Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_diagnostics.F @ 3709

Last change on this file since 3709 was 2759, checked in by aslmd, 3 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 10.7 KB

Line
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	,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
309	END MODULE module_diagnostics

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format