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 sfcevp_sum = 0.
166 hfx_sum = 0.
167 lh_sum = 0.
168
169 DO j = jps, min(jpe,jde-1)
170 DO i = ips, min(ipe,ide-1)
171 drcdt_sum = drcdt_sum + abs(raincv(i,j))
172 drndt_sum = drndt_sum + abs(rainncv(i,j))
173 dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
174 rainc_sum = rainc_sum + abs(rainc(i,j))
175 rainnc_sum = rainnc_sum + abs(rainnc(i,j))
176 raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
177 sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
178 hfx_sum = hfx_sum + abs(hfx(i,j))
179 lh_sum = lh_sum + abs(lh(i,j))
180 ENDDO
181 ENDDO
182
183 ! compute global sum
184 drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
185 drndt_sum = wrf_dm_sum_real ( drndt_sum )
186 dardt_sum = wrf_dm_sum_real ( dardt_sum )
187 rainc_sum = wrf_dm_sum_real ( rainc_sum )
188 rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
189 raint_sum = wrf_dm_sum_real ( raint_sum )
190 sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
191 hfx_sum = wrf_dm_sum_real ( hfx_sum )
192 lh_sum = wrf_dm_sum_real ( lh_sum )
193
194 ENDIF
195
196 ! print out the average values
197
198 CALL get_current_grid_name( grid_str )
199
200 #ifdef DM_PARALLEL
201 IF ( wrf_dm_on_monitor() ) THEN
202 #endif
203 WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (Pa/sec): ', xtime, &
204 dpsdt_sum/no_points, &
205 dmudt_sum/no_points
206 CALL wrf_message ( TRIM(outstring) )
207 IF ( diag_print .eq. 2) THEN
208 WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
209 dardt_sum/dt/no_points, &
210 drcdt_sum/dt/no_points, &
211 drndt_sum/dt/no_points
212 CALL wrf_message ( TRIM(outstring) )
213 WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm/sec): ', xtime, &
214 raint_sum/no_points, &
215 rainc_sum/no_points, &
216 rainnc_sum/no_points
217 CALL wrf_message ( TRIM(outstring) )
218 WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
219 sfcevp_sum/no_points, &
220 hfx_sum/no_points, &
221 lh_sum/no_points
222 CALL wrf_message ( TRIM(outstring) )
223 ENDIF
224 #ifdef DM_PARALLEL
225 ENDIF
226 #endif
227
228 ENDIF
229
230 ! save values at this time step
231 !$OMP PARALLEL DO &
232 !$OMP PRIVATE ( ij,i,j )
233 DO ij = 1 , num_tiles
234
235 DO j=j_start(ij),j_end(ij)
236 DO i=i_start(ij),i_end(ij)
237 pk1m(i,j)=p_phy(i,kms,j)
238 mu_2m(i,j)=mu_2(i,j)
239 ENDDO
240 ENDDO
241
242 IF ( xtime .lt. 0.0001 ) THEN
243 DO j=j_start(ij),j_end(ij)
244 DO i=i_start(ij),i_end(ij)
245 dpsdt(i,j)=0.
246 dmudt(i,j)=0.
247 ENDDO
248 ENDDO
249 ENDIF
250
251 ENDDO
252 !$OMP END PARALLEL DO
253
254 END SUBROUTINE diagnostic_output_calc
255
256 END MODULE module_diagnostics