!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 & ,xland,itimestep & ,f_ice_phy,f_rain_phy,f_rimef_phy & ,lowlyr,sr & ,ids,ide, jds,jde, kds,kde & ,ims,ime, jms,jme, kms,kme & ,i_start,i_end,j_start,j_end,kts,kte,num_tiles & ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr & ,qni_curr & ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qni & ,qt_curr,f_qt & ,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew ,w ,z & ,rainnc, rainncv & ,snownc, snowncv & ,graupelnc, graupelncv & ) ! Framework USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, ETAMPNEW, NCEPCLOUD3, NCEPCLOUD5, THOMPSON ! 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_ncloud3 USE module_mp_ncloud5 USE module_mp_wsm3 USE module_mp_wsm5 USE module_mp_wsm6 USE module_mp_etanew USE module_mp_thompson !---------------------------------------------------------------------- ! 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) ! NCEP cloud3, Hong et al. (1998) with some mod, Dudhia (1989) ! NCEP cloud5, Hong et al. (1998) with some mod, Rutledge and Hobbs (1984) ! !---------------------------------------------------------------------- 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) ! Qni cloud ice number concentration (#/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) !-- 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) !-- 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_QNI species index for cloud ice number concentration !-- 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, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme 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 ! 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 ! LOGICAL, OPTIONAL, INTENT(IN ) :: channel_switch REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & OPTIONAL, & INTENT(INOUT ) :: & w, z & ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr & ,qt_curr,qni_curr ! REAL, DIMENSION( ims:ime , jms:jme ), & INTENT(INOUT), & OPTIONAL :: & RAINNC & ,RAINNCV & ,SNOWNC & ,SNOWNCV & ,GRAUPELNC & ,GRAUPELNCV 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_qni,f_qt ! 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 !$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) !----------- 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 et al' ) 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 ( 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, & TH=th, & PII=pi_phy, & P=p, & DZ=dz8w, & DT_IN=dt, & ITIMESTEP=itimestep, & RAINNC=RAINNC, & RAINNCV=RAINNCV, & 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 thompson_et_al' ) 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 & ,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 & ,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 & ,F_QG=f_qg & ,QG=qg_curr & ) ELSE CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' ) 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 (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 (NCEPCLOUD3) CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud3' ) IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND. & PRESENT( QR_CURR ) .AND. & PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. & PRESENT( W ) ) THEN CALL ncloud3( & 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 & ,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 ncepcloud3' ) ENDIF CASE (NCEPCLOUD5) CALL wrf_debug ( 100 , 'microphysics_driver: calling ncloud5' ) 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 ) .AND. & PRESENT( W ) ) THEN CALL ncloud5( & TH=th & ,Q=qv_curr & ,QC=qc_curr & ,QR=qr_curr & ,QI=qi_curr & ,QS=qs_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 & ,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 ncepcloud5' ) 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 !$OMP END PARALLEL DO CALL wrf_debug ( 200 , 'microphysics_driver: returning from' ) RETURN END SUBROUTINE microphysics_driver END MODULE module_microphysics_driver