Context Navigation

module_fddagd_driver.F

Last change on this file was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 18.1 KB

Line
1	!WRF:MEDIATION_LAYER:PHYSICS
2	!
3
4	MODULE module_fddagd_driver
5	CONTAINS
6
7	!------------------------------------------------------------------
8	SUBROUTINE fddagd_driver(itimestep,dt,xtime, &
9	id, &
10	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
11	RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
12	u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old, &
13	q_ndg_old,mu_ndg_old, &
14	u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new, &
15	q_ndg_new,mu_ndg_new, &
16	u3d,v3d,th_phy,ph,rho,moist, &
17	p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w, &
18	grid,config_flags,DX,n_moist, &
19	STEPFG, &
20	pblh,ht,regime,znt, &
21	ids,ide, jds,jde, kds,kde, &
22	ims,ime, jms,jme, kms,kme, &
23	i_start,i_end, j_start,j_end, kts,kte, num_tiles, &
24	u10, v10, th2, q2, &
25	u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
26	rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
27	u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
28	rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
29	ips,ipe,jps,jpe,kps,kpe, &
30	imsx,imex,jmsx,jmex,kmsx,kmex, &
31	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
32	imsy,imey,jmsy,jmey,kmsy,kmey, &
33	ipsy,ipey,jpsy,jpey,kpsy,kpey )
34	!------------------------------------------------------------------
35	USE module_configure
36	USE module_state_description
37	USE module_model_constants
38	USE module_domain, ONLY : domain
39
40	! *** add new modules of schemes here
41
42	USE module_fdda_psufddagd
43	USE module_fdda_spnudging
44
45	!------------------------------------------------------------------
46	IMPLICIT NONE
47	!======================================================================
48	! Grid structure in physics part of WRF
49	!----------------------------------------------------------------------
50	! The horizontal velocities used in the physics are unstaggered
51	! relative to temperature/moisture variables. All predicted
52	! variables are carried at half levels except w, which is at full
53	! levels. Some arrays with names (*8w) are at w (full) levels.
54	!
55	!----------------------------------------------------------------------
56	! In WRF, kms (smallest number) is the bottom level and kme (largest
57	! number) is the top level. In your scheme, if 1 is at the top level,
58	! then you have to reverse the order in the k direction.
59	!
60	! kme - half level (no data at this level)
61	! kme ----- full level
62	! kme-1 - half level
63	! kme-1 ----- full level
64	! .
65	! .
66	! .
67	! kms+2 - half level
68	! kms+2 ----- full level
69	! kms+1 - half level
70	! kms+1 ----- full level
71	! kms - half level
72	! kms ----- full level
73	!
74	!======================================================================
75	!-- RUNDGDTEN U tendency due to
76	! FDDA analysis nudging (m/s^2)
77	!-- RVNDGDTEN V tendency due to
78	! FDDA analysis nudging (m/s^2)
79	!-- RTHNDGDTEN Theta tendency due to
80	! FDDA analysis nudging (K/s)
81	!-- RPHNDGDTEN Geopotential tendency due to
82	! FDDA analysis nudging (m^2/s^3)
83	!-- RQVNDGDTEN Qv tendency due to
84	! FDDA analysis nudging (kg/kg/s)
85	!-- RMUNDGDTEN mu tendency due to
86	! FDDA analysis nudging (Pa/s)
87	!-- itimestep number of time steps
88	!-- u3d u-velocity staggered on u points (m/s)
89	!-- v3d v-velocity staggered on v points (m/s)
90	!-- th_phy potential temperature (K)
91	!-- moist moisture array (4D - last index is species) (kg/kg)
92	!-- p_phy pressure (Pa)
93	!-- pi_phy exner function (dimensionless)
94	!-- p8w pressure at full levels (Pa)
95	!-- t_phy temperature (K)
96	!-- dz8w dz between full levels (m)
97	!-- z height above sea level (m)
98	!-- config_flags
99	!-- DX horizontal space interval (m)
100	!-- DT time step (second)
101	!-- n_moist number of moisture species
102	!-- STEPFG number of timesteps per FDDA re-calculation
103	!-- KPBL k-index of PBL top
104	!-- ids start index for i in domain
105	!-- ide end index for i in domain
106	!-- jds start index for j in domain
107	!-- jde end index for j in domain
108	!-- kds start index for k in domain
109	!-- kde end index for k in domain
110	!-- ims start index for i in memory
111	!-- ime end index for i in memory
112	!-- jms start index for j in memory
113	!-- jme end index for j in memory
114	!-- kms start index for k in memory
115	!-- kme end index for k in memory
116	!-- jts start index for j in tile
117	!-- jte end index for j in tile
118	!-- kts start index for k in tile
119	!-- kte end index for k in tile
120	!
121	!******************************************************************
122	!------------------------------------------------------------------
123	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
124	TYPE(domain) , TARGET :: grid
125	!
126
127	INTEGER , INTENT(IN) :: id
128
129	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
130	ims,ime, jms,jme, kms,kme, &
131	kts,kte, num_tiles, &
132	ips,ipe,jps,jpe,kps,kpe, &
133	imsx,imex,jmsx,jmex,kmsx,kmex, &
134	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
135	imsy,imey,jmsy,jmey,kmsy,kmey, &
136	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
137	n_moist
138
139	INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
140	& i_start,i_end,j_start,j_end
141
142	INTEGER, INTENT(IN ) :: itimestep,STEPFG
143	!
144	REAL, INTENT(IN ) :: DT,DX,XTIME
145
146
147	!
148	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
149	INTENT(IN ) :: p_phy, &
150	pi_phy, &
151	p8w, &
152	rho, &
153	t_phy, &
154	u3d, &
155	v3d, &
156	ph, &
157	dz8w, &
158	z, &
159	z_at_w, &
160	th_phy
161	!
162	REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), &
163	INTENT(IN ) :: moist
164	!
165	!
166	!
167	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
168	INTENT(INOUT) :: RUNDGDTEN, &
169	RVNDGDTEN, &
170	RTHNDGDTEN, &
171	RPHNDGDTEN, &
172	RQVNDGDTEN
173
174	REAL, DIMENSION( ims:ime, jms:jme ), &
175	INTENT(INOUT) :: RMUNDGDTEN
176
177	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
178	INTENT(INOUT) :: u_ndg_old, &
179	v_ndg_old, &
180	t_ndg_old, &
181	ph_ndg_old,&
182	q_ndg_old, &
183	u_ndg_new, &
184	v_ndg_new, &
185	t_ndg_new, &
186	ph_ndg_new,&
187	q_ndg_new
188	REAL, DIMENSION( ims:ime, jms:jme ), &
189	INTENT(INOUT) :: mu_ndg_old, &
190	mu_ndg_new
191
192	!
193	REAL, DIMENSION( ims:ime , jms:jme ), &
194	INTENT(IN ) :: pblh, &
195	ht, &
196	znt
197
198	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) :: regime
199
200	REAL, DIMENSION( ims:ime, jms:jme ), &
201	INTENT(IN ) :: u10, &
202	v10, &
203	th2, &
204	q2
205
206	REAL, DIMENSION( ims:ime, jms:jme ), &
207	INTENT(IN) :: u10_ndg_old, &
208	v10_ndg_old, &
209	t2_ndg_old, &
210	th2_ndg_old, &
211	q2_ndg_old, &
212	rh_ndg_old, &
213	psl_ndg_old, &
214	ps_ndg_old, &
215	odis_ndg_old, &
216	u10_ndg_new, &
217	v10_ndg_new, &
218	t2_ndg_new, &
219	th2_ndg_new, &
220	q2_ndg_new, &
221	rh_ndg_new, &
222	psl_ndg_new, &
223	ps_ndg_new, &
224	odis_ndg_new
225
226	REAL, DIMENSION( ims:ime, jms:jme ), &
227	INTENT(IN) :: tob_ndg_old, &
228	tob_ndg_new
229
230	! LOCAL VAR
231
232	!
233	INTEGER :: i,J,K,NK,jj,ij
234	CHARACTER (LEN=256) :: message
235
236	!------------------------------------------------------------------
237	!
238	#if ! ( NMM_CORE == 1 )
239	if (config_flags%grid_fdda .eq. 0 .AND. config_flags%grid_sfdda .eq. 0) return
240
241	IF (itimestep == 1) THEN
242
243	IF( config_flags%grid_fdda .eq. 1 ) THEN
244	!$OMP PARALLEL DO &
245	!$OMP PRIVATE ( ij,i,j,k )
246	DO ij = 1 , num_tiles
247	DO j=j_start(ij),j_end(ij)
248	DO i=i_start(ij),i_end(ij)
249
250	DO k=kts,min(kte+1,kde)
251	u_ndg_old(i,k,j) = u3d(i,k,j)
252	v_ndg_old(i,k,j) = v3d(i,k,j)
253	t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
254	ph_ndg_old(i,k,j) = ph(i,k,j)
255	q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
256	ENDDO
257	mu_ndg_old(i,j) = 0.0
258
259	ENDDO
260	ENDDO
261
262	ENDDO
263
264	! IF( config_flags%grid_sfdda .eq. 1 ) THEN
265	! DO ij = 1 , num_tiles
266	! DO j=j_start(ij),j_end(ij)
267	! DO i=i_start(ij),i_end(ij)
268	! u10_ndg_old(i,j) = u10(i,j)
269	! v10_ndg_old(i,j) = v10(i,j)
270	! th2_ndg_old(i,j) = th2(i,j) - 300.0
271	! q2_ndg_old(i,j) = q2(i,j)
272	! ENDDO
273	! ENDDO
274
275	! ENDDO
276	! ENDIF
277	!$OMP END PARALLEL DO
278
279	ENDIF
280	ENDIF
281
282	!GMM if fgdtzero = 1, tendencies are zero in between calls
283
284	IF (mod(itimestep-1,STEPFG) .eq. 0 .and. config_flags%fgdtzero .eq. 1) THEN
285
286	!$OMP PARALLEL DO &
287	!$OMP PRIVATE ( ij,i,j,k )
288	DO ij = 1 , num_tiles
289	DO j=j_start(ij),j_end(ij)
290	DO i=i_start(ij),i_end(ij)
291
292	DO k=kts,min(kte+1,kde)
293	RTHNDGDTEN(I,K,J)=0.
294	RUNDGDTEN(I,K,J)=0.
295	RVNDGDTEN(I,K,J)=0.
296	RPHNDGDTEN(I,K,J)=0.
297	RQVNDGDTEN(I,K,J)=0.
298	ENDDO
299
300	RMUNDGDTEN(I,J)=0.
301
302	ENDDO
303	ENDDO
304
305	ENDDO
306	!$OMP END PARALLEL DO
307
308	ENDIF
309
310	IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
311
312	!$OMP PARALLEL DO &
313	!$OMP PRIVATE ( ij,i,j,k )
314	DO ij = 1 , num_tiles
315	DO j=j_start(ij),j_end(ij)
316	DO i=i_start(ij),i_end(ij)
317
318	DO k=kts,min(kte+1,kde)
319	RTHNDGDTEN(I,K,J)=0.
320	RUNDGDTEN(I,K,J)=0.
321	RVNDGDTEN(I,K,J)=0.
322	RPHNDGDTEN(I,K,J)=0.
323	RQVNDGDTEN(I,K,J)=0.
324	ENDDO
325
326	RMUNDGDTEN(I,J)=0.
327
328	ENDDO
329	ENDDO
330
331	ENDDO
332	!$OMP END PARALLEL DO
333
334	!
335	IF( config_flags%grid_fdda /= 0 ) THEN
336	fdda_select: SELECT CASE(config_flags%grid_fdda)
337
338	CASE (PSUFDDAGD)
339
340	!$OMP PARALLEL DO &
341	!$OMP PRIVATE ( ij, i,j,k )
342	DO ij = 1 , num_tiles
343	CALL wrf_debug(100,'in PSU FDDA scheme')
344
345	IF( config_flags%bl_pbl_physics /= 1 &
346	.AND. config_flags%bl_pbl_physics /= 5 &
347	.AND. config_flags%bl_pbl_physics /= 6 &
348	.AND. config_flags%bl_pbl_physics /= 7 &
349	.AND. config_flags%bl_pbl_physics /= 99 ) THEN
350	DO j=MAX(j_start(ij)-1,jds),j_end(ij)
351	DO i=MAX(i_start(ij)-1,ids),i_end(ij)
352	IF( pblh(i,j) > z_at_w(i,2,j)-ht(i,j) ) THEN
353	regime(i,j) = 4.0
354	ELSE
355	regime(i,j) = 1.0
356	ENDIF
357	ENDDO
358	ENDDO
359	ENDIF
360
361	CALL FDDAGD(itimestep,dx,dt,xtime, &
362	id, &
363	config_flags%auxinput10_interval_m, &
364	config_flags%auxinput10_end_h, &
365	config_flags%if_no_pbl_nudging_uv, &
366	config_flags%if_no_pbl_nudging_t, &
367	config_flags%if_no_pbl_nudging_q, &
368	config_flags%if_zfac_uv, &
369	config_flags%k_zfac_uv, &
370	config_flags%if_zfac_t, &
371	config_flags%k_zfac_t, &
372	config_flags%if_zfac_q, &
373	config_flags%k_zfac_q, &
374	config_flags%guv, &
375	config_flags%gt, config_flags%gq, &
376	config_flags%if_ramping, config_flags%dtramp_min, &
377	config_flags%grid_sfdda, &
378	config_flags%auxinput9_interval_m, &
379	config_flags%auxinput9_end_h, &
380	config_flags%guv_sfc, &
381	config_flags%gt_sfc, config_flags%gq_sfc, config_flags%rinblw, &
382	u3d,v3d,th_phy,t_phy, &
383	moist(ims,kms,jms,P_QV), &
384	p_phy,pi_phy, &
385	u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old, &
386	u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new, &
387	u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
388	rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
389	u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
390	rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
391	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
392	pblh, ht, regime, znt, z, z_at_w, &
393	ids,ide, jds,jde, kds,kde, &
394	ims,ime, jms,jme, kms,kme, &
395	i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte )
396
397	ENDDO
398	!$OMP END PARALLEL DO
399
400	CASE (SPNUDGING)
401	CALL wrf_debug(100,'in SPECTRAL NUDGING scheme')
402	CALL SPECTRAL_NUDGING(grid,itimestep,dt,xtime, &
403	id, &
404	config_flags%auxinput10_interval_m, &
405	config_flags%auxinput10_end_h, &
406	config_flags%if_no_pbl_nudging_uv, &
407	config_flags%if_no_pbl_nudging_t, &
408	config_flags%if_no_pbl_nudging_ph, &
409	config_flags%if_zfac_uv, &
410	config_flags%k_zfac_uv, &
411	config_flags%dk_zfac_uv, &
412	config_flags%if_zfac_t, &
413	config_flags%k_zfac_t, &
414	config_flags%dk_zfac_t, &
415	config_flags%if_zfac_ph, &
416	config_flags%k_zfac_ph, &
417	config_flags%dk_zfac_ph, &
418	config_flags%guv, &
419	config_flags%gt, &
420	config_flags%gph, &
421	config_flags%if_ramping, config_flags%dtramp_min, &
422	config_flags%xwavenum, config_flags%ywavenum, &
423	u3d,v3d,th_phy,ph, &
424	u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old, &
425	u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new, &
426	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN,&
427	pblh, ht, z, z_at_w, &
428	ids,ide, jds,jde, kds,kde, &
429	ims,ime, jms,jme, kms,kme, &
430	i_start,i_end,j_start,j_end,kts,kte, num_tiles, &
431	ips,ipe,jps,jpe,kps,kpe, &
432	imsx,imex,jmsx,jmex,kmsx,kmex, &
433	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
434	imsy,imey,jmsy,jmey,kmsy,kmey, &
435	ipsy,ipey,jpsy,jpey,kpsy,kpey )
436
437
438	CASE DEFAULT
439
440	WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
441	CALL wrf_error_fatal ( wrf_err_message )
442
443	END SELECT fdda_select
444	ENDIF
445
446	ENDIF
447
448	#endif
449	!
450	END SUBROUTINE fddagd_driver
451	END MODULE module_fddagd_driver

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

Download in other formats:

Original Format