source: trunk/WRF.COMMON/WRFV3/phys/module_diagnostics.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 10.7 KB
RevLine 
[2759]1!WRF:MEDIATION_LAYER:PHYSICS
2!
3
4MODULE module_diagnostics
5CONTAINS
6   SUBROUTINE diagnostic_output_calc(                                 &
7                      ids,ide, jds,jde, kds,kde,                      &
8                      ims,ime, jms,jme, kms,kme,                      &
9                      ips,ipe, jps,jpe, kps,kpe,                      & ! patch  dims
10                      i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
11                     ,dpsdt,dmudt                                     &
12                     ,p8w,pk1m,mu_2,mu_2m                             &
13                     ,u,v                                             &
14                     ,raincv,rainncv,rainc,rainnc                     &
15                     ,hfx,sfcevp,lh                                   &
16                     ,dt,xtime,sbw                                    &
17                     ,diag_print                                      &
18                                                                      )
19!----------------------------------------------------------------------
20
21  USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
22
23   IMPLICIT NONE
24!======================================================================
25! Definitions
26!-----------
27!-- DIAG_PRINT    print control: 0 - no diagnostics; 1 - dmudt only; 2 - all
28!-- DT            time step (second)
29!-- XTIME         forecast time
30!-- SBW           specified boundary width - used later
31!
32!-- P8W           3D pressure array at full eta levels
33!-- MU            dry column hydrostatic pressure
34!-- RAINC         cumulus scheme precipitation since hour 0
35!-- RAINCV        cumulus scheme precipitation in one time step (mm)
36!-- RAINNC        explicit scheme precipitation since hour 0
37!-- RAINNCV       explicit scheme precipitation in one time step (mm)
38!-- HFX           surface sensible heat flux
39!-- LH            surface latent heat flux
40!-- SFCEVP        total surface evaporation
41!-- U             u component of wind - to be used later to compute k.e.
42!-- V             v component of wind - to be used later to compute k.e.
43!
44!-- ids           start index for i in domain
45!-- ide           end index for i in domain
46!-- jds           start index for j in domain
47!-- jde           end index for j in domain
48!-- kds           start index for k in domain
49!-- kde           end index for k in domain
50!-- ims           start index for i in memory
51!-- ime           end index for i in memory
52!-- jms           start index for j in memory
53!-- jme           end index for j in memory
54!-- ips           start index for i in patch
55!-- ipe           end index for i in patch
56!-- jps           start index for j in patch
57!-- jpe           end index for j in patch
58!-- kms           start index for k in memory
59!-- kme           end index for k in memory
60!-- i_start       start indices for i in tile
61!-- i_end         end indices for i in tile
62!-- j_start       start indices for j in tile
63!-- j_end         end indices for j in tile
64!-- kts           start index for k in tile
65!-- kte           end index for k in tile
66!-- num_tiles     number of tiles
67!
68!======================================================================
69
70   INTEGER,      INTENT(IN   )    ::                             &
71                                      ids,ide, jds,jde, kds,kde, &
72                                      ims,ime, jms,jme, kms,kme, &
73                                      ips,ipe, jps,jpe, kps,kpe, &
74                                                        kts,kte, &
75                                                      num_tiles
76
77   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                  &
78     &           i_start,i_end,j_start,j_end
79
80   INTEGER,      INTENT(IN   )    ::   diag_print
81
82   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
83         INTENT(IN ) ::                                       u  &
84                                                    ,         v  &
85                                                    ,       p8w
86
87   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
88                                                           MU_2  &
89                                                    ,     RAINC  &
90                                                    ,    RAINNC  &
91                                                    ,    RAINCV  &
92                                                    ,   RAINNCV  &
93                                                    ,       HFX  &
94                                                    ,    SFCEVP  & 
95                                                    ,        LH 
96
97   REAL, DIMENSION( ims:ime , jms:jme ),                         &
98          INTENT(INOUT) ::                                DPSDT  &
99                                                    ,     DMUDT  &
100                                                    ,     MU_2M  &
101                                                    ,      PK1M
102 
103   REAL,  INTENT(IN   ) :: DT, XTIME
104   INTEGER,  INTENT(IN   ) :: SBW
105
106! LOCAL  VAR
107
108   INTEGER :: i,j,k,its,ite,jts,jte,ij
109   INTEGER :: idp,jdp,irc,jrc,irnc,jrnc,isnh,jsnh
110   INTEGER :: prfreq
111
112   REAL              :: no_points
113   REAL              :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
114   REAL              :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
115   REAL              :: dmumax, raincmax, rainncmax, snowhmax
116   LOGICAL, EXTERNAL :: wrf_dm_on_monitor
117   CHARACTER*256     :: outstring
118   CHARACTER*6       :: grid_str
119
120!-----------------------------------------------------------------
121
122   if (diag_print .eq. 0 ) return
123
124   IF ( xtime .ne. 0. ) THEN
125
126    if(diag_print.eq.1) then
127       prfreq = dt
128!      prfreq = max(2,int(dt/60.))   ! in min
129    else
130       prfreq=10                   ! in min
131    endif
132   
133    IF (MOD(nint(dt),prfreq) == 0) THEN
134
135! COMPUTE THE NUMBER OF MASS GRID POINTS
136   no_points = float((ide-ids)*(jde-jds))
137
138! SET START AND END POINTS FOR TILES
139!  !$OMP PARALLEL DO   &
140!  !$OMP PRIVATE ( ij )
141
142   dmumax = 0.
143   DO ij = 1 , num_tiles
144
145!     print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
146      DO j=j_start(ij),j_end(ij)
147      DO i=i_start(ij),i_end(ij)
148         dpsdt(i,j)=(p8w(i,kms,j)-pk1m(i,j))/dt
149         dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
150         if(abs(dmudt(i,j)*dt).gt.dmumax)then
151           dmumax=abs(dmudt(i,j)*dt)
152           idp=i
153           jdp=j
154         endif
155      ENDDO     
156      ENDDO
157
158   ENDDO
159!  !$OMP END PARALLEL DO
160
161! convert DMUMAX from (PA) to (bars) per time step
162   dmumax = dmumax*1.e-5
163! compute global MAX
164   CALL wrf_dm_maxval ( dmumax,  idp, jdp )
165
166!  print *, 'p8w(30,1,30),pk1m(30,30) : ', p8w(30,1,30),pk1m(30,30)
167!  print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
168   dpsdt_sum = 0.
169   dmudt_sum = 0.
170
171   DO j = jps, min(jpe,jde-1)
172     DO i = ips, min(ipe,ide-1)
173       dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
174       dmudt_sum = dmudt_sum + abs(dmudt(i,j))
175     ENDDO
176   ENDDO
177
178! compute global sum
179   dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
180   dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
181
182!  print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
183
184   IF ( diag_print .eq. 2 ) THEN
185   dardt_sum = 0.
186   drcdt_sum = 0.
187   drndt_sum = 0.
188   rainc_sum = 0.
189   raint_sum = 0.
190   rainnc_sum = 0.
191   sfcevp_sum = 0.
192   hfx_sum = 0.
193   lh_sum = 0.
194
195   DO j = jps, min(jpe,jde-1)
196     DO i = ips, min(ipe,ide-1)
197       drcdt_sum = drcdt_sum + abs(raincv(i,j))
198       drndt_sum = drndt_sum + abs(rainncv(i,j))
199       dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
200       rainc_sum = rainc_sum + abs(rainc(i,j))
201! MAX for accumulated conv precip
202       IF(rainc(i,j).gt.raincmax)then
203          raincmax=rainc(i,j)
204          irc=i
205          jrc=j
206       ENDIF
207       rainnc_sum = rainnc_sum + abs(rainnc(i,j))
208! MAX for accumulated resolved precip
209       IF(rainnc(i,j).gt.rainncmax)then
210          rainncmax=rainnc(i,j)
211          irnc=i
212          jrnc=j
213       ENDIF
214       raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
215       sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
216       hfx_sum = hfx_sum + abs(hfx(i,j))
217       lh_sum = lh_sum + abs(lh(i,j))
218     ENDDO
219   ENDDO
220
221! compute global MAX
222   CALL wrf_dm_maxval ( raincmax, irc, jrc )
223   CALL wrf_dm_maxval ( rainncmax, irnc, jrnc )
224
225! compute global sum
226   drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
227   drndt_sum = wrf_dm_sum_real ( drndt_sum )
228   dardt_sum = wrf_dm_sum_real ( dardt_sum )
229   rainc_sum = wrf_dm_sum_real ( rainc_sum )
230   rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
231   raint_sum = wrf_dm_sum_real ( raint_sum )
232   sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
233   hfx_sum = wrf_dm_sum_real ( hfx_sum )
234   lh_sum = wrf_dm_sum_real ( lh_sum )
235
236   ENDIF
237
238! print out the average values
239
240   CALL get_current_grid_name( grid_str )
241
242#ifdef DM_PARALLEL
243   IF ( wrf_dm_on_monitor() ) THEN
244#endif
245     WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (mb/3h): ', xtime, &
246           dpsdt_sum/no_points*108., &
247           dmudt_sum/no_points*108.
248     CALL wrf_message ( TRIM(outstring) )
249
250     WRITE(outstring,*) grid_str,'Max mu change time step: ', idp,jdp,dmumax
251     CALL wrf_message ( TRIM(outstring) )
252
253     IF ( diag_print .eq. 2) THEN
254     WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
255           dardt_sum/dt/no_points, &
256           drcdt_sum/dt/no_points, &
257           drndt_sum/dt/no_points
258     CALL wrf_message ( TRIM(outstring) )
259     WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm): ', xtime, &
260           raint_sum/no_points, &
261           rainc_sum/no_points, &
262           rainnc_sum/no_points
263     CALL wrf_message ( TRIM(outstring) )
264     WRITE(outstring,*) grid_str,'Max Accum Resolved Precip,   I,J  (mm): '               ,&
265           rainncmax,irnc,jrnc
266     CALL wrf_message ( TRIM(outstring) )
267     WRITE(outstring,*) grid_str,'Max Accum Convective Precip,   I,J  (mm): '             ,&
268           raincmax,irc,jrc
269     CALL wrf_message ( TRIM(outstring) )
270     WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
271           sfcevp_sum/no_points, &
272           hfx_sum/no_points, &
273           lh_sum/no_points
274     CALL wrf_message ( TRIM(outstring) )
275     ENDIF
276#ifdef DM_PARALLEL
277   ENDIF
278#endif
279
280    ENDIF        ! print frequency
281   ENDIF
282
283! save values at this time step
284   !$OMP PARALLEL DO   &
285   !$OMP PRIVATE ( ij,i,j )
286   DO ij = 1 , num_tiles
287
288      DO j=j_start(ij),j_end(ij)
289      DO i=i_start(ij),i_end(ij)
290         pk1m(i,j)=p8w(i,kms,j)
291         mu_2m(i,j)=mu_2(i,j)
292      ENDDO
293      ENDDO
294
295      IF ( xtime .lt. 0.0001 ) THEN
296      DO j=j_start(ij),j_end(ij)
297      DO i=i_start(ij),i_end(ij)
298         dpsdt(i,j)=0.
299         dmudt(i,j)=0.
300      ENDDO
301      ENDDO
302      ENDIF
303
304   ENDDO
305   !$OMP END PARALLEL DO
306
307   END SUBROUTINE diagnostic_output_calc
308
309END MODULE module_diagnostics
Note: See TracBrowser for help on using the repository browser.