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