source: trunk/WRF.COMMON/WRFV2/phys/module_cumulus_driver.F @ 3547

Last change on this file since 3547 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 22.3 KB
Line 
1!WRF:MEDIATION_LAYER:PHYSICS
2!
3
4MODULE module_cumulus_driver
5CONTAINS
6   SUBROUTINE cumulus_driver(                                         &
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                     ,i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
11                 ! Order independent args (use VAR= in call)
12                 ! --Prognostic
13                     ,u,v,th,t,w                                      &
14                     ,p,pi,rho                                        &
15                 ! --Other arguments
16                     ,itimestep,dt,dx                                 &
17                     ,rainc,raincv,nca                                &
18                     ,dz8w,p8w,forcet,forceq                          &
19                     ,w0avg,stepcu,gsw                                &
20                     ,cldefi,lowlyr,xland,cu_act_flag,warm_rain       &
21                     ,htop,hbot,kpbl,ht                               & 
22                     ,ensdim,maxiens,maxens,maxens2,maxens3           &
23                 ! Package selection variable
24                     ,cu_physics                                      &
25                 ! Optional moisture tracers
26                     ,qv_curr, qc_curr, qr_curr                       &
27                     ,qi_curr, qs_curr, qg_curr                       &
28                     ,qv_prev, qc_prev, qr_prev                       &
29                     ,qi_prev, qs_prev, qg_prev                       &
30                 ! Optional arguments for GD scheme
31                     ,apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma     &
32                     ,apr_capme,apr_capmi                             &
33                     ,mass_flux,xf_ens,pr_ens                         &
34                     ,gd_cloud,gd_cloud2      &
35                 ! Optional moisture and other tendencies
36                     ,rqvcuten,rqccuten,rqrcuten                      &
37                     ,rqicuten,rqscuten,rqgcuten                      &
38                     ,rqvblten,rqvften                                &
39                     ,rthcuten,rthraten,rthblten,rthften              &
40                 ! Optional moisture tracer flags
41                     ,f_qv,f_qc,f_qr                                  &
42                     ,f_qi,f_qs,f_qg                                  &
43                                                                      )
44!----------------------------------------------------------------------
45   USE module_model_constants
46   USE module_state_description, ONLY:     KFSCHEME,BMJSCHEME         &
47                                          ,KFETASCHEME,GDSCHEME       &
48                                          ,SASSCHEME
49
50! *** add new modules of schemes here
51
52   USE module_cu_kf
53   USE module_cu_bmj
54   USE module_cu_kfeta
55   USE module_cu_gd
56   USE module_cu_sas
57
58   !  This driver calls subroutines for the cumulus parameterizations.
59   !
60   !  1. Kain & Fritsch (1993)
61   !  2. Betts-Miller-Janjic (Janjic, 1994)
62   !
63!----------------------------------------------------------------------
64   IMPLICIT NONE
65!======================================================================
66! Grid structure in physics part of WRF
67!----------------------------------------------------------------------
68! The horizontal velocities used in the physics are unstaggered
69! relative to temperature/moisture variables. All predicted
70! variables are carried at half levels except w, which is at full
71! levels. Some arrays with names (*8w) are at w (full) levels.
72!
73!----------------------------------------------------------------------
74! In WRF, kms (smallest number) is the bottom level and kme (largest
75! number) is the top level.  In your scheme, if 1 is at the top level,
76! then you have to reverse the order in the k direction.
77!
78!         kme      -   half level (no data at this level)
79!         kme    ----- full level
80!         kme-1    -   half level
81!         kme-1  ----- full level
82!         .
83!         .
84!         .
85!         kms+2    -   half level
86!         kms+2  ----- full level
87!         kms+1    -   half level
88!         kms+1  ----- full level
89!         kms      -   half level
90!         kms    ----- full level
91!
92!======================================================================
93! Definitions
94!-----------
95! Rho_d      dry density (kg/m^3)
96! Theta_m    moist potential temperature (K)
97! Qv         water vapor mixing ratio (kg/kg)
98! Qc         cloud water mixing ratio (kg/kg)
99! Qr         rain water mixing ratio (kg/kg)
100! Qi         cloud ice mixing ratio (kg/kg)
101! Qs         snow mixing ratio (kg/kg)
102!-----------------------------------------------------------------
103!-- DT            time step (second)
104!-- itimestep     number of time step (integer)   
105!-- DX            horizontal space interval (m)
106!-- rr            dry air density (kg/m^3)
107!
108!-- RTHCUTEN      Theta tendency due to
109!                 cumulus scheme precipitation (K/s)
110!-- RQVCUTEN      Qv tendency due to
111!                 cumulus scheme precipitation (kg/kg/s)
112!-- RQRCUTEN      Qr tendency due to
113!                 cumulus scheme precipitation (kg/kg/s)
114!-- RQCCUTEN      Qc tendency due to
115!                 cumulus scheme precipitation (kg/kg/s)
116!-- RQSCUTEN      Qs tendency due to
117!                 cumulus scheme precipitation (kg/kg/s)
118!-- RQICUTEN      Qi tendency due to
119!                 cumulus scheme precipitation (kg/kg/s)
120!
121!-- RAINC         accumulated total cumulus scheme precipitation (mm)
122!-- RAINCV        cumulus scheme precipitation (mm)
123!-- NCA           counter of the cloud relaxation
124!                 time in KF cumulus scheme (integer)
125!-- u_phy         u-velocity interpolated to theta points (m/s)
126!-- v_phy         v-velocity interpolated to theta points (m/s)
127!-- th_phy        potential temperature (K)
128!-- t_phy         temperature (K)
129!-- w             vertical velocity (m/s)
130!-- moist         moisture array (4D - last index is species) (kg/kg)
131!-- dz8w          dz between full levels (m)
132!-- p8w           pressure at full levels (Pa) 
133!-- p_phy         pressure (Pa)
134!-- pi_phy        exner function (dimensionless)
135!                 points (dimensionless)
136!-- RTHRATEN      radiative temp forcing for Grell-Devenyi scheme
137!-- RTHBLTEN      PBL temp forcing for Grell-Devenyi scheme
138!-- RQVBLTEN      PBL moisture forcing for Grell-Devenyi scheme
139!-- RTHFTEN
140!-- RQVFTEN
141!-- MASS_FLUX
142!-- XF_ENS
143!-- PR_ENS
144!-- warm_rain
145!-- CU_ACT_FLAG
146!-- W0AVG         average vertical velocity, (for KF scheme) (m/s)
147!-- rho           density (kg/m^3)
148!-- CLDEFI        precipitation efficiency (for BMJ scheme) (dimensionless)
149!-- STEPCU        # of fundamental timesteps between convection calls
150!-- XLAND         land-sea mask (1.0 for land; 2.0 for water)
151!-- LOWLYR        index of lowest model layer above the ground
152!-- XLV0          latent heat of vaporization constant
153!                 used in temperature dependent formula (J/kg)
154!-- XLV1          latent heat of vaporization constant
155!                 used in temperature dependent formula (J/kg/K)
156!-- XLS0          latent heat of sublimation constant
157!                 used in temperature dependent formula (J/kg)
158!-- XLS1          latent heat of sublimation constant
159!                 used in temperature dependent formula (J/kg/K)
160!-- R_d           gas constant for dry air ( 287. J/kg/K)
161!-- R_v           gas constant for water vapor (461 J/k/kg)
162!-- Cp            specific heat at constant pressure (1004 J/k/kg)
163!-- rvovrd        R_v divided by R_d (dimensionless)
164!-- G             acceleration due to gravity (m/s^2)
165!-- EP_1          constant for virtual temperature
166!                 (R_v/R_d - 1) (dimensionless)
167!-- pi_phy        the exner function, (p/p0)**(R/Cp) (none unit)
168!-- ids           start index for i in domain
169!-- ide           end index for i in domain
170!-- jds           start index for j in domain
171!-- jde           end index for j in domain
172!-- kds           start index for k in domain
173!-- kde           end index for k in domain
174!-- ims           start index for i in memory
175!-- ime           end index for i in memory
176!-- jms           start index for j in memory
177!-- jme           end index for j in memory
178!-- kms           start index for k in memory
179!-- kme           end index for k in memory
180!-- i_start       start indices for i in tile
181!-- i_end         end indices for i in tile
182!-- j_start       start indices for j in tile
183!-- j_end         end indices for j in tile
184!-- kts           start index for k in tile
185!-- kte           end index for k in tile
186!-- num_tiles     number of tiles
187!-- HBOT          index of lowest model layer with convection
188!-- HTOP          index of highest model layer with convection
189!-- LBOT          index of lowest model layer with convection
190!-- LTOP          index of highest model layer with convection
191!-- KPBL          layer index of the PBL
192!
193!======================================================================
194
195   INTEGER,      INTENT(IN   )    ::                             &
196                                      ids,ide, jds,jde, kds,kde, &
197                                      ims,ime, jms,jme, kms,kme, &
198                                                        kts,kte, &
199                                      itimestep, num_tiles
200   INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
201     &           i_start,i_end,j_start,j_end
202
203   INTEGER,      INTENT(IN   )    ::                             &
204                           ensdim,maxiens,maxens,maxens2,maxens3
205
206   INTEGER,      INTENT(IN   )    ::   cu_physics
207   INTEGER,      INTENT(IN   )    ::   STEPCU
208   LOGICAL,      INTENT(IN   )    ::   warm_rain
209
210   INTEGER,DIMENSION( ims:ime, jms:jme ),                        &
211           INTENT(IN ) ::                                LOWLYR
212
213   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
214         INTENT(IN ) ::                                          &
215                                                           dz8w  &
216                                                      ,     p8w  &
217                                                      ,       p  &
218                                                      ,      pi  &
219                                                      ,       u  &
220                                                      ,       v  &
221                                                      ,      th  &
222                                                      ,       t  &
223                                                      ,     rho  &
224                                                      ,       w
225
226   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
227         INTENT(INOUT)  ::                                       &
228                                                          W0AVG
229
230   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
231                                                 GSW,HT,XLAND
232
233   REAL, DIMENSION( ims:ime , jms:jme ),                         &
234          INTENT(INOUT) ::                                RAINC  &
235                                                    ,    RAINCV  &
236                                                    ,       NCA  &
237                                                    ,      HTOP  &
238                                                    ,      HBOT  &
239                                                    ,    CLDEFI
240 
241
242   INTEGER, DIMENSION( ims:ime , jms:jme ),                      &
243                    INTENT(IN) ::                          KPBL
244
245
246   LOGICAL, DIMENSION( ims:ime , jms:jme ),                      &
247          INTENT(INOUT) :: CU_ACT_FLAG
248
249   REAL,  INTENT(IN   ) :: DT, DX
250
251!
252! optional arguments
253!
254   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
255         OPTIONAL, INTENT(INOUT) ::                              &
256                      ! optional moisture tracers
257                      ! 2 time levels; if only one then use CURR
258                      qv_curr, qc_curr, qr_curr                  &
259                     ,qi_curr, qs_curr, qg_curr                  &
260                     ,qv_prev, qc_prev, qr_prev                  &
261                     ,qi_prev, qs_prev, qg_prev                  &
262                      ! optional moisture and other tendencies
263                     ,rqvcuten,rqccuten,rqrcuten                 &
264                     ,rqicuten,rqscuten,rqgcuten                 &
265                     ,rqvblten,rqvften                           &
266                     ,rthraten,rthblten                          &
267                                                      ,   forcet &
268                                                      ,   forceq &
269                     ,rthften,rthcuten
270
271   REAL, DIMENSION( ims:ime , jms:jme ),                         &
272                    OPTIONAL,                                    &
273                    INTENT(INOUT) ::                             &
274                apr_gr,apr_w,apr_mc,apr_st,apr_as,apr_capma      &
275               ,apr_capme,apr_capmi                              &
276                                                    , MASS_FLUX
277   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
278         OPTIONAL, INTENT(INOUT) ::                              &
279                  GD_CLOUD,GD_CLOUD2
280   REAL, DIMENSION( ims:ime , jms:jme , 1:ensdim ),              &
281          OPTIONAL,                                              &
282          INTENT(INOUT) ::                       XF_ENS, PR_ENS
283
284!
285! Flags relating to the optional tendency arrays declared above
286! Models that carry the optional tendencies will provdide the
287! optional arguments at compile time; these flags all the model
288! to determine at run-time whether a particular tracer is in
289! use or not.
290!
291   LOGICAL, INTENT(IN), OPTIONAL ::                             &
292                                                      f_qv      &
293                                                     ,f_qc      &
294                                                     ,f_qr      &
295                                                     ,f_qi      &
296                                                     ,f_qs      &
297                                                     ,f_qg
298
299
300! LOCAL  VAR
301
302   INTEGER :: i,j,k,its,ite,jts,jte,ij
303
304!-----------------------------------------------------------------
305
306   IF (cu_physics .eq. 0) return
307
308! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD.
309! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME
310
311! SET START AND END POINTS FOR TILES
312      !$OMP PARALLEL DO   &
313      !$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k)
314
315      DO ij = 1 , num_tiles
316        its = i_start(ij)
317        ite = i_end(ij)
318        jts = j_start(ij)
319        jte = j_end(ij)
320
321
322   cps_select: SELECT CASE(cu_physics)
323
324     CASE (KFSCHEME)
325          CALL wrf_debug(100,'in kfcps')
326
327          CALL KFCPS(                                           &
328              ! order independent arguments
329                DT=dt ,KTAU=itimestep ,DX=dx ,RHO=rho           &
330               ,U=u ,V=v ,TH=th ,T=t ,W=w                       &
331               ,PCPS=p ,PI=pi                                   &
332               ,XLV0=xlv0 ,XLV1=xlv1 ,XLS0=xls0 ,XLS1=xls1      &
333               ,RAINCV=raincv ,NCA=nca                          &
334               ,DZ8W=dz8w                                       &
335               ,W0AVG=w0avg                                     &
336               ,CP=cp ,R=r_d ,G=g ,EP1=ep_1 ,EP2=ep_2           &
337               ,SVP1=svp1 ,SVP2=svp2 ,SVP3=svp3 ,SVPT0=svpt0    &
338               ,STEPCU=stepcu                                   &
339               ,CU_ACT_FLAG=cu_act_flag                         &
340               ,WARM_RAIN=warm_rain                             &
341               ,QV=qv_curr                                      &
342               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
343               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
344               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
345              ! optionals
346               ,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten            &
347               ,RQCCUTEN=rqccuten ,RQRCUTEN=rqrcuten            &
348               ,RQICUTEN=rqicuten ,RQSCUTEN=rqscuten            &
349               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
350               ,F_QI=f_qi,F_QS=f_qs                             &
351                                                                )
352
353     CASE (BMJSCHEME)
354          CALL wrf_debug(100,'in bmj_cps')
355          CALL BMJDRV(                                          &
356                TH=th,T=T ,RAINCV=raincv, RHO=rho               &
357               ,DT=dt ,ITIMESTEP=itimestep ,STEPCU=stepcu       &
358               ,CUTOP=htop, CUBOT=hbot, KPBL=kpbl               &
359               ,DZ8W=dz8w ,PINT=p8w, PMID=p, PI=pi              &
360               ,CP=cp ,R=r_d ,ELWV=xlv ,ELIV=xls ,G=g           &
361               ,TFRZ=svpt0 ,D608=ep_1 ,CLDEFI=cldefi            &
362               ,LOWLYR=lowlyr ,XLAND=xland                      &
363               ,CU_ACT_FLAG=cu_act_flag                         &
364               ,QV=qv_curr                                      &
365               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
366               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
367               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
368              ! optionals
369               ,RTHCUTEN=rthcuten ,RQVCUTEN=rqvcuten            &
370                                                                )
371
372     CASE (KFETASCHEME)
373          CALL wrf_debug(100,'in kf_eta_cps')
374          CALL KF_ETA_CPS(                                      &
375                U=u ,V=v ,TH=th ,T=t ,W=w ,RHO=rho              &
376               ,RAINCV=raincv, NCA=nca ,DZ8W=dz8w               &
377               ,PCPS=p, PI=pi ,W0AVG=W0AVG                      &
378               ,CUTOP=HTOP,CUBOT=HBOT                           &
379               ,XLV0=XLV0 ,XLV1=XLV1 ,XLS0=XLS0 ,XLS1=XLS1      &
380               ,CP=CP ,R=R_d ,G=G ,EP1=EP_1 ,EP2=EP_2           &
381               ,SVP1=SVP1 ,SVP2=SVP2 ,SVP3=SVP3 ,SVPT0=SVPT0    &
382               ,DT=dt ,KTAU=itimestep ,DX=dx                    &
383               ,STEPCU=stepcu                                   &
384               ,CU_ACT_FLAG=cu_act_flag ,warm_rain=warm_rain    &
385               ,QV=qv_curr                                      &
386               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
387               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
388               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
389              ! optionals
390               ,RTHCUTEN=rthcuten                               &
391               ,RQVCUTEN=rqvcuten ,RQCCUTEN=rqccuten            &
392               ,RQRCUTEN=rqrcuten ,RQICUTEN=rqicuten            &
393               ,RQSCUTEN=rqscuten                               &
394               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
395               ,F_QI=f_qi,F_QS=f_qs                             &
396                                                                )
397
398     CASE (GDSCHEME)
399          CALL wrf_debug(100,'in grelldrv')
400          CALL GRELLDRV(                                        &
401                DT=dt, ITIMESTEP=itimestep, DX=dx               &
402               ,U=u,V=v,T=t,W=w ,RHO=rho                        &
403               ,P=p,PI=pi ,Q=qv_curr ,RAINCV=raincv             &
404               ,DZ8W=dz8w,P8W=p8w,XLV=xlv,CP=cp,G=g,R_V=r_v     &
405               ,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc         &
406               ,APR_ST=apr_st,APR_AS=apr_as                     &
407               ,APR_CAPMA=apr_capma,APR_CAPME=apr_capme         &
408               ,APR_CAPMI=apr_capmi,MASS_FLUX=mass_flux         &
409               ,XF_ENS=xf_ens,PR_ENS=pr_ens,HT=ht               &
410               ,xland=xland,gsw=gsw                             &
411               ,GDC=gd_cloud,GDC2=gd_cloud2 &
412               ,ENSDIM=ensdim,MAXIENS=maxiens,MAXENS=maxens     &
413               ,MAXENS2=maxens2,MAXENS3=maxens3                 &
414               ,STEPCU=STEPCU,htop=htop,hbot=hbot               &
415               ,CU_ACT_FLAG=CU_ACT_FLAG,warm_rain=warm_rain     &
416               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
417               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
418               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
419              ! optionals
420#if (NMM_CORE == 1 )
421               ,RTHCUTEN=RTHCUTEN ,RTHFTEN=forcet               &
422               ,RQICUTEN=RQICUTEN ,RQVFTEN=forceq               &
423#else
424               ,RTHCUTEN=RTHCUTEN ,RTHFTEN=RTHFTEN              &
425               ,RQICUTEN=RQICUTEN ,RQVFTEN=RQVFTEN              &
426#endif
427               ,RTHRATEN=RTHRATEN,RTHBLTEN=RTHBLTEN             &
428               ,RQVCUTEN=RQVCUTEN,RQCCUTEN=RQCCUTEN             &
429               ,RQVBLTEN=RQVBLTEN                               &
430               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
431               ,F_QI=f_qi,F_QS=f_qs                             &
432                                                                )
433     CASE (SASSCHEME)
434                                                                                                                                           
435          CALL wrf_debug(100,'in cu_sas')
436            CALL CU_SAS(                                        &
437                DT=dt,ITIMESTEP=itimestep,STEPCU=STEPCU         &
438               ,RAINCV=RAINCV,HTOP=HTOP,HBOT=HBOT               &
439               ,U3D=u,V3D=v,W=w,T3D=t,PI3D=pi,RHO3D=rho         &
440               ,QV3D=QV_CURR,QC3D=QC_CURR,QI3D=QI_CURR          &
441               ,DZ8W=dz8w,PCPS=p,P8W=p8w,XLAND=XLAND            &
442               ,CU_ACT_FLAG=CU_ACT_FLAG                         &
443               ,IDS=ids,IDE=ide,JDS=jds,JDE=jde,KDS=kds,KDE=kde &
444               ,IMS=ims,IME=ime,JMS=jms,JME=jme,KMS=kms,KME=kme &
445               ,ITS=its,ITE=ite,JTS=jts,JTE=jte,KTS=kts,KTE=kte &
446              ! optionals
447               ,RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN             &
448               ,RQCCUTEN=RQCCUTEN,RQICUTEN=RQICUTEN             &
449               ,F_QV=f_qv,F_QC=f_qc,F_QR=f_qr                   &
450               ,F_QI=f_qi,F_QS=f_qs                             &
451                                                                )
452
453     CASE DEFAULT
454
455         WRITE( wrf_err_message , * ) 'The cumulus option does not exist: cu_physics = ', cu_physics
456         CALL wrf_error_fatal ( wrf_err_message )
457
458   END SELECT cps_select
459
460      ENDDO
461      !$OMP END PARALLEL DO
462
463   END SUBROUTINE cumulus_driver
464
465END MODULE module_cumulus_driver
Note: See TracBrowser for help on using the repository browser.