Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_diagnostics.F @ 3567

Last change on this file since 3567 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 9.1 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	,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

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

Download in other formats:

Original Format