Line data Source code
1 : module fv_prints
2 : !-------------------------------------------------------------------------
3 : !BOP
4 : !
5 : ! !MODULE: fv_prints --- print maxima and minima of dycore varibles
6 : !
7 : ! !USES:
8 : use shr_kind_mod, only: r8 => shr_kind_r8
9 : use perf_mod
10 : use cam_logfile, only: iulog
11 : ! !PUBLIC MEMBER FUNCTIONS:
12 : PUBLIC fv_out
13 : !
14 : ! !DESCRIPTION:
15 : !
16 : ! This module provides basic utilities to evaluate the dynamics state
17 : !
18 : ! !REVISION HISTORY:
19 : ! 00.08.01 Lin Creation
20 : ! 01.01.05 Boville Modifications
21 : ! 01.03.26 Sawyer Added ProTex documentation
22 : ! 03.04.17 Sawyer Bug fix: pls=pls/2*plon instead of 2*plat (Boville)
23 : ! 05.07.06 Sawyer Simplified interface with grid
24 : ! 06.02.21 Sawyer Converted to XY decomposition
25 : ! 06.07.01 Sawyer Transitioned tracers q3 to T_TRACERS
26 : ! 06.09.10 Sawyer Isolated magic numbers with F90 parameters
27 : ! 08.07.03 Worley Introduced repro_sum logic
28 : ! 12.10.29 Santos repro_sum_mod is now shr_reprosum_mod
29 : !
30 : !EOP
31 : !-------------------------------------------------------------------------
32 :
33 : private
34 : real(r8), parameter :: D0_0 = 0.0_r8
35 : real(r8), parameter :: D0_01 = 0.01_r8
36 : real(r8), parameter :: D1_0 = 1.0_r8
37 : real(r8), parameter :: D2_0 = 2.0_r8
38 : real(r8), parameter :: D864_0 = 864.0_r8
39 : real(r8), parameter :: G_EARTH = 9.80616_r8
40 : real(r8), parameter :: SECS_PER_1000_DAYS = 86400000.0_r8
41 :
42 : CONTAINS
43 :
44 : !-------------------------------------------------------------------------
45 : !BOP
46 : ! !IROUTINE: fv_out --- Write out maxima and minima of dynamics state
47 : !
48 : ! !INTERFACE:
49 1536 : subroutine fv_out( grid, pk, pt, ptop, ps, &
50 768 : tracer, delp, pe, surf_state, phys_state, &
51 : ncdate, ncsec, full_phys )
52 :
53 : ! !USES:
54 : use shr_kind_mod, only: r8 => shr_kind_r8
55 : use dynamics_vars, only : T_FVDYCORE_GRID
56 : use ppgrid, only: begchunk, endchunk, pcols, pver
57 : use phys_grid, only: get_ncols_p
58 : use physics_types, only: physics_state
59 : use camsrfexch, only: cam_out_t
60 : use constituents, only: cnst_name
61 : #if defined( SPMD )
62 : use parutilitiesmodule, only : sumop, parcollective
63 : use mpishorthand, only: mpicom
64 : #endif
65 : use shr_reprosum_mod, only : shr_reprosum_calc, shr_reprosum_tolExceeded
66 :
67 : use gmean_mod, only : gmean
68 :
69 : implicit none
70 :
71 : ! !INPUT PARAMETERS:
72 : type (T_FVDYCORE_GRID), intent(in) :: grid
73 :
74 : integer ncdate ! Date
75 : integer ncsec ! Time
76 :
77 : real(r8) :: ptop ! Pressure at top
78 : ! Surface pressure
79 : real(r8) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy)
80 : ! Pe**kappa
81 : real(r8) :: pk(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km+1)
82 : ! Potential temperature
83 : real(r8) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
84 : ! Layer thickness (pint(k+1) - pint(k))
85 : real(r8) :: delp(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km)
86 : ! Tracers
87 : real(r8), intent(inout) :: &
88 : tracer(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq)
89 : ! Edge pressure
90 : real(r8) :: pe(grid%ifirstxy:grid%ilastxy,grid%km+1,grid%jfirstxy:grid%jlastxy)
91 :
92 : type(cam_out_t), intent(in), dimension(begchunk:endchunk) :: surf_state
93 :
94 : type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state
95 : logical full_phys ! Full physics on?
96 :
97 : !
98 : ! !DESCRIPTION:
99 : !
100 : ! Determine maxima and minima of dynamics state and write them out
101 : !
102 : ! !REVISION HISTORY:
103 : ! 00.08.01 Lin Creation
104 : ! 01.01.05 Boville Modifications
105 : ! 01.03.26 Sawyer Added ProTex documentation
106 : ! 01.06.27 Mirin Converted to 2D yz decomposition
107 : ! 01.12.18 Mirin Calculate average height (htsum) metric
108 : ! 02.02.13 Eaton Pass precc and precl via cam_out_t type
109 : ! 05.07.06 Sawyer Simplified interface with grid
110 : ! 06.02.21 Sawyer Converted to XY decomposition
111 : ! 06.07.01 Sawyer Transitioned tracers q3 to T_TRACERS
112 : ! 08.07.03 Worley Introduced repro_sum and gmean logic
113 : ! 12.10.2= Santos repro_sum is now shr_reprosum_mod
114 : !
115 : !EOP
116 : !-----------------------------------------------------------------------
117 : !BOC
118 : !
119 : ! !LOCAL VARIABLES:
120 : integer i, j, k, ic, nj, lchnk, nck, ncol
121 1536 : real(r8), dimension(begchunk:endchunk) :: pmax, tmax, umax, vmax, wmax
122 1536 : real(r8), dimension(begchunk:endchunk) :: pmin, tmin, umin, vmin, wmin
123 1536 : real(r8), dimension(pcols,begchunk:endchunk,1) :: precc ! convective precip rate
124 1536 : real(r8), dimension(pcols,begchunk:endchunk,1) :: precl ! large-scale precip rate
125 1536 : real(r8), dimension(begchunk:endchunk) :: preccmax, preclmax
126 1536 : real(r8), dimension(begchunk:endchunk) :: preccmin, preclmin
127 : real(r8) :: fac, precmax, precmin
128 : real(r8) :: pcon(1), pls(1)
129 : real(r8) :: p1, p2, dtmp, apcon, htsum(1)
130 : real(r8), pointer :: qtmp(:,:,:)
131 1536 : real(r8) :: htg(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy)
132 : real(r8) :: rel_diff(2)
133 :
134 : integer :: im, jm, km, ifirstxy, ilastxy, jfirstxy, jlastxy
135 : integer :: itot, jtot, ltot
136 :
137 : integer :: ntotq ! No. of total tracers
138 : integer :: iam
139 :
140 : integer n, nhmsf
141 :
142 : logical :: write_warning, exceeded
143 :
144 : ! statement function for hour minutes seconds of day
145 : nhmsf(n) = n/3600*10000 + mod(n,3600 )/ 60*100 + mod(n, 60)
146 :
147 : ! Initialize variables from grid (for convenience)
148 :
149 768 : im = grid%im
150 768 : jm = grid%jm
151 768 : km = grid%km
152 768 : ifirstxy= grid%ifirstxy
153 768 : ilastxy = grid%ilastxy
154 768 : jfirstxy= grid%jfirstxy
155 768 : jlastxy = grid%jlastxy
156 768 : ntotq = grid%ntotq
157 :
158 768 : itot = (ilastxy-ifirstxy) + 1
159 768 : jtot = (jlastxy-jfirstxy) + 1
160 768 : ltot = itot*jtot
161 :
162 768 : iam = grid%iam
163 :
164 768 : if (iam == 0) then
165 1 : write(iulog,*) ' '
166 1 : write(iulog,*) nhmsf(ncsec), ncdate
167 : endif
168 :
169 : !
170 : ! Check total air and dry air mass.
171 :
172 : call dryairm( grid, .true., ps, tracer, delp, &
173 768 : pe, .true.)
174 :
175 : !$omp parallel do private(lchnk, ncol)
176 4608 : do lchnk = begchunk, endchunk
177 3840 : ncol = get_ncols_p(lchnk)
178 62976 : pmax(lchnk) = maxval(phys_state(lchnk)%ps(1:ncol))
179 62976 : pmin(lchnk) = minval(phys_state(lchnk)%ps(1:ncol))
180 1896192 : tmax(lchnk) = maxval(phys_state(lchnk)%t(1:ncol,1:pver))
181 1896192 : tmin(lchnk) = minval(phys_state(lchnk)%t(1:ncol,1:pver))
182 1896192 : umax(lchnk) = maxval(phys_state(lchnk)%u(1:ncol,1:pver))
183 1896192 : umin(lchnk) = minval(phys_state(lchnk)%u(1:ncol,1:pver))
184 1896192 : vmax(lchnk) = maxval(phys_state(lchnk)%v(1:ncol,1:pver))
185 1896192 : vmin(lchnk) = minval(phys_state(lchnk)%v(1:ncol,1:pver))
186 1896192 : wmax(lchnk) = maxval(phys_state(lchnk)%omega(1:ncol,1:pver))
187 1896960 : wmin(lchnk) = minval(phys_state(lchnk)%omega(1:ncol,1:pver))
188 : end do
189 :
190 : #if defined( SPMD )
191 768 : nck = endchunk - begchunk + 1
192 768 : call pmaxmin2('PS', pmin, pmax, nck, D0_01, mpicom)
193 768 : call pmaxmin2('U ', umin, umax, nck, D1_0, mpicom)
194 768 : call pmaxmin2('V ', vmin, vmax, nck, D1_0, mpicom)
195 768 : call pmaxmin2('T ', tmin, tmax, nck, D1_0, mpicom)
196 768 : call pmaxmin2('W (mb/day)', wmin, wmax, nck, D864_0, mpicom)
197 : #endif
198 :
199 : #if 0
200 : !
201 : ! This code is currently inactive: the maxima and minima were not
202 : ! being used
203 : !
204 : nj = (jlastxy - jfirstxy + 1) * (ilastxy - ifirstxy + 1)
205 : do ic=1,ntotq
206 : qtmp => tracer(:,:,:,ic)
207 : call pmaxmin(cnst_name(ic), qtmp, p1, p2, nj, km, D1_0, grid%commxy)
208 : !
209 : ! Do something with p1 and p2?
210 : !
211 : end do
212 : #endif
213 :
214 : !
215 : ! Calculate the vertically integrated heights
216 : !
217 58368 : htg(:,:) = D0_0
218 : apcon = D1_0/G_EARTH
219 :
220 : !$omp parallel do private(i, j, k)
221 3072 : do j=jfirstxy,jlastxy
222 76800 : do k=1,km
223 1845504 : do i=ifirstxy,ilastxy
224 1843200 : htg(i,j) = htg(i,j) + apcon * pt(i,j,k) * (pk(i,j,k+1)-pk(i,j,k))
225 : enddo
226 : enddo
227 : enddo
228 :
229 : !$omp parallel do private(i, j, k)
230 3072 : do j=jfirstxy,jlastxy
231 58368 : do i=ifirstxy,ilastxy
232 57600 : htg(i,j) = htg(i,j)*grid%cosp(j)
233 : enddo
234 : enddo
235 :
236 768 : call t_startf("fv_out_reprosum")
237 : call shr_reprosum_calc(htg, htsum, ltot, ltot, 1, gbl_count=im*jm, &
238 768 : commid=grid%commxy, rel_diff=rel_diff)
239 768 : call t_stopf("fv_out_reprosum")
240 :
241 : ! check that "fast" reproducible sum is accurate enough.
242 : ! NOTE: not recomputing if difference too large. This
243 : ! value is output only, so does not feed back into the
244 : ! simulation
245 768 : write_warning = .false.
246 768 : if (iam == 0) write_warning = .true.
247 : exceeded = shr_reprosum_tolExceeded('fv_out', 1, write_warning, &
248 768 : iulog, rel_diff)
249 :
250 768 : if (iam == 0) then
251 1 : htsum(1) = htsum(1) / (D2_0*im)
252 1 : write(iulog,*) 'Average Height (geopotential units) = ', htsum(1)
253 : endif
254 :
255 768 : if ( .not. full_phys ) return
256 :
257 : ! Global means:
258 :
259 768 : fac = SECS_PER_1000_DAYS ! convert to mm/day
260 :
261 : !$omp parallel do private(lchnk, ncol)
262 4608 : do lchnk = begchunk, endchunk
263 3840 : ncol = get_ncols_p(lchnk)
264 59136 : precc(:ncol,lchnk,1) = surf_state(lchnk)%precc(:ncol)
265 59136 : precl(:ncol,lchnk,1) = surf_state(lchnk)%precl(:ncol)
266 62976 : preccmax(lchnk) = maxval(precc(1:ncol,lchnk,1))
267 62976 : preccmin(lchnk) = minval(precc(1:ncol,lchnk,1))
268 62976 : preclmax(lchnk) = maxval(precl(1:ncol,lchnk,1))
269 63744 : preclmin(lchnk) = minval(precl(1:ncol,lchnk,1))
270 : end do
271 :
272 : #if defined( SPMD )
273 768 : nck = endchunk - begchunk + 1
274 768 : call pmaxmin2('PRECC', preccmin, preccmax, nck, fac, mpicom)
275 768 : call pmaxmin2('PRECL', preclmin, preclmax, nck, fac, mpicom)
276 : #endif
277 :
278 768 : call gmean(precc,pcon,1)
279 768 : call gmean(precl,pls,1)
280 :
281 768 : if (iam == 0) then
282 1 : pcon(1) = pcon(1) * fac
283 1 : pls(1) = pls(1) * fac
284 1 : write(iulog,*) 'Total precp=',pcon(1)+pls(1), &
285 2 : ' CON=', pcon(1),' LS=',pls(1)
286 1 : write(iulog,*) ' '
287 : endif
288 :
289 : !EOC
290 768 : end subroutine fv_out
291 : !-----------------------------------------------------------------------
292 :
293 : !-----------------------------------------------------------------------
294 : !BOP
295 : ! !IROUTINE: pmaxmin --- Find and print the maxima and minima of a field
296 : !
297 : ! !INTERFACE:
298 : subroutine pmaxmin( qname, a, pmin, pmax, im, jm, fac, commun )
299 :
300 : ! !USES:
301 768 : use shr_kind_mod, only: r8 => shr_kind_r8
302 : #if defined( SPMD )
303 : #define CPP_PRT_PREFIX if(gid==0)
304 : use parutilitiesmodule, only : gid, maxop, parcollective
305 : #else
306 : #define CPP_PRT_PREFIX
307 : #endif
308 : implicit none
309 :
310 : ! !INPUT PARAMETERS:
311 : character*(*) qname ! Name of field
312 : integer im ! Total longitudes
313 : integer jm ! Total latitudes
314 : integer commun ! Communicator
315 : real(r8) a(im,jm) ! 2D field
316 : real(r8) fac ! multiplication factor
317 :
318 : ! !OUTPUT PARAMETERS:
319 : real(r8) pmax ! Field maximum
320 : real(r8) pmin ! Field minimum
321 :
322 : ! !DESCRIPTION:
323 : !
324 : ! Parallelized utility routine for computing/printing global
325 : ! max/min from input lists of max/min's (usually for each latitude).
326 : !
327 : ! !REVISION HISTORY:
328 : ! 00.03.01 Lin Creation
329 : ! 00.05.01 Mirin Coalesce variables to minimize collective ops
330 : ! 01.08.05 Sawyer Modified to use parcollective
331 : ! 01.03.26 Sawyer Added ProTex documentation
332 : !
333 : !EOP
334 : !-----------------------------------------------------------------------
335 : !BOC
336 : !
337 : ! !LOCAL VARIABLES:
338 :
339 : integer i, j
340 : real(r8) qmin(jm), qmax(jm)
341 : real(r8) pm(2)
342 :
343 : !$omp parallel do default(shared) private(i,j, pmax, pmin)
344 :
345 : do j=1,jm
346 : pmax = a(1,j)
347 : pmin = a(1,j)
348 : do i=2,im
349 : pmax = max(pmax, a(i,j))
350 : pmin = min(pmin, a(i,j))
351 : enddo
352 : qmax(j) = pmax
353 : qmin(j) = pmin
354 : enddo
355 : !
356 : ! Now find max/min of qmax/qmin
357 : !
358 : pmax = qmax(1)
359 : pmin = qmin(1)
360 : do j=2,jm
361 : pmax = max(pmax, qmax(j))
362 : pmin = min(pmin, qmin(j))
363 : enddo
364 :
365 : #if defined( SPMD )
366 : pm(1) = pmax
367 : pm(2) = -pmin
368 : call parcollective( commun, maxop, 2, pm )
369 : pmax = pm(1)
370 : pmin = -pm(2)
371 : #endif
372 :
373 : CPP_PRT_PREFIX write(iulog,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
374 :
375 : return
376 : !EOC
377 : end subroutine pmaxmin
378 : !-----------------------------------------------------------------------
379 :
380 : !-----------------------------------------------------------------------
381 : !BOP
382 : ! !IROUTINE: pmaxmin2 --- Find and print the maxima and minima of 1-D array
383 : !
384 : ! !INTERFACE:
385 5376 : subroutine pmaxmin2( qname, qmin, qmax, nj, fac, commun )
386 :
387 : ! !USES:
388 : use shr_kind_mod, only: r8 => shr_kind_r8
389 : #if defined( SPMD )
390 : #define CPP_PRT_PREFIX if(gid==0)
391 : use parutilitiesmodule, only : gid, maxop, parcollective
392 : #else
393 : #define CPP_PRT_PREFIX
394 : #endif
395 : implicit none
396 :
397 : ! !INPUT PARAMETERS:
398 : character*(*) qname
399 : integer nj
400 : integer commun
401 : real(r8), intent(in), dimension(nj) :: qmax, qmin ! Fields
402 : real(r8) fac ! multiplication factor
403 :
404 : ! !DESCRIPTION:
405 : !
406 : ! Parallelized utility routine for computing/printing global max/min from
407 : ! input lists of max/min's (usually for each latitude). The primary purpose
408 : ! is to allow for the original array and the input max/min arrays to be
409 : ! distributed across nodes.
410 : !
411 : ! !REVISION HISTORY:
412 : ! 00.10.01 Lin Creation from pmaxmin
413 : ! 01.03.26 Sawyer Added ProTex documentation
414 : !
415 : !EOP
416 : !-----------------------------------------------------------------------
417 : !BOC
418 : !
419 : ! !LOCAL VARIABLES:
420 : real(r8) pm(2)
421 : real(r8) pmin, pmax
422 :
423 37632 : pmax = maxval(qmax)
424 37632 : pmin = minval(qmin)
425 :
426 : #if defined( SPMD )
427 5376 : pm(1) = pmax
428 5376 : pm(2) = -pmin
429 5376 : call parcollective( commun, maxop, 2, pm )
430 5376 : pmax = pm(1)
431 5376 : pmin = -pm(2)
432 : #endif
433 :
434 5376 : CPP_PRT_PREFIX write(iulog,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
435 :
436 5376 : return
437 : !EOC
438 : end subroutine pmaxmin2
439 : !-----------------------------------------------------------------------
440 :
441 : end module fv_prints
|
