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