Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_cumulus_driver.F @ 354

Last change on this file since 354 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: 44.2 KB

Line
1	!WRF:MEDIATION_LAYER:PHYSICS
2	!
3
4	MODULE module_cumulus_driver
5	CONTAINS
6	SUBROUTINE cumulus_driver(grid &
7	! Order dependent args for domain, mem, and tile dims
8	,ids,ide, jds,jde, kds,kde &
9	,ims,ime, jms,jme, kms,kme &
10	,ips,ipe, jps,jpe, kps,kpe &
11	,i_start,i_end,j_start,j_end,kts,kte,num_tiles &
12	! Order independent args (use VAR= in call)
13	! --Prognostic
14	,u,v,th,t,w &
15	,p,pi,rho &
16	! --Other arguments
17	,itimestep,dt,dx,cudt,curr_secs,adapt_step_flag &
18	,rainc,raincv,pratec,nca &
19	,z,z_at_w,dz8w,mavail,pblh,p8w,psfc,tsk &
20	,tke_pbl, ust &
21	,forcet,forceq,w0avg,stepcu,gsw &
22	,cldefi,lowlyr,xland,cu_act_flag,warm_rain &
23	,hfx,qfx,cldfra,tpert2d,htop,hbot,kpbl,ht&
24	,ensdim,maxiens,maxens,maxens2,maxens3 &
25	,periodic_x,periodic_y &
26	! Package selection variables
27	,cu_physics, bl_pbl_physics, sf_sfclay_physics &
28	! Optional moisture tracers
29	,qv_curr, qc_curr, qr_curr &
30	,qi_curr, qs_curr, qg_curr &
31	,qv_prev, qc_prev, qr_prev &
32	,qi_prev, qs_prev, qg_prev &
33	! Optional arguments for GD scheme
34	,apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma &
35	,apr_capme,apr_capmi,edt_out,clos_choice &
36	,mass_flux,xf_ens,pr_ens,cugd_avedx,imomentum &
37	,ishallow,cugd_tten,cugd_qvten,cugd_qcten &
38	,cugd_ttens,cugd_qvtens &
39	,gd_cloud,gd_cloud2 &
40	! Optional output arguments for CAMZM scheme
41	,cape, zmmu, zmmd, zmdt, zmdq, dlf, rliq &
42	,pconvb, pconvt &
43	,evaptzm, fzsntzm, evsntzm, evapqzm, zmflxprc &
44	,zmflxsnw, zmntprpd, zmntsnpd, zmeiheat &
45	,cmfmc, cmfmcdzm, preccdzm, precz &
46	,zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu, zmvpgd &
47	,zmicuu, zmicud, zmicvu, zmicvd, zmdice, zmdliq &
48	,k22_shallow,kbcon_shallow,ktop_shallow,xmb_shallow &
49	! Optional arguments for NSAS scheme
50	,mp_physics &
51	! Optional moisture and other tendencies
52	,rqvcuten,rqccuten,rqrcuten &
53	,rqicuten,rqscuten,rqgcuten &
54	,rqvblten,rqvften &
55	,rucuten,rvcuten &
56	,rthcuten,rthraten,rthblten,rthften &
57	#if (NMM_CORE==1)
58	! for hwrf-sas --- 3.2 CLEANUP TODO -- THESE SHOULD BE OPTIONAL, NOT #IF/#ENDIF
59	,mommix,store_rand &
60	#endif
61	! Optional variables for tiedtke scheme - add by ZCX&YQW
62	,znu &
63	! Optional moisture tracer flags
64	,f_qv,f_qc,f_qr &
65	,f_qi,f_qs,f_qg &
66	,CFU1,CFD1,DFU1,EFU1,DFD1,EFD1,f_flux &
67	! Optional trigger function activation variable
68	,kfeta_trigger &
69	#if ( WRF_DFI_RADAR == 1 )
70	! Optional CAP suppress option --- 3.2 CLEANUP TODO -- THESE SHOULD BE OPTIONAL, NOT #IF/#ENDIF
71	,do_capsuppress &
72	#endif
73	)
74	!----------------------------------------------------------------------
75	USE module_model_constants
76	USE module_state_description, ONLY: KFSCHEME,BMJSCHEME &
77	,KFETASCHEME,GDSCHEME &
78	,G3SCHEME &
79	,P_QC,P_QI,Param_FIRST_SCALAR &
80	,CAMZMSCHEME, SASSCHEME &
81	,NSASSCHEME &
82	,TIEDTKESCHEME
83
84	! *** add new modules of schemes here
85
86	USE module_cu_kf , ONLY : kfcps
87	USE module_cu_bmj , ONLY : bmjdrv
88	#ifdef DM_PARALLEL
89	USE module_dm , ONLY : ntasks_x,ntasks_y,local_communicator,mytask,ntasks
90	# if (EM_CORE == 1)
91	USE module_comm_dm , ONLY : halo_cup_g3_in_sub, halo_cup_g3_out_sub
92	# endif
93	#endif
94	USE module_domain , ONLY: domain
95	USE module_cu_kfeta , ONLY : kf_eta_cps
96	USE module_cu_gd , ONLY : grelldrv
97	USE module_cu_g3 , ONLY : g3drv,conv_grell_spread3d
98	USE module_cu_sas
99	USE module_cu_camzm_driver, ONLY : camzm_driver
100	USE module_cu_tiedtke, ONLY : cu_tiedtke
101	USE module_cu_nsas , ONLY : cu_nsas
102	USE module_wrf_error , ONLY : wrf_err_message
103
104	! This driver calls subroutines for the cumulus parameterizations.
105	!
106	! 1. Kain & Fritsch (1993)
107	! 2. Betts-Miller-Janjic (Janjic, 1994)
108	! 3. Grell-Devenyi (Grell and Devenyi, 2002)
109	! 4. Simplified Arakawa-Schubert scheme (NCEP)
110	! (adapted by Zhang and Wang to work with ARW in V3.3)
111	! 5. Grell 3D ensemble scheme
112	! 6. Modified Tiedtke scheme (Zhang and Wang 2010)
113	! 14. New simplified Arakawa-Schubert scheme (NCEP, YSU)
114	!
115	!----------------------------------------------------------------------
116	IMPLICIT NONE
117	!======================================================================
118	! Grid structure in physics part of WRF
119	!----------------------------------------------------------------------
120	! The horizontal velocities used in the physics are unstaggered
121	! relative to temperature/moisture variables. All predicted
122	! variables are carried at half levels except w, which is at full
123	! levels. Some arrays with names (*8w) are at w (full) levels.
124	!
125	!----------------------------------------------------------------------
126	! In WRF, kms (smallest number) is the bottom level and kme (largest
127	! number) is the top level. In your scheme, if 1 is at the top level,
128	! then you have to reverse the order in the k direction.
129	!
130	! kme - half level (no data at this level)
131	! kme ----- full level
132	! kme-1 - half level
133	! kme-1 ----- full level
134	! .
135	! .
136	! .
137	! kms+2 - half level
138	! kms+2 ----- full level
139	! kms+1 - half level
140	! kms+1 ----- full level
141	! kms - half level
142	! kms ----- full level
143	!
144	!======================================================================
145	! Definitions
146	!-----------
147	! Rho_d dry density (kg/m^3)
148	! Theta_m moist potential temperature (K)
149	! Qv water vapor mixing ratio (kg/kg)
150	! Qc cloud water mixing ratio (kg/kg)
151	! Qr rain water mixing ratio (kg/kg)
152	! Qi cloud ice mixing ratio (kg/kg)
153	! Qs snow mixing ratio (kg/kg)
154	!-----------------------------------------------------------------
155	!-- DT time step (second)
156	!-- CUDT cumulus time step (minute)
157	!-- curr_secs current forecast time (seconds)
158	!-- itimestep number of time step (integer)
159	!-- DX horizontal space interval (m)
160	!-- rr dry air density (kg/m^3)
161	!
162	!-- RUCUTEN Zonal wind tendency due to
163	! cumulus scheme precipitation (m/s/s)
164	!-- RVCUTEN Meridional wind tendency due to
165	! cumulus scheme precipitation (m/s/s)
166	!-- RTHCUTEN Theta tendency due to
167	! cumulus scheme precipitation (K/s)
168	!-- RQVCUTEN Qv tendency due to
169	! cumulus scheme precipitation (kg/kg/s)
170	!-- RQRCUTEN Qr tendency due to
171	! cumulus scheme precipitation (kg/kg/s)
172	!-- RQCCUTEN Qc tendency due to
173	! cumulus scheme precipitation (kg/kg/s)
174	!-- RQSCUTEN Qs tendency due to
175	! cumulus scheme precipitation (kg/kg/s)
176	!-- RQICUTEN Qi tendency due to
177	! cumulus scheme precipitation (kg/kg/s)
178	!
179	!-- RAINC accumulated total cumulus scheme precipitation (mm)
180	!-- RAINCV time-step cumulus scheme precipitation (mm)
181	!-- PRATEC precipitiation rate from cumulus scheme (mm/s)
182	!-- NCA counter of the cloud relaxation
183	! time in KF cumulus scheme (integer)
184	!-- u_phy u-velocity interpolated to theta points (m/s)
185	!-- v_phy v-velocity interpolated to theta points (m/s)
186	!-- th_phy potential temperature (K)
187	!-- t_phy temperature (K)
188	!-- tsk skin temperature (K)
189	!-- tke_pbl turbulent kinetic energy from PBL scheme (m2/s2)
190	!-- ust u* in similarity theory (m/s)
191	!-- w vertical velocity (m/s)
192	!-- moist moisture array (4D - last index is species) (kg/kg)
193	!-- z height above sea level at middle of layers (m)
194	!-- z_at_w height above sea level at layer interfaces (m)
195	!-- dz8w dz between full levels (m)
196	!-- pblh planetary boundary layer height (m)
197	!-- mavail soil moisture availability
198	!-- p8w pressure at full levels (Pa)
199	!-- psfc surface pressure (Pa)
200	!-- p_phy pressure (Pa)
201	!-- pi_phy exner function (dimensionless)
202	! points (dimensionless)
203	!-- hfx upward heat flux at surface (W/m2)
204	!-- qfx upward moisture flux at surface (kg/m2/s)
205	!-- RTHRATEN radiative temp forcing for Grell-Devenyi scheme
206	!-- RTHBLTEN PBL temp forcing for Grell-Devenyi scheme
207	!-- RQVBLTEN PBL moisture forcing for Grell-Devenyi scheme
208	!-- RTHFTEN
209	!-- RQVFTEN
210	!-- MASS_FLUX
211	!-- XF_ENS
212	!-- PR_ENS
213	!-- warm_rain
214	!-- cldfra cloud fraction
215	!-- CU_ACT_FLAG
216	!-- W0AVG average vertical velocity, (for KF scheme) (m/s)
217	!-- kfeta_trigger namelist for KF trigger (=1, default; =2, moisture-advection-dependent trigger)
218	!-- rho density (kg/m^3)
219	!-- CLDEFI precipitation efficiency (for BMJ scheme) (dimensionless)
220	!-- STEPCU # of fundamental timesteps between convection calls
221	!-- XLAND land-sea mask (1.0 for land; 2.0 for water)
222	!-- LOWLYR index of lowest model layer above the ground
223	!-- XLV0 latent heat of vaporization constant
224	! used in temperature dependent formula (J/kg)
225	!-- XLV1 latent heat of vaporization constant
226	! used in temperature dependent formula (J/kg/K)
227	!-- XLS0 latent heat of sublimation constant
228	! used in temperature dependent formula (J/kg)
229	!-- XLS1 latent heat of sublimation constant
230	! used in temperature dependent formula (J/kg/K)
231	!-- R_d gas constant for dry air ( 287. J/kg/K)
232	!-- R_v gas constant for water vapor (461 J/k/kg)
233	!-- Cp specific heat at constant pressure (1004 J/k/kg)
234	!-- rvovrd R_v divided by R_d (dimensionless)
235	!-- G acceleration due to gravity (m/s^2)
236	!-- EP_1 constant for virtual temperature
237	! (R_v/R_d - 1) (dimensionless)
238	!-- pi_phy the exner function, (p/p0)**(R/Cp) (none unit)
239	!-- ids start index for i in domain
240	!-- ide end index for i in domain
241	!-- jds start index for j in domain
242	!-- jde end index for j in domain
243	!-- kds start index for k in domain
244	!-- kde end index for k in domain
245	!-- ims start index for i in memory
246	!-- ime end index for i in memory
247	!-- jms start index for j in memory
248	!-- jme end index for j in memory
249	!-- kms start index for k in memory
250	!-- kme end index for k in memory
251	!-- i_start start indices for i in tile
252	!-- i_end end indices for i in tile
253	!-- j_start start indices for j in tile
254	!-- j_end end indices for j in tile
255	!-- kts start index for k in tile
256	!-- kte end index for k in tile
257	!-- num_tiles number of tiles
258	!-- HBOT index of lowest model layer with convection
259	!-- HTOP index of highest model layer with convection
260	!-- LBOT index of lowest model layer with convection
261	!-- LTOP index of highest model layer with convection
262	!-- KPBL layer index of the PBL
263	!-- periodic_x T/F this is using periodic lateral boundaries in the X direction
264	!-- periodic_y T/F this is using periodic lateral boundaries in the Y-direction
265	!
266	!======================================================================
267
268	INTEGER, INTENT(IN ) :: &
269	ids,ide, jds,jde, kds,kde, &
270	ims,ime, jms,jme, kms,kme, &
271	kts,kte, &
272	itimestep, num_tiles
273	LOGICAL periodic_x, periodic_y
274	TYPE(domain) , INTENT(INOUT) :: grid
275	INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
276	& i_start,i_end,j_start,j_end
277
278	INTEGER, INTENT(IN ) :: &
279	ensdim,maxiens,maxens,maxens2,maxens3
280
281	INTEGER, OPTIONAL, INTENT(IN ) :: &
282	cugd_avedx,clos_choice,bl_pbl_physics,sf_sfclay_physics
283
284	INTEGER, INTENT(IN ) :: cu_physics
285	INTEGER, INTENT(IN ) :: STEPCU
286	LOGICAL, INTENT(IN ) :: warm_rain
287
288	INTEGER,DIMENSION( ims:ime, jms:jme ), &
289	INTENT(IN ) :: LOWLYR
290
291	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
292	INTENT(IN ) :: &
293	z &
294	, dz8w &
295	, p8w &
296	, p &
297	, pi &
298	, u &
299	, v &
300	, th &
301	, t &
302	, rho &
303	, w
304
305	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
306	INTENT(IN ),OPTIONAL :: z_at_w &
307	, cldfra &
308	, tke_pbl
309
310	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
311	INTENT(INOUT) :: &
312	W0AVG
313
314	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: &
315	GSW,HT,XLAND
316
317	REAL, DIMENSION( ims:ime , jms:jme ), &
318	INTENT(INOUT) :: RAINC &
319	, RAINCV &
320	, NCA &
321	, HTOP &
322	, HBOT &
323	, CLDEFI
324
325	REAL, DIMENSION( kms:kme ), OPTIONAL, INTENT(IN ) :: &
326	znu
327
328	REAL, DIMENSION( ims:ime , jms:jme ),INTENT(INOUT),OPTIONAL :: &
329	PRATEC,MAVAIL,PBLH,PSFC,TSK,TPERT2D,UST,HFX,QFX
330	REAL, DIMENSION( ims:ime , jms:jme ) :: tmppratec
331
332	INTEGER, DIMENSION( ims:ime , jms:jme ), &
333	INTENT(IN) :: KPBL
334
335	LOGICAL, DIMENSION( ims:ime , jms:jme ), &
336	INTENT(INOUT) :: CU_ACT_FLAG
337
338	INTEGER, INTENT(IN ), OPTIONAL :: kfeta_trigger
339
340	REAL, INTENT(IN ) :: DT, DX
341	INTEGER, INTENT(IN ),OPTIONAL :: &
342	ips,ipe, jps,jpe, kps,kpe,imomentum,ishallow
343	REAL, INTENT(IN ),OPTIONAL :: CUDT
344	REAL, INTENT(IN ),OPTIONAL :: CURR_SECS
345	LOGICAL,INTENT(IN ),OPTIONAL :: adapt_step_flag
346	REAL :: cudt_pass, curr_secs_pass
347	LOGICAL :: adapt_step_flag_pass
348
349	INTEGER, INTENT(IN ), OPTIONAL :: mp_physics
350	#if (NMM_CORE==1)
351	REAL, DIMENSION( ims:ime , jms:jme ), &
352	INTENT(IN) :: STORE_RAND
353	REAL, INTENT(INOUT) :: mommix
354	#endif
355
356	REAL, DIMENSION( ims:ime, jms:jme, kms:kme ), &
357	INTENT(INOUT) :: rucuten,rvcuten
358	!
359	! optional arguments
360	!
361	INTEGER, DIMENSION( ims:ime, jms:jme ), &
362	OPTIONAL, INTENT(INOUT) :: &
363	k22_shallow,kbcon_shallow,ktop_shallow
364	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
365	OPTIONAL, INTENT(INOUT) :: &
366	! optional moisture tracers
367	! 2 time levels; if only one then use CURR
368	qv_curr, qc_curr, qr_curr &
369	,qi_curr, qs_curr, qg_curr &
370	,qv_prev, qc_prev, qr_prev &
371	,qi_prev, qs_prev, qg_prev &
372	! optional moisture and other tendencies
373	,rqvcuten,rqccuten,rqrcuten &
374	,rqicuten,rqscuten,rqgcuten &
375	,rqvblten,rqvften &
376	,rthraten,rthblten &
377	,cugd_tten,cugd_qvten,cugd_qcten &
378	,cugd_ttens,cugd_qvtens &
379	,forcet, forceq &
380	,rthften,rthcuten
381
382	REAL, DIMENSION( ims:ime , jms:jme ), &
383	OPTIONAL, &
384	INTENT(INOUT) :: &
385	apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma &
386	,apr_capme,apr_capmi,edt_out,xmb_shallow &
387	, MASS_FLUX &
388	,cape, pconvb, pconvt, preccdzm, precz, rliq
389	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
390	OPTIONAL, INTENT(INOUT) :: &
391	GD_CLOUD,GD_CLOUD2, &
392	zmmd, zmmu, zmdt, zmdq, dlf, &
393	evaptzm, fzsntzm, evsntzm, evapqzm, zmflxprc, &
394	zmflxsnw, zmntprpd, zmntsnpd, zmeiheat, &
395	cmfmc, cmfmcdzm, &
396	zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu, zmvpgd, &
397	zmicuu, zmicud, zmicvu, zmicvd, zmdice, zmdliq
398	REAL, DIMENSION( ims:ime , jms:jme , 1:ensdim ), &
399	OPTIONAL, &
400	INTENT(INOUT) :: XF_ENS, PR_ENS
401	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
402	OPTIONAL, &
403	INTENT(INOUT) :: &
404	CFU1, &
405	CFD1, &
406	DFU1, &
407	EFU1, &
408	DFD1, &
409	EFD1
410
411	!
412	! Flags relating to the optional tendency arrays declared above
413	! Models that carry the optional tendencies will provdide the
414	! optional arguments at compile time; these flags all the model
415	! to determine at run-time whether a particular tracer is in
416	! use or not.
417	!
418	LOGICAL, INTENT(IN), OPTIONAL :: &
419	f_qv &
420	,f_qc &
421	,f_qr &
422	,f_qi &
423	,f_qs &
424	,f_qg
425	LOGICAL, INTENT(IN), OPTIONAL :: f_flux
426
427	#if ( WRF_DFI_RADAR == 1 )
428	!
429	! option of cap suppress:
430	! do_capsuppress = 1 do
431	! do_capsuppress = other don't
432	!
433	!
434	INTEGER, INTENT(IN ) ,OPTIONAL :: do_capsuppress
435	REAL, DIMENSION( ims:ime, jms:jme ) :: cap_suppress_loc
436	#endif
437
438	! LOCAL VAR
439
440	INTEGER :: i,j,k,its,ite,jts,jte,ij,trigger_kf
441	logical :: l_flux
442
443	!-----------------------------------------------------------------
444
445	l_flux=.FALSE.
446	if (present(f_flux)) l_flux=f_flux
447	if (.not. PRESENT(CURR_SECS)) then
448	curr_secs_pass = -1
449	else
450	curr_secs_pass = curr_secs
451	endif
452
453	if (.not. PRESENT(CUDT)) then
454	cudt_pass = -1
455	else
456	cudt_pass = cudt
457	endif
458
459	if (.not. PRESENT(adapt_step_flag)) then
460	adapt_step_flag_pass = .false.
461	else
462	adapt_step_flag_pass = adapt_step_flag
463	endif
464
465	! Initialize tmppratec to pratec
466
467	if ( PRESENT ( pratec ) ) then
468	tmppratec(:,:) = pratec(:,:)
469	else
470	tmppratec(:,:) = 0.
471	end if
472
473	if (.not. PRESENT(kfeta_trigger)) then
474	trigger_kf = 1
475	else
476	trigger_kf = kfeta_trigger
477	endif
478
479	IF (cu_physics .eq. 0) return
480
481	#if ( EM_CORE == 1 )
482	if(cu_physics .eq. 5 ) then
483	!$OMP PARALLEL DO &
484	!$OMP PRIVATE ( ij,i,j,k,its,ite,jts,jte )
485
486	DO ij = 1 , num_tiles
487	its = i_start(ij)
488	ite = i_end(ij)
489	jts = j_start(ij)
490	jte = j_end(ij)
491	do j=jts,min(jte,jde-1)
492	do k=kts,kte
493	do i=its,min(ite,ide-1)
494	RTHFTEN(i,k,j)=(RTHFTEN(i,k,j)+RTHRATEN(i,k,j) &
495	+RTHBLTEN(i,k,j))*pi(i,k,j)
496	RQVFTEN(i,k,j)=RQVFTEN(i,k,j)+RQVBLTEN(i,k,j)
497	enddo
498	enddo
499	enddo
500	ENDDO
501	!$OMP END PARALLEL DO
502	endif
503
504	IF ( cu_physics == G3SCHEME .OR. cu_physics == KFETASCHEME ) THEN
505	#ifdef DM_PARALLEL
506	#include "HALO_CUP_G3_IN.inc"
507	#endif
508	ENDIF
509	#endif
510
511	! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD.
512	! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME
513
514	! SET START AND END POINTS FOR TILES
515	!$OMP PARALLEL DO &
516	!$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
517
518	DO ij = 1 , num_tiles
519	its = i_start(ij)
520	ite = i_end(ij)
521	jts = j_start(ij)
522	jte = j_end(ij)
523
524
525	cps_select: SELECT CASE(cu_physics)
526
527	CASE (KFSCHEME)
528	CALL wrf_debug(100,'in kfcps')
529
530	CALL KFCPS( &
531	! order independent arguments
532	DT=dt ,KTAU=itimestep ,DX=dx , CUDT=cudt_pass &
533	,CURR_SECS=curr_secs_pass &
534	,ADAPT_STEP_FLAG=adapt_step_flag_pass &
535	,RHO=rho &
536	,U=u ,V=v ,TH=th ,T=t ,W=w &
537	,PCPS=p ,PI=pi &
538	,XLV0=xlv0 ,XLV1=xlv1 ,XLS0=xls0 ,XLS1=xls1 &
539	,RAINCV=raincv, PRATEC=tmppratec, NCA=nca &
540	,DZ8W=dz8w &
541	,W0AVG=w0avg &
542	,CP=cp ,R=r_d ,G=g ,EP1=ep_1 ,EP2=ep_2 &
543	,SVP1=svp1 ,SVP2=svp2 ,SVP3=svp3 ,SVPT0=svpt0 &
544	,STEPCU=stepcu &
545	,CU_ACT_FLAG=cu_act_flag &
546	,WARM_RAIN=warm_rain &
547	,QV=qv_curr &
548	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
549	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
550	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
551	! optionals
552	,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten &
553	,RQCCUTEN=rqccuten ,RQRCUTEN=rqrcuten &
554	,RQICUTEN=rqicuten ,RQSCUTEN=rqscuten &
555	,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr &
556	,F_QI=f_qi,F_QS=f_qs &
557	)
558
559	CASE (BMJSCHEME)
560	CALL wrf_debug(100,'in bmj_cps')
561	CALL BMJDRV( &
562	TH=th,T=T ,RAINCV=raincv, PRATEC=tmppratec &
563	,RHO=rho &
564	,DT=dt ,ITIMESTEP=itimestep ,STEPCU=stepcu &
565	,CUDT=cudt_pass &
566	,CURR_SECS=curr_secs_pass &
567	,ADAPT_STEP_FLAG=adapt_step_flag_pass &
568	,CUTOP=htop, CUBOT=hbot, KPBL=kpbl &
569	,DZ8W=dz8w ,PINT=p8w, PMID=p, PI=pi &
570	,CP=cp ,R=r_d ,ELWV=xlv ,ELIV=xls ,G=g &
571	,TFRZ=svpt0 ,D608=ep_1 ,CLDEFI=cldefi &
572	,LOWLYR=lowlyr ,XLAND=xland &
573	,CU_ACT_FLAG=cu_act_flag &
574	,QV=qv_curr &
575	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
576	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
577	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
578	! optionals
579	,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten &
580	)
581
582	CASE (KFETASCHEME)
583	CALL wrf_debug(100,'in kf_eta_cps')
584	CALL KF_ETA_CPS( &
585	U=u ,V=v ,TH=th ,T=t ,W=w ,RHO=rho &
586	,CUDT=cudt_pass &
587	,CURR_SECS=curr_secs_pass &
588	,ADAPT_STEP_FLAG=adapt_step_flag_pass &
589	,RAINCV=raincv, PRATEC=tmppratec, NCA=nca &
590	,DZ8W=dz8w &
591	,PCPS=p, PI=pi ,W0AVG=W0AVG &
592	,CUTOP=HTOP,CUBOT=HBOT &
593	,XLV0=XLV0 ,XLV1=XLV1 ,XLS0=XLS0 ,XLS1=XLS1 &
594	,CP=CP ,R=R_d ,G=G ,EP1=EP_1 ,EP2=EP_2 &
595	,SVP1=SVP1 ,SVP2=SVP2 ,SVP3=SVP3 ,SVPT0=SVPT0 &
596	,DT=dt ,KTAU=itimestep ,DX=dx &
597	,STEPCU=stepcu &
598	,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=warm_rain &
599	,QV=qv_curr &
600	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
601	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
602	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
603	,trigger=trigger_kf &
604	! optionals
605	,RTHCUTEN=rthcuten &
606	,RQVCUTEN=rqvcuten ,RQCCUTEN=rqccuten &
607	,RQRCUTEN=rqrcuten ,RQICUTEN=rqicuten &
608	,RQSCUTEN=rqscuten, RQVFTEN=RQVFTEN &
609	,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr &
610	,F_QI=f_qi,F_QS=f_qs &
611	)
612
613	CASE (GDSCHEME)
614	CALL wrf_debug(100,'in grelldrv')
615	CALL GRELLDRV( &
616	DT=dt, ITIMESTEP=itimestep, DX=dx &
617	,U=u,V=v,T=t,W=w ,RHO=rho &
618	,P=p,PI=pi ,Q=qv_curr ,RAINCV=raincv &
619	,DZ8W=dz8w,P8W=p8w,XLV=xlv,CP=cp,G=g,R_V=r_v &
620	,PRATEC=tmppratec &
621	,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc &
622	,APR_ST=apr_st,APR_AS=apr_as &
623	,APR_CAPMA=apr_capma,APR_CAPME=apr_capme &
624	,APR_CAPMI=apr_capmi,MASS_FLUX=mass_flux &
625	,XF_ENS=xf_ens,PR_ENS=pr_ens,HT=ht &
626	,xland=xland,gsw=gsw &
627	,GDC=gd_cloud,GDC2=gd_cloud2 &
628	,ENSDIM=ensdim,MAXIENS=maxiens,MAXENS=maxens &
629	,MAXENS2=maxens2,MAXENS3=maxens3 &
630	,STEPCU=STEPCU,htop=htop,hbot=hbot &
631	,CU_ACT_FLAG=CU_ACT_FLAG,warm_rain=warm_rain &
632	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
633	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
634	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
635	,PERIODIC_X=periodic_x,PERIODIC_Y=periodic_y &
636	! optionals
637	#if (NMM_CORE == 1 )
638	,RTHCUTEN=RTHCUTEN ,RTHFTEN=forcet &
639	,RQICUTEN=RQICUTEN ,RQVFTEN=forceq &
640	#else
641	,RTHCUTEN=RTHCUTEN ,RTHFTEN=RTHFTEN &
642	,RQICUTEN=RQICUTEN ,RQVFTEN=RQVFTEN &
643	#endif
644	,RTHRATEN=RTHRATEN,RTHBLTEN=RTHBLTEN &
645	,RQVCUTEN=RQVCUTEN,RQCCUTEN=RQCCUTEN &
646	,RQVBLTEN=RQVBLTEN &
647	,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr &
648	,F_QI=f_qi,F_QS=f_qs &
649	,CFU1=CFU1,CFD1=CFD1,DFU1=DFU1,EFU1=EFU1 &
650	,DFD1=DFD1,EFD1=EFD1,f_flux=l_flux )
651	CALL wrf_debug(200,'back from grelldrv')
652
653	CASE (SASSCHEME)
654
655	IF ( adapt_step_flag_pass ) THEN
656	WRITE( wrf_err_message , * ) 'The SAS cumulus option will not work properly with an adaptive time step'
657	CALL wrf_error_fatal ( wrf_err_message )
658	END IF
659	CALL wrf_debug(100,'in cu_sas')
660	CALL CU_SAS( &
661	DT=dt,ITIMESTEP=itimestep,STEPCU=STEPCU &
662	,RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN &
663	,RQCCUTEN=RQCCUTEN,RQICUTEN=RQICUTEN &
664	,RUCUTEN=RUCUTEN, RVCUTEN=RVCUTEN &
665	,RAINCV=RAINCV,PRATEC=tmpPRATEC,HTOP=HTOP,HBOT=HBOT &
666	,U3D=u,V3D=v,W=w,T3D=t &
667	,QV3D=QV_CURR,QC3D=QC_CURR,QI3D=QI_CURR &
668	,PI3D=pi,RHO3D=rho &
669	,DZ8W=dz8w,PCPS=p,P8W=p8w,XLAND=XLAND &
670	,CU_ACT_FLAG=CU_ACT_FLAG &
671	,P_QC=p_qc &
672	#if (NMM_CORE==1)
673	,store_rand=store_rand &
674	,MOMMIX=MOMMIX &
675	#endif
676	,P_QI=p_qi,P_FIRST_SCALAR=param_first_scalar &
677	,CUDT=cudt_pass &
678	,CURR_SECS=curr_secs_pass &
679	,ADAPT_STEP_FLAG=adapt_step_flag_pass &
680	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
681	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
682	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
683	)
684	CASE (G3SCHEME)
685	CALL wrf_debug(100,'in grelldrv')
686	#if ( WRF_DFI_RADAR == 1 )
687	if (do_capsuppress == 1) then
688	WRITE( wrf_err_message , * ) 'G3 do CAP suppress',its,jts,min( jte,jde-1 ),min( ite,ide-1 ),kte
689	CALL wrf_debug(200, wrf_err_message)
690	DO j = jts, min( jte,jde-1 )
691	DO i = its, min( ite,ide-1 )
692	cap_suppress_loc(i,j) = grid%dfi_tten_rad(i,kte,j)
693	ENDDO
694	ENDDO
695	endif
696	#endif
697	CALL G3DRV( &
698	DT=dt, ITIMESTEP=itimestep, DX=dx &
699	,U=u,V=v,T=t,W=w ,RHO=rho &
700	,P=p,PI=pi,Q=qv_curr,RAINCV=raincv &
701	,DZ8W=dz8w ,P8W=p8w,XLV=xlv,CP=cp,G=g,R_V=r_v &
702	,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc &
703	,APR_ST=apr_st,APR_AS=apr_as,PRATEC=tmppratec &
704	,APR_CAPMA=apr_capma,APR_CAPME=apr_capme &
705	,APR_CAPMI=apr_capmi,MASS_FLUX=mass_flux &
706	,XF_ENS=xf_ens,PR_ENS=pr_ens,HT=ht &
707	,xland=xland,gsw=gsw,edt_out=edt_out &
708	,GDC=gd_cloud,GDC2=gd_cloud2,kpbl=kpbl &
709	,k22_shallow=k22_shallow &
710	,kbcon_shallow=kbcon_shallow &
711	,ktop_shallow=ktop_shallow &
712	,xmb_shallow=xmb_shallow &
713	,cugd_tten=cugd_tten,cugd_qvten=cugd_qvten &
714	,cugd_ttens=cugd_ttens,cugd_qvtens=cugd_qvtens &
715	,cugd_qcten=cugd_qcten,cugd_avedx=cugd_avedx &
716	,imomentum=imomentum,ishallow_g3=ishallow &
717	,ENSDIM=ensdim,MAXIENS=maxiens,MAXENS=maxens &
718	,MAXENS2=maxens2,MAXENS3=maxens3,ichoice=clos_choice &
719	,STEPCU=STEPCU,htop=htop,hbot=hbot &
720	,CU_ACT_FLAG=CU_ACT_FLAG,warm_rain=warm_rain &
721	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
722	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
723	,IPS=ips,IPE=ipe,JPS=jps,JPE=jpe,KPS=kps,KPE=kpe &
724	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
725	,PERIODIC_X=periodic_x,PERIODIC_Y=periodic_y &
726	! optionals
727	#if (NMM_CORE == 1 )
728	,RTHCUTEN=RTHCUTEN ,RTHFTEN=forcet &
729	,RQICUTEN=RQICUTEN ,RQVFTEN=forceq &
730	#else
731	,RTHCUTEN=RTHCUTEN ,RTHFTEN=RTHFTEN &
732	,RQICUTEN=RQICUTEN ,RQVFTEN=RQVFTEN &
733	,rqvblten=rqvblten,rthblten=rthblten &
734	#endif
735	,RQVCUTEN=RQVCUTEN,RQCCUTEN=RQCCUTEN &
736	,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr &
737	,F_QI=f_qi,F_QS=f_qs &
738	#if ( WRF_DFI_RADAR == 1 )
739	! Optional CAP suppress option
740	,do_capsuppress=do_capsuppress &
741	,cap_suppress_loc=cap_suppress_loc &
742	#endif
743	)
744	CASE (CAMZMSCHEME)
745	IF (PRESENT(z_at_w) .AND. PRESENT(mavail) &
746	.AND. PRESENT(pblh) .AND. PRESENT(psfc))THEN
747	CALL wrf_debug(100,'in camzm_cps')
748	IF(.not.f_qi)THEN
749	WRITE( wrf_err_message , * ) 'This cumulus option requires ice microphysics option: f_qi = ', f_qi
750	CALL wrf_error_fatal ( wrf_err_message )
751	ENDIF
752	CALL CAMZM_DRIVER( &
753	IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
754	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
755	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
756	,ITIMESTEP=itimestep, BL_PBL_PHYSICS=bl_pbl_physics &
757	,SF_SFCLAY_PHYSICS=sf_sfclay_physics &
758	,TH=th, T_PHY=t, TSK=tsk, TKE_PBL=tke_pbl, UST=ust &
759	,QV=qv_curr, QC=qc_curr, QI=qi_curr, MAVAIL=mavail &
760	,KPBL=kpbl, PBLH=pblh, XLAND=xland &
761	,Z=z, Z_AT_W=z_at_w &
762	,DZ8W=dz8w, HT=ht &
763	,P=p, P8W=p8w, PI_PHY=pi, PSFC=psfc &
764	,U_PHY=u, V_PHY=v, HFX=hfx, QFX=qfx, CLDFRA=cldfra &
765	,TPERT_CAMUWPBL=tpert2d &
766	,DX=dx, DT=dt, STEPCU=stepcu, CUDT=cudt &
767	,CURR_SECS=curr_secs &
768	,ADAPT_STEP_FLAG=adapt_step_flag, CAPE_OUT=cape &
769	,MU_OUT=zmmu, MD_OUT=zmmd &
770	,ZMDT=zmdt, ZMDQ=zmdq, DLF_OUT=dlf, RLIQ_OUT=rliq &
771	,PCONVT=pconvt, PCONVB=pconvb, CUBOT=hbot, CUTOP=htop&
772	,RAINCV=raincv, PRATEC=tmppratec &
773	,RUCUTEN=rucuten, RVCUTEN=rvcuten &
774	,RTHCUTEN=rthcuten, RQVCUTEN=rqvcuten &
775	,RQCCUTEN=rqccuten, RQICUTEN=rqicuten &
776	,EVAPTZM=evaptzm, FZSNTZM=fzsntzm, EVSNTZM=evsntzm &
777	,EVAPQZM=evapqzm, ZMFLXPRC=zmflxprc &
778	,ZMFLXSNW=zmflxsnw, ZMNTPRPD=zmntprpd &
779	,ZMNTSNPD=zmntsnpd, ZMEIHEAT=zmeiheat &
780	,CMFMC=cmfmc, CMFMCDZM=cmfmcdzm &
781	,PRECCDZM=preccdzm, PRECZ=precz &
782	,ZMMTU=zmmtu, ZMMTV=zmmtv, ZMUPGU=zmupgu &
783	,ZMUPGD=zmupgd, ZMVPGU=zmvpgu, ZMVPGD=zmvpgd &
784	,ZMICUU=zmicuu, ZMICUD=zmicud, ZMICVU=zmicvu &
785	,ZMICVD=zmicvd, ZMDICE=zmdice, ZMDLIQ=zmdliq &
786	)
787	ELSE
788	WRITE( wrf_err_message , * ) 'Insufficient arguments to call CAMZM cu scheme'
789	CALL wrf_error_fatal ( wrf_err_message )
790	ENDIF
791
792	! TIEDTKE SCHEME - ZCX&YQW (U of Hawaii)
793	CASE (TIEDTKESCHEME)
794
795	IF ( PRESENT ( QFX ) .AND. PRESENT( ZNU ) ) THEN
796
797	CALL wrf_debug(100,'in cu_tiedtke')
798	CALL CU_TIEDTKE( &
799	DT=dt,ITIMESTEP=itimestep,STEPCU=STEPCU &
800	,RAINCV=RAINCV,PRATEC=tmppratec,QFX=qfx,ZNU=znu &
801	,U3D=u,V3D=v,W=w,T3D=t,PI3D=pi,RHO3D=rho &
802	,QV3D=QV_CURR,QC3D=QC_CURR,QI3D=QI_CURR &
803	,QVFTEN=RQVFTEN,QVPBLTEN=RQVBLTEN &
804	,DZ8W=dz8w,PCPS=p,P8W=p8w,XLAND=XLAND &
805	,CU_ACT_FLAG=CU_ACT_FLAG &
806	,CUDT=cudt_pass &
807	,CURR_SECS=curr_secs_pass &
808	,ADAPT_STEP_FLAG=adapt_step_flag_pass &
809	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
810	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
811	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
812	! optionals
813	,RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN &
814	,RQCCUTEN=RQCCUTEN,RQICUTEN=RQICUTEN &
815	,RUCUTEN = RUCUTEN,RVCUTEN = RVCUTEN &
816	,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr &
817	,F_QI=f_qi,F_QS=f_qs &
818	)
819	ELSE
820	CALL wrf_error_fatal('Lacking arguments for CU_TIEDTKE in cumulus driver')
821	ENDIF
822
823	! New GFS SAS SCHEME - (Yonsei Univ., South Korea)
824	CASE (NSASSCHEME)
825	IF ( PRESENT ( QFX ) .AND. PRESENT( HFX ) ) THEN
826	CALL wrf_debug(100,'in nsas_cps')
827	CALL CU_NSAS( &
828	DT=dt,P3DI=p8w,P3D=p,PI3D=pi, &
829	QC3D=QC_CURR,QI3D=QI_CURR,RHO3D=rho, &
830	ITIMESTEP=itimestep,STEPCU=STEPCU, &
831	HBOT=HBOT,HTOP=HTOP, &
832	CU_ACT_FLAG=CU_ACT_FLAG,CUDT=cudt_pass, &
833	CURR_SECS=curr_secs_pass, &
834	ADAPT_STEP_FLAG=adapt_step_flag_pass, &
835	RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN, &
836	RQCCUTEN=RQCCUTEN,RQICUTEN=RQICUTEN, &
837	RUCUTEN=RUCUTEN,RVCUTEN=RVCUTEN, &
838	QV3D=QV_CURR,T3D=t, &
839	RAINCV=RAINCV,PRATEC=tmpPRATEC, &
840	XLAND=XLAND,DZ8W=dz8w,W=w,U3D=u,V3D=v, &
841	HPBL=pblh,HFX=hfx,QFX=qfx, &
842	MP_PHYSICS=mp_physics, &
843	P_QC=p_qc,P_QI=p_qi, &
844	P_FIRST_SCALAR=param_first_scalar &
845	,CP=cp,CLIQ=cliq,CPV=cpv,G=g,XLV=xlv,R_D=r_d &
846	,R_V=r_v,EP_1=ep_1,EP_2=EP_2 &
847	,CICE=cice,XLS=xls,PSAT=psat &
848	,F_QI=f_qi,F_QC=f_qc &
849	,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
850	,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
851	,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
852	)
853	ELSE
854	CALL wrf_error_fatal('Lacking arguments for CU_NSAS in cumulus driver')
855	ENDIF
856
857	CASE DEFAULT
858
859	WRITE( wrf_err_message , * ) 'The cumulus option does not exist: cu_physics = ', cu_physics
860	CALL wrf_error_fatal ( wrf_err_message )
861
862	END SELECT cps_select
863
864	ENDDO
865	!$OMP END PARALLEL DO
866	#if ( EM_CORE == 1 )
867	IF(cu_physics .eq. 5 )then
868	#ifdef DM_PARALLEL
869	# include "HALO_CUP_G3_OUT.inc"
870	#endif
871	!$OMP PARALLEL DO &
872	!$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
873	DO ij = 1 , num_tiles
874	its = i_start(ij)
875	ite = i_end(ij)
876	jts = j_start(ij)
877	jte = j_end(ij)
878
879	call conv_grell_spread3d(rthcuten=rthcuten,rqvcuten=rqvcuten &
880	& ,rqccuten=rqccuten,raincv=raincv,cugd_avedx=cugd_avedx &
881	& ,cugd_tten=cugd_tten,cugd_qvten=cugd_qvten,rqicuten=rqicuten &
882	& ,cugd_ttens=cugd_ttens,cugd_qvtens=cugd_qvtens &
883	& ,cugd_qcten=cugd_qcten,pi_phy=pi,moist_qv=qv_curr &
884	& ,PRATEC=tmppratec,dt=dt,num_tiles=num_tiles &
885	& ,imomentum=imomentum &
886	& ,F_QV=F_QV,F_QC=F_QC,F_QR=F_QR,F_QI=F_QI,F_QS=F_QS &
887	& ,ids=IDS,ide=IDE, jds=JDS,jde=JDE, kds=KDS,kde=KDE &
888	& ,ips=IPS,ipe=IPE, jps=JPS,jpe=JPE, kps=KPS,kpe=KPE &
889	& ,ims=IMS,ime=IME, jms=JMS,jme=JME, kms=KMS,kme=KME &
890	& ,its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte)
891	ENDDO
892	!$OMP END PARALLEL DO
893	endif
894	#endif
895
896	!
897	! Copy pratec back to output array, if necessary.
898	!
899	if (PRESENT(PRATEC)) then
900	pratec(:,:) = tmppratec(:,:)
901	endif
902	CALL wrf_debug(200,'returning from cumulus_driver')
903	END SUBROUTINE cumulus_driver
904
905	END MODULE module_cumulus_driver

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

Download in other formats:

Original Format