From 40f93615293f648b8473ffff101a372c4ad781f1 Mon Sep 17 00:00:00 2001 From: "Haiqin.Li" Date: Mon, 13 Mar 2023 17:20:01 +0000 Subject: [PATCH] "include the MYNN-EDMF update from PR #43" --- physics/module_bl_mynn.F90 | 3172 ++++++++++++++++----------------- physics/mynnedmf_wrapper.F90 | 424 ++--- physics/mynnedmf_wrapper.meta | 60 +- physics/sgscloud_radpre.F90 | 132 +- physics/sgscloud_radpre.meta | 38 + 5 files changed, 1965 insertions(+), 1861 deletions(-) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index d1fae478d..51a906faf 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -121,7 +121,7 @@ ! Hybrid PBL height diagnostic, which blends a theta-v-based ! definition in neutral/convective BL and a TKE-based definition ! in stable conditions. -! TKE budget output option (bl_mynn_tkebudget) +! TKE budget output option ! v3.5.0: TKE advection option (bl_mynn_tkeadvect) ! v3.5.1: Fog deposition related changes. ! v3.6.0: Removed fog deposition from the calculation of tendencies @@ -216,14 +216,14 @@ ! Misc small-impact bugfixes: ! 1) dz was incorrectly indexed in mym_condensation ! 2) configurations with icloud_bl = 0 were using uninitialized arrays -! v4.4 / CCPP +! v4.5 / CCPP ! This version includes many modifications that proved valuable in the global ! framework and removes some key lingering bugs in the mixing of chemical species. ! TKE Budget output fixed (Puhales, 2020-12) ! New option for stability function: (Puhales, 2020-12) ! bl_mynn_stfunc = 0 (original, Kansas-type function, Paulson, 1970 ) ! bl_mynn_stfunc = 1 (expanded range, same as used for Jimenez et al (MWR) -! see the Technical Note for this implementation. +! see the Technical Note for this implementation (small impact). ! Improved conservation of momentum and higher-order moments. ! Important bug fixes for mixing of chemical species. ! Addition of pressure-gradient effects on updraft momentum transport. @@ -253,58 +253,48 @@ MODULE module_bl_mynn IMPLICIT NONE -!get rid - INTEGER , PARAMETER :: param_first_scalar = 1, & - & p_qc = 2, & - & p_qr = 0, & - & p_qi = 2, & - & p_qs = 0, & - & p_qg = 0, & - & p_qnc= 0, & - & p_qni= 0 - !=================================================================== ! From here on, these are MYNN-specific parameters: ! The parameters below depend on stability functions of module_sf_mynn. - REAL, PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & - cphh_st=5.0, cphh_unst=16.0 + real(kind_phys), PARAMETER :: cphm_st=5.0, cphm_unst=16.0, & + cphh_st=5.0, cphh_unst=16.0 ! Closure constants - REAL, PARAMETER :: & - &pr = 0.74, & - &g1 = 0.235, & ! NN2009 = 0.235 - &b1 = 24.0, & - &b2 = 15.0, & ! CKmod NN2009 - &c2 = 0.729, & ! 0.729, & !0.75, & - &c3 = 0.340, & ! 0.340, & !0.352, & - &c4 = 0.0, & - &c5 = 0.2, & + real(kind_phys), PARAMETER :: & + &pr = 0.74, & + &g1 = 0.235, & ! NN2009 = 0.235 + &b1 = 24.0, & + &b2 = 15.0, & ! CKmod NN2009 + &c2 = 0.729, & ! 0.729, & !0.75, & + &c3 = 0.340, & ! 0.340, & !0.352, & + &c4 = 0.0, & + &c5 = 0.2, & &a1 = b1*( 1.0-3.0*g1 )/6.0, & ! &c1 = g1 -1.0/( 3.0*a1*b1**(1.0/3.0) ), & &c1 = g1 -1.0/( 3.0*a1*2.88449914061481660), & &a2 = a1*( g1-c1 )/( g1*pr ), & &g2 = b2/b1*( 1.0-c3 ) +2.0*a1/b1*( 3.0-2.0*c2 ) - REAL, PARAMETER :: & - &cc2 = 1.0-c2, & - &cc3 = 1.0-c3, & - &e1c = 3.0*a2*b2*cc3, & - &e2c = 9.0*a1*a2*cc2, & + real(kind_phys), PARAMETER :: & + &cc2 = 1.0-c2, & + &cc3 = 1.0-c3, & + &e1c = 3.0*a2*b2*cc3, & + &e2c = 9.0*a1*a2*cc2, & &e3c = 9.0*a2*a2*cc2*( 1.0-c5 ), & - &e4c = 12.0*a1*a2*cc2, & + &e4c = 12.0*a1*a2*cc2, & &e5c = 6.0*a1*a1 ! Constants for min tke in elt integration (qmin), max z/L in els (zmax), ! and factor for eddy viscosity for TKE (Kq = Sqfac*Km): - REAL, PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 + real(kind_phys), PARAMETER :: qmin=0.0, zmax=1.0, Sqfac=3.0 ! Note that the following mixing-length constants are now specified in mym_length ! &cns=3.5, alp1=0.23, alp2=0.3, alp3=3.0, alp4=10.0, alp5=0.2 - REAL, PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 - REAL, PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq + real(kind_phys), PARAMETER :: gpw=5./3., qcgmin=1.e-8, qkemin=1.e-12 + real(kind_phys), PARAMETER :: tliq = 269. !all hydrometeors are liquid when T > tliq ! Constants for cloud PDF (mym_condensation) - REAL, PARAMETER :: rr2=0.7071068, rrp=0.3989423 + real(kind_phys), PARAMETER :: rr2=0.7071068, rrp=0.3989423 !>Use Canuto/Kitamura mod (remove Ric and negative TKE) (1:yes, 0:no) !!For more info, see Canuto et al. (2008 JAS) and Kitamura (Journal of the @@ -314,12 +304,12 @@ MODULE module_bl_mynn !!(above) back to NN2009 values (see commented out lines next to the !!parameters above). This only removes the negative TKE problem !!but does not necessarily improve performance - neutral impact. - REAL, PARAMETER :: CKmod=1. + real(kind_phys), PARAMETER :: CKmod=1. !>Use Ito et al. (2015, BLM) scale-aware (0: no, 1: yes). Note that this also has impacts !!on the cloud PDF and mass-flux scheme, using Honnert et al. (2011) similarity function !!for TKE in the upper PBL/cloud layer. - REAL, PARAMETER :: scaleaware=1. + real(kind_phys), PARAMETER :: scaleaware=1. !>Of the following the options, use one OR the other, not both. !>Adding top-down diffusion driven by cloud-top radiative cooling @@ -341,32 +331,6 @@ MODULE module_bl_mynn LOGICAL, PARAMETER :: debug_code = .false. INTEGER, PARAMETER :: idbg = 23 !specific i-point to write out -! JAYMES- -!> Constants used for empirical calculations of saturation -!! vapor pressures (in function "esat") and saturation mixing ratios -!! (in function "qsat"), reproduced from module_mp_thompson.F, -!! v3.6 - REAL, PARAMETER:: J0= .611583699E03 - REAL, PARAMETER:: J1= .444606896E02 - REAL, PARAMETER:: J2= .143177157E01 - REAL, PARAMETER:: J3= .264224321E-1 - REAL, PARAMETER:: J4= .299291081E-3 - REAL, PARAMETER:: J5= .203154182E-5 - REAL, PARAMETER:: J6= .702620698E-8 - REAL, PARAMETER:: J7= .379534310E-11 - REAL, PARAMETER:: J8=-.321582393E-13 - - REAL, PARAMETER:: K0= .609868993E03 - REAL, PARAMETER:: K1= .499320233E02 - REAL, PARAMETER:: K2= .184672631E01 - REAL, PARAMETER:: K3= .402737184E-1 - REAL, PARAMETER:: K4= .565392987E-3 - REAL, PARAMETER:: K5= .521693933E-5 - REAL, PARAMETER:: K6= .307839583E-7 - REAL, PARAMETER:: K7= .105785160E-9 - REAL, PARAMETER:: K8= .161444444E-12 -! end- - ! Used in WRF-ARW module_physics_init.F INTEGER :: mynn_level @@ -385,13 +349,12 @@ SUBROUTINE mynn_bl_driver( & &initflag,restart,cycling, & &delt,dz,dx,znt, & &u,v,w,th,sqv3d,sqc3d,sqi3d, & - &qnc,qni, & - &qnwfa,qnifa,ozone, & + &sqs3d,qnc,qni, & + &qnwfa,qnifa,qnbca,ozone, & &p,exner,rho,t3d, & &xland,ts,qsfc,ps, & &ust,ch,hfx,qfx,rmol,wspd, & &uoce,voce, & !ocean current - &vdfg, & !Katata-added for fog dep &qke,qke_adv, & &sh3d,sm3d, & &nchem,kdvel,ndvel, & !Smoke/Chem variables @@ -401,16 +364,16 @@ SUBROUTINE mynn_bl_driver( & &tsq,qsq,cov, & &rublten,rvblten,rthblten, & &rqvblten,rqcblten,rqiblten, & - &rqncblten,rqniblten, & + &rqncblten,rqniblten,rqsblten, & &rqnwfablten,rqnifablten, & - &dozone, & + &rqnbcablten,dozone, & &exch_h,exch_m, & &pblh,kpbl, & &el_pbl, & &dqke,qwt,qshear,qbuoy,qdiss, & &qc_bl,qi_bl,cldfra_bl, & &bl_mynn_tkeadvect, & - &bl_mynn_tkebudget, & + &tke_budget, & &bl_mynn_cloudpdf, & &bl_mynn_mixlength, & &icloud_bl, & @@ -429,18 +392,19 @@ SUBROUTINE mynn_bl_driver( & &spp_pbl,pattern_spp_pbl, & &rthraten, & &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & - &FLAG_OZONE & - &,IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE) + &FLAG_QNI,FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA, & + &FLAG_QNBCA,FLAG_OZONE, & + &IDS,IDE,JDS,JDE,KDS,KDE, & + &IMS,IME,JMS,JME,KMS,KME, & + &ITS,ITE,JTS,JTE,KTS,KTE ) !------------------------------------------------------------------- INTEGER, INTENT(in) :: initflag !INPUT NAMELIST OPTIONS: - LOGICAL, INTENT(IN) :: restart,cycling - LOGICAL, INTENT(in) :: bl_mynn_tkebudget + LOGICAL, INTENT(in) :: restart,cycling + INTEGER, INTENT(in) :: tke_budget INTEGER, INTENT(in) :: bl_mynn_cloudpdf INTEGER, INTENT(in) :: bl_mynn_mixlength INTEGER, INTENT(in) :: bl_mynn_edmf @@ -452,17 +416,18 @@ SUBROUTINE mynn_bl_driver( & INTEGER, INTENT(in) :: bl_mynn_cloudmix INTEGER, INTENT(in) :: bl_mynn_mixqt INTEGER, INTENT(in) :: icloud_bl - REAL(kind=kind_phys), INTENT(in) :: closure + real(kind_phys), INTENT(in) :: closure LOGICAL, INTENT(in) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& - FLAG_QNWFA,FLAG_QNIFA,FLAG_OZONE + FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + FLAG_OZONE,FLAG_QS LOGICAL, INTENT(IN) :: mix_chem,enh_mix,rrfs_sd,smoke_dbg - INTEGER, INTENT(in) :: & - & IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE + INTEGER, INTENT(in) :: & + & IDS,IDE,JDS,JDE,KDS,KDE & + &,IMS,IME,JMS,JME,KMS,KME & + &,ITS,ITE,JTS,JTE,KTS,KTE #ifdef HARDCODE_VERTICAL # define kts 1 @@ -479,120 +444,129 @@ SUBROUTINE mynn_bl_driver( & ! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs ! on Cheyenne with the GNU compiler. - REAL(kind=kind_phys), INTENT(in) :: delt - REAL(kind=kind_phys), DIMENSION(:), INTENT(in) :: dx - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(in) :: dz, & + real(kind_phys), INTENT(in) :: delt + real(kind_phys), DIMENSION(:), INTENT(in) :: dx + real(kind_phys), DIMENSION(:,:), INTENT(in) :: dz, & &u,v,w,th,sqv3D,p,exner,rho,T3D - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(in) :: & - &sqc3D,sqi3D,qni,qnc,qnwfa,qnifa - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(in):: ozone - REAL(kind=kind_phys), DIMENSION(:), INTENT(in):: ust, & + real(kind_phys), DIMENSION(:,:), INTENT(in) :: & + &sqc3D,sqi3D,sqs3D,qni,qnc,qnwfa,qnifa,qnbca + real(kind_phys), DIMENSION(:,:), INTENT(in):: ozone + real(kind_phys), DIMENSION(:), INTENT(in):: ust, & &ch,qsfc,ps,wspd - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & &Qke,Tsq,Qsq,Cov,qke_adv - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: & - &rublten,rvblten,rthblten,rqvblten,rqcblten, & - &rqiblten,rqniblten,rqncblten, & - &rqnwfablten,rqnifablten - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: dozone - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(in) :: rthraten + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + &rublten,rvblten,rthblten,rqvblten,rqcblten, & + &rqiblten,rqsblten,rqniblten,rqncblten, & + &rqnwfablten,rqnifablten,rqnbcablten + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: dozone + real(kind_phys), DIMENSION(:,:), INTENT(in) :: rthraten - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(out) :: exch_h,exch_m - REAL, DIMENSION(:), INTENT(in) :: xland,ts,znt,hfx,qfx, & - &uoce,voce + real(kind_phys), DIMENSION(:,:), INTENT(out) :: exch_h,exch_m + real(kind_phys), DIMENSION(:), INTENT(in) :: xland, & + &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: & - & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & + & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D -! REAL, DIMENSION(IMS:IME,KMS:KME) :: & +! real, DIMENSION(IMS:IME,KMS:KME) :: & ! & edmf_a_dd,edmf_w_dd,edmf_qt_dd,edmf_thl_dd,edmf_ent_dd,edmf_qc_dd - REAL(kind=kind_phys), DIMENSION(:), INTENT(inout) :: Pblh - REAL, DIMENSION(:), INTENT(inout) :: rmol + real(kind_phys), DIMENSION(:), INTENT(inout) :: Pblh + real(kind_phys), DIMENSION(:), INTENT(inout) :: rmol - REAL, DIMENSION(IMS:IME) :: Psig_bl,Psig_shcu + real(kind_phys), DIMENSION(IMS:IME) :: psig_bl,psig_shcu - INTEGER,DIMENSION(:),INTENT(INOUT) :: & + INTEGER,DIMENSION(:),INTENT(INOUT) :: & &KPBL,nupdraft,ktop_plume - REAL(kind=kind_phys), DIMENSION(:), INTENT(out) :: maxmf + real(kind_phys), DIMENSION(:), INTENT(out) :: maxmf - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: el_pbl + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: el_pbl - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(out) :: & + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & &qWT,qSHEAR,qBUOY,qDISS,dqke - ! 3D budget arrays are not allocated when bl_mynn_tkebudget == .false. + ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. - REAL, DIMENSION(kts:kte) :: qWT1,qSHEAR1,qBUOY1,qDISS1,dqke1,diss_heat + real(kind_phys), DIMENSION(kts:kte) :: & + &qwt1,qshear1,qbuoy1,qdiss1,dqke1,diss_heat - REAL(kind=kind_phys), DIMENSION(:,:), intent(out) :: Sh3D,Sm3D + real(kind_phys), DIMENSION(:,:), intent(out) :: Sh3D,Sm3D - REAL(kind=kind_phys), DIMENSION(:,:), INTENT(inout) :: & + real(kind_phys), DIMENSION(:,:), INTENT(inout) :: & &qc_bl,qi_bl,cldfra_bl - REAL, DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D,cldfra_bl1D, & - qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old + real(kind_phys), DIMENSION(KTS:KTE) :: qc_bl1D,qi_bl1D, & + &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays INTEGER, INTENT(IN ) :: nchem, kdvel, ndvel -! REAL, DIMENSION( ims:ime, kms:kme, nchem ), INTENT(INOUT), optional :: chem3d -! REAL, DIMENSION( ims:ime, kdvel, ndvel ), INTENT(IN), optional :: vdep - REAL(kind=kind_phys), DIMENSION(:, :, :), INTENT(INOUT) :: chem3d - REAL(kind=kind_phys), DIMENSION(:, :), INTENT(IN) :: vdep - REAL(kind=kind_phys), DIMENSION(:), INTENT(IN) :: frp,EMIS_ANT_NO + real(kind_phys), DIMENSION(:,:,:), INTENT(INOUT) :: chem3d + real(kind_phys), DIMENSION(:,:), INTENT(IN) :: vdep + real(kind_phys), DIMENSION(:), INTENT(IN) :: frp,EMIS_ANT_NO !local - REAL, DIMENSION(kts:kte ,nchem) :: chem1 - REAL, DIMENSION(kts:kte+1,nchem) :: s_awchem1 - REAL, DIMENSION(ndvel) :: vd1 + real(kind_phys), DIMENSION(kts:kte ,nchem) :: chem1 + real(kind_phys), DIMENSION(kts:kte+1,nchem) :: s_awchem1 + real(kind_phys), DIMENSION(ndvel) :: vd1 INTEGER :: ic !local vars INTEGER :: ITF,JTF,KTF, IMD,JMD INTEGER :: i,j,k,kproblem - REAL, DIMENSION(KTS:KTE) :: thl,thvl,tl,qv1,qc1,qi1,sqw, & - &El, Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - &Vt, Vq, sgm, thlsg, sqwsg, vdfg - REAL, DIMENSION(KTS:KTE) :: thetav,sh,sm,u1,v1,w1,p1, & - &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & - &sqv,sqi,sqc,du1,dv1,dth1,dqv1,dqc1,dqi1,ozone1, & - &k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1, & - &dqnwfa1,dqnifa1,dozone1 + real(kind_phys), DIMENSION(KTS:KTE) :: & + &thl,tl,qv1,qc1,qi1,qs1,sqw, & + &el, dfm, dfh, dfq, tcd, qcd, pdk, pdt, pdq, pdc, & + &vt, vq, sgm + real(kind_phys), DIMENSION(KTS:KTE) :: & + &thetav,sh,sm,u1,v1,w1,p1, & + &ex1,dz1,th1,tk1,rho1,qke1,tsq1,qsq1,cov1, & + &sqv,sqi,sqc,sqs, & + &du1,dv1,dth1,dqv1,dqc1,dqi1,dqs1,ozone1, & + &k_m1,k_h1,qni1,dqni1,qnc1,dqnc1,qnwfa1,qnifa1, & + &qnbca1,dqnwfa1,dqnifa1,dqnbca1,dozone1 !mass-flux variables - REAL, DIMENSION(KTS:KTE) :: dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf - REAL, DIMENSION(KTS:KTE) :: edmf_a1,edmf_w1,edmf_qt1, & - &edmf_thl1,edmf_ent1,edmf_qc1 - REAL, DIMENSION(KTS:KTE) :: edmf_a_dd1,edmf_w_dd1, & - &edmf_qt_dd1,edmf_thl_dd1, & + real(kind_phys), DIMENSION(KTS:KTE) :: & + &dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf + real(kind_phys), DIMENSION(KTS:KTE) :: & + &edmf_a1,edmf_w1,edmf_qt1,edmf_thl1, & + &edmf_ent1,edmf_qc1 + real(kind_phys), DIMENSION(KTS:KTE) :: & + &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1,edmf_thl_dd1, & &edmf_ent_dd1,edmf_qc_dd1 - REAL, DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & - det_thl,det_sqv,det_sqc,det_u,det_v - REAL,DIMENSION(KTS:KTE+1) :: s_aw1,s_awthl1,s_awqt1, & - s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & - s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1 - REAL,DIMENSION(KTS:KTE+1) :: sd_aw1,sd_awthl1,sd_awqt1, & - sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 - - REAL, DIMENSION(KTS:KTE+1) :: zw - REAL :: cpm,sqcg,flt,fltv,flq,flqv,flqc,pmz,phh,exnerg,zet,phi_m,& - & afk,abk,ts_decay, qc_bl2, qi_bl2, & - & th_sfc,ztop_plume,sqc9,sqi9,wsp + real(kind_phys), DIMENSION(KTS:KTE) :: & + &sub_thl,sub_sqv,sub_u,sub_v, & + &det_thl,det_sqv,det_sqc,det_u,det_v + real(kind_phys), DIMENSION(KTS:KTE+1) :: & + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1,s_awu1,s_awv1,s_awqke1, & + &s_awqnc1,s_awqni1,s_awqnwfa1,s_awqnifa1, & + &s_awqnbca1 + real(kind_phys), DIMENSION(KTS:KTE+1) :: & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1,sd_awqke1 + + real(kind_phys), DIMENSION(KTS:KTE+1) :: zw + real(kind_phys) :: cpm,sqcg,flt,fltv,flq,flqv,flqc, & + &pmz,phh,exnerg,zet,phi_m, & + &afk,abk,ts_decay, qc_bl2, qi_bl2, & + &th_sfc,ztop_plume,wsp !top-down diffusion - REAL, DIMENSION(ITS:ITE) :: maxKHtopdown - REAL,DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD + real(kind_phys), DIMENSION(ITS:ITE) :: maxKHtopdown + real(kind_phys), DIMENSION(KTS:KTE) :: KHtopdown,TKEprodTD LOGICAL :: INITIALIZE_QKE,problem ! Stochastic fields - INTEGER, INTENT(IN) :: spp_pbl - REAL(kind=kind_phys), DIMENSION( :, :), INTENT(IN) :: pattern_spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col + INTEGER, INTENT(IN) :: spp_pbl + real(kind_phys), DIMENSION(:,:), INTENT(IN) :: pattern_spp_pbl + real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col ! Substepping TKE INTEGER :: nsub - real(kind=kind_phys) :: delt2 + real(kind_phys) :: delt2 if (debug_code) then !check incoming values @@ -629,7 +603,7 @@ SUBROUTINE mynn_bl_driver( & !*** Begin debugging IMD=(IMS+IME)/2 JMD=(JMS+JME)/2 -!*** End debugging +!*** End debugging JTF=JTE ITF=ITE @@ -701,6 +675,7 @@ SUBROUTINE mynn_bl_driver( & dqnc1(kts:kte)=0.0 dqnwfa1(kts:kte)=0.0 dqnifa1(kts:kte)=0.0 + dqnbca1(kts:kte)=0.0 dozone1(kts:kte)=0.0 qc_bl1D_old(kts:kte)=0.0 cldfra_bl1D_old(kts:kte)=0.0 @@ -721,7 +696,7 @@ SUBROUTINE mynn_bl_driver( & ENDDO ENDDO - IF ( bl_mynn_tkebudget ) THEN + IF (tke_budget .eq. 1) THEN DO k=KTS,KTE DO i=ITS,ITF qWT(i,k)=0. @@ -734,7 +709,23 @@ SUBROUTINE mynn_bl_driver( & ENDIF DO i=ITS,ITF - DO k=KTS,KTE !KTF + if (FLAG_QI ) then + sqi(:)=sqi3D(i,:) + else + sqi = 0.0 + endif + if (FLAG_QS ) then + sqs(:)=sqs3D(i,:) + else + sqs = 0.0 + endif + if (icloud_bl > 0) then + cldfra_bl1d(:)=cldfra_bl(i,:) + qc_bl1d(:)=qc_bl(i,:) + qi_bl1d(:)=qi_bl(i,:) + endif + + do k=KTS,KTE !KTF dz1(k)=dz(i,k) u1(k) = u(i,k) v1(k) = v(i,k) @@ -745,52 +736,15 @@ SUBROUTINE mynn_bl_driver( & rho1(k)=rho(i,k) sqc(k)=sqc3D(i,k) !/(1.+qv(i,k)) sqv(k)=sqv3D(i,k) !/(1.+qv(i,k)) - thetav(k)=th(i,k)*(1.+0.608*sqv(k)) - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - ENDIF - IF (FLAG_QI ) THEN - sqi(k)=sqi3D(i,k) !/(1.+qv(i,k)) - sqw(k)=sqv(k)+sqc(k)+sqi(k) - thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - sqi(k)=0.0 - sqw(k)=sqv(k)+sqc(k) - thl(k)=th1(k)-xlvcp/ex1(k)*sqc(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=0.0 - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ENDIF - thvl(k)=thlsg(k)*(1.+0.61*sqv(k)) + thetav(k)=th(i,k)*(1.+p608*sqv(k)) + !keep snow out for now - increases ceiling bias + sqw(k)=sqv(k)+sqc(k)+sqi(k)!+sqs(k) + thl(k)=th1(k) - xlvcp/ex1(k)*sqc(k) & + & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + !Use form from Tripoli and Cotton (1981) with their + !suggested min temperature to improve accuracy. + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) IF (k==kts) THEN zw(k)=0. @@ -821,9 +775,8 @@ SUBROUTINE mynn_bl_driver( & zw(kte+1)=zw(kte)+dz(i,kte) -!> - Call get_pblh() to calculate hybrid (\f$\theta_{vli}-TKE\f$) PBL height. -! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i),thvl, & +!> - Call get_pblh() to calculate hybrid (\f$\theta_{v}-TKE\f$) PBL height. + CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& & Qke1,zw,dz1,xland(i),KPBL(i)) !> - Call scale_aware() to calculate similarity functions for scale-adaptive control @@ -841,18 +794,17 @@ SUBROUTINE mynn_bl_driver( & !! obtaining prerequisite variables by calling the following subroutines from !! within mym_initialize(): mym_level2() and mym_length(). CALL mym_initialize ( & - &kts,kte, & + &kts,kte,xland(i), & &dz1, dx(i), zw, & &u1, v1, thl, sqv, & - &thlsg, sqwsg, & &PBLH(i), th1, thetav, sh, sm, & &ust(i), rmol(i), & &el, Qke1, Tsq1, Qsq1, Cov1, & &Psig_bl(i), cldfra_bl1D, & &bl_mynn_mixlength, & - &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf,& + &edmf_w1,edmf_a1, & &INITIALIZE_QKE, & - &spp_pbl,rstoch_col ) + &spp_pbl,rstoch_col ) IF (.not.restart) THEN !UPDATE 3D VARIABLES @@ -895,647 +847,582 @@ SUBROUTINE mynn_bl_driver( & ENDIF DO i=ITS,ITF - DO k=KTS,KTE !KTF - !JOE-TKE BUDGET - IF ( bl_mynn_tkebudget ) THEN - dqke(i,k)=qke(i,k) - END IF - IF (icloud_bl > 0) THEN - CLDFRA_BL1D(k)=CLDFRA_BL(i,k) - QC_BL1D(k)=QC_BL(i,k) - QI_BL1D(k)=QI_BL(i,k) - cldfra_bl1D_old(k)=cldfra_bl(i,k) - qc_bl1D_old(k)=qc_bl(i,k) - qi_bl1D_old(k)=qi_bl(i,k) - else - CLDFRA_BL1D(k)=0.0 - QC_BL1D(k)=0.0 - QI_BL1D(k)=0.0 - cldfra_bl1D_old(k)=0.0 - qc_bl1D_old(k)=0.0 - qi_bl1D_old(k)=0.0 - ENDIF - dz1(k)= dz(i,k) - u1(k) = u(i,k) - v1(k) = v(i,k) - w1(k) = w(i,k) - th1(k)= th(i,k) - tk1(k)=T3D(i,k) - p1(k) = p(i,k) - ex1(k)= exner(i,k) - rho1(k)=rho(i,k) - sqv(k)= sqv3D(i,k) !/(1.+qv(i,k)) - sqc(k)= sqc3D(i,k) !/(1.+qv(i,k)) - qv1(k)= sqv(k)/(1.-sqv(k)) - qc1(k)= sqc(k)/(1.-sqv(k)) - dqc1(k)=0.0 - dqi1(k)=0.0 - dqni1(k)=0.0 - dqnc1(k)=0.0 - dqnwfa1(k)=0.0 - dqnifa1(k)=0.0 - dozone1(k)=0.0 - IF(FLAG_QI)THEN - sqi(k)= sqi3D(i,k) !/(1.+qv(i,k)) - qi1(k)= sqi(k)/(1.-sqv(k)) - sqw(k)= sqv(k)+sqc(k)+sqi(k) - thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & - & - xlscp/ex1(k)*sqi(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & - ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. sqi(k)<1e-8 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=sqi(k) - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - sqwsg(k)=sqv(k)+sqc9+sqi9 - ELSE - qi1(k)=0.0 - sqi(k)=0.0 - sqw(k)= sqv(k)+sqc(k) - thl(k)= th1(k)-xlvcp/ex1(k)*sqc(k) - !Use form from Tripoli and Cotton (1981) with their - !suggested min temperature to improve accuracy. - !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k)) - !COMPUTE THL USING SGS CLOUDS FOR PBLH DIAG - IF(sqc(k)<1e-6 .and. CLDFRA_BL1D(k)>0.001)THEN - sqc9=QC_BL1D(k)*CLDFRA_BL1D(k) - sqi9=QI_BL1D(k)*CLDFRA_BL1D(k) - ELSE - sqc9=sqc(k) - sqi9=0.0 - ENDIF - thlsg(k)=th1(k) - xlvcp/ex1(k)*sqc9 & - & - xlscp/ex1(k)*sqi9 - ENDIF - thetav(k)=th1(k)*(1.+0.608*sqv(k)) - thvl(k) =thlsg(k) *(1.+0.608*sqv(k)) - - IF (FLAG_QNI ) THEN - qni1(k)=qni(i,k) - ELSE - qni1(k)=0.0 - ENDIF - IF (FLAG_QNC ) THEN - qnc1(k)=qnc(i,k) - ELSE - qnc1(k)=0.0 - ENDIF - IF (FLAG_QNWFA ) THEN - qnwfa1(k)=qnwfa(i,k) - ELSE - qnwfa1(k)=0.0 - ENDIF - IF (FLAG_QNIFA ) THEN - qnifa1(k)=qnifa(i,k) - ELSE - qnifa1(k)=0.0 - ENDIF - IF (FLAG_OZONE) THEN - ozone1(k)=ozone(i,k) - ELSE - ozone1(k)=0.0 - ENDIF - el(k) = el_pbl(i,k) - qke1(k)=qke(i,k) - sh(k) =sh3d(i,k) - sm(k) =sm3d(i,k) - tsq1(k)=tsq(i,k) - qsq1(k)=qsq(i,k) - cov1(k)=cov(i,k) - if (spp_pbl==1) then - rstoch_col(k)=pattern_spp_pbl(i,k) - else - rstoch_col(k)=0.0 - endif - - !edmf - edmf_a1(k)=0.0 - edmf_w1(k)=0.0 - edmf_qc1(k)=0.0 - s_aw1(k)=0. - s_awthl1(k)=0. - s_awqt1(k)=0. - s_awqv1(k)=0. - s_awqc1(k)=0. - s_awu1(k)=0. - s_awv1(k)=0. - s_awqke1(k)=0. - s_awqnc1(k)=0. - s_awqni1(k)=0. - s_awqnwfa1(k)=0. - s_awqnifa1(k)=0. - ![EWDD] - edmf_a_dd1(k)=0.0 - edmf_w_dd1(k)=0.0 - edmf_qc_dd1(k)=0.0 - sd_aw1(k)=0. - sd_awthl1(k)=0. - sd_awqt1(k)=0. - sd_awqv1(k)=0. - sd_awqc1(k)=0. - sd_awu1(k)=0. - sd_awv1(k)=0. - sd_awqke1(k)=0. - sub_thl(k)=0. - sub_sqv(k)=0. - sub_u(k)=0. - sub_v(k)=0. - det_thl(k)=0. - det_sqv(k)=0. - det_sqc(k)=0. - det_u(k)=0. - det_v(k)=0. - - IF (k==kts) THEN - zw(k)=0. - ELSE - zw(k)=zw(k-1)+dz(i,k-1) - ENDIF - ENDDO ! end k - - !initialize smoke/chem arrays (if used): - IF ( mix_chem ) then - do ic = 1,ndvel - vd1(ic) = vdep(i,ic) ! dry deposition velocity - chem1(kts,ic) = chem3d(i,kts,ic) - s_awchem1(kts,ic)=0. - enddo - do k = kts+1,kte - DO ic = 1,nchem - chem1(k,ic) = chem3d(i,k,ic) - s_awchem1(k,ic)=0. - ENDDO - enddo - ELSE - do ic = 1,ndvel - vd1(ic) = 0. ! dry deposition velocity - chem1(kts,ic) = 0. - s_awchem1(kts,ic)=0. - enddo - do k = kts+1,kte - do ic = 1,nchem - chem1(k,ic) = 0. - s_awchem1(k,ic)=0. - enddo - enddo - ENDIF - - zw(kte+1)=zw(kte)+dz(i,kte) - !EDMF - s_aw1(kte+1)=0. - s_awthl1(kte+1)=0. - s_awqt1(kte+1)=0. - s_awqv1(kte+1)=0. - s_awqc1(kte+1)=0. - s_awu1(kte+1)=0. - s_awv1(kte+1)=0. - s_awqke1(kte+1)=0. - s_awqnc1(kte+1)=0. - s_awqni1(kte+1)=0. - s_awqnwfa1(kte+1)=0. - s_awqnifa1(kte+1)=0. - sd_aw1(kte+1)=0. - sd_awthl1(kte+1)=0. - sd_awqt1(kte+1)=0. - sd_awqv1(kte+1)=0. - sd_awqc1(kte+1)=0. - sd_awu1(kte+1)=0. - sd_awv1(kte+1)=0. - sd_awqke1(kte+1)=0. - IF ( mix_chem ) THEN - DO ic = 1,nchem - s_awchem1(kte+1,ic)=0. - ENDDO - ENDIF + !Initialize some arrays + if (tke_budget .eq. 1) then + dqke(i,:)=qke(i,:) + endif + if (FLAG_QI ) then + sqi(:)=sqi3D(i,:) + else + sqi = 0.0 + endif + if (FLAG_QS ) then + sqs(:)=sqs3D(i,:) + else + sqs = 0.0 + endif + if (icloud_bl > 0) then + CLDFRA_BL1D(:)=CLDFRA_BL(i,:) + QC_BL1D(:) =QC_BL(i,:) + QI_BL1D(:) =QI_BL(i,:) + cldfra_bl1D_old(:)=cldfra_bl(i,:) + qc_bl1D_old(:)=qc_bl(i,:) + qi_bl1D_old(:)=qi_bl(i,:) + else + CLDFRA_BL1D =0.0 + QC_BL1D =0.0 + QI_BL1D =0.0 + cldfra_bl1D_old=0.0 + qc_bl1D_old =0.0 + qi_bl1D_old =0.0 + endif + dz1(kts:kte) =dz(i,kts:kte) + u1(kts:kte) =u(i,kts:kte) + v1(kts:kte) =v(i,kts:kte) + w1(kts:kte) =w(i,kts:kte) + th1(kts:kte) =th(i,kts:kte) + tk1(kts:kte) =T3D(i,kts:kte) + p1(kts:kte) =p(i,kts:kte) + ex1(kts:kte) =exner(i,kts:kte) + rho1(kts:kte) =rho(i,kts:kte) + sqv(kts:kte) =sqv3D(i,kts:kte) !/(1.+qv(i,kts:kte)) + sqc(kts:kte) =sqc3D(i,kts:kte) !/(1.+qv(i,kts:kte)) + qv1(kts:kte) =sqv(kts:kte)/(1.-sqv(kts:kte)) + qc1(kts:kte) =sqc(kts:kte)/(1.-sqv(kts:kte)) + qi1(kts:kte) =sqi(kts:kte)/(1.-sqv(kts:kte)) + qs1(kts:kte) =sqs(kts:kte)/(1.-sqv(kts:kte)) + dqc1(kts:kte) =0.0 + dqi1(kts:kte) =0.0 + dqs1(kts:kte) =0.0 + dqni1(kts:kte) =0.0 + dqnc1(kts:kte) =0.0 + dqnwfa1(kts:kte)=0.0 + dqnifa1(kts:kte)=0.0 + dqnbca1(kts:kte)=0.0 + dozone1(kts:kte)=0.0 + IF (FLAG_QNI ) THEN + qni1(kts:kte)=qni(i,kts:kte) + ELSE + qni1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNC ) THEN + qnc1(kts:kte)=qnc(i,kts:kte) + ELSE + qnc1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNWFA ) THEN + qnwfa1(kts:kte)=qnwfa(i,kts:kte) + ELSE + qnwfa1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNIFA ) THEN + qnifa1(kts:kte)=qnifa(i,kts:kte) + ELSE + qnifa1(kts:kte)=0.0 + ENDIF + IF (FLAG_QNBCA ) THEN + qnbca1(kts:kte)=qnbca(i,kts:kte) + ELSE + qnbca1(kts:kte)=0.0 + ENDIF + IF (FLAG_OZONE ) THEN + ozone1(kts:kte)=ozone(i,kts:kte) + ELSE + ozone1(kts:kte)=0.0 + ENDIF + el(kts:kte) =el_pbl(i,kts:kte) + qke1(kts:kte)=qke(i,kts:kte) + sh(kts:kte) =sh3d(i,kts:kte) + sm(kts:kte) =sm3d(i,kts:kte) + tsq1(kts:kte)=tsq(i,kts:kte) + qsq1(kts:kte)=qsq(i,kts:kte) + cov1(kts:kte)=cov(i,kts:kte) + if (spp_pbl==1) then + rstoch_col(kts:kte)=pattern_spp_pbl(i,kts:kte) + else + rstoch_col(kts:kte)=0.0 + endif + !edmf + edmf_a1 =0.0 + edmf_w1 =0.0 + edmf_qc1 =0.0 + s_aw1 =0.0 + s_awthl1 =0.0 + s_awqt1 =0.0 + s_awqv1 =0.0 + s_awqc1 =0.0 + s_awu1 =0.0 + s_awv1 =0.0 + s_awqke1 =0.0 + s_awqnc1 =0.0 + s_awqni1 =0.0 + s_awqnwfa1 =0.0 + s_awqnifa1 =0.0 + s_awqnbca1 =0.0 + ![EWDD] + edmf_a_dd1 =0.0 + edmf_w_dd1 =0.0 + edmf_qc_dd1=0.0 + sd_aw1 =0.0 + sd_awthl1 =0.0 + sd_awqt1 =0.0 + sd_awqv1 =0.0 + sd_awqc1 =0.0 + sd_awu1 =0.0 + sd_awv1 =0.0 + sd_awqke1 =0.0 + sub_thl =0.0 + sub_sqv =0.0 + sub_u =0.0 + sub_v =0.0 + det_thl =0.0 + det_sqv =0.0 + det_sqc =0.0 + det_u =0.0 + det_v =0.0 + + do k = kts,kte + if (k==kts) then + zw(k)=0. + else + zw(k)=zw(k-1)+dz(i,k-1) + endif + !keep snow out for now - increases ceiling bias + sqw(k)= sqv(k)+sqc(k)+sqi(k)!+sqs(k) + thl(k)= th1(k) - xlvcp/ex1(k)*sqc(k) & + & - xlscp/ex1(k)*(sqi(k)+sqs(k)) + !Use form from Tripoli and Cotton (1981) with their + !suggested min temperature to improve accuracy. + !thl(k)=th(i,k)*(1.- xlvcp/MAX(tk1(k),TKmin)*sqc(k) & + ! & - xlscp/MAX(tk1(k),TKmin)*sqi(k)) + thetav(k)=th1(k)*(1.+p608*sqv(k)) + enddo ! end k + zw(kte+1)=zw(kte)+dz(i,kte) + + !initialize smoke/chem arrays (if used): + if ( mix_chem ) then + do ic = 1,ndvel + vd1(ic) = vdep(i,ic) ! dry deposition velocity + chem1(kts,ic) = chem3d(i,kts,ic) + enddo + do k = kts+1,kte + do ic = 1,nchem + chem1(k,ic) = chem3d(i,k,ic) + enddo + enddo + else + do ic = 1,ndvel + vd1(ic) = 0. ! dry deposition velocity + chem1(kts,ic) = 0. + enddo + do k = kts+1,kte + do ic = 1,nchem + chem1(k,ic) = 0. + enddo + enddo + endif + s_awchem1 = 0.0 !> - Call get_pblh() to calculate the hybrid \f$\theta_{vli}-TKE\f$ !! PBL height diagnostic. -! CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& - CALL GET_PBLH(KTS,KTE,PBLH(i),thvl,& - & Qke1,zw,dz1,xland(i),KPBL(i)) + CALL GET_PBLH(KTS,KTE,PBLH(i),thetav,& + & Qke1,zw,dz1,xland(i),KPBL(i)) !> - Call scale_aware() to calculate the similarity functions, !! \f$P_{\sigma-PBL}\f$ and \f$P_{\sigma-shcu}\f$, to control !! the scale-adaptive behaviour for the local and nonlocal !! components, respectively. - IF (scaleaware > 0.) THEN - CALL SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) - ELSE - Psig_bl(i)=1.0 - Psig_shcu(i)=1.0 - ENDIF + if (scaleaware > 0.) then + call SCALE_AWARE(dx(i),PBLH(i),Psig_bl(i),Psig_shcu(i)) + else + Psig_bl(i)=1.0 + Psig_shcu(i)=1.0 + endif - sqcg= 0.0 !ill-defined variable; qcg has been removed - cpm=cp*(1.+0.84*qv1(kts)) - exnerg=(ps(i)/p1000mb)**rcp - - !----------------------------------------------------- - !ORIGINAL CODE - !flt = hfx(i)/( rho(i,kts)*cpm ) & - ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) - !flq = qfx(i)/ rho(i,kts) & - ! -ch(i)*(sqc(kts) -sqcg ) - !----------------------------------------------------- - ! Katata-added - The deposition velocity of cloud (fog) - ! water is used instead of CH. - !flt = hfx(i)/( rho(i,kts)*cpm ) & - ! & +xlvcp*vdfg(i)*(sqc(kts)/exner(i,kts)- sqcg/exnerg) - !flq = qfx(i)/ rho(i,kts) & - ! & -vdfg(i)*(sqc(kts) - sqcg ) - !----------------------------------------------------- - flqv = qfx(i)/rho1(kts) - flqc = -vdfg(i)*(sqc(kts) - sqcg ) - th_sfc = ts(i)/ex1(kts) - - ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS - flq =flqv+flqc !! LATENT - flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/ex1(kts) !! Temperature flux - fltv=flt + flqv*p608*th_sfc !! Virtual temperature flux - - ! Update 1/L using updated sfc heat flux and friction velocity - rmol(i) = -karman*gtr*fltv/max(ust(i)**3,1.0e-6) - zet = 0.5*dz(i,kts)*rmol(i) - zet = MAX(zet, -20.) - zet = MIN(zet, 20.) - !if(i.eq.idbg)print*,"updated z/L=",zet - if (bl_mynn_stfunc == 0) then - !Original Kansas-type stability functions - if ( zet >= 0.0 ) then - pmz = 1.0 + (cphm_st-1.0) * zet - phh = 1.0 + cphh_st * zet - else - pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet - phh = 1.0/SQRT(1.0-cphh_unst*zet) - end if + sqcg= 0.0 !ill-defined variable; qcg has been removed + cpm=cp*(1.+0.84*qv1(kts)) + exnerg=(ps(i)/p1000mb)**rcp + + !----------------------------------------------------- + !ORIGINAL CODE + !flt = hfx(i)/( rho(i,kts)*cpm ) & + ! +xlvcp*ch(i)*(sqc(kts)/exner(i,kts) -sqcg/exnerg) + !flq = qfx(i)/ rho(i,kts) & + ! -ch(i)*(sqc(kts) -sqcg ) + !----------------------------------------------------- + flqv = qfx(i)/rho1(kts) + flqc = 0.0 !currently no sea-spray fluxes, fog settling handled elsewhere + th_sfc = ts(i)/ex1(kts) + + ! TURBULENT FLUX FOR TKE BOUNDARY CONDITIONS + flq =flqv+flqc !! LATENT + flt =hfx(i)/(rho1(kts)*cpm )-xlvcp*flqc/ex1(kts) !! Temperature flux + fltv=flt + flqv*p608*th_sfc !! Virtual temperature flux + + ! Update 1/L using updated sfc heat flux and friction velocity + rmol(i) = -karman*gtr*fltv/max(ust(i)**3,1.0e-6) + zet = 0.5*dz(i,kts)*rmol(i) + zet = MAX(zet, -20.) + zet = MIN(zet, 20.) + !if(i.eq.idbg)print*,"updated z/L=",zet + if (bl_mynn_stfunc == 0) then + !Original Kansas-type stability functions + if ( zet >= 0.0 ) then + pmz = 1.0 + (cphm_st-1.0) * zet + phh = 1.0 + cphh_st * zet else - !Updated stability functions (Puhales, 2020) - phi_m = phim(zet) - pmz = phi_m - zet - phh = phih(zet) + pmz = 1.0/ (1.0-cphm_unst*zet)**0.25 - zet + phh = 1.0/SQRT(1.0-cphh_unst*zet) end if + else + !Updated stability functions (Puhales, 2020) + phi_m = phim(zet) + pmz = phi_m - zet + phh = phih(zet) + end if !> - Call mym_condensation() to calculate the nonconvective component !! of the subgrid cloud fraction and mixing ratio as well as the functions !! used to calculate the buoyancy flux. Different cloud PDFs can be !! selected by use of the namelist parameter \p bl_mynn_cloudpdf. - CALL mym_condensation ( kts,kte, & - &dx(i),dz1,zw,u1,v1,xland(i), & - &thl,sqw,sqv,sqc,sqi, & - &p1,ex1,tsq1,qsq1,cov1, & - &Sh,el,bl_mynn_cloudpdf, & - &qc_bl1D,qi_bl1D,cldfra_bl1D, & - &PBLH(i),HFX(i), & - &Vt, Vq, th1, sgm, rmol(i), & - &spp_pbl, rstoch_col ) + call mym_condensation (kts,kte, & + &dx(i),dz1,zw,xland(i), & + &thl,sqw,sqv,sqc,sqi,sqs, & + &p1,ex1,tsq1,qsq1,cov1, & + &Sh,el,bl_mynn_cloudpdf, & + &qc_bl1D,qi_bl1D,cldfra_bl1D, & + &PBLH(i),HFX(i), & + &Vt, Vq, th1, sgm, rmol(i), & + &spp_pbl, rstoch_col ) !> - Add TKE source driven by cloud top cooling !! Calculate the buoyancy production of TKE from cloud-top cooling when !! \p bl_mynn_topdown =1. - IF (bl_mynn_topdown.eq.1)then - CALL topdown_cloudrad(kts,kte,dz1,zw, & - &xland(i),kpbl(i),PBLH(i), & - &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & - &cldfra_bl1D,rthraten(i,:), & - &maxKHtopdown(i),KHtopdown,TKEprodTD ) - ELSE - maxKHtopdown(i) = 0.0 - KHtopdown(kts:kte) = 0.0 - TKEprodTD(kts:kte) = 0.0 - ENDIF + if (bl_mynn_topdown.eq.1) then + call topdown_cloudrad(kts,kte,dz1,zw, & + &xland(i),kpbl(i),PBLH(i), & + &sqc,sqi,sqw,thl,th1,ex1,p1,rho1,thetav, & + &cldfra_bl1D,rthraten(i,:), & + &maxKHtopdown(i),KHtopdown,TKEprodTD ) + else + maxKHtopdown(i) = 0.0 + KHtopdown(kts:kte) = 0.0 + TKEprodTD(kts:kte) = 0.0 + endif - IF (bl_mynn_edmf > 0) THEN - !PRINT*,"Calling DMP Mass-Flux: i= ",i - CALL DMP_mf( & - &kts,kte,delt,zw,dz1,p1,rho1, & - &bl_mynn_edmf_mom, & - &bl_mynn_edmf_tke, & - &bl_mynn_mixscalars, & - &u1,v1,w1,th1,thl,thetav,tk1, & - &sqw,sqv,sqc,qke1, & - &qnc1,qni1,qnwfa1,qnifa1, & - &ex1,Vt,Vq,sgm, & - &ust(i),flt,fltv,flq,flqv, & - &PBLH(i),KPBL(i),DX(i), & - &xland(i),th_sfc, & + if (bl_mynn_edmf > 0) then + !PRINT*,"Calling DMP Mass-Flux: i= ",i + call DMP_mf( & + &kts,kte,delt,zw,dz1,p1,rho1, & + &bl_mynn_edmf_mom, & + &bl_mynn_edmf_tke, & + &bl_mynn_mixscalars, & + &u1,v1,w1,th1,thl,thetav,tk1, & + &sqw,sqv,sqc,qke1, & + &qnc1,qni1,qnwfa1,qnifa1,qnbca1, & + &ex1,Vt,Vq,sgm, & + &ust(i),flt,fltv,flq,flqv, & + &PBLH(i),KPBL(i),DX(i), & + &xland(i),th_sfc, & ! now outputs - tendencies - ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & + ! &,dth1mf,dqv1mf,dqc1mf,du1mf,dv1mf & ! outputs - updraft properties - & edmf_a1,edmf_w1,edmf_qt1, & - & edmf_thl1,edmf_ent1,edmf_qc1, & + &edmf_a1,edmf_w1,edmf_qt1, & + &edmf_thl1,edmf_ent1,edmf_qc1, & ! for the solver - & s_aw1,s_awthl1,s_awqt1, & - & s_awqv1,s_awqc1, & - & s_awu1,s_awv1,s_awqke1, & - & s_awqnc1,s_awqni1, & - & s_awqnwfa1,s_awqnifa1, & - & sub_thl,sub_sqv, & - & sub_u,sub_v, & - & det_thl,det_sqv,det_sqc, & - & det_u,det_v, & + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1, & + &s_awu1,s_awv1,s_awqke1, & + &s_awqnc1,s_awqni1, & + &s_awqnwfa1,s_awqnifa1,s_awqnbca1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & ! chem/smoke mixing - & nchem,chem1,s_awchem1, & - & mix_chem, & - & qc_bl1D,cldfra_bl1D, & - & qc_bl1D_old,cldfra_bl1D_old, & - & FLAG_QC,FLAG_QI, & - & FLAG_QNC,FLAG_QNI, & - & FLAG_QNWFA,FLAG_QNIFA, & - & Psig_shcu(i), & - & nupdraft(i),ktop_plume(i), & - & maxmf(i),ztop_plume, & - & spp_pbl,rstoch_col ) - ENDIF + &nchem,chem1,s_awchem1, & + &mix_chem, & + &qc_bl1D,cldfra_bl1D, & + &qc_bl1D_old,cldfra_bl1D_old, & + &FLAG_QC,FLAG_QI, & + &FLAG_QNC,FLAG_QNI, & + &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + &Psig_shcu(i), & + &nupdraft(i),ktop_plume(i), & + &maxmf(i),ztop_plume, & + &spp_pbl,rstoch_col ) + endif - IF (bl_mynn_edmf_dd == 1) THEN - CALL DDMF_JPL(kts,kte,delt,zw,dz1,p1, & - &u1,v1,th1,thl,thetav,tk1, & - sqw,sqv,sqc,rho1,ex1, & - &ust(i),flt,flq, & - &PBLH(i),KPBL(i), & - &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & - &edmf_thl_dd1,edmf_ent_dd1, & - &edmf_qc_dd1, & - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & - &sd_awqke1, & - &qc_bl1d,cldfra_bl1d, & - &rthraten(i,:) ) - ENDIF + if (bl_mynn_edmf_dd == 1) then + call DDMF_JPL(kts,kte,delt,zw,dz1,p1, & + &u1,v1,th1,thl,thetav,tk1, & + &sqw,sqv,sqc,rho1,ex1, & + &ust(i),flt,flq, & + &PBLH(i),KPBL(i), & + &edmf_a_dd1,edmf_w_dd1,edmf_qt_dd1, & + &edmf_thl_dd1,edmf_ent_dd1, & + &edmf_qc_dd1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1,sd_awu1,sd_awv1, & + &sd_awqke1, & + &qc_bl1d,cldfra_bl1d, & + &rthraten(i,:) ) + endif - !Capability to substep the eddy-diffusivity portion - !do nsub = 1,2 - delt2 = delt !*0.5 !only works if topdown=0 - - CALL mym_turbulence ( & - &kts,kte,closure, & - &dz1, DX(i), zw, & - &u1, v1, thl, thetav, sqc, sqw, & - &thlsg, sqwsg, & - &qke1, tsq1, qsq1, cov1, & - &vt, vq, & - &rmol(i), flt, flq, & - &PBLH(i),th1, & - &Sh,Sm,el, & - &Dfm,Dfh,Dfq, & - &Tcd,Qcd,Pdk, & - &Pdt,Pdq,Pdc, & - &qWT1,qSHEAR1,qBUOY1,qDISS1, & - &bl_mynn_tkebudget, & - &Psig_bl(i),Psig_shcu(i), & - &cldfra_bl1D,bl_mynn_mixlength, & - &edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & - &TKEprodTD, & - &spp_pbl,rstoch_col) + !Capability to substep the eddy-diffusivity portion + !do nsub = 1,2 + delt2 = delt !*0.5 !only works if topdown=0 + + call mym_turbulence( & + &kts,kte,xland(i),closure, & + &dz1, DX(i), zw, & + &u1, v1, thl, thetav, sqc, sqw, & + &qke1, tsq1, qsq1, cov1, & + &vt, vq, & + &rmol(i), flt, fltv, flq, & + &PBLH(i),th1, & + &Sh,Sm,el, & + &Dfm,Dfh,Dfq, & + &Tcd,Qcd,Pdk, & + &Pdt,Pdq,Pdc, & + &qWT1,qSHEAR1,qBUOY1,qDISS1, & + &tke_budget, & + &Psig_bl(i),Psig_shcu(i), & + &cldfra_bl1D,bl_mynn_mixlength, & + &edmf_w1,edmf_a1, & + &TKEprodTD, & + &spp_pbl,rstoch_col ) !> - Call mym_predict() to solve TKE and !! \f$\theta^{'2}, q^{'2}, and \theta^{'}q^{'}\f$ !! for the following time step. - CALL mym_predict (kts,kte,closure, & - &delt2, dz1, & - &ust(i), flt, flq, pmz, phh, & - &el, dfq, rho1, pdk, pdt, pdq, pdc,& - &Qke1, Tsq1, Qsq1, Cov1, & - &s_aw1, s_awqke1, bl_mynn_edmf_tke,& - &qWT1, qDISS1,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) - - if (dheat_opt > 0) then - DO k=kts,kte-1 - ! Set max dissipative heating rate to 7.2 K per hour - diss_heat(k) = MIN(MAX(1.0*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) - ! Limit heating above 100 mb: - diss_heat(k) = diss_heat(k) * exp(-10000./MAX(p1(k),1.)) - ENDDO - diss_heat(kte) = 0. - else - diss_heat(1:kte) = 0. - endif + call mym_predict(kts,kte,closure, & + &delt2, dz1, & + &ust(i), flt, flq, pmz, phh, & + &el, dfq, rho1, pdk, pdt, pdq, pdc, & + &Qke1, Tsq1, Qsq1, Cov1, & + &s_aw1, s_awqke1, bl_mynn_edmf_tke, & + &qWT1, qDISS1, tke_budget ) + + if (dheat_opt > 0) then + do k=kts,kte-1 + ! Set max dissipative heating rate to 7.2 K per hour + diss_heat(k) = MIN(MAX(1.0*(qke1(k)**1.5)/(b1*MAX(0.5*(el(k)+el(k+1)),1.))/cp, 0.0),0.002) + ! Limit heating above 100 mb: + diss_heat(k) = diss_heat(k) * exp(-10000./MAX(p1(k),1.)) + enddo + diss_heat(kte) = 0. + else + diss_heat(1:kte) = 0. + endif !> - Call mynn_tendencies() to solve for tendencies of !! \f$U, V, \theta, q_{v}, q_{c}, and q_{i}\f$. - CALL mynn_tendencies(kts,kte,i, & - &delt, dz1, rho1, & - &u1, v1, th1, tk1, qv1, & - &qc1, qi1, qnc1, qni1, & - &ps(i), p1, ex1, thl, & - &sqv, sqc, sqi, sqw, & - &qnwfa1, qnifa1, ozone1, & - &ust(i),flt,flq,flqv,flqc, & - &wspd(i),uoce(i),voce(i), & - &tsq1, qsq1, cov1, & - &tcd, qcd, & - &dfm, dfh, dfq, & - &Du1, Dv1, Dth1, Dqv1, & - &Dqc1, Dqi1, Dqnc1, Dqni1, & - &Dqnwfa1, Dqnifa1, Dozone1, & - &diss_heat, & + call mynn_tendencies(kts,kte,i, & + &delt, dz1, rho1, & + &u1, v1, th1, tk1, qv1, & + &qc1, qi1, qs1, qnc1, qni1, & + &ps(i), p1, ex1, thl, & + &sqv, sqc, sqi, sqs, sqw, & + &qnwfa1, qnifa1, qnbca1, ozone1, & + &ust(i),flt,flq,flqv,flqc, & + &wspd(i),uoce(i),voce(i), & + &tsq1, qsq1, cov1, & + &tcd, qcd, & + &dfm, dfh, dfq, & + &Du1, Dv1, Dth1, Dqv1, & + &Dqc1, Dqi1, Dqs1, Dqnc1, Dqni1, & + &Dqnwfa1, Dqnifa1, Dqnbca1, & + &Dozone1, & + &diss_heat, & ! mass flux components - &s_aw1,s_awthl1,s_awqt1, & - &s_awqv1,s_awqc1,s_awu1,s_awv1, & - &s_awqnc1,s_awqni1, & - &s_awqnwfa1,s_awqnifa1, & - &sd_aw1,sd_awthl1,sd_awqt1, & - &sd_awqv1,sd_awqc1, & - sd_awu1,sd_awv1, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC, & - &FLAG_QNI,FLAG_QNWFA,FLAG_QNIFA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) - - - IF ( mix_chem ) THEN - IF ( rrfs_sd ) THEN - CALL mynn_mix_chem(kts,kte,i, & - &delt, dz1, pblh(i), & - &nchem, kdvel, ndvel, & - &chem1, vd1, & - &rho1,flt, & - &tcd, qcd, & - &dfh, & - &s_aw1,s_awchem1, & - &emis_ant_no(i), & - &frp(i), rrfs_sd, & - &enh_mix, smoke_dbg ) - ELSE - CALL mynn_mix_chem(kts,kte,i, & - &delt, dz1, pblh(i), & - &nchem, kdvel, ndvel, & - &chem1, vd1, & - &rho1,flt, & - &tcd, qcd, & - &dfh, & - &s_aw1,s_awchem1, & - &zero, & - &zero, rrfs_sd, & - &enh_mix, smoke_dbg ) - ENDIF - DO ic = 1,nchem - DO k = kts,kte - chem3d(i,k,ic) = max(1.e-12, chem1(k,ic)) - ENDDO - ENDDO - ENDIF + &s_aw1,s_awthl1,s_awqt1, & + &s_awqv1,s_awqc1,s_awu1,s_awv1, & + &s_awqnc1,s_awqni1, & + &s_awqnwfa1,s_awqnifa1,s_awqnbca1, & + &sd_aw1,sd_awthl1,sd_awqt1, & + &sd_awqv1,sd_awqc1, & + &sd_awu1,sd_awv1, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & + &FLAG_QC,FLAG_QI,FLAG_QNC, & + &FLAG_QNI,FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA, & + &FLAG_QNBCA, & + &cldfra_bl1d, & + &bl_mynn_cloudmix, & + &bl_mynn_mixqt, & + &bl_mynn_edmf, & + &bl_mynn_edmf_mom, & + &bl_mynn_mixscalars ) + + + if ( mix_chem ) then + if ( rrfs_sd ) then + call mynn_mix_chem(kts,kte,i, & + &delt, dz1, pblh(i), & + &nchem, kdvel, ndvel, & + &chem1, vd1, & + &rho1,flt, & + &tcd, qcd, & + &dfh, & + &s_aw1,s_awchem1, & + &emis_ant_no(i), & + &frp(i), rrfs_sd, & + &enh_mix, smoke_dbg ) + else + call mynn_mix_chem(kts,kte,i, & + &delt, dz1, pblh(i), & + &nchem, kdvel, ndvel, & + &chem1, vd1, & + &rho1,flt, & + &tcd, qcd, & + &dfh, & + &s_aw1,s_awchem1, & + &zero, & + &zero, rrfs_sd, & + &enh_mix, smoke_dbg ) + endif + do ic = 1,nchem + do k = kts,kte + chem3d(i,k,ic) = max(1.e-12, chem1(k,ic)) + enddo + enddo + endif - CALL retrieve_exchange_coeffs(kts,kte,& - &dfm, dfh, dz1, K_m1, K_h1) - - !UPDATE 3D ARRAYS - do k=kts,kte - exch_m(i,k)=K_m1(k) - exch_h(i,k)=K_h1(k) - rublten(i,k)=du1(k) - rvblten(i,k)=dv1(k) - rthblten(i,k)=dth1(k) - rqvblten(i,k)=dqv1(k) - if (bl_mynn_cloudmix > 0) then - if (FLAG_QC) rqcblten(i,k)=dqc1(k) - if (FLAG_QI) rqiblten(i,k)=dqi1(k) - else - if (FLAG_QC) rqcblten(i,k)=0. - if (FLAG_QI) rqiblten(i,k)=0. - endif - if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then - if (FLAG_QNC) rqncblten(i,k)=dqnc1(k) - if (FLAG_QNI) rqniblten(i,k)=dqni1(k) - if (FLAG_QNWFA) rqnwfablten(i,k)=dqnwfa1(k) - if (FLAG_QNIFA) rqnifablten(i,k)=dqnifa1(k) - else - if (FLAG_QNC) rqncblten(i,k)=0. - if (FLAG_QNI) rqniblten(i,k)=0. - if (FLAG_QNWFA) rqnwfablten(i,k)=0. - if (FLAG_QNIFA) rqnifablten(i,k)=0. - endif - dozone(i,k)=dozone1(k) - - if (icloud_bl > 0) then - qc_bl(i,k)=qc_bl1D(k) - qi_bl(i,k)=qi_bl1D(k) - cldfra_bl(i,k)=cldfra_bl1D(k) - endif - - el_pbl(i,k)=el(k) - qke(i,k)=qke1(k) - tsq(i,k)=tsq1(k) - qsq(i,k)=qsq1(k) - cov(i,k)=cov1(k) - sh3d(i,k)=sh(k) - sm3d(i,k)=sm(k) - enddo !end-k + call retrieve_exchange_coeffs(kts,kte, & + &dfm, dfh, dz1, K_m1, K_h1 ) + + !UPDATE 3D ARRAYS + exch_m(i,:) =k_m1(:) + exch_h(i,:) =k_h1(:) + rublten(i,:) =du1(:) + rvblten(i,:) =dv1(:) + rthblten(i,:)=dth1(:) + rqvblten(i,:)=dqv1(:) + if (bl_mynn_cloudmix > 0) then + if (flag_qc) rqcblten(i,:)=dqc1(:) + if (flag_qi) rqiblten(i,:)=dqi1(:) + if (flag_qs) rqsblten(i,:)=dqs1(:) + else + if (flag_qc) rqcblten(i,:)=0. + if (flag_qi) rqiblten(i,:)=0. + if (flag_qs) rqsblten(i,:)=0. + endif + if (bl_mynn_cloudmix > 0 .and. bl_mynn_mixscalars > 0) then + if (flag_qnc) rqncblten(i,:) =dqnc1(:) + if (flag_qni) rqniblten(i,:) =dqni1(:) + if (flag_qnwfa) rqnwfablten(i,:)=dqnwfa1(:) + if (flag_qnifa) rqnifablten(i,:)=dqnifa1(:) + if (flag_qnbca) rqnbcablten(i,:)=dqnbca1(:) + else + if (flag_qnc) rqncblten(i,:) =0. + if (flag_qni) rqniblten(i,:) =0. + if (flag_qnwfa) rqnwfablten(i,:)=0. + if (flag_qnifa) rqnifablten(i,:)=0. + if (flag_qnbca) rqnbcablten(i,:)=0. + endif + dozone(i,:)=dozone1(:) + if (icloud_bl > 0) then + qc_bl(i,:) =qc_bl1D(:) + qi_bl(i,:) =qi_bl1D(:) + cldfra_bl(i,:)=cldfra_bl1D(:) + endif + el_pbl(i,:)=el(:) + qke(i,:) =qke1(:) + tsq(i,:) =tsq1(:) + qsq(i,:) =qsq1(:) + cov(i,:) =cov1(:) + sh3d(i,:) =sh(:) + sm3d(i,:) =sm(:) + + if (tke_budget .eq. 1) then + !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) + !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) + k=kts + qSHEAR1(k) =4.*(ust(i)**3*phi_m/(karman*dz(i,k)))-qSHEAR1(k+1) !! staggered + qBUOY1(k) =4.*(-ust(i)**3*zet/(karman*dz(i,k)))-qBUOY1(k+1) !! staggered + !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array + do k = kts,kte-1 + qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z + qBUOY(i,k) =0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z + qWT(i,k) =qWT1(k) + qDISS(i,k) =qDISS1(k) + dqke(i,k) =(qke1(k)-dqke(i,k))*0.5/delt + enddo + !! Upper boundary conditions + k=kte + qSHEAR(i,k) =0. + qBUOY(i,k) =0. + qWT(i,k) =0. + qDISS(i,k) =0. + dqke(i,k) =0. + endif - if ( bl_mynn_tkebudget ) then - !! TKE budget is now given in m**2/s**-3 (Puhales, 2020) - !! Lower boundary condtions (using similarity relationships such as the prognostic equation for Qke) - k=kts - qSHEAR1(k)=4.*(ust(i)**3*phi_m/(karman*dz(i,k)))-qSHEAR1(k+1) !! staggered - qBUOY1(k)=4.*(-ust(i)**3*zet/(karman*dz(i,k)))-qBUOY1(k+1) !! staggered - !! unstaggering SHEAR and BUOY and trasfering all TKE budget to 3D array - do k = kts,kte-1 - qSHEAR(i,k)=0.5*(qSHEAR1(k)+qSHEAR1(k+1)) !!! unstaggering in z - qBUOY(i,k)=0.5*(qBUOY1(k)+qBUOY1(k+1)) !!! unstaggering in z - qWT(i,k)=qWT1(k) - qDISS(i,k)=qDISS1(k) - dqke(i,k)=(qke1(k)-dqke(i,k))*0.5/delt - enddo - !! Upper boundary conditions - k=kte - qSHEAR(i,k)=0. - qBUOY(i,k)=0. - qWT(i,k)=0. - qDISS(i,k)=0. - dqke(i,k)=0. + !update updraft/downdraft properties + if (bl_mynn_output > 0) then !research mode == 1 + if (bl_mynn_edmf > 0) then + edmf_a(i,:) =edmf_a1(:) + edmf_w(i,:) =edmf_w1(:) + edmf_qt(i,:) =edmf_qt1(:) + edmf_thl(i,:) =edmf_thl1(:) + edmf_ent(i,:) =edmf_ent1(:) + edmf_qc(i,:) =edmf_qc1(:) + sub_thl3D(i,:)=sub_thl(:) + sub_sqv3D(i,:)=sub_sqv(:) + det_thl3D(i,:)=det_thl(:) + det_sqv3D(i,:)=det_sqv(:) endif + !if (bl_mynn_edmf_dd > 0) THEN + ! edmf_a_dd(i,:) =edmf_a_dd1(:) + ! edmf_w_dd(i,:) =edmf_w_dd1(:) + ! edmf_qt_dd(i,:) =edmf_qt_dd1(:) + ! edmf_thl_dd(i,:)=edmf_thl_dd1(:) + ! edmf_ent_dd(i,:)=edmf_ent_dd1(:) + ! edmf_qc_dd(i,:) =edmf_qc_dd1(:) + !endif + endif - !update updraft/downdraft properties - if (bl_mynn_output > 0) THEN !research mode == 1 - if (bl_mynn_edmf > 0) THEN - DO k = kts,kte - edmf_a(i,k)=edmf_a1(k) - edmf_w(i,k)=edmf_w1(k) - edmf_qt(i,k)=edmf_qt1(k) - edmf_thl(i,k)=edmf_thl1(k) - edmf_ent(i,k)=edmf_ent1(k) - edmf_qc(i,k)=edmf_qc1(k) - sub_thl3D(i,k)=sub_thl(k) - sub_sqv3D(i,k)=sub_sqv(k) - det_thl3D(i,k)=det_thl(k) - det_sqv3D(i,k)=det_sqv(k) - ENDDO - endif -! if (bl_mynn_edmf_dd > 0) THEN -! DO k = kts,kte -! edmf_a_dd(i,k)=edmf_a_dd1(k) -! edmf_w_dd(i,k)=edmf_w_dd1(k) -! edmf_qt_dd(i,k)=edmf_qt_dd1(k) -! edmf_thl_dd(i,k)=edmf_thl_dd1(k) -! edmf_ent_dd(i,k)=edmf_ent_dd1(k) -! edmf_qc_dd(i,k)=edmf_qc_dd1(k) -! ENDDO -! ENDIF - ENDIF - - !*** Begin debug prints - IF ( debug_code .and. (i .eq. idbg)) THEN - IF ( ABS(QFX(i))>.001)print*,& - "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) - IF ( ABS(HFX(i))>1100.)print*,& - "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) - DO k = kts,kte - IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) - IF ( ABS(vt(k)) > 2.0 )print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) - IF ( ABS(vq(k)) > 7000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) - IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) - IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 1500.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) - IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& - "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) - IF (icloud_bl > 0) then - IF( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN - PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) - ENDIF - ENDIF - - !IF (I==IMD .AND. J==JMD) THEN - ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) - ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) - ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) - ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) - ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) - ! PRINT*," vq=",vq(k)," vt=",vt(k)," vdfg=",vdfg(i) - !ENDIF - ENDDO !end-k - ENDIF - !*** End debug prints + !*** Begin debug prints + if ( debug_code .and. (i .eq. idbg)) THEN + if ( ABS(QFX(i))>.001)print*,& + "SUSPICIOUS VALUES AT: i=",i," QFX=",QFX(i) + if ( ABS(HFX(i))>1100.)print*,& + "SUSPICIOUS VALUES AT: i=",i," HFX=",HFX(i) + do k = kts,kte + IF ( sh(k) < 0. .OR. sh(k)> 200.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," sh=",sh(k) + IF ( ABS(vt(k)) > 2.0 )print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," vt=",vt(k) + IF ( ABS(vq(k)) > 7000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," vq=",vq(k) + IF ( qke(i,k) < -1. .OR. qke(i,k)> 200.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," qke=",qke(i,k) + IF ( el_pbl(i,k) < 0. .OR. el_pbl(i,k)> 1500.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," el_pbl=",el_pbl(i,k) + IF ( exch_m(i,k) < 0. .OR. exch_m(i,k)> 2000.)print*,& + "SUSPICIOUS VALUES AT: i,k=",i,k," exxch_m=",exch_m(i,k) + IF (icloud_bl > 0) then + IF ( cldfra_bl(i,k) < 0.0 .OR. cldfra_bl(i,k)> 1.)THEN + PRINT*,"SUSPICIOUS VALUES: CLDFRA_BL=",cldfra_bl(i,k)," qc_bl=",QC_BL(i,k) + ENDIF + ENDIF - !JOE-add tke_pbl for coupling w/shallow-cu schemes (TKE_PBL = QKE/2.) - ! TKE_PBL is defined on interfaces, while QKE is at middle of layer. - !tke_pbl(i,kts) = 0.5*MAX(qke(i,kts),1.0e-10) - !DO k = kts+1,kte - ! afk = dz1(k)/( dz1(k)+dz1(k-1) ) - ! abk = 1.0 -afk - ! tke_pbl(i,k) = 0.5*MAX(qke(i,k)*abk+qke(i,k-1)*afk,1.0e-3) - !ENDDO + !IF (I==IMD .AND. J==JMD) THEN + ! PRINT*,"MYNN DRIVER END: k=",k," sh=",sh(k) + ! PRINT*," sqw=",sqw(k)," thl=",thl(k)," exch_m=",exch_m(i,k) + ! PRINT*," xland=",xland(i)," rmol=",rmol(i)," ust=",ust(i) + ! PRINT*," qke=",qke(i,k)," el=",el_pbl(i,k)," tsq=",tsq(i,k) + ! PRINT*," PBLH=",PBLH(i)," u=",u(i,k)," v=",v(i,k) + ! PRINT*," vq=",vq(k)," vt=",vt(k) + !ENDIF + enddo !end-k + endif - ENDDO !end i-loop + enddo !end i-loop !ACF copy qke into qke_adv if using advection IF (bl_mynn_tkeadvect) THEN @@ -1610,40 +1497,40 @@ END SUBROUTINE mynn_bl_driver !!\section gen_mym_ini GSD MYNN-EDMF mym_initialize General Algorithm !> @{ SUBROUTINE mym_initialize ( & - & kts,kte, & + & kts,kte,xland, & & dz, dx, zw, & & u, v, thl, qw, & - & thlsg, qwsg, & ! & ust, rmo, pmz, phh, flt, flq, & & zi, theta, thetav, sh, sm, & & ust, rmo, el, & & Qke, Tsq, Qsq, Cov, Psig_bl, cldfra_bl1D, & & bl_mynn_mixlength, & - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & + & edmf_w1,edmf_a1, & & INITIALIZE_QKE, & & spp_pbl,rstoch_col) ! !------------------------------------------------------------------- - - INTEGER, INTENT(IN) :: kts,kte - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - LOGICAL, INTENT(IN) :: INITIALIZE_QKE -! REAL, INTENT(IN) :: ust, rmo, pmz, phh, flt, flq - REAL, INTENT(IN) :: rmo, Psig_bl - REAL(kind=kind_phys), INTENT(IN) :: dx, ust, zi - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,cldfra_bl1D,& - edmf_w1,edmf_a1,edmf_qc1 - REAL, DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov - REAL, DIMENSION(kts:kte), INTENT(inout) :: el,qke - REAL, DIMENSION(kts:kte) :: & - &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv,& + + integer, INTENT(IN) :: kts,kte + integer, INTENT(IN) :: bl_mynn_mixlength + logical, INTENT(IN) :: INITIALIZE_QKE +! real(kind_phys), INTENT(IN) :: ust, rmo, pmz, phh, flt, flq + real(kind_phys), INTENT(IN) :: rmo, Psig_bl, xland + real(kind_phys), INTENT(IN) :: dx, ust, zi + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz + real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,& + &qw,cldfra_bl1D,edmf_w1,edmf_a1 + real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: tsq,qsq,cov + real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: el,qke + real(kind_phys), DIMENSION(kts:kte) :: & + &ql,pdk,pdt,pdq,pdc,dtl,dqw,dtv, & &gm,gh,sm,sh,qkw,vt,vq INTEGER :: k,l,lmax - REAL :: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1.,flt=0.,flq=0.,tmpq - REAL, DIMENSION(kts:kte) :: theta,thetav,thlsg,qwsg - REAL, DIMENSION(kts:kte) :: rstoch_col + real(kind_phys):: phm,vkz,elq,elv,b1l,b2l,pmz=1.,phh=1., & + &flt=0.,fltv=0.,flq=0.,tmpq + real(kind_phys), DIMENSION(kts:kte) :: theta,thetav + real(kind_phys), DIMENSION(kts:kte) :: rstoch_col INTEGER ::spp_pbl !> - At first ql, vt and vq are set to zero. @@ -1657,7 +1544,6 @@ SUBROUTINE mym_initialize ( & CALL mym_level2 ( kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -1696,17 +1582,18 @@ SUBROUTINE mym_initialize ( & DO l = 1,lmax ! !> - call mym_length() to calculate the master length scale. - CALL mym_length ( & - & kts,kte, & - & dz, dx, zw, & - & rmo, flt, flq, & - & vt, vq, & - & u, v, qke, & - & dtv, & - & el, & - & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf) + CALL mym_length ( & + & kts,kte,xland, & + & dz, dx, zw, & + & rmo, flt, fltv, flq, & + & vt, vq, & + & u, v, qke, & + & dtv, & + & el, & + & zi,theta, & + & qkw,Psig_bl,cldfra_bl1D, & + & bl_mynn_mixlength, & + & edmf_w1,edmf_a1 ) ! DO k = kts+1,kte elq = el(k)*qkw(k) @@ -1816,7 +1703,6 @@ END SUBROUTINE mym_initialize SUBROUTINE mym_level2 (kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! @@ -1829,18 +1715,19 @@ SUBROUTINE mym_level2 (kts,kte, & # define kte HARDCODE_VERTICAL #endif - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,qw,ql,vt,vq,& - thetav,thlsg,qwsg - REAL, DIMENSION(kts:kte), INTENT(out) :: & + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v, & + &thl,qw,ql,vt,vq,thetav + real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: & &dtl,dqw,dtv,gm,gh,sm,sh - INTEGER :: k + integer :: k - REAL :: rfc,f1,f2,rf1,rf2,smc,shc,& - &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk,afk,abk,ri,rf + real(kind_phys):: rfc,f1,f2,rf1,rf2,smc,shc, & + &ri1,ri2,ri3,ri4,duz,dtz,dqz,vtt,vqq,dtq,dzk, & + &afk,abk,ri,rf - REAL :: a2fac + real(kind_phys):: a2fac ! ev = 2.5e6 ! tv0 = 0.61*tref @@ -1868,11 +1755,7 @@ SUBROUTINE mym_level2 (kts,kte, & duz = ( u(k)-u(k-1) )**2 +( v(k)-v(k-1) )**2 duz = duz /dzk**2 dtz = ( thl(k)-thl(k-1) )/( dzk ) - !Alternatively, use SGS clouds for thl - !dtz = ( thlsg(k)-thlsg(k-1) )/( dzk ) dqz = ( qw(k)-qw(k-1) )/( dzk ) - !Alternatively, use SGS clouds for qw - !dqz = ( qwsg(k)-qwsg(k-1) )/( dzk ) ! vtt = 1.0 +vt(k)*abk +vt(k-1)*afk ! Beta-theta in NN09, Eq. 39 vqq = tv0 +vq(k)*abk +vq(k-1)*afk ! Beta-q @@ -1949,16 +1832,17 @@ END SUBROUTINE mym_level2 !>\ingroup gsd_mynn_edmf !! This subroutine calculates the mixing lengths. SUBROUTINE mym_length ( & - & kts,kte, & + & kts,kte,xland, & & dz, dx, zw, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & vt, vq, & & u1, v1, qke, & & dtv, & & el, & - & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf) + & zi, theta, qkw, & + & Psig_bl, cldfra_bl1D, & + & bl_mynn_mixlength, & + & edmf_w1,edmf_a1 ) !------------------------------------------------------------------- @@ -1969,53 +1853,50 @@ SUBROUTINE mym_length ( & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl - REAL(kind=kind_phys), INTENT(IN) :: dx,zi - REAL, DIMENSION(kts:kte), INTENT(IN) :: u1,v1,qke,vt,vq,cldfra_bl1D,& - edmf_w1,edmf_a1,edmf_qc1 - REAL, DIMENSION(kts:kte), INTENT(out) :: qkw, el - REAL, DIMENSION(kts:kte), INTENT(in) :: dtv - - REAL :: elt,vsc - - REAL, DIMENSION(kts:kte), INTENT(IN) :: theta - REAL, DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw - REAL :: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg + INTEGER, INTENT(IN) :: bl_mynn_mixlength + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz + real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw + real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq,Psig_bl,xland + real(kind_phys), INTENT(IN) :: dx,zi + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: u1,v1, & + &qke,vt,vq,cldfra_bl1D,edmf_w1,edmf_a1 + real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: qkw, el + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dtv + real(kind_phys):: elt,vsc + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: theta + real(kind_phys), DIMENSION(kts:kte) :: qtke,elBLmin,elBLavg,thetaw + real(kind_phys):: wt,wt2,zi2,h1,h2,hs,elBLmin0,elBLavg0,cldavg ! THE FOLLOWING CONSTANTS ARE IMPORTANT FOR REGULATING THE ! MIXING LENGTHS: - REAL :: cns, & !< for surface layer (els) in stable conditions - alp1, & !< for turbulent length scale (elt) - alp2, & !< for buoyancy length scale (elb) - alp3, & !< for buoyancy enhancement factor of elb - alp4, & !< for surface layer (els) in unstable conditions - alp5, & !< for BouLac mixing length or above PBLH - alp6 !< for mass-flux/ + real(kind_phys):: cns, & !< for surface layer (els) in stable conditions + alp1, & !< for turbulent length scale (elt) + alp2, & !< for buoyancy length scale (elb) + alp3, & !< for buoyancy enhancement factor of elb + alp4, & !< for surface layer (els) in unstable conditions + alp5, & !< for BouLac mixing length or above PBLH + alp6 !< for mass-flux/ !THE FOLLOWING LIMITS DO NOT DIRECTLY AFFECT THE ACTUAL PBLH. !THEY ONLY IMPOSE LIMITS ON THE CALCULATION OF THE MIXING LENGTH !SCALES SO THAT THE BOULAC MIXING LENGTH (IN FREE ATMOS) DOES !NOT ENCROACH UPON THE BOUNDARY LAYER MIXING LENGTH (els, elb & elt). - REAL, PARAMETER :: minzi = 300. !< min mixed-layer height - REAL, PARAMETER :: maxdz = 750. !< max (half) transition layer depth + real(kind_phys), PARAMETER :: minzi = 300. !< min mixed-layer height + real(kind_phys), PARAMETER :: maxdz = 750. !< max (half) transition layer depth !! =0.3*2500 m PBLH, so the transition !! layer stops growing for PBLHs > 2.5 km. - REAL, PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth + real(kind_phys), PARAMETER :: mindz = 300. !< 300 !min (half) transition layer depth !SURFACE LAYER LENGTH SCALE MODS TO REDUCE IMPACT IN UPPER BOUNDARY LAYER - REAL, PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) - REAL, PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) - REAL :: z_m + real(kind_phys), PARAMETER :: ZSLH = 100. !< Max height correlated to surface conditions (m) + real(kind_phys), PARAMETER :: CSL = 2. !< CSL = constant of proportionality to L O(1) INTEGER :: i,j,k - REAL :: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud,wstar,elb,els, & - & els1,elf,el_stab,el_unstab,el_mf,el_stab_mf,elb_mf, & - & PBLH_PLUS_ENT,Uonset,Ugrid,el_les - REAL, PARAMETER :: ctau = 1000. !constant for tau_cloud + real(kind_phys):: afk,abk,zwk,zwk1,dzk,qdz,vflx,bv,tau_cloud, & + & wstar,elb,els,elf,el_stab,el_mf,el_stab_mf,elb_mf, & + & PBLH_PLUS_ENT,Uonset,Ugrid,wt_u,el_les + real(kind_phys), PARAMETER :: ctau = 1000. !constant for tau_cloud ! tv0 = 0.61*tref ! gtr = 9.81/tref @@ -2083,15 +1964,11 @@ SUBROUTINE mym_length ( & elf = elb ENDIF - z_m = MAX(0.,zwk - 4.) - ! ** Length scale in the surface layer ** IF ( rmo .GT. 0.0 ) THEN els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) ELSE els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 END IF ! ** HARMONC AVERGING OF MIXING LENGTH SCALES: @@ -2106,18 +1983,21 @@ SUBROUTINE mym_length ( & CASE (1) !NONLOCAL (using BouLac) FORM OF MIXING LENGTH - cns = 3.5 - alp1 = 0.22 !0.21 + ugrid = sqrt(u1(kts)**2 + v1(kts)**2) + uonset= 15. + wt_u = (1.0 - min(max(ugrid - uonset, 0.0)/30.0, 0.5)) + cns = 2.7 !was 3.5 + alp1 = 0.22 alp2 = 0.3 - alp3 = 2.0 !1.5 + alp3 = 2.0 * wt_u !taper off bouyancy enhancement in shear-driven pbls alp4 = 5.0 alp5 = 0.3 alp6 = 50. ! Impose limits on the height integration for elt and the transition layer depth - zi2=MAX(zi,200.) !minzi) - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) ! 1/2 transition layer depth + zi2=MAX(zi,300.) !minzi) + h1=MAX(0.3*zi2,300.) + h1=MIN(h1,600.) ! 1/2 transition layer depth h2=h1/2.0 ! 1/4 transition layer depth qtke(kts)=MAX(0.5*qke(kts), 0.01) !tke at full sigma levels @@ -2148,7 +2028,9 @@ SUBROUTINE mym_length ( & END DO elt = MIN( MAX( alp1*elt/vsc, 10.), 400.) - vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq + !avoid use of buoyancy flux functions which are ill-defined at the surface + !vflx = ( vt(kts)+1.0 )*flt + ( vq(kts)+tv0 )*flq + vflx = fltv vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** @@ -2163,31 +2045,23 @@ SUBROUTINE mym_length ( & ! ** Length scale limited by the buoyancy effect ** IF ( dtv(k) .GT. 0.0 ) THEN - alp2 = 0.3 !test+ 0.15*0.5*(cldfra_bl1D(k)+cldfra_bl1D(k-1)) bv = max( sqrt( gtr*dtv(k) ), 0.001) - !elb = alp2*qkw(k) / bv & ! formulation, - ! & *( 1.0 + alp3/alp2*& ! except keep - ! &SQRT( vsc/( bv*elt ) ) ) ! elb bounded by zwk elb = MAX(alp2*qkw(k), & & alp6*edmf_a1(k-1)*edmf_w1(k-1)) / bv & & *( 1.0 + alp3*SQRT( vsc/(bv*elt) ) ) elb = MIN(elb, zwk) - elf = 0.65 * qkw(k)/bv + elf = 0.80 * qkw(k)/bv elBLavg(k) = MAX(elBLavg(k), alp6*edmf_a1(k-1)*edmf_w1(k-1)/bv) ELSE elb = 1.0e10 elf = elb ENDIF - z_m = MAX(0.,zwk - 4.) - ! ** Length scale in the surface layer ** IF ( rmo .GT. 0.0 ) THEN els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) ELSE els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 END IF ! ** NOW BLEND THE MIXING LENGTH SCALES: @@ -2197,8 +2071,7 @@ SUBROUTINE mym_length ( & !defined relative to the PBLH (zi) + transition layer (h1) !el(k) = MIN(elb/( elb/elt+elb/els+1.0 ),elf) !try squared-blending - !el_unstab = SQRT( els**2/(1. + (els1**2/elt**2) )) - el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb**2))) + el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb**2))) el(k) = MIN (el(k), elf) el(k) = el(k)*(1.-wt) + alp5*elBLavg(k)*wt @@ -2212,20 +2085,20 @@ SUBROUTINE mym_length ( & Uonset = 3.5 + dz(kts)*0.1 Ugrid = sqrt(u1(kts)**2 + v1(kts)**2) cns = 3.5 !JOE-test * (1.0 - MIN(MAX(Ugrid - Uonset, 0.0)/10.0, 1.0)) - alp1 = 0.22 !0.21 + alp1 = 0.22 alp2 = 0.30 - alp3 = 2.0 !1.5 + alp3 = 2.0 alp4 = 5.0 alp5 = alp2 !like alp2, but for free atmosphere alp6 = 50.0 !used for MF mixing length ! Impose limits on the height integration for elt and the transition layer depth !zi2=MAX(zi,minzi) - zi2=MAX(zi, 200.) + zi2=MAX(zi, 300.) !h1=MAX(0.3*zi2,mindz) !h1=MIN(h1,maxdz) ! 1/2 transition layer depth - h1=MAX(0.3*zi2,200.) - h1=MIN(h1,500.) + h1=MAX(0.3*zi2,300.) + h1=MIN(h1,600.) h2=h1*0.5 ! 1/4 transition layer depth qtke(kts)=MAX(0.5*qke(kts),0.01) !tke at full sigma levels @@ -2255,7 +2128,9 @@ SUBROUTINE mym_length ( & END DO elt = MIN( MAX(alp1*elt/vsc, 10.), 400.) - vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq + !avoid use of buoyancy flux functions which are ill-defined at the surface + !vflx = ( vt(kts)+1.0 )*flt +( vq(kts)+tv0 )*flq + vflx = fltv vsc = ( gtr*elt*MAX( vflx, 0.0 ) )**onethird ! ** Strictly, el(i,j,1) is not zero. ** @@ -2318,33 +2193,24 @@ SUBROUTINE mym_length ( & elb_mf = elb END IF elf = elf/(1. + (elf/800.)) !bound free-atmos mixing length to < 800 m. -! elb_mf = elb_mf/(1. + (elb_mf/800.)) !bound buoyancy mixing length to < 800 m. elb_mf = MAX(elb_mf, 0.01) !to avoid divide-by-zero below - z_m = MAX(0.,zwk - 4.) - ! ** Length scale in the surface layer ** IF ( rmo .GT. 0.0 ) THEN els = karman*zwk/(1.0+cns*MIN( zwk*rmo, zmax )) - els1 = karman*z_m/(1.0+cns*MIN( zwk*rmo, zmax )) ELSE els = karman*zwk*( 1.0 - alp4* zwk*rmo )**0.2 - els1 = karman*z_m*( 1.0 - alp4* zwk*rmo )**0.2 END IF ! ** NOW BLEND THE MIXING LENGTH SCALES: wt=.5*TANH((zwk - (zi2+h1))/h2) + .5 - ! "el_unstab" = blended els-elt - !el_unstab = els/(1. + (els1/elt)) !try squared-blending - !el(k) = SQRT( els**2/(1. + (els1**2/elt**2) )) - el(k) = SQRT( els**2/(1. + (els1**2/elt**2) +(els1**2/elb_mf**2))) - !el(k) = MIN(el_unstab, elb_mf) + el(k) = SQRT( els**2/(1. + (els**2/elt**2) +(els**2/elb_mf**2))) el(k) = el(k)*(1.-wt) + elf*wt - ! include scale-awareness. For now, use simple asymptotic kz -> 12 m. - el_les= MIN(els/(1. + (els1/12.)), elb_mf) + ! include scale-awareness. For now, use simple asymptotic kz -> 12 m (should be ~dz). + el_les= MIN(els/(1. + (els/12.)), elb_mf) el(k) = el(k)*Psig_bl + (1.-Psig_bl)*el_les END DO @@ -2391,14 +2257,14 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) !------------------------------------------------------------------- INTEGER, INTENT(IN) :: k,kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta + real(kind_phys), INTENT(OUT) :: lb1,lb2 + real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw !LOCAL VARS INTEGER :: izz, found - REAL :: dlu,dld - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz + real(kind_phys):: dlu,dld + real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !---------------------------------- @@ -2541,15 +2407,15 @@ SUBROUTINE boulac_length(kts,kte,zw,dz,qtke,theta,lb1,lb2) !------------------------------------------------------------------- INTEGER, INTENT(IN) :: kts,kte - REAL, DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta - REAL, DIMENSION(kts:kte), INTENT(OUT) :: lb1,lb2 - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: qtke,dz,theta + real(kind_phys), DIMENSION(kts:kte), INTENT(OUT):: lb1,lb2 + real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw !LOCAL VARS INTEGER :: iz, izz, found - REAL, DIMENSION(kts:kte) :: dlu,dld - REAL, PARAMETER :: Lmax=2000. !soft limit - REAL :: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz + real(kind_phys), DIMENSION(kts:kte) :: dlu,dld + real(kind_phys), PARAMETER :: Lmax=2000. !soft limit + real(kind_phys):: dzt, zup, beta, zup_inf, bbb, tl, zdo, zdo_sup, zzz !print*,"IN MYNN-BouLac",kts, kte @@ -2730,30 +2596,30 @@ END SUBROUTINE boulac_length !! - Production terms of TKE,\f$\theta^{'2}\f$,\f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$ !! are calculated. !! - Eddy diffusivity \f$K_h\f$ and eddy viscosity \f$K_m\f$ are calculated. -!! - TKE budget terms are calculated (if the namelist parameter \p bl_mynn_tkebudget +!! - TKE budget terms are calculated (if the namelist parameter \p tke_budget !! is set to True) SUBROUTINE mym_turbulence ( & & kts,kte, & - & closure, & + & xland,closure, & & dz, dx, zw, & & u, v, thl, thetav, ql, qw, & - & thlsg, qwsg, & & qke, tsq, qsq, cov, & & vt, vq, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & zi,theta, & & sh, sm, & & El, & & Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & - & bl_mynn_tkebudget, & - & Psig_bl,Psig_shcu,cldfra_bl1D,bl_mynn_mixlength,& - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf, & + & tke_budget, & + & Psig_bl,Psig_shcu,cldfra_bl1D, & + & bl_mynn_mixlength, & + & edmf_w1,edmf_a1, & & TKEprodTD, & - & spp_pbl,rstoch_col) + & spp_pbl,rstoch_col ) !------------------------------------------------------------------- -! + INTEGER, INTENT(IN) :: kts,kte #ifdef HARDCODE_VERTICAL @@ -2761,40 +2627,38 @@ SUBROUTINE mym_turbulence ( & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(IN) :: bl_mynn_mixlength,bl_mynn_edmf - REAL(kind=kind_phys), INTENT(IN) :: closure - REAL, DIMENSION(kts:kte), INTENT(in) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(in) :: zw - REAL, INTENT(in) :: rmo,flt,flq,Psig_bl,Psig_shcu - REAL(kind=kind_phys), INTENT(IN) :: dx,zi - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw,& - &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1,edmf_qc1,& - &TKEprodTD,thlsg,qwsg - - REAL, DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq,& + INTEGER, INTENT(IN) :: bl_mynn_mixlength,tke_budget + real(kind_phys), INTENT(IN) :: closure + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: dz + real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: zw + real(kind_phys), INTENT(in) :: rmo,flt,fltv,flq, & + &Psig_bl,Psig_shcu,xland,dx,zi + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,thl,thetav,qw, & + &ql,vt,vq,qke,tsq,qsq,cov,cldfra_bl1D,edmf_w1,edmf_a1, & + &TKEprodTD + + real(kind_phys), DIMENSION(kts:kte), INTENT(out) :: dfm,dfh,dfq, & &pdk,pdt,pdq,pdc,tcd,qcd,el - REAL, DIMENSION(kts:kte), INTENT(inout) :: & + real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D - REAL :: q3sq_old,dlsq1,qWTP_old,qWTP_new - REAL :: dudz,dvdz,dTdz,& - upwp,vpwp,Tpwp - LOGICAL, INTENT(in) :: bl_mynn_tkebudget + real(kind_phys):: q3sq_old,dlsq1,qWTP_old,qWTP_new + real(kind_phys):: dudz,dvdz,dTdz,upwp,vpwp,Tpwp - REAL, DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh + real(kind_phys), DIMENSION(kts:kte) :: qkw,dtl,dqw,dtv,gm,gh,sm,sh INTEGER :: k -! REAL :: cc2,cc3,e1c,e2c,e3c,e4c,e5c - REAL :: e6c,dzk,afk,abk,vtt,vqq,& +! real(kind_phys):: cc2,cc3,e1c,e2c,e3c,e4c,e5c + real(kind_phys):: e6c,dzk,afk,abk,vtt,vqq, & &cw25,clow,cupp,gamt,gamq,smd,gamv,elq,elh - REAL :: cldavg - REAL, DIMENSION(kts:kte), INTENT(in) :: theta + real(kind_phys):: cldavg + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: theta - REAL :: a2fac, duz, ri !JOE-Canuto/Kitamura mod + real(kind_phys):: a2fac, duz, ri !JOE-Canuto/Kitamura mod - REAL:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2,& - gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min,& + real:: auh,aum,adh,adm,aeh,aem,Req,Rsl,Rsl2, & + gmelq,sm20,sh20,sm25max,sh25max,sm25min,sh25min, & sm_pbl,sh_pbl,zi2,wt,slht,wtpr DOUBLE PRECISION q2sq, t2sq, r2sq, c2sq, elsq, gmel, ghel @@ -2802,11 +2666,10 @@ SUBROUTINE mym_turbulence ( & DOUBLE PRECISION e1, e2, e3, e4, enum, eden, wden ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: Prnum, Prlim - REAL, PARAMETER :: Prlimit = 5.0 - + INTEGER, INTENT(IN) :: spp_pbl + real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + real(kind_phys):: Prnum, shb + real(kind_phys), PARAMETER :: Prlimit = 5.0 ! ! tv0 = 0.61*tref @@ -2824,21 +2687,21 @@ SUBROUTINE mym_turbulence ( & CALL mym_level2 (kts,kte, & & dz, & & u, v, thl, thetav, qw, & - & thlsg, qwsg, & & ql, vt, vq, & & dtl, dqw, dtv, gm, gh, sm, sh ) ! CALL mym_length ( & - & kts,kte, & + & kts,kte,xland, & & dz, dx, zw, & - & rmo, flt, flq, & + & rmo, flt, fltv, flq, & & vt, vq, & & u, v, qke, & & dtv, & & el, & & zi,theta, & - & qkw,Psig_bl,cldfra_bl1D,bl_mynn_mixlength, & - & edmf_w1,edmf_a1,edmf_qc1,bl_mynn_edmf ) + & qkw,Psig_bl,cldfra_bl1D, & + & bl_mynn_mixlength, & + & edmf_w1,edmf_a1 ) ! DO k = kts+1,kte @@ -3002,10 +2865,16 @@ SUBROUTINE mym_turbulence ( & !IF ( sm(k) > sm25max ) sm(k) = sm25max !IF ( sm(k) < sm25min ) sm(k) = sm25min !sm(k) = Prnum*sh(k) - slht = zi*0.1 - wtpr = min( max( (slht - zw(k))/slht, 0.0), 1.0) ! 1 at z=0, 0 above sfc layer - Prlim = 1.0*wtpr + (1.0 - wtpr)*Prlimit - sm(k) = MIN(sm(k), Prlimit*Sh(k)) + + !surface layer PR + !slht = zi*0.1 + !wtpr = min( max( (slht - zw(k))/slht, 0.0), 1.0) ! 1 at z=0, 0 above sfc layer + !Prlim = 1.0*wtpr + (1.0 - wtpr)*Prlimit + !Prlim = 2.0*wtpr + (1.0 - wtpr)*Prlimit + !sm(k) = MIN(sm(k), Prlim*Sh(k)) + !Pending more testing, keep same Pr limit in sfc layer + shb = max(sh(k), 0.002) + sm(k) = MIN(sm(k), Prlimit*shb) ! ** Level 3 : start ** IF ( closure .GE. 3.0 ) THEN @@ -3160,11 +3029,6 @@ SUBROUTINE mym_turbulence ( & ! with active plumes and clouds. cldavg = 0.5*(cldfra_bl1D(k-1) + cldfra_bl1D(k)) IF (edmf_a1(k) > 0.001 .OR. cldavg > 0.02) THEN - !sm(k) = MAX(sm(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & - ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - !sh(k) = MAX(sh(k), MAX(1.0 - 2.0*cldavg, 0.0)**0.33 * 0.03 * & - ! & MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) - ! for mass-flux columns sm(k) = MAX(sm(k), 0.03*MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) sh(k) = MAX(sh(k), 0.03*MIN(10.*edmf_a1(k)*edmf_w1(k),1.0) ) @@ -3178,14 +3042,14 @@ SUBROUTINE mym_turbulence ( & ! Production of TKE (pdk), T-variance (pdt), ! q-variance (pdq), and covariance (pdc) - pdk(k) = elq*( sm(k)*gm(k) & - & +sh(k)*gh(k)+gamv ) + & + pdk(k) = elq*( sm(k)*gm(k) & + & +sh(k)*gh(k)+gamv ) + & & TKEprodTD(k) pdt(k) = elh*( sh(k)*dtl(k)+gamt )*dtl(k) pdq(k) = elh*( sh(k)*dqw(k)+gamq )*dqw(k) - pdc(k) = elh*( sh(k)*dtl(k)+gamt )& - &*dqw(k)*0.5 & - &+elh*( sh(k)*dqw(k)+gamq )*dtl(k)*0.5 + pdc(k) = elh*( sh(k)*dtl(k)+gamt ) & + & *dqw(k)*0.5 & + & + elh*( sh(k)*dqw(k)+gamq )*dtl(k)*0.5 ! Contergradient terms tcd(k) = elq*gamt @@ -3200,7 +3064,7 @@ SUBROUTINE mym_turbulence ( & dfq(k) = dfm(k) ! Modified: Dec/22/2005, up to here - IF ( bl_mynn_tkebudget ) THEN + IF (tke_budget .eq. 1) THEN !TKE BUDGET ! dudz = ( u(k)-u(k-1) )/dzk ! dvdz = ( v(k)-v(k-1) )/dzk @@ -3229,7 +3093,7 @@ SUBROUTINE mym_turbulence ( & !!!Dissipation Term (now it evaluated on mym_predict) !qDISS1D(k) = (q3sq**(3./2.))/(b1*MAX(el(k),1.)) !! ORIGINAL CODE - !! >> EOB + !! >> EOB ENDIF END DO @@ -3323,7 +3187,7 @@ SUBROUTINE mym_predict (kts,kte, & & pdk, pdt, pdq, pdc, & & qke, tsq, qsq, cov, & & s_aw,s_awqke,bl_mynn_edmf_tke, & - & qWT1D, qDISS1D,bl_mynn_tkebudget) !! TKE budget (Puhales, 2020) + & qWT1D, qDISS1D,tke_budget) !! TKE budget (Puhales, 2020) !------------------------------------------------------------------- INTEGER, INTENT(IN) :: kts,kte @@ -3333,30 +3197,29 @@ SUBROUTINE mym_predict (kts,kte, & # define kte HARDCODE_VERTICAL #endif - REAL(kind=kind_phys), INTENT(IN) :: closure - INTEGER, INTENT(IN) :: bl_mynn_edmf_tke - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc - REAL, INTENT(IN) :: flt, flq, pmz, phh - REAL(kind=kind_phys), INTENT(IN) :: ust, delt - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov + real(kind_phys), INTENT(IN) :: closure + INTEGER, INTENT(IN) :: bl_mynn_edmf_tke,tke_budget + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz, dfq, el, rho + real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: pdk, pdt, pdq, pdc + real(kind_phys), INTENT(IN) :: flt, flq, pmz, phh + real(kind_phys), INTENT(IN) :: ust, delt + real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: qke,tsq, qsq, cov ! WA 8/3/15 - REAL, DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw + real(kind_phys), DIMENSION(kts:kte+1), INTENT(INOUT) :: s_awqke,s_aw !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D - LOGICAL, INTENT(IN) :: bl_mynn_tkebudget - REAL, DIMENSION(kts:kte) :: tke_up,dzinv + real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qWT1D, qDISS1D + real(kind_phys), DIMENSION(kts:kte) :: tke_up,dzinv !! >> EOB INTEGER :: k - REAL, DIMENSION(kts:kte) :: qkw, bp, rp, df3q - REAL :: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), DIMENSION(kts:kte) :: qkw, bp, rp, df3q + real(kind_phys):: vkz,pdk1,phm,pdt1,pdq1,pdc1,b1l,b2l,onoff + real(kind_phys), DIMENSION(kts:kte) :: dtz + real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz + real(kind_phys), DIMENSION(kts:kte) :: rhoinv + real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,kqdz,kmdz ! REGULATE THE MOMENTUM MIXING FROM THE MASS-FLUX SCHEME (on or off) IF (bl_mynn_edmf_tke == 0) THEN @@ -3486,7 +3349,7 @@ SUBROUTINE mym_predict (kts,kte, & !! TKE budget (Puhales, 2020, WRF 4.2.1) << EOB - IF (bl_mynn_tkebudget) THEN + IF (tke_budget .eq. 1) THEN !! TKE Vertical transport << EOBvt tke_up=0.5*qke dzinv=1./dz @@ -3722,8 +3585,8 @@ END SUBROUTINE mym_predict !! calculate the buoyancy flux. Different cloud PDFs can be selected by !! use of the namelist parameter \p bl_mynn_cloudpdf . SUBROUTINE mym_condensation (kts,kte, & - & dx, dz, zw, u1, v1, xland,& - & thl, qw, qv, qc, qi, & + & dx, dz, zw, xland, & + & thl, qw, qv, qc, qi, qs, & & p,exner, & & tsq, qsq, cov, & & Sh, el, bl_mynn_cloudpdf, & @@ -3742,45 +3605,45 @@ SUBROUTINE mym_condensation (kts,kte, & # define kte HARDCODE_VERTICAL #endif - REAL, INTENT(IN) :: HFX1,rmo,xland - REAL(kind=kind_phys), INTENT(IN) :: dx,pblh1 - REAL, DIMENSION(kts:kte), INTENT(IN) :: dz - REAL, DIMENSION(kts:kte+1), INTENT(IN) :: zw - REAL, DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw,qv,qc,qi, & - &tsq, qsq, cov, th, u1, v1 + real(kind_phys), INTENT(IN) :: HFX1,rmo,xland + real(kind_phys), INTENT(IN) :: dx,pblh1 + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dz + real(kind_phys), DIMENSION(kts:kte+1), INTENT(IN) :: zw + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: p,exner,thl,qw, & + &qv,qc,qi,qs,tsq,qsq,cov,th - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm + real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: vt,vq,sgm - REAL, DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH - REAL, DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & - cldfra_bl1D + real(kind_phys), DIMENSION(kts:kte) :: alp,a,bet,b,ql,q1,RH + real(kind_phys), DIMENSION(kts:kte), INTENT(OUT) :: qc_bl1D,qi_bl1D, & + &cldfra_bl1D DOUBLE PRECISION :: t3sq, r3sq, c3sq - REAL :: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll,& - &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb,& - &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water,& - &qmq,qsat_tk,wsp,wspfac + real(kind_phys):: qsl,esat,qsat,dqsl,cld0,q1k,qlk,eq1,qll, & + &q2p,pt,rac,qt,t,xl,rsl,cpm,Fng,qww,alpha,beta,bb, & + &ls,wt,cld_factor,fac_damp,liq_frac,ql_ice,ql_water, & + &qmq,qsat_tk,q1_rh,rh_hack + real(kind_phys), PARAMETER :: rhcrit=0.83 !for hom pdf min sigma INTEGER :: i,j,k - REAL :: erf + real(kind_phys):: erf !VARIABLES FOR ALTERNATIVE SIGMA - REAL::dth,dtl,dqw,dzk,els - REAL, DIMENSION(kts:kte), INTENT(IN) :: Sh,el + real:: dth,dtl,dqw,dzk,els + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: Sh,el !variables for SGS BL clouds - REAL :: zagl,damp,PBLH2 - REAL :: cfmax - INTEGER, PARAMETER :: buoy_opt=1 ! 0: traditional SD77, 1: CB02,CB05 + real(kind_phys) :: zagl,damp,PBLH2 + real(kind_phys) :: cfmax !JAYMES: variables for tropopause-height estimation - REAL :: theta1, theta2, ht1, ht2 - INTEGER :: k_tropo + real(kind_phys) :: theta1, theta2, ht1, ht2 + INTEGER :: k_tropo ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col - REAL :: qw_pert + INTEGER, INTENT(IN) :: spp_pbl + real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col + real(kind_phys) :: qw_pert ! First, obtain an estimate for the tropopause height (k), using the method employed in the ! Thompson subgrid-cloud scheme. This height will be a consideration later when determining @@ -3856,9 +3719,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(k) = liq_frac*ql(k) qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -3916,9 +3776,6 @@ SUBROUTINE mym_condensation (kts,kte, & qc_bl1D(k) = liq_frac*ql(k) qi_bl1D(k) = (1.0 - liq_frac)*ql(k) - if(cldfra_bl1D(k)>0.01 .and. qc_bl1D(k)<1.E-6)qc_bl1D(k)=1.E-6 - if(cldfra_bl1D(k)>0.01 .and. qi_bl1D(k)<1.E-8)qi_bl1D(k)=1.E-8 - !Now estimate the buoyancy flux functions q2p = xlvcp/exner(k) pt = thl(k) +q2p*ql(k) ! potential temp @@ -3947,7 +3804,7 @@ SUBROUTINE mym_condensation (kts,kte, & xl = xl_blend(t) ! obtain latent heat qsat_tk = qsat_blend(t, p(k)) ! saturation water vapor mixing ratio at tk and p - rh(k)=MAX(MIN(1.0,qw(k)/MAX(1.E-8,qsat_tk)),0.001) + rh(k)=MAX(MIN(1.00,qw(k)/MAX(1.E-10,qsat_tk)),0.001) !dqw/dT: Clausius-Clapeyron dqsl = qsat_tk*ep_2*xlv/( r_d*t**2 ) @@ -3968,35 +3825,53 @@ SUBROUTINE mym_condensation (kts,kte, & !Use the form of Eq. (6) in Chaboureau and Bechtold (2002) !except neglect all but the first term for sig_r - r3sq = MAX( qsq(k), 0.0 ) + r3sq = max( qsq(k), 0.0 ) !Calculate sigma using higher-order moments: sgm(k) = SQRT( r3sq ) !Set limits on sigma relative to saturation water vapor - sgm(k) = MIN( sgm(k), qsat_tk*0.666 ) !500 ) - sgm(k) = MAX( sgm(k), qsat_tk*0.035 ) !Note: 0.02 results in SWDOWN similar - !to the first-order version of sigma - q1(k) = qmq / sgm(k) ! Q1, the normalized saturation + sgm(k) = min( sgm(k), qsat_tk*0.666 ) + sgm(k) = max( sgm(k), qsat_tk*0.035 ) + q1(k) = qmq / sgm(k) ! Q1, the normalized saturation + + !Add condition for falling/settling into low-RH layers, so at least + !some cloud fraction is applied for all qc and qi. + rh_hack = rh(k) + !ensure adequate RH & q1 when qi is at least 1e-9 + if (qi(k)>1.e-9) then + rh_hack =min(1.0, rhcrit + 0.06*(9.0 + log10(qi(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif + !ensure adequate RH & q1 when qc is at least 1e-6 + if (qc(k)>1.e-6) then + rh_hack =min(1.0, rhcrit + 0.09*(6.0 + log10(qc(k)))) + rh(k) =max(rh(k), rh_hack) + !add rh-based q1 + q1_rh =-3. + 3.*(rh_hack-rhcrit)/(1.-rhcrit) + q1(k) =max(q1_rh, q1(k) ) + endif + q1k = q1(k) ! backup Q1 for later modification ! Specify cloud fraction !Original C-B cloud fraction, allows cloud fractions out to q1 = -3.5 !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.55*q1(k)))) ! Eq. 7 in CB02 - !wayne's - over-diffuse, when limits removed from vt & vq & fng + !Waynes LES fit - over-diffuse, when limits removed from vt & vq & fng !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.2*(q1(k)+0.4)))) - !effort to reduce rh-dependency - !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(2.9*(q1(k)+0.4)))) - cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.8*(q1(k)+0.4)))) - !moderate - best compromise?? - !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.55*(q1(k)+0.2)))) - !closer to original for Q1 < -1, best for holding onto stratus, not good flowers - !cldfra_bl1D(K) = max(0., min(1., 0.5+0.36*atan(1.9*(q1(k)+0.4)))) - + !Best compromise: Improves marine stratus without adding much cold bias. + cldfra_bl1D(k) = max(0., min(1., 0.5+0.36*atan(1.8*(q1(k)+0.2)))) ! Specify hydrometeors ! JAYMES- this option added 8 May 2015 ! The cloud water formulations are taken from CB02, Eq. 8. IF (q1k < 0.) THEN !unsaturated - ql_water = sgm(k)*EXP(1.2*q1k-1) +#ifdef SINGLE_PREC + ql_water = sgm(k)*EXP(1.2*q1k-1.) +#else + ql_water = sgm(k)*EXP(1.2*q1k-1.) +#endif ql_ice = sgm(k)*EXP(1.2*q1k-1.) ELSE IF (q1k > 2.) THEN !supersaturated ql_water = sgm(k)*q1k @@ -4007,41 +3882,23 @@ SUBROUTINE mym_condensation (kts,kte, & ENDIF !In saturated grid cells, use average of SGS and resolved values - if ( qc(k) > 1.e-7 ) ql_water = 0.5 * ( ql_water + qc(k) ) - if ( qi(k) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + qi(k) ) + !if ( qc(k) > 1.e-6 ) ql_water = 0.5 * ( ql_water + qc(k) ) + !ql_ice is actually the total frozen condensate (snow+ice), + !if ( (qi(k)+qs(k)) > 1.e-9 ) ql_ice = 0.5 * ( ql_ice + (qi(k)+qs(k)) ) - if (cldfra_bl1D(k) < 0.01) then + if (cldfra_bl1D(k) < 0.001) then ql_ice = 0.0 ql_water = 0.0 cldfra_bl1D(k) = 0.0 endif - !PHASE PARTITIONING: Make some inferences about the relative amounts of - !subgrid cloud water vs. ice based on collocated explicit clouds. Otherise, - !use a simple temperature-dependent partitioning. - ! IF ( qc(k) + qi(k) > 0.0 ) THEN ! explicit condensate exists, retain its phase partitioning - ! IF ( qi(k) == 0.0 ) THEN ! explicit contains no ice; assume subgrid liquid - ! liq_frac = 1.0 - ! ELSE IF ( qc(k) == 0.0 ) THEN ! explicit contains no liquid; assume subgrid ice - ! liq_frac = 0.0 - ! ELSE IF ( (qc(k) >= 1.E-10) .AND. (qi(k) >= 1.E-10) ) THEN ! explicit contains mixed phase of workably - ! ! large amounts; assume subgrid follows - ! ! same partioning - ! liq_frac = qc(k) / ( qc(k) + qi(k) ) - ! ELSE - ! liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(t0c-tice))) ! explicit contains mixed phase, but at least one - ! ! species is very small, so make a temperature- - ! ! depedent guess - ! ENDIF - ! ELSE ! no explicit condensate, so make a temperature-dependent guess - liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(tliq-tice))) - ! ENDIF - + liq_frac = MIN(1.0, MAX(0.0, (t-tice)/(tliq-tice))) qc_bl1D(k) = liq_frac*ql_water ! apply liq_frac to ql_water and ql_ice qi_bl1D(k) = (1.0-liq_frac)*ql_ice - !Above tropopause: eliminate subgrid clouds from CB scheme - if (k .ge. k_tropo-1) then + !Above tropopause: eliminate subgrid clouds from CB scheme. Note that this was + !"k_tropo - 1" as of 20 Feb 2023. Changed to allow more high-level clouds. + if (k .ge. k_tropo) then cldfra_bl1D(K) = 0. qc_bl1D(k) = 0. qi_bl1D(k) = 0. @@ -4049,6 +3906,7 @@ SUBROUTINE mym_condensation (kts,kte, & !Buoyancy-flux-related calculations follow... !limiting Q1 to avoid too much diffusion in cloud layers + !q1k=max(Q1(k),-2.0) if ((xland-1.5).GE.0) then ! water q1k=max(Q1(k),-2.5) else ! land @@ -4076,64 +3934,30 @@ SUBROUTINE mym_condensation (kts,kte, & Fng = MIN(23.9 + EXP(-1.6*(q1k+2.5)), 60.) ENDIF - if (buoy_opt .eq. 1) then - cfmax= min(cldfra_bl1D(K), 0.6) - bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from - ! "b" in CB02 (i.e., b(k) above) by a factor - ! of T/theta. Strictly, b(k) above is formulated in - ! terms of sat. mixing ratio, but bb in BCMT95 is - ! cast in terms of sat. specific humidity. The - ! conversion is neglected here. - qww = 1.+0.61*qw(k) - alpha = 0.61*th(k) - beta = (th(k)/t)*(xl/cp) - 1.61*th(k) - vt(k) = qww - cfmax*beta*bb*Fng - 1. - vq(k) = alpha + cfmax*beta*a(k)*Fng - tv0 - ! vt and vq correspond to beta-theta and beta-q, respectively, - ! in NN09, Eq. B8. They also correspond to the bracketed - ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng - ! The "-1" and "-tv0" terms are included for consistency with - ! the legacy vt and vq formulations (above). - else - - !original buoyancy flux functions from SD77 - eq1 = rrp*exp( -0.5*q1k*q1k ) - qll = max( cldfra_bl1D(k)*q1k + eq1, 0.0 ) - q2p = xl/cp/exner(k) - - !qt is a THETA-V CONVERSION FOR TOTAL WATER - cfmax= min(cldfra_bl1D(K), 0.6) - qt = 1.0 +p608*qw(k) -(1.+p608)*(qc_bl1D(k)+qi_bl1D(k))*cfmax - rac = alp(k)*( cfmax-qll*eq1 )*( q2p*qt-(1.+p608)*th(k) ) - - !BUOYANCY FACTORS: wherever vt and vq are used, there is a - !"+1" and "+tv0", respectively, so these are subtracted out here. - !vt is unitless and vq has units of K. - vt(k) = qt-1.0 -rac*bet(k) - vq(k) = p608*th(k)-tv0 +rac - endif - - ! dampen the amplification factor (cld_factor) with height in order - ! to limit excessively large cloud fractions aloft - !fac_damp = 1.! -MIN(MAX( zagl-(PBLH2+1000.),0.0)/ & - ! MAX((zw(k_tropo)-(PBLH2+1000.)),500.), 1.) - !fac_damp = min(zagl * 0.01, 1.0) - wsp =sqrt(u1(k)**2 + v1(k)**2) - wspfac = 1.0 - min(max(0.,wsp-15),10.)/10. ! reduce as winds go from 15 to 25 m/s. - fac_damp = min(zagl * 0.0025, 1.0)*wspfac - !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.5 ) / 0.51 )**3.3 + cfmax= min(cldfra_bl1D(k), 0.6) + bb = b(k)*t/th(k) ! bb is "b" in BCMT95. Their "b" differs from + ! "b" in CB02 (i.e., b(k) above) by a factor + ! of T/theta. Strictly, b(k) above is formulated in + ! terms of sat. mixing ratio, but bb in BCMT95 is + ! cast in terms of sat. specific humidity. The + ! conversion is neglected here. + qww = 1.+0.61*qw(k) + alpha = 0.61*th(k) + beta = (th(k)/t)*(xl/cp) - 1.61*th(k) + vt(k) = qww - cfmax*beta*bb*Fng - 1. + vq(k) = alpha + cfmax*beta*a(k)*Fng - tv0 + ! vt and vq correspond to beta-theta and beta-q, respectively, + ! in NN09, Eq. B8. They also correspond to the bracketed + ! expressions in BCMT95, Eq. 15, since (s*ql/sigma^2) = cldfra*Fng + ! The "-1" and "-tv0" terms are included for consistency with + ! the legacy vt and vq formulations (above). + + ! dampen amplification factor where need be + fac_damp = min(zagl * 0.0025, 1.0) !cld_factor = 1.0 + fac_damp*MAX(0.0, ( RH(k) - 0.75 ) / 0.26 )**1.9 !HRRRv4 - !cld_factor = 1.0 + fac_damp*(MAX(0.0, ( RH(k) - 0.80 )) / 0.22 )**2 - !cld_factor = 1.0 + fac_damp*(MAX(0.0, ( RH(k) - 0.90 )) / 0.11 )**2 - !cld_factor = 1.0 + fac_damp*1.8*(max(0.0, q1k + 0.2 ))**2 !too low of albedo - !cld_factor = 1.0 + fac_damp*1.8*(max(0.0, q1k + 0.2 ))**2 - !make this enhancement over water only? - !if ((xland-1.5).GE.0) then ! water - cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) - !else - ! cld_factor = 1.0 - !endif - cldfra_bl1D(K) = MIN( 1., cld_factor*cldfra_bl1D(K) ) + !cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.25 )**2, 0.3) + cld_factor = 1.0 + fac_damp*min((max(0.0, ( RH(k) - 0.92 )) / 0.145)**2, 0.35) + cldfra_bl1D(K) = min( 1., cld_factor*cldfra_bl1D(K) ) enddo END SELECT !end cloudPDF option @@ -4166,38 +3990,39 @@ END SUBROUTINE mym_condensation !>\ingroup gsd_mynn_edmf !! This subroutine solves for tendencies of U, V, \f$\theta\f$, qv, !! qc, and qi - SUBROUTINE mynn_tendencies(kts,kte,i, & - &delt,dz,rho, & - &u,v,th,tk,qv,qc,qi,qnc,qni, & - &psfc,p,exner, & - &thl,sqv,sqc,sqi,sqw, & - &qnwfa,qnifa,ozone, & - &ust,flt,flq,flqv,flqc,wspd, & - &uoce,voce, & - &tsq,qsq,cov, & - &tcd,qcd, & - &dfm,dfh,dfq, & - &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqnc,Dqni, & - &Dqnwfa,Dqnifa,Dozone, & - &diss_heat, & - &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & - &s_awu,s_awv, & - &s_awqnc,s_awqni, & - &s_awqnwfa,s_awqnifa, & - &sd_aw,sd_awthl,sd_awqt,sd_awqv, & - &sd_awqc,sd_awu,sd_awv, & - &sub_thl,sub_sqv, & - &sub_u,sub_v, & - &det_thl,det_sqv,det_sqc, & - &det_u,det_v, & - &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & - &FLAG_QNWFA,FLAG_QNIFA, & - &cldfra_bl1d, & - &bl_mynn_cloudmix, & - &bl_mynn_mixqt, & - &bl_mynn_edmf, & - &bl_mynn_edmf_mom, & - &bl_mynn_mixscalars ) + SUBROUTINE mynn_tendencies(kts,kte,i, & + &delt,dz,rho, & + &u,v,th,tk,qv,qc,qi,qs,qnc,qni, & + &psfc,p,exner, & + &thl,sqv,sqc,sqi,sqs,sqw, & + &qnwfa,qnifa,qnbca,ozone, & + &ust,flt,flq,flqv,flqc,wspd, & + &uoce,voce, & + &tsq,qsq,cov, & + &tcd,qcd, & + &dfm,dfh,dfq, & + &Du,Dv,Dth,Dqv,Dqc,Dqi,Dqs,Dqnc,Dqni, & + &Dqnwfa,Dqnifa,Dqnbca,Dozone, & + &diss_heat, & + &s_aw,s_awthl,s_awqt,s_awqv,s_awqc, & + &s_awu,s_awv, & + &s_awqnc,s_awqni, & + &s_awqnwfa,s_awqnifa,s_awqnbca, & + &sd_aw,sd_awthl,sd_awqt,sd_awqv, & + &sd_awqc,sd_awu,sd_awv, & + &sub_thl,sub_sqv, & + &sub_u,sub_v, & + &det_thl,det_sqv,det_sqc, & + &det_u,det_v, & + &FLAG_QC,FLAG_QI,FLAG_QNC,FLAG_QNI, & + &FLAG_QS, & + &FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA, & + &cldfra_bl1d, & + &bl_mynn_cloudmix, & + &bl_mynn_mixqt, & + &bl_mynn_edmf, & + &bl_mynn_edmf_mom, & + &bl_mynn_mixscalars ) !------------------------------------------------------------------- INTEGER, INTENT(in) :: kts,kte,i @@ -4207,11 +4032,11 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & # define kte HARDCODE_VERTICAL #endif - INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt,& - bl_mynn_edmf,bl_mynn_edmf_mom, & + INTEGER, INTENT(in) :: bl_mynn_cloudmix,bl_mynn_mixqt, & + bl_mynn_edmf,bl_mynn_edmf_mom, & bl_mynn_mixscalars - LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QNC,& - FLAG_QNWFA,FLAG_QNIFA + LOGICAL, INTENT(IN) :: FLAG_QI,FLAG_QNI,FLAG_QC,FLAG_QS, & + &FLAG_QNC,FLAG_QNWFA,FLAG_QNIFA,FLAG_QNBCA ! thl - liquid water potential temperature ! qw - total water @@ -4220,46 +4045,47 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ! flq - surface flux of qw ! mass-flux plumes - REAL, DIMENSION(kts:kte+1), INTENT(in) :: s_aw,s_awthl,s_awqt,& - &s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & - &s_awqnwfa,s_awqnifa, & + real(kind_phys), DIMENSION(kts:kte+1), INTENT(in) :: s_aw, & + &s_awthl,s_awqt,s_awqnc,s_awqni,s_awqv,s_awqc,s_awu,s_awv, & + &s_awqnwfa,s_awqnifa,s_awqnbca, & &sd_aw,sd_awthl,sd_awqt,sd_awqv,sd_awqc,sd_awu,sd_awv ! tendencies from mass-flux environmental subsidence and detrainment - REAL, DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: sub_thl,sub_sqv, & &sub_u,sub_v,det_thl,det_sqv,det_sqc,det_u,det_v - REAL, DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,qni,qnc,& - &rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd,cldfra_bl1d,diss_heat - REAL, DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,sqi,& - &qnwfa,qnifa,ozone,dfm,dfh - REAL, DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv,dqc,dqi,& - &dqni,dqnc,dqnwfa,dqnifa,dozone - REAL, INTENT(IN) :: flt,flq,flqv,flqc,uoce,voce - REAL(kind=kind_phys), INTENT(IN) :: ust,delt,psfc,wspd + real(kind_phys), DIMENSION(kts:kte), INTENT(in) :: u,v,th,tk,qv,qc,qi,& + &qs,qni,qnc,rho,p,exner,dfq,dz,tsq,qsq,cov,tcd,qcd, & + &cldfra_bl1d,diss_heat + real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: thl,sqw,sqv,sqc,& + &sqi,sqs,qnwfa,qnifa,qnbca,ozone,dfm,dfh + real(kind_phys), DIMENSION(kts:kte), INTENT(inout) :: du,dv,dth,dqv, & + &dqc,dqi,dqs,dqni,dqnc,dqnwfa,dqnifa,dqnbca,dozone + real(kind_phys), INTENT(IN) :: flt,flq,flqv,flqc,uoce,voce + real(kind_phys), INTENT(IN) :: ust,delt,psfc,wspd !debugging - REAL ::wsp,wsp2,tk2,th2 + real(kind_phys):: wsp,wsp2,tk2,th2 LOGICAL :: problem integer :: kproblem -! REAL, INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top +! real(kind_phys), INTENT(IN) :: gradu_top,gradv_top,gradth_top,gradqv_top !local vars - REAL, DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp - REAL, DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqw2,qni2,qnc2, & !AFTER MIXING - qnwfa2,qnifa2,ozone2 - REAL, DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - REAL, DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface - & khdz, kmdz - REAL :: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw - REAL :: t,esat,qsl,onoff,kh,km,dzk,rhosfc - REAL :: ustdrag,ustdiff,qvflux - REAL :: th_new,portion_qc,portion_qi,condensate,qsat + real(kind_phys), DIMENSION(kts:kte) :: dtz,dfhc,dfmc,delp + real(kind_phys), DIMENSION(kts:kte) :: sqv2,sqc2,sqi2,sqs2,sqw2, & + &qni2,qnc2,qnwfa2,qnifa2,qnbca2,ozone2 + real(kind_phys), DIMENSION(kts:kte) :: zfac,plumeKh,rhoinv + real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys), DIMENSION(kts:kte+1) :: rhoz, & !rho on model interface + &khdz,kmdz + real(kind_phys):: rhs,gfluxm,gfluxp,dztop,maxdfh,mindfh,maxcf,maxKh,zw + real(kind_phys):: t,esat,qsl,onoff,kh,km,dzk,rhosfc + real(kind_phys):: ustdrag,ustdiff,qvflux + real(kind_phys):: th_new,portion_qc,portion_qi,condensate,qsat INTEGER :: k,kk !Activate nonlocal mixing from the mass-flux scheme for !number concentrations and aerosols (0.0 = no; 1.0 = yes) - REAL, PARAMETER :: nonloc = 1.0 + real(kind_phys), PARAMETER :: nonloc = 1.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -4716,19 +4542,6 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & IF (bl_mynn_cloudmix > 0 .AND. FLAG_QI) THEN k=kts - -! a(k)=0. -! b(k)=1.+dtz(k)*dfh(k+1) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt !should we have qcd for ice? -! -! DO k=kts+1,kte-1 -! a(k)= -dtz(k)*dfh(k) -! b(k)=1.+dtz(k)*(dfh(k)+dfh(k+1)) -! c(k)= -dtz(k)*dfh(k+1) -! d(k)=sqi(k) !+ qcd(k)*delt -! ENDDO - !rho-weighted: a(k)= -dtz(k)*khdz(k)*rhoinv(k) b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) @@ -4772,6 +4585,42 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & sqi2=sqi ENDIF +!============================================ +! MIX SNOW ( sqs ) +!============================================ +IF (bl_mynn_cloudmix > 0 .AND. FLAG_QS) THEN + + k=kts +!rho-weighted: + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k+1)+khdz(k))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqs(k) + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k)+khdz(k+1))*rhoinv(k) + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) + d(k)=sqs(k) + ENDDO + +!! prescribed value + a(kte)=0. + b(kte)=1. + c(kte)=0. + d(kte)=sqs(kte) + +! CALL tridiag(kte,a,b,c,d) + CALL tridiag2(kte,a,b,c,d,sqs2) +! CALL tridiag3(kte,a,b,c,d,sqs2) + +! DO k=kts,kte +! sqs2(k)=d(k-kts+1) +! ENDDO +ELSE + sqs2=sqs +ENDIF + !!============================================ !! cloud ice number concentration (qni) !!============================================ @@ -4937,6 +4786,48 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & qnifa2=qnifa ENDIF +!============================================ +! Black-carbon aerosols ( qnbca ). +!============================================ +IF (bl_mynn_cloudmix > 0 .AND. FLAG_QNBCA .AND. & + bl_mynn_mixscalars > 0) THEN + + k=kts + + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) - & + & 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc + d(k)=qnbca(k) - dtz(k)*rhoinv(k)*s_awqnbca(k+1)*nonloc + + DO k=kts+1,kte-1 + a(k)= -dtz(k)*khdz(k)*rhoinv(k) + 0.5*dtz(k)*rhoinv(k)*s_aw(k)*nonloc + b(k)=1.+dtz(k)*(khdz(k) + khdz(k+1))*rhoinv(k) + & + & 0.5*dtz(k)*rhoinv(k)*(s_aw(k)-s_aw(k+1))*nonloc + c(k)= -dtz(k)*khdz(k+1)*rhoinv(k) - 0.5*dtz(k)*rhoinv(k)*s_aw(k+1)*nonloc + d(k)=qnbca(k) + dtz(k)*rhoinv(k)*(s_awqnbca(k)-s_awqnbca(k+1))*nonloc + ENDDO + +! prescribed value + a(kte)=0. + b(kte)=1. + c(kte)=0. + d(kte)=qnbca(kte) + +! CALL tridiag(kte,a,b,c,d) +! CALL tridiag2(kte,a,b,c,d,x) + CALL tridiag3(kte,a,b,c,d,x) + + DO k=kts,kte + !qnbca2(k)=d(k-kts+1) + qnbca2(k)=x(k) + ENDDO + +ELSE + !If not mixing aerosols, set "updated" array equal to original array + qnbca2=qnbca +ENDIF + !============================================ ! Ozone - local mixing only !============================================ @@ -5061,6 +4952,19 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ENDDO ENDIF + !=================== + ! CLOUD SNOW TENDENCY + !=================== + IF (FLAG_QS) THEN + DO k=kts,kte + Dqs(k)=(sqs2(k)/(1.-sqs2(k)) - qs(k))/delt + ENDDO + ELSE + DO k=kts,kte + Dqs(k) = 0. + ENDDO + ENDIF + !=================== ! CLOUD ICE NUM CONC TENDENCY !=================== @@ -5085,9 +4989,9 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ENDIF !ensure non-negative moist species - CALL moisture_check(kte, delt, delp, exner, & - sqv2, sqc2, sqi2, thl, & - dqv, dqc, dqi, dth ) + CALL moisture_check(kte, delt, delp, exner, & + sqv2, sqc2, sqi2, sqs2, thl, & + dqv, dqc, dqi, dqs, dth ) !===================== ! OZONE TENDENCY CHECK @@ -5103,8 +5007,8 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & !=================== IF (FLAG_QI) THEN DO k=kts,kte - Dth(k)=(thl(k) + xlvcp/exner(k)*sqc2(k) & - & + xlscp/exner(k)*sqi2(k) & + Dth(k)=(thl(k) + xlvcp/exner(k)*sqc2(k) & + & + xlscp/exner(k)*(sqi2(k)+sqs(k)) & & - th(k))/delt !Use form from Tripoli and Cotton (1981) with their !suggested min temperature to improve accuracy: @@ -5144,6 +5048,19 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & ENDDO ENDIF + !======================== + ! BLACK-CARBON TENDENCIES + !======================== + IF (FLAG_QNBCA .AND. bl_mynn_mixscalars > 0) THEN + DO k=kts,kte + Dqnbca(k)=(qnbca2(k) - qnbca(k))/delt + ENDDO + ELSE + DO k=kts,kte + Dqnbca(k)=0. + ENDDO + ENDIF + !ensure non-negative moist species !note: if called down here, dth needs to be updated, but ! if called before the theta-tendency calculation, do not compute dth @@ -5189,9 +5106,9 @@ SUBROUTINE mynn_tendencies(kts,kte,i, & END SUBROUTINE mynn_tendencies ! ================================================================== - SUBROUTINE moisture_check(kte, delt, dp, exner, & - qv, qc, qi, th, & - dqv, dqc, dqi, dth ) + SUBROUTINE moisture_check(kte, delt, dp, exner, & + qv, qc, qi, qs, th, & + dqv, dqc, dqi, dqs, dth ) ! This subroutine was adopted from the CAM-UW ShCu scheme and ! adapted for use here. @@ -5207,33 +5124,36 @@ SUBROUTINE moisture_check(kte, delt, dp, exner, & ! applying corresponding input tendencies and corrective tendencies. implicit none - integer, intent(in) :: kte - real(kind=kind_phys), intent(in) :: delt - real, dimension(kte), intent(in) :: dp, exner - real, dimension(kte), intent(inout) :: qv, qc, qi, th - real, dimension(kte), intent(inout) :: dqv, dqc, dqi, dth + integer, intent(in) :: kte + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(kte), intent(in) :: dp, exner + real(kind_phys), dimension(kte), intent(inout) :: qv, qc, qi, qs, th + real(kind_phys), dimension(kte), intent(inout) :: dqv, dqc, dqi, dqs, dth integer k - real :: dqc2, dqi2, dqv2, sum, aa, dum - real, parameter :: qvmin = 1e-20, & - qcmin = 0.0, & - qimin = 0.0 + real(kind_phys):: dqc2, dqi2, dqs2, dqv2, sum, aa, dum + real(kind_phys), parameter :: qvmin = 1e-20, & + qcmin = 0.0, & + qimin = 0.0 do k = kte, 1, -1 ! From the top to the surface dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0) dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0) + dqs2 = max(0.0, qimin-qs(k)) !qs deficit (>=0) !fix tendencies dqc(k) = dqc(k) + dqc2/delt dqi(k) = dqi(k) + dqi2/delt - dqv(k) = dqv(k) - (dqc2+dqi2)/delt + dqs(k) = dqs(k) + dqs2/delt + dqv(k) = dqv(k) - (dqc2+dqi2+dqs2)/delt dth(k) = dth(k) + xlvcp/exner(k)*(dqc2/delt) + & - xlscp/exner(k)*(dqi2/delt) + xlscp/exner(k)*((dqi2+dqs2)/delt) !update species qc(k) = qc(k) + dqc2 qi(k) = qi(k) + dqi2 - qv(k) = qv(k) - dqc2 - dqi2 + qs(k) = qs(k) + dqs2 + qv(k) = qv(k) - dqc2 - dqi2 - dqs2 th(k) = th(k) + xlvcp/exner(k)*dqc2 + & - xlscp/exner(k)*dqi2 + xlscp/exner(k)*(dqi2+dqs2) !then fix qv dqv2 = max(0.0, qvmin-qv(k)) !qv deficit (>=0) @@ -5246,6 +5166,7 @@ SUBROUTINE moisture_check(kte, delt, dp, exner, & qv(k) = max(qv(k),qvmin) qc(k) = max(qc(k),qcmin) qi(k) = max(qi(k),qimin) + qs(k) = max(qs(k),qimin) end do ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally ! extracted from all the layers that has 'qv > 2*qvmin'. This fully @@ -5289,36 +5210,35 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & !------------------------------------------------------------------- INTEGER, INTENT(in) :: kts,kte,i - - REAL, DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd - REAL, DIMENSION(kts:kte), INTENT(INOUT) :: rho - REAL, INTENT(IN) :: flt - REAL(kind=kind_phys), INTENT(IN) :: delt,pblh + real(kind_phys), DIMENSION(kts:kte), INTENT(IN) :: dfh,dz,tcd,qcd + real(kind_phys), DIMENSION(kts:kte), INTENT(INOUT) :: rho + real(kind_phys), INTENT(IN) :: flt + real(kind_phys), INTENT(IN) :: delt,pblh INTEGER, INTENT(IN) :: nchem, kdvel, ndvel - REAL, DIMENSION( kts:kte+1), INTENT(IN) :: s_aw - REAL, DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 - REAL, DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem - REAL, DIMENSION( ndvel ), INTENT(IN) :: vd1 - REAL(kind=kind_phys), INTENT(IN) :: emis_ant_no,frp + real(kind_phys), DIMENSION( kts:kte+1), INTENT(IN) :: s_aw + real(kind_phys), DIMENSION( kts:kte, nchem ), INTENT(INOUT) :: chem1 + real(kind_phys), DIMENSION( kts:kte+1,nchem), INTENT(IN) :: s_awchem + real(kind_phys), DIMENSION( ndvel ), INTENT(IN) :: vd1 + real(kind_phys), INTENT(IN) :: emis_ant_no,frp LOGICAL, INTENT(IN) :: rrfs_sd,enh_mix,smoke_dbg !local vars - REAL, DIMENSION(kts:kte) :: dtz - REAL, DIMENSION(kts:kte) :: a,b,c,d,x - REAL :: rhs,dztop - REAL :: t,dzk - REAL :: hght - REAL :: khdz_old, khdz_back + real(kind_phys), DIMENSION(kts:kte) :: dtz + real(kind_phys), DIMENSION(kts:kte) :: a,b,c,d,x + real(kind_phys):: rhs,dztop + real(kind_phys):: t,dzk + real(kind_phys):: hght + real(kind_phys):: khdz_old, khdz_back INTEGER :: k,kk,kmaxfire ! JLS 12/21/21 INTEGER :: ic ! Chemical array loop index INTEGER, SAVE :: icall - REAL, DIMENSION(kts:kte) :: rhoinv - REAL, DIMENSION(kts:kte+1) :: rhoz,khdz - REAL, PARAMETER :: NO_threshold = 0.1 ! For anthropogenic sources - REAL, PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires - REAL, PARAMETER :: pblh_threshold = 250.0 + real(kind_phys), DIMENSION(kts:kte) :: rhoinv + real(kind_phys), DIMENSION(kts:kte+1) :: rhoz,khdz + real(kind_phys), PARAMETER :: NO_threshold = 10.0 ! For anthropogenic sources + real(kind_phys), PARAMETER :: frp_threshold = 10.0 ! RAR 02/11/22: I increased the frp threshold to enhance mixing over big fires + real(kind_phys), PARAMETER :: pblh_threshold = 100.0 dztop=.5*(dz(kte)+dz(kte-1)) @@ -5419,13 +5339,13 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& INTEGER , INTENT(in) :: kts,kte - REAL, DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh + real(kind_phys), DIMENSION(KtS:KtE), INTENT(in) :: dz,dfm,dfh - REAL, DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h + real(kind_phys), DIMENSION(KtS:KtE), INTENT(out) :: K_m, K_h INTEGER :: k - REAL :: dzk + real(kind_phys):: dzk K_m(kts)=0. K_h(kts)=0. @@ -5451,12 +5371,12 @@ SUBROUTINE tridiag(n,a,b,c,d) !------------------------------------------------------------------- INTEGER, INTENT(in):: n - REAL, DIMENSION(n), INTENT(in) :: a,b - REAL, DIMENSION(n), INTENT(inout) :: c,d + real(kind_phys), DIMENSION(n), INTENT(in) :: a,b + real(kind_phys), DIMENSION(n), INTENT(inout) :: c,d INTEGER :: i - REAL :: p - REAL, DIMENSION(n) :: q + real(kind_phys):: p + real(kind_phys), DIMENSION(n) :: q c(n)=0. q(1)=-c(1)/b(1) @@ -5486,10 +5406,10 @@ subroutine tridiag2(n,a,b,c,d,x) ! n - number of unknowns (levels) integer,intent(in) :: n - real, dimension(n),intent(in) :: a,b,c,d - real ,dimension(n),intent(out) :: x - real ,dimension(n) :: cp,dp - real :: m + real(kind_phys), dimension(n), intent(in) :: a,b,c,d + real(kind_phys), dimension(n), intent(out):: x + real(kind_phys), dimension(n) :: cp,dp + real(kind_phys):: m integer :: i ! initialize c-prime and d-prime @@ -5528,12 +5448,12 @@ subroutine tridiag3(kte,a,b,c,d,x) implicit none integer,intent(in) :: kte integer, parameter :: kts=1 - real, dimension(kte) :: a,b,c,d - real ,dimension(kte),intent(out) :: x + real(kind_phys), dimension(kte) :: a,b,c,d + real(kind_phys), dimension(kte), intent(out) :: x integer :: in ! integer kms,kme,kts,kte,in -! real a(kms:kme,3),c(kms:kme),x(kms:kme) +! real(kind_phys)a(kms:kme,3),c(kms:kme),x(kms:kme) do in=kte-1,kts,-1 d(in)=d(in)-c(in)*d(in+1)/b(in+1) @@ -5551,63 +5471,6 @@ subroutine tridiag3(kte,a,b,c,d,x) return end subroutine tridiag3 -! ================================================================== - -!>\ingroup gsd_mynn_edmf - SUBROUTINE mynn_bl_init_driver( & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN & !,RQNIBLTEN,RQNCBLTEN & - &,QKE, & - &EXCH_H & - !&,icloud_bl,qc_bl,cldfra_bl & - &,RESTART,ALLOWED_TO_READ,LEVEL & - &,IDS,IDE,JDS,JDE,KDS,KDE & - &,IMS,IME,JMS,JME,KMS,KME & - &,ITS,ITE,JTS,JTE,KTS,KTE) - - !--------------------------------------------------------------- - LOGICAL,INTENT(IN) :: ALLOWED_TO_READ,RESTART - INTEGER,INTENT(IN) :: LEVEL !,icloud_bl - - INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, & - & IMS,IME,JMS,JME,KMS,KME, & - & ITS,ITE,JTS,JTE,KTS,KTE - - - REAL,DIMENSION(IMS:IME,KMS:KME),INTENT(INOUT) :: & - &RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & - &RQCBLTEN,RQIBLTEN,& !RQNIBLTEN,RQNCBLTEN & - &QKE,EXCH_H - - INTEGER :: I,J,K,ITF,JTF,KTF - - JTF=MIN0(JTE,JDE-1) - KTF=MIN0(KTE,KDE-1) - ITF=MIN0(ITE,IDE-1) - - IF(.NOT.RESTART)THEN - DO K=KTS,KTF - DO I=ITS,ITF - RUBLTEN(i,k)=0. - RVBLTEN(i,k)=0. - RTHBLTEN(i,k)=0. - RQVBLTEN(i,k)=0. - if( p_qc >= param_first_scalar ) RQCBLTEN(i,k)=0. - if( p_qi >= param_first_scalar ) RQIBLTEN(i,k)=0. - !if( p_qnc >= param_first_scalar ) RQNCBLTEN(i,k)=0. - !if( p_qni >= param_first_scalar ) RQNIBLTEN(i,k)=0. - !QKE(i,k)=0. - EXCH_H(i,k)=0. -! if(icloud_bl > 0) qc_bl(i,k)=0. -! if(icloud_bl > 0) cldfra_bl(i,k)=0. - ENDDO - ENDDO - ENDIF - - mynn_level=level - - END SUBROUTINE mynn_bl_init_driver - ! ================================================================== !>\ingroup gsd_mynn_edmf !! This subroutine calculates hybrid diagnotic boundary-layer height (PBLH). @@ -5654,15 +5517,15 @@ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) # define kte HARDCODE_VERTICAL #endif - REAL(kind=kind_phys), INTENT(OUT) :: zi - REAL, INTENT(IN) :: landsea - REAL, DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D - REAL, DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D + real(kind_phys), INTENT(OUT) :: zi + real(kind_phys), INTENT(IN) :: landsea + real(kind_phys), DIMENSION(KTS:KTE), INTENT(IN) :: thetav1D, qke1D, dz1D + real(kind_phys), DIMENSION(KTS:KTE+1), INTENT(IN) :: zw1D !LOCAL VARS - REAL :: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv - REAL :: delt_thv !delta theta-v; dependent on land/sea point - REAL, PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). - REAL, PARAMETER :: sbl_damp = 400. !transition length for blending (m). + real(kind_phys):: PBLH_TKE,qtke,qtkem1,wt,maxqke,TKEeps,minthv + real(kind_phys):: delt_thv !delta theta-v; dependent on land/sea point + real(kind_phys), PARAMETER :: sbl_lim = 200. !upper limit of stable BL height (m). + real(kind_phys), PARAMETER :: sbl_damp = 400. !transition length for blending (m). INTEGER :: I,J,K,kthv,ktke,kzi !Initialize KPBL (kzi) @@ -5790,46 +5653,47 @@ END SUBROUTINE GET_PBLH !! !! This scheme remains under development, so consider it experimental code. !! - SUBROUTINE DMP_mf( & - & kts,kte,dt,zw,dz,p,rho, & - & momentum_opt, & - & tke_opt, & - & scalar_opt, & - & u,v,w,th,thl,thv,tk, & - & qt,qv,qc,qke, & - & qnc,qni,qnwfa,qnifa, & - & exner,vt,vq,sgm, & - & ust,flt,fltv,flq,flqv, & - & pblh,kpbl,DX,landsea,ts, & + SUBROUTINE DMP_mf( & + & kts,kte,dt,zw,dz,p,rho, & + & momentum_opt, & + & tke_opt, & + & scalar_opt, & + & u,v,w,th,thl,thv,tk, & + & qt,qv,qc,qke, & + & qnc,qni,qnwfa,qnifa,qnbca, & + & exner,vt,vq,sgm, & + & ust,flt,fltv,flq,flqv, & + & pblh,kpbl,dx,landsea,ts, & ! outputs - updraft properties - & edmf_a,edmf_w, & - & edmf_qt,edmf_thl, & - & edmf_ent,edmf_qc, & + & edmf_a,edmf_w, & + & edmf_qt,edmf_thl, & + & edmf_ent,edmf_qc, & ! outputs - variables needed for solver - & s_aw,s_awthl,s_awqt, & - & s_awqv,s_awqc, & - & s_awu,s_awv,s_awqke, & - & s_awqnc,s_awqni, & - & s_awqnwfa,s_awqnifa, & - & sub_thl,sub_sqv, & - & sub_u,sub_v, & - & det_thl,det_sqv,det_sqc, & - & det_u,det_v, & + & s_aw,s_awthl,s_awqt, & + & s_awqv,s_awqc, & + & s_awu,s_awv,s_awqke, & + & s_awqnc,s_awqni, & + & s_awqnwfa,s_awqnifa, & + & s_awqnbca, & + & sub_thl,sub_sqv, & + & sub_u,sub_v, & + & det_thl,det_sqv,det_sqc, & + & det_u,det_v, & ! chem/smoke - & nchem,chem1,s_awchem, & - & mix_chem, & + & nchem,chem1,s_awchem, & + & mix_chem, & ! in/outputs - subgrid scale clouds & qc_bl1d,cldfra_bl1d, & & qc_bl1D_old,cldfra_bl1D_old, & ! inputs - flags for moist arrays - & F_QC,F_QI, & - F_QNC,F_QNI, & - & F_QNWFA,F_QNIFA, & - & Psig_shcu, & + & F_QC,F_QI, & + & F_QNC,F_QNI, & + & F_QNWFA,F_QNIFA,F_QNBCA, & + & Psig_shcu, & ! output info - &nup2,ktop,maxmf,ztop, & - ! unputs for stochastic perturbations - &spp_pbl,rstoch_col) + & nup2,ktop,maxmf,ztop, & + ! inputs for stochastic perturbations + & spp_pbl,rstoch_col ) ! inputs: INTEGER, INTENT(IN) :: KTS,KTE,KPBL,momentum_opt,tke_opt,scalar_opt @@ -5840,140 +5704,134 @@ SUBROUTINE DMP_mf( & #endif ! Stochastic - INTEGER, INTENT(IN) :: spp_pbl - REAL, DIMENSION(KTS:KTE) :: rstoch_col + INTEGER, INTENT(IN) :: spp_pbl + real(kind_phys), DIMENSION(KTS:KTE) :: rstoch_col - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: U,V,W,TH,THL,TK,QT,QV,QC,& - exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW !height at full-sigma - REAL, INTENT(IN) :: FLT,FLTV,FLQ,FLQV,& - Psig_shcu,landsea,ts - REAL(kind=kind_phys), INTENT(IN) :: dx,dt,ust,pblh - LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA + real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: & + &U,V,W,TH,THL,TK,QT,QV,QC, & + &exner,dz,THV,P,rho,qke,qnc,qni,qnwfa,qnifa,qnbca + real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: zw !height at full-sigma + real(kind_phys), INTENT(IN) :: flt,fltv,flq,flqv,Psig_shcu, & + &landsea,ts,dx,dt,ust,pblh + LOGICAL, OPTIONAL :: F_QC,F_QI,F_QNC,F_QNI,F_QNWFA,F_QNIFA,F_QNBCA ! outputs - updraft properties - REAL,DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & - & edmf_qt,edmf_thl, edmf_ent,edmf_qc + real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a,edmf_w, & + & edmf_qt,edmf_thl,edmf_ent,edmf_qc !add one local edmf variable: - REAL,DIMENSION(KTS:KTE) :: edmf_th + real(kind_phys),DIMENSION(KTS:KTE) :: edmf_th ! output INTEGER, INTENT(OUT) :: nup2,ktop - REAL(kind=kind_phys), INTENT(OUT) :: maxmf - REAL, INTENT(OUT) :: ztop + real(kind_phys), INTENT(OUT) :: maxmf + real(kind_phys), INTENT(OUT) :: ztop ! outputs - variables needed for solver - REAL,DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi - s_awthl, & !sum ai*rho*wi*phii - s_awqt, & - s_awqv, & - s_awqc, & - s_awqnc, & - s_awqni, & - s_awqnwfa, & - s_awqnifa, & - s_awu, & - s_awv, & - s_awqke, s_aw2 - - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: qc_bl1d,cldfra_bl1d, & - qc_bl1d_old,cldfra_bl1d_old + real(kind_phys),DIMENSION(KTS:KTE+1) :: s_aw, & !sum ai*rho*wis_awphi + &s_awthl,s_awqt,s_awqv,s_awqc,s_awqnc,s_awqni, & + &s_awqnwfa,s_awqnifa,s_awqnbca,s_awu,s_awv, & + &s_awqke,s_aw2 + + real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: & + &qc_bl1d,cldfra_bl1d,qc_bl1d_old,cldfra_bl1d_old INTEGER, PARAMETER :: nup=10, debug_mf=0 !------------- local variables ------------------- ! updraft properties defined on interfaces (k=1 is the top of the ! first model layer - REAL,DIMENSION(KTS:KTE+1,1:NUP) :: UPW,UPTHL,UPQT,UPQC,UPQV, & - UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & - UPQNI,UPQNWFA,UPQNIFA + real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP) :: & + &UPW,UPTHL,UPQT,UPQC,UPQV, & + &UPA,UPU,UPV,UPTHV,UPQKE,UPQNC, & + &UPQNI,UPQNWFA,UPQNIFA,UPQNBCA ! entrainment variables - REAL,DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf - INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi + real(kind_phys),DIMENSION(KTS:KTE,1:NUP) :: ENT,ENTf + INTEGER,DIMENSION(KTS:KTE,1:NUP) :: ENTi ! internal variables INTEGER :: K,I,k50 - REAL :: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & - pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn,QNWFAn,QNIFAn, & - Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,qtk,rho_int + real(kind_phys):: fltv2,wstar,qstar,thstar,sigmaW,sigmaQT, & + &sigmaTH,z0,pwmin,pwmax,wmin,wmax,wlv,Psig_w,maxw,maxqc,wpbl + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,QNCn,QNIn, & + QNWFAn,QNIFAn,QNBCAn, & + Wn2,Wn,EntEXP,EntEXM,EntW,BCOEFF,THVkm1,THVk,Pk,rho_int ! w parameters - REAL,PARAMETER :: & - &Wa=2./3., & - &Wb=0.002, & + real(kind_phys), PARAMETER :: & + &Wa=2./3., & + &Wb=0.002, & &Wc=1.5 ! Lateral entrainment parameters ( L0=100 and ENT0=0.1) were taken from ! Suselj et al (2013, jas). Note that Suselj et al (2014,waf) use L0=200 and ENT0=0.2. - REAL,PARAMETER :: & + real(kind_phys),PARAMETER :: & & L0=100., & & ENT0=0.1 ! Implement ideas from Neggers (2016, JAMES): - REAL, PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts - REAL, PARAMETER :: lmax = 1000.! diameter of largest plume - REAL, PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand - REAL, PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) - REAL :: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). + real(kind_phys), PARAMETER :: Atot = 0.10 ! Maximum total fractional area of all updrafts + real(kind_phys), PARAMETER :: lmax = 1000.! diameter of largest plume + real(kind_phys), PARAMETER :: dl = 100. ! diff size of each plume - the differential multiplied by the integrand + real(kind_phys), PARAMETER :: dcut = 1.2 ! max diameter of plume to parameterize relative to dx (km) + real(kind_phys):: d != -2.3 to -1.7 ;=-1.9 in Neggers paper; power law exponent for number density (N=Cl^d). ! Note that changing d to -2.0 makes each size plume equally contribute to the total coverage of all plumes. ! Note that changing d to -1.7 doubles the area coverage of the largest plumes relative to the smallest plumes. - REAL :: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx + real(kind_phys):: cn,c,l,n,an2,hux,maxwidth,wspd_pbl,cloud_base,width_flx ! chem/smoke INTEGER, INTENT(IN) :: nchem - REAL,DIMENSION(:, :) :: chem1 - REAL,DIMENSION(kts:kte+1, nchem) :: s_awchem - REAL,DIMENSION(nchem) :: chemn - REAL,DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM + real(kind_phys),DIMENSION(:, :) :: chem1 + real(kind_phys),DIMENSION(kts:kte+1, nchem) :: s_awchem + real(kind_phys),DIMENSION(nchem) :: chemn + real(kind_phys),DIMENSION(KTS:KTE+1,1:NUP, nchem) :: UPCHEM INTEGER :: ic - REAL,DIMENSION(KTS:KTE+1, nchem) :: edmf_chem + real(kind_phys),DIMENSION(KTS:KTE+1, nchem) :: edmf_chem LOGICAL, INTENT(IN) :: mix_chem !JOE: add declaration of ERF - REAL :: ERF + real(kind_phys):: ERF LOGICAL :: superadiabatic ! VARIABLES FOR CHABOUREAU-BECHTOLD CLOUD FRACTION - REAL,DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm - REAL :: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& - Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & + real(kind_phys),DIMENSION(KTS:KTE), INTENT(INOUT) :: vt, vq, sgm + real(kind_phys):: sigq,xl,rsl,cpm,a,qmq,mf_cf,Aup,Q1,diffqt,qsat_tk,& + Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid, & Ac_mf,Ac_strat,qc_mf - REAL, PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value + real(kind_phys), PARAMETER :: cf_thresh = 0.5 ! only overwrite stratus CF less than this value ! Variables for plume interpolation/saturation check - REAL,DIMENSION(KTS:KTE) :: exneri,dzi - REAL :: THp, QTp, QCp, QCs, esat, qsl - REAL :: csigma,acfac,ac_wsp,ac_cld + real(kind_phys),DIMENSION(KTS:KTE) :: exneri,dzi + real(kind_phys):: THp, QTp, QCp, QCs, esat, qsl + real(kind_phys):: csigma,acfac,ac_wsp,ac_cld !plume overshoot INTEGER :: overshoot - REAL :: bvf, Frz, dzp + real(kind_phys):: bvf, Frz, dzp !Flux limiter: not let mass-flux of heat between k=1&2 exceed (fluxportion)*(surface heat flux). !This limiter makes adjustments to the entire column. - REAL :: adjustment, flx1 - REAL, PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact + real(kind_phys):: adjustment, flx1 + real(kind_phys), PARAMETER :: fluxportion=0.75 ! set liberally, so has minimal impact. 0.5 starts to have a noticeable impact ! over land (decrease maxMF by 10-20%), but no impact over water. !Subsidence - REAL,DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence - det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment - envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & + real(kind_phys),DIMENSION(KTS:KTE) :: sub_thl,sub_sqv,sub_u,sub_v, & !tendencies due to subsidence + det_thl,det_sqv,det_sqc,det_u,det_v, & !tendencied due to detrainment + envm_a,envm_w,envm_thl,envm_sqv,envm_sqc, & envm_u,envm_v !environmental variables defined at middle of layer - REAL,DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface - REAL :: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & - detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs,& + real(kind_phys),DIMENSION(KTS:KTE+1) :: envi_a,envi_w !environmental variables defined at model interface + real(kind_phys):: temp,sublim,qc_ent,qv_ent,qt_ent,thl_ent,detrate, & + detrateUV,oow,exc_fac,aratio,detturb,qc_grid,qc_sgs, & qc_plume,exc_heat,exc_moist,tk_int - REAL, PARAMETER :: Cdet = 1./45. - REAL, PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers + real(kind_phys), PARAMETER :: Cdet = 1./45. + real(kind_phys), PARAMETER :: dzpmax = 300. !limit dz used in detrainment - can be excessing in thick layers !parameter "Csub" determines the propotion of upward vertical velocity that contributes to !environmenatal subsidence. Some portion is expected to be compensated by downdrafts instead of !gentle environmental subsidence. 1.0 assumes all upward vertical velocity in the mass-flux scheme !is compensated by "gentle" environmental subsidence. - REAL, PARAMETER :: Csub=0.25 + real(kind_phys), PARAMETER :: Csub=0.25 !Factor for the pressure gradient effects on momentum transport - REAL, PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere - REAL :: Uk,Ukm1,Vk,Vkm1,dxsa + real(kind_phys), PARAMETER :: pgfac = 0.00 ! Zhang and Wu showed 0.4 is more appropriate for lower troposphere + real(kind_phys):: Uk,Ukm1,Vk,Vkm1,dxsa ! check the inputs ! print *,'dt',dt @@ -6002,6 +5860,7 @@ SUBROUTINE DMP_mf( & UPQNI=0. UPQNWFA=0. UPQNIFA=0. + UPQNBCA=0. IF ( mix_chem ) THEN UPCHEM(KTS:KTE+1,1:NUP,1:nchem)=0.0 ENDIF @@ -6031,6 +5890,7 @@ SUBROUTINE DMP_mf( & s_awqni=0. s_awqnwfa=0. s_awqnifa=0. + s_awqnbca=0. IF ( mix_chem ) THEN s_awchem(kts:kte+1,1:nchem) = 0.0 ENDIF @@ -6224,7 +6084,7 @@ SUBROUTINE DMP_mf( & wlv=wmin+(wmax-wmin)/NUP2*(i-1) !SURFACE UPDRAFT VERTICAL VELOCITY - UPW(1,I)=wmin + REAL(i)/REAL(NUP)*(wmax-wmin) + UPW(1,I)=wmin + real(i)/real(NUP)*(wmax-wmin) !IF (UPW(1,I) > 0.5*ZW(2)/dt) UPW(1,I) = 0.5*ZW(2)/dt UPU(1,I)=(U(KTS)*DZ(KTS+1)+U(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) @@ -6258,6 +6118,7 @@ SUBROUTINE DMP_mf( & UPQNI(1,I)=(QNI(KTS)*DZ(KTS+1)+QNI(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNWFA(1,I)=(QNWFA(KTS)*DZ(KTS+1)+QNWFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) UPQNIFA(1,I)=(QNIFA(KTS)*DZ(KTS+1)+QNIFA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) + UPQNBCA(1,I)=(QNBCA(KTS)*DZ(KTS+1)+QNBCA(KTS+1)*DZ(KTS))/(DZ(KTS)+DZ(KTS+1)) ENDDO IF ( mix_chem ) THEN @@ -6330,6 +6191,7 @@ SUBROUTINE DMP_mf( & QNIn=UPQNI(k-1,I)*(1.-EntExp) + QNI(k)*EntExp QNWFAn=UPQNWFA(k-1,I)*(1.-EntExp) + QNWFA(k)*EntExp QNIFAn=UPQNIFA(k-1,I)*(1.-EntExp) + QNIFA(k)*EntExp + QNBCAn=UPQNBCA(k-1,I)*(1.-EntExp) + QNBCA(k)*EntExp !capture the updated qc, qt & thl modified by entranment alone, !since they will be modified later if condensation occurs. @@ -6426,13 +6288,10 @@ SUBROUTINE DMP_mf( & dzp = dz(k) ENDIF - !Limit very tall plumes - Wn=Wn*EXP(-MAX(ZW(k+1)-MIN(pblh+2000.,3500.),0.0)/1000.) - - !JOE- minimize the plume penetratration in stratocu-topped PBL - ! IF (fltv2 < 0.06) THEN - ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. - ! ENDIF + !minimize the plume penetratration in stratocu-topped PBL + !IF (fltv2 < 0.06) THEN + ! IF(ZW(k+1) >= pblh-200. .AND. qc(k) > 1e-5 .AND. I > 4) Wn=0. + !ENDIF !Modify environment variables (representative of the model layer - envm*) !following the updraft dynamical detrainment of Asai and Kasahara (1967, JAS). @@ -6470,6 +6329,7 @@ SUBROUTINE DMP_mf( & UPQNI(K,I)=QNIn UPQNWFA(K,I)=QNWFAn UPQNIFA(K,I)=QNIFAn + UPQNBCA(K,I)=QNBCAn UPA(K,I)=UPA(K-1,I) IF ( mix_chem ) THEN do ic = 1,nchem @@ -6527,11 +6387,11 @@ SUBROUTINE DMP_mf( & !to conform to grid mean properties, move qc to qv in grid mean !saturated layers, so total water fluxes are preserved but !negative qc fluxes in unsaturated layers is reduced. - IF (qc(k) > 1e-12 .OR. qc(k+1) > 1e-12) then +! if (qc(k) > 1e-12 .or. qc(k+1) > 1e-12) then qc_plume = UPQC(K,i) - ELSE - qc_plume = 0.0 - ENDIF +! else +! qc_plume = 0.0 +! endif s_awqc(k+1) = s_awqc(k+1) + rho_int*UPA(K,i)*UPW(K,i)*qc_plume*Psig_w IF (momentum_opt > 0) THEN s_awu(k+1) = s_awu(k+1) + rho_int*UPA(K,i)*UPW(K,i)*UPU(K,i)*Psig_w @@ -6567,6 +6427,7 @@ SUBROUTINE DMP_mf( & s_awqni(k+1)= s_awqni(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNI(K,i)*Psig_w s_awqnwfa(k+1)= s_awqnwfa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNWFA(K,i)*Psig_w s_awqnifa(k+1)= s_awqnifa(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNIFA(K,i)*Psig_w + s_awqnbca(k+1)= s_awqnbca(K+1) + rho_int*UPA(K,i)*UPW(K,i)*UPQNBCA(K,i)*Psig_w ENDDO ENDDO ENDIF @@ -6596,6 +6457,7 @@ SUBROUTINE DMP_mf( & s_awqni= s_awqni*adjustment s_awqnwfa= s_awqnwfa*adjustment s_awqnifa= s_awqnifa*adjustment + s_awqnbca= s_awqnbca*adjustment IF (momentum_opt > 0) THEN s_awu = s_awu*adjustment s_awv = s_awv*adjustment @@ -6642,9 +6504,9 @@ SUBROUTINE DMP_mf( & !smoke/chem IF ( mix_chem ) THEN - DO k=KTS,KTE-1 + DO k=kts,kte-1 IF(k > KTOP) exit - rho_int = (rho(k)*DZ(k+1)+rho(k+1)*DZ(k))/(DZ(k+1)+DZ(k)) + rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) DO I=1,NUP !NUP2 IF(I > NUP2) exit do ic = 1,nchem @@ -6661,14 +6523,14 @@ SUBROUTINE DMP_mf( & ENDIF !Calculate the effects environmental subsidence. - !All envi_*variables are valid at the interfaces, like the edmf_* variables + !All envi_*variables are valid at the interfaces, like the edmf_* variables IF (env_subs) THEN - DO k=KTS+1,KTE-1 + DO k=kts+1,kte-1 !First, smooth the profiles of w & a, since sharp vertical gradients !in plume variables are not likely extended to env variables !Note1: w is treated as negative further below !Note2: both w & a will be transformed into env variables further below - envi_w(k) = onethird*(edmf_w(K-1)+edmf_w(K)+edmf_w(K+1)) + envi_w(k) = onethird*(edmf_w(k-1)+edmf_w(k)+edmf_w(k+1)) envi_a(k) = onethird*(edmf_a(k-1)+edmf_a(k)+edmf_a(k+1))*adjustment ENDDO !define env variables at k=1 (top of first model layer) @@ -6689,22 +6551,26 @@ SUBROUTINE DMP_mf( & sublim = 1.0 ENDIF !Transform w & a into env variables - DO k=KTS,KTE + DO k=kts,kte temp=envi_a(k) envi_a(k)=1.0-temp envi_w(k)=csub*sublim*envi_w(k)*temp/(1.-temp) ENDDO !calculate tendencies from subsidence and detrainment valid at the middle of - !each model layer - dzi(kts) = 0.5*(DZ(kts)+DZ(kts+1)) - sub_thl(kts)=0.5*envi_w(kts)*envi_a(kts)*(thl(kts+1)-thl(kts))/dzi(kts) - sub_sqv(kts)=0.5*envi_w(kts)*envi_a(kts)*(qv(kts+1)-qv(kts))/dzi(kts) - DO k=KTS+1,KTE-1 - dzi(k) = 0.5*(DZ(k)+DZ(k+1)) - sub_thl(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (thl(k+1)-thl(k))/dzi(k) - sub_sqv(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (qv(k+1)-qv(k))/dzi(k) + !each model layer. The lowest model layer uses an assumes w=0 at the surface. + dzi(kts) = 0.5*(dz(kts)+dz(kts+1)) + rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) + sub_thl(kts)= 0.5*envi_w(kts)*envi_a(kts)* & + (rho(kts+1)*thl(kts+1)-rho(kts)*thl(kts))/dzi(kts)/rho_int + sub_sqv(kts)= 0.5*envi_w(kts)*envi_a(kts)* & + (rho(kts+1)*qv(kts+1)-rho(kts)*qv(kts))/dzi(kts)/rho_int + DO k=kts+1,kte-1 + dzi(k) = 0.5*(dz(k)+dz(k+1)) + rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) + sub_thl(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (rho(k+1)*thl(k+1)-rho(k)*thl(k))/dzi(k)/rho_int + sub_sqv(k)= 0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & + (rho(k+1)*qv(k+1)-rho(k)*qv(k))/dzi(k)/rho_int ENDDO DO k=KTS,KTE-1 @@ -6714,13 +6580,17 @@ SUBROUTINE DMP_mf( & ENDDO IF (momentum_opt > 0) THEN - sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)*(u(kts+1)-u(kts))/dzi(kts) - sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)*(v(kts+1)-v(kts))/dzi(kts) - DO k=KTS+1,KTE-1 + rho_int = (rho(kts)*dz(kts+1)+rho(kts+1)*dz(kts))/(dz(kts+1)+dz(kts)) + sub_u(kts)=0.5*envi_w(kts)*envi_a(kts)* & + (rho(kts+1)*u(kts+1)-rho(kts)*u(kts))/dzi(kts)/rho_int + sub_v(kts)=0.5*envi_w(kts)*envi_a(kts)* & + (rho(kts+1)*v(kts+1)-rho(kts)*v(kts))/dzi(kts)/rho_int + DO k=kts+1,kte-1 + rho_int = (rho(k)*dz(k+1)+rho(k+1)*dz(k))/(dz(k+1)+dz(k)) sub_u(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (u(k+1)-u(k))/dzi(k) + (rho(k+1)*u(k+1)-rho(k)*u(k))/dzi(k)/rho_int sub_v(k)=0.5*(envi_w(k)+envi_w(k-1))*0.5*(envi_a(k)+envi_a(k-1)) * & - (v(k+1)-v(k))/dzi(k) + (rho(k+1)*v(k+1)-rho(k)*v(k))/dzi(k)/rho_int ENDDO DO k=KTS,KTE-1 @@ -6741,10 +6611,10 @@ SUBROUTINE DMP_mf( & !JOE: ADD CLDFRA_bl1d, qc_bl1d. Note that they have already been defined in ! mym_condensation. Here, a shallow-cu component is added, but no cumulus -! clouds can be added at k=1 (start loop at k=2). - DO K=KTS+1,KTE-2 +! clouds can be added at k=1 (start loop at k=2). + do k=kts+1,kte-2 IF(k > KTOP) exit - IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0)THEN + IF(0.5*(edmf_qc(k)+edmf_qc(k-1))>0.0 .and. (cldfra_bl1d(k) < cf_thresh))THEN !interpolate plume quantities to mass levels Aup = (edmf_a(k)*dzi(k-1)+edmf_a(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) THp = (edmf_th(k)*dzi(k-1)+edmf_th(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) @@ -6757,11 +6627,11 @@ SUBROUTINE DMP_mf( & qsl=ep_2*esat/max(1.e-7,(p(k)-ep_3*esat)) !condensed liquid in the plume on mass levels - IF (edmf_qc(k)>0.0 .AND. edmf_qc(k-1)>0.0)THEN + if (edmf_qc(k)>0.0 .and. edmf_qc(k-1)>0.0) then QCp = (edmf_qc(k)*dzi(k-1)+edmf_qc(k-1)*dzi(k))/(dzi(k-1)+dzi(k)) - ELSE - QCp = MAX(edmf_qc(k),edmf_qc(k-1)) - ENDIF + else + QCp = max(edmf_qc(k),edmf_qc(k-1)) + endif !COMPUTE CLDFRA & QC_BL FROM MASS-FLUX SCHEME and recompute vt & vq xl = xl_blend(tk(k)) ! obtain blended heat capacity @@ -6794,10 +6664,11 @@ SUBROUTINE DMP_mf( & endif !CB form: - sigq = 3.5E-3 * Aup * 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) + !sigq = 3.5E-3 * Aup * 0.5*(edmf_w(k)+edmf_w(k-1)) * f ! convective component of sigma (CB2005) !sigq = SQRT(sigq**2 + sgm(k)**2) ! combined conv + stratus components !Per S.DeRoode 2009? - !sigq = 4. * Aup * (QTp - qt(k)) + !sigq = 5. * Aup * (QTp - qt(k)) + sigq = 10. * Aup * (QTp - qt(k)) !constrain sigq wrt saturation: sigq = max(sigq, qsat_tk*0.02 ) sigq = min(sigq, qsat_tk*0.25 ) @@ -6806,21 +6677,21 @@ SUBROUTINE DMP_mf( & Q1 = qmq/sigq ! the numerator of Q1 if ((landsea-1.5).GE.0) then ! WATER - mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.2)),0.01),0.6) + !modified form from LES + !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.2)),0.01),0.6) + !Original CB + mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) mf_cf = max(mf_cf, 1.2 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) else ! LAND - !mf_cf= min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.01),0.6) - mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) ! New WA fit + !LES form + !mf_cf = min(max(0.5 + 0.36 * atan(1.20*(Q1+0.4)),0.01),0.6) + !Original CB + mf_cf = min(max(0.5 + 0.36 * atan(1.55*Q1),0.01),0.6) mf_cf = max(mf_cf, 1.75 * Aup) + mf_cf = min(mf_cf, 5.0 * Aup) endif - ! WA TEST 4/15/22 use fit to Aup rather than CB - !IF (Aup > 0.1) THEN - ! mf_cf = 2.5 * Aup - !ELSE - ! mf_cf = 1.8 * Aup - !ENDIF - !IF ( debug_code ) THEN ! print*,"In MYNN, StEM edmf" ! print*," CB: env qt=",qt(k)," qsat=",qsat_tk @@ -6832,21 +6703,17 @@ SUBROUTINE DMP_mf( & ! Update cloud fractions and specific humidities in grid cells ! where the mass-flux scheme is active. The specific humidities ! are converted to grid means (not in-cloud quantities). - if ((landsea-1.5).GE.0) then ! water - !don't overwrite stratus CF & qc_bl - degrades marine stratus - if (cldfra_bl1d(k) < cf_thresh) then - if (QCp * Aup > 5e-5) then - qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 - else - qc_bl1d(k) = 1.18 * (QCp * Aup) - endif - if (mf_cf .ge. Aup) then - qc_bl1d(k) = qc_bl1d(k) / mf_cf - endif - cldfra_bl1d(k) = mf_cf - Ac_mf = mf_cf + if (QCp * Aup > 5e-5) then + qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 + else + qc_bl1d(k) = 1.18 * (QCp * Aup) endif + if (mf_cf .ge. Aup) then + qc_bl1d(k) = qc_bl1d(k) / mf_cf + endif + cldfra_bl1d(k) = mf_cf + Ac_mf = mf_cf else ! land if (QCp * Aup > 5e-5) then qc_bl1d(k) = 1.86 * (QCp * Aup) - 2.2e-5 @@ -6865,42 +6732,40 @@ SUBROUTINE DMP_mf( & !Use Bechtold and Siebesma (1998) piecewise estimation of Fng with !limits ,since they really should be recalculated after all the other changes...: !Only overwrite vt & vq in non-stratus condition - if (cldfra_bl1d(k) < cf_thresh) then - !if ((landsea-1.5).GE.0) then ! WATER - Q1=max(Q1,-2.25) - !else - ! Q1=max(Q1,-2.0) - !endif - - if (Q1 .ge. 1.0) then - Fng = 1.0 - elseif (Q1 .ge. -1.7 .and. Q1 .lt. 1.0) then - Fng = EXP(-0.4*(Q1-1.0)) - elseif (Q1 .ge. -2.5 .and. Q1 .lt. -1.7) then - Fng = 3.0 + EXP(-3.8*(Q1+1.7)) - else - Fng = min(23.9 + EXP(-1.6*(Q1+2.5)), 60.) - endif - - !link the buoyancy flux function to active clouds only (c*Aup): - vt(k) = qww - (1.5*Aup)*beta*bb*Fng - 1. - vq(k) = alpha + (1.5*Aup)*beta*a*Fng - tv0 + !if ((landsea-1.5).GE.0) then ! WATER + Q1=max(Q1,-2.25) + !else + ! Q1=max(Q1,-2.0) + !endif + + if (Q1 .ge. 1.0) then + Fng = 1.0 + elseif (Q1 .ge. -1.7 .and. Q1 .lt. 1.0) then + Fng = EXP(-0.4*(Q1-1.0)) + elseif (Q1 .ge. -2.5 .and. Q1 .lt. -1.7) then + Fng = 3.0 + EXP(-3.8*(Q1+1.7)) + else + Fng = min(23.9 + EXP(-1.6*(Q1+2.5)), 60.) endif - endif + + !link the buoyancy flux function to active clouds only (c*Aup): + vt(k) = qww - (1.5*Aup)*beta*bb*Fng - 1. + vq(k) = alpha + (1.5*Aup)*beta*a*Fng - tv0 + endif !check for (qc in plume) .and. (cldfra_bl < threshold) enddo !k-loop ENDIF !end nup2 > 0 !modify output (negative: dry plume, positive: moist plume) - IF (ktop > 0) THEN + if (ktop > 0) then maxqc = maxval(edmf_qc(1:ktop)) - IF ( maxqc < 1.E-8) maxmf = -1.0*maxmf - ENDIF + if ( maxqc < 1.E-8) maxmf = -1.0*maxmf + endif ! -! debugging +! debugging ! -IF (edmf_w(1) > 4.0) THEN +if (edmf_w(1) > 4.0) then ! surface values print *,'flq:',flq,' fltv:',fltv2 print *,'pblh:',pblh,' wstar:',wstar @@ -6953,12 +6818,12 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) ! ! zero or one condensation for edmf: calculates THV and QC ! -real,intent(in) :: QT,THL,P,zagl -real,intent(out) :: THV -real,intent(inout):: QC +real(kind_phys),intent(in) :: QT,THL,P,zagl +real(kind_phys),intent(out) :: THV +real(kind_phys),intent(inout):: QC integer :: niter,i -real :: diff,exn,t,th,qs,qcold +real(kind_phys):: diff,exn,t,th,qs,qcold ! constants used from module_model_constants.F ! p1000mb @@ -7000,7 +6865,7 @@ subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) !THIS BASICALLY GIVE THE SAME RESULT AS THE PREVIOUS LINE !TH = THL + xlv/cp/EXN*QC - !THV= TH*(1. + 0.608*QT) + !THV= TH*(1. + p608*QT) !print *,'t,p,qt,qs,qc' !print *,t,p,qt,qs,qc @@ -7015,11 +6880,11 @@ subroutine condensation_edmf_r(QT,THL,P,zagl,THV,QC) ! zero or one condensation for edmf: calculates THL and QC ! similar to condensation_edmf but with different inputs ! -real,intent(in) :: QT,THV,P,zagl -real,intent(out) :: THL, QC +real(kind_phys),intent(in) :: QT,THV,P,zagl +real(kind_phys),intent(out) :: THL, QC integer :: niter,i -real :: diff,exn,t,th,qs,qcold +real(kind_phys):: diff,exn,t,th,qs,qcold ! number of iterations niter=50 @@ -7065,58 +6930,58 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & &rthraten ) INTEGER, INTENT(IN) :: KTS,KTE,KPBL - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& + real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: U,V,TH,THL,TK,QT,QV,QC,& THV,P,rho,exner,dz - REAL(kind=kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: rthraten + real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: rthraten ! zw .. heights of the downdraft levels (edges of boxes) - REAL,DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW - REAL, INTENT(IN) :: WTHL,WQT - REAL(kind=kind_phys), INTENT(IN) :: dt,ust,pblh + real(kind_phys),DIMENSION(KTS:KTE+1), INTENT(IN) :: ZW + real(kind_phys), INTENT(IN) :: WTHL,WQT + real(kind_phys), INTENT(IN) :: dt,ust,pblh ! outputs - downdraft properties - REAL,DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & + real(kind_phys),DIMENSION(KTS:KTE), INTENT(OUT) :: edmf_a_dd,edmf_w_dd, & & edmf_qt_dd,edmf_thl_dd, edmf_ent_dd,edmf_qc_dd ! outputs - variables needed for solver (sd_aw - sum ai*wi, sd_awphi - sum ai*wi*phii) - REAL,DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & + real(kind_phys),DIMENSION(KTS:KTE+1) :: sd_aw, sd_awthl, sd_awqt, sd_awu, & sd_awv, sd_awqc, sd_awqv, sd_awqke, sd_aw2 - REAL,DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d + real(kind_phys),DIMENSION(KTS:KTE), INTENT(IN) :: qc_bl1d, cldfra_bl1d INTEGER, PARAMETER :: NDOWN=5, debug_mf=0 !fixing number of plumes to 5 ! draw downdraft starting height randomly between cloud base and cloud top INTEGER, DIMENSION(1:NDOWN) :: DD_initK - REAL , DIMENSION(1:NDOWN) :: randNum + real(kind_phys) , DIMENSION(1:NDOWN) :: randNum ! downdraft properties - REAL,DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& + real(kind_phys),DIMENSION(KTS:KTE+1,1:NDOWN) :: DOWNW,DOWNTHL,DOWNQT,& DOWNQC,DOWNA,DOWNU,DOWNV,DOWNTHV ! entrainment variables - REAl,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf + Real(Kind_phys),DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENT,ENTf INTEGER,DIMENSION(KTS+1:KTE+1,1:NDOWN) :: ENTi ! internal variables INTEGER :: K,I,ki, kminrad, qlTop, p700_ind, qlBase - REAL :: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & + real(kind_phys):: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & pwmin,pwmax,wmin,wmax,wlv,wtv,went,mindownw - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & + real(kind_phys):: B,QTn,THLn,THVn,QCn,Un,Vn,QKEn,Wn2,Wn,THVk,Pk, & EntEXP,EntW, Beta_dm, EntExp_M, rho_int - REAL :: jump_thetav, jump_qt, jump_thetal, & + real(kind_phys):: jump_thetav, jump_qt, jump_thetal, & refTHL, refTHV, refQT ! DD specific internal variables - REAL :: minrad,zminrad, radflux, F0, wst_rad, wst_dd + real(kind_phys):: minrad,zminrad, radflux, F0, wst_rad, wst_dd logical :: cloudflg - REAL :: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& + real(kind_phys):: sigq,xl,rsl,cpm,a,mf_cf,diffqt,& Fng,qww,alpha,beta,bb,f,pt,t,q2p,b9,satvp,rhgrid ! w parameters - REAL,PARAMETER :: & + real(kind_phys),PARAMETER :: & &Wa=1., & &Wb=1.5,& &Z00=100.,& &BCOEFF=0.2 ! entrainment parameters - REAL,PARAMETER :: & + real(kind_phys),PARAMETER :: & & L0=80,& & ENT0=0.2 @@ -7178,7 +7043,7 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & do i=1,NDOWN ! downdraft starts somewhere between cloud base to cloud top ! the probability is equally distributed - DD_initK(i) = qlTop ! nint(randNum(i)*REAL(qlTop-qlBase)) + qlBase + DD_initK(i) = qlTop ! nint(randNum(i)*real(qlTop-qlBase)) + qlBase enddo ! LOOP RADFLUX @@ -7248,13 +7113,13 @@ SUBROUTINE DDMF_JPL(kts,kte,dt,zw,dz,p, & do I=1,NDOWN !downdraft now starts at different height ki = DD_initK(I) - wlv=wmin+(wmax-wmin)/REAL(NDOWN)*(i-1) - wtv=wmin+(wmax-wmin)/REAL(NDOWN)*i + wlv=wmin+(wmax-wmin)/real(NDOWN)*(i-1) + wtv=wmin+(wmax-wmin)/real(NDOWN)*i !DOWNW(ki,I)=0.5*(wlv+wtv) DOWNW(ki,I)=wlv !DOWNA(ki,I)=0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW)) - DOWNA(ki,I)=.1/REAL(NDOWN) + DOWNA(ki,I)=.1/real(NDOWN) DOWNU(ki,I)=(u(ki-1)*DZ(ki) + u(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) DOWNV(ki,I)=(v(ki-1)*DZ(ki) + v(ki)*DZ(ki-1)) /(DZ(ki)+DZ(ki-1)) @@ -7424,9 +7289,9 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) ! Psig_bl tapers local mixing ! Psig_shcu tapers nonlocal mixing - REAL(kind=kind_phys), INTENT(IN) :: dx,pbl1 - REAL, INTENT(OUT) :: Psig_bl,Psig_shcu - REAL :: dxdh + real(kind_phys), INTENT(IN) :: dx,pbl1 + real(kind_phys), INTENT(OUT) :: Psig_bl,Psig_shcu + real(kind_phys) :: dxdh Psig_bl=1.0 Psig_shcu=1.0 @@ -7498,22 +7363,42 @@ FUNCTION esat_blend(t) IMPLICIT NONE - REAL, INTENT(IN):: t - REAL :: esat_blend,XC,ESL,ESI,chi - - XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common - -! For 253 < t < 273.16 K, the vapor pressures are "blended" as a function of temperature, -! using the approach of Chaboureau and Bechtold (2002), JAS, p. 2363. The resulting + real(kind_phys), INTENT(IN):: t + real(kind_phys):: esat_blend,XC,ESL,ESI,chi + !liquid + real(kind_phys), PARAMETER:: J0= .611583699E03 + real(kind_phys), PARAMETER:: J1= .444606896E02 + real(kind_phys), PARAMETER:: J2= .143177157E01 + real(kind_phys), PARAMETER:: J3= .264224321E-1 + real(kind_phys), PARAMETER:: J4= .299291081E-3 + real(kind_phys), PARAMETER:: J5= .203154182E-5 + real(kind_phys), PARAMETER:: J6= .702620698E-8 + real(kind_phys), PARAMETER:: J7= .379534310E-11 + real(kind_phys), PARAMETER:: J8=-.321582393E-13 + !ice + real(kind_phys), PARAMETER:: K0= .609868993E03 + real(kind_phys), PARAMETER:: K1= .499320233E02 + real(kind_phys), PARAMETER:: K2= .184672631E01 + real(kind_phys), PARAMETER:: K3= .402737184E-1 + real(kind_phys), PARAMETER:: K4= .565392987E-3 + real(kind_phys), PARAMETER:: K5= .521693933E-5 + real(kind_phys), PARAMETER:: K6= .307839583E-7 + real(kind_phys), PARAMETER:: K7= .105785160E-9 + real(kind_phys), PARAMETER:: K8= .161444444E-12 + + XC=MAX(-80.,t - t0c) !note t0c = 273.15, tice is set in module mynn_common to 240 + +! For 240 < t < 268.16 K, the vapor pressures are "blended" as a function of temperature, +! using the approach similar to Chaboureau and Bechtold (2002), JAS, p. 2363. The resulting ! values are returned from the function. - IF (t .GE. t0c) THEN + IF (t .GE. (t0c-6.)) THEN esat_blend = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) ELSE IF (t .LE. tice) THEN esat_blend = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) ELSE - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) - ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) - chi = (t0c - t)/(t0c - tice) + ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + chi = ((t0c-6.) - t)/((t0c-6.) - tice) esat_blend = (1.-chi)*ESL + chi*ESI END IF @@ -7523,39 +7408,54 @@ END FUNCTION esat_blend !>\ingroup gsd_mynn_edmf !! This function extends function "esat" and returns a "blended" -!! saturation mixing ratio. +!! saturation mixing ratio. Tice currently set to 240 K, t0c = 273.15 K. !!\author JAYMES - FUNCTION qsat_blend(t, P, waterice) + FUNCTION qsat_blend(t, P) IMPLICIT NONE - REAL, INTENT(IN):: t, P - CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: waterice - CHARACTER(LEN=1) :: wrt - REAL :: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi - - IF ( .NOT. PRESENT(waterice) ) THEN - wrt = 'b' - ELSE - wrt = waterice - ENDIF + real(kind_phys), INTENT(IN):: t, P + real(kind_phys):: qsat_blend,XC,ESL,ESI,RSLF,RSIF,chi + !liquid + real(kind_phys), PARAMETER:: J0= .611583699E03 + real(kind_phys), PARAMETER:: J1= .444606896E02 + real(kind_phys), PARAMETER:: J2= .143177157E01 + real(kind_phys), PARAMETER:: J3= .264224321E-1 + real(kind_phys), PARAMETER:: J4= .299291081E-3 + real(kind_phys), PARAMETER:: J5= .203154182E-5 + real(kind_phys), PARAMETER:: J6= .702620698E-8 + real(kind_phys), PARAMETER:: J7= .379534310E-11 + real(kind_phys), PARAMETER:: J8=-.321582393E-13 + !ice + real(kind_phys), PARAMETER:: K0= .609868993E03 + real(kind_phys), PARAMETER:: K1= .499320233E02 + real(kind_phys), PARAMETER:: K2= .184672631E01 + real(kind_phys), PARAMETER:: K3= .402737184E-1 + real(kind_phys), PARAMETER:: K4= .565392987E-3 + real(kind_phys), PARAMETER:: K5= .521693933E-5 + real(kind_phys), PARAMETER:: K6= .307839583E-7 + real(kind_phys), PARAMETER:: K7= .105785160E-9 + real(kind_phys), PARAMETER:: K8= .161444444E-12 XC=MAX(-80.,t - t0c) - IF ((t .GE. t0c) .OR. (wrt .EQ. 'w')) THEN - ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + IF (t .GE. (t0c-6.)) THEN + ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESL = min(ESL, P*0.15) ! Even with P=1050mb and T=55C, the sat. vap. pres only contributes to ~15% of total pres. qsat_blend = 0.622*ESL/max(P-ESL, 1e-5) -! ELSE IF (t .LE. 253.) THEN ELSE IF (t .LE. tice) THEN ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + ESI = min(ESI, P*0.15) qsat_blend = 0.622*ESI/max(P-ESI, 1e-5) ELSE ESL = J0+XC*(J1+XC*(J2+XC*(J3+XC*(J4+XC*(J5+XC*(J6+XC*(J7+XC*J8))))))) + ESL = min(ESL, P*0.15) ESI = K0+XC*(K1+XC*(K2+XC*(K3+XC*(K4+XC*(K5+XC*(K6+XC*(K7+XC*K8))))))) + ESI = min(ESI, P*0.15) RSLF = 0.622*ESL/max(P-ESL, 1e-5) RSIF = 0.622*ESI/max(P-ESI, 1e-5) -! chi = (273.16-t)/20.16 - chi = (t0c - t)/(t0c - tice) +! chi = (268.16-t)/(268.16-240.) + chi = ((t0c-6.) - t)/((t0c-6.) - tice) qsat_blend = (1.-chi)*RSLF + chi*RSIF END IF @@ -7572,8 +7472,8 @@ FUNCTION xl_blend(t) IMPLICIT NONE - REAL, INTENT(IN):: t - REAL :: xl_blend,xlvt,xlst,chi + real(kind_phys), INTENT(IN):: t + real(kind_phys):: xl_blend,xlvt,xlst,chi !note: t0c = 273.15, tice is set in mynn_common IF (t .GE. t0c) THEN @@ -7583,7 +7483,7 @@ FUNCTION xl_blend(t) ELSE xlvt = xlv + (cpv-cliq)*(t-t0c) !vaporization/condensation xlst = xls + (cpv-cice)*(t-t0c) !sublimation/deposition -! chi = (273.16-t)/20.16 +! chi = (273.16-t)/(273.16-240.) chi = (t0c - t)/(t0c - tice) xl_blend = (1.-chi)*xlvt + chi*xlst !blended END IF @@ -7601,12 +7501,12 @@ FUNCTION phim(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phi_m,phim + real(kind_phys), INTENT(IN):: zet + real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys):: phi_m,phim if ( zet >= 0.0 ) then dummy_0=1+zet**bm_st @@ -7653,12 +7553,12 @@ FUNCTION phih(zet) ! stable conditions [z/L ~ O(10)]. IMPLICIT NONE - REAL, INTENT(IN):: zet - REAL :: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi - REAL, PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st - REAL, PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st - REAL, PARAMETER :: am_unst=10., ah_unst=34. - REAL :: phh,phih + real(kind_phys), INTENT(IN):: zet + real(kind_phys):: dummy_0,dummy_1,dummy_11,dummy_2,dummy_22,dummy_3,dummy_33,dummy_4,dummy_44,dummy_psi + real(kind_phys), PARAMETER :: am_st=6.1, bm_st=2.5, rbm_st=1./bm_st + real(kind_phys), PARAMETER :: ah_st=5.3, bh_st=1.1, rbh_st=1./bh_st + real(kind_phys), PARAMETER :: am_unst=10., ah_unst=34. + real(kind_phys):: phh,phih if ( zet >= 0.0 ) then dummy_0=1+zet**bh_st @@ -7698,23 +7598,23 @@ SUBROUTINE topdown_cloudrad(kts,kte,dz1,zw,xland,kpbl,PBLH, & &maxKHtopdown,KHtopdown,TKEprodTD ) !input - integer, intent(in) :: kte,kts - real, dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& + integer, intent(in) :: kte,kts + real(kind_phys), dimension(kts:kte), intent(in) :: dz1,sqc,sqi,sqw,& thl,th1,ex1,p1,rho1,thetav,cldfra_bl1D - real(kind=kind_phys), dimension(kts:kte), intent(in) :: rthraten - real, dimension(kts:kte+1), intent(in) :: zw - real(kind=kind_phys), intent(in) :: pblh - real, intent(in) :: xland - integer,intent(in) :: kpbl + real(kind_phys), dimension(kts:kte), intent(in) :: rthraten + real(kind_phys), dimension(kts:kte+1), intent(in) :: zw + real(kind_phys), intent(in) :: pblh + real(kind_phys), intent(in) :: xland + integer , intent(in) :: kpbl !output - real, intent(out) :: maxKHtopdown - real, dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD + real(kind_phys), intent(out) :: maxKHtopdown + real(kind_phys), dimension(kts:kte), intent(out) :: KHtopdown,TKEprodTD !local - real, dimension(kts:kte) :: zfac,wscalek2,zfacent - real :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 - real :: temps,templ,zl1,wstar3_2 - real :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad - real, parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 + real(kind_phys), dimension(kts:kte) :: zfac,wscalek2,zfacent + real(kind_phys) :: bfx0,sflux,wm2,wm3,h1,h2,bfxpbl,dthvx,tmp1 + real(kind_phys) :: temps,templ,zl1,wstar3_2 + real(kind_phys) :: ent_eff,radsum,radflux,we,rcldb,rvls,minrad,zminrad + real(kind_phys), parameter :: pfac =2.0, zfmin = 0.01, phifac=8.0 integer :: k,kk,kminrad logical :: cloudflg diff --git a/physics/mynnedmf_wrapper.F90 b/physics/mynnedmf_wrapper.F90 index 8ac6378bd..74cf8fa30 100644 --- a/physics/mynnedmf_wrapper.F90 +++ b/physics/mynnedmf_wrapper.F90 @@ -2,7 +2,6 @@ !! This file contains all of the code related to running the MYNN !! eddy-diffusivity mass-flux scheme. -!>\ingroup gsd_mynn_edmf !> The following references best describe the code within !! Olson et al. (2019, NOAA Technical Memorandum) !! Nakanishi and Niino (2009) \cite NAKANISHI_2009 @@ -18,33 +17,32 @@ subroutine mynnedmf_wrapper_init ( & & con_cpv, con_cliq, con_cice, con_rcp, & & con_XLV, con_XLF, con_p608, con_ep2, & & con_karman, con_t0c, & - & do_mynnedmf, lheatstrg, & + & do_mynnedmf, & & errmsg, errflg ) use machine, only : kind_phys use bl_mynn_common implicit none - - logical, intent(in) :: do_mynnedmf - logical, intent(in) :: lheatstrg - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - real(kind=kind_phys),intent(in) :: con_xlv - real(kind=kind_phys),intent(in) :: con_xlf - real(kind=kind_phys),intent(in) :: con_rv - real(kind=kind_phys),intent(in) :: con_rd - real(kind=kind_phys),intent(in) :: con_ep2 - real(kind=kind_phys),intent(in) :: con_grav - real(kind=kind_phys),intent(in) :: con_cp - real(kind=kind_phys),intent(in) :: con_cpv - real(kind=kind_phys),intent(in) :: con_rcp - real(kind=kind_phys),intent(in) :: con_p608 - real(kind=kind_phys),intent(in) :: con_cliq - real(kind=kind_phys),intent(in) :: con_cice - real(kind=kind_phys),intent(in) :: con_karman - real(kind=kind_phys),intent(in) :: con_t0c + + logical, intent(in) :: do_mynnedmf + character(len=*),intent(out):: errmsg + integer, intent(out) :: errflg + + real(kind_phys),intent(in) :: con_xlv + real(kind_phys),intent(in) :: con_xlf + real(kind_phys),intent(in) :: con_rv + real(kind_phys),intent(in) :: con_rd + real(kind_phys),intent(in) :: con_ep2 + real(kind_phys),intent(in) :: con_grav + real(kind_phys),intent(in) :: con_cp + real(kind_phys),intent(in) :: con_cpv + real(kind_phys),intent(in) :: con_rcp + real(kind_phys),intent(in) :: con_p608 + real(kind_phys),intent(in) :: con_cliq + real(kind_phys),intent(in) :: con_cice + real(kind_phys),intent(in) :: con_karman + real(kind_phys),intent(in) :: con_t0c ! Initialize CCPP error handling variables errmsg = '' @@ -85,10 +83,8 @@ subroutine mynnedmf_wrapper_init ( & end subroutine mynnedmf_wrapper_init - subroutine mynnedmf_wrapper_finalize () - end subroutine mynnedmf_wrapper_finalize - -! \brief This scheme (1) performs pre-mynnedmf work, (2) runs the mynnedmf, and (3) performs post-mynnedmf work +!>\defgroup gp_mynnedmf MYNN-EDMF PBL and Shallow Convection Module +!> This scheme (1) performs pre-mynnedmf work, (2) runs the mynnedmf, and (3) performs post-mynnedmf work !> \section arg_table_mynnedmf_wrapper_run Argument Table !! \htmlinclude mynnedmf_wrapper_run.html !! @@ -101,14 +97,15 @@ SUBROUTINE mynnedmf_wrapper_run( & & phii,u,v,omega,t3d, & & qgrs_water_vapor, & & qgrs_liquid_cloud, & - & qgrs_ice_cloud, & + & qgrs_ice, & + & qgrs_snow, & & qgrs_cloud_droplet_num_conc, & & qgrs_cloud_ice_num_conc, & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc, & & qgrs_cccn, & - & prsl,exner, & + & prsl,prsi,exner, & & slmsk,tsurf,qsfc,ps, & & ust,ch,hflx,qflx,wspd,rb, & & dtsfc1,dqsfc1, & @@ -137,16 +134,18 @@ SUBROUTINE mynnedmf_wrapper_run( & & nupdraft,maxMF,ktop_plume, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & ! <=== ntqv, ntcw - & dqdt_ice_cloud, dqdt_ozone, & ! <=== ntiw, ntoz + & dqdt_ice, dqdt_snow, & ! <=== ntiw, ntsw + & dqdt_ozone, & ! <=== ntoz & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc,& ! <=== ntwa, ntia & dqdt_cccn, & ! <=== ntccn & flag_for_pbl_generic_tend, & & dtend, dtidx, index_of_temperature, & & index_of_x_wind, index_of_y_wind, ntke, & - & ntqv, ntcw, ntiw, ntoz, ntlnc, ntinc, ntwa, ntia, & + & ntqv, ntcw, ntiw, ntsw, & + & ntoz, ntlnc, ntinc, ntwa, ntia, & & index_of_process_pbl, htrsw, htrlw, xmu, & - & bl_mynn_tkebudget, bl_mynn_tkeadvect, & + & tke_budget, bl_mynn_tkeadvect, & & bl_mynn_cloudpdf, bl_mynn_mixlength, & & bl_mynn_edmf, & & bl_mynn_edmf_mom, bl_mynn_edmf_tke, & @@ -155,10 +154,12 @@ SUBROUTINE mynnedmf_wrapper_run( & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & & imp_physics_thompson, imp_physics_wsm6, & - & rrfs_sd, chem3d, frp, mix_chem, enh_mix, & + & imp_physics_fa, & + & chem3d, frp, mix_chem, rrfs_sd, enh_mix, & & nchem, ndvel, vdep, smoke_dbg, & & imp_physics_nssl, nssl_ccn_on, & - & ltaerosol, spp_wts_pbl, spp_pbl, lprnt, huge, errmsg, errflg ) + & ltaerosol, mraerosol, spp_wts_pbl, spp_pbl, & + & lprnt, huge, errmsg, errflg ) ! should be moved to inside the mynn: use machine, only: kind_phys @@ -170,7 +171,7 @@ SUBROUTINE mynnedmf_wrapper_run( & implicit none !------------------------------------------------------------------- - real(kind=kind_phys) :: huge + real(kind_phys) :: huge character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -185,8 +186,8 @@ SUBROUTINE mynnedmf_wrapper_run( & ! NAMELIST OPTIONS (INPUT): logical, intent(in) :: & & bl_mynn_tkeadvect, & - & bl_mynn_tkebudget, & & ltaerosol, & + & mraerosol, & & lprnt, & & do_mynnsfclay, & & flag_for_pbl_generic_tend, & @@ -203,100 +204,100 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_output, & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl, & - & imp_physics_nssl, & - & spp_pbl - real(kind=kind_phys), intent(in) :: & + & imp_physics_nssl, imp_physics_fa, & + & spp_pbl, & + & tke_budget + real(kind_phys), intent(in) :: & & bl_mynn_closure !TENDENCY DIAGNOSTICS - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + real(kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind integer, intent(in) :: index_of_y_wind, index_of_process_pbl - integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntlnc + integer, intent(in) :: ntoz, ntqv, ntcw, ntiw, ntsw, ntlnc integer, intent(in) :: ntinc, ntwa, ntia, ntke !MISC CONFIGURATION OPTIONS - INTEGER, PARAMETER :: & + INTEGER, PARAMETER :: & & bl_mynn_mixscalars=1 - LOGICAL :: & - & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QNC, & - & FLAG_QNWFA, FLAG_QNIFA, FLAG_OZONE + LOGICAL :: & + & FLAG_QI, FLAG_QNI, FLAG_QC, FLAG_QS, FLAG_QNC, & + & FLAG_QNWFA, FLAG_QNIFA, FLAG_QNBCA, FLAG_OZONE ! Define locally until needed from CCPP LOGICAL, PARAMETER :: cycling = .false. - INTEGER, PARAMETER :: param_first_scalar = 1 - INTEGER :: & - & p_qc, p_qr, p_qi, p_qs, p_qg, p_qnc, p_qni !MYNN-1D - REAL(kind=kind_phys), intent(in) :: delt, dtf + REAL(kind_phys), intent(in) :: delt, dtf INTEGER, intent(in) :: im, levs LOGICAL, intent(in) :: flag_init, flag_restart INTEGER :: initflag, k, i - INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & - & IMS,IME,JMS,JME,KMS,KME, & + INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & + & IMS,IME,JMS,JME,KMS,KME, & & ITS,ITE,JTS,JTE,KTS,KTE - REAL(kind=kind_phys) :: tem + REAL(kind_phys) :: tem !MYNN-3D - real(kind=kind_phys), dimension(:,:), intent(in) :: phii - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(in) :: phii + real(kind_phys), dimension(:,:), intent(inout) :: & & dtdt, dudt, dvdt, & - & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice_cloud, & + & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice, & + & dqdt_snow, & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc - real(kind=kind_phys), dimension(:,:), intent(inout) ::dqdt_cccn - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) ::dqdt_cccn + real(kind_phys), dimension(:,:), intent(inout) :: & & qke, qke_adv, EL_PBL, Sh3D, Sm3D, & & qc_bl, qi_bl, cldfra_bl !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & & dqke,qWT,qSHEAR,qBUOY,qDISS - real(kind=kind_phys), dimension(:,:), intent(inout) :: & - & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice_cloud - real(kind=kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & + & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice, & + & qgrs_snow + real(kind_phys), dimension(:,:), intent(in) :: & & u,v,omega, & - & exner,prsl, & + & exner,prsl,prsi, & & qgrs_cloud_droplet_num_conc, & & qgrs_cloud_ice_num_conc, & & qgrs_ozone, & & qgrs_water_aer_num_conc, & & qgrs_ice_aer_num_conc - real(kind=kind_phys), dimension(:,:), intent(in) ::qgrs_cccn - real(kind=kind_phys), dimension(:,:), intent(out) :: & + real(kind_phys), dimension(:,:), intent(in) ::qgrs_cccn + real(kind_phys), dimension(:,:), intent(out) :: & & Tsq, Qsq, Cov, exch_h, exch_m - real(kind=kind_phys), dimension(:), intent(in) :: xmu - real(kind=kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw + real(kind_phys), dimension(:), intent(in) :: xmu + real(kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw ! spp_wts_pbl only allocated if spp_pbl == 1 - real(kind=kind_phys), dimension(:,:), intent(in) :: spp_wts_pbl + real(kind_phys), dimension(:,:), intent(in) :: spp_wts_pbl !LOCAL - real(kind=kind_phys), dimension(im,levs) :: & - & sqv,sqc,sqi,qnc,qni,ozone,qnwfa,qnifa, & + real(kind_phys), dimension(im,levs) :: & + & sqv,sqc,sqi,sqs,qnc,qni,ozone,qnwfa,qnifa,qnbca, & & dz, w, p, rho, th, qv, delp, & & RUBLTEN, RVBLTEN, RTHBLTEN, RQVBLTEN, & - & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, & - & RQNWFABLTEN, RQNIFABLTEN - real(kind=kind_phys), allocatable :: old_ozone(:,:) + & RQCBLTEN, RQNCBLTEN, RQIBLTEN, RQNIBLTEN, RQSBLTEN, & + & RQNWFABLTEN, RQNIFABLTEN, RQNBCABLTEN + real(kind_phys), allocatable :: old_ozone(:,:) !smoke/chem arrays - real(kind=kind_phys), dimension(:), intent(inout) :: frp + real(kind_phys), dimension(:), intent(inout) :: frp logical, intent(in) :: mix_chem, enh_mix, rrfs_sd - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind=kind_phys), dimension(:,: ), intent(inout) :: vdep - real(kind=kind_phys), dimension(im) :: emis_ant_no + real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d + real(kind_phys), dimension(:,: ), intent(inout) :: vdep + real(kind_phys), dimension(im) :: emis_ant_no !MYNN-2D - real(kind=kind_phys), dimension(:), intent(in) :: & + real(kind_phys), dimension(:), intent(in) :: & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol - real(kind=kind_phys), dimension(:), intent(in) :: & + real(kind_phys), dimension(:), intent(in) :: & & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & & stress_wat,hflx_wat,qflx_wat, & & oceanfrac,fice @@ -304,26 +305,26 @@ SUBROUTINE mynnedmf_wrapper_run( & logical, dimension(:), intent(in) :: & & wet, dry, icy - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout) :: & & pblh,dusfc_diag,dvsfc_diag,dtsfc_diag,dqsfc_diag - real(kind=kind_phys), dimension(:), intent(out) :: & + real(kind_phys), dimension(:), intent(out) :: & & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & & maxMF integer, dimension(:), intent(inout) :: & & kpbl,nupdraft,ktop_plume - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout) :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind=kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout) :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL - real, dimension(im) :: & - & hfx,qfx,rmol,xland,uoce,voce,vdfg,znt,ts + real(kind_phys), dimension(im) :: & + & hfx,qfx,rmol,xland,uoce,voce,znt,ts integer :: idtend - real, dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 - real(kind=kind_phys), allocatable :: save_qke_adv(:,:) + real(kind_phys), dimension(im) :: dusfci1,dvsfci1,dtsfci1,dqsfci1 + real(kind_phys), allocatable :: save_qke_adv(:,:) ! Initialize CCPP error handling variables errmsg = '' @@ -356,62 +357,33 @@ SUBROUTINE mynnedmf_wrapper_run( & !initialize arrays for test EMIS_ANT_NO = 0. - - ! Check incoming moist species to ensure non-negative values - ! First, create height (dz) and pressure differences (delp) - ! across model layers - do k=1,levs - do i=1,im - dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv - enddo - enddo - - do i=1,im - delp(i,1) = ps(i) - (prsl(i,2)*dz(i,1) + prsl(i,1)*dz(i,2))/(dz(i,1)+dz(i,2)) - do k=2,levs-1 - delp(i,k) = (prsl(i,k)*dz(i,k-1) + prsl(i,k-1)*dz(i,k))/(dz(i,k)+dz(i,k-1)) - & - (prsl(i,k+1)*dz(i,k) + prsl(i,k)*dz(i,k+1))/(dz(i,k)+dz(i,k+1)) - enddo - delp(i,levs) = delp(i,levs-1) - enddo - - do i=1,im - call moisture_check2(levs, delt, & - delp(i,:), exner(i,:), & - qgrs_water_vapor(i,:), & - qgrs_liquid_cloud(i,:),& - qgrs_ice_cloud(i,:), & - t3d(i,:) ) - enddo + vdep = 0. FLAG_OZONE = ntoz>0 ! Assign variables for each microphysics scheme - if (imp_physics == imp_physics_wsm6) then - ! WSM6 + if (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fa) then + ! WSM6 or Ferrier-Aligo FLAG_QI = .true. FLAG_QNI= .false. FLAG_QC = .true. FLAG_QNC= .false. + FLAG_QS = .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) + sqs(i,k) = 0. ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + qnbca(i,k) = 0. enddo enddo elseif (imp_physics == imp_physics_nssl ) then @@ -420,21 +392,16 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .true. FLAG_QC = .true. FLAG_QNC= .true. + FLAG_QS = .false. FLAG_QNWFA= nssl_ccn_on ! ERM: Perhaps could use this field for CCN field? FLAG_QNIFA= .false. - ! p_q vars not used? - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) + sqs(i,k) = 0. ozone(i,k) = qgrs_ozone(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) @@ -443,6 +410,7 @@ SUBROUTINE mynnedmf_wrapper_run( & qnwfa(i,k) = qgrs_cccn(i,k) ENDIF qnifa(i,k) = 0. + qnbca(i,k) = 0. enddo enddo elseif (imp_physics == imp_physics_thompson) then @@ -451,52 +419,69 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. + FLAG_QS = .true. FLAG_QNC= .true. FLAG_QNWFA= .true. FLAG_QNIFA= .true. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) qnwfa(i,k) = qgrs_water_aer_num_conc(i,k) qnifa(i,k) = qgrs_ice_aer_num_conc(i,k) + qnbca(i,k) = 0. + enddo + enddo + else if(mraerosol) then + FLAG_QI = .true. + FLAG_QNI= .true. + FLAG_QC = .true. + FLAG_QS = .true. + FLAG_QNC= .true. + FLAG_QNWFA= .false. + FLAG_QNIFA= .false. + FLAG_QNBCA= .false. + do k=1,levs + do i=1,im + sqv(i,k) = qgrs_water_vapor(i,k) + sqc(i,k) = qgrs_liquid_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) + sqs(i,k) = qgrs_snow(i,k) + qnc(i,k) = qgrs_cloud_droplet_num_conc(i,k) + qni(i,k) = qgrs_cloud_ice_num_conc(i,k) + ozone(i,k) = qgrs_ozone(i,k) + qnwfa(i,k) = 0. + qnifa(i,k) = 0. + qnbca(i,k) = 0. enddo enddo else FLAG_QI = .true. FLAG_QNI= .true. FLAG_QC = .true. + FLAG_QS = .true. FLAG_QNC= .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) + sqs(i,k) = qgrs_snow(i,k) qnc(i,k) = 0. qni(i,k) = qgrs_cloud_ice_num_conc(i,k) ozone(i,k) = qgrs_ozone(i,k) qnwfa(i,k) = 0. qnifa(i,k) = 0. + qnbca(i,k) = 0. enddo enddo endif @@ -506,24 +491,21 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .false. FLAG_QC = .true. FLAG_QNC= .false. + FLAG_QS = .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 2 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) - sqi(i,k) = qgrs_ice_cloud(i,k) + sqi(i,k) = qgrs_ice(i,k) qnc(i,k) = 0. qni(i,k) = 0. + sqs(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + qnbca(i,k) = 0. ozone(i,k) = qgrs_ozone(i,k) enddo enddo @@ -534,24 +516,21 @@ SUBROUTINE mynnedmf_wrapper_run( & FLAG_QNI= .false. FLAG_QC = .true. FLAG_QNC= .false. + FLAG_QS = .false. FLAG_QNWFA= .false. FLAG_QNIFA= .false. - p_qc = 2 - p_qr = 0 - p_qi = 0 - p_qs = 0 - p_qg = 0 - p_qnc= 0 - p_qni= 0 + FLAG_QNBCA= .false. do k=1,levs do i=1,im sqv(i,k) = qgrs_water_vapor(i,k) sqc(i,k) = qgrs_liquid_cloud(i,k) sqi(i,k) = 0. + sqs(i,k) = 0. qnc(i,k) = 0. qni(i,k) = 0. qnwfa(i,k) = 0. qnifa(i,k) = 0. + qnbca(i,k) = 0. ozone(i,k) = qgrs_ozone(i,k) enddo enddo @@ -560,17 +539,38 @@ SUBROUTINE mynnedmf_wrapper_run( & allocate(old_ozone(im,levs)) old_ozone = ozone endif - if (lprnt)write(0,*)"prepping MYNN-EDMF variables..." do k=1,levs do i=1,im - ! dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv th(i,k)=t3d(i,k)/exner(i,k) rho(i,k)=prsl(i,k)/(r_d*t3d(i,k)*(1.+p608*max(sqv(i,k),1e-8))) w(i,k) = -omega(i,k)/(rho(i,k)*grav) + enddo + enddo + + ! Check incoming moist species to ensure non-negative values + ! First, create height difference (dz) + do k=1,levs + do i=1,im + dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv enddo enddo + do i=1,im + do k=1,levs + delp(i,k) = prsi(i,k) - prsi(i,k+1) + enddo + enddo + + do i=1,im + call moisture_check2(levs, delt, & + delp(i,:), exner(i,:), & + sqv(i,:), sqc(i,:), & + sqi(i,:), sqs(i,:), & + t3d(i,:) ) + enddo + + !intialize more variables do i=1,im if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 xland(i)=1.0 !but land/water = (1/2) in SFCLAY_mynn @@ -579,7 +579,6 @@ SUBROUTINE mynnedmf_wrapper_run( & endif uoce(i)=0.0 voce(i)=0.0 - vdfg(i)=0.0 !ust(i) = sqrt(stress(i)) ch(i)=0.0 hfx(i)=hflx(i)*rho(i,1)*cp @@ -663,7 +662,7 @@ SUBROUTINE mynnedmf_wrapper_run( & if (lprnt) then print* write(0,*)"===CALLING mynn_bl_driver; input:" - print*,"bl_mynn_tkebudget=",bl_mynn_tkebudget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect + print*,"tke_budget=",tke_budget," bl_mynn_tkeadvect=",bl_mynn_tkeadvect print*,"bl_mynn_cloudpdf=",bl_mynn_cloudpdf," bl_mynn_mixlength=",bl_mynn_mixlength print*,"bl_mynn_edmf=",bl_mynn_edmf," bl_mynn_edmf_mom=",bl_mynn_edmf_mom print*,"bl_mynn_edmf_tke=",bl_mynn_edmf_tke @@ -689,7 +688,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"znt:",znt(1)," delt=",delt print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) - print*,"vdfg=",vdfg(1)," ch=",ch(1) + print*,"ch=",ch(1) !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) @@ -705,12 +704,12 @@ SUBROUTINE mynnedmf_wrapper_run( & & cycling=cycling, & & delt=delt,dz=dz,dx=dx,znt=znt, & & u=u,v=v,w=w,th=th,sqv3D=sqv,sqc3D=sqc, & - & sqi3D=sqi,qnc=qnc,qni=qni, & - & qnwfa=qnwfa,qnifa=qnifa,ozone=ozone, & + & sqi3D=sqi,sqs3D=sqs,qnc=qnc,qni=qni, & + & qnwfa=qnwfa,qnifa=qnifa,qnbca=qnbca,ozone=ozone, & & p=prsl,exner=exner,rho=rho,T3D=t3d, & & xland=xland,ts=ts,qsfc=qsfc,ps=ps, & & ust=ust,ch=ch,hfx=hfx,qfx=qfx,rmol=rmol, & - & wspd=wspd,uoce=uoce,voce=voce,vdfg=vdfg, & !input + & wspd=wspd,uoce=uoce,voce=voce, & !input & qke=QKE,qke_adv=qke_adv, & !output & sh3d=Sh3d,sm3d=Sm3d, & !chem/smoke @@ -724,15 +723,17 @@ SUBROUTINE mynnedmf_wrapper_run( & & RUBLTEN=RUBLTEN,RVBLTEN=RVBLTEN,RTHBLTEN=RTHBLTEN, & !output & RQVBLTEN=RQVBLTEN,RQCBLTEN=rqcblten, & & RQIBLTEN=rqiblten,RQNCBLTEN=rqncblten, & !output + & RQSBLTEN=rqsblten, & !output & RQNIBLTEN=rqniblten,RQNWFABLTEN=RQNWFABLTEN, & !output - & RQNIFABLTEN=RQNIFABLTEN,dozone=dqdt_ozone, & !output + & RQNIFABLTEN=RQNIFABLTEN,RQNBCABLTEN=RQNBCABLTEN, & !output + & dozone=dqdt_ozone, & !output & EXCH_H=exch_h,EXCH_M=exch_m, & !output & pblh=pblh,KPBL=KPBL, & !output & el_pbl=el_pbl, & !output & dqke=dqke, & !output & qWT=qWT,qSHEAR=qSHEAR,qBUOY=qBUOY,qDISS=qDISS, & !output & bl_mynn_tkeadvect=bl_mynn_tkeadvect, & - & bl_mynn_tkebudget=bl_mynn_tkebudget, & !input parameter + & tke_budget=tke_budget, & !input parameter & bl_mynn_cloudpdf=bl_mynn_cloudpdf, & !input parameter & bl_mynn_mixlength=bl_mynn_mixlength, & !input parameter & icloud_bl=icloud_bl, & !input parameter @@ -745,7 +746,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_cloudmix=bl_mynn_cloudmix, & !input parameter & bl_mynn_mixqt=bl_mynn_mixqt, & !input parameter & edmf_a=edmf_a,edmf_w=edmf_w,edmf_qt=edmf_qt, & !output - & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,&!output + & edmf_thl=edmf_thl,edmf_ent=edmf_ent,edmf_qc=edmf_qc,& !output & sub_thl3D=sub_thl,sub_sqv3D=sub_sqv, & & det_thl3D=det_thl,det_sqv3D=det_sqv, & & nupdraft=nupdraft,maxMF=maxMF, & !output @@ -753,12 +754,12 @@ SUBROUTINE mynnedmf_wrapper_run( & & spp_pbl=spp_pbl,pattern_spp_pbl=spp_wts_pbl, & !input & RTHRATEN=htrlw, & !input & FLAG_QI=flag_qi,FLAG_QNI=flag_qni, & !input - & FLAG_QC=flag_qc,FLAG_QNC=flag_qnc, & !input + & FLAG_QC=flag_qc,FLAG_QNC=flag_qnc,FLAG_QS=flag_qs, & !input & FLAG_QNWFA=FLAG_QNWFA,FLAG_QNIFA=FLAG_QNIFA, & !input - & FLAG_OZONE=FLAG_OZONE, & !input + & FLAG_QNBCA=FLAG_QNBCA,FLAG_OZONE=FLAG_OZONE, & !input & IDS=1,IDE=im,JDS=1,JDE=1,KDS=1,KDE=levs, & !input & IMS=1,IME=im,JMS=1,JME=1,KMS=1,KME=levs, & !input - & ITS=1,ITE=im,JTS=1,JTE=1,KTS=1,KTE=levs) !input + & ITS=1,ITE=im,JTS=1,JTE=1,KTS=1,KTE=levs ) !input ! POST MYNN (INTERSTITIAL) WORK: @@ -799,13 +800,14 @@ SUBROUTINE mynnedmf_wrapper_run( & !enddo !DO moist/scalar/tracer tendencies: - if (imp_physics == imp_physics_wsm6) then + if (imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fa) then ! WSM6 do k=1,levs do i=1,im dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -819,7 +821,7 @@ SUBROUTINE mynnedmf_wrapper_run( & ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt + ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt ! !dqdt_ozone(i,k) = 0.0 ! enddo !enddo @@ -831,8 +833,9 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 dqdt_water_aer_num_conc(i,k) = RQNWFABLTEN(i,k) dqdt_ice_aer_num_conc(i,k) = RQNIFABLTEN(i,k) @@ -851,7 +854,7 @@ SUBROUTINE mynnedmf_wrapper_run( & ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt + ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt ! qgrs_cloud_droplet_num_conc(i,k) = qgrs_cloud_droplet_num_conc(i,k) + RQNCBLTEN(i,k)*delt ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt ! !dqdt_ozone(i,k) = 0.0 @@ -859,14 +862,33 @@ SUBROUTINE mynnedmf_wrapper_run( & ! !qgrs_ice_aer_num_conc(i,k) = qgrs_ice_aer_num_conc(i,k) + RQNIFABLTEN(i,k)*delt ! enddo !enddo + else if(mraerosol) then + do k=1,levs + do i=1,im + dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) + enddo + enddo + if(ldiag3d .and. .not. flag_for_pbl_generic_tend) then + call dtend_helper(100+ntqv,RQVBLTEN) + call dtend_helper(100+ntcw,RQCBLTEN) + call dtend_helper(100+ntlnc,RQNCBLTEN) + call dtend_helper(100+ntiw,RQIBLTEN) + call dtend_helper(100+ntinc,RQNIBLTEN) + endif else !Thompson (2008) do k=1,levs do i=1,im dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_ozone(i,k) = 0.0 enddo enddo @@ -875,12 +897,13 @@ SUBROUTINE mynnedmf_wrapper_run( & call dtend_helper(100+ntcw,RQCBLTEN) call dtend_helper(100+ntiw,RQIBLTEN) call dtend_helper(100+ntinc,RQNIBLTEN) + call dtend_helper(100+ntsw,RQSBLTEN) endif !do k=1,levs ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt + ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt ! qgrs_cloud_ice_num_conc(i,k) = qgrs_cloud_ice_num_conc(i,k) + RQNIBLTEN(i,k)*delt ! !dqdt_ozone(i,k) = 0.0 ! enddo @@ -893,8 +916,9 @@ SUBROUTINE mynnedmf_wrapper_run( & dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_cloud_droplet_num_conc(i,k) = RQNCBLTEN(i,k) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_ice_num_conc(i,k) = RQNIBLTEN(i,k) + dqdt_snow(i,k) = RQSBLTEN(i,k) !/(1.0 + qv(i,k)) IF ( nssl_ccn_on ) THEN ! dqdt_cccn(i,k) = RQNWFABLTEN(i,k) ENDIF @@ -907,7 +931,7 @@ SUBROUTINE mynnedmf_wrapper_run( & do i=1,im dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) + dqdt_ice(i,k) = RQIBLTEN(i,k) !/(1.0 + qv(i,k)) !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 !dqdt_graupel(i,k) = 0.0 @@ -923,7 +947,7 @@ SUBROUTINE mynnedmf_wrapper_run( & ! do i=1,im ! qgrs_water_vapor(i,k) = qgrs_water_vapor(i,k) + (RQVBLTEN(i,k)/(1.0+RQVBLTEN(i,k)))*delt ! qgrs_liquid_cloud(i,k) = qgrs_liquid_cloud(i,k) + RQCBLTEN(i,k)*delt - ! qgrs_ice_cloud(i,k) = qgrs_ice_cloud(i,k) + RQIBLTEN(i,k)*delt + ! qgrs_ice(i,k) = qgrs_ice(i,k) + RQIBLTEN(i,k)*delt ! !dqdt_ozone(i,k) = 0.0 ! enddo !enddo @@ -933,7 +957,7 @@ SUBROUTINE mynnedmf_wrapper_run( & do i=1,im dqdt_water_vapor(i,k) = RQVBLTEN(i,k) !/(1.0 + qv(i,k)) dqdt_liquid_cloud(i,k) = RQCBLTEN(i,k) !/(1.0 + qv(i,k)) - dqdt_ice_cloud(i,k) = 0.0 + dqdt_ice(i,k) = 0.0 !dqdt_rain(i,k) = 0.0 !dqdt_snow(i,k) = 0.0 !dqdt_graupel(i,k) = 0.0 @@ -970,8 +994,7 @@ SUBROUTINE mynnedmf_wrapper_run( & print*,"znt:",znt(1)," delt=",delt print*,"im=",im," levs=",levs print*,"PBLH=",pblh(1)," KPBL=",KPBL(1)," xland=",xland(1) - print*,"vdfg=",vdfg(1)," ch=",ch(1) - !print*,"TKE:",TKE_PBL(1,1),TKE_PBL(1,2),TKE_PBL(1,levs) + print*,"ch=",ch(1) print*,"qke:",qke(1,1),qke(1,2),qke(1,levs) print*,"el_pbl:",el_pbl(1,1),el_pbl(1,2),el_pbl(1,levs) print*,"Sh3d:",Sh3d(1,1),sh3d(1,2),sh3d(1,levs) @@ -1001,8 +1024,8 @@ SUBROUTINE mynnedmf_wrapper_run( & CONTAINS SUBROUTINE dtend_helper(itracer,field,mult) - real(kind=kind_phys), intent(in) :: field(im,levs) - real(kind=kind_phys), intent(in), optional :: mult(im,levs) + real(kind_phys), intent(in) :: field(im,levs) + real(kind_phys), intent(in), optional :: mult(im,levs) integer, intent(in) :: itracer integer :: idtend @@ -1018,7 +1041,7 @@ END SUBROUTINE dtend_helper ! ================================================================== SUBROUTINE moisture_check2(kte, delt, dp, exner, & - qv, qc, qi, th ) + qv, qc, qi, qs, th ) ! ! If qc < qcmin, qi < qimin, or qv < qvmin happens in any layer, ! force them to be larger than minimum value by (1) condensating @@ -1032,11 +1055,11 @@ SUBROUTINE moisture_check2(kte, delt, dp, exner, & implicit none integer, intent(in) :: kte - real(kind=kind_phys), intent(in) :: delt - real(kind=kind_phys), dimension(kte), intent(in) :: dp, exner - real(kind=kind_phys), dimension(kte), intent(inout) :: qv, qc, qi, th + real(kind_phys), intent(in) :: delt + real(kind_phys), dimension(kte), intent(in) :: dp, exner + real(kind_phys), dimension(kte), intent(inout) :: qv, qc, qi, qs, th integer k - real :: dqc2, dqi2, dqv2, sum, aa, dum + real :: dqc2, dqi2, dqs2, dqv2, sum, aa, dum real, parameter :: qvmin1= 1e-8, & !min at k=1 qvmin = 1e-20, & !min above k=1 qcmin = 0.0, & @@ -1045,17 +1068,19 @@ SUBROUTINE moisture_check2(kte, delt, dp, exner, & do k = kte, 1, -1 ! From the top to the surface dqc2 = max(0.0, qcmin-qc(k)) !qc deficit (>=0) dqi2 = max(0.0, qimin-qi(k)) !qi deficit (>=0) + dqs2 = max(0.0, qimin-qs(k)) !qs deficit (>=0) !update species qc(k) = qc(k) + dqc2 qi(k) = qi(k) + dqi2 - qv(k) = qv(k) - dqc2 - dqi2 + qs(k) = qs(k) + dqs2 + qv(k) = qv(k) - dqc2 - dqi2 - dqs2 !for theta !th(k) = th(k) + xlvcp/exner(k)*dqc2 + & ! xlscp/exner(k)*dqi2 !for temperature th(k) = th(k) + xlvcp*dqc2 + & - xlscp*dqi2 + xlscp*(dqi2+dqs2) !then fix qv if lending qv made it negative if (k .eq. 1) then @@ -1071,6 +1096,7 @@ SUBROUTINE moisture_check2(kte, delt, dp, exner, & endif qc(k) = max(qc(k),qcmin) qi(k) = max(qi(k),qimin) + qs(k) = max(qs(k),qimin) end do ! Extra moisture used to satisfy 'qv(1)>=qvmin' is proportionally diff --git a/physics/mynnedmf_wrapper.meta b/physics/mynnedmf_wrapper.meta index 044162dbb..ec4706aba 100644 --- a/physics/mynnedmf_wrapper.meta +++ b/physics/mynnedmf_wrapper.meta @@ -125,13 +125,6 @@ dimensions = () type = logical intent = in -[lheatstrg] - standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -303,7 +296,7 @@ type = real kind = kind_phys intent = inout -[qgrs_ice_cloud] +[qgrs_ice] standard_name = cloud_ice_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 @@ -311,6 +304,14 @@ type = real kind = kind_phys intent = inout +[qgrs_snow] + standard_name = snow_mixing_ratio + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [qgrs_cloud_droplet_num_conc] standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air long_name = number concentration of cloud droplets (liquid) @@ -367,6 +368,14 @@ type = real kind = kind_phys intent = in +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in [exner] standard_name = dimensionless_exner_function long_name = Exner function at layers @@ -1017,7 +1026,7 @@ type = real kind = kind_phys intent = inout -[dqdt_ice_cloud] +[dqdt_ice] standard_name = process_split_cumulative_tendency_of_cloud_ice_mixing_ratio long_name = cloud condensed water mixing ratio tendency due to model physics units = kg kg-1 s-1 @@ -1025,6 +1034,14 @@ type = real kind = kind_phys intent = inout +[dqdt_snow] + standard_name = process_split_cumulative_tendency_of_snow_mixing_ratio + long_name = ratio of mass of snow water tendency to mass of dry air plus vapor (without condensates) due to model physics + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [dqdt_ozone] standard_name = process_split_cumulative_tendency_of_ozone_mixing_ratio long_name = ozone mixing ratio tendency due to model physics @@ -1151,6 +1168,13 @@ dimensions = () type = integer intent = in +[ntsw] + standard_name = index_of_snow_mixing_ratio_in_tracer_concentration_array + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in [ntlnc] standard_name = index_of_mass_number_concentration_of_cloud_droplets_in_tracer_concentration_array long_name = tracer index for liquid number concentration @@ -1210,12 +1234,12 @@ type = real kind = kind_phys intent = in -[bl_mynn_tkebudget] +[tke_budget] standard_name = control_for_tke_budget_output long_name = flag for activating TKE budget units = flag dimensions = () - type = logical + type = integer intent = in [bl_mynn_tkeadvect] standard_name = flag_for_tke_advection @@ -1329,6 +1353,13 @@ dimensions = () type = integer intent = in +[imp_physics_fa] + standard_name = identifier_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [imp_physics_nssl] standard_name = identifier_for_nssl_microphysics_scheme long_name = choice of NSSL 2-moment microphysics scheme @@ -1416,6 +1447,13 @@ dimensions = () type = logical intent = in +[mraerosol] + standard_name = do_merra2_aerosol_awareness + long_name = flag for merra2 aerosol-aware physics for example the thompson microphysics + units = flag + dimensions = () + type = logical + intent = in [spp_wts_pbl] standard_name = spp_weights_for_pbl_scheme long_name = spp weights for pbl scheme diff --git a/physics/sgscloud_radpre.F90 b/physics/sgscloud_radpre.F90 index ae0f39dde..05ca1af2a 100644 --- a/physics/sgscloud_radpre.F90 +++ b/physics/sgscloud_radpre.F90 @@ -35,7 +35,7 @@ module sgscloud_radpre !! !>\section sgscloud_radpre_mod SGS Cloud Scheme Pre General Algorithm subroutine sgscloud_radpre_run( & - im,dt,levs, & + im,dt,fhswr,levs, & flag_init,flag_restart, & con_g, con_pi, eps, epsm1, & r_v, cpv, rcp, & @@ -43,8 +43,9 @@ subroutine sgscloud_radpre_run( & do_mynnedmf, & qc, qi, qv, T3D, P3D, exner, & qr, qs, qg, & - qci_conv,ud_mf, & + qci_conv,qlc,qli,ud_mf, & imfdeepcnv, imfdeepcnv_gf, & + imfdeepcnv_sas, & qc_save, qi_save, qs_save, & qc_bl,qi_bl,cldfra_bl, & delp,clouds1,clouds2,clouds3, & @@ -53,6 +54,7 @@ subroutine sgscloud_radpre_run( & nlay, plyr, xlat, dz,de_lgth, & cldsa,mtopa,mbota, & imp_physics, imp_physics_gfdl,& + imp_physics_fa, & iovr, & errmsg, errflg ) @@ -67,17 +69,18 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), intent(in) :: con_g, con_pi, eps, epsm1 real(kind=kind_phys), intent(in) :: r_v, cpv, rcp real(kind=kind_phys), intent(in) :: xlv, xlf, cp - real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), intent(in) :: dt,fhswr real :: xls, xlvcp, xlscp !derived below real(kind=kind_phys) :: gfac integer, intent(in) :: im, levs, imfdeepcnv, imfdeepcnv_gf, & - & nlay, imp_physics, imp_physics_gfdl + & nlay, imfdeepcnv_sas, imp_physics, imp_physics_gfdl, imp_physics_fa logical, intent(in) :: flag_init, flag_restart, do_mynnedmf real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi real(kind=kind_phys), dimension(:,:), intent(inout) :: qr, qs, qg - ! qci_conv only allocated if GF is used + ! note: qci_conv only allocated if GF is used real(kind=kind_phys), dimension(:,:), intent(inout) :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(inout) :: qlc, qli !for SAS real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf real(kind=kind_phys), dimension(:,:), intent(in) :: T3D,delp real(kind=kind_phys), dimension(:,:), intent(in) :: qv,P3D,exner @@ -112,7 +115,8 @@ subroutine sgscloud_radpre_run( & real :: rhgrid,h2oliq,qsat,tem1,tem2,clwt,es,onemrh,value !Chaboureau and Bechtold (2002 and 2005) - real :: a, f, sigq, qmq, qt, xl, tlk, th, thl, rsl, cpm, cb_cf + real :: a, f, sigq, qmq, qt, xl, th, thl, rsl, cpm, cb_cf + real(kind=kind_phys) :: tlk !Option to convective cloud fraction integer, parameter :: conv_cf_opt = 0 !0: C-B, 1: X-R @@ -188,7 +192,7 @@ subroutine sgscloud_radpre_run( & !endif if (qc(i,k) < 1.e-6 .and. cldfra_bl(i,k)>0.001) then - qc(i,k) = qc_bl(i,k)*cldfra_bl(i,k) + qc(i,k) = qc_bl(i,k) !eff radius cloud water (microns) from Miles et al. (2007) if (nint(slmsk(i)) == 1) then !land @@ -206,8 +210,8 @@ subroutine sgscloud_radpre_run( & !~700 mb and decrease snow to zero by ~300 mb snow_frac = min(0.5, max((p3d(i,k)-30000.0),0.0)/140000.0) ice_frac = 1.0 - snow_frac - if (qi(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then - qi(i,k) = ice_frac*qi_bl(i,k)*cldfra_bl(i,k) + if (qi(i,k) < 1.e-9 .and. cldfra_bl(i,k)>0.001) then + qi(i,k) = ice_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) if(qi(i,k)>1.E-8)clouds5(i,k)=max(173.45 + 2.14*Tc, 20.) @@ -219,8 +223,8 @@ subroutine sgscloud_radpre_run( & clouds4(i,k) = max(0.0, qi(i,k) * gfac * delp(i,k)) endif - if (qs(i,k) < 1.e-8 .and. cldfra_bl(i,k)>0.001) then - qs(i,k) = snow_frac*qi_bl(i,k)*cldfra_bl(i,k) + if (qs(i,k) < 1.e-9 .and. cldfra_bl(i,k)>0.001) then + qs(i,k) = snow_frac*qi_bl(i,k) !eff radius cloud ice (microns), from Mishra et al. (2014, JGR Atmos, fig 6b) if(qs(i,k)>1.E-8)clouds9(i,k)=max(2.*(173.45 + 2.14*Tc), 50.) @@ -270,7 +274,6 @@ subroutine sgscloud_radpre_run( & if (imfdeepcnv == imfdeepcnv_gf) then do k = 1, levs do i = 1, im - !if ( qci_conv(i,k) > 0. .AND. (qi(i,k) < 1E-7 .AND. qc(i,k) < 1E-7 ) ) then if ( qci_conv(i,k) > 0. ) then Tk = T3D(i,k) Tc = Tk - 273.15 @@ -321,10 +324,15 @@ subroutine sgscloud_radpre_run( & sigq = SQRT(sigq**2 + 1e-10) ! combined conv + background components qmq = a * (qt - qsat) ! saturation deficit/excess; ! the numerator of Q1 - cb_cf= min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.01),0.99) + cb_cf= min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.0),0.99) + if (qci_conv(i,k) .lt. 1e-9) cb_cf = 0.0 if (do_mynnedmf .and. qmq .ge. 0.0) then ! leverage C-B stratus clouds from MYNN in saturated conditions - clouds1(i,k) = 0.5*(clouds1(i,k) + cb_cf) + if (cb_cf .gt. 0.0) then + clouds1(i,k) = 0.5*(clouds1(i,k) + cb_cf) + else + !default to MYNN clouds - already specified + endif else ! unsaturated clouds1(i,k) = cb_cf endif @@ -354,7 +362,101 @@ subroutine sgscloud_radpre_run( & endif ! qci_conv enddo enddo - endif ! imfdeepcnv_gf + + elseif (imfdeepcnv == imfdeepcnv_sas) then + + do k = 1, levs + do i = 1, im + h2oliq = qlc(i,k)+qli(i,k) + if ( h2oliq > 0. ) then + Tk = T3D(i,k) + Tc = Tk - 273.15 + + !Partition the convective clouds into water & frozen species + liqfrac = min(1., max(0., (Tk-244.)/29.)) + + qc(i,k) = qc(i,k)+qlc(i,k) + !split ice & snow 50-50% + qi(i,k) = qi(i,k)+0.5*qli(i,k) + qs(i,k) = qs(i,k)+0.5*qli(i,k) + + !eff radius cloud water (microns) + if (nint(slmsk(i)) == 1) then !land + if(qc(i,k)>1.E-8)clouds3(i,k)=5.4 + else + !from Miles et al. + if(qc(i,k)>1.E-8)clouds3(i,k)=9.6 + endif + !from Mishra et al. (2014, JGR Atmos), assume R_sno = 2*R_ice + if(qi(i,k)>1.e-8)clouds5(i,k)=max( 173.45 + 2.14*Tc , 20.) + if(qs(i,k)>1.e-8)clouds9(i,k)=max(2.0*(173.45 + 2.14*Tc), 50.) + + if ( conv_cf_opt .eq. 0 ) then + !print *,'Chab-Bechtold cloud fraction used' + !Alternatively, use Chaboureau-Bechtold (CB) convective component + !Based on both CB2002 and CB2005. + xl = xlv*liqfrac + xls*(1.-liqfrac) ! blended heat capacity + tlk = t3d(i,k) - xlvcp/exner(i,k)*qc(i,k) & + & - xlscp/exner(i,k)*qi(i,k)! liquid temp + ! get saturation water vapor mixing ratio at tl and p + es = min( p3d(i,k), fpvs( tlk ) ) ! fpvs and prsl in pa + qsat= max( QMIN, eps*es / (p3d(i,k) + epsm1*es) ) + rsl = xl*qsat / (r_v*tlk**2) ! slope of C-C curve at t = tl + ! CB02, Eqn. 4 + qt = qc(i,k) + qi(i,k) + qv(i,k) !total water + cpm = cp + qt*cpv ! CB02, sec. 2, para. 1 + a = 1./(1. + xl*rsl/cpm) ! CB02 variable "a" + !Now calculate convective component of the cloud fraction: + if (a > 0.0) then + f = min(1.0/a, 4.0) ! f is the vertical profile + else ! scaling function (CB2005) + f = 1.0 + endif + sigq = 1.5E-3 * ud_mf(i,k)/dt * f + !sigq = 3.E-3 * ud_mf(i,k)/dt * f + sigq = SQRT(sigq**2 + 1e-10) ! combined conv + background components + qmq = a * (qt - qsat) ! saturation deficit/excess; + ! the numerator of Q1 + cb_cf= min(max(0.5 + 0.36 * atan(1.55*(qmq/sigq)),0.0),0.99) + if (h2oliq .lt. 1e-9) cb_cf = 0.0 + if (do_mynnedmf .and. qmq .ge. 0.0) then + ! leverage C-B stratus clouds from MYNN in saturated conditions + if (cb_cf .gt. 0.0) then + clouds1(i,k) = 0.5*(clouds1(i,k) + cb_cf) + else + !default to MYNN clouds - already specified + endif + else ! unsaturated + clouds1(i,k) = cb_cf + endif + else + !print *,'SAS with Xu-Randall cloud fraction' + ! Xu-Randall (1996) cloud fraction + es = min( p3d(i,k), fpvs( t3d(i,k) ) ) ! fpvs and prsl in pa + qsat = max( QMIN, eps*es / (p3d(i,k) + epsm1*es) ) + rhgrid = max( 0., min( 1.00, qv(i,k)/qsat ) ) + h2oliq = qc(i,k) + qi(i,k) + qr(i,k) + qs(i,k) + qg(i,k) ! g/kg + clwt = 1.0e-6 * (p3d(i,k)*0.00001) + + if (h2oliq > clwt) then + onemrh= max( 1.e-10, 1.0-rhgrid ) + tem1 = min(max((onemrh*qsat)**0.49,0.0001),1.0) !jhan + tem1 = 100.0 / tem1 + value = max( min( tem1*(h2oliq-clwt), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhgrid) ) + + clouds1(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + else + clouds1(i,k) = 0.0 + endif + !print*,"XuRandla- cf:",clouds1(i,k)," rh:",rhgrid," qt:",h2oliq + !print*,"XuRandlb- clwt:",clwt," qsat:",qsat," p:",p3d(i,k) + endif ! end convective cf choice + endif ! qlc/qli check + enddo + enddo + + endif ! convection scheme check endif ! timestep > 1 diff --git a/physics/sgscloud_radpre.meta b/physics/sgscloud_radpre.meta index 28c1b7da6..887ea0b45 100644 --- a/physics/sgscloud_radpre.meta +++ b/physics/sgscloud_radpre.meta @@ -29,6 +29,14 @@ dimensions = () type = integer intent = in +[fhswr] + standard_name = period_of_shortwave_radiation_calls + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in [flag_init] standard_name = flag_for_first_timestep long_name = flag signaling first time step for time integration loop @@ -218,6 +226,22 @@ type = real kind = kind_phys intent = inout +[qlc] + standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qli] + standard_name = ice_water_mixing_ratio_convective_transport_tracer + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout [imfdeepcnv] standard_name = control_for_deep_convection_scheme long_name = flag for mass-flux deep convection scheme @@ -232,6 +256,13 @@ dimensions = () type = integer intent = in +[imfdeepcnv_sas] + standard_name = identifier_for_simplified_arakawa_schubert_deep_convection + long_name = flag for SAS deep convection scheme + units = flag + dimensions = () + type = integer + intent = in [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme @@ -427,6 +458,13 @@ dimensions = () type = integer intent = in +[imp_physics_fa] + standard_name = identifier_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [iovr] standard_name = flag_for_cloud_overlap_method_for_radiation long_name = max-random overlap clouds