!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 & ,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 & ,qrcuten, qscuten, qicuten, mu & ,qt_curr,f_qt & ,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew ,hail,ice2 & ! for mp_gsfcgce ! ,ccntype & ! for mp_milbrandt2mom ,w ,z & ,rainnc, rainncv & ,snownc, snowncv & ,hailnc, hailncv & ,graupelnc, graupelncv & ,refl_10cm & ! HM, 9/22/09, add for refl ! YLIN ! Added the RI_CURR array to the call ,ri_curr & ) ! Framework #if(NMM_CORE==1) USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, ETAMPNEW, 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,THOMPSON, MORR_TWO_MOMENT & ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME & ,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_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 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) ! 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) ! !---------------------------------------------------------------------- !-- 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 !-- 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 ! !====================================================================== 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 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & OPTIONAL, & INTENT(IN) :: qrcuten, qscuten, qicuten 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 ! 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 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 & ! 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 ! 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) 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 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