!WRF:MEDIATION_LAYER:PHYSICS
! *** add new modules of schemes here
!
MODULE module_microphysics_driver
CONTAINS
SUBROUTINE microphysics_driver( &
th, rho, pi_phy, p &
,ht, dz8w, p8w, dt,dx,dy &
,mp_physics, spec_zone &
,specified, channel_switch &
,warm_rain &
,t8w &
,chem_opt, progn &
,cldfra, cldfra_old, exch_h, nsource &
,qlsink, precr, preci, precs, precg &
,xland,itimestep &
,f_ice_phy,f_rain_phy,f_rimef_phy &
,lowlyr,sr, id &
,ids,ide, jds,jde, kds,kde &
,ims,ime, jms,jme, kms,kme &
,ips,ipe, jps,jpe, kps,kpe &
,i_start,i_end,j_start,j_end,kts,kte &
,num_tiles, naer &
,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
,qndrop_curr,qni_curr,qh_curr,qnh_curr &
,qzr_curr,qzi_curr,qzs_curr,qzg_curr,qzh_curr &
,qns_curr,qnr_curr,qng_curr,qnn_curr,qnc_curr &
,qvolg_curr &
,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni &
,f_qns,f_qnr,f_qng,f_qnc,f_qnn,f_qh,f_qnh &
, f_qzr,f_qzi,f_qzs,f_qzg,f_qzh &
,f_qvolg &
,qrcuten, qscuten, qicuten, mu &
,qt_curr,f_qt &
,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew or etampold
,hail,ice2 & ! for mp_gsfcgce
! ,ccntype & ! for mp_milbrandt2mom
,w ,z &
,rainnc, rainncv &
,snownc, snowncv &
,hailnc, hailncv &
,graupelnc, graupelncv &
#ifdef WRF_CHEM
,rainprod, evapprod &
,qv_b4mp, qc_b4mp, qi_b4mp, qs_b4mp &
#endif
,refl_10cm & ! HM, 9/22/09, add for refl
! YLIN
! Added the RI_CURR array to the call
,ri_curr &
,diagflag &
)
! Framework
#if(NMM_CORE==1)
USE module_state_description, ONLY : &
KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME &
,WSM6SCHEME, ETAMPNEW, ETAMPOLD, etamp_HWRF,THOMPSON, MORR_TWO_MOMENT &
,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME &
,MILBRANDT2MOM !,MILBRANDT3MOM
#else
USE module_state_description, ONLY : &
KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME &
,WSM6SCHEME, ETAMPNEW, ETAMPOLD, THOMPSON, MORR_TWO_MOMENT &
,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN &
,MILBRANDT2MOM !,MILBRANDT3MOM
#endif
! Model Layer
USE module_model_constants
USE module_wrf_error
! *** add new modules of schemes here
USE module_mp_kessler
USE module_mp_lin
USE module_mp_sbu_ylin
USE module_mp_wsm3
USE module_mp_wsm5
USE module_mp_wsm6
USE module_mp_etanew
USE module_mp_etaold
USE module_mp_thompson
USE module_mp_gsfcgce
USE module_mp_morr_two_moment
USE module_mp_wdm5
USE module_mp_wdm6
USE module_mp_milbrandt2mom
! USE module_mp_milbrandt3mom
#if (EM_CORE==1)
USE module_mp_nssl_2mom
#endif
USE module_mp_HWRF
USE module_mixactivate, only: prescribe_aerosol_mixactivate
!----------------------------------------------------------------------
! This driver calls subroutines for the microphys.
!
! Schemes
!
! Kessler scheme
! Lin et al. (1983), Rutledge and Hobbs (1984)
! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
! * etampnew - what's in the operational 4-km High-Resolution Window Runs
! * etampold - what was run in the 12-km operational NAM
! Milbrandt and Yau (2005)
!----------------------------------------------------------------------
IMPLICIT NONE
!======================================================================
! Grid structure in physics part of WRF
!----------------------------------------------------------------------
! The horizontal velocities used in the physics are unstaggered
! relative to temperature/moisture variables. All predicted
! variables are carried at half levels except w, which is at full
! levels. Some arrays with names (*8w) are at w (full) levels.
!
!----------------------------------------------------------------------
! In WRF, kms (smallest number) is the bottom level and kme (largest
! number) is the top level. In your scheme, if 1 is at the top level,
! then you have to reverse the order in the k direction.
!
! kme - half level (no data at this level)
! kme ----- full level
! kme-1 - half level
! kme-1 ----- full level
! .
! .
! .
! kms+2 - half level
! kms+2 ----- full level
! kms+1 - half level
! kms+1 ----- full level
! kms - half level
! kms ----- full level
!
!======================================================================
! Definitions
!-----------
! Rho_d dry density (kg/m^3)
! Theta_m moist potential temperature (K)
! Qv water vapor mixing ratio (kg/kg)
! Qc cloud water mixing ratio (kg/kg)
! Qr rain water mixing ratio (kg/kg)
! Qi cloud ice mixing ratio (kg/kg)
! Qs snow mixing ratio (kg/kg)
! Qg graupel mixing ratio (kg/kg)
! Qh hail mixing ratio (kg/kg)
! Qndrop droplet number mixing ratio (#/kg)
! Qni cloud ice number concentration (#/kg)
! Qns snow number concentration (#/kg)
! Qnr rain number concentration (#/kg)
! Qng graupel number concentration (#/kg)
! Qnh hail number concentration (#/kg)
! Qzr rain reflectivity (m6/kg)
! Qzi ice reflectivity (m6/kg)
! Qzs snow reflectivity (m6/kg)
! Qzg graupel reflectivity (m6/kg)
! Qzh hail reflectivity (m6/kg)
! Qvolg graupel particle volume (m3/kg)
!
!----------------------------------------------------------------------
!-- th potential temperature (K)
!-- moist_new updated moisture array (kg/kg)
!-- moist_old Old moisture array (kg/kg)
!-- rho density of air (kg/m^3)
!-- pi_phy exner function (dimensionless)
!-- p pressure (Pa)
!-- RAINNC grid scale precipitation (mm)
!-- RAINNCV one time step grid scale precipitation (mm/step)
!-- SNOWNC grid scale snow and ice (mm)
!-- SNOWNCV one time step grid scale snow and ice (mm/step)
!-- GRAUPELNC grid scale graupel (mm)
!-- GRAUPELNCV one time step grid scale graupel (mm/step)
!-- HAILNC grid scale hail (mm)
!-- HAILNCV one time step grid scale hail (mm/step)
!-- SR one time step mass ratio of snow to total precip
!-- z Height above sea level (m)
!-- dt Time step (s)
!-- G acceleration due to gravity (m/s^2)
!-- CP heat capacity at constant pressure for dry air (J/kg/K)
!-- R_d gas constant for dry air (J/kg/K)
!-- R_v gas constant for water vapor (J/kg/K)
!-- XLS latent heat of sublimation (J/kg)
!-- XLV latent heat of vaporization (J/kg)
!-- XLF latent heat of melting (J/kg)
!-- rhowater water density (kg/m^3)
!-- rhosnow snow density (kg/m^3)
!-- F_ICE_PHY Fraction of ice.
!-- F_RAIN_PHY Fraction of rain.
!-- F_RIMEF_PHY Mass ratio of rimed ice (rime factor)
!-- t8w temperature at layer interfaces
!-- cldfra, cldfra_old, current, previous cloud fraction
!-- exch_h vertical diffusivity (m2/s)
!-- qlsink Fractional cloud water sink (/s)
!-- precr rain precipitation rate at all levels (kg/m2/s)
!-- preci ice precipitation rate at all levels (kg/m2/s)
!-- precs snow precipitation rate at all levels (kg/m2/s)
!-- precg graupel precipitation rate at all levels (kg/m2/s) &
!-- P_QV species index for water vapor
!-- P_QC species index for cloud water
!-- P_QR species index for rain water
!-- P_QI species index for cloud ice
!-- P_QS species index for snow
!-- P_QG species index for graupel
!-- P_QH species index for hail
!-- P_QNDROP species index for cloud drop mixing ratio
!-- P_QNR species index for rain number concentration,
!-- P_QNI species index for cloud ice number concentration
!-- P_QNS species index for snow number concentration,
!-- P_QNG species index for graupel number concentration,
!-- P_QNH species index for hail number concentration,
!-- P_QZR species index for rain reflectivity
!-- P_QZI species index for ice reflectivity
!-- P_QZS species index for snow reflectivity
!-- P_QZG species index for graupel reflectivity
!-- P_QZH species index for hail reflectivity
!-- P_QVOLG species index for graupel particle volume,
!-- id grid id number
!-- ids start index for i in domain
!-- ide end index for i in domain
!-- jds start index for j in domain
!-- jde end index for j in domain
!-- kds start index for k in domain
!-- kde end index for k in domain
!-- ims start index for i in memory
!-- ime end index for i in memory
!-- jms start index for j in memory
!-- jme end index for j in memory
!-- kms start index for k in memory
!-- kme end index for k in memory
!-- i_start start indices for i in tile
!-- i_end end indices for i in tile
!-- j_start start indices for j in tile
!-- j_end end indices for j in tile
!-- its start index for i in tile
!-- ite end index for i in tile
!-- jts start index for j in tile
!-- jte end index for j in tile
!-- kts start index for k in tile
!-- kte end index for k in tile
!-- num_tiles number of tiles
!-- diagflag Logical to tell us when to produce diagnostics for history or restart
!
!======================================================================
INTEGER, INTENT(IN ) :: mp_physics
LOGICAL, INTENT(IN ) :: specified
INTEGER, OPTIONAL, INTENT(IN ) :: chem_opt, progn
INTEGER, OPTIONAL, INTENT(IN ) :: hail, ice2 !, ccntype
!
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, OPTIONAL, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
INTEGER, INTENT(IN ) :: kts,kte
INTEGER, INTENT(IN ) :: itimestep,num_tiles,spec_zone
INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
& i_start,i_end,j_start,j_end
LOGICAL, INTENT(IN ) :: warm_rain
!
REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
INTENT(INOUT) :: th
!
!
REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
INTENT(IN ) :: &
rho, &
dz8w, &
p8w, &
pi_phy, &
p
REAL, INTENT(INOUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
!!$#ifdef WRF_CHEM
! REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
!!$#else
!!$ REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: &
!!$#endif
qlsink, & ! cloud water sink (/s)
precr, & ! rain precipitation rate at all levels (kg/m2/s)
preci, & ! ice precipitation rate at all levels (kg/m2/s)
precs, & ! snow precipitation rate at all levels (kg/m2/s)
precg ! graupel precipitation rate at all levels (kg/m2/s)
!
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAND
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: SR
REAL, INTENT(IN ) :: dt,dx,dy
INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
!
! Optional
!
REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT) :: refl_10cm
LOGICAL, OPTIONAL, INTENT(IN ) :: channel_switch
REAL, OPTIONAL, INTENT(INOUT ) :: naer ! aerosol number concentration (/kg)
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
OPTIONAL, &
INTENT(INOUT ) :: &
w, z, t8w &
,cldfra, cldfra_old, exch_h &
,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
,qt_curr,qndrop_curr,qni_curr,qh_curr,qnh_curr &
,qns_curr,qnr_curr,qng_curr,qnn_curr,qnc_curr &
,qzr_curr,qzi_curr,qzs_curr,qzg_curr,qzh_curr &
,qvolg_curr
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
OPTIONAL, &
INTENT(IN) :: qrcuten, qscuten, qicuten
#ifdef WRF_CHEM
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
INTENT(INOUT) :: rainprod, evapprod
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
INTENT(INOUT) :: qv_b4mp, qc_b4mp, qi_b4mp, qs_b4mp
#endif
REAL, DIMENSION( ims:ime, jms:jme ), &
OPTIONAL, &
INTENT(IN) :: mu
! YLIN
! Added RI_CURR similar to microphysics fields above
REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
OPTIONAL, &
INTENT(INOUT) :: ri_curr
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), &
OPTIONAL, &
INTENT(OUT ) :: &
nsource
!
REAL, DIMENSION( ims:ime , jms:jme ), &
INTENT(INOUT), &
OPTIONAL :: &
RAINNC &
,RAINNCV &
,SNOWNC &
,SNOWNCV &
,GRAUPELNC &
,GRAUPELNCV &
,HAILNC &
,HAILNCV
INTEGER,OPTIONAL,INTENT(IN ) :: id
REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL , &
INTENT(IN) :: ht
REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
,tbpvs_state,tbpvs0_state
!
LOGICAL, OPTIONAL :: f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni,f_qt &
,f_qns,f_qnr,f_qng,f_qnn,f_qnc,f_qh,f_qnh,f_qzr &
,f_qzi,f_qzs,f_qzg,f_qzh,f_qvolg
LOGICAL, OPTIONAL :: diagflag
! LOCAL VAR
INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
LOGICAL :: channel
!---------------------------------------------------------------------
! check for microphysics type. We need a clean way to
! specify these things!
!---------------------------------------------------------------------
channel = .FALSE.
IF ( PRESENT ( channel_switch ) ) channel = channel_switch
if (mp_physics .eq. 0) return
IF( specified ) THEN
sz = spec_zone
ELSE
sz = 0
ENDIF
#ifndef RUN_ON_GPU
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
DO ij = 1 , num_tiles
IF (channel) THEN
its = max(i_start(ij),ids)
ite = min(i_end(ij),ide-1)
ELSE
its = max(i_start(ij),ids+sz)
ite = min(i_end(ij),ide-1-sz)
ENDIF
jts = max(j_start(ij),jds+sz)
jte = min(j_end(ij),jde-1-sz)
#else
DO ij = 1 , 1
IF (channel) THEN
its = max(ips,ids)
ite = min(ipe,ide-1)
ELSE
its = max(ips,ids+sz)
ite = min(ipe,ide-1-sz)
ENDIF
jts = max(jps,jds+sz)
jte = min(jpe,jde-1-sz)
#endif
! 2009-06009 rce - zero all these for safety
IF( PRESENT(qlsink) ) qlsink(its:ite,kts:kte,jts:jte) = 0.
IF( PRESENT(precr ) ) precr(its:ite,kts:kte,jts:jte) = 0.
IF( PRESENT(preci ) ) preci(its:ite,kts:kte,jts:jte) = 0.
IF( PRESENT(precs ) ) precs(its:ite,kts:kte,jts:jte) = 0.
IF( PRESENT(precg ) ) precg(its:ite,kts:kte,jts:jte) = 0.
!-----------
IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
IF( chem_opt==0 .AND. progn==1 .AND. (mp_physics==LINSCHEME .OR. mp_physics==MORR_TWO_MOMENT)) THEN
IF( PRESENT( QNDROP_CURR ) ) THEN
CALL wrf_debug ( 100 , 'microphysics_driver: calling prescribe_aerosol_mixactivate' )
! 06-nov-2005 rce - id & itimestep added to arg list
call prescribe_aerosol_mixactivate ( &
id, itimestep, dt, naer, &
rho, th, pi_phy, w, cldfra, cldfra_old, &
z, dz8w, p8w, t8w, exch_h, &
qv_curr, qc_curr, qi_curr, qndrop_curr, &
nsource, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
F_QC=f_qc, F_QI=f_qi )
END IF
ELSE IF( progn==1 .AND. mp_physics/=LINSCHEME .AND. mp_physics/=MORR_TWO_MOMENT) THEN
call wrf_error_fatal("SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME or MORRISON.")
END IF
END IF
micro_select: SELECT CASE(mp_physics)
CASE (KESSLERSCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( Z )) THEN
CALL kessler( &
T=th &
,QV=qv_curr &
,QC=qc_curr &
,QR=qr_curr &
,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater &
,DZ8W=dz8w &
,RAINNC=rainnc,RAINNCV=rainncv &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
ENDIF
!
CASE (THOMPSON)
CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
PRESENT( QNR_CURR) .AND. PRESENT ( QNI_CURR) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
#ifdef WRF_CHEM
qv_b4mp(its:ite,kts:kte,jts:jte) = qv_curr(its:ite,kts:kte,jts:jte)
qc_b4mp(its:ite,kts:kte,jts:jte) = qc_curr(its:ite,kts:kte,jts:jte)
qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
#endif
CALL mp_gt_driver( &
QV=qv_curr, &
QC=qc_curr, &
QR=qr_curr, &
QI=qi_curr, &
QS=qs_curr, &
QG=qg_curr, &
NI=qni_curr, &
NR=qnr_curr, &
TH=th, &
PII=pi_phy, &
P=p, &
DZ=dz8w, &
DT_IN=dt, &
ITIMESTEP=itimestep, &
RAINNC=RAINNC, &
RAINNCV=RAINNCV, &
SNOWNC=SNOWNC, &
SNOWNCV=SNOWNCV, &
GRAUPELNC=GRAUPELNC, &
GRAUPELNCV=GRAUPELNCV, &
SR=SR, &
#ifdef WRF_CHEM
RAINPROD=rainprod, &
EVAPPROD=evapprod, &
#endif
! refl_10cm, grid_clock, grid_alarms, &
IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
ENDIF
!
CASE (MORR_TWO_MOMENT)
CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
PRESENT (QS_CURR) .AND. PRESENT (QG_CURR) .AND. &
PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
PRESENT (QNS_CURR) .AND. PRESENT (QNI_CURR).AND. &
PRESENT (QNR_CURR) .AND. PRESENT (QNG_CURR).AND. &
PRESENT (MU) .AND. PRESENT (QSCUTEN).AND. &
PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
PRESENT (Z ) .AND.PRESENT ( W ) ) THEN
CALL mp_morr_two_moment( &
ITIMESTEP=itimestep, & !*
TH=th, & !*
QV=qv_curr, & !*
QC=qc_curr, & !*
QR=qr_curr, & !*
QI=qi_curr, & !*
QS=qs_curr, & !*
QG=qg_curr, & !*
NI=qni_curr, & !*
NS=qns_curr, & !* ! VVT
NR=qnr_curr, & !* ! VVT
NG=qng_curr, & !* ! VVT
RHO=rho, & !*
PII=pi_phy, & !*
P=p, & !*
DT_IN=dt, & !*
DZ=dz8w, & !* !hm
HT=ht, & !*
W=w & !*
,RAINNC=RAINNC & !*
,RAINNCV=RAINNCV & !*
,SR=SR & !* !hm
,qrcuten=qrcuten & ! hm
,qscuten=qscuten & ! hm
,qicuten=qicuten & ! hm
,mu=mu & ! hm
,F_QNDROP=f_qndrop & ! hm for wrf-chem
,QNDROP=qndrop_curr & ! hm for wrf-chem
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
,QLSINK=qlsink & ! jdf for wrf-chem
,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg & ! jdf for wrf-chem
)
ELSE
Call wrf_error_fatal( 'arguments not present for calling morrison two moment')
ENDIF
CASE (MILBRANDT2MOM)
CALL wrf_debug(100, 'microphysics_driver: calling milbrandt2mom')
IF (PRESENT (QV_CURR) .AND. &
PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. &
PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. &
PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. &
PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. &
PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. &
PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. &
PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. &
PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
PRESENT (Z ) .AND. PRESENT ( W ) ) THEN
! PRESENT (ccntype) &
CALL mp_milbrandt2mom_driver( &
ITIMESTEP=itimestep, &
TH=th, &
QV=qv_curr, &
QC=qc_curr, &
QR=qr_curr, &
QI=qi_curr, &
QS=qs_curr, &
QG=qg_curr, &
QH=qh_curr, &
NC=qnc_curr, &
NR=qnr_curr, &
NI=qni_curr, &
NS=qns_curr, &
NG=qng_curr, &
NH=qnh_curr, &
PII=pi_phy, &
P=p, &
DT_IN=dt, &
DZ=dz8w, &
W=w, &
RAINNC = RAINNC, &
RAINNCV = RAINNCV, &
SNOWNC = SNOWNC, &
SNOWNCV = SNOWNCV, &
HAILNC = HAILNC, &
HAILNCV = HAILNCV, &
GRPLNC = GRAUPELNC, &
GRPLNCV = GRAUPELNCV, &
SR=SR, &
! ccntype = ccntype, &
Zet = refl_10cm, & ! HM, 9/22/09 for refl
IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
Call wrf_error_fatal( 'arguments not present for calling milbrandt2mom')
ENDIF
! CASE (MILBRANDT3MOM)
! CALL wrf_debug(100, 'microphysics_driver: calling milbrandt3mom')
! IF (PRESENT (QV_CURR) .AND. &
! PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
! PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. PRESENT (QZR_CURR) .AND. &
! PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. PRESENT (QZI_CURR) .AND. &
! PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. PRESENT (QZS_CURR) .AND. &
! PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. PRESENT (QZG_CURR) .AND. &
! PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. PRESENT (QZH_CURR) .AND. &
! PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
! PRESENT (Z ) .AND. PRESENT ( W ) ) THEN
! CALL mp_milbrandt3mom_driver( &
! ITIMESTEP=itimestep, & !*
! TH=th, & !*
! QV=qv_curr, & !*
! QC=qc_curr, & !*
! QR=qr_curr, & !*
! QI=qi_curr, & !*
! QS=qs_curr, & !*
! QG=qg_curr, & !*
! QH=qh_curr, & !*
! NC=qnc_curr, & !*
! NR=qnr_curr, & !*
! NI=qni_curr, & !*
! NS=qns_curr, & !*
! NG=qng_curr, & !*
! NH=qnh_curr, & !*
! ZR=qzr_curr, & !*
! ZI=qzi_curr, & !*
! ZS=qzs_curr, & !*
! ZG=qzg_curr, & !*
! ZH=qzh_curr, & !*
! PII=pi_phy, & !*
! P=p, & !*
! DT_IN=dt, & !*
! DZ=dz8w, & !* ! h
! W=w & !*
! ,RAINNC=RAINNC & !*
! ,RAINNCV=RAINNCV & !*
! ,SR=SR & !* !hm
! ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
! ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
! ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
! )
! ELSE
! Call wrf_error_fatal( 'arguments not present for calling milbrandt3mom')
! ENDIF
#if (EM_CORE==1)
CASE (NSSL_2MOM)
CALL wrf_debug(100, 'microphysics_driver: calling nssl2mom')
IF (PRESENT (QV_CURR) .AND. &
PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. &
PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. &
PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. &
PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. &
PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. &
PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. &
PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. &
PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
PRESENT (Z ) .AND. PRESENT ( W ) .AND. &
PRESENT (QVOLG_CURR) ) THEN
CALL nssl_2mom_driver( &
ITIMESTEP=itimestep, &
TH=th, &
QV=qv_curr, &
QC=qc_curr, &
QR=qr_curr, &
QI=qi_curr, &
QS=qs_curr, &
QH=qg_curr, &
QHL=qh_curr, &
CCW=qnc_curr, &
CRW=qnr_curr, &
CCI=qni_curr, &
CSW=qns_curr, &
CHW=qng_curr, &
CHL=qnh_curr, &
VHW=qvolg_curr, &
PII=pi_phy, &
P=p, &
W=w, &
DZ=dz8w, &
DTP=dt, &
DN=rho, &
RAINNC = RAINNC, &
RAINNCV = RAINNCV, &
SNOWNC = SNOWNC, &
SNOWNCV = SNOWNCV, &
HAILNC = HAILNC, &
HAILNCV = HAILNCV, &
GRPLNC = GRAUPELNC, &
GRPLNCV = GRAUPELNCV, &
SR=SR, &
dbz = refl_10cm, &
diagflag = diagflag, &
IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
Call wrf_error_fatal( 'arguments not present for calling nssl_2mom')
ENDIF
CASE (NSSL_2MOMCCN)
CALL wrf_debug(100, 'microphysics_driver: calling nssl_2momccn')
IF (PRESENT (QV_CURR) .AND. &
PRESENT (QC_CURR) .AND. PRESENT (QNC_CURR) .AND. &
PRESENT (QR_CURR) .AND. PRESENT (QNR_CURR) .AND. &
PRESENT (QI_CURR) .AND. PRESENT (QNI_CURR) .AND. &
PRESENT (QS_CURR) .AND. PRESENT (QNS_CURR) .AND. &
PRESENT (QG_CURR) .AND. PRESENT (QNG_CURR) .AND. &
PRESENT (QH_CURR) .AND. PRESENT (QNH_CURR) .AND. &
PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
PRESENT (SNOWNC ) .AND. PRESENT (SNOWNCV) .AND. &
PRESENT (HAILNC ) .AND. PRESENT (HAILNCV) .AND. &
PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
PRESENT (Z ) .AND. PRESENT ( W ) .AND. &
PRESENT (QVOLG_CURR) .AND. PRESENT( QNN_CURR ) ) THEN
CALL nssl_2mom_driver( &
ITIMESTEP=itimestep, &
TH=th, &
QV=qv_curr, &
QC=qc_curr, &
QR=qr_curr, &
QI=qi_curr, &
QS=qs_curr, &
QH=qg_curr, &
QHL=qh_curr, &
CCW=qnc_curr, &
CRW=qnr_curr, &
CCI=qni_curr, &
CSW=qns_curr, &
CHW=qng_curr, &
CHL=qnh_curr, &
VHW=qvolg_curr, &
cn=qnn_curr, &
PII=pi_phy, &
P=p, &
W=w, &
DZ=dz8w, &
DTP=dt, &
DN=rho, &
RAINNC = RAINNC, &
RAINNCV = RAINNCV, &
SNOWNC = SNOWNC, &
SNOWNCV = SNOWNCV, &
HAILNC = HAILNC, &
HAILNCV = HAILNCV, &
GRPLNC = GRAUPELNC, &
GRPLNCV = GRAUPELNCV, &
SR=SR, &
dbz = refl_10cm, &
diagflag = diagflag, &
IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme, &
ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
Call wrf_error_fatal( 'arguments not present for calling nssl_2momccn')
ENDIF
#endif
!
CASE (GSFCGCESCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling GSFCGCE' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( HAIL ) .AND. PRESENT ( ICE2 ) .AND. &
PRESENT( Z ) .AND. PRESENT ( W ) ) THEN
CALL gsfcgce( &
TH=th &
,QV=qv_curr &
,QL=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
,HT=ht, DZ8W=dz8w, GRAV=G &
,RHOWATER=rhowater, RHOSNOW=rhosnow &
,ITIMESTEP=itimestep &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
,RAINNC=rainnc, RAINNCV=rainncv &
,SNOWNC=snownc, SNOWNCV=snowncv ,SR=sr &
,GRAUPELNC=graupelnc ,GRAUPELNCV=graupelncv &
,F_QG=f_qg &
,QG=qg_curr &
,IHAIL=hail, ICE2=ice2 &
)
! HAIL = 1, run gsfcgce with hail option
! 0, run gsfcgce with graupel option <---- default
! note: no effect if ice2 = 1
! ICE2 = 1, run gsfcgce with only snow, ice
! 2, run gsfcgce with only graupel, ice
! 0, run gsfcgce with snow, ice and hail/graupel <---- default
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling GSFCGCE' )
ENDIF
CASE (LINSCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( Z ) ) THEN
CALL lin_et_al( &
TH=th &
,QV=qv_curr &
,QL=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,QLSINK=qlsink &
,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
,HT=ht, DZ8W=dz8w, GRAV=G, CP=cp &
,RAIR=r_d, RVAPOR=R_v &
,XLS=xls, XLV=xlv, XLF=xlf &
,RHOWATER=rhowater, RHOSNOW=rhosnow &
,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
,SVP3=svp3,SVPT0=svpt0 &
,RAINNC=rainnc, RAINNCV=rainncv &
,SNOWNC=snownc, SNOWNCV=snowncv &
,GRAUPELNC=graupelnc, GRAUPELNCV=graupelncv, SR=sr &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg &
,F_QG=f_qg, F_QNDROP=f_qndrop &
,QG=qg_curr &
,QNDROP=qndrop_curr &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
ENDIF
CASE (SBU_YLINSCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling sbu_ylin' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. &
PRESENT( RI_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( Z ) ) THEN
CALL sbu_ylin( &
TH=th &
,QV=qv_curr &
,QL=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,RI3D=ri_curr &
! ,QLSINK=qlsink &
,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z &
,HT=ht, DZ8W=dz8w &
! , GRAV=G, CP=cp &
! ,RAIR=r_d, RVAPOR=R_v &
! ,XLS=xls, XLV=xlv, XLF=xlf &
! ,RHOWATER=rhowater, RHOSNOW=rhosnow &
! ,EP2=ep_2,SVP1=svp1,SVP2=svp2 &
! ,SVP3=svp3,SVPT0=svpt0 &
,RAINNC=rainnc, RAINNCV=rainncv &
! ,SNOWNC=snownc, SNOWNCV=snowncv &
! ,GRAUPELNC=graupelnc, GRAUPELNCV=graupelncv, SR=sr &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
! ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg &
! ,F_QG=f_qg &
! ,F_QNDROP=f_qndrop &
! ,QG=qg_curr &
! ,QNDROP=qndrop_curr &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling sbu_ylin' )
ENDIF
CASE (WSM3SCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( W ) ) THEN
CALL wsm3( &
TH=th &
,Q=qv_curr &
,QCI=qc_curr &
,QRS=qr_curr &
,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
,DELT=dt,G=g,CPD=cp,CPV=cpv &
,RD=r_d,RV=r_v,T0C=svpt0 &
,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
,XLS=xls, XLV0=xlv, XLF0=xlf &
,DEN0=rhoair0, DENR=rhowater &
,CLIQ=cliq,CICE=cice,PSAT=psat &
,RAIN=rainnc ,RAINNCV=rainncv &
,SNOW=snownc ,SNOWNCV=snowncv &
,SR=sr &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
ENDIF
CASE (WSM5SCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
CALL wsm5( &
TH=th &
,Q=qv_curr &
,QC=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
,DELT=dt,G=g,CPD=cp,CPV=cpv &
,RD=r_d,RV=r_v,T0C=svpt0 &
,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
,XLS=xls, XLV0=xlv, XLF0=xlf &
,DEN0=rhoair0, DENR=rhowater &
,CLIQ=cliq,CICE=cice,PSAT=psat &
,RAIN=rainnc ,RAINNCV=rainncv &
,SNOW=snownc ,SNOWNCV=snowncv &
,SR=sr &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
ENDIF
CASE (WSM6SCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
CALL wsm6( &
TH=th &
,Q=qv_curr &
,QC=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,QG=qg_curr &
,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
,DELT=dt,G=g,CPD=cp,CPV=cpv &
,RD=r_d,RV=r_v,T0C=svpt0 &
,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
,XLS=xls, XLV0=xlv, XLF0=xlf &
,DEN0=rhoair0, DENR=rhowater &
,CLIQ=cliq,CICE=cice,PSAT=psat &
,RAIN=rainnc ,RAINNCV=rainncv &
,SNOW=snownc ,SNOWNCV=snowncv &
,SR=sr &
,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
ENDIF
CASE (WDM5SCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling wdm5' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. PRESENT( QNN_CURR ) .AND. &
PRESENT ( QNC_CURR ) .AND. PRESENT( QNR_CURR ).AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
CALL wdm5( &
TH=th &
,Q=qv_curr &
,QC=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,NN=qnn_curr &
,NC=qnc_curr &
,NR=qnr_curr &
,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
,DELT=dt,G=g,CPD=cp,CPV=cpv,CCN0=n_ccn0 &
,RD=r_d,RV=r_v,T0C=svpt0 &
,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
,XLS=xls, XLV0=xlv, XLF0=xlf &
,DEN0=rhoair0, DENR=rhowater &
,CLIQ=cliq,CICE=cice,PSAT=psat &
,RAIN=rainnc ,RAINNCV=rainncv &
,SNOW=snownc ,SNOWNCV=snowncv &
,SR=sr &
,ITIMESTEP=itimestep &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling wdm5')
ENDIF
CASE (WDM6SCHEME)
CALL wrf_debug ( 100 , 'microphysics_driver: calling wdm6' )
IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. &
PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND. &
PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND. &
PRESENT( QNN_CURR ) .AND. PRESENT ( QNC_CURR ) .AND. &
PRESENT( QNR_CURR ).AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) ) THEN
CALL wdm6( &
TH=th &
,Q=qv_curr &
,QC=qc_curr &
,QR=qr_curr &
,QI=qi_curr &
,QS=qs_curr &
,QG=qg_curr &
,NN=qnn_curr &
,NC=qnc_curr &
,NR=qnr_curr &
,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w &
,DELT=dt,G=g,CPD=cp,CPV=cpv,CCN0=n_ccn0 &
,RD=r_d,RV=r_v,T0C=svpt0 &
,EP1=ep_1, EP2=ep_2, QMIN=epsilon &
,XLS=xls, XLV0=xlv, XLF0=xlf &
,DEN0=rhoair0, DENR=rhowater &
,CLIQ=cliq,CICE=cice,PSAT=psat &
,RAIN=rainnc ,RAINNCV=rainncv &
,SNOW=snownc ,SNOWNCV=snowncv &
,SR=sr &
,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv &
,ITIMESTEP=itimestep &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling wdm6')
ENDIF
#if(NMM_CORE==1)
CASE (ETAMP_HWRF)
CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew_HWRF')
IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( mp_restart_state ) .AND. &
PRESENT( tbpvs_state ) .AND. &
PRESENT( tbpvs0_state ) ) THEN
CALL ETAMP_NEW_HWRF( &
ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy, GID=id &
,RAINNC=rainnc,RAINNCV=rainncv &
,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
,QV=qv_curr &
,QT=qt_curr &
,LOWLYR=LOWLYR,SR=SR &
,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
,F_RIMEF_PHY=F_RIMEF_PHY &
,QC=qc_curr,QR=Qr_curr,QI=Qi_curr &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
ENDIF
#endif
CASE (ETAMPNEW) !-- Operational 4-km High-Resolution Window (HRW) version
CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( mp_restart_state ) .AND. &
PRESENT( tbpvs_state ) .AND. &
PRESENT( tbpvs0_state ) ) THEN
CALL ETAMP_NEW( &
ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
,QV=qv_curr &
,QC=qc_curr &
,QS=qs_curr &
,QR=qr_curr &
,QT=qt_curr &
,LOWLYR=LOWLYR,SR=SR &
,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
,F_RIMEF_PHY=F_RIMEF_PHY &
,RAINNC=rainnc,RAINNCV=rainncv &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
,MP_RESTART_STATE=mp_restart_state &
,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
ENDIF
CASE (ETAMPOLD) !-- What was run in the operational NAM (WRF NMM)
CALL wrf_debug ( 100 , 'microphysics_driver: calling etampold')
IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. &
PRESENT( mp_restart_state ) .AND. &
PRESENT( tbpvs_state ) .AND. &
PRESENT( tbpvs0_state ) ) THEN
CALL ETAMP_OLD( &
ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy &
,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
,QV=qv_curr &
,QC=qc_curr &
,QS=qs_curr &
,QR=qr_curr &
,QT=qt_curr &
,LOWLYR=LOWLYR,SR=SR &
,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY &
,F_RIMEF_PHY=F_RIMEF_PHY &
,RAINNC=rainnc,RAINNCV=rainncv &
,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
,MP_RESTART_STATE=mp_restart_state &
,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
)
ELSE
CALL wrf_error_fatal ( 'arguments not present for calling etampold' )
ENDIF
CASE DEFAULT
WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
CALL wrf_error_fatal ( wrf_err_message )
END SELECT micro_select
ENDDO
#ifndef RUN_ON_GPU
!$OMP END PARALLEL DO
#endif
CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
RETURN
END SUBROUTINE microphysics_driver
END MODULE module_microphysics_driver