module_microphysics_driver.F

References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:PHYSICS
2 ! *** add new modules of schemes here
3 !
4 MODULE module_microphysics_driver
5 CONTAINS
6 
7 SUBROUTINE microphysics_driver(                                          &
8                        th, rho, pi_phy, p                                &
9                       ,ht, dz8w, p8w, dt,dx,dy                           &
10                       ,mp_physics, spec_zone                             &
11                       ,specified, channel_switch                         &
12                       ,warm_rain                                         &
13                       ,t8w                                               &
14                       ,cldfra, cldfra_old, exch_h, nsource               &
15                       ,qlsink, precr, preci, precs, precg                &
16                       ,xland,itimestep                                   &
17                       ,f_ice_phy,f_rain_phy,f_rimef_phy                  &
18                       ,lowlyr,sr, id                                     &
19                       ,ids,ide, jds,jde, kds,kde                         &
20                       ,ims,ime, jms,jme, kms,kme                         &
21                       ,i_start,i_end,j_start,j_end,kts,kte               &
22                       ,num_tiles, naer                                   &
23                       ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr   &
24                       ,qndrop_curr,qni_curr                              &
25                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni      &
26                       ,qt_curr,f_qt                                      &
27                       ,mp_restart_state,tbpvs_state,tbpvs0_state         & ! for etampnew
28                       ,w ,z                                              &
29                       ,rainnc, rainncv                                   &
30                       ,snownc, snowncv                                   &
31                       ,graupelnc, graupelncv                             &
32                                                                          )
33 ! Framework
34    USE module_state_description, ONLY :                                  &
35                      KESSLERSCHEME, LINSCHEME, WSM3SCHEME, WSM5SCHEME    &
36                     ,WSM6SCHEME, ETAMPNEW, NCEPCLOUD3, NCEPCLOUD5, THOMPSON
37 
38 
39 ! Model Layer
40    USE module_model_constants
41    USE module_wrf_error
42 
43 ! *** add new modules of schemes here
44 
45    USE module_mp_kessler
46    USE module_mp_lin
47    USE module_mp_ncloud3
48    USE module_mp_ncloud5
49    USE module_mp_wsm3
50    USE module_mp_wsm5
51    USE module_mp_wsm6
52    USE module_mp_etanew
53    USE module_mp_thompson
54    USE module_mixactivate, only: prescribe_aerosol_mixactivate
55 
56 !----------------------------------------------------------------------
57    ! This driver calls subroutines for the microphys.
58    !
59    ! Schemes
60    !
61    ! Kessler scheme
62    ! Lin et al. (1983), Rutledge and Hobbs (1984)
63    ! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
64    ! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
65    ! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
66    ! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
67    ! NCEP cloud3, Hong et al. (1998) with some mod, Dudhia (1989)
68    ! NCEP cloud5, Hong et al. (1998) with some mod, Rutledge and Hobbs (1984)
69    ! 
70 !----------------------------------------------------------------------
71    IMPLICIT NONE
72 !======================================================================
73 ! Grid structure in physics part of WRF
74 !----------------------------------------------------------------------  
75 ! The horizontal velocities used in the physics are unstaggered
76 ! relative to temperature/moisture variables. All predicted
77 ! variables are carried at half levels except w, which is at full
78 ! levels. Some arrays with names (*8w) are at w (full) levels.
79 !
80 !----------------------------------------------------------------------  
81 ! In WRF, kms (smallest number) is the bottom level and kme (largest 
82 ! number) is the top level.  In your scheme, if 1 is at the top level, 
83 ! then you have to reverse the order in the k direction.
84 !                 
85 !         kme      -   half level (no data at this level)
86 !         kme    ----- full level
87 !         kme-1    -   half level
88 !         kme-1  ----- full level
89 !         .
90 !         .
91 !         .
92 !         kms+2    -   half level
93 !         kms+2  ----- full level
94 !         kms+1    -   half level
95 !         kms+1  ----- full level
96 !         kms      -   half level
97 !         kms    ----- full level
98 !
99 !======================================================================
100 ! Definitions
101 !-----------
102 ! Rho_d      dry density (kg/m^3)
103 ! Theta_m    moist potential temperature (K)
104 ! Qv         water vapor mixing ratio (kg/kg)
105 ! Qc         cloud water mixing ratio (kg/kg)
106 ! Qr         rain water mixing ratio (kg/kg)
107 ! Qi         cloud ice mixing ratio (kg/kg)
108 ! Qs         snow mixing ratio (kg/kg)
109 ! Qndrop     droplet number mixing ratio (#/kg)
110 ! Qni        cloud ice number concentration (#/kg)
111 !
112 !----------------------------------------------------------------------
113 !-- th        potential temperature    (K)
114 !-- moist_new     updated moisture array   (kg/kg)
115 !-- moist_old     Old moisture array       (kg/kg)
116 !-- rho           density of air           (kg/m^3)
117 !-- pi_phy        exner function           (dimensionless)
118 !-- p             pressure                 (Pa)
119 !-- RAINNC        grid scale precipitation (mm)
120 !-- RAINNCV       one time step grid scale precipitation (mm/step)
121 !-- SNOWNC        grid scale snow and ice (mm)
122 !-- SNOWNCV       one time step grid scale snow and ice (mm/step)
123 !-- GRAUPELNC     grid scale graupel (mm)
124 !-- GRAUPELNCV    one time step grid scale graupel (mm/step)
125 !-- SR            one time step mass ratio of snow to total precip
126 !-- z             Height above sea level   (m)
127 !-- dt            Time step              (s)
128 !-- G             acceleration due to gravity  (m/s^2)
129 !-- CP            heat capacity at constant pressure for dry air (J/kg/K)
130 !-- R_d           gas constant for dry air (J/kg/K)
131 !-- R_v           gas constant for water vapor (J/kg/K)
132 !-- XLS           latent heat of sublimation   (J/kg)
133 !-- XLV           latent heat of vaporization  (J/kg)
134 !-- XLF           latent heat of melting       (J/kg)
135 !-- rhowater      water density                      (kg/m^3)
136 !-- rhosnow       snow density               (kg/m^3)
137 !-- F_ICE_PHY     Fraction of ice.
138 !-- F_RAIN_PHY    Fraction of rain.
139 !-- F_RIMEF_PHY   Mass ratio of rimed ice (rime factor)
140 !-- t8w           temperature at layer interfaces
141 !-- cldfra, cldfra_old, current, previous cloud fraction
142 !-- exch_h        vertical diffusivity (m2/s)
143 !-- qlsink        Fractional cloud water sink (/s)
144 !-- precr         rain precipitation rate at all levels (kg/m2/s)
145 !-- preci         ice precipitation rate at all levels (kg/m2/s)
146 !-- precs         snow precipitation rate at all levels (kg/m2/s)
147 !-- precg         graupel precipitation rate at all levels (kg/m2/s)                             &
148 !-- P_QV          species index for water vapor
149 !-- P_QC          species index for cloud water
150 !-- P_QR          species index for rain water
151 !-- P_QI          species index for cloud ice
152 !-- P_QS          species index for snow
153 !-- P_QG          species index for graupel
154 !-- P_QNDROP      species index for cloud drop mixing ratio
155 !-- P_QNI         species index for cloud ice number concentration
156 !-- id            grid id number
157 !-- ids           start index for i in domain
158 !-- ide           end index for i in domain
159 !-- jds           start index for j in domain
160 !-- jde           end index for j in domain
161 !-- kds           start index for k in domain
162 !-- kde           end index for k in domain
163 !-- ims           start index for i in memory
164 !-- ime           end index for i in memory
165 !-- jms           start index for j in memory
166 !-- jme           end index for j in memory
167 !-- kms           start index for k in memory
168 !-- kme           end index for k in memory
169 !-- i_start       start indices for i in tile
170 !-- i_end         end indices for i in tile
171 !-- j_start       start indices for j in tile
172 !-- j_end         end indices for j in tile
173 !-- its           start index for i in tile
174 !-- ite           end index for i in tile
175 !-- jts           start index for j in tile
176 !-- jte           end index for j in tile
177 !-- kts           start index for k in tile
178 !-- kte           end index for k in tile
179 !-- num_tiles     number of tiles
180 !
181 !======================================================================
182 
183    INTEGER,    INTENT(IN   )    :: mp_physics
184    LOGICAL,    INTENT(IN   )    :: specified
185 !
186    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
187    INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
188    INTEGER,      INTENT(IN   )    ::                         kts,kte
189    INTEGER,      INTENT(IN   )    ::     itimestep,num_tiles,spec_zone
190    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
191      &           i_start,i_end,j_start,j_end
192 
193    LOGICAL,      INTENT(IN   )    ::   warm_rain
194 !
195    REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
196          INTENT(INOUT) ::                                         th
197 !
198 
199 !
200    REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
201          INTENT(IN   ) ::                                             &
202                                                                  rho, &
203                                                                 dz8w, &
204                                                                  p8w, &
205                                                               pi_phy, &
206                                                                    p
207 
208 
209    REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
210                                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
211 !!$#ifdef WRF_CHEM
212 !  REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
213    REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
214 !!$#else
215 !!$  REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
216 !!$#endif
217          qlsink, & ! cloud water sink (/s)
218          precr, & ! rain precipitation rate at all levels (kg/m2/s)
219          preci, & ! ice precipitation rate at all levels (kg/m2/s)
220          precs, & ! snow precipitation rate at all levels (kg/m2/s)
221          precg    ! graupel precipitation rate at all levels (kg/m2/s)
222 
223 !
224 
225    REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)   :: XLAND
226 
227    REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT)   :: SR
228 
229    REAL, INTENT(IN   ) :: dt,dx,dy
230 
231    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
232 
233 !
234 ! Optional
235 !
236    LOGICAL,  OPTIONAL,   INTENT(IN   )    :: channel_switch
237    REAL, OPTIONAL,  INTENT(INOUT   ) :: naer  ! aerosol number concentration (/kg)
238    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
239          OPTIONAL,                                                &
240          INTENT(INOUT ) ::                                        &
241                   w, z, t8w                                       & 
242                  ,cldfra, cldfra_old, exch_h                      &
243                  ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
244                  ,qt_curr,qndrop_curr,qni_curr                                
245    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                   &
246          OPTIONAL,                                                &
247          INTENT(OUT ) ::                                          &
248                   nsource
249 
250 !
251    REAL, DIMENSION( ims:ime , jms:jme ),                          &
252          INTENT(INOUT),                                           &
253          OPTIONAL   ::                                            &
254                                                            RAINNC &
255                                                          ,RAINNCV &
256                                                           ,SNOWNC &
257                                                          ,SNOWNCV &
258                                                        ,GRAUPELNC &
259                                                       ,GRAUPELNCV
260    INTEGER,OPTIONAL,INTENT(IN   )    ::                        id
261 
262    REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL ,             &
263          INTENT(IN)   ::                                       ht
264 
265    REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
266                                          ,tbpvs_state,tbpvs0_state
267 !
268 
269    LOGICAL, OPTIONAL :: f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni,f_qt
270 
271 
272 ! LOCAL  VAR
273 
274    INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
275    LOGICAL :: channel
276 
277 !---------------------------------------------------------------------
278 !  check for microphysics type.  We need a clean way to 
279 !  specify these things!
280 !---------------------------------------------------------------------
281 
282    channel = .FALSE.
283    IF ( PRESENT ( channel_switch ) ) channel = channel_switch
284 
285    if (mp_physics .eq. 0) return
286    IF( specified ) THEN
287      sz = spec_zone
288    ELSE
289      sz = 0
290    ENDIF
291 
292    !$OMP PARALLEL DO   &
293    !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
294 
295    DO ij = 1 , num_tiles
296 
297        IF (channel) THEN
298          its = max(i_start(ij),ids)
299          ite = min(i_end(ij),ide-1)
300        ELSE
301          its = max(i_start(ij),ids+sz)
302          ite = min(i_end(ij),ide-1-sz)
303        ENDIF
304        jts = max(j_start(ij),jds+sz)
305        jte = min(j_end(ij),jde-1-sz)
306 
307        IF( PRESENT(qlsink) ) qlsink(its:ite,kts:kte,jts:jte) = 0.
308 
309 !-----------
310 #ifndef WRF_CHEM
311        IF( PRESENT( QNDROP_CURR ) ) THEN
312           IF( F_QNDROP .AND. mp_physics==LINSCHEME ) THEN
313              CALL wrf_debug ( 100 , 'microphysics_driver: calling prescribe_aerosol_mixactivate' )
314 ! 06-nov-2005 rce - id  & itimestep added to arg list
315              call prescribe_aerosol_mixactivate (               &
316                   id, itimestep, dt, naer,                      &
317                   rho, th, pi_phy, w, cldfra, cldfra_old,       &
318                   z, dz8w, p8w, t8w, exch_h,                    &
319                   qv_curr, qc_curr, qi_curr, qndrop_curr,       &
320                   nsource,                                      &
321                   ims,ime, jms,jme, kms,kme,                    &
322                   its,ite, jts,jte, kts,kte,                    &
323                   F_QC=f_qc, F_QI=f_qi                          )
324           ELSE IF( F_QNDROP ) THEN
325              call wrf_error_fatal("SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME.")
326           END IF
327        END IF
328 #endif
329 
330      micro_select: SELECT CASE(mp_physics)
331 
332         CASE (KESSLERSCHEME)
333              CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
334              IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND.  &
335                                            PRESENT( QR_CURR ) .AND.  &
336                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
337                                            PRESENT( Z       ))  THEN
338                CALL kessler(                                        &
339                   T=th                                              &
340                  ,QV=qv_curr                                        &
341                  ,QC=qc_curr                                        &
342                  ,QR=qr_curr                                        &
343                  ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
344                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
345                  ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater           &
346                  ,DZ8W=dz8w                                         &
347                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
348                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
349                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
350                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
351                                                                     )
352              ELSE 
353                 CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
354              ENDIF
355 
356 !
357         CASE (THOMPSON)
358              CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson et al' )
359              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
360                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
361                   PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
362                                            PRESENT ( QNI_CURR ).AND.  &
363                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) ) THEN
364              CALL mp_gt_driver(                          &
365                      QV=qv_curr,                         &
366                      QC=qc_curr,                         &
367                      QR=qr_curr,                         &
368                      QI=qi_curr,                         &
369                      QS=qs_curr,                         &
370                      QG=qg_curr,                         &
371                      NI=qni_curr,                        &
372                      TH=th,                              &
373                      PII=pi_phy,                         &
374                      P=p,                                &
375                      DZ=dz8w,                            &
376                      DT_IN=dt,                           &
377                      ITIMESTEP=itimestep,                &
378                      RAINNC=RAINNC,                      &
379                      RAINNCV=RAINNCV,                    &
380                      SR=SR                               &
381                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
382                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
383                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
384              ELSE
385                 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
386              ENDIF
387 !
388         CASE (LINSCHEME)
389              CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
390              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
391                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
392                   PRESENT( QS_CURR )                           .AND.  &
393                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
394                   PRESENT( Z       ) ) THEN
395                CALL lin_et_al(                                      &
396                   TH=th                                             &
397                  ,QV=qv_curr                                        &
398                  ,QL=qc_curr                                        &
399                  ,QR=qr_curr                                        &
400                  ,QI=qi_curr                                        &
401                  ,QS=qs_curr                                        &
402                  ,QLSINK=qlsink                                     &
403                  ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z           &
404                  ,HT=ht, DZ8W=dz8w, GRAV=G,  CP=cp                  &
405                  ,RAIR=r_d, RVAPOR=R_v                              &
406                  ,XLS=xls, XLV=xlv, XLF=xlf                         &
407                  ,RHOWATER=rhowater, RHOSNOW=rhosnow                &
408                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
409                  ,SVP3=svp3,SVPT0=svpt0                             &
410                  ,RAINNC=rainnc, RAINNCV=rainncv                    &
411                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
412                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
413                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
414                  ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg   &
415                  ,F_QG=f_qg, F_QNDROP=f_qndrop                      &
416                  ,QG=qg_curr                                        &
417                  ,QNDROP=qndrop_curr                                &
418                                                                     )
419              ELSE 
420                 CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
421              ENDIF
422 
423         CASE (WSM3SCHEME)
424              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
425              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
426                   PRESENT( QR_CURR ) .AND.                            &
427                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
428                   PRESENT( W       )                            ) THEN
429              CALL wsm3(                                             &
430                   TH=th                                             &
431                  ,Q=qv_curr                                         &
432                  ,QCI=qc_curr                                       &
433                  ,QRS=qr_curr                                       &
434                  ,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w              &
435                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
436                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
437                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
438                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
439                  ,DEN0=rhoair0, DENR=rhowater                       &
440                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
441                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
442                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
443                  ,SR=sr                                             &
444                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
445                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
446                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
447                                                                     )
448              ELSE 
449                 CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
450              ENDIF
451 
452         CASE (WSM5SCHEME)
453              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
454              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
455                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
456                   PRESENT( QS_CURR ) .AND.                            &
457                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
458              CALL wsm5(                                             &
459                   TH=th                                             &
460                  ,Q=qv_curr                                         &
461                  ,QC=qc_curr                                        &
462                  ,QR=qr_curr                                        &
463                  ,QI=qi_curr                                        &
464                  ,QS=qs_curr                                        &
465                  ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
466                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
467                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
468                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
469                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
470                  ,DEN0=rhoair0, DENR=rhowater                       &
471                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
472                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
473                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
474                  ,SR=sr                                             &
475                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
476                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
477                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
478                                                                     )
479              ELSE
480                 CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
481              ENDIF
482 
483         CASE (WSM6SCHEME)
484              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
485              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
486                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
487                   PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
488                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
489              CALL wsm6(                                             &
490                   TH=th                                             &
491                  ,Q=qv_curr                                         &
492                  ,QC=qc_curr                                        &
493                  ,QR=qr_curr                                        &
494                  ,QI=qi_curr                                        &
495                  ,QS=qs_curr                                        &
496                  ,QG=qg_curr                                        &
497                  ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
498                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
499                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
500                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
501                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
502                  ,DEN0=rhoair0, DENR=rhowater                       &
503                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
504                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
505                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
506                  ,SR=sr                                             &
507                  ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
508                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
509                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
510                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
511                                                                     )
512              ELSE
513                 CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
514              ENDIF
515 
516         CASE (ETAMPNEW)
517              CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
518 
519              IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
520                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
521                   PRESENT( mp_restart_state )                  .AND. &
522                   PRESENT( tbpvs_state )                      .AND. &
523                   PRESENT( tbpvs0_state )                       ) THEN
524                CALL ETAMP_NEW(                                      &
525                   ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy             &
526                  ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
527                  ,QV=qv_curr                                        &
528                  ,QC=qc_curr                                        &
529                  ,QS=qs_curr                                        & 
530                  ,QR=qr_curr                                        &
531                  ,QT=qt_curr                                        &
532                  ,LOWLYR=LOWLYR,SR=SR                               &
533                  ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY         &
534                  ,F_RIMEF_PHY=F_RIMEF_PHY                           &
535                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
536                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
537                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
538                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
539                  ,MP_RESTART_STATE=mp_restart_state                 &
540                  ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
541                                                                     )
542              ELSE
543                 CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
544              ENDIF
545 
546         CASE (NCEPCLOUD3)
547              CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud3' )
548              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
549                   PRESENT( QR_CURR ) .AND.                            &
550                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
551                   PRESENT( W       )                            ) THEN
552              CALL ncloud3(                                          &
553                   TH=th                                             &
554                  ,Q=qv_curr                                         &
555                  ,QCI=qc_curr                                       &
556                  ,QRS=qr_curr                                       &
557                  ,W=w, DEN=rho, PII=pi_phy, P=p, DELZ=dz8w          &
558                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
559                  ,RD=r_d,RV=r_v,T0C=SVPT0                           &
560                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
561                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
562                  ,DEN0=rhoair0, DENR=rhowater                       &
563                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
564                  ,RAIN=RAINNC,RAINNCV=RAINNCV                       &
565                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
566                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
567                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
568                                                                     )
569 
570              ELSE
571                 CALL wrf_error_fatal ( 'arguments not present for calling ncepcloud3' )
572              ENDIF
573 
574         CASE (NCEPCLOUD5)
575              CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud5' )
576              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
577                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
578                   PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
579                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
580                   PRESENT( W       )                            ) THEN
581              CALL ncloud5(                                          &
582                   TH=th                                             &
583                  ,Q=qv_curr                                         &
584                  ,QC=qc_curr                                        &
585                  ,QR=qr_curr                                        &
586                  ,QI=qi_curr                                        &
587                  ,QS=qs_curr                                        &
588                  ,W=w, DEN=rho, PII=pi_phy, P=p, DELZ=dz8w          &
589                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
590                  ,RD=r_d,RV=r_v,T0C=SVPT0                           &
591                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
592                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
593                  ,DEN0=rhoair0, DENR=rhowater                       &
594                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
595                  ,RAIN=RAINNC,RAINNCV=RAINNCV                       &
596                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
597                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
598                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
599                                                                     )
600              ELSE
601                 CALL wrf_error_fatal ( 'arguments not present for calling ncepcloud5' )
602              ENDIF
603 
604 
605       CASE DEFAULT 
606 
607          WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
608          CALL wrf_error_fatal ( wrf_err_message )
609 
610       END SELECT micro_select 
611 
612    ENDDO
613    !$OMP END PARALLEL DO
614 
615    CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
616 
617    RETURN
618 
619    END SUBROUTINE microphysics_driver
620 
621 END MODULE module_microphysics_driver
622