module_diagnostics.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:PHYSICS
2 !
3
4 MODULE module_diagnostics
5 CONTAINS
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 ,p_phy,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
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 !-- P_PHY 3D pressure array
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 , p_phy
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
110 REAL :: no_points
111 REAL :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
112 REAL :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
113 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
114 CHARACTER*256 :: outstring
115 CHARACTER*6 :: grid_str
116
117 !-----------------------------------------------------------------
118
119 if (diag_print .eq. 0 ) return
120
121 IF ( xtime .gt. 0. ) THEN
122
123 ! COMPUTE THE NUMBER OF MASS GRID POINTS
124 no_points = float((ide-ids)*(jde-jds))
125
126 ! SET START AND END POINTS FOR TILES
127 ! !$OMP PARALLEL DO &
128 ! !$OMP PRIVATE ( ij )
129
130 DO ij = 1 , num_tiles
131
132 ! print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
133 DO j=j_start(ij),j_end(ij)
134 DO i=i_start(ij),i_end(ij)
135 dpsdt(i,j)=(p_phy(i,kms,j)-pk1m(i,j))/dt
136 dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
137 ENDDO
138 ENDDO
139
140 ENDDO
141 ! !$OMP END PARALLEL DO
142
143 ! print *, 'p_phy(30,1,30),pk1m(30,30) : ', p_phy(30,1,30),pk1m(30,30)
144 ! print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
145 dpsdt_sum = 0.
146 dmudt_sum = 0.
147
148 DO j = jps, min(jpe,jde-1)
149 DO i = ips, min(ipe,ide-1)
150 dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
151 dmudt_sum = dmudt_sum + abs(dmudt(i,j))
152 ENDDO
153 ENDDO
154
155 ! compute global sum
156 dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
157 dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
158
159 ! print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
160
161 IF ( diag_print .eq. 2 ) THEN
162 dardt_sum = 0.
163 drcdt_sum = 0.
164 drndt_sum = 0.
165 rainc_sum = 0.
166 raint_sum = 0.
167 rainnc_sum = 0.
168 sfcevp_sum = 0.
169 hfx_sum = 0.
170 lh_sum = 0.
171
172 DO j = jps, min(jpe,jde-1)
173 DO i = ips, min(ipe,ide-1)
174 drcdt_sum = drcdt_sum + abs(raincv(i,j))
175 drndt_sum = drndt_sum + abs(rainncv(i,j))
176 dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
177 rainc_sum = rainc_sum + abs(rainc(i,j))
178 rainnc_sum = rainnc_sum + abs(rainnc(i,j))
179 raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
180 sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
181 hfx_sum = hfx_sum + abs(hfx(i,j))
182 lh_sum = lh_sum + abs(lh(i,j))
183 ENDDO
184 ENDDO
185
186 ! compute global sum
187 drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
188 drndt_sum = wrf_dm_sum_real ( drndt_sum )
189 dardt_sum = wrf_dm_sum_real ( dardt_sum )
190 rainc_sum = wrf_dm_sum_real ( rainc_sum )
191 rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
192 raint_sum = wrf_dm_sum_real ( raint_sum )
193 sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
194 hfx_sum = wrf_dm_sum_real ( hfx_sum )
195 lh_sum = wrf_dm_sum_real ( lh_sum )
196
197 ENDIF
198
199 ! print out the average values
200
201 CALL get_current_grid_name( grid_str )
202
203 #ifdef DM_PARALLEL
204 IF ( wrf_dm_on_monitor() ) THEN
205 #endif
206 WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (Pa/sec): ', xtime, &
207 dpsdt_sum/no_points, &
208 dmudt_sum/no_points
209 CALL wrf_message ( TRIM(outstring) )
210 IF ( diag_print .eq. 2) THEN
211 WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
212 dardt_sum/dt/no_points, &
213 drcdt_sum/dt/no_points, &
214 drndt_sum/dt/no_points
215 CALL wrf_message ( TRIM(outstring) )
216 WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm): ', xtime, &
217 raint_sum/no_points, &
218 rainc_sum/no_points, &
219 rainnc_sum/no_points
220 CALL wrf_message ( TRIM(outstring) )
221 WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
222 sfcevp_sum/no_points, &
223 hfx_sum/no_points, &
224 lh_sum/no_points
225 CALL wrf_message ( TRIM(outstring) )
226 ENDIF
227 #ifdef DM_PARALLEL
228 ENDIF
229 #endif
230
231 ENDIF
232
233 ! save values at this time step
234 !$OMP PARALLEL DO &
235 !$OMP PRIVATE ( ij,i,j )
236 DO ij = 1 , num_tiles
237
238 DO j=j_start(ij),j_end(ij)
239 DO i=i_start(ij),i_end(ij)
240 pk1m(i,j)=p_phy(i,kms,j)
241 mu_2m(i,j)=mu_2(i,j)
242 ENDDO
243 ENDDO
244
245 IF ( xtime .lt. 0.0001 ) THEN
246 DO j=j_start(ij),j_end(ij)
247 DO i=i_start(ij),i_end(ij)
248 dpsdt(i,j)=0.
249 dmudt(i,j)=0.
250 ENDDO
251 ENDDO
252 ENDIF
253
254 ENDDO
255 !$OMP END PARALLEL DO
256
257 END SUBROUTINE diagnostic_output_calc
258
259 END MODULE module_diagnostics