diff --git a/schemes/bretherton_park/bretherton_park_diff.F90 b/schemes/bretherton_park/bretherton_park_diff.F90
new file mode 100644
index 00000000..3ffe52fe
--- /dev/null
+++ b/schemes/bretherton_park/bretherton_park_diff.F90
@@ -0,0 +1,734 @@
+! University of Washington (UW) moist turbulence scheme (also known as diag_TKE)
+! This is the CCPP interface to this scheme.
+!
+! Original references:
+! A new moist turbulence parametrization in the Community Atmosphere Model
+! by Christopher S. Bretherton and Sungsu Park. J. Climate. 2009. 22. 3422-3448
+! https://doi.org/10.1175/2008JCLI2556.1
+! The University of Washington shallow convection and moist turbulence schemes
+! and their impact on climate simulations with the Community Atmosphere Model
+! by Sungsu Park and Christopher S. Bretherton. J. Climate. 2009. 22. 3449-3469
+! https://doi.org/10.1175/2008JCLI2557.1
+!
+! Based on eddy_diff_cam originally from Sungsu Park.
+module bretherton_park_diff
+ use ccpp_kinds, only: kind_phys
+
+ implicit none
+ private
+
+ ! public CCPP-compliant interfaces
+ public :: bretherton_park_diff_init
+ public :: bretherton_park_diff_run
+
+ ! Tunable parameters:
+ ! Number of iterations for solution
+ integer, parameter :: nturb = 5
+
+ real(kind_phys), parameter :: ml2 = 30.0_kind_phys**2 ! mixing lengths squared for computing free air diffusivity
+ ! used for interfaces in [ntop_eddy+1, nbot_eddy]
+
+ logical, parameter :: use_kvf = .false. ! .true. (.false.) : initialize kvh/kvm = kvf (0)
+ real(kind_phys), parameter :: lambda = 0.5_kind_phys ! Under-relaxation factor (0 < lambda =< 1)
+
+ ! Module storage:
+ logical :: do_diffusion_const_wet(1)
+ integer :: ntop_eddy
+ integer :: nbot_eddy
+
+contains
+
+!> \section arg_table_bretherton_park_diff_init Argument Table
+!! \htmlinclude bretherton_park_diff_init.html
+ subroutine bretherton_park_diff_init( &
+ amIRoot, iulog, &
+ pver, &
+ gravit, cpair, rair, zvir, latvap, latice, karman, &
+ ntop_eddy_in, &
+ pref_mid, &
+ ! namelist options:
+ eddy_lbulk_max, eddy_leng_max, eddy_max_bot_pressure, eddy_moist_entrain_a2l, &
+ ! output:
+ ncvmax, &
+ errmsg, errflg)
+
+ ! Driver subroutines for UW PBL scheme.
+ use eddy_diff, only: init_eddy_diff
+
+ ! Input arguments
+ logical, intent(in) :: amIRoot
+ integer, intent(in) :: iulog
+ integer, intent(in) :: pver
+ real(kind_phys), intent(in) :: gravit
+ real(kind_phys), intent(in) :: cpair
+ real(kind_phys), intent(in) :: rair
+ real(kind_phys), intent(in) :: zvir
+ real(kind_phys), intent(in) :: latvap
+ real(kind_phys), intent(in) :: latice
+ real(kind_phys), intent(in) :: karman
+ integer, intent(in) :: ntop_eddy_in ! Top interface level to which eddy vertical diffusivity is applied [index]
+ real(kind_phys), intent(in) :: pref_mid(:) ! reference_pressure [Pa]
+ real(kind_phys), intent(in) :: eddy_lbulk_max ! Maximum master length [m]
+ real(kind_phys), intent(in) :: eddy_leng_max ! Maximum dissipation length [m]
+ real(kind_phys), intent(in) :: eddy_max_bot_pressure ! Bottom pressure level for eddy_leng_max [hPa]
+ real(kind_phys), intent(in) :: eddy_moist_entrain_a2l ! Moist entrainment enhancement parameter [1]
+
+ ! Output arguments
+ integer, intent(out) :: ncvmax ! maximum number of convective layers (CLs) [count]
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ integer :: k
+ real(kind_phys) :: leng_max(pver)
+
+ errmsg = ''
+ errflg = 0
+
+ ! Only diffuse water vapor
+ do_diffusion_const_wet(1) = .true.
+
+ ! from the set_vertical_diffusion_top scheme.
+ ntop_eddy = ntop_eddy_in
+
+ ! hardcoded to be surface layer:
+ nbot_eddy = pver
+
+ ! Set maximum number of convective layers (CLs) in the UW scheme
+ ! this was hardcoded to pver at the time of CCPPization, but could be made a parameter if needed.
+ ! this is used as a dimension for many of the CL diagnostic variables in the run phase.
+ ncvmax = pver
+
+ do k = 1, pver
+ if (pref_mid(k) <= eddy_max_bot_pressure*1.e2_kind_phys) then ! hPa to Pa
+ leng_max(k) = eddy_leng_max
+ else
+ leng_max(k) = 40.e3_kind_phys
+ end if
+ end do
+
+ if(amIRoot) then
+ write(iulog,*) 'eddy diffusivity scheme is UW Moist Turbulence Scheme by Bretherton and Park'
+ write(iulog,*) 'Bretherton and Park (UW) PBL: nturb = ', nturb
+ write(iulog,*) 'Bretherton and Park (UW) PBL: eddy_leng_max = ', eddy_leng_max,' lbulk_max = ', eddy_lbulk_max
+ do k = 1,pver
+ write(iulog,*) 'Bretherton and Park (UW) PBL: ',k,pref_mid(k),' leng_max = ',leng_max(k)
+ end do
+ end if
+
+ call init_eddy_diff(pver, ncvmax, gravit, cpair, rair, zvir, &
+ latvap, latice, ntop_eddy, nbot_eddy, karman, &
+ eddy_lbulk_max, leng_max, &
+ eddy_moist_entrain_a2l, errmsg)
+
+ if(trim(errmsg) /= "") then
+ errflg = 1
+ return
+ end if
+
+ end subroutine bretherton_park_diff_init
+
+ ! Interface to UW PBL scheme to compute eddy diffusivities.
+ ! Eddy diffusivities are calculated in a fully implicit way through iterative process.
+ ! CL = convective layers; STL = stable turbulent layers.
+ !
+ ! Original author: Sungsu Park, August 2006, May 2008.
+!> \section arg_table_bretherton_park_diff_run Argument Table
+!! \htmlinclude bretherton_park_diff_run.html
+ subroutine bretherton_park_diff_run( &
+ ncol, pver, pverp, pcnst, ncvmax, &
+ iulog, &
+ dt, &
+ const_props, &
+ do_iss, am_correction, do_beljaars, &
+ is_first_timestep, &
+ gravit, cpair, rair, latvap, latice, &
+ t, tint, &
+ qv, ql, qi, &
+ s, &
+ p, rhoi, dpidz_sq, &
+ cldn, &
+ z, zi, &
+ pmid, pint, &
+ u, v, &
+ taux, tauy, &
+ shflx, qflx, wstarent, &
+ ksrftms, dragblj, &
+ qrl, wsedl, &
+ ! input/output:
+ kvm, kvh, &
+ tauresx, tauresy, &
+ ! output:
+ s2, n2, ri, &
+ kvq, rrho, &
+ ustar, &
+ pblh, pblhp, minpblh, &
+ cgh, cgs, tpert, qpert, wpert, &
+ tke, tkes, wcap, &
+ wsed, turbtype, &
+ bprod, sprod, sfi, sfuh, sflh, &
+ qlfd, &
+ chu, chs, cmu, cms, &
+ kbase_o, ktop_o, ncvfin_o, &
+ kbase_mg, ktop_mg, ncvfin_mg, &
+ kbase_f, ktop_f, ncvfin_f, &
+ wet, web, jtbu, jbbu, &
+ evhc, jt2slv, n2ht, n2hb, &
+ lwp, opt_depth, radinvfrac, radf, &
+ wstar, wstar3fact, &
+ ebrk, wbrk, lbrk, &
+ ricl, ghcl, shcl, smcl, &
+ ghi, shi, smi, rii, lengi, &
+ errorPBL, &
+ errmsg, errflg)
+
+ ! pbl utils dependencies:
+ use atmos_phys_pbl_utils, only: calc_eddy_flux_coefficient, calc_ideal_gas_rrho, calc_friction_velocity
+
+ ! to-be-ccppized dependency:
+ use coords_1d, only: coords1d
+ use wv_saturation, only: qsat
+
+ ! Driver routines for UW PBL scheme.
+ use eddy_diff, only: trbintd, caleddy
+
+ ! framework dependency for const_props
+ use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t
+
+ ! dependency to get constituent index
+ use ccpp_const_utils, only: ccpp_const_get_idx
+
+ ! Driver routines for diffusion solver to be called iteratively within this run phase.
+ use diffusion_solver, only: implicit_surface_stress_add_drag_coefficient_run
+ use diffusion_stubs, only: turbulent_mountain_stress_add_drag_coefficient_run
+ use diffusion_solver, only: vertical_diffusion_wind_damping_rate_run
+ use diffusion_solver, only: vertical_diffusion_diffuse_horizontal_momentum_run
+ use diffusion_solver, only: vertical_diffusion_diffuse_dry_static_energy_run
+ use diffusion_solver, only: vertical_diffusion_diffuse_tracers_run
+
+ ! Input variables
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ integer, intent(in) :: pverp
+ integer, intent(in) :: pcnst
+ integer, intent(in) :: ncvmax ! max # of CLs (can set to pver) [count]
+ integer, intent(in) :: iulog
+ real(kind_phys), intent(in) :: dt ! Physics timestep [s]
+ type(ccpp_constituent_prop_ptr_t), &
+ intent(in) :: const_props(:) ! CCPP constituent properties pointer
+ logical, intent(in) :: do_iss ! Use implicit turbulent surface stress computation [flag]
+ logical, intent(in) :: am_correction ! Do angular momentum conservation correction [flag]
+ logical, intent(in) :: do_beljaars ! Do Beljaars drag in vertical diffusion? [flag]
+ logical, intent(in) :: is_first_timestep ! is_first_timestep [flag]
+ real(kind_phys), intent(in) :: gravit
+ real(kind_phys), intent(in) :: cpair
+ real(kind_phys), intent(in) :: rair
+ real(kind_phys), intent(in) :: latvap
+ real(kind_phys), intent(in) :: latice
+ real(kind_phys), intent(in) :: t(:, :) ! Temperature [K]
+ real(kind_phys), intent(in) :: tint(:, :) ! Temperature defined on interfaces [K]
+ real(kind_phys), intent(in) :: qv(:, :) ! Water vapor mixing ratio [kg kg-1]
+ real(kind_phys), intent(in) :: ql(:, :) ! Liquid water mixing ratio [kg kg-1]
+ real(kind_phys), intent(in) :: qi(:, :) ! Ice mixing ratio [kg kg-1]
+ real(kind_phys), intent(in) :: s(:, :) ! Dry static energy [J kg-1]
+ type(coords1d), intent(in) :: p ! Pressure coordinates for solver [Pa]
+ real(kind_phys), intent(in) :: rhoi(:, :) ! Density at interfaces [kg m-3]
+ real(kind_phys), intent(in) :: dpidz_sq(:, :) ! Square of derivative of pressure with height (moist) [kg2 m-4 s-4], interfaces
+ real(kind_phys), intent(in) :: cldn(:, :) ! Stratiform cloud fraction [fraction]
+ real(kind_phys), intent(in) :: z(:, :) ! Layer mid-point height above surface [m]
+ real(kind_phys), intent(in) :: zi(:, :) ! Interface height above surface [m]
+ real(kind_phys), intent(in) :: pmid(:, :) ! Layer mid-point pressure [Pa]
+ real(kind_phys), intent(in) :: pint(:, :) ! Interface pressure [Pa]
+ real(kind_phys), intent(in) :: u(:, :) ! Zonal velocity [m s-1]
+ real(kind_phys), intent(in) :: v(:, :) ! Meridional velocity [m s-1]
+ real(kind_phys), intent(in) :: taux(:) ! Zonal wind stress at surface [N m-2]
+ real(kind_phys), intent(in) :: tauy(:) ! Meridional wind stress at surface [N m-2]
+ real(kind_phys), intent(in) :: shflx(:) ! Sensible heat flux at surface [W m-2]
+ real(kind_phys), intent(in) :: qflx(:, :) ! Constituent fluxes at surface [kg m-2 s-1]
+ logical, intent(in) :: wstarent ! .true. means use the 'wstar' entrainment closure [flag]
+ real(kind_phys), intent(in) :: ksrftms(:) ! Surface drag coefficient of turbulent mountain stress [kg m-2 s-1]
+ real(kind_phys), intent(in) :: dragblj(:, :) ! Drag profile from Beljaars SGO form drag [s-1]
+ real(kind_phys), intent(in) :: qrl(:, :) ! LW radiative cooling rate adj. by pressure thickness [J Pa kg-1 s-1]
+ real(kind_phys), intent(in) :: wsedl(:, :) ! Sedimentation velocity of stratiform liquid cloud droplet [m s-1]
+
+ ! Input/output variables
+ real(kind_phys), intent(inout) :: kvm(:, :) ! Eddy diffusivity for momentum [m2 s-1]
+ ! (in from previous timestep, output to current timestep)
+ real(kind_phys), intent(inout) :: kvh(:, :) ! Eddy diffusivity for heat [m2 s-1]
+ ! (in from previous timestep, output to current timestep)
+ real(kind_phys), intent(inout) :: tauresx(:) ! Residual stress to be added in vdiff to correct for turb [N m-2]
+ real(kind_phys), intent(inout) :: tauresy(:) ! (in from previous timestep; output to current timestep)
+
+ ! Output variables, including those for diagnostic output
+ real(kind_phys), intent(out) :: s2(:, :) ! Shear squared, defined at interfaces except surface [s-2]
+ real(kind_phys), intent(out) :: n2(:, :) ! Buoyancy frequency, defined at interfaces except surface [s-2]
+ real(kind_phys), intent(out) :: ri(:, :) ! Richardson number, 'n2/s2', defined at interfaces except surface [s-2]
+ real(kind_phys), intent(out) :: kvq(:, :) ! Eddy diffusivity for constituents, moisture and tracers [m2 s-1]
+ real(kind_phys), intent(out) :: rrho(:) ! Reciprocal of density at the lowest layer [m3 kg-1]
+ real(kind_phys), intent(out) :: ustar(:) ! Surface friction velocity [m s-1]
+ real(kind_phys), intent(out) :: pblh(:) ! PBL top height [m]
+ real(kind_phys), intent(out) :: pblhp(:) ! PBL top pressure [Pa]
+ real(kind_phys), intent(out) :: minpblh(:) ! Minimum PBL height based on surface stress [m]
+ real(kind_phys), intent(out) :: cgh(:, :) ! Counter-gradient term for heat [J kg-1 m-1]
+ real(kind_phys), intent(out) :: cgs(:, :) ! Counter-gradient star [cg flux-1]
+ real(kind_phys), intent(out) :: tpert(:) ! Convective temperature excess [K]
+ real(kind_phys), intent(out) :: qpert(:) ! Convective humidity excess [kg kg-1]
+ real(kind_phys), intent(out) :: wpert(:) ! Turbulent velocity excess [m s-1]
+ real(kind_phys), intent(out) :: tke(:, :) ! Turbulent kinetic energy [m2 s-2]
+ real(kind_phys), intent(out) :: tkes(:) ! TKE at surface interface [m2 s-2]
+ real(kind_phys), intent(out) :: wcap(:, :) ! Normalized TKE at all interfaces [m2 s-2]
+ real(kind_phys), intent(out) :: wsed(:, :) ! Sedimentation velocity at the top of each CL (for sedimentation-entrainment feedback) [m s-1]
+ integer, intent(out) :: turbtype(:, :) ! Turbulence type identifier at all interfaces [1]
+ real(kind_phys), intent(out) :: bprod(:, :) ! Buoyancy production of tke (interfaces) [m2 s-3]
+ real(kind_phys), intent(out) :: sprod(:, :) ! Shear production [m2 s-3]
+ real(kind_phys), intent(out) :: sfi(:, :) ! Interfacial layer saturation fraction [fraction]
+ real(kind_phys), intent(out) :: sfuh(:, :) ! Saturation fraction in upper half-layer [fraction]
+ real(kind_phys), intent(out) :: sflh(:, :) ! Saturation fraction in lower half-layer [fraction]
+ real(kind_phys), intent(out) :: qlfd(:, :) ! Liquid water specific humidity for diffusion [kg kg-1]
+ ! Buoyancy coefficients : w'b' = ch * w'sl' + cm * w'qt'
+ real(kind_phys), intent(out) :: chu(:, :) ! Heat buoyancy coef for dry states, interfaces [m s-2 kg J-1]
+ real(kind_phys), intent(out) :: chs(:, :) ! Heat buoyancy coef for sat states, interfaces [m s-2 kg J-1]
+ real(kind_phys), intent(out) :: cmu(:, :) ! Moisture buoyancy coef for dry states, interfaces [m s-2 kg-1 kg]
+ real(kind_phys), intent(out) :: cms(:, :) ! Moisture buoyancy coef for sat states, interfaces [m s-2 kg-1 kg]
+ real(kind_phys), intent(out) :: kbase_o(:, :) ! Original external base interface index of CL from 'exacol', ncvmax [index]
+ real(kind_phys), intent(out) :: ktop_o(:, :) ! Original external top interface index of CL from 'exacol', ncvmax [index]
+ real(kind_phys), intent(out) :: ncvfin_o(:) ! Original number of CLs from 'exacol' [count]
+ real(kind_phys), intent(out) :: kbase_mg(:, :) ! 'kbase' after extending-merging from 'zisocl', ncvmax [index]
+ real(kind_phys), intent(out) :: ktop_mg(:, :) ! 'ktop' after extending-merging from 'zisocl', ncvmax [index]
+ real(kind_phys), intent(out) :: ncvfin_mg(:) ! 'ncvfin' after extending-merging from 'zisocl' [count]
+ real(kind_phys), intent(out) :: kbase_f(:, :) ! Final 'kbase' after extending-merging & including SRCL, ncvmax [index]
+ real(kind_phys), intent(out) :: ktop_f(:, :) ! Final 'ktop' after extending-merging & including SRCL, ncvmax [index]
+ real(kind_phys), intent(out) :: ncvfin_f(:) ! Final 'ncvfin' after extending-merging & including SRCL [count]
+ real(kind_phys), intent(out) :: wet(:, :) ! Entrainment rate at the CL top, ncvmax [m s-1]
+ real(kind_phys), intent(out) :: web(:, :) ! Entrainment rate at the CL base, ncvmax [m s-1] (Set to zero if CL is based at surface)
+ real(kind_phys), intent(out) :: jtbu(:, :) ! Buoyancy jump across the CL top, ncvmax [m s-2]
+ real(kind_phys), intent(out) :: jbbu(:, :) ! Buoyancy jump across the CL base, ncvmax [m s-2]
+ real(kind_phys), intent(out) :: evhc(:, :) ! Evaporative enhancement factor at the CL top, ncvmax [1]
+ real(kind_phys), intent(out) :: jt2slv(:, :) ! Jump of slv (liquid water virtual static energy) (across two layers)
+ ! at CL top used only for evhc (evaporative enhancement factor at CL top), ncvmax [J kg-1]
+ real(kind_phys), intent(out) :: n2ht(:, :) ! n2 defined at the CL top interface but using
+ ! sfuh(kt) instead of sfi(kt), ncvmax [s-2]
+ real(kind_phys), intent(out) :: n2hb(:, :) ! n2 defined at the CL base interface but using
+ ! sflh(kb-1) instead of sfi(kb), ncvmax [s-2]
+ real(kind_phys), intent(out) :: lwp(:, :) ! LWP in the CL top layer, ncvmax [kg m-2]
+ real(kind_phys), intent(out) :: opt_depth(:, :) ! Optical depth of the CL top layer, ncvmax [1]
+ real(kind_phys), intent(out) :: radinvfrac(:, :) ! Fraction of radiative cooling confined in the top portion of CL top layer, ncvmax [fraction]
+ real(kind_phys), intent(out) :: radf(:, :) ! Buoyancy production at the CL top due to LW radiative cooling, ncvmax [m2 s-3]
+ real(kind_phys), intent(out) :: wstar(:, :) ! Convective velocity in each CL, ncvmax [m s-1]
+ real(kind_phys), intent(out) :: wstar3fact(:, :) ! Enhancement of 'wstar3' due to entrainment (inverse), ncvmax [1]
+ real(kind_phys), intent(out) :: ebrk(:, :) ! Net mean TKE of CL including entrainment effect, ncvmax [m2 s-2]
+ real(kind_phys), intent(out) :: wbrk(:, :) ! Net mean normalized TKE (W) of CL,
+ ! 'ebrk/b1' including entrainment effect, ncvmax [m2 s-2]
+ real(kind_phys), intent(out) :: lbrk(:, :) ! Energetic internal thickness of CL, ncvmax [m]
+ real(kind_phys), intent(out) :: ricl(:, :) ! CL internal mean Richardson number, ncvmax [1]
+ real(kind_phys), intent(out) :: ghcl(:, :) ! Half of normalized buoyancy production of CL, ncvmax [1]
+ real(kind_phys), intent(out) :: shcl(:, :) ! Galperin instability function of heat-moisture of CL, ncvmax [1]
+ real(kind_phys), intent(out) :: smcl(:, :) ! Galperin instability function of mementum of CL, ncvmax [1]
+ real(kind_phys), intent(out) :: ghi(:, :) ! Half of normalized buoyancy production at all interfaces [1]
+ real(kind_phys), intent(out) :: shi(:, :) ! Galperin instability function of heat-moisture at all interfaces [1]
+ real(kind_phys), intent(out) :: smi(:, :) ! Galperin instability function of heat-moisture at all interfaces [1]
+ real(kind_phys), intent(out) :: rii(:, :) ! Interfacial Richardson number defined at all interfaces [1]
+ real(kind_phys), intent(out) :: lengi(:, :) ! Turbulence length scale at all interfaces [m]
+ real(kind_phys), intent(out) :: errorPBL(:) ! Error function showing whether PBL produced convergent solution or not [m2 s-1]
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ ! Local variables
+ integer :: i, k, iturb
+ integer :: const_wv_idx
+ integer :: ipbl(ncol) ! If 1, PBL is CL, while if 0, PBL is STL.
+
+ character(2048) :: warnstring ! Warning messages from driver routine
+
+ real(kind_phys) :: kvf(ncol, pverp) ! Free atmospheric eddy diffusivity [m2 s-1]
+ real(kind_phys) :: kvm_in(ncol, pverp) ! Eddy diffusivity for momentum [m2 s-1], previous timestep
+ real(kind_phys) :: kvh_in(ncol, pverp) ! Eddy diffusivity for heat [m2 s-1], previous timestep
+ real(kind_phys) :: kvm_ce(ncol, pverp) ! Eddy diffusivity for momentum [m2 s-1], input into caleddy
+ real(kind_phys) :: kvh_ce(ncol, pverp) ! Eddy diffusivity for heat [m2 s-1], input into caleddy
+
+ real(kind_phys) :: qt(ncol, pver) ! Total specific humidity [kg kg-1]
+ real(kind_phys) :: sl(ncol, pver) ! Liquid water static energy [J kg-1]
+ real(kind_phys) :: slv(ncol, pver) ! Liquid water virtual static energy [J kg-1]
+ real(kind_phys) :: slslope(ncol, pver) ! Slope of 'sl' in each layer
+ real(kind_phys) :: qtslope(ncol, pver) ! Slope of 'qt' in each layer
+ real(kind_phys) :: qvfd(ncol, pver) ! Specific humidity for diffusion [kg kg-1]
+ real(kind_phys) :: tfd(ncol, pver) ! Temperature for diffusion [K]
+ real(kind_phys) :: slfd(ncol, pver) ! Liquid static energy [J kg-1]
+ real(kind_phys) :: qtfd(ncol, pver, 1) ! Total specific humidity [kg kg-1]
+ real(kind_phys) :: ufd(ncol, pver) ! U-wind for diffusion [m s-1]
+ real(kind_phys) :: vfd(ncol, pver) ! V-wind for diffusion [m s-1]
+
+ ! Output arguments from iterative calls of diffusion solver
+ real(kind_phys) :: ufd_out(ncol, pver) ! U-wind for diffusion [m s-1]
+ real(kind_phys) :: vfd_out(ncol, pver) ! V-wind for diffusion [m s-1]
+ real(kind_phys) :: slfd_out(ncol, pver) ! Liquid static energy [J kg-1]
+ real(kind_phys) :: qtfd_out(ncol, pver, 1) ! Total specific humidity [kg kg-1]
+
+ ! Input arguments for CCPPized diffusion solver
+ real(kind_phys) :: ksrf(ncol)
+ real(kind_phys) :: tau_damp_rate(ncol, pver)
+ real(kind_phys) :: ubc_mmr_dummy(ncol, 1)
+ logical :: cnst_fixed_ubc(1)
+
+ real(kind_phys) :: jnk1d(ncol)
+ real(kind_phys) :: jnk2d(ncol, pverp)
+ real(kind_phys) :: zero(ncol)
+ real(kind_phys) :: zero2d(ncol, pverp)
+ real(kind_phys) :: es ! Saturation vapor pressure
+ real(kind_phys) :: qs ! Saturation specific humidity
+ real(kind_phys) :: templ, temps
+
+ errmsg = ''
+ errflg = 0
+
+ ! Check constituents list and locate water vapor index
+ ! (not assumed to be 1)
+ call ccpp_const_get_idx(const_props, &
+ 'water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', &
+ const_wv_idx, errmsg, errflg)
+ if (errflg /= 0) return
+
+ ! Initialize dummy variables to pass into diffusion solver.
+ zero(:) = 0._kind_phys
+ zero2d(:, :) = 0._kind_phys
+
+ ! Set initial state
+ ufd(:ncol, :) = u(:ncol, :)
+ vfd(:ncol, :) = v(:ncol, :)
+ tfd(:ncol, :) = t(:ncol, :)
+ qvfd(:ncol, :) = qv(:ncol, :)
+ qlfd(:ncol, :) = ql(:ncol, :)
+
+ ! Save kvm, kvh from previous timestep for use in the driver routines,
+ ! as the kvm and kvh inout arguments are overwritten during the iterative
+ ! process.
+ kvm_in(:, :pverp) = kvm(:, :pverp)
+ kvh_in(:, :pverp) = kvh(:, :pverp)
+
+ ! Prepare invariant drag coefficients for diffusion solver
+ ! during the iterative process using CCPPized subroutines.
+ !
+ ! Calculate surface drag rate
+ ksrf(:ncol) = 0._kind_phys
+ call implicit_surface_stress_add_drag_coefficient_run( &
+ ncol = ncol, &
+ pver = pver, &
+ do_iss = do_iss, &
+ taux = taux(:ncol), &
+ tauy = tauy(:ncol), &
+ u0 = u(:ncol, :pver), & ! use original state.
+ v0 = v(:ncol, :pver), & ! use original state.
+ ! below input/output:
+ ksrf = ksrf(:ncol), &
+ errmsg = errmsg, &
+ errflg = errflg)
+ if (errflg /= 0) return
+
+ ! Add TMS surface drag rate
+ call turbulent_mountain_stress_add_drag_coefficient_run( &
+ ncol = ncol, &
+ pver = pver, &
+ ksrftms = ksrftms(:ncol), &
+ ! below input/output:
+ ksrf = ksrf(:ncol), &
+ errmsg = errmsg, &
+ errflg = errflg)
+ if (errflg /= 0) return
+
+ ! Based on the drag coefficients, calculate wind damping rates
+ call vertical_diffusion_wind_damping_rate_run( &
+ ncol=ncol, &
+ pver=pver, &
+ gravit=gravit, &
+ p=p, & ! Coords1D, pressure coordinates [Pa]
+ ksrf=ksrf(:ncol), &
+ ! below output:
+ tau_damp_rate=tau_damp_rate(:ncol, :pver), &
+ errmsg=errmsg, &
+ errflg=errflg)
+ if (errflg /= 0) return
+
+ ! Iterative loop:
+ iturb_loop: do iturb = 1, nturb
+
+ ! Total stress includes 'tms'.
+ ! Here, in computing 'tms', we can use either iteratively changed 'ufd,vfd' or the
+ ! initially given 'u,v' to the PBL scheme. Note that normal stress, 'taux, tauy'
+ ! are not changed by iteration. In order to treat 'tms' in a fully implicit way,
+ ! updated wind is used here.
+
+ ! Compute ustar
+ rrho(:ncol) = calc_ideal_gas_rrho(rair, tfd(:ncol, pver), pmid(:ncol, pver))
+ ustar(:ncol) = calc_friction_velocity(taux(:ncol) - ksrftms(:ncol)*ufd(:ncol, pver), & ! Zonal wind stress
+ tauy(:ncol) - ksrftms(:ncol)*vfd(:ncol, pver), & ! Meridional wind stress
+ rrho(:ncol))
+
+ minpblh(:ncol) = 100.0_kind_phys*ustar(:ncol) ! By construction, 'minpblh' is larger than 1 [m] when 'ustar_min = 0.01'.
+
+ ! Calculate (qt,sl,n2,s2,ri) from a given set of (t,qv,ql,qi,u,v)
+ call trbintd( &
+ ncol, pver, z, ufd, vfd, tfd, pmid, &
+ s2, n2, ri, zi, pint, cldn, qtfd, qvfd, &
+ qlfd, qi, sfi, sfuh, sflh, slfd, slv, slslope, &
+ qtslope, chs, chu, cms, cmu)
+
+ ! Save initial (i.e., before iterative diffusion) profile of (qt,sl) at each iteration.
+ ! Only necessary for (qt,sl) not (u,v) because (qt,sl) are newly calculated variables.
+ if (iturb == 1) then
+ qt(:ncol, :) = qtfd(:ncol, :, 1)
+ sl(:ncol, :) = slfd(:ncol, :)
+ end if
+
+ ! Get free atmosphere exchange coefficients. This 'kvf' is not used in UW moist PBL scheme
+ if (use_kvf) then
+ kvf(:ncol, :) = 0.0_kind_phys
+ do k = ntop_eddy, nbot_eddy - 1
+ do i = 1, ncol
+ ! mixing length squared (ml2) is fixed parameter value from ntop_eddy+1 to nbot_eddy, otherwise 0
+ if(k >= ntop_eddy+1 .and. k <= nbot_eddy) then
+ kvf(i, k + 1) = calc_eddy_flux_coefficient(ml2, ri(i, k), s2(i, k))
+ else
+ kvf(i, k + 1) = calc_eddy_flux_coefficient(0.0_kind_phys, ri(i, k), s2(i, k))
+ end if
+ end do
+ end do
+ else
+ kvf = 0._kind_phys
+ end if
+
+ ! caleddy driver subroutine:
+ !
+ ! Calculate eddy diffusivity (kvh,kvm) and (tke,bprod,sprod) using
+ ! a given (kvh,kvm) which are used only for initializing (bprod,sprod) at
+ ! the first part of caleddy. (bprod,sprod) are fully updated at the end of
+ ! caleddy after calculating (kvh,kvm)
+ !
+ ! Depending on model timestep and iteration number, kvh and kvm input to caleddy
+ ! as the initial guess of bprod, sprod
+ ! differ as necessary for 'wstar-based' entrainment closure.
+ if (iturb == 1 .and. is_first_timestep) then
+ ! First iteration of first model timestep: Use free tropospheric value or zero.
+ kvh_ce = kvf
+ kvm_ce = kvf
+ else
+ ! Further iterations or non-first model timesteps: use value from
+ ! previous iteration or previous timestep.
+ kvh_ce = kvh
+ kvm_ce = kvm
+ end if
+
+ call caleddy(ncol, pver, &
+ slfd, qtfd, qlfd, slv, ufd, &
+ vfd, pint, z, zi, &
+ qflx(:,const_wv_idx), shflx, slslope, qtslope, &
+ chu, chs, cmu, cms, sfuh, &
+ sflh, n2, s2, ri, rrho, &
+ pblh, ustar, &
+ kvh_ce, kvm_ce, kvh, kvm, &
+ tpert, qpert, qrl, kvf, tke, &
+ wstarent, bprod, sprod, minpblh, wpert, &
+ tkes, turbtype, &
+ kbase_o, ktop_o, ncvfin_o, &
+ kbase_mg, ktop_mg, ncvfin_mg, &
+ kbase_f, ktop_f, ncvfin_f, &
+ wet, web, jtbu, jbbu, &
+ evhc, jt2slv, n2ht, n2hb, &
+ lwp, opt_depth, radinvfrac, radf, &
+ wstar, wstar3fact, &
+ ebrk, wbrk, lbrk, ricl, ghcl, &
+ shcl, smcl, ghi, shi, smi, &
+ rii, lengi, wcap, pblhp, cldn, &
+ ipbl, wsedl, wsed, &
+ warnstring, errmsg)
+
+ if (trim(warnstring) /= "") then
+ write (iulog, *) "eddy_diff_cam: Messages from caleddy follow."
+ write (iulog, *) warnstring
+ end if
+
+ if (trim(errmsg) /= "") then
+ errflg = 1
+ return
+ end if
+
+ ! Calculate errorPBL to check whether PBL produced convergent solutions or not.
+ if (iturb == nturb) then
+ do i = 1, ncol
+ errorPBL(i) = 0._kind_phys
+ do k = 1, pver
+ errorPBL(i) = errorPBL(i) + (kvh(i, k) - kvh_ce(i, k))**2
+ end do
+ errorPBL(i) = sqrt(errorPBL(i)/pver)
+ end do
+ end if
+
+ ! Eddy diffusivities which will be used for the initialization of (bprod,
+ ! sprod) in 'caleddy' at the next iteration step.
+ !
+ ! This is updated from the values from the output of caleddy
+ ! and from the initial input to caleddy
+ if (iturb > 1 .and. iturb < nturb) then
+ kvm(:ncol, :) = lambda*kvm(:ncol, :) + (1._kind_phys - lambda)*kvm_ce(:ncol, :)
+ kvh(:ncol, :) = lambda*kvh(:ncol, :) + (1._kind_phys - lambda)*kvh_ce(:ncol, :)
+ end if
+
+ ! Set nonlocal terms to zero for flux diagnostics, since not used by caleddy.
+ cgh(:ncol, :) = 0._kind_phys
+ cgs(:ncol, :) = 0._kind_phys
+
+ if (iturb < nturb) then
+
+ ! Each time we diffuse the original state
+ slfd(:ncol, :) = sl(:ncol, :)
+ qtfd(:ncol, :, 1) = qt(:ncol, :)
+ ufd(:ncol, :) = u(:ncol, :)
+ vfd(:ncol, :) = v(:ncol, :)
+
+ ! Diffuse initial profile of each time step using a given (kvh_out,kvm_out)
+ ! Call the CCPPized subroutines for the diffusion solver
+ ! in iteration. This is not specified in the SDF but instead
+ ! called internally because it is an iterative process.
+ ! Notes:
+ ! - there is no molecular diffusion used here.
+ ! - in tracers, only water vapor is diffused (ncnst = 1)
+ ufd_out(:, :) = 0._kind_phys
+ vfd_out(:, :) = 0._kind_phys
+ slfd_out(:, :) = 0._kind_phys
+ call vertical_diffusion_diffuse_horizontal_momentum_run( &
+ ncol=ncol, &
+ pver=pver, &
+ pverp=pverp, &
+ dt=dt, &
+ rair=rair, &
+ gravit=gravit, &
+ do_iss=do_iss, &
+ am_correction=am_correction, &
+ itaures=.false., &
+ t=t(:ncol, :pver), &
+ p=p, & ! Coords1D, pressure coordinates [Pa]
+ rhoi=rhoi(:ncol, :pverp), &
+ taux=taux(:ncol), &
+ tauy=tauy(:ncol), &
+ tau_damp_rate=tau_damp_rate(:ncol, :pver), & ! tau damp rate from above
+ kvm=kvm(:ncol, :pverp), &
+ ksrftms=ksrftms(:ncol), &
+ dragblj=dragblj(:ncol, :pver), &
+ dpidz_sq=dpidz_sq(:ncol, :pverp), & ! moist
+ u0=ufd(:ncol, :pver), &
+ v0=vfd(:ncol, :pver), &
+ dse0=slfd(:ncol, :pver), &
+ ! input/output
+ ! (not actually updated since itaures = .false. in this internal call.)
+ tauresx=tauresx(:ncol), &
+ tauresy=tauresy(:ncol), &
+ ! below output
+ u1=ufd_out(:ncol, :pver), &
+ v1=vfd_out(:ncol, :pver), &
+ dse1=slfd_out(:ncol, :pver), &
+ dtk=jnk2d(:ncol, :), & ! unused dummy.
+ tautmsx=jnk1d(:ncol), & ! unused dummy.
+ tautmsy=jnk1d(:ncol), & ! unused dummy.
+ ! arguments for Beljaars
+ do_beljaars=do_beljaars, &
+ errmsg=errmsg, &
+ errflg=errflg)
+
+ if (errflg /= 0) return
+
+ ! Update u, v, dse with updated iterative values after diffusion solver
+ ufd(:, :pver) = ufd_out(:, :pver)
+ vfd(:, :pver) = vfd_out(:, :pver)
+ slfd(:, :pver) = slfd_out(:, :pver)
+
+ ! Diffuse dry static energy
+ call vertical_diffusion_diffuse_dry_static_energy_run( &
+ ncol=ncol, &
+ pver=pver, &
+ dt=dt, &
+ gravit=gravit, &
+ p=p, & ! Coords1D, pressure coordinates [Pa]
+ rhoi=rhoi(:ncol, :pverp), &
+ shflx=shflx(:ncol), &
+ dse_top=zero(:ncol), & ! = zero
+ kvh=kvh(:ncol, :pverp), &
+ cgh=cgh(:ncol, :pverp), &
+ dpidz_sq=dpidz_sq(:ncol, :pverp), & ! moist
+ ! input/output
+ dse=slfd(:ncol, :pver), &
+ errmsg=errmsg, &
+ errflg=errflg)
+
+ if (errflg /= 0) return
+
+ ! Diffuse tracers
+ ! Only water vapor is actually diffused here; all constituent indices are subset to just water vapor,
+ ! or sized 1, in order to be compatible with the underlying CCPPized subroutine.
+ ubc_mmr_dummy(:ncol, :1) = 0._kind_phys
+ cnst_fixed_ubc(:1) = .false.
+
+ qtfd_out(:, :, :) = 0._kind_phys
+ call vertical_diffusion_diffuse_tracers_run( &
+ ncol = ncol, &
+ pver = pver, &
+ ncnst = 1, & ! only water vapor is diffused here.
+ dt = dt, &
+ rair = rair, &
+ gravit = gravit, &
+ do_diffusion_const = do_diffusion_const_wet, & ! moist constituents to diffuse
+ p = p, & ! Coords1D, pressure coordinates [Pa]
+ t = t(:ncol, :pver), &
+ rhoi = rhoi(:ncol, :pverp), &
+ cflx = qflx(:ncol, const_wv_idx:const_wv_idx), & ! subset to water vapor only.
+ kvh = kvh(:ncol, :pverp), &
+ kvq = kvh(:ncol, :pverp), & ! [sic] kvh used for kvq here.
+ cgs = cgs(:ncol, :pverp), &
+ qmincg = zero(:ncol), &
+ dpidz_sq = dpidz_sq(:ncol, :pverp), & ! moist
+ ! upper boundary conditions from ubc module
+ ubc_mmr = ubc_mmr_dummy(:ncol, :1), &
+ cnst_fixed_ubc = cnst_fixed_ubc(:1), & ! = .false.
+ q0 = qtfd(:ncol, :pver, :1), &
+ q1 = qtfd_out(:ncol, :pver, :1), &
+ errmsg = errmsg, &
+ errflg = errflg)
+
+ if (errflg /= 0) return
+
+ ! update q with after in iterative process.
+ qtfd(:ncol, :pver, :1) = qtfd_out(:ncol, :pver, :1)
+
+ ! Retrieve (tfd,qvfd,qlfd) from (slfd,qtfd) in order to
+ ! use 'trbintd' at the next iteration.
+
+ do k = 1, pver
+ do i = 1, ncol
+ ! ----------------------------------------------------- !
+ ! Compute the condensate 'qlfd' in the updated profiles !
+ ! ----------------------------------------------------- !
+ ! Option.1 : Assume grid-mean condensate is homogeneously diffused by the moist turbulence scheme.
+ ! This should be used if 'pseudodiff = .false.' in vertical_diffusion.F90.
+ ! Modification : Need to be check whether below is correct in the presence of ice, qi.
+ ! I should understand why the variation of ice, qi is neglected during diffusion.
+ templ = (slfd(i, k) - gravit*z(i, k))/cpair
+ call qsat(templ, pmid(i, k), es, qs)
+ temps = templ + (qtfd(i, k, 1) - qs)/(cpair/latvap + latvap*qs/(rair*templ**2))
+ call qsat(temps, pmid(i, k), es, qs)
+ qlfd(i, k) = max(qtfd(i, k, 1) - qi(i, k) - qs, 0._kind_phys)
+ ! Option.2 : Assume condensate is not diffused by the moist turbulence scheme.
+ ! This should bs used if 'pseudodiff = .true.' in vertical_diffusion.F90.
+ ! qlfd(i,k) = ql(i,k)
+ ! ----------------------------- !
+ ! Compute the other 'qvfd, tfd' !
+ ! ----------------------------- !
+ qvfd(i, k) = max(0._kind_phys, qtfd(i, k, 1) - qi(i, k) - qlfd(i, k))
+ tfd(i, k) = (slfd(i, k) + latvap*qlfd(i, k) + (latvap + latice)*qi(i, k) - gravit*z(i, k))/cpair
+ end do
+ end do
+ end if
+
+ end do iturb_loop ! End of 'iturb' iteration
+
+ kvq(:ncol, :) = kvh(:ncol, :)
+
+ end subroutine bretherton_park_diff_run
+
+end module bretherton_park_diff
diff --git a/schemes/bretherton_park/bretherton_park_diff.meta b/schemes/bretherton_park/bretherton_park_diff.meta
new file mode 100644
index 00000000..bd6d9921
--- /dev/null
+++ b/schemes/bretherton_park/bretherton_park_diff.meta
@@ -0,0 +1,832 @@
+[ccpp-table-properties]
+ name = bretherton_park_diff
+ type = scheme
+ dependencies = eddy_diff.F90, ../phys_utils/atmos_phys_pbl_utils, ../to_be_ccppized/coords_1d.F90, ../to_be_ccppized/wv_saturation.F90
+
+[ccpp-arg-table]
+ name = bretherton_park_diff_init
+ type = scheme
+[ amIRoot ]
+ standard_name = flag_for_mpi_root
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ iulog ]
+ standard_name = log_output_unit
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ gravit ]
+ standard_name = standard_gravitational_acceleration
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ cpair ]
+ standard_name = specific_heat_of_dry_air_at_constant_pressure
+ units = J kg-1 K-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ rair ]
+ standard_name = gas_constant_of_dry_air
+ units = J kg-1 K-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ zvir ]
+ standard_name = ratio_of_water_vapor_to_dry_air_gas_constants_minus_one
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ latvap ]
+ standard_name = latent_heat_of_vaporization_of_water_at_0c
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ latice ]
+ standard_name = latent_heat_of_fusion_of_water_at_0c
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ karman ]
+ standard_name = von_karman_constant
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ ntop_eddy_in ]
+ standard_name = vertical_layer_index_of_eddy_vertical_diffusion_top
+ units = index
+ type = integer
+ dimensions = ()
+ intent = in
+[ pref_mid ]
+ standard_name = reference_pressure_in_atmosphere_layer
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (vertical_layer_dimension)
+ intent = in
+[ eddy_lbulk_max ]
+ standard_name = maximum_master_length_scale_for_eddy_diffusion
+ units = m
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ eddy_leng_max ]
+ standard_name = maximum_dissipation_length_scale_for_eddy_diffusion
+ units = m
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ eddy_max_bot_pressure ]
+ standard_name = air_pressure_threshold_for_maximum_turbulent_length_scale_application
+ units = hPa
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ eddy_moist_entrain_a2l ]
+ standard_name = tunable_parameter_for_moist_entrainment_enhancement_in_pbl
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ ncvmax ]
+ standard_name = maximum_number_of_convective_layers_in_eddy_diffusion
+ units = count
+ type = integer
+ dimensions = ()
+ intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
+
+[ccpp-arg-table]
+ name = bretherton_park_diff_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pverp ]
+ standard_name = vertical_interface_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pcnst ]
+ standard_name = number_of_ccpp_constituents
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ ncvmax ]
+ standard_name = maximum_number_of_convective_layers_in_eddy_diffusion
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ iulog ]
+ standard_name = log_output_unit
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = in
+[ dt ]
+ standard_name = timestep_for_physics
+ units = s
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ const_props ]
+ standard_name = ccpp_constituent_properties
+ units = none
+ type = ccpp_constituent_prop_ptr_t
+ dimensions = (number_of_ccpp_constituents)
+ intent = in
+[ do_iss ]
+ standard_name = do_implicit_total_surface_stress_in_vertical_diffusion
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ am_correction ]
+ standard_name = do_angular_momentum_correction_in_vertical_diffusion
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ do_beljaars ]
+ standard_name = do_beljaars_drag_in_vertical_diffusion_tbd
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ is_first_timestep ]
+ standard_name = is_first_timestep
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ gravit ]
+ standard_name = standard_gravitational_acceleration
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ cpair ]
+ standard_name = specific_heat_of_dry_air_at_constant_pressure
+ units = J kg-1 K-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ rair ]
+ standard_name = gas_constant_of_dry_air
+ units = J kg-1 K-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ latvap ]
+ standard_name = latent_heat_of_vaporization_of_water_at_0c
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ latice ]
+ standard_name = latent_heat_of_fusion_of_water_at_0c
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ t ]
+ standard_name = air_temperature
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ tint ]
+ standard_name = air_temperature_at_interfaces_for_vertical_diffusion
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ qv ]
+ standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water
+ units = kg kg-1
+ advected = True
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ ql ]
+ standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water
+ units = kg kg-1
+ advected = True
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ qi ]
+ standard_name = cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water
+ units = kg kg-1
+ advected = True
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ s ]
+ standard_name = dry_static_energy
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ p ]
+ standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
+ units = none
+ type = coords1d
+ dimensions = ()
+ intent = in
+[ rhoi ]
+ standard_name = air_density_at_interfaces_for_vertical_diffusion
+ units = kg m-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ dpidz_sq ]
+ standard_name = square_of_derivative_of_air_pressure_with_respect_to_height_at_interfaces_for_vertical_diffusion
+ units = kg2 m-4 s-4
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ cldn ]
+ standard_name = stratiform_cloud_area_fraction
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ z ]
+ standard_name = geopotential_height_wrt_surface
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ zi ]
+ standard_name = geopotential_height_wrt_surface_at_interface
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ pmid ]
+ standard_name = air_pressure
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ pint ]
+ standard_name = air_pressure_at_interface
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ u ]
+ standard_name = eastward_wind
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ v ]
+ standard_name = northward_wind
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ taux ]
+ standard_name = surface_eastward_wind_stress_from_coupler
+ units = N m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ tauy ]
+ standard_name = surface_northward_wind_stress_from_coupler
+ units = N m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ shflx ]
+ standard_name = surface_upward_sensible_heat_flux_from_coupler
+ units = W m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ qflx ]
+ standard_name = surface_upward_ccpp_constituent_fluxes_from_coupler
+ units = kg m-2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
+ intent = in
+[ wstarent ]
+ standard_name = use_wstar_entrainment_closure_formulation_for_eddy_diffusion_scheme
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = in
+[ ksrftms ]
+ standard_name = turbulent_orographic_form_drag_coefficent_at_surface
+ units = kg s-1 m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ dragblj ]
+ standard_name = turbulent_orographic_form_drag_coefficent
+ units = s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ qrl ]
+ standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness
+ units = J Pa kg-1 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ wsedl ]
+ standard_name = sedimentation_velocity_of_liquid_stratus_cloud_droplet
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ kvm ]
+ standard_name = eddy_momentum_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = inout
+[ kvh ]
+ standard_name = eddy_heat_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = inout
+[ tauresx ]
+ standard_name = eastward_reserved_stress_at_surface_on_previous_timestep
+ units = N m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = inout
+[ tauresy ]
+ standard_name = northward_reserved_stress_at_surface_on_previous_timestep
+ units = N m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = inout
+[ s2 ]
+ standard_name = square_of_vertical_wind_shear
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ n2 ]
+ standard_name = squared_buoyancy_frequency
+ long_name = Square of Brunt-Vaisala frequency
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ ri ]
+ standard_name = gradient_richardson_number
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ kvq ]
+ standard_name = eddy_constituent_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ rrho ]
+ standard_name = reciprocal_of_dry_air_density_of_bottom_layer
+ units = m3 kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ ustar ]
+ standard_name = surface_friction_velocity
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ pblh ]
+ standard_name = atmosphere_boundary_layer_thickness
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ pblhp ]
+ standard_name = air_pressure_at_top_of_atmosphere_boundary_layer
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ minpblh ]
+ standard_name = minimum_atmosphere_boundary_layer_thickness
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ cgh ]
+ standard_name = counter_gradient_coefficient_for_vertical_diffusion_of_heat_at_interfaces
+ units = J kg-1 m-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ cgs ]
+ standard_name = counter_gradient_coefficient_for_vertical_diffusion_of_constituents_at_interfaces
+ units = s m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ tpert ]
+ standard_name = convective_temperature_perturbation_due_to_pbl_eddies
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ qpert ]
+ standard_name = convective_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_perturbation_due_to_pbl_eddies
+ units = kg kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ wpert ]
+ standard_name = turbulent_vertical_velocity_excess
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ tke ]
+ standard_name = tke_at_interfaces
+ long_name = specific Turbulent Kinetic Energy (TKE) at vertical interfaces
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ tkes ]
+ standard_name = tke_at_surface
+ long_name = specific Turbulent Kinetic Energy (TKE) at surface
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ wcap ]
+ standard_name = normalized_tke_at_interfaces
+ long_name = normalized specific Turbulent Kinetic Energy (TKE) at vertical interfaces
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ wsed ]
+ standard_name = sedimentation_velocity_of_liquid_stratus_cloud_droplet_at_top_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ turbtype ]
+ standard_name = atmosphere_turbulence_type_at_interfaces
+ units = 1
+ type = integer
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ bprod ]
+ standard_name = tke_production_due_to_buoyancy
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ sprod ]
+ standard_name = tke_production_due_to_vertical_shear
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ sfi ]
+ standard_name = water_vapor_saturation_fraction_at_interfaces
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ sfuh ]
+ standard_name = water_vapor_saturation_fraction_at_upper_half_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ sflh ]
+ standard_name = water_vapor_saturation_fraction_at_lower_half_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ qlfd ]
+ standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_for_eddy_diffusion
+ units = kg kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ chu ]
+ standard_name = heat_buoyancy_coefficient_for_unsaturated_air
+ units = m s-2 kg J-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ chs ]
+ standard_name = heat_buoyancy_coefficient_for_saturated_air
+ units = m s-2 kg J-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ cmu ]
+ standard_name = moisture_buoyancy_coefficient_for_unsaturated_air
+ units = m s-2 kg-1 kg
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ cms ]
+ standard_name = moisture_buoyancy_coefficient_for_saturated_air
+ units = m s-2 kg-1 kg
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ kbase_o ]
+ standard_name = vertical_index_at_bottom_of_initial_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ktop_o ]
+ standard_name = vertical_index_at_top_of_initial_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ncvfin_o ]
+ standard_name = number_of_initial_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ kbase_mg ]
+ # after extending-merging (zisocl) but without SRCLs (single-layer radiatively-driven cloud-topped convective layers)
+ standard_name = vertical_index_at_bottom_of_merged_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ktop_mg ]
+ standard_name = vertical_index_at_top_of_merged_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ncvfin_mg ]
+ standard_name = number_of_merged_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ kbase_f ]
+ # after adding SRCLs
+ standard_name = vertical_index_at_bottom_of_final_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ktop_f ]
+ standard_name = vertical_index_at_top_of_final_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ncvfin_f ]
+ standard_name = number_of_final_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ wet ]
+ standard_name = entrainment_rate_at_top_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ web ]
+ standard_name = entrainment_rate_at_bottom_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ jtbu ]
+ standard_name = buoyancy_jump_at_top_of_convective_layer
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ jbbu ]
+ standard_name = buoyancy_jump_at_bottom_of_convective_layer
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ evhc ]
+ standard_name = evaporative_enhancement_factor_at_top_of_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ jt2slv ]
+ standard_name = liquid_water_virtual_static_energy_jump_at_top_of_convective_layer
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ n2ht ]
+ standard_name = squared_buoyancy_frequency_at_top_of_convective_layer
+ long_name = squared Brunt-Vaisala frequency at top of convective layer
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ n2hb ]
+ standard_name = standard_name = squared_buoyancy_frequency_at_bottom_of_convective_layer
+ long_name = squared Brunt-Vaisala frequency at bottom of convective layer
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ lwp ]
+ standard_name = liquid_water_path_at_top_of_convective_layer
+ units = kg m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ opt_depth ]
+ standard_name = atmosphere_optical_depth_at_top_of_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ radinvfrac ]
+ standard_name = fraction_of_longwave_radiative_cooling_at_top_of_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ radf ]
+ standard_name = specific_eddy_kinetic_energy_buoyancy_production_due_to_longwave_radiative_cooling_at_top_of_convective_layer
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ wstar ]
+ standard_name = convective_velocity_scale_in_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ wstar3fact ]
+ standard_name = reciprocal_of_entrainment_enhancement_factor_of_convective_velocity_scale_cubed_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ebrk ]
+ standard_name = tke_in_convective_layer
+ long_name = specific Turbulent Kinetic Energy (TKE) in convective layer
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ wbrk ]
+ standard_name = normalized_tke_in_convective_layer
+ long_name = normalized specific Turbulent Kinetic Energy (TKE) in convective layer
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ lbrk ]
+ standard_name = energetic_thickness_of_convective_layer
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ricl ]
+ standard_name = bulk_richardson_number_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ghcl ]
+ standard_name = normalized_tke_production_due_to_buoyancy_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ shcl ]
+ standard_name = galperin_instability_function_for_heat_and_moisture_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ smcl ]
+ standard_name = galperin_instability_function_for_momentum_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = out
+[ ghi ]
+ standard_name = normalized_tke_production_due_to_buoyancy_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ shi ]
+ standard_name = galperin_instability_function_for_heat_and_moisture_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ smi ]
+ standard_name = galperin_instability_function_for_momentum_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ rii ]
+ standard_name = gradient_richardson_number_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ lengi ]
+ standard_name = turbulent_mixing_length_at_interfaces
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = out
+[ errorPBL ]
+ standard_name = atmosphere_boundary_layer_convergence_indicator
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+# these are for the diffusion solver to compute implicit surface stress.
+# for UW PBL, this is taux = wsx; tauy = wsy
+# currently handled by hb_prepare_vertical_diffusion_inputs run phase.
+#[ taux ]
+# standard_name = eastward_stress_at_surface_for_vertical_diffusion
+# units = N m-2
+# type = real | kind = kind_phys
+# dimensions = (horizontal_loop_extent)
+# intent = out
+#[ tauy ]
+# standard_name = northward_stress_at_surface_for_vertical_diffusion
+# units = N m-2
+# type = real | kind = kind_phys
+# dimensions = (horizontal_loop_extent)
+# intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
diff --git a/schemes/bretherton_park/bretherton_park_diff_namelist.xml b/schemes/bretherton_park/bretherton_park_diff_namelist.xml
new file mode 100644
index 00000000..756eaab1
--- /dev/null
+++ b/schemes/bretherton_park/bretherton_park_diff_namelist.xml
@@ -0,0 +1,160 @@
+
+
+
+
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_nl
+ maximum_master_length_scale_for_eddy_diffusion
+ m
+
+ Maximum master length scale designed to address issues in diag_TKE (the Bretherton-Park scheme) outside the boundary layer. In order not to disturb turbulence characteristics in the lower troposphere, this should be set at least larger than a few km. However, this does not significantly improve the values outside of the boundary layer. Smaller values make some improvement, but it is also noisy. Better results are seen using eddy_leng_max or kv_freetrop_scale.
+ Default: 40000 m
+
+
+ 40.D3
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_nl
+ maximum_dissipation_length_scale_for_eddy_diffusion
+ m
+
+ Maximum dissipation length scale designed to address issues with diag_TKE (the Bretherton-Park scheme) outside the boundary layer, where the default value generates large diffusivities. A value of 30 m is consistent with the length scales used in the HB scheme; however, this will also reduce value in the boundary layer.
+ Default: 40000 m
+
+
+ 40.D3
+
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_nl
+ air_pressure_threshold_for_maximum_turbulent_length_scale_application
+ hPa
+
+ Bottom pressure level at which namelist values for eddy_leng_max and eddy_lbulk_max are applied. Default values are used at lower levels (i.e. the boundary layer).
+ Default: 100.D3 hPa
+
+
+ 100.D3
+
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_nl
+ tunable_parameter_for_moist_entrainment_enhancement_in_pbl
+ 1
+
+ Moist entrainment enhancement parameter. Default: 30.D0
+
+
+ 30.D0
+
+
+
+
+ logical
+ pbl
+ eddy_diff_nl
+ use_wstar_entrainment_closure_formulation_for_eddy_diffusion_scheme
+ flag
+
+ Use wstar (.true.) or TKE (.false.) entrainment closure in UW eddy diffusion scheme.
+ Default: TRUE
+
+
+ .true.
+
+
+
+
+
+
diff --git a/schemes/bretherton_park/eddy_diff.F90 b/schemes/bretherton_park/eddy_diff.F90
new file mode 100644
index 00000000..91339b65
--- /dev/null
+++ b/schemes/bretherton_park/eddy_diff.F90
@@ -0,0 +1,3388 @@
+module eddy_diff
+
+ !--------------------------------------------------------------------------------- !
+ ! !
+ ! The University of Washington Moist Turbulence Scheme to compute eddy diffusion !
+ ! coefficients associated with dry and moist turbulences in the whole !
+ ! atmospheric layers. !
+ ! !
+ ! For detailed description of the code and its performances, see !
+ ! !
+ ! 1.'A new moist turbulence parametrization in the Community Atmosphere Model' !
+ ! by Christopher S. Bretherton and Sungsu Park. J. Climate. 2009. 22. 3422-3448 !
+ ! 2.'The University of Washington shallow convection and moist turbulence schemes !
+ ! and their impact on climate simulations with the Community Atmosphere Model' !
+ ! by Sungsu Park and Christopher S. Bretherton. J. Climate. 2009. 22. 3449-3469 !
+ ! !
+ ! For questions on the scheme and code, send an email to !
+ ! Sungsu Park at sungsup@ucar.edu (tel: 303-497-1375) !
+ ! Chris Bretherton at breth@washington.edu !
+ ! !
+ ! Developed by Chris Bretherton at the University of Washington, Seattle, WA. !
+ ! Sungsu Park at the CGD/NCAR, Boulder, CO. !
+ ! Last coded on May.2006, Dec.2009 by Sungsu Park. !
+ ! !
+ !--------------------------------------------------------------------------------- !
+
+ use ccpp_kinds, only: kind_phys
+
+ implicit none
+ private
+
+ public :: init_eddy_diff
+ public :: trbintd
+ public :: caleddy
+
+ integer, parameter :: i4 = selected_int_kind( 6) ! 4 byte integer
+
+ ! --------------------------------- !
+ ! PBL Parameters used in the UW PBL !
+ ! --------------------------------- !
+
+ character, parameter :: sftype = 'l' ! Method for calculating saturation fraction
+
+ character(len=4), parameter :: choice_evhc = 'maxi' ! 'orig', 'ramp', 'maxi' : recommended to be used with choice_radf
+ character(len=6), parameter :: choice_radf = 'maxi' ! 'orig', 'ramp', 'maxi' : recommended to be used with choice_evhc
+ character(len=6), parameter :: choice_SRCL = 'nonamb' ! 'origin', 'remove', 'nonamb'
+
+ character(len=6), parameter :: choice_tunl = 'rampcl' ! 'origin', 'rampsl'(Sungsu), 'rampcl'(Chris)
+ real(kind_phys), parameter :: ctunl = 2._kind_phys ! Maximum asympt leng = ctunl*tunl when choice_tunl = 'rampsl(cl)'
+ ! [ no unit ]
+ character(len=6), parameter :: choice_leng = 'origin' ! 'origin', 'takemn'
+ real(kind_phys), parameter :: cleng = 3._kind_phys ! Order of 'leng' when choice_leng = 'origin' [ no unit ]
+ character(len=6), parameter :: choice_tkes = 'ibprod' ! 'ibprod' (include tkes in computing bprod), 'ebprod'(exclude)
+
+ real(kind_phys) :: lbulk_max = 40.e3_kind_phys ! Maximum master length scale designed to address issues in the
+ ! upper atmosphere where vertical model resolution is coarse [ m ].
+ ! In order not to disturb turbulence characteristics in the lower
+ ! troposphere, this should be set at least larger than ~ a few km.
+ real(kind_phys), allocatable :: leng_max(:) ! Maximum length scale designed to address issues in the upper
+ ! atmosphere.
+
+ ! Parameters for 'sedimentation-entrainment feedback' for liquid stratus
+ ! If .false., no sedimentation entrainment feedback ( i.e., use default evhc )
+
+ logical, parameter :: id_sedfact = .false.
+ real(kind_phys), parameter :: ased = 9._kind_phys ! Valid only when id_sedfact = .true.
+
+ ! --------------------------------------------------------------------------------------------------- !
+ ! Parameters governing entrainment efficiency A = a1l(i)*evhc, evhc = 1 + a2l * a3l * L * ql / jt2slv !
+ ! Here, 'ql' is cloud-top LWC and 'jt2slv' is the jump in 'slv' across !
+ ! the cloud-top entrainment zone ( across two grid layers to consider full mixture ) !
+ ! --------------------------------------------------------------------------------------------------- !
+
+ real(kind_phys), parameter :: a1l = 0.10_kind_phys ! Dry entrainment efficiency for TKE closure
+ ! a1l = 0.2*tunl*erat^-1.5,
+ ! where erat = /wstar^2 for dry CBL = 0.3.
+
+ real(kind_phys), parameter :: a1i = 0.2_kind_phys ! Dry entrainment efficiency for wstar closure
+ real(kind_phys), parameter :: ccrit = 0.5_kind_phys ! Minimum allowable sqrt(tke)/wstar.
+ ! Used in solving cubic equation for 'ebrk'
+ real(kind_phys), parameter :: wstar3factcrit = 0.5_kind_phys ! 1/wstar3factcrit is the maximally allowed enhancement of
+ ! 'wstar3' due to entrainment.
+
+ real(kind_phys) :: a2l ! Moist entrainment enhancement param (recommended range : 10~30 )
+ real(kind_phys), parameter :: a3l = 0.8_kind_phys ! Approximation to a complicated thermodynamic parameters
+
+ real(kind_phys), parameter :: jbumin = .001_kind_phys ! Minimum buoyancy jump at an entrainment jump, [m/s2]
+ real(kind_phys), parameter :: evhcmax = 10._kind_phys ! Upper limit of evaporative enhancement factor
+
+ real(kind_phys), parameter :: onet = 1._kind_phys/3._kind_phys ! 1/3 power in wind gradient expression [ no unit ]
+ integer :: ncvmax ! Max numbers of CLs (good to set to 'pver')
+ real(kind_phys), parameter :: qmin = 1.e-5_kind_phys ! Minimum grid-mean LWC counted as clouds [kg/kg]
+ real(kind_phys), parameter :: ntzero = 1.e-12_kind_phys ! Not zero (small positive number used in 's2')
+ real(kind_phys), parameter :: b1 = 5.8_kind_phys ! TKE dissipation D = e^3/(b1*leng), e = b1*W.
+ real(kind_phys) :: b123 ! b1**(2/3)
+ real(kind_phys), parameter :: tunl = 0.085_kind_phys ! Asympt leng = tunl*(turb lay depth)
+ real(kind_phys), parameter :: alph1 = 0.5562_kind_phys ! alph1~alph5 : Galperin instability function parameters
+ real(kind_phys), parameter :: alph2 = -4.3640_kind_phys ! These coefficients are used to calculate
+ real(kind_phys), parameter :: alph3 = -34.6764_kind_phys ! 'sh' and 'sm' from 'gh'.
+ real(kind_phys), parameter :: alph4 = -6.1272_kind_phys !
+ real(kind_phys), parameter :: alph5 = 0.6986_kind_phys !
+ real(kind_phys), parameter :: ricrit = 0.19_kind_phys ! Critical Richardson number for turbulence.
+ ! Can be any value >= 0.19.
+ real(kind_phys), parameter :: ae = 1._kind_phys ! TKE transport efficiency [no unit]
+ real(kind_phys), parameter :: rinc = -0.04_kind_phys ! Minimum W/ used for CL merging test
+ real(kind_phys), parameter :: wpertmin = 1.e-6_kind_phys ! Minimum PBL eddy vertical velocity perturbation
+ real(kind_phys), parameter :: wfac = 1._kind_phys ! Ratio of 'wpert' to sqrt(tke) for CL.
+ real(kind_phys), parameter :: tfac = 1._kind_phys ! Ratio of 'tpert' to (w't')/wpert for CL.
+ ! Same ratio also used for q
+ real(kind_phys), parameter :: fak = 8.5_kind_phys ! Constant in surface temperature excess for stable STL.
+ ! [ no unit ]
+ real(kind_phys), parameter :: rcapmin = 0.1_kind_phys ! Minimum allowable e/ in a CL
+ real(kind_phys), parameter :: rcapmax = 2.0_kind_phys ! Maximum allowable e/ in a CL
+ real(kind_phys), parameter :: tkemax = 20._kind_phys ! TKE is capped at tkemax [m2/s2]
+
+ logical, parameter :: use_dw_surf = .true. ! Used in 'zisocl'. Default is 'true'
+ ! If 'true', surface interfacial energy does not contribute
+ ! to the CL mean stability functions after finishing merging.
+ ! For this case, 'dl2n2_surf' is only used for a merging test
+ ! based on 'l2n2'
+ ! If 'false',surface interfacial enery explicitly contribute to
+ ! CL mean stability functions after finishing merging.
+ ! For this case, 'dl2n2_surf' and 'dl2s2_surf' are directly used
+ ! for calculating surface interfacial layer energetics
+
+ logical, parameter :: set_qrlzero = .false. ! .true. ( .false.) : turning-off ( on) radiative-turbulence
+ ! interaction by setting qrl = 0.
+
+ ! ------------------------------------------------------- !
+ ! PBL constants set using values from other parts of code !
+ ! ------------------------------------------------------- !
+
+ real(kind_phys) :: cpair ! Specific heat of dry air
+ real(kind_phys) :: rair ! Gas const for dry air
+ real(kind_phys) :: zvir ! rh2o/rair - 1
+ real(kind_phys) :: latvap ! Latent heat of vaporization
+ real(kind_phys) :: latice ! Latent heat of fusion
+ real(kind_phys) :: latsub ! Latent heat of sublimation
+ real(kind_phys) :: g ! Gravitational acceleration
+ real(kind_phys) :: vk ! Von Karman's constant
+
+ integer :: ntop_turb ! Top interface level to which turbulent vertical diffusion
+ ! is applied ( = 1 )
+ integer :: nbot_turb ! Bottom interface level to which turbulent vertical diff
+ ! is applied ( = pver )
+
+contains
+
+ !============================================================================ !
+ ! !
+ !============================================================================ !
+
+ subroutine init_eddy_diff( pver, ncvmax_in, gravx, cpairx, rairx, zvirx, &
+ latvapx, laticex, ntop_eddy, nbot_eddy, vkx, &
+ eddy_lbulk_max, leng_max_in, &
+ eddy_moist_entrain_a2l, errstring)
+ !---------------------------------------------------------------- !
+ ! Purpose: !
+ ! Initialize time independent constants/variables of PBL package. !
+ !---------------------------------------------------------------- !
+
+ use wv_saturation, only: qsat
+
+ ! --------- !
+ ! Arguments !
+ ! --------- !
+ integer, intent(in) :: pver ! Number of vertical layers
+ integer, intent(in) :: ncvmax_in
+ integer, intent(in) :: ntop_eddy ! Top interface level to which eddy vertical diffusivity is applied ( = 1 )
+ integer, intent(in) :: nbot_eddy ! Bottom interface level to which eddy vertical diffusivity is applied ( = pver )
+ real(kind_phys), intent(in) :: gravx ! Acceleration of gravity
+ real(kind_phys), intent(in) :: cpairx ! Specific heat of dry air
+ real(kind_phys), intent(in) :: rairx ! Gas constant for dry air
+ real(kind_phys), intent(in) :: zvirx ! rh2o/rair - 1
+ real(kind_phys), intent(in) :: latvapx ! Latent heat of vaporization
+ real(kind_phys), intent(in) :: laticex ! Latent heat of fusion
+ real(kind_phys), intent(in) :: vkx ! Von Karman's constant
+ real(kind_phys), intent(in) :: eddy_lbulk_max ! Maximum master length scale
+ real(kind_phys), intent(in) :: leng_max_in(pver) ! Maximum length scale for upper atmosphere
+ real(kind_phys), intent(in) :: eddy_moist_entrain_a2l ! Moist entrainment enhancement param
+
+ character(len=*), intent(out) :: errstring
+
+ integer :: k ! Vertical loop index
+
+ errstring = ""
+
+ ! --------------- !
+ ! Basic constants !
+ ! --------------- !
+
+ ncvmax = ncvmax_in
+
+ cpair = cpairx
+ rair = rairx
+ g = gravx
+ zvir = zvirx
+ latvap = latvapx
+ latice = laticex
+ latsub = latvap + latice
+ vk = vkx
+ ntop_turb = ntop_eddy
+ nbot_turb = nbot_eddy
+ b123 = b1**(2._kind_phys/3._kind_phys)
+ a2l = eddy_moist_entrain_a2l
+
+ lbulk_max = eddy_lbulk_max
+
+ allocate(leng_max(pver))
+ leng_max = leng_max_in
+
+ end subroutine init_eddy_diff
+
+ !=============================================================================== !
+ ! !
+ !=============================================================================== !
+
+ subroutine sfdiag( ncol , pver , qt , ql , sl , &
+ pi , pm , zi , cld , sfi , sfuh , &
+ sflh , slslope , qtslope )
+ !----------------------------------------------------------------------- !
+ ! !
+ ! Purpose: Interface for calculating saturation fractions at upper and !
+ ! lower-half layers, & interfaces for use by turbulence scheme !
+ ! !
+ ! Method : Various but 'l' should be chosen for consistency. !
+ ! !
+ ! Author : B. Stevens and C. Bretherton (August 2000) !
+ ! Sungsu Park. August 2006. !
+ ! May. 2008. !
+ ! !
+ ! S.Park : The computed saturation fractions are repeatedly !
+ ! used to compute buoyancy coefficients in'trbintd' & 'caleddy'.!
+ !----------------------------------------------------------------------- !
+
+ use wv_saturation, only: qsat
+
+ ! --------------- !
+ ! Input arguments !
+ ! --------------- !
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+
+ real(kind_phys), intent(in) :: sl(ncol,pver) ! Liquid water static energy [ J/kg ]
+ real(kind_phys), intent(in) :: qt(ncol,pver) ! Total water specific humidity [ kg/kg ]
+ real(kind_phys), intent(in) :: ql(ncol,pver) ! Liquid water specific humidity [ kg/kg ]
+ real(kind_phys), intent(in) :: pi(ncol,pver+1) ! Interface pressures [ Pa ]
+ real(kind_phys), intent(in) :: pm(ncol,pver) ! Layer mid-point pressures [ Pa ]
+ real(kind_phys), intent(in) :: zi(ncol,pver+1) ! Interface heights [ m ]
+ real(kind_phys), intent(in) :: cld(ncol,pver) ! Stratiform cloud fraction [ fraction ]
+ real(kind_phys), intent(in) :: slslope(ncol,pver) ! Slope of 'sl' in each layer
+ real(kind_phys), intent(in) :: qtslope(ncol,pver) ! Slope of 'qt' in each layer
+
+ ! ---------------- !
+ ! Output arguments !
+ ! ---------------- !
+
+ real(kind_phys), intent(out) :: sfi(ncol,pver+1) ! Interfacial layer saturation fraction [ fraction ]
+ real(kind_phys), intent(out) :: sfuh(ncol,pver) ! Saturation fraction in upper half-layer [ fraction ]
+ real(kind_phys), intent(out) :: sflh(ncol,pver) ! Saturation fraction in lower half-layer [ fraction ]
+
+ ! --------------- !
+ ! Local Variables !
+ ! --------------- !
+
+ integer :: i ! Longitude index
+ integer :: k ! Vertical index
+ integer :: km1 ! k-1
+ integer :: status ! Status returned by function calls
+ real(kind_phys) :: sltop, slbot ! sl at top/bot of grid layer
+ real(kind_phys) :: qttop, qtbot ! qt at top/bot of grid layer
+ real(kind_phys) :: tltop, tlbot ! Liquid water temperature at top/bot of grid layer
+ real(kind_phys) :: qxtop, qxbot ! Sat excess at top/bot of grid layer
+ real(kind_phys) :: qxm ! Sat excess at midpoint
+ real(kind_phys) :: es ! Saturation vapor pressure
+ real(kind_phys) :: qs ! Saturation spec. humidity
+ real(kind_phys) :: cldeff(ncol,pver) ! Effective Cloud Fraction [ fraction ]
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ sfi(1:ncol,:) = 0._kind_phys
+ sfuh(1:ncol,:) = 0._kind_phys
+ sflh(1:ncol,:) = 0._kind_phys
+ cldeff(1:ncol,:) = 0._kind_phys
+
+ select case (sftype)
+ case ('d')
+ ! ----------------------------------------------------------------------- !
+ ! Simply use the given stratus fraction ('horizontal' cloud partitioning) !
+ ! ----------------------------------------------------------------------- !
+ do k = ntop_turb + 1, nbot_turb
+ km1 = k - 1
+ do i = 1, ncol
+ sfuh(i,k) = cld(i,k)
+ sflh(i,k) = cld(i,k)
+ sfi(i,k) = 0.5_kind_phys * ( sflh(i,km1) + min( sflh(i,km1), sfuh(i,k) ) )
+ end do
+ end do
+ do i = 1, ncol
+ sfi(i,pver+1) = sflh(i,pver)
+ end do
+ case ('l')
+ ! ------------------------------------------ !
+ ! Use modified stratus fraction partitioning !
+ ! ------------------------------------------ !
+ do k = ntop_turb + 1, nbot_turb
+ km1 = k - 1
+ do i = 1, ncol
+ cldeff(i,k) = cld(i,k)
+ sfuh(i,k) = cld(i,k)
+ sflh(i,k) = cld(i,k)
+ if( ql(i,k) .lt. qmin ) then
+ sfuh(i,k) = 0._kind_phys
+ sflh(i,k) = 0._kind_phys
+ end if
+ ! Modification : The contribution of ice should be carefully considered.
+ if( choice_evhc .eq. 'ramp' .or. choice_radf .eq. 'ramp' ) then
+ cldeff(i,k) = cld(i,k) * min( ql(i,k) / qmin, 1._kind_phys )
+ sfuh(i,k) = cldeff(i,k)
+ sflh(i,k) = cldeff(i,k)
+ elseif( choice_evhc .eq. 'maxi' .or. choice_radf .eq. 'maxi' ) then
+ cldeff(i,k) = cld(i,k)
+ sfuh(i,k) = cldeff(i,k)
+ sflh(i,k) = cldeff(i,k)
+ endif
+ ! At the stratus top, take the minimum interfacial saturation fraction
+ sfi(i,k) = 0.5_kind_phys * ( sflh(i,km1) + min( sfuh(i,k), sflh(i,km1) ) )
+ ! Modification : Currently sfi at the top and surface interfaces are set to be zero.
+ ! Also, sfuh and sflh in the top model layer is set to be zero.
+ ! However, I may need to set
+ ! do i = 1, ncol
+ ! sfi(i,pver+1) = sflh(i,pver)
+ ! end do
+ ! for treating surface-based fog.
+ ! OK. I added below block similar to the other cases.
+ end do
+ end do
+ do i = 1, ncol
+ sfi(i,pver+1) = sflh(i,pver)
+ end do
+ case ('u')
+ ! ------------------------------------------------------------------------- !
+ ! Use unsaturated buoyancy - since sfi, sfuh, sflh have already been zeroed !
+ ! nothing more need be done for this case. !
+ ! ------------------------------------------------------------------------- !
+ case ('z')
+ ! ------------------------------------------------------------------------- !
+ ! Calculate saturation fraction based on whether the air just above or just !
+ ! below the interface is saturated, i.e. with vertical cloud partitioning. !
+ ! The saturation fraction of the interfacial layer between mid-points k and !
+ ! k+1 is computed by averaging the saturation fraction of the half-layers !
+ ! above and below the interface, with a special provision for cloud tops !
+ ! (more cloud in the half-layer below than in the half-layer above).In each !
+ ! half-layer, vertical partitioning of cloud based on the slopes diagnosed !
+ ! above is used. Loop down through the layers, computing the saturation !
+ ! fraction in each half-layer (sfuh for upper half, sflh for lower half). !
+ ! Once sfuh(i,k) is computed, use with sflh(i,k-1) to determine saturation !
+ ! fraction sfi(i,k) for interfacial layer k-0.5. !
+ ! This is 'not' chosen for full consistent treatment of stratus fraction in !
+ ! all physics schemes. !
+ ! ------------------------------------------------------------------------- !
+ do k = ntop_turb + 1, nbot_turb
+ km1 = k - 1
+ do i = 1, ncol
+ ! Compute saturation excess at the mid-point of layer k
+ sltop = sl(i,k) + slslope(i,k) * ( pi(i,k) - pm(i,k) )
+ qttop = qt(i,k) + qtslope(i,k) * ( pi(i,k) - pm(i,k) )
+ tltop = ( sltop - g * zi(i,k) ) / cpair
+ call qsat( tltop, pi(i,k), es, qs)
+ qxtop = qttop - qs
+ slbot = sl(i,k) + slslope(i,k) * ( pi(i,k+1) - pm(i,k) )
+ qtbot = qt(i,k) + qtslope(i,k) * ( pi(i,k+1) - pm(i,k) )
+ tlbot = ( slbot - g * zi(i,k+1) ) / cpair
+ call qsat( tlbot, pi(i,k+1), es, qs)
+ qxbot = qtbot - qs
+ qxm = qxtop + ( qxbot - qxtop ) * ( pm(i,k) - pi(i,k) ) / ( pi(i,k+1) - pi(i,k) )
+ ! Find the saturation fraction sfuh(i,k) of the upper half of layer k.
+ if( ( qxtop .lt. 0._kind_phys ) .and. ( qxm .lt. 0._kind_phys ) ) then
+ sfuh(i,k) = 0._kind_phys
+ else if( ( qxtop .gt. 0._kind_phys ) .and. ( qxm .gt. 0._kind_phys ) ) then
+ sfuh(i,k) = 1._kind_phys
+ else ! Either qxm < 0 and qxtop > 0 or vice versa
+ sfuh(i,k) = max( qxtop, qxm ) / abs( qxtop - qxm )
+ end if
+ ! Combine with sflh(i) (still for layer k-1) to get interfac layer saturation fraction
+ sfi(i,k) = 0.5_kind_phys * ( sflh(i,k-1) + min( sflh(i,k-1), sfuh(i,k) ) )
+ ! Update sflh to be for the lower half of layer k.
+ if( ( qxbot .lt. 0._kind_phys ) .and. ( qxm .lt. 0._kind_phys ) ) then
+ sflh(i,k) = 0._kind_phys
+ else if( ( qxbot .gt. 0._kind_phys ) .and. ( qxm .gt. 0._kind_phys ) ) then
+ sflh(i,k) = 1._kind_phys
+ else ! Either qxm < 0 and qxbot > 0 or vice versa
+ sflh(i,k) = max( qxbot, qxm ) / abs( qxbot - qxm )
+ end if
+ end do ! i
+ end do ! k
+ do i = 1, ncol
+ sfi(i,pver+1) = sflh(i,pver) ! Saturation fraction in the lowest half-layer.
+ end do
+ end select
+
+ return
+ end subroutine sfdiag
+
+ !=============================================================================== !
+ ! !
+ !=============================================================================== !
+
+ subroutine trbintd( ncol , pver , &
+ z , u , v , &
+ t , pmid , &
+ s2 , n2 , ri , &
+ zi , pi , cld , &
+ qt , qv , ql , qi , sfi , sfuh , &
+ sflh , sl , slv , slslope , qtslope , &
+ chs , chu , cms , cmu )
+ !----------------------------------------------------------------------- !
+ ! Purpose: Calculate buoyancy coefficients at all interfaces including !
+ ! surface. Also, computes the profiles of ( sl,qt,n2,s2,ri ). !
+ ! Note that (n2,s2,ri) are defined at each interfaces except !
+ ! surface. !
+ ! !
+ ! Author: B. Stevens ( Extracted from pbldiff, August, 2000 ) !
+ ! Sungsu Park ( August 2006, May. 2008 ) !
+ !----------------------------------------------------------------------- !
+
+ use wv_saturation, only: qsat
+
+ ! --------------- !
+ ! Input arguments !
+ ! --------------- !
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ real(kind_phys), intent(in) :: z(ncol,pver) ! Layer mid-point height above surface [ m ]
+ real(kind_phys), intent(in) :: u(ncol,pver) ! Layer mid-point u [ m/s ]
+ real(kind_phys), intent(in) :: v(ncol,pver) ! Layer mid-point v [ m/s ]
+ real(kind_phys), intent(in) :: t(ncol,pver) ! Layer mid-point temperature [ K ]
+ real(kind_phys), intent(in) :: pmid(ncol,pver) ! Layer mid-point pressure [ Pa ]
+ real(kind_phys), intent(in) :: zi(ncol,pver+1) ! Interface height [ m ]
+ real(kind_phys), intent(in) :: pi(ncol,pver+1) ! Interface pressure [ Pa ]
+ real(kind_phys), intent(in) :: cld(ncol,pver) ! Stratus fraction
+ real(kind_phys), intent(in) :: qv(ncol,pver) ! Water vapor specific humidity [ kg/kg ]
+ real(kind_phys), intent(in) :: ql(ncol,pver) ! Liquid water specific humidity [ kg/kg ]
+ real(kind_phys), intent(in) :: qi(ncol,pver) ! Ice water specific humidity [ kg/kg ]
+
+ ! ---------------- !
+ ! Output arguments !
+ ! ---------------- !
+
+ real(kind_phys), intent(out) :: s2(ncol,pver) ! Interfacial ( except surface ) shear squared [ s-2 ]
+ real(kind_phys), intent(out) :: n2(ncol,pver) ! Interfacial ( except surface ) buoyancy frequency [ s-2 ]
+ real(kind_phys), intent(out) :: ri(ncol,pver) ! Interfacial ( except surface ) Richardson number, 'n2/s2'
+
+ real(kind_phys), intent(out) :: qt(ncol,pver) ! Total specific humidity [ kg/kg ]
+ real(kind_phys), intent(out) :: sfi(ncol,pver+1) ! Interfacial layer saturation fraction [ fraction ]
+ real(kind_phys), intent(out) :: sfuh(ncol,pver) ! Saturation fraction in upper half-layer [ fraction ]
+ real(kind_phys), intent(out) :: sflh(ncol,pver) ! Saturation fraction in lower half-layer [ fraction ]
+ real(kind_phys), intent(out) :: sl(ncol,pver) ! Liquid water static energy [ J/kg ]
+ real(kind_phys), intent(out) :: slv(ncol,pver) ! Liquid water virtual static energy [ J/kg ]
+
+ real(kind_phys), intent(out) :: chu(ncol,pver+1) ! Heat buoyancy coef for dry states at all interfaces, finally. [m s-2 kg J-1]
+ real(kind_phys), intent(out) :: chs(ncol,pver+1) ! heat buoyancy coef for sat states at all interfaces, finally. [m s-2 kg J-1]
+ real(kind_phys), intent(out) :: cmu(ncol,pver+1) ! Moisture buoyancy coef for dry states at all interfaces, finally. [m s-2 kg-1 kg]
+ real(kind_phys), intent(out) :: cms(ncol,pver+1) ! Moisture buoyancy coef for sat states at all interfaces, finally. [m s-2 kg-1 kg]
+ real(kind_phys), intent(out) :: slslope(ncol,pver) ! Slope of 'sl' in each layer
+ real(kind_phys), intent(out) :: qtslope(ncol,pver) ! Slope of 'qt' in each layer
+
+ ! --------------- !
+ ! Local Variables !
+ ! --------------- !
+
+ integer :: i ! Longitude index
+ integer :: k, km1 ! Level index
+ integer :: status ! Status returned by function calls
+
+ real(kind_phys) :: qs(ncol,pver) ! Saturation specific humidity
+ real(kind_phys) :: es(ncol,pver) ! Saturation vapor pressure
+ real(kind_phys) :: gam(ncol,pver) ! (l/cp)*(d(qs)/dT)
+ real(kind_phys) :: rdz ! 1 / (delta z) between midpoints
+ real(kind_phys) :: dsldz ! 'delta sl / delta z' at interface
+ real(kind_phys) :: dqtdz ! 'delta qt / delta z' at interface
+ real(kind_phys) :: ch ! 'sfi' weighted ch at the interface
+ real(kind_phys) :: cm ! 'sfi' weighted cm at the interface
+ real(kind_phys) :: bfact ! Buoyancy factor in n2 calculations
+ real(kind_phys) :: product ! Intermediate vars used to find slopes
+ real(kind_phys) :: dsldp_a, dqtdp_a ! Slopes across interface above
+ real(kind_phys) :: dsldp_b(ncol), dqtdp_b(ncol) ! Slopes across interface below
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ ! Calculate conservative scalars (qt,sl,slv) and buoyancy coefficients at the layer mid-points.
+ ! Note that 'ntop_turb = 1', 'nbot_turb = pver'
+ do k = ntop_turb, nbot_turb
+ call qsat( t(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol, gam=gam(1:ncol,k))
+ do i = 1, ncol
+ qt(i,k) = qv(i,k) + ql(i,k) + qi(i,k)
+ sl(i,k) = cpair * t(i,k) + g * z(i,k) - latvap * ql(i,k) - latsub * qi(i,k)
+ slv(i,k) = sl(i,k) * ( 1._kind_phys + zvir * qt(i,k) )
+ ! Thermodynamic coefficients for buoyancy flux - in this loop these are
+ ! calculated at mid-points; later, they will be averaged to interfaces,
+ ! where they will ultimately be used. At the surface, the coefficients
+ ! are taken from the lowest mid point.
+ bfact = g / ( t(i,k) * ( 1._kind_phys + zvir * qv(i,k) - ql(i,k) - qi(i,k) ) )
+ chu(i,k) = ( 1._kind_phys + zvir * qt(i,k) ) * bfact / cpair
+ chs(i,k) = ( ( 1._kind_phys + ( 1._kind_phys + zvir ) * gam(i,k) * cpair * t(i,k) / latvap ) / ( 1._kind_phys + gam(i,k) ) ) * bfact / cpair
+ cmu(i,k) = zvir * bfact * t(i,k)
+ cms(i,k) = latvap * chs(i,k) - bfact * t(i,k)
+ end do
+ end do
+
+ do i = 1, ncol
+ chu(i,pver+1) = chu(i,pver)
+ chs(i,pver+1) = chs(i,pver)
+ cmu(i,pver+1) = cmu(i,pver)
+ cms(i,pver+1) = cms(i,pver)
+ end do
+
+ ! Compute slopes of conserved variables sl, qt within each layer k.
+ ! 'a' indicates the 'above' gradient from layer k-1 to layer k and
+ ! 'b' indicates the 'below' gradient from layer k to layer k+1.
+ ! We take a smaller (in absolute value) of these gradients as the
+ ! slope within layer k. If they have opposite signs, gradient in
+ ! layer k is taken to be zero. I should re-consider whether this
+ ! profile reconstruction is the best or not.
+ ! This is similar to the profile reconstruction used in the UWShCu.
+
+ do i = 1, ncol
+ ! Slopes at endpoints determined by extrapolation
+ slslope(i,pver) = ( sl(i,pver) - sl(i,pver-1) ) / ( pmid(i,pver) - pmid(i,pver-1) )
+ qtslope(i,pver) = ( qt(i,pver) - qt(i,pver-1) ) / ( pmid(i,pver) - pmid(i,pver-1) )
+ slslope(i,1) = ( sl(i,2) - sl(i,1) ) / ( pmid(i,2) - pmid(i,1) )
+ qtslope(i,1) = ( qt(i,2) - qt(i,1) ) / ( pmid(i,2) - pmid(i,1) )
+ dsldp_b(i) = slslope(i,1)
+ dqtdp_b(i) = qtslope(i,1)
+ end do
+
+ do k = 2, pver - 1
+ do i = 1, ncol
+ dsldp_a = dsldp_b(i)
+ dqtdp_a = dqtdp_b(i)
+ dsldp_b(i) = ( sl(i,k+1) - sl(i,k) ) / ( pmid(i,k+1) - pmid(i,k) )
+ dqtdp_b(i) = ( qt(i,k+1) - qt(i,k) ) / ( pmid(i,k+1) - pmid(i,k) )
+ product = dsldp_a * dsldp_b(i)
+ if( product .le. 0._kind_phys ) then
+ slslope(i,k) = 0._kind_phys
+ else if( product .gt. 0._kind_phys .and. dsldp_a .lt. 0._kind_phys ) then
+ slslope(i,k) = max( dsldp_a, dsldp_b(i) )
+ else if( product .gt. 0._kind_phys .and. dsldp_a .gt. 0._kind_phys ) then
+ slslope(i,k) = min( dsldp_a, dsldp_b(i) )
+ end if
+ product = dqtdp_a*dqtdp_b(i)
+ if( product .le. 0._kind_phys ) then
+ qtslope(i,k) = 0._kind_phys
+ else if( product .gt. 0._kind_phys .and. dqtdp_a .lt. 0._kind_phys ) then
+ qtslope(i,k) = max( dqtdp_a, dqtdp_b(i) )
+ else if( product .gt. 0._kind_phys .and. dqtdp_a .gt. 0._kind_phys ) then
+ qtslope(i,k) = min( dqtdp_a, dqtdp_b(i) )
+ end if
+ end do ! i
+ end do ! k
+
+ ! Compute saturation fraction at the interfacial layers for use in buoyancy
+ ! flux computation.
+
+ call sfdiag( ncol , pver , qt , ql , sl , &
+ pi , pmid , zi , cld , sfi , sfuh , &
+ sflh , slslope , qtslope )
+
+ ! Calculate buoyancy coefficients at all interfaces (1:pver+1) and (n2,s2,ri)
+ ! at all interfaces except surface. Note 'nbot_turb = pver', 'ntop_turb = 1'.
+ ! With the previous definition of buoyancy coefficients at the surface, the
+ ! resulting buoyancy coefficients at the top and surface interfaces becomes
+ ! identical to the buoyancy coefficients at the top and bottom layers. Note
+ ! that even though the dimension of (s2,n2,ri) is 'pver', they are defined
+ ! at interfaces ( not at the layer mid-points ) except the surface.
+
+ do k = nbot_turb, ntop_turb + 1, -1
+ km1 = k - 1
+ do i = 1, ncol
+ rdz = 1._kind_phys / ( z(i,km1) - z(i,k) )
+ dsldz = ( sl(i,km1) - sl(i,k) ) * rdz
+ dqtdz = ( qt(i,km1) - qt(i,k) ) * rdz
+ chu(i,k) = ( chu(i,km1) + chu(i,k) ) * 0.5_kind_phys
+ chs(i,k) = ( chs(i,km1) + chs(i,k) ) * 0.5_kind_phys
+ cmu(i,k) = ( cmu(i,km1) + cmu(i,k) ) * 0.5_kind_phys
+ cms(i,k) = ( cms(i,km1) + cms(i,k) ) * 0.5_kind_phys
+ ch = chu(i,k) * ( 1._kind_phys - sfi(i,k) ) + chs(i,k) * sfi(i,k)
+ cm = cmu(i,k) * ( 1._kind_phys - sfi(i,k) ) + cms(i,k) * sfi(i,k)
+ n2(i,k) = ch * dsldz + cm * dqtdz
+ s2(i,k) = ( ( u(i,km1) - u(i,k) )**2 + ( v(i,km1) - v(i,k) )**2) * rdz**2
+ s2(i,k) = max( ntzero, s2(i,k) )
+ ri(i,k) = n2(i,k) / s2(i,k)
+ end do
+ end do
+ do i = 1, ncol
+ n2(i,1) = n2(i,2)
+ s2(i,1) = s2(i,2)
+ ri(i,1) = ri(i,2)
+ end do
+
+ return
+
+ end subroutine trbintd
+
+ ! ---------------------------------------------------------------------------- !
+ ! !
+ ! The University of Washington Moist Turbulence Scheme !
+ ! !
+ ! Authors : Chris Bretherton at the University of Washington, Seattle, WA !
+ ! Sungsu Park at the CGD/NCAR, Boulder, CO !
+ ! !
+ ! ---------------------------------------------------------------------------- !
+
+ subroutine caleddy( ncol , pver , &
+ sl , qt , ql , slv , u , &
+ v , pi , z , zi , &
+ qflx , shflx , slslope , qtslope , &
+ chu , chs , cmu , cms , sfuh , &
+ sflh , n2 , s2 , ri , rrho , &
+ pblh , ustar , &
+ kvh_in , kvm_in , kvh , kvm , &
+ tpert , qpert , qrlin , kvf , tke , &
+ wstarent , bprod , sprod , minpblh , wpert , &
+ tkes , turbtype , &
+ kbase_o , ktop_o , ncvfin_o , &
+ kbase_mg , ktop_mg , ncvfin_mg , &
+ kbase_f , ktop_f , ncvfin_f , &
+ wet_CL , web_CL , jtbu_CL , jbbu_CL , &
+ evhc_CL , jt2slv_CL , n2ht_CL , n2hb_CL , lwp_CL , &
+ opt_depth_CL , radinvfrac_CL, radf_CL , wstar_CL , wstar3fact_CL, &
+ ebrk , wbrk , lbrk , ricl , ghcl , &
+ shcl , smcl , &
+ gh_a , sh_a , sm_a , ri_a , leng , &
+ wcap , pblhp , cld , ipbl , &
+ wsedl , wsed_CL , warnstring , errstring)
+
+ !--------------------------------------------------------------------------------- !
+ ! !
+ ! Purpose : This is a driver routine to compute eddy diffusion coefficients !
+ ! for heat (sl), momentum (u, v), moisture (qt), and other trace !
+ ! constituents. This scheme uses first order closure for stable !
+ ! turbulent layers (STL). For convective layers (CL), entrainment !
+ ! closure is used at the CL external interfaces, which is coupled !
+ ! to the diagnosis of a CL regime mean TKE from the instantaneous !
+ ! thermodynamic and velocity profiles. The CLs are diagnosed by !
+ ! extending original CL layers of moist static instability into !
+ ! adjacent weakly stably stratified interfaces, stopping if the !
+ ! stability is too strong. This allows a realistic depiction of !
+ ! dry convective boundary layers with a downgradient approach. !
+ ! !
+ ! NOTE: This routine currently assumes ntop_turb = 1, nbot_turb = pver !
+ ! ( turbulent diffusivities computed at all interior interfaces ) !
+ ! and will require modification to handle a different ntop_turb. !
+ ! !
+ ! Authors: Sungsu Park and Chris Bretherton. 08/2006, 05/2008. !
+ ! !
+ ! For details, see !
+ ! !
+ ! 1. 'A new moist turbulence parametrization in the Community Atmosphere Model' !
+ ! by Christopher S. Bretherton & Sungsu Park. J. Climate. 22. 3422-3448. 2009. !
+ ! !
+ ! 2. 'The University of Washington shallow convection and moist turbulence schemes !
+ ! and their impact on climate simulations with the Community Atmosphere Model' !
+ ! by Sungsu Park & Christopher S. Bretherton. J. Climate. 22. 3449-3469. 2009. !
+ ! !
+ ! For questions on the scheme and code, send an email to !
+ ! sungsup@ucar.edu or breth@washington.edu !
+ ! !
+ !--------------------------------------------------------------------------------- !
+
+ ! ---------------- !
+ ! Inputs variables !
+ ! ---------------- !
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ real(kind_phys), intent(in) :: u(ncol,pver) ! U wind [m s-1]
+ real(kind_phys), intent(in) :: v(ncol,pver) ! V wind [m s-1]
+ real(kind_phys), intent(in) :: sl(ncol,pver) ! Liquid water static energy, cp * T + g * z - Lv * ql - Ls * qi [J kg-1]
+ real(kind_phys), intent(in) :: slv(ncol,pver) ! Liquid water virtual static energy, sl * ( 1 + 0.608 * qt ) [J kg-1]
+ real(kind_phys), intent(in) :: qt(ncol,pver) ! Total speccific humidity qv + ql + qi [kg kg-1]
+ real(kind_phys), intent(in) :: ql(ncol,pver) ! Liquid water specific humidity [kg kg-1]
+ real(kind_phys), intent(in) :: pi(ncol,pver+1) ! Interface pressures [Pa]
+ real(kind_phys), intent(in) :: z(ncol,pver) ! Layer midpoint height above surface [ m ]
+ real(kind_phys), intent(in) :: zi(ncol,pver+1) ! Interface height above surface, i.e., zi(pver+1) = 0 all over the globe
+ ! [ m ]
+ real(kind_phys), intent(in) :: chu(ncol,pver+1) ! Buoyancy coeffi. unsaturated sl (heat) coef. at all interfaces.
+ ! [m s-2 kg J-1]
+ real(kind_phys), intent(in) :: chs(ncol,pver+1) ! Buoyancy coeffi. saturated sl (heat) coef. at all interfaces.
+ ! [m s-2 kg J-1]
+ real(kind_phys), intent(in) :: cmu(ncol,pver+1) ! Buoyancy coeffi. unsaturated qt (moisture) coef. at all interfaces
+ ! [m s-2 kg kg-1]
+ real(kind_phys), intent(in) :: cms(ncol,pver+1) ! Buoyancy coeffi. saturated qt (moisture) coef. at all interfaces
+ ! [m s-2 kg kg-1]
+ real(kind_phys), intent(in) :: sfuh(ncol,pver) ! Saturation fraction in upper half-layer [ fraction ]
+ real(kind_phys), intent(in) :: sflh(ncol,pver) ! Saturation fraction in lower half-layer [ fraction ]
+ real(kind_phys), intent(in) :: n2(ncol,pver) ! Interfacial (except surface) moist buoyancy frequency [ s-2 ]
+ real(kind_phys), intent(in) :: s2(ncol,pver) ! Interfacial (except surface) shear frequency [ s-2 ]
+ real(kind_phys), intent(in) :: ri(ncol,pver) ! Interfacial (except surface) Richardson number
+ real(kind_phys), intent(in) :: qflx(ncol) ! Kinematic surface constituent ( water vapor ) flux [kg m-2 s-1]
+ real(kind_phys), intent(in) :: shflx(ncol) ! Kinematic surface heat flux [W m-2]
+ real(kind_phys), intent(in) :: slslope(ncol,pver) ! Slope of 'sl' in each layer [J kg-1 Pa-1]
+ real(kind_phys), intent(in) :: qtslope(ncol,pver) ! Slope of 'qt' in each layer [kg kg-1 Pa-1]
+ real(kind_phys), intent(in) :: qrlin(ncol,pver) ! Input grid-mean LW heating rate : [ K/s ] * cpair * dp = [ W/kg*Pa ]
+ real(kind_phys), intent(in) :: wsedl(ncol,pver) ! Sedimentation velocity of liquid stratus cloud droplet [m s-1]
+ real(kind_phys), intent(in) :: ustar(ncol) ! Surface friction velocity [m s-1]
+ real(kind_phys), intent(in) :: rrho(ncol) ! 1./bottom mid-point density. Specific volume [m3 kg-1]
+ real(kind_phys), intent(in) :: kvf(ncol,pver+1) ! Free atmosphere eddy diffusivity [m2 s-1]
+ logical, intent(in) :: wstarent ! Switch for choosing wstar3 entrainment parameterization
+ real(kind_phys), intent(in) :: minpblh(ncol) ! Minimum PBL height based on surface stress [ m ]
+ real(kind_phys), intent(in) :: kvh_in(ncol,pver+1) ! kvh saved from last timestep or last iterative step [m2 s-1]
+ real(kind_phys), intent(in) :: kvm_in(ncol,pver+1) ! kvm saved from last timestep or last iterative step [m2 s-1]
+ real(kind_phys), intent(in) :: cld(ncol,pver) ! Stratus Cloud Fraction [ fraction ]
+
+ ! ---------------- !
+ ! Output variables !
+ ! ---------------- !
+
+ real(kind_phys), intent(out) :: kvh(ncol,pver+1) ! Eddy diffusivity for heat, moisture, and tracers [ m2/s ]
+ real(kind_phys), intent(out) :: kvm(ncol,pver+1) ! Eddy diffusivity for momentum [ m2/s ]
+ real(kind_phys), intent(out) :: pblh(ncol) ! PBL top height [ m ]
+ real(kind_phys), intent(out) :: pblhp(ncol) ! PBL top height pressure [ Pa ]
+ real(kind_phys), intent(out) :: tpert(ncol) ! Convective temperature excess [ K ]
+ real(kind_phys), intent(out) :: qpert(ncol) ! Convective humidity excess [ kg/kg ]
+ real(kind_phys), intent(out) :: wpert(ncol) ! Turbulent velocity excess [ m/s ]
+ real(kind_phys), intent(out) :: tkes(ncol) ! TKE at surface [ m2/s2 ]
+ real(kind_phys), intent(out) :: tke(ncol,pver+1) ! Turbulent kinetic energy [ m2/s2 ], 'tkes' at surface, pver+1.
+ real(kind_phys), intent(out) :: bprod(ncol,pver+1) ! Buoyancy production [ m2/s3 ], 'bflxs' at surface, pver+1.
+ real(kind_phys), intent(out) :: sprod(ncol,pver+1) ! Shear production [ m2/s3 ], (ustar(i)**3)/(vk*z(i,pver))
+ ! at surface, pver+1.
+ integer(i4), intent(out) :: turbtype(ncol,pver+1) ! Turbulence type at each interface:
+ ! 0. = Non turbulence interface
+ ! 1. = Stable turbulence interface
+ ! 2. = CL interior interface ( if bflxs > 0, surface is this )
+ ! 3. = Bottom external interface of CL
+ ! 4. = Top external interface of CL.
+ ! 5. = Double entraining CL external interface
+ integer(i4), intent(out) :: ipbl(ncol) ! If 1, PBL is CL, while if 0, PBL is STL.
+ real(kind_phys), intent(out) :: wsed_CL(ncol,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ]
+
+ character(len=*), intent(out) :: warnstring
+ character(len=*), intent(out) :: errstring
+
+ ! --------------------------- !
+ ! Diagnostic output variables !
+ ! --------------------------- !
+
+ real(kind_phys) :: kbase_o(ncol,ncvmax) ! Original external base interface index of CL just after 'exacol'
+ real(kind_phys) :: ktop_o(ncol,ncvmax) ! Original external top interface index of CL just after 'exacol'
+ real(kind_phys) :: ncvfin_o(ncol) ! Original number of CLs just after 'exacol'
+ real(kind_phys) :: kbase_mg(ncol,ncvmax) ! kbase just after extending-merging (after 'zisocl') but without SRCL
+ real(kind_phys) :: ktop_mg(ncol,ncvmax) ! ktop just after extending-merging (after 'zisocl') but without SRCL
+ real(kind_phys) :: ncvfin_mg(ncol) ! ncvfin just after extending-merging (after 'zisocl') but without SRCL
+ real(kind_phys) :: kbase_f(ncol,ncvmax) ! Final kbase after adding SRCL
+ real(kind_phys) :: ktop_f(ncol,ncvmax) ! Final ktop after adding SRCL
+ real(kind_phys) :: ncvfin_f(ncol) ! Final ncvfin after adding SRCL
+ real(kind_phys) :: wet_CL(ncol,ncvmax) ! Entrainment rate at the CL top [ m/s ]
+ real(kind_phys) :: web_CL(ncol,ncvmax) ! Entrainment rate at the CL base [ m/s ]
+ real(kind_phys) :: jtbu_CL(ncol,ncvmax) ! Buoyancy jump across the CL top [ m/s2 ]
+ real(kind_phys) :: jbbu_CL(ncol,ncvmax) ! Buoyancy jump across the CL base [ m/s2 ]
+ real(kind_phys) :: evhc_CL(ncol,ncvmax) ! Evaporative enhancement factor at the CL top
+ real(kind_phys) :: jt2slv_CL(ncol,ncvmax) ! Jump of slv ( across two layers ) at CL top for use only in evhc [ J/kg ]
+ real(kind_phys) :: n2ht_CL(ncol,ncvmax) ! n2 defined at the CL top interface
+ ! but using sfuh(kt) instead of sfi(kt) [ s-2 ]
+ real(kind_phys) :: n2hb_CL(ncol,ncvmax) ! n2 defined at the CL base interface
+ ! but using sflh(kb-1) instead of sfi(kb) [ s-2 ]
+ real(kind_phys) :: lwp_CL(ncol,ncvmax) ! LWP in the CL top layer [ kg/m2 ]
+ real(kind_phys) :: opt_depth_CL(ncol,ncvmax) ! Optical depth of the CL top layer
+ real(kind_phys) :: radinvfrac_CL(ncol,ncvmax) ! Fraction of LW radiative cooling confined in the top portion of CL
+ real(kind_phys) :: radf_CL(ncol,ncvmax) ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ]
+ real(kind_phys) :: wstar_CL(ncol,ncvmax) ! Convective velocity of CL including entrainment contribution finally [ m/s ]
+ real(kind_phys) :: wstar3fact_CL(ncol,ncvmax) ! "wstar3fact" of CL. Entrainment enhancement of wstar3 (inverse)
+
+ real(kind_phys) :: gh_a(ncol,pver+1) ! Half of normalized buoyancy production, -l2n2/2e. [ no unit ]
+ real(kind_phys) :: sh_a(ncol,pver+1) ! Galperin instability function of heat-moisture at all interfaces [ no unit ]
+ real(kind_phys) :: sm_a(ncol,pver+1) ! Galperin instability function of momentum at all interfaces [ no unit ]
+ real(kind_phys) :: ri_a(ncol,pver+1) ! Interfacial Richardson number at all interfaces [ no unit ]
+
+ real(kind_phys) :: ebrk(ncol,ncvmax) ! Net CL mean TKE [ m2/s2 ]
+ real(kind_phys) :: wbrk(ncol,ncvmax) ! Net CL mean normalized TKE [ m2/s2 ]
+ real(kind_phys) :: lbrk(ncol,ncvmax) ! Net energetic integral thickness of CL [ m ]
+ real(kind_phys) :: ricl(ncol,ncvmax) ! Mean Richardson number of CL ( l2n2/l2s2 )
+ real(kind_phys) :: ghcl(ncol,ncvmax) ! Half of normalized buoyancy production of CL
+ real(kind_phys) :: shcl(ncol,ncvmax) ! Instability function of heat and moisture of CL
+ real(kind_phys) :: smcl(ncol,ncvmax) ! Instability function of momentum of CL
+
+ real(kind_phys) :: leng(ncol,pver+1) ! Turbulent length scale [ m ], 0 at the surface.
+ real(kind_phys) :: wcap(ncol,pver+1) ! Normalized TKE [m2/s2], 'tkes/b1' at the surface and 'tke/b1' at
+ ! the top/bottom entrainment interfaces of CL assuming no transport.
+ ! ------------------------ !
+ ! Local Internal Variables !
+ ! ------------------------ !
+
+ logical :: belongcv(ncol,pver+1) ! True for interfaces in a CL (both interior and exterior are included)
+ logical :: belongst(ncol,pver+1) ! True for stable turbulent layer interfaces (STL)
+ logical :: in_CL ! True if interfaces k,k+1 both in same CL.
+ logical :: extend ! True when CL is extended in zisocl
+ logical :: extend_up ! True when CL is extended upward in zisocl
+ logical :: extend_dn ! True when CL is extended downward in zisocl
+
+ integer :: i ! Longitude index
+ integer :: k ! Vertical index
+ integer :: ks ! Vertical index
+ integer :: ncvfin(ncol) ! Total number of CL in column
+ integer :: ncvf ! Total number of CL in column prior to adding SRCL
+ integer :: ncv ! Index of current CL
+ integer :: ncvnew ! Index of added SRCL appended after regular CLs from 'zisocl'
+ integer :: ncvsurf ! If nonzero, CL index based on surface
+ ! (usually 1, but can be > 1 when SRCL is based at sfc)
+ integer :: kbase(ncol,ncvmax) ! Vertical index of CL base interface
+ integer :: ktop(ncol,ncvmax) ! Vertical index of CL top interface
+ integer :: kb, kt ! kbase and ktop for current CL
+ integer :: ktblw ! ktop of the CL located at just below the current CL
+
+ integer :: ktopbl(ncol) ! PBL top height or interface index
+ real(kind_phys) :: bflxs(ncol) ! Surface buoyancy flux [ m2/s3 ]
+ real(kind_phys) :: rcap ! 'tke/ebrk' at all interfaces of CL.
+ ! Set to 1 at the CL entrainment interfaces
+ real(kind_phys) :: jtzm ! Interface layer thickness of CL top interface [ m ]
+ real(kind_phys) :: jtsl ! Jump of s_l across CL top interface [ J/kg ]
+ real(kind_phys) :: jtqt ! Jump of q_t across CL top interface [ kg/kg ]
+ real(kind_phys) :: jtbu ! Jump of buoyancy across CL top interface [ m/s2 ]
+ real(kind_phys) :: jtu ! Jump of u across CL top interface [ m/s ]
+ real(kind_phys) :: jtv ! Jump of v across CL top interface [ m/s ]
+ real(kind_phys) :: jt2slv ! Jump of slv ( across two layers ) at CL top for use only in evhc [ J/kg ]
+ real(kind_phys) :: radf ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ]
+ real(kind_phys) :: jbzm ! Interface layer thickness of CL base interface [ m ]
+ real(kind_phys) :: jbsl ! Jump of s_l across CL base interface [ J/kg ]
+ real(kind_phys) :: jbqt ! Jump of q_t across CL top interface [ kg/kg ]
+ real(kind_phys) :: jbbu ! Jump of buoyancy across CL base interface [ m/s2 ]
+ real(kind_phys) :: jbu ! Jump of u across CL base interface [ m/s ]
+ real(kind_phys) :: jbv ! Jump of v across CL base interface [ m/s ]
+ real(kind_phys) :: ch ! Buoyancy coefficients defined at the CL top and base interfaces
+ ! using CL internal
+ real(kind_phys) :: cm ! sfuh(kt) and sflh(kb-1) instead of sfi(kt) and sfi(kb), respectively.
+ ! These are used for entrainment calculation at CL external interfaces
+ ! and SRCL identification.
+ real(kind_phys) :: n2ht ! n2 defined at the CL top interface
+ ! but using sfuh(kt) instead of sfi(kt) [ s-2 ]
+ real(kind_phys) :: n2hb ! n2 defined at the CL base interface
+ ! but using sflh(kb-1) instead of sfi(kb) [ s-2 ]
+ real(kind_phys) :: n2htSRCL ! n2 defined at the upper-half layer of SRCL.
+ ! This is used only for identifying SRCL.
+ ! n2htSRCL use SRCL internal slope sl and qt
+ ! as well as sfuh(kt) instead of sfi(kt) [ s-2 ]
+ real(kind_phys) :: gh ! Half of normalized buoyancy production ( -l2n2/2e ) [ no unit ]
+ real(kind_phys) :: sh ! Galperin instability function for heat and moisture
+ real(kind_phys) :: sm ! Galperin instability function for momentum
+ real(kind_phys) :: lbulk ! Depth of turbulent layer, Master length scale (not energetic length)
+ real(kind_phys) :: dzht ! Thickness of top half-layer [ m ]
+ real(kind_phys) :: dzhb ! Thickness of bottom half-layer [ m ]
+ real(kind_phys) :: rootp ! Sqrt(net CL-mean TKE including entrainment contribution) [ m/s ]
+ real(kind_phys) :: evhc ! Evaporative enhancement factor: (1+E)
+ ! with E = evap. cool. efficiency [ no unit ]
+ real(kind_phys) :: kentr ! Effective entrainment diffusivity 'wet*dz', 'web*dz' [ m2/s ]
+ real(kind_phys) :: lwp ! Liquid water path in the layer kt [ kg/m2 ]
+ real(kind_phys) :: opt_depth ! Optical depth of the layer kt [ no unit ]
+ real(kind_phys) :: radinvfrac ! Fraction of LW cooling in the layer kt
+ ! concentrated at the CL top [ no unit ]
+ real(kind_phys) :: wet ! CL top entrainment rate [ m/s ]
+ real(kind_phys) :: web ! CL bot entrainment rate [ m/s ]. Set to zero if CL is based at surface.
+ real(kind_phys) :: vyt ! n2ht/n2 at the CL top interface
+ real(kind_phys) :: vyb ! n2hb/n2 at the CL base interface
+ real(kind_phys) :: vut ! Inverse Ri (=s2/n2) at the CL top interface
+ real(kind_phys) :: vub ! Inverse Ri (=s2/n2) at the CL base interface
+ real(kind_phys) :: fact ! Factor relating TKE generation to entrainment [ no unit ]
+ real(kind_phys) :: trma ! Intermediate variables used for solving quadratic ( for gh from ri )
+ real(kind_phys) :: trmb ! and cubic equations ( for ebrk: the net CL mean TKE )
+ real(kind_phys) :: trmc !
+ real(kind_phys) :: trmp !
+ real(kind_phys) :: trmq !
+ real(kind_phys) :: qq !
+ real(kind_phys) :: det !
+ real(kind_phys) :: gg ! Intermediate variable used for calculating stability functions of
+ ! SRCL or SBCL based at the surface with bflxs > 0.
+ real(kind_phys) :: dzhb5 ! Half thickness of the bottom-most layer of current CL regime
+ real(kind_phys) :: dzht5 ! Half thickness of the top-most layer of adjacent CL regime
+ ! just below current CL
+ real(kind_phys) :: qrlw(ncol,pver) ! Local grid-mean LW heating rate : [K/s] * cpair * dp = [ W/kg*Pa ]
+
+ real(kind_phys) :: cldeff(ncol,pver) ! Effective stratus fraction
+ real(kind_phys) :: qleff ! Used for computing evhc
+ real(kind_phys) :: tunlramp ! Ramping tunl
+ real(kind_phys) :: leng_imsi ! For Kv = max(Kv_STL, Kv_entrain)
+ real(kind_phys) :: tke_imsi !
+ real(kind_phys) :: kvh_imsi !
+ real(kind_phys) :: kvm_imsi !
+ real(kind_phys) :: alph4exs ! For extended stability function in the stable regime
+ real(kind_phys) :: ghmin !
+
+ real(kind_phys) :: sedfact ! For 'sedimentation-entrainment feedback'
+
+ ! Local variables specific for 'wstar' entrainment closure
+
+ real(kind_phys) :: cet ! Proportionality coefficient between wet and wstar3
+ real(kind_phys) :: ceb ! Proportionality coefficient between web and wstar3
+ real(kind_phys) :: wstar ! Convective velocity for CL [ m/s ]
+ real(kind_phys) :: wstar3 ! Cubed convective velocity for CL [ m3/s3 ]
+ real(kind_phys) :: wstar3fact ! 1/(relative change of wstar^3 by entrainment)
+ real(kind_phys) :: rmin ! sqrt(p)
+ real(kind_phys) :: fmin ! f(rmin), where f(r) = r^3 - 3*p*r - 2q
+ real(kind_phys) :: rcrit ! ccrit*wstar
+ real(kind_phys) :: fcrit ! f(rcrit)
+ logical noroot ! True if f(r) has no root r > rcrit
+
+ character(128) :: temp_string
+
+ !-----------------------!
+ ! Start of Main Program !
+ !-----------------------!
+
+ warnstring = ""
+ errstring = ""
+
+ ! Option: Turn-off LW radiative-turbulence interaction in PBL scheme
+ ! by setting qrlw = 0. Logical parameter 'set_qrlzero' was
+ ! defined in the first part of 'eddy_diff.F90' module.
+
+ if( set_qrlzero ) then
+ qrlw(:,:) = 0._kind_phys
+ else
+ qrlw(:ncol,:pver) = qrlin(:ncol,:pver)
+ endif
+
+ ! Define effective stratus fraction using the grid-mean ql.
+ ! Modification : The contribution of ice should be carefully considered.
+ ! This should be done in combination with the 'qrlw' and
+ ! overlapping assumption of liquid and ice stratus.
+
+ do k = 1, pver
+ do i = 1, ncol
+ if( choice_evhc .eq. 'ramp' .or. choice_radf .eq. 'ramp' ) then
+ cldeff(i,k) = cld(i,k) * min( ql(i,k) / qmin, 1._kind_phys )
+ else
+ cldeff(i,k) = cld(i,k)
+ endif
+ end do
+ end do
+
+ ! For an extended stability function in the stable regime, re-define
+ ! alph4exe and ghmin. This is for future work.
+
+ if( ricrit .eq. 0.19_kind_phys ) then
+ alph4exs = alph4
+ ghmin = -3.5334_kind_phys
+ elseif( ricrit .gt. 0.19_kind_phys ) then
+ alph4exs = -2._kind_phys * b1 * alph2 / ( alph3 - 2._kind_phys * b1 * alph5 ) / ricrit
+ ghmin = -1.e10_kind_phys
+ else
+ errstring = 'ricrit should be larger than 0.19 in UW PBL'
+ return
+ endif
+
+ !
+ ! Initialization of Diagnostic Output
+ !
+
+ do i = 1, ncol
+ wet_CL(i,:ncvmax) = 0._kind_phys
+ web_CL(i,:ncvmax) = 0._kind_phys
+ jtbu_CL(i,:ncvmax) = 0._kind_phys
+ jbbu_CL(i,:ncvmax) = 0._kind_phys
+ evhc_CL(i,:ncvmax) = 0._kind_phys
+ jt2slv_CL(i,:ncvmax) = 0._kind_phys
+ n2ht_CL(i,:ncvmax) = 0._kind_phys
+ n2hb_CL(i,:ncvmax) = 0._kind_phys
+ lwp_CL(i,:ncvmax) = 0._kind_phys
+ opt_depth_CL(i,:ncvmax) = 0._kind_phys
+ radinvfrac_CL(i,:ncvmax) = 0._kind_phys
+ radf_CL(i,:ncvmax) = 0._kind_phys
+ wstar_CL(i,:ncvmax) = 0._kind_phys
+ wstar3fact_CL(i,:ncvmax) = 0._kind_phys
+ ricl(i,:ncvmax) = 0._kind_phys
+ ghcl(i,:ncvmax) = 0._kind_phys
+ shcl(i,:ncvmax) = 0._kind_phys
+ smcl(i,:ncvmax) = 0._kind_phys
+ ebrk(i,:ncvmax) = 0._kind_phys
+ wbrk(i,:ncvmax) = 0._kind_phys
+ lbrk(i,:ncvmax) = 0._kind_phys
+ gh_a(i,:pver+1) = 0._kind_phys
+ sh_a(i,:pver+1) = 0._kind_phys
+ sm_a(i,:pver+1) = 0._kind_phys
+ ri_a(i,:pver+1) = 0._kind_phys
+ ipbl(i) = 0
+ wsed_CL(i,:ncvmax) = 0._kind_phys
+ end do
+
+ ! kvh and kvm are stored over timesteps in 'vertical_diffusion.F90' and
+ ! passed in as kvh_in and kvm_in. However, at the first timestep they
+ ! need to be computed and these are done just before calling 'caleddy'.
+ ! kvm and kvh are also stored over iterative time step in the first part
+ ! of 'eddy_diff.F90'
+
+ ! Initialize kvh and kvm to kvf
+ kvh(:,:) = kvf(:,:)
+ kvm(:,:) = kvf(:,:)
+ ! Zero diagnostic quantities for the new diffusion step.
+ wcap(:,:) = 0._kind_phys
+ leng(:,:) = 0._kind_phys
+ tke(:,:) = 0._kind_phys
+ turbtype(:,:) = 0
+
+
+ ! Initialize 'bprod' [ m2/s3 ] and 'sprod' [ m2/s3 ] at all interfaces.
+ ! Note this initialization is a hybrid initialization since 'n2' [s-2] and 's2' [s-2]
+ ! are calculated from the given current initial profile, while 'kvh_in' [m2/s] and
+ ! 'kvm_in' [m2/s] are from the previous iteration or previous time step.
+ ! This initially guessed 'bprod' and 'sprod' will be updated at the end of this
+ ! 'caleddy' subroutine for diagnostic output.
+ ! This computation of 'bprod,sprod' below is necessary for wstar-based entrainment closure.
+
+ do k = 2, pver
+ do i = 1, ncol
+ bprod(i,k) = -kvh_in(i,k) * n2(i,k)
+ sprod(i,k) = kvm_in(i,k) * s2(i,k)
+ end do
+ end do
+
+ ! Set 'bprod' and 'sprod' at top and bottom interface.
+ ! In calculating 'surface' (actually lowest half-layer) buoyancy flux,
+ ! 'chu' at surface is defined to be the same as 'chu' at the mid-point
+ ! of lowest model layer (pver) at the end of 'trbind'. The same is for
+ ! the other buoyancy coefficients. 'sprod(i,pver+1)' is defined in a
+ ! consistent way as the definition of 'tkes' in the original code.
+ ! ( Important Option ) If I want to isolate surface buoyancy flux from
+ ! the other parts of CL regimes energetically even though bflxs > 0,
+ ! all I should do is to re-define 'bprod(i,pver+1)=0' in the below 'do'
+ ! block. Additionally for merging test of extending SBCL based on 'l2n2'
+ ! in 'zisocl', I should use 'l2n2 = - wint / sh' for similar treatment
+ ! as previous code. All other parts of the code are fully consistently
+ ! treated by these change only.
+ ! My future general convection scheme will use bflxs(i).
+
+ do i = 1, ncol
+ bprod(i,1) = 0._kind_phys ! Top interface
+ sprod(i,1) = 0._kind_phys ! Top interface
+ ch = chu(i,pver+1) * ( 1._kind_phys - sflh(i,pver) ) + chs(i,pver+1) * sflh(i,pver)
+ cm = cmu(i,pver+1) * ( 1._kind_phys - sflh(i,pver) ) + cms(i,pver+1) * sflh(i,pver)
+ bflxs(i) = ch * shflx(i) * rrho(i) + cm * qflx(i) * rrho(i)
+ if( choice_tkes .eq. 'ibprod' ) then
+ bprod(i,pver+1) = bflxs(i)
+ else
+ bprod(i,pver+1) = 0._kind_phys
+ endif
+ sprod(i,pver+1) = (ustar(i)**3)/(vk*z(i,pver))
+ end do
+
+ ! Initially identify CL regimes in 'exacol'
+ ! ktop : Interface index of the CL top external interface
+ ! kbase : Interface index of the CL base external interface
+ ! ncvfin: Number of total CLs
+ ! Note that if surface buoyancy flux is positive ( bflxs = bprod(i,pver+1) > 0 ),
+ ! surface interface is identified as an internal interface of CL. However, even
+ ! though bflxs <= 0, if 'pver' interface is a CL internal interface (ri(pver)<0),
+ ! surface interface is identified as an external interface of CL. If bflxs =< 0
+ ! and ri(pver) >= 0, then surface interface is identified as a stable turbulent
+ ! intereface (STL) as shown at the end of 'caleddy'. Even though a 'minpblh' is
+ ! passed into 'exacol', it is not used in the 'exacol'.
+
+ call exacol( ncol, pver, ri, bflxs, minpblh, zi, ktop, kbase, ncvfin )
+
+ ! Diagnostic output of CL interface indices before performing 'extending-merging'
+ ! of CL regimes in 'zisocl'
+ do i = 1, ncol
+ do k = 1, ncvmax
+ kbase_o(i,k) = real(kbase(i,k),kind_phys)
+ ktop_o(i,k) = real(ktop(i,k),kind_phys)
+ ncvfin_o(i) = real(ncvfin(i),kind_phys)
+ end do
+ end do
+
+ ! ----------------------------------- !
+ ! Perform calculation for each column !
+ ! ----------------------------------- !
+
+ do i = 1, ncol
+
+ ! Define Surface Interfacial Layer TKE, 'tkes'.
+ ! In the current code, 'tkes' is used as representing TKE of surface interfacial
+ ! layer (low half-layer of surface-based grid layer). In the code, when bflxs>0,
+ ! surface interfacial layer is assumed to be energetically coupled to the other
+ ! parts of the CL regime based at the surface. In this sense, it is conceptually
+ ! more reasonable to include both 'bprod' and 'sprod' in the definition of 'tkes'.
+ ! Since 'tkes' cannot be negative, it is lower bounded by small positive number.
+ ! Note that inclusion of 'bprod' in the definition of 'tkes' may increase 'ebrk'
+ ! and 'wstar3', and eventually, 'wet' at the CL top, especially when 'bflxs>0'.
+ ! This might help to solve the problem of too shallow PBLH over the overcast Sc
+ ! regime. If I want to exclude 'bprod(i,pver+1)' in calculating 'tkes' even when
+ ! bflxs > 0, all I should to do is to set 'bprod(i,pver+1) = 0' in the above
+ ! initialization 'do' loop (explained above), NOT changing the formulation of
+ ! tkes(i) in the below block. This is because for consistent treatment in the
+ ! other parts of the code also.
+
+ ! tkes(i) = (b1*vk*z(i,pver)*sprod(i,pver+1))**(2._kind_phys/3._kind_phys)
+ tkes(i) = max(b1*vk*z(i,pver)*(bprod(i,pver+1)+sprod(i,pver+1)), 1.e-7_kind_phys)**(2._kind_phys/3._kind_phys)
+ tkes(i) = min(tkes(i), tkemax)
+ tke(i,pver+1) = tkes(i)
+ wcap(i,pver+1) = tkes(i)/b1
+
+ ! Extend and merge the initially identified CLs, relabel the CLs, and calculate
+ ! CL internal mean energetics and stability functions in 'zisocl'.
+ ! The CL nearest to the surface is CL(1) and the CL index, ncv, increases
+ ! with height. The following outputs are from 'zisocl'. Here, the dimension
+ ! of below outputs are (ncol,ncvmax) (except the 'ncvfin(ncol)' and
+ ! 'belongcv(ncol,pver+1)) and 'ncv' goes from 1 to 'ncvfin'.
+ ! For 'ncv = ncvfin+1, ncvmax', below output are already initialized to be zero.
+ ! ncvfin : Total number of CLs
+ ! kbase(ncv) : Base external interface index of CL
+ ! ktop : Top external interface index of CL
+ ! belongcv : True if the interface (either internal or external) is CL
+ ! ricl : Mean Richardson number of internal CL
+ ! ghcl : Normalized buoyancy production '-l2n2/2e' [no unit] of internal CL
+ ! shcl : Galperin instability function of heat-moisture of internal CL
+ ! smcl : Galperin instability function of momentum of internal CL
+ ! lbrk, int : Thickness of (energetically) internal CL (lint, [m])
+ ! wbrk, int : Mean normalized TKE of internal CL ([m2/s2])
+ ! ebrk, int : Mean TKE of internal CL (b1*wbrk,[m2/s2])
+ ! The ncvsurf is an identifier saying which CL regime is based at the surface.
+ ! If 'ncvsurf=1', then the first CL regime is based at the surface. If surface
+ ! interface is not a part of CL (neither internal nor external), 'ncvsurf = 0'.
+ ! After identifying and including SRCLs into the normal CL regimes (where newly
+ ! identified SRCLs are simply appended to the normal CL regimes using regime
+ ! indices of 'ncvfin+1','ncvfin+2' (as will be shown in the below SRCL part),..
+ ! where 'ncvfin' is the final CL regime index produced after extending-merging
+ ! in 'zisocl' but before adding SRCLs), if any newly identified SRCL (e.g.,
+ ! 'ncvfin+1') is based at surface, then 'ncvsurf = ncvfin+1'. Thus 'ncvsurf' can
+ ! be 0, 1, or >1. 'ncvsurf' can be a useful diagnostic output.
+
+ ncvsurf = 0
+ if( ncvfin(i) .gt. 0 ) then
+ call zisocl( ncol , pver , i , &
+ z , zi , n2 , s2 , &
+ bprod , sprod , bflxs , tkes , &
+ ncvfin , kbase , ktop , belongcv, &
+ ricl , ghcl , shcl , smcl , &
+ lbrk , wbrk , ebrk , &
+ extend , extend_up, extend_dn, &
+ errstring)
+ if (trim(errstring) /= "") return
+ if( kbase(i,1) .eq. pver + 1 ) ncvsurf = 1
+ else
+ belongcv(i,:) = .false.
+ endif
+
+ ! Diagnostic output after finishing extending-merging process in 'zisocl'
+ ! Since we are adding SRCL additionally, we need to print out these here.
+
+ do k = 1, ncvmax
+ kbase_mg(i,k) = real(kbase(i,k))
+ ktop_mg(i,k) = real(ktop(i,k))
+ ncvfin_mg(i) = real(ncvfin(i))
+ end do
+
+ ! ----------------------- !
+ ! Identification of SRCLs !
+ ! ----------------------- !
+
+ ! Modification : This cannot identify the 'cirrus' layer due to the condition of
+ ! ql(i,k) .gt. qmin. This should be modified in future to identify
+ ! a single thin cirrus layer.
+ ! Instead of ql, we may use cldn in future, including ice
+ ! contribution.
+
+ ! ------------------------------------------------------------------------------ !
+ ! Find single-layer radiatively-driven cloud-topped convective layers (SRCLs). !
+ ! SRCLs extend through a single model layer k, with entrainment at the top and !
+ ! bottom interfaces, unless bottom interface is the surface. !
+ ! The conditions for an SRCL is identified are: !
+ ! !
+ ! 1. Cloud in the layer, k : ql(i,k) .gt. qmin = 1.e-5 [ kg/kg ] !
+ ! 2. No cloud in the above layer (else assuming that some fraction of the LW !
+ ! flux divergence in layer k is concentrated at just below top interface !
+ ! of layer k is invalid). Then, this condition might be sensitive to the !
+ ! vertical resolution of grid. !
+ ! 3. LW radiative cooling (SW heating is assumed uniformly distributed through !
+ ! layer k, so not relevant to buoyancy production) in the layer k. However, !
+ ! SW production might also contribute, which may be considered in a future. !
+ ! 4. Internal stratification 'n2ht' of upper-half layer should be unstable. !
+ ! The 'n2ht' is pure internal stratification of upper half layer, obtained !
+ ! using internal slopes of sl, qt in layer k (in contrast to conventional !
+ ! interfacial slope) and saturation fraction in the upper-half layer, !
+ ! sfuh(k) (in contrast to sfi(k)). !
+ ! 5. Top and bottom interfaces not both in the same existing convective layer. !
+ ! If SRCL is within the previouisly identified CL regimes, we don't define !
+ ! a new SRCL. !
+ ! 6. k >= ntop_turb + 1 = 2 !
+ ! 7. Ri at the top interface > ricrit = 0.19 (otherwise turbulent mixing will !
+ ! broadly distribute the cloud top in the vertical, preventing localized !
+ ! radiative destabilization at the top interface). !
+ ! !
+ ! Note if 'k = pver', it identifies a surface-based single fog layer, possibly, !
+ ! warm advection fog. Note also the CL regime index of SRCLs itself increases !
+ ! with height similar to the regular CLs indices identified from 'zisocl'. !
+ ! ------------------------------------------------------------------------------ !
+
+ ncv = 1
+ ncvf = ncvfin(i)
+
+ if( choice_SRCL .eq. 'remove' ) goto 222
+
+ do k = nbot_turb, ntop_turb + 1, -1 ! 'k = pver, 2, -1' is a layer index.
+
+ if( ql(i,k) .gt. qmin .and. ql(i,k-1) .lt. qmin .and. qrlw(i,k) .lt. 0._kind_phys &
+ .and. ri(i,k) .ge. ricrit ) then
+
+ ! In order to avoid any confliction with the treatment of ambiguous layer,
+ ! I need to impose an additional constraint that ambiguous layer cannot be
+ ! SRCL. So, I added constraint that 'k+1' interface (base interface of k
+ ! layer) should not be a part of previously identified CL. Since 'belongcv'
+ ! is even true for external entrainment interfaces, below constraint is
+ ! fully sufficient.
+
+ if( choice_SRCL .eq. 'nonamb' .and. belongcv(i,k+1) ) then
+ go to 220
+ endif
+
+ ch = ( 1._kind_phys - sfuh(i,k) ) * chu(i,k) + sfuh(i,k) * chs(i,k)
+ cm = ( 1._kind_phys - sfuh(i,k) ) * cmu(i,k) + sfuh(i,k) * cms(i,k)
+
+ n2htSRCL = ch * slslope(i,k) + cm * qtslope(i,k)
+
+ if( n2htSRCL .le. 0._kind_phys ) then
+
+ ! Test if bottom and top interfaces are part of the pre-existing CL.
+ ! If not, find appropriate index for the new SRCL. Note that this
+ ! calculation makes use of 'ncv set' obtained from 'zisocl'. The
+ ! 'in_CL' is a parameter testing whether the new SRCL is already
+ ! within the pre-existing CLs (.true.) or not (.false.).
+
+ in_CL = .false.
+
+ do while ( ncv .le. ncvf )
+ if( ktop(i,ncv) .le. k ) then
+ if( kbase(i,ncv) .gt. k ) then
+ in_CL = .true.
+ endif
+ exit ! Exit from 'do while' loop if SRCL is within the CLs.
+ else
+ ncv = ncv + 1 ! Go up one CL
+ end if
+ end do ! ncv
+
+ if( .not. in_CL ) then ! SRCL is not within the pre-existing CLs.
+
+ ! Identify a new SRCL and add it to the pre-existing CL regime group.
+
+ ncvfin(i) = ncvfin(i) + 1
+ ncvnew = ncvfin(i)
+ ktop(i,ncvnew) = k
+ kbase(i,ncvnew) = k+1
+ belongcv(i,k) = .true.
+ belongcv(i,k+1) = .true.
+
+ ! Calculate internal energy of SRCL. There is no internal energy if
+ ! SRCL is elevated from the surface. Also, we simply assume neutral
+ ! stability function. Note that this assumption of neutral stability
+ ! does not influence numerical calculation- stability functions here
+ ! are just for diagnostic output. In general SRCLs other than a SRCL
+ ! based at surface with bflxs <= 0, there is no other way but to use
+ ! neutral stability function. However, in case of SRCL based at the
+ ! surface, we can explicitly calculate non-zero stability functions
+ ! in a consistent way. Even though stability functions of SRCL are
+ ! just diagnostic outputs not influencing numerical calculations, it
+ ! would be informative to write out correct reasonable values rather
+ ! than simply assuming neutral stability. I am doing this right now.
+ ! Similar calculations were done for the SBCL and when surface inter
+ ! facial layer was merged by overlying CL in 'ziscol'.
+
+ if( k .lt. pver ) then
+
+ wbrk(i,ncvnew) = 0._kind_phys
+ ebrk(i,ncvnew) = 0._kind_phys
+ lbrk(i,ncvnew) = 0._kind_phys
+ ghcl(i,ncvnew) = 0._kind_phys
+ shcl(i,ncvnew) = 0._kind_phys
+ smcl(i,ncvnew) = 0._kind_phys
+ ricl(i,ncvnew) = 0._kind_phys
+
+ else ! Surface-based fog
+
+ if( bflxs(i) .gt. 0._kind_phys ) then ! Incorporate surface TKE into CL interior energy
+ ! It is likely that this case cannot exist since
+ ! if surface buoyancy flux is positive, it would
+ ! have been identified as SBCL in 'zisocl' ahead.
+ ebrk(i,ncvnew) = tkes(i)
+ lbrk(i,ncvnew) = z(i,pver)
+ wbrk(i,ncvnew) = tkes(i) / b1
+
+ write(temp_string,*) 'Major mistake in SRCL: bflxs > 0 for surface-based SRCL'
+ warnstring = trim(warnstring)//temp_string
+ write(temp_string,*) 'bflxs = ', bflxs(i), &
+ 'ncvfin_o = ', ncvfin_o(i), &
+ 'ncvfin_mg = ', ncvfin_mg(i)
+ warnstring = trim(warnstring)//temp_string
+ do ks = 1, ncvmax
+ write(temp_string,*) 'ncv =', ks, ' ', kbase_o(i,ks), &
+ ktop_o(i,ks), kbase_mg(i,ks), ktop_mg(i,ks)
+ warnstring = trim(warnstring)//temp_string
+ end do
+ errstring = 'CALEDDY: Major mistake in SRCL: bflxs > 0 for surface-based SRCL'
+ return
+ else ! Don't incorporate surface interfacial TKE into CL interior energy
+
+ ebrk(i,ncvnew) = 0._kind_phys
+ lbrk(i,ncvnew) = 0._kind_phys
+ wbrk(i,ncvnew) = 0._kind_phys
+
+ endif
+
+ ! Calculate stability functions (ghcl, shcl, smcl, ricl) explicitly
+ ! using an reverse procedure starting from tkes(i). Note that it is
+ ! possible to calculate stability functions even when bflxs < 0.
+ ! Previous code just assumed neutral stability functions. Note that
+ ! since alph5 = 0.7 > 0, alph3 = -35 < 0, the denominator of gh is
+ ! always positive if bflxs > 0. However, if bflxs < 0, denominator
+ ! can be zero. For this case, we provide a possible maximum negative
+ ! value (the most stable state) to gh. Note also tkes(i) is always a
+ ! positive value by a limiter. Also, sprod(i,pver+1) > 0 by limiter.
+
+ gg = 0.5_kind_phys * vk * z(i,pver) * bprod(i,pver+1) / ( tkes(i)**(3._kind_phys/2._kind_phys) )
+ if( abs(alph5-gg*alph3) .le. 1.e-7_kind_phys ) then
+ ! gh = -0.28_kind_phys
+ ! gh = -3.5334_kind_phys
+ gh = ghmin
+ else
+ gh = gg / ( alph5 - gg * alph3 )
+ end if
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ ! gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,ghmin),0.0233_kind_phys)
+ ghcl(i,ncvnew) = gh
+ shcl(i,ncvnew) = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ smcl(i,ncvnew) = max(0._kind_phys,(alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4exs*gh))
+ ricl(i,ncvnew) = -(smcl(i,ncvnew)/shcl(i,ncvnew))*(bprod(i,pver+1)/sprod(i,pver+1))
+
+ ! 'ncvsurf' is CL regime index based at the surface. If there is no
+ ! such regime, then 'ncvsurf = 0'.
+
+ ncvsurf = ncvnew
+
+ end if
+
+ end if
+
+ end if
+
+ end if
+
+ 220 continue
+
+ end do ! End of 'k' loop where 'k' is a grid layer index running from 'pver' to 2
+
+ 222 continue
+
+ ! -------------------------------------------------------------------------- !
+ ! Up to this point, we identified all kinds of CL regimes : !
+ ! 1. A SBCL. By construction, 'bflxs > 0' for SBCL. !
+ ! 2. Surface-based CL with multiple layers and 'bflxs =< 0' !
+ ! 3. Surface-based CL with multiple layers and 'bflxs > 0' !
+ ! 4. Regular elevated CL with two entraining interfaces !
+ ! 5. SRCLs. If SRCL is based at surface, it will be bflxs < 0. !
+ ! '1-4' were identified from 'zisocl' while '5' were identified separately !
+ ! after performing 'zisocl'. CL regime index of '1-4' increases with height !
+ ! ( e.g., CL = 1 is the CL regime nearest to the surface ) while CL regime !
+ ! index of SRCL is simply appended after the final index of CL regimes from !
+ ! 'zisocl'. However, CL regime indices of SRCLs itself increases with height !
+ ! when there are multiple SRCLs, similar to the regular CLs from 'zisocl'. !
+ ! -------------------------------------------------------------------------- !
+
+ ! Diagnostic output of final CL regimes indices
+
+ do k = 1, ncvmax
+ kbase_f(i,k) = real(kbase(i,k))
+ ktop_f(i,k) = real(ktop(i,k))
+ ncvfin_f(i) = real(ncvfin(i))
+ end do
+
+ ! --------------------------------------------------------------------- !
+ ! Compute radf for each CL in column by calling subroutine compute_radf !
+ ! --------------------------------------------------------------------- !
+ call compute_radf( choice_radf, i, ncol, pver, ncvmax, ncvfin, ktop, qmin, &
+ ql, pi, qrlw, g, cldeff, zi, chs, lwp_CL(i,:), opt_depth_CL(i,:), &
+ radinvfrac_CL(i,:), radf_CL(i,:) )
+
+ ! ---------------------------------------- !
+ ! Perform do loop for individual CL regime !
+ ! ---------------------------------------- ! -------------------------------- !
+ ! For individual CLs, compute !
+ ! 1. Entrainment rates at the CL top and (if any) base interfaces using !
+ ! appropriate entrainment closure (current code use 'wstar' closure). !
+ ! 2. Net CL mean (i.e., including entrainment contribution) TKE (ebrk) !
+ ! and normalized TKE (wbrk). !
+ ! 3. TKE (tke) and normalized TKE (wcap) profiles at all CL interfaces. !
+ ! 4. ( kvm, kvh ) profiles at all CL interfaces. !
+ ! 5. ( bprod, sprod ) profiles at all CL interfaces. !
+ ! Also calculate !
+ ! 1. PBL height as the top external interface of surface-based CL, if any. !
+ ! 2. Characteristic excesses of convective 'updraft velocity (wpert)', !
+ ! 'temperature (tpert)', and 'moisture (qpert)' in the surface-based CL, !
+ ! if any, for use in the separate convection scheme. !
+ ! If there is no surface-based CL, 'PBL height' and 'convective excesses' are !
+ ! calculated later from surface-based STL (Stable Turbulent Layer) properties.!
+ ! --------------------------------------------------------------------------- !
+
+ ktblw = 0
+ do ncv = 1, ncvfin(i)
+
+ kt = ktop(i,ncv)
+ kb = kbase(i,ncv)
+
+ lwp = lwp_CL(i,ncv)
+ opt_depth = opt_depth_CL(i,ncv)
+ radinvfrac = radinvfrac_CL(i,ncv)
+ radf = radf_CL(i, ncv)
+
+ ! Check whether surface interface is energetically interior or not.
+ if( kb .eq. (pver+1) .and. bflxs(i) .le. 0._kind_phys ) then
+ lbulk = zi(i,kt) - z(i,pver)
+ else
+ lbulk = zi(i,kt) - zi(i,kb)
+ end if
+ lbulk = min( lbulk, lbulk_max )
+
+ ! Calculate 'turbulent length scale (leng)' and 'normalized TKE (wcap)'
+ ! at all CL interfaces except the surface. Note that below 'wcap' at
+ ! external interfaces are not correct. However, it does not influence
+ ! numerical calculation and correct normalized TKE at the entraining
+ ! interfaces will be re-calculated at the end of this 'do ncv' loop.
+
+ do k = min(kb,pver), kt, -1
+ if( choice_tunl .eq. 'rampcl' ) then
+ ! In order to treat the case of 'ricl(i,ncv) >> 0' of surface-based SRCL
+ ! with 'bflxs(i) < 0._kind_phys', I changed ricl(i,ncv) -> min(0._kind_phys,ricl(i,ncv))
+ ! in the below exponential. This is necessary to prevent the model crash
+ ! by too large values (e.g., 700) of ricl(i,ncv)
+ tunlramp = ctunl*tunl*(1._kind_phys-(1._kind_phys-1._kind_phys/ctunl)*exp(min(0._kind_phys,ricl(i,ncv))))
+ tunlramp = min(max(tunlramp,tunl),ctunl*tunl)
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ leng(i,k) = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! leng(i,k) = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ leng(i,k) = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ leng(i,k) = min(leng_max(k), leng(i,k))
+ wcap(i,k) = (leng(i,k)**2) * (-shcl(i,ncv)*n2(i,k)+smcl(i,ncv)*s2(i,k))
+ end do ! k
+
+ ! Calculate basic cross-interface variables ( jump condition ) across the
+ ! base external interface of CL.
+
+ if( kb .lt. pver+1 ) then
+
+ jbzm = z(i,kb-1) - z(i,kb) ! Interfacial layer thickness [m]
+ jbsl = sl(i,kb-1) - sl(i,kb) ! Interfacial jump of 'sl' [J/kg]
+ jbqt = qt(i,kb-1) - qt(i,kb) ! Interfacial jump of 'qt' [kg/kg]
+ jbbu = n2(i,kb) * jbzm ! Interfacial buoyancy jump [m/s2]
+ ! considering saturation ( > 0 )
+ jbbu = max(jbbu,jbumin) ! Set minimum buoyancy jump, jbumin = 1.e-3
+ jbu = u(i,kb-1) - u(i,kb) ! Interfacial jump of 'u' [m/s]
+ jbv = v(i,kb-1) - v(i,kb) ! Interfacial jump of 'v' [m/s]
+ ch = (1._kind_phys -sflh(i,kb-1))*chu(i,kb) + sflh(i,kb-1)*chs(i,kb) ! Buoyancy coefficient just above the base interface
+ cm = (1._kind_phys -sflh(i,kb-1))*cmu(i,kb) + sflh(i,kb-1)*cms(i,kb) ! Buoyancy coefficient just above the base interface
+ n2hb = (ch*jbsl + cm*jbqt)/jbzm ! Buoyancy frequency [s-2]
+ ! just above the base interface
+ vyb = n2hb*jbzm/jbbu ! Ratio of 'n2hb/n2' at 'kb' interface
+ vub = min(1._kind_phys,(jbu**2+jbv**2)/(jbbu*jbzm) ) ! Ratio of 's2/n2 = 1/Ri' at 'kb' interface
+
+ else
+
+ ! Below setting is necessary for consistent treatment when 'kb' is at the surface.
+ jbbu = 0._kind_phys
+ n2hb = 0._kind_phys
+ vyb = 0._kind_phys
+ vub = 0._kind_phys
+ web = 0._kind_phys
+
+ end if
+
+ ! Calculate basic cross-interface variables ( jump condition ) across the
+ ! top external interface of CL. The meanings of variables are similar to
+ ! the ones at the base interface.
+
+ jtzm = z(i,kt-1) - z(i,kt)
+ jtsl = sl(i,kt-1) - sl(i,kt)
+ jtqt = qt(i,kt-1) - qt(i,kt)
+ jtbu = n2(i,kt)*jtzm ! Note : 'jtbu' is guaranteed positive by definition of CL top.
+ jtbu = max(jtbu,jbumin) ! But threshold it anyway to be sure.
+ jtu = u(i,kt-1) - u(i,kt)
+ jtv = v(i,kt-1) - v(i,kt)
+ ch = (1._kind_phys -sfuh(i,kt))*chu(i,kt) + sfuh(i,kt)*chs(i,kt)
+ cm = (1._kind_phys -sfuh(i,kt))*cmu(i,kt) + sfuh(i,kt)*cms(i,kt)
+ n2ht = (ch*jtsl + cm*jtqt)/jtzm
+ vyt = n2ht*jtzm/jtbu
+ vut = min(1._kind_phys,(jtu**2+jtv**2)/(jtbu*jtzm))
+
+ ! Evaporative enhancement factor of entrainment rate at the CL top interface, evhc.
+ ! We take the full inversion strength to be 'jt2slv = slv(i,kt-2)-slv(i,kt)'
+ ! where 'kt-1' is in the ambiguous layer. However, for a cloud-topped CL overlain
+ ! by another CL, it is possible that 'slv(i,kt-2) < slv(i,kt)'. To avoid negative
+ ! or excessive evhc, we lower-bound jt2slv and upper-bound evhc. Note 'jtslv' is
+ ! used only for calculating 'evhc' : when calculating entrainment rate, we will
+ ! use normal interfacial buoyancy jump across CL top interface.
+
+ evhc = 1._kind_phys
+ jt2slv = 0._kind_phys
+
+ ! Modification : I should check whether below 'jbumin' produces reasonable limiting value.
+ ! In addition, our current formulation does not consider ice contribution.
+
+ if( choice_evhc .eq. 'orig' ) then
+
+ if( ql(i,kt) .gt. qmin .and. ql(i,kt-1) .lt. qmin ) then
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g )
+ evhc = 1._kind_phys + a2l * a3l * latvap * ql(i,kt) / jt2slv
+ evhc = min( evhc, evhcmax )
+ end if
+
+ elseif( choice_evhc .eq. 'ramp' ) then
+
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g )
+ evhc = 1._kind_phys + max(cldeff(i,kt)-cldeff(i,kt-1),0._kind_phys) * a2l * a3l * latvap * ql(i,kt) / jt2slv
+ evhc = min( evhc, evhcmax )
+
+ elseif( choice_evhc .eq. 'maxi' ) then
+
+ qleff = max( ql(i,kt-1), ql(i,kt) )
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max( jt2slv, jbumin*slv(i,kt-1)/g )
+ evhc = 1._kind_phys + a2l * a3l * latvap * qleff / jt2slv
+ evhc = min( evhc, evhcmax )
+
+ endif
+
+ ! ------------------------------------------------------------------- !
+ ! Calculate 'wstar3' by summing buoyancy productions within CL from !
+ ! 1. Interior buoyancy production ( bprod: fcn of TKE ) !
+ ! 2. Cloud-top radiative cooling !
+ ! 3. Surface buoyancy flux contribution only when bflxs > 0. !
+ ! Note that master length scale, lbulk, has already been !
+ ! corrctly defined at the first part of this 'do ncv' loop !
+ ! considering the sign of bflxs. !
+ ! This 'wstar3' is used for calculation of entrainment rate. !
+ ! Note that this 'wstar3' formula does not include shear production !
+ ! and the effect of drizzle, which should be included later. !
+ ! Q : Strictly speaking, in calculating interior buoyancy production, !
+ ! the use of 'bprod' is not correct, since 'bprod' is not correct !
+ ! value but initially guessed value. More reasonably, we should !
+ ! use '-leng(i,k)*sqrt(b1*wcap(i,k))*shcl(i,ncv)*n2(i,k)' instead !
+ ! of 'bprod(i,k)', although this is still an approximation since !
+ ! tke(i,k) is not exactly 'b1*wcap(i,k)' due to a transport term.!
+ ! However since iterative calculation will be performed after all,!
+ ! below might also be OK. But I should test this alternative. !
+ ! ------------------------------------------------------------------- !
+
+ dzht = zi(i,kt) - z(i,kt) ! Thickness of CL top half-layer
+ dzhb = z(i,kb-1) - zi(i,kb) ! Thickness of CL bot half-layer
+ wstar3 = radf * dzht
+ do k = kt + 1, kb - 1 ! If 'kt = kb - 1', this loop will not be performed.
+ wstar3 = wstar3 + bprod(i,k) * ( z(i,k-1) - z(i,k) )
+ ! Below is an alternative which may speed up convergence.
+ ! However, for interfaces merged into original CL, it can
+ ! be 'wcap(i,k)<0' since 'n2(i,k)>0'. Thus, I should use
+ ! the above original one.
+ ! wstar3 = wstar3 - leng(i,k)*sqrt(b1*wcap(i,k))*shcl(i,ncv)*n2(i,k)* &
+ ! (z(i,k-1) - z(i,k))
+ end do
+ if( kb .eq. (pver+1) .and. bflxs(i) .gt. 0._kind_phys ) then
+ wstar3 = wstar3 + bflxs(i) * dzhb
+ ! wstar3 = wstar3 + bprod(i,pver+1) * dzhb
+ end if
+ wstar3 = max( 2.5_kind_phys * wstar3, 0._kind_phys )
+
+ ! -------------------------------------------------------------- !
+ ! Below single block is for 'sedimentation-entrainment feedback' !
+ ! -------------------------------------------------------------- !
+
+ if( id_sedfact ) then
+ ! wsed = 7.8e5_kind_phys*(ql(i,kt)/ncliq(i,kt))**(2._kind_phys/3._kind_phys)
+ sedfact = exp(-ased*wsedl(i,kt)/(wstar3**(1._kind_phys/3._kind_phys)+1.e-6_kind_phys))
+ wsed_CL(i,ncv) = wsedl(i,kt)
+ if( choice_evhc .eq. 'orig' ) then
+ if (ql(i,kt).gt.qmin .and. ql(i,kt-1).lt.qmin) then
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g)
+ evhc = 1._kind_phys+sedfact*a2l*a3l*latvap*ql(i,kt) / jt2slv
+ evhc = min(evhc,evhcmax)
+ end if
+ elseif( choice_evhc .eq. 'ramp' ) then
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g)
+ evhc = 1._kind_phys+max(cldeff(i,kt)-cldeff(i,kt-1),0._kind_phys)*sedfact*a2l*a3l*latvap*ql(i,kt) / jt2slv
+ evhc = min(evhc,evhcmax)
+ elseif( choice_evhc .eq. 'maxi' ) then
+ qleff = max(ql(i,kt-1),ql(i,kt))
+ jt2slv = slv(i,max(kt-2,1)) - slv(i,kt)
+ jt2slv = max(jt2slv, jbumin*slv(i,kt-1)/g)
+ evhc = 1._kind_phys+sedfact*a2l*a3l*latvap*qleff / jt2slv
+ evhc = min(evhc,evhcmax)
+ endif
+ endif
+
+ ! -------------------------------------------------------------------------- !
+ ! Now diagnose CL top and bottom entrainment rates (and the contribution of !
+ ! top/bottom entrainments to wstar3) using entrainment closures of the form !
+ ! !
+ ! wet = cet*wstar3, web = ceb*wstar3 !
+ ! !
+ ! where cet and ceb depend on the entrainment interface jumps, ql, etc. !
+ ! No entrainment is diagnosed unless the wstar3 > 0. Note '1/wstar3fact' is !
+ ! a factor indicating the enhancement of wstar3 due to entrainment process. !
+ ! Q : Below setting of 'wstar3fact = max(..,0.5)'might prevent the possible !
+ ! case when buoyancy consumption by entrainment is stronger than cloud !
+ ! top radiative cooling production. Is that OK ? No. According to bulk !
+ ! modeling study, entrainment buoyancy consumption was always a certain !
+ ! fraction of other net productions, rather than a separate sum. Thus, !
+ ! below max limit of wstar3fact is correct. 'wstar3fact = max(.,0.5)' !
+ ! prevents unreasonable enhancement of CL entrainment rate by cloud-top !
+ ! entrainment instability, CTEI. !
+ ! Q : Use of the same dry entrainment coefficient, 'a1i' both at the CL top !
+ ! and base interfaces may result in too small 'wstar3' and 'ebrk' below, !
+ ! as was seen in my generalized bulk modeling study. This should be re- !
+ ! considered later !
+ ! -------------------------------------------------------------------------- !
+
+ if( wstar3 .gt. 0._kind_phys ) then
+ cet = a1i * evhc / ( jtbu * lbulk )
+ if( kb .eq. pver + 1 ) then
+ wstar3fact = max( 1._kind_phys + 2.5_kind_phys * cet * n2ht * jtzm * dzht, wstar3factcrit )
+ else
+ ceb = a1i / ( jbbu * lbulk )
+ wstar3fact = max( 1._kind_phys + 2.5_kind_phys * cet * n2ht * jtzm * dzht &
+ + 2.5_kind_phys * ceb * n2hb * jbzm * dzhb, wstar3factcrit )
+ end if
+ wstar3 = wstar3 / wstar3fact
+ else ! wstar3 == 0
+ wstar3fact = 0._kind_phys ! This is just for dianostic output
+ cet = 0._kind_phys
+ ceb = 0._kind_phys
+ end if
+
+ ! ---------------------------------------------------------------------------- !
+ ! Calculate net CL mean TKE including entrainment contribution by solving a !
+ ! canonical cubic equation. The solution of cubic equ. is 'rootp**2 = ebrk' !
+ ! where 'ebrk' originally (before solving cubic eq.) was interior CL mean TKE, !
+ ! but after solving cubic equation, it is replaced by net CL mean TKE in the !
+ ! same variable 'ebrk'. !
+ ! ---------------------------------------------------------------------------- !
+ ! Solve cubic equation (canonical form for analytic solution) !
+ ! r^3 - 3*trmp*r - 2*trmq = 0, r = sqrt !
+ ! to estimate for CL, derived from layer-mean TKE balance: !
+ ! !
+ ! ^(3/2)/(b_1*) \approx (*) !
+ ! = (_int * l_int + _et * dzt + _eb * dzb)/lbulk !
+ ! _int = ^(1/2)/(b_1*)*_int !
+ ! _et = (-vyt+vut)*wet*jtbu + radf !
+ ! _eb = (-vyb+vub)*web*jbbu !
+ ! !
+ ! where: !
+ ! <> denotes a vertical avg (over the whole CL unless indicated) !
+ ! l_int (called lbrk below) is aggregate thickness of interior CL layers !
+ ! dzt = zi(i,kt)-z(i,kt) is thickness of top entrainment layer !
+ ! dzb = z(i,kb-1)-zi(i,kb) is thickness of bot entrainment layer !
+ ! _int (called ebrk below) is the CL-mean TKE if only interior !
+ ! interfaces contributed. !
+ ! wet, web are top. bottom entrainment rates !
+ ! !
+ ! For a single-level radiatively-driven convective layer, there are no !
+ ! interior interfaces so 'ebrk' = 'lbrk' = 0. If the CL goes to the !
+ ! surface, 'vyb' and 'vub' are set to zero before and 'ebrk' and 'lbrk' !
+ ! have already incorporated the surface interfacial layer contribution, !
+ ! so the same formulas still apply. !
+ ! !
+ ! In the original formulation based on TKE, !
+ ! wet*jtbu = a1l*evhc*^3/2/leng(i,kt) !
+ ! web*jbbu = a1l*^3/2/leng(i,kt) !
+ ! !
+ ! In the wstar formulation !
+ ! wet*jtbu = a1i*evhc*wstar3/lbulk !
+ ! web*jbbu = a1i*wstar3/lbulk, !
+ ! ---------------------------------------------------------------------------- !
+
+ fact = ( evhc * ( -vyt + vut ) * dzht + ( -vyb + vub ) * dzhb * leng(i,kb) / leng(i,kt) ) / lbulk
+
+ if( wstarent ) then
+
+ ! (Option 1) 'wstar' entrainment formulation
+ ! Here trmq can have either sign, and will usually be nonzero even for non-
+ ! cloud topped CLs. If trmq > 0, there will be two positive roots r; we take
+ ! the larger one. Why ? If necessary, we limit entrainment and wstar to prevent
+ ! a solution with r < ccrit*wstar ( Why ? ) where we take ccrit = 0.5.
+
+ trma = 1._kind_phys
+ trmp = ebrk(i,ncv) * ( lbrk(i,ncv) / lbulk ) / 3._kind_phys + ntzero
+ trmq = 0.5_kind_phys * b1 * ( leng(i,kt) / lbulk ) * ( radf * dzht + a1i * fact * wstar3 )
+
+ ! Check if there is an acceptable root with r > rcrit = ccrit*wstar.
+ ! To do this, first find local minimum fmin of the cubic f(r) at sqrt(p),
+ ! and value fcrit = f(rcrit).
+
+ rmin = sqrt(trmp)
+ fmin = rmin * ( rmin * rmin - 3._kind_phys * trmp ) - 2._kind_phys * trmq
+ wstar = wstar3**onet
+ rcrit = ccrit * wstar
+ fcrit = rcrit * ( rcrit * rcrit - 3._kind_phys * trmp ) - 2._kind_phys * trmq
+
+ ! No acceptable root exists (noroot = .true.) if either:
+ ! 1) rmin < rcrit (in which case cubic is monotone increasing for r > rcrit)
+ ! and f(rcrit) > 0.
+ ! or 2) rmin > rcrit (in which case min of f(r) in r > rcrit is at rmin)
+ ! and f(rmin) > 0.
+ ! In this case, we reduce entrainment and wstar3 such that r/wstar = ccrit;
+ ! this changes the coefficients of the cubic. It might be informative to
+ ! check when and how many 'noroot' cases occur, since when 'noroot', we
+ ! will impose arbitrary limit on 'wstar3, wet, web, and ebrk' using ccrit.
+
+ noroot = ( ( rmin .lt. rcrit ) .and. ( fcrit .gt. 0._kind_phys ) ) &
+ .or. ( ( rmin .ge. rcrit ) .and. ( fmin .gt. 0._kind_phys ) )
+ if( noroot ) then ! Solve cubic for r
+ trma = 1._kind_phys - b1 * ( leng(i,kt) / lbulk ) * a1i * fact / ccrit**3
+ trma = max( trma, 0.5_kind_phys ) ! Limit entrainment enhancement of ebrk
+ trmp = trmp / trma
+ trmq = 0.5_kind_phys * b1 * ( leng(i,kt) / lbulk ) * radf * dzht / trma
+ end if ! noroot
+
+ ! Solve the cubic equation
+
+ qq = trmq**2 - trmp**3
+ if( qq .ge. 0._kind_phys ) then
+ rootp = ( trmq + sqrt(qq) )**(1._kind_phys/3._kind_phys) + ( max( trmq - sqrt(qq), 0._kind_phys ) )**(1._kind_phys/3._kind_phys)
+ else
+ rootp = 2._kind_phys * sqrt(trmp) * cos( acos( trmq / sqrt(trmp**3) ) / 3._kind_phys )
+ end if
+
+ ! Adjust 'wstar3' only if there is 'noroot'.
+ ! And calculate entrainment rates at the top and base interfaces.
+
+ if( noroot ) wstar3 = ( rootp / ccrit )**3 ! Adjust wstar3
+ wet = cet * wstar3 ! Find entrainment rates
+ if( kb .lt. pver + 1 ) web = ceb * wstar3 ! When 'kb.eq.pver+1', it was set to web=0.
+
+ else !
+
+ ! (Option.2) wstarentr = .false. Use original entrainment formulation.
+ ! trmp > 0 if there are interior interfaces in CL, trmp = 0 otherwise.
+ ! trmq > 0 if there is cloudtop radiative cooling, trmq = 0 otherwise.
+
+ trma = 1._kind_phys - b1 * a1l * fact
+ trma = max( trma, 0.5_kind_phys ) ! Prevents runaway entrainment instability
+ trmp = ebrk(i,ncv) * ( lbrk(i,ncv) / lbulk ) / ( 3._kind_phys * trma )
+ trmq = 0.5_kind_phys * b1 * ( leng(i,kt) / lbulk ) * radf * dzht / trma
+
+ qq = trmq**2 - trmp**3
+ if( qq .ge. 0._kind_phys ) then
+ rootp = ( trmq + sqrt(qq) )**(1._kind_phys/3._kind_phys) + ( max( trmq - sqrt(qq), 0._kind_phys ) )**(1._kind_phys/3._kind_phys)
+ else ! Also part of case 3
+ rootp = 2._kind_phys * sqrt(trmp) * cos( acos( trmq / sqrt(trmp**3) ) / 3._kind_phys )
+ end if ! qq
+
+ ! Find entrainment rates and limit them by free-entrainment values a1l*sqrt(e)
+
+ wet = a1l * rootp * min( evhc * rootp**2 / ( leng(i,kt) * jtbu ), 1._kind_phys )
+ if( kb .lt. pver + 1 ) web = a1l * rootp * min( evhc * rootp**2 / ( leng(i,kb) * jbbu ), 1._kind_phys )
+
+ end if ! wstarentr
+
+ ! ---------------------------------------------------- !
+ ! Finally, get the net CL mean TKE and normalized TKE !
+ ! ---------------------------------------------------- !
+
+ ebrk(i,ncv) = rootp**2
+ ebrk(i,ncv) = min(ebrk(i,ncv),tkemax) ! Limit CL-avg TKE used for entrainment
+ wbrk(i,ncv) = ebrk(i,ncv)/b1
+
+ ! The only way ebrk = 0 is for SRCL which are actually radiatively cooled
+ ! at top interface. In this case, we remove 'convective' label from the
+ ! interfaces around this layer. This case should now be impossible, so
+ ! we flag it. Q: I can't understand why this case is impossible now. Maybe,
+ ! due to various limiting procedures used in solving cubic equation ?
+ ! In case of SRCL, 'ebrk' should be positive due to cloud top LW radiative
+ ! cooling contribution, although 'ebrk(internal)' of SRCL before including
+ ! entrainment contribution (which include LW cooling contribution also) is
+ ! zero.
+
+ if( ebrk(i,ncv) .le. 0._kind_phys ) then
+ write(temp_string,*) 'CALEDDY: Warning, CL with zero TKE, i, kt, kb ', i, kt, kb
+ warnstring = trim(warnstring)//temp_string
+ belongcv(i,kt) = .false.
+ belongcv(i,kb) = .false.
+ end if
+
+ ! ----------------------------------------------------------------------- !
+ ! Calculate complete TKE profiles at all CL interfaces, capped by tkemax. !
+ ! We approximate TKE = at entrainment interfaces. However when CL is !
+ ! based at surface, correct 'tkes' will be inserted to tke(i,pver+1). !
+ ! Note that this approximation at CL external interfaces do not influence !
+ ! numerical calculation since 'e' at external interfaces are not used in !
+ ! actual numerical calculation afterward. In addition in order to extract !
+ ! correct TKE averaged over the PBL in the cumulus scheme,it is necessary !
+ ! to set e = at the top entrainment interface. Since net CL mean TKE !
+ ! 'ebrk' obtained by solving cubic equation already includes tkes ( tkes !
+ ! is included when bflxs > 0 but not when bflxs <= 0 into internal ebrk ),!
+ ! 'tkes' should be written to tke(i,pver+1) !
+ ! ----------------------------------------------------------------------- !
+
+ ! 1. At internal interfaces
+ do k = kb - 1, kt + 1, -1
+ rcap = ( b1 * ae + wcap(i,k) / wbrk(i,ncv) ) / ( b1 * ae + 1._kind_phys )
+ rcap = min( max(rcap,rcapmin), rcapmax )
+ tke(i,k) = ebrk(i,ncv) * rcap
+ tke(i,k) = min( tke(i,k), tkemax )
+ kvh(i,k) = leng(i,k) * sqrt(tke(i,k)) * shcl(i,ncv)
+ kvm(i,k) = leng(i,k) * sqrt(tke(i,k)) * smcl(i,ncv)
+ bprod(i,k) = -kvh(i,k) * n2(i,k)
+ sprod(i,k) = kvm(i,k) * s2(i,k)
+ turbtype(i,k) = 2 ! CL interior interfaces.
+ end do
+
+ ! 2. At CL top entrainment interface
+ kentr = wet * jtzm
+ kvh(i,kt) = kentr
+ kvm(i,kt) = kentr
+ bprod(i,kt) = -kentr * n2ht + radf ! I must use 'n2ht' not 'n2'
+ sprod(i,kt) = kentr * s2(i,kt)
+ turbtype(i,kt) = 4 ! CL top entrainment interface
+ trmp = -b1 * ae / ( 1._kind_phys + b1 * ae )
+ trmq = -(bprod(i,kt)+sprod(i,kt))*b1*leng(i,kt)/(1._kind_phys+b1*ae)/(ebrk(i,ncv)**(3._kind_phys/2._kind_phys))
+ rcap = compute_cubic(0._kind_phys,trmp,trmq)**2._kind_phys
+ rcap = min( max(rcap,rcapmin), rcapmax )
+ tke(i,kt) = ebrk(i,ncv) * rcap
+ tke(i,kt) = min( tke(i,kt), tkemax )
+
+ ! 3. At CL base entrainment interface and double entraining interfaces
+ ! When current CL base is also the top interface of CL regime below,
+ ! simply add the two contributions for calculating eddy diffusivity
+ ! and buoyancy/shear production. Below code correctly works because
+ ! we (CL regime index) always go from surface upward.
+
+ if( kb .lt. pver + 1 ) then
+
+ kentr = web * jbzm
+
+ if( kb .ne. ktblw ) then
+
+ kvh(i,kb) = kentr
+ kvm(i,kb) = kentr
+ bprod(i,kb) = -kvh(i,kb)*n2hb ! I must use 'n2hb' not 'n2'
+ sprod(i,kb) = kvm(i,kb)*s2(i,kb)
+ turbtype(i,kb) = 3 ! CL base entrainment interface
+ trmp = -b1*ae/(1._kind_phys+b1*ae)
+ trmq = -(bprod(i,kb)+sprod(i,kb))*b1*leng(i,kb)/(1._kind_phys+b1*ae)/(ebrk(i,ncv)**(3._kind_phys/2._kind_phys))
+ rcap = compute_cubic(0._kind_phys,trmp,trmq)**2._kind_phys
+ rcap = min( max(rcap,rcapmin), rcapmax )
+ tke(i,kb) = ebrk(i,ncv) * rcap
+ tke(i,kb) = min( tke(i,kb),tkemax )
+
+ else
+
+ kvh(i,kb) = kvh(i,kb) + kentr
+ kvm(i,kb) = kvm(i,kb) + kentr
+ ! dzhb5 : Half thickness of the lowest layer of current CL regime
+ ! dzht5 : Half thickness of the highest layer of adjacent CL regime just below current CL.
+ dzhb5 = z(i,kb-1) - zi(i,kb)
+ dzht5 = zi(i,kb) - z(i,kb)
+ bprod(i,kb) = ( dzht5*bprod(i,kb) - dzhb5*kentr*n2hb ) / ( dzhb5 + dzht5 )
+ sprod(i,kb) = ( dzht5*sprod(i,kb) + dzhb5*kentr*s2(i,kb) ) / ( dzhb5 + dzht5 )
+ trmp = -b1*ae/(1._kind_phys+b1*ae)
+ trmq = -kentr*(s2(i,kb)-n2hb)*b1*leng(i,kb)/(1._kind_phys+b1*ae)/(ebrk(i,ncv)**(3._kind_phys/2._kind_phys))
+ rcap = compute_cubic(0._kind_phys,trmp,trmq)**2._kind_phys
+ rcap = min( max(rcap,rcapmin), rcapmax )
+ tke_imsi = ebrk(i,ncv) * rcap
+ tke_imsi = min( tke_imsi, tkemax )
+ tke(i,kb) = ( dzht5*tke(i,kb) + dzhb5*tke_imsi ) / ( dzhb5 + dzht5 )
+ tke(i,kb) = min(tke(i,kb),tkemax)
+ turbtype(i,kb) = 5 ! CL double entraining interface
+
+ end if
+
+ else
+
+ ! If CL base interface is surface, compute similarly using wcap(i,kb)=tkes/b1
+ ! Even when bflx < 0, use the same formula in order to impose consistency of
+ ! tke(i,kb) at bflx = 0._kind_phys
+
+ rcap = (b1*ae + wcap(i,kb)/wbrk(i,ncv))/(b1*ae + 1._kind_phys)
+ rcap = min( max(rcap,rcapmin), rcapmax )
+ tke(i,kb) = ebrk(i,ncv) * rcap
+ tke(i,kb) = min( tke(i,kb),tkemax )
+
+ end if
+
+ ! Calculate wcap at all interfaces of CL. Put a minimum threshold on TKE
+ ! to prevent possible division by zero. 'wcap' at CL internal interfaces
+ ! are already calculated in the first part of 'do ncv' loop correctly.
+ ! When 'kb.eq.pver+1', below formula produces the identical result to the
+ ! 'tkes(i)/b1' if leng(i,kb) is set to vk*z(i,pver). Note wcap(i,pver+1)
+ ! is already defined as 'tkes(i)/b1' at the first part of caleddy.
+
+ wcap(i,kt) = (bprod(i,kt)+sprod(i,kt))*leng(i,kt)/sqrt(max(tke(i,kt),1.e-6_kind_phys))
+ if( kb .lt. pver + 1 ) then
+ wcap(i,kb) = (bprod(i,kb)+sprod(i,kb))*leng(i,kb)/sqrt(max(tke(i,kb),1.e-6_kind_phys))
+ end if
+
+ ! Save the index of upper external interface of current CL-regime in order to
+ ! handle the case when this interface is also the lower external interface of
+ ! CL-regime located just above.
+
+ ktblw = kt
+
+ ! Diagnostic Output
+
+ wet_CL(i,ncv) = wet
+ web_CL(i,ncv) = web
+ jtbu_CL(i,ncv) = jtbu
+ jbbu_CL(i,ncv) = jbbu
+ evhc_CL(i,ncv) = evhc
+ jt2slv_CL(i,ncv) = jt2slv
+ n2ht_CL(i,ncv) = n2ht
+ n2hb_CL(i,ncv) = n2hb
+ wstar_CL(i,ncv) = wstar
+ wstar3fact_CL(i,ncv) = wstar3fact
+
+ end do ! ncv
+
+ ! Calculate PBL height and characteristic cumulus excess for use in the
+ ! cumulus convection shceme. Also define turbulence type at the surface
+ ! when the lowest CL is based at the surface. These are just diagnostic
+ ! outputs, not influencing numerical calculation of current PBL scheme.
+ ! If the lowest CL is based at the surface, define the PBL depth as the
+ ! CL top interface. The same rule is applied for all CLs including SRCL.
+
+ if( ncvsurf .gt. 0 ) then
+
+ ktopbl(i) = ktop(i,ncvsurf)
+ pblh(i) = zi(i, ktopbl(i))
+ pblhp(i) = pi(i, ktopbl(i))
+ wpert(i) = max(wfac*sqrt(ebrk(i,ncvsurf)),wpertmin)
+ tpert(i) = max(abs(shflx(i)*rrho(i)/cpair)*tfac/wpert(i),0._kind_phys)
+ qpert(i) = max(abs(qflx(i)*rrho(i))*tfac/wpert(i),0._kind_phys)
+
+ if( bflxs(i) .gt. 0._kind_phys ) then
+ turbtype(i,pver+1) = 2 ! CL interior interface
+ else
+ turbtype(i,pver+1) = 3 ! CL external base interface
+ endif
+
+ ipbl(i) = 1
+ end if ! End of the calculationf of te properties of surface-based CL.
+
+ ! -------------------------------------------- !
+ ! Treatment of Stable Turbulent Regime ( STL ) !
+ ! -------------------------------------------- !
+
+ ! Identify top and bottom most (internal) interfaces of STL except surface.
+ ! Also, calculate 'turbulent length scale (leng)' at each STL interfaces.
+
+ belongst(i,1) = .false. ! k = 1 (top interface) is assumed non-turbulent
+ do k = 2, pver ! k is an interface index
+ belongst(i,k) = ( ri(i,k) .lt. ricrit ) .and. ( .not. belongcv(i,k) )
+ if( belongst(i,k) .and. ( .not. belongst(i,k-1) ) ) then
+ kt = k ! Top interface index of STL
+ elseif( .not. belongst(i,k) .and. belongst(i,k-1) ) then
+ kb = k - 1 ! Base interface index of STL
+ lbulk = z(i,kt-1) - z(i,kb)
+ lbulk = min( lbulk, lbulk_max )
+ do ks = kt, kb
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = max( 1.e-3_kind_phys, ctunl * tunl * exp(-log(ctunl)*ri(i,ks)/ricrit) )
+ ! tunlramp = 0.065_kind_phys + 0.7_kind_phys * exp(-20._kind_phys*ri(i,ks))
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ leng(i,ks) = ( (vk*zi(i,ks))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! leng(i,ks) = vk*zi(i,ks) / (1._kind_phys+vk*zi(i,ks)/(tunlramp*lbulk))
+ else
+ leng(i,ks) = min( vk*zi(i,ks), tunlramp*lbulk )
+ endif
+ leng(i,ks) = min(leng_max(ks), leng(i,ks))
+ end do
+ end if
+ end do ! k
+
+ ! Now look whether STL extends to ground. If STL extends to surface,
+ ! re-define master length scale,'lbulk' including surface interfacial
+ ! layer thickness, and re-calculate turbulent length scale, 'leng' at
+ ! all STL interfaces again. Note that surface interface is assumed to
+ ! always be STL if it is not CL.
+
+ belongst(i,pver+1) = .not. belongcv(i,pver+1)
+
+ if( belongst(i,pver+1) ) then ! kb = pver+1 (surface STL)
+
+ turbtype(i,pver+1) = 1 ! Surface is STL interface
+
+ if( belongst(i,pver) ) then ! STL includes interior
+ ! 'kt' already defined above as the top interface of STL
+ lbulk = z(i,kt-1)
+ else ! STL with no interior turbulence
+ kt = pver+1
+ lbulk = z(i,kt-1)
+ end if
+ lbulk = min( lbulk, lbulk_max )
+
+ ! PBL height : Layer mid-point just above the highest STL interface
+ ! Note in contrast to the surface based CL regime where PBL height
+ ! was defined at the top external interface, PBL height of surface
+ ! based STL is defined as the layer mid-point.
+
+ ktopbl(i) = kt - 1
+ pblh(i) = z(i,ktopbl(i))
+ pblhp(i) = 0.5_kind_phys * ( pi(i,ktopbl(i)) + pi(i,ktopbl(i)+1) )
+
+ ! Re-calculate turbulent length scale including surface interfacial
+ ! layer contribution to lbulk.
+
+ do ks = kt, pver
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = max(1.e-3_kind_phys,ctunl*tunl*exp(-log(ctunl)*ri(i,ks)/ricrit))
+ ! tunlramp = 0.065_kind_phys + 0.7_kind_phys * exp(-20._kind_phys*ri(i,ks))
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ leng(i,ks) = ( (vk*zi(i,ks))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! leng(i,ks) = vk*zi(i,ks) / (1._kind_phys+vk*zi(i,ks)/(tunlramp*lbulk))
+ else
+ leng(i,ks) = min( vk*zi(i,ks), tunlramp*lbulk )
+ endif
+ leng(i,ks) = min(leng_max(ks), leng(i,ks))
+ end do ! ks
+
+ ! Characteristic cumulus excess of surface-based STL.
+ ! We may be able to use ustar for wpert.
+
+ wpert(i) = 0._kind_phys
+ tpert(i) = max(shflx(i)*rrho(i)/cpair*fak/ustar(i),0._kind_phys) ! CCM stable-layer forms
+ qpert(i) = max(qflx(i)*rrho(i)*fak/ustar(i),0._kind_phys)
+
+ ipbl(i) = 0
+
+ end if
+
+ ! Calculate stability functions and energetics at the STL interfaces
+ ! except the surface. Note that tke(i,pver+1) and wcap(i,pver+1) are
+ ! already calculated in the first part of 'caleddy', kvm(i,pver+1) &
+ ! kvh(i,pver+1) were already initialized to be zero, bprod(i,pver+1)
+ ! & sprod(i,pver+1) were direcly calculated from the bflxs and ustar.
+ ! Note transport term is assumed to be negligible at STL interfaces.
+
+ do k = 2, pver
+
+ if( belongst(i,k) ) then
+
+ turbtype(i,k) = 1 ! STL interfaces
+ trma = alph3*alph4exs*ri(i,k) + 2._kind_phys*b1*(alph2-alph4exs*alph5*ri(i,k))
+ trmb = (alph3+alph4exs)*ri(i,k) + 2._kind_phys*b1*(-alph5*ri(i,k)+alph1)
+ trmc = ri(i,k)
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ ! Sanity Check
+ if( det .lt. 0._kind_phys ) then
+ errstring = 'The det < 0. for the STL in UW eddy_diff'
+ return
+ end if
+ gh = (-trmb + sqrt(det))/(2._kind_phys*trma)
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ ! gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,ghmin),0.0233_kind_phys)
+ sh = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ sm = max(0._kind_phys,(alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4exs*gh))
+
+ tke(i,k) = b1*(leng(i,k)**2)*(-sh*n2(i,k)+sm*s2(i,k))
+ tke(i,k) = min(tke(i,k),tkemax)
+ wcap(i,k) = tke(i,k)/b1
+ kvh(i,k) = leng(i,k) * sqrt(tke(i,k)) * sh
+ kvm(i,k) = leng(i,k) * sqrt(tke(i,k)) * sm
+ bprod(i,k) = -kvh(i,k) * n2(i,k)
+ sprod(i,k) = kvm(i,k) * s2(i,k)
+
+ end if
+
+ end do ! k
+
+ ! --------------------------------------------------- !
+ ! End of treatment of Stable Turbulent Regime ( STL ) !
+ ! --------------------------------------------------- !
+
+ ! --------------------------------------------------------------- !
+ ! Re-computation of eddy diffusivity at the entrainment interface !
+ ! assuming that it is purely STL (00.19, !
+ ! turbulent can exist at the entrainment interface since 'Sh,Sm' !
+ ! do not necessarily go to zero even when Ri>0.19. Since Ri can !
+ ! be fairly larger than 0.19 at the entrainment interface, I !
+ ! should set minimum value of 'tke' to be 0. in order to prevent !
+ ! sqrt(tke) from being imaginary. !
+ ! --------------------------------------------------------------- !
+
+ ! goto 888
+
+ do k = 2, pver
+
+ if( ( turbtype(i,k) .eq. 3 ) .or. ( turbtype(i,k) .eq. 4 ) .or. &
+ ( turbtype(i,k) .eq. 5 ) ) then
+
+ trma = alph3*alph4exs*ri(i,k) + 2._kind_phys*b1*(alph2-alph4exs*alph5*ri(i,k))
+ trmb = (alph3+alph4exs)*ri(i,k) + 2._kind_phys*b1*(-alph5*ri(i,k)+alph1)
+ trmc = ri(i,k)
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ gh = (-trmb + sqrt(det))/(2._kind_phys*trma)
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ ! gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,ghmin),0.0233_kind_phys)
+ sh = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ sm = max(0._kind_phys,(alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4exs*gh))
+
+ lbulk = z(i,k-1) - z(i,k)
+ lbulk = min( lbulk, lbulk_max )
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = max(1.e-3_kind_phys,ctunl*tunl*exp(-log(ctunl)*ri(i,k)/ricrit))
+ ! tunlramp = 0.065_kind_phys + 0.7_kind_phys*exp(-20._kind_phys*ri(i,k))
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ leng_imsi = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! leng_imsi = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ leng_imsi = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ leng_imsi = min(leng_max(k), leng_imsi)
+
+ tke_imsi = b1*(leng_imsi**2)*(-sh*n2(i,k)+sm*s2(i,k))
+ tke_imsi = min(max(tke_imsi,0._kind_phys),tkemax)
+ kvh_imsi = leng_imsi * sqrt(tke_imsi) * sh
+ kvm_imsi = leng_imsi * sqrt(tke_imsi) * sm
+
+ if( kvh(i,k) .lt. kvh_imsi ) then
+ kvh(i,k) = kvh_imsi
+ kvm(i,k) = kvm_imsi
+ leng(i,k) = leng_imsi
+ tke(i,k) = tke_imsi
+ wcap(i,k) = tke_imsi / b1
+ bprod(i,k) = -kvh_imsi * n2(i,k)
+ sprod(i,k) = kvm_imsi * s2(i,k)
+ turbtype(i,k) = 1 ! This was added on Dec.10.2009 for use in microphysics.
+ endif
+
+ end if
+
+ end do
+
+ ! 888 continue
+
+ ! ------------------------------------------------------------------ !
+ ! End of recomputation of eddy diffusivity at entrainment interfaces !
+ ! ------------------------------------------------------------------ !
+
+ ! As an option, we can impose a certain minimum back-ground diffusivity.
+
+ ! do k = 1, pver+1
+ ! kvh(i,k) = max(0.01_kind_phys,kvh(i,k))
+ ! kvm(i,k) = max(0.01_kind_phys,kvm(i,k))
+ ! enddo
+
+ ! --------------------------------------------------------------------- !
+ ! Diagnostic Output !
+ ! Just for diagnostic purpose, calculate stability functions at each !
+ ! interface including surface. Instead of assuming neutral stability, !
+ ! explicitly calculate stability functions using an reverse procedure !
+ ! starting from tkes(i) similar to the case of SRCL and SBCL in zisocl. !
+ ! Note that it is possible to calculate stability functions even when !
+ ! bflxs < 0. Note that this inverse method allows us to define Ri even !
+ ! at the surface. Note also tkes(i) and sprod(i,pver+1) are always !
+ ! positive values by limiters (e.g., ustar_min = 0.01). !
+ ! Dec.12.2006 : Also just for diagnostic output, re-set !
+ ! 'bprod(i,pver+1)= bflxs(i)' here. Note that this setting does not !
+ ! influence numerical calculation at all - it is just for diagnostic !
+ ! output. !
+ ! --------------------------------------------------------------------- !
+
+ bprod(i,pver+1) = bflxs(i)
+
+ gg = 0.5_kind_phys*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._kind_phys/2._kind_phys))
+ if( abs(alph5-gg*alph3) .le. 1.e-7_kind_phys ) then
+ ! gh = -0.28_kind_phys
+ if( bprod(i,pver+1) .gt. 0._kind_phys ) then
+ gh = -3.5334_kind_phys
+ else
+ gh = ghmin
+ endif
+ else
+ gh = gg/(alph5-gg*alph3)
+ end if
+
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ if( bprod(i,pver+1) .gt. 0._kind_phys ) then
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ else
+ gh = min(max(gh,ghmin),0.0233_kind_phys)
+ endif
+
+ gh_a(i,pver+1) = gh
+ sh_a(i,pver+1) = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ if( bprod(i,pver+1) .gt. 0._kind_phys ) then
+ sm_a(i,pver+1) = max(0._kind_phys,(alph1+alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh))
+ else
+ sm_a(i,pver+1) = max(0._kind_phys,(alph1+alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4exs*gh))
+ endif
+ ri_a(i,pver+1) = -(sm_a(i,pver+1)/sh_a(i,pver+1))*(bprod(i,pver+1)/sprod(i,pver+1))
+
+ do k = 1, pver
+ if( ri(i,k) .lt. 0._kind_phys ) then
+ trma = alph3*alph4*ri(i,k) + 2._kind_phys*b1*(alph2-alph4*alph5*ri(i,k))
+ trmb = (alph3+alph4)*ri(i,k) + 2._kind_phys*b1*(-alph5*ri(i,k)+alph1)
+ trmc = ri(i,k)
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ gh = (-trmb + sqrt(det))/(2._kind_phys*trma)
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ gh_a(i,k) = gh
+ sh_a(i,k) = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ sm_a(i,k) = max(0._kind_phys,(alph1+alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh))
+ ri_a(i,k) = ri(i,k)
+ else
+ if( ri(i,k) .gt. ricrit ) then
+ gh_a(i,k) = ghmin
+ sh_a(i,k) = 0._kind_phys
+ sm_a(i,k) = 0._kind_phys
+ ri_a(i,k) = ri(i,k)
+ else
+ trma = alph3*alph4exs*ri(i,k) + 2._kind_phys*b1*(alph2-alph4exs*alph5*ri(i,k))
+ trmb = (alph3+alph4exs)*ri(i,k) + 2._kind_phys*b1*(-alph5*ri(i,k)+alph1)
+ trmc = ri(i,k)
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ gh = (-trmb + sqrt(det))/(2._kind_phys*trma)
+ gh = min(max(gh,ghmin),0.0233_kind_phys)
+ gh_a(i,k) = gh
+ sh_a(i,k) = max(0._kind_phys,alph5/(1._kind_phys+alph3*gh))
+ sm_a(i,k) = max(0._kind_phys,(alph1+alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4exs*gh))
+ ri_a(i,k) = ri(i,k)
+ endif
+ endif
+
+ end do
+
+ end do ! End of column index loop, i
+
+ end subroutine caleddy
+
+ !============================================================================== !
+ ! !
+ !============================================================================== !
+
+ subroutine exacol( ncol, pver, ri, bflxs, minpblh, zi, ktop, kbase, ncvfin )
+
+ ! ---------------------------------------------------------------------------- !
+ ! Object : Find unstable CL regimes and determine the indices !
+ ! kbase, ktop which delimit these unstable layers : !
+ ! ri(kbase) > 0 and ri(ktop) > 0, but ri(k) < 0 for ktop < k < kbase. !
+ ! Author : Chris Bretherton 08/2000, !
+ ! Sungsu Park 08/2006, 11/2008 !
+ !----------------------------------------------------------------------------- !
+
+ ! --------------- !
+ ! Input variables !
+ ! --------------- !
+
+ integer, intent(in) :: ncol ! Number of atmospheric columns
+ integer, intent(in) :: pver ! Number of atmospheric vertical layers
+
+ real(kind_phys), intent(in) :: ri(ncol,pver) ! Moist gradient Richardson no.
+ real(kind_phys), intent(in) :: bflxs(ncol) ! Buoyancy flux at surface
+ real(kind_phys), intent(in) :: minpblh(ncol) ! Minimum PBL height based on surface stress
+ real(kind_phys), intent(in) :: zi(ncol,pver+1) ! Interface heights
+
+ ! ---------------- !
+ ! Output variables !
+ ! ---------------- !
+
+ integer, intent(out) :: kbase(ncol,ncvmax) ! External interface index of CL base
+ integer, intent(out) :: ktop(ncol,ncvmax) ! External interface index of CL top
+ integer, intent(out) :: ncvfin(ncol) ! Total number of CLs
+
+ ! --------------- !
+ ! Local variables !
+ ! --------------- !
+
+ integer :: i
+ integer :: k
+ integer :: ncv
+ real(kind_phys) :: rimaxentr
+ real(kind_phys) :: riex(pver+1) ! Column Ri profile extended to surface
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ do i = 1, ncol
+ ncvfin(i) = 0
+ do ncv = 1, ncvmax
+ ktop(i,ncv) = 0
+ kbase(i,ncv) = 0
+ end do
+ end do
+
+ ! ------------------------------------------------------ !
+ ! Find CL regimes starting from the surface going upward !
+ ! ------------------------------------------------------ !
+
+ rimaxentr = 0._kind_phys
+
+ do i = 1, ncol
+
+ riex(2:pver) = ri(i,2:pver)
+
+ ! Below allows consistent treatment of surface and other interfaces.
+ ! Simply, if surface buoyancy flux is positive, Ri of surface is set to be negative.
+
+ riex(pver+1) = rimaxentr - bflxs(i)
+
+ ncv = 0
+ k = pver + 1 ! Work upward from surface interface
+
+ do while ( k .gt. ntop_turb + 1 )
+
+ ! Below means that if 'bflxs > 0' (do not contain '=' sign), surface
+ ! interface is energetically interior surface.
+
+ if( riex(k) .lt. rimaxentr ) then
+
+ ! Identify a new CL
+
+ ncv = ncv + 1
+
+ ! First define 'kbase' as the first interface below the lower-most unstable interface
+ ! Thus, Richardson number at 'kbase' is positive.
+
+ kbase(i,ncv) = min(k+1,pver+1)
+
+ ! Decrement k until top unstable level
+
+ do while( riex(k) .lt. rimaxentr .and. k .gt. ntop_turb + 1 )
+ k = k - 1
+ end do
+
+ ! ktop is the first interface above upper-most unstable interface
+ ! Thus, Richardson number at 'ktop' is positive.
+
+ ktop(i,ncv) = k
+
+ else
+
+ ! Search upward for a CL.
+
+ k = k - 1
+
+ end if
+
+ end do ! End of CL regime finding for each atmospheric column
+
+ ncvfin(i) = ncv
+
+ end do ! End of atmospheric column do loop
+
+ end subroutine exacol
+
+ !============================================================================== !
+ ! !
+ !============================================================================== !
+
+ subroutine zisocl( ncol , pver , long , &
+ z , zi , n2 , s2 , &
+ bprod , sprod , bflxs, tkes , &
+ ncvfin , kbase , ktop , belongcv, &
+ ricl , ghcl , shcl , smcl , &
+ lbrk , wbrk , ebrk , extend , extend_up, extend_dn,&
+ errstring)
+
+ !------------------------------------------------------------------------ !
+ ! Object : This 'zisocl' vertically extends original CLs identified from !
+ ! 'exacol' using a merging test based on either 'wint' or 'l2n2' !
+ ! and identify new CL regimes. Similar to the case of 'exacol', !
+ ! CL regime index increases with height. After identifying new !
+ ! CL regimes ( kbase, ktop, ncvfin ),calculate CL internal mean !
+ ! energetics (lbrk : energetic thickness integral, wbrk, ebrk ) !
+ ! and stability functions (ricl, ghcl, shcl, smcl) by including !
+ ! surface interfacial layer contribution when bflxs > 0. Note !
+ ! that there are two options in the treatment of the energetics !
+ ! of surface interfacial layer (use_dw_surf= 'true' or 'false') !
+ ! Author : Sungsu Park 08/2006, 11/2008 !
+ !------------------------------------------------------------------------ !
+
+ ! --------------- !
+ ! Input variables !
+ ! --------------- !
+
+ integer, intent(in) :: long ! Longitude of the column
+ integer, intent(in) :: ncol ! Number of atmospheric columns
+ integer, intent(in) :: pver ! Number of atmospheric vertical layers
+ real(kind_phys), intent(in) :: z(ncol, pver) ! Layer mid-point height [ m ]
+ real(kind_phys), intent(in) :: zi(ncol, pver+1) ! Interface height [ m ]
+ real(kind_phys), intent(in) :: n2(ncol, pver) ! Buoyancy frequency at interfaces except surface [ s-2 ]
+ real(kind_phys), intent(in) :: s2(ncol, pver) ! Shear frequency at interfaces except surface [ s-2 ]
+ real(kind_phys), intent(in) :: bprod(ncol,pver+1) ! Buoyancy production [ m2/s3 ]. bprod(i,pver+1) = bflxs
+ real(kind_phys), intent(in) :: sprod(ncol,pver+1) ! Shear production [ m2/s3 ]. sprod(i,pver+1) = usta**3/(vk*z(i,pver))
+ real(kind_phys), intent(in) :: bflxs(ncol) ! Surface buoyancy flux [ m2/s3 ]. bprod(i,pver+1) = bflxs
+ real(kind_phys), intent(in) :: tkes(ncol) ! TKE at the surface [ s2/s2 ]
+
+ ! ---------------------- !
+ ! Input/output variables !
+ ! ---------------------- !
+
+ integer, intent(inout) :: kbase(ncol,ncvmax) ! Base external interface index of CL
+ integer, intent(inout) :: ktop(ncol,ncvmax) ! Top external interface index of CL
+ integer, intent(inout) :: ncvfin(ncol) ! Total number of CLs
+
+ ! ---------------- !
+ ! Output variables !
+ ! ---------------- !
+
+ logical, intent(out) :: belongcv(ncol,pver+1) ! True if interface is in a CL ( either internal or external )
+ real(kind_phys), intent(out) :: ricl(ncol,ncvmax) ! Mean Richardson number of internal CL
+ real(kind_phys), intent(out) :: ghcl(ncol,ncvmax) ! Half of normalized buoyancy production of internal CL
+ real(kind_phys), intent(out) :: shcl(ncol,ncvmax) ! Galperin instability function of heat-moisture of internal CL
+ real(kind_phys), intent(out) :: smcl(ncol,ncvmax) ! Galperin instability function of momentum of internal CL
+ real(kind_phys), intent(out) :: lbrk(ncol,ncvmax) ! Thickness of (energetically) internal CL ( lint, [m] )
+ real(kind_phys), intent(out) :: wbrk(ncol,ncvmax) ! Mean normalized TKE of internal CL [ m2/s2 ]
+ real(kind_phys), intent(out) :: ebrk(ncol,ncvmax) ! Mean TKE of internal CL ( b1*wbrk, [m2/s2] )
+
+ character(len=*), intent(out) :: errstring
+ ! ------------------ !
+ ! Internal variables !
+ ! ------------------ !
+
+ logical :: extend ! True when CL is extended in zisocl
+ logical :: extend_up ! True when CL is extended upward in zisocl
+ logical :: extend_dn ! True when CL is extended downward in zisocl
+ logical :: bottom ! True when CL base is at surface ( kb = pver + 1 )
+
+ integer :: i ! Local index for the longitude
+ integer :: ncv ! CL Index increasing with height
+ integer :: incv
+ integer :: k
+ integer :: kb ! Local index for kbase
+ integer :: kt ! Local index for ktop
+ integer :: ncvinit ! Value of ncv at routine entrance
+ integer :: cntu ! Number of merged CLs during upward extension of individual CL
+ integer :: cntd ! Number of merged CLs during downward extension of individual CL
+ integer :: kbinc ! Index for incorporating underlying CL
+ integer :: ktinc ! Index for incorporating overlying CL
+
+ real(kind_phys) :: wint ! Normalized TKE of internal CL
+ real(kind_phys) :: dwinc ! Normalized TKE of CL external interfaces
+ real(kind_phys) :: dw_surf ! Normalized TKE of surface interfacial layer
+ real(kind_phys) :: dzinc
+ real(kind_phys) :: gh
+ real(kind_phys) :: sh
+ real(kind_phys) :: sm
+ real(kind_phys) :: gh_surf ! Half of normalized buoyancy production in surface interfacial layer
+ real(kind_phys) :: sh_surf ! Galperin instability function in surface interfacial layer
+ real(kind_phys) :: sm_surf ! Galperin instability function in surface interfacial layer
+ real(kind_phys) :: l2n2 ! Vertical integral of 'l^2N^2' over CL. Include thickness product
+ real(kind_phys) :: l2s2 ! Vertical integral of 'l^2S^2' over CL. Include thickness product
+ real(kind_phys) :: dl2n2 ! Vertical integration of 'l^2*N^2' of CL external interfaces
+ real(kind_phys) :: dl2s2 ! Vertical integration of 'l^2*S^2' of CL external interfaces
+ real(kind_phys) :: dl2n2_surf ! 'dl2n2' defined in the surface interfacial layer
+ real(kind_phys) :: dl2s2_surf ! 'dl2s2' defined in the surface interfacial layer
+ real(kind_phys) :: lint ! Thickness of (energetically) internal CL
+ real(kind_phys) :: dlint ! Interfacial layer thickness of CL external interfaces
+ real(kind_phys) :: dlint_surf ! Surface interfacial layer thickness
+ real(kind_phys) :: lbulk ! Master Length Scale : Whole CL thickness from top to base external interface
+ real(kind_phys) :: lz ! Turbulent length scale
+ real(kind_phys) :: ricll ! Mean Richardson number of internal CL
+ real(kind_phys) :: trma
+ real(kind_phys) :: trmb
+ real(kind_phys) :: trmc
+ real(kind_phys) :: det
+ real(kind_phys) :: zbot ! Height of CL base
+ real(kind_phys) :: l2rat ! Square of ratio of actual to initial CL (not used)
+ real(kind_phys) :: gg ! Intermediate variable used for calculating stability functions of SBCL
+ real(kind_phys) :: tunlramp ! Ramping tunl
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ i = long
+
+ ! Initialize main output variables
+
+ do k = 1, ncvmax
+ ricl(i,k) = 0._kind_phys
+ ghcl(i,k) = 0._kind_phys
+ shcl(i,k) = 0._kind_phys
+ smcl(i,k) = 0._kind_phys
+ lbrk(i,k) = 0._kind_phys
+ wbrk(i,k) = 0._kind_phys
+ ebrk(i,k) = 0._kind_phys
+ end do
+ extend = .false.
+ extend_up = .false.
+ extend_dn = .false.
+
+ ! ----------------------------------------------------------- !
+ ! Loop over each CL to see if any of them need to be extended !
+ ! ----------------------------------------------------------- !
+
+ ncv = 1
+
+ do while( ncv .le. ncvfin(i) )
+
+ ncvinit = ncv
+ cntu = 0
+ cntd = 0
+ kb = kbase(i,ncv)
+ kt = ktop(i,ncv)
+
+ ! ---------------------------------------------------------------------------- !
+ ! Calculation of CL interior energetics including surface before extension !
+ ! ---------------------------------------------------------------------------- !
+ ! Note that the contribution of interior interfaces (not surface) to 'wint' is !
+ ! accounted by using '-sh*l2n2 + sm*l2s2' while the contribution of surface is !
+ ! accounted by using 'dwsurf = tkes/b1' when bflxs > 0. This approach is fully !
+ ! reasonable. Another possible alternative, which seems to be also consistent !
+ ! is to calculate 'dl2n2_surf' and 'dl2s2_surf' of surface interfacial layer !
+ ! separately, and this contribution is explicitly added by initializing 'l2n2' !
+ ! 'l2s2' not by zero, but by 'dl2n2_surf' and 'ds2n2_surf' below. At the same !
+ ! time, 'dwsurf' should be excluded in 'wint' calculation below. The only diff.!
+ ! between two approaches is that in case of the latter approach, contributions !
+ ! of surface interfacial layer to the CL mean stability function (ri,gh,sh,sm) !
+ ! are explicitly included while the first approach is not. In this sense, the !
+ ! second approach seems to be more conceptually consistent, but currently, I !
+ ! (Sungsu) will keep the first default approach. There is a switch !
+ ! 'use_dw_surf' at the first part of eddy_diff.F90 chosing one of !
+ ! these two options. !
+ ! ---------------------------------------------------------------------------- !
+
+ ! ------------------------------------------------------ !
+ ! Step 0: Calculate surface interfacial layer energetics !
+ ! ------------------------------------------------------ !
+
+ lbulk = zi(i,kt) - zi(i,kb)
+ lbulk = min( lbulk, lbulk_max )
+ dlint_surf = 0._kind_phys
+ dl2n2_surf = 0._kind_phys
+ dl2s2_surf = 0._kind_phys
+ dw_surf = 0._kind_phys
+ if( kb .eq. pver+1 ) then
+
+ if( bflxs(i) .gt. 0._kind_phys ) then
+
+ ! Calculate stability functions of surface interfacial layer
+ ! from the given 'bprod(i,pver+1)' and 'sprod(i,pver+1)' using
+ ! inverse approach. Since alph5>0 and alph3<0, denominator of
+ ! gg is always positive if bprod(i,pver+1)>0.
+
+ gg = 0.5_kind_phys*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._kind_phys/2._kind_phys))
+ gh = gg/(alph5-gg*alph3)
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ sh = alph5/(1._kind_phys+alph3*gh)
+ sm = (alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh)
+ ricll = min(-(sm/sh)*(bprod(i,pver+1)/sprod(i,pver+1)),ricrit)
+
+ ! Calculate surface interfacial layer contribution to CL internal
+ ! energetics. By construction, 'dw_surf = -dl2n2_surf + ds2n2_surf'
+ ! is exactly satisfied, which corresponds to assuming turbulent
+ ! length scale of surface interfacial layer = vk * z(i,pver). Note
+ ! 'dl2n2_surf','dl2s2_surf','dw_surf' include thickness product.
+
+ dlint_surf = z(i,pver)
+ dl2n2_surf = -vk*(z(i,pver)**2)*bprod(i,pver+1)/(sh*sqrt(tkes(i)))
+ dl2s2_surf = vk*(z(i,pver)**2)*sprod(i,pver+1)/(sm*sqrt(tkes(i)))
+ dw_surf = (tkes(i)/b1)*z(i,pver)
+
+ else
+
+ ! Note that this case can happen when surface is an external
+ ! interface of CL.
+ lbulk = zi(i,kt) - z(i,pver)
+ lbulk = min( lbulk, lbulk_max )
+
+ end if
+
+ end if
+
+ ! ------------------------------------------------------ !
+ ! Step 1: Include surface interfacial layer contribution !
+ ! ------------------------------------------------------ !
+
+ lint = dlint_surf
+ l2n2 = dl2n2_surf
+ l2s2 = dl2s2_surf
+ wint = dw_surf
+ if( use_dw_surf ) then
+ l2n2 = 0._kind_phys
+ l2s2 = 0._kind_phys
+ else
+ wint = 0._kind_phys
+ end if
+
+ ! --------------------------------------------------------------------------------- !
+ ! Step 2. Include the contribution of 'pure internal interfaces' other than surface !
+ ! --------------------------------------------------------------------------------- !
+
+ if( kt .lt. kb - 1 ) then ! The case of non-SBCL.
+
+ do k = kb - 1, kt + 1, -1
+ if( choice_tunl .eq. 'rampcl' ) then
+ ! Modification : I simply used the average tunlramp between the two limits.
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(k), lz)
+ dzinc = z(i,k-1) - z(i,k)
+ l2n2 = l2n2 + lz*lz*n2(i,k)*dzinc
+ l2s2 = l2s2 + lz*lz*s2(i,k)*dzinc
+ lint = lint + dzinc
+ end do
+
+ ! Calculate initial CL stability functions (gh,sh,sm) and net
+ ! internal energy of CL including surface contribution if any.
+
+ ! Modification : It seems that below cannot be applied when ricrit > 0.19.
+ ! May need future generalization.
+
+ ricll = min(l2n2/max(l2s2,ntzero),ricrit) ! Mean Ri of internal CL
+ trma = alph3*alph4*ricll+2._kind_phys*b1*(alph2-alph4*alph5*ricll)
+ trmb = ricll*(alph3+alph4)+2._kind_phys*b1*(-alph5*ricll+alph1)
+ trmc = ricll
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ gh = (-trmb + sqrt(det))/2._kind_phys/trma
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ sh = alph5/(1._kind_phys+alph3*gh)
+ sm = (alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh)
+ wint = wint - sh*l2n2 + sm*l2s2
+
+ else ! The case of SBCL
+
+ ! If there is no pure internal interface, use only surface interfacial
+ ! values. However, re-set surface interfacial values such that it can
+ ! be used in the merging tests (either based on 'wint' or 'l2n2') and
+ ! in such that surface interfacial energy is not double-counted.
+ ! Note that regardless of the choise of 'use_dw_surf', below should be
+ ! kept as it is below, for consistent merging test of extending SBCL.
+
+ lint = dlint_surf
+ l2n2 = dl2n2_surf
+ l2s2 = dl2s2_surf
+ wint = dw_surf
+
+ ! Aug.29.2006 : Only for the purpose of merging test of extending SRCL
+ ! based on 'l2n2', re-define 'l2n2' of surface interfacial layer using
+ ! 'wint'. This part is designed for similar treatment of merging as in
+ ! the original 'eddy_diff.F90' code, where 'l2n2' of SBCL was defined
+ ! as 'l2n2 = - wint / sh'. Note that below block is used only when (1)
+ ! surface buoyancy production 'bprod(i,pver+1)' is NOT included in the
+ ! calculation of surface TKE in the initialization of 'bprod(i,pver+1)'
+ ! in the main subroutine ( even though bflxs > 0 ), and (2) to force
+ ! current scheme be similar to the previous scheme in the treatment of
+ ! extending-merging test of SBCL based on 'l2n2'. Otherwise below line
+ ! must be commented out. Note at this stage, correct non-zero value of
+ ! 'sh' has been already computed.
+
+ if( choice_tkes .eq. 'ebprod' ) then
+ l2n2 = - wint / sh
+ endif
+
+ endif
+
+ ! Set consistent upper limits on 'l2n2' and 'l2s2'. Below limits are
+ ! reasonable since l2n2 of CL interior interface is always negative.
+
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = min( l2s2, tkemax*lint/(b1*sm))
+
+ ! Note that at this stage, ( gh, sh, sm ) are the values of surface
+ ! interfacial layer if there is no pure internal interface, while if
+ ! there is pure internal interface, ( gh, sh, sm ) are the values of
+ ! pure CL interfaces or the values that include both the CL internal
+ ! interfaces and surface interfaces, depending on the 'use_dw_surf'.
+
+ ! ----------------------------------------------------------------------- !
+ ! Perform vertical extension-merging process !
+ ! ----------------------------------------------------------------------- !
+ ! During the merging process, we assumed ( lbulk, sh, sm ) of CL external !
+ ! interfaces are the same as the ones of the original merging CL. This is !
+ ! an inevitable approximation since we don't know ( sh, sm ) of external !
+ ! interfaces at this stage. Note that current default merging test is !
+ ! purely based on buoyancy production without including shear production, !
+ ! since we used 'l2n2' instead of 'wint' as a merging parameter. However, !
+ ! merging test based on 'wint' maybe conceptually more attractable. !
+ ! Downward CL merging process is identical to the upward merging process, !
+ ! but when the base of extended CL reaches to the surface, surface inter !
+ ! facial layer contribution to the energetic of extended CL must be done !
+ ! carefully depending on the sign of surface buoyancy flux. The contribu !
+ ! tion of surface interfacial layer energetic is included to the internal !
+ ! energetics of merging CL only when bflxs > 0. !
+ ! ----------------------------------------------------------------------- !
+
+ ! ---------------------------- !
+ ! Step 1. Extend the CL upward !
+ ! ---------------------------- !
+
+ extend = .false. ! This will become .true. if CL top or base is extended
+
+ ! Calculate contribution of potentially incorporable CL top interface
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,kt))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,kt) / (1._kind_phys+vk*zi(i,kt)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,kt), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(kt), lz)
+
+ dzinc = z(i,kt-1)-z(i,kt)
+ dl2n2 = lz*lz*n2(i,kt)*dzinc
+ dl2s2 = lz*lz*s2(i,kt)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ ! ------------ !
+ ! Merging Test !
+ ! ------------ !
+
+ ! The part of the below test that involves kt and z has different
+ ! effects based on the model top.
+ ! If the model top is in the stratosphere, we want the loop to
+ ! continue until it either completes normally, or kt is pushed to
+ ! the top of the model. The latter case should not happen, so this
+ ! causes an error.
+ ! If the model top is higher, as in WACCM and WACCM-X, if kt is
+ ! pushed close to the model top, this may not represent an error at
+ ! all, because of very different and more variable temperature/wind
+ ! profiles at the model top. Therefore we simply exit the loop early
+ ! and continue with no errors.
+
+ ! do while ( dwinc .gt. ( rinc*dzinc*wint/(lint+(1._kind_phys-rinc)*dzinc)) ) ! Merging test based on wint
+ ! do while ( -dl2n2 .gt. (-rinc*dzinc*l2n2/(lint+(1._kind_phys-rinc)*dzinc)) ) ! Merging test based on l2n2
+ do while ( -dl2n2 .gt. (-rinc*l2n2/(1._kind_phys-rinc)) & ! Integral merging test
+ .and. (kt > ntop_turb+2 .or. z(i,kt) < 50000._kind_phys) )
+
+ ! Add contribution of top external interface to interior energy.
+ ! Note even when we chose 'use_dw_surf='true.', the contribution
+ ! of surface interfacial layer to 'l2n2' and 'l2s2' are included
+ ! here. However it is not double counting of surface interfacial
+ ! energy : surface interfacial layer energy is counted in 'wint'
+ ! formula and 'l2n2' is just used for performing merging test in
+ ! this 'do while' loop.
+
+ lint = lint + dzinc
+ l2n2 = l2n2 + dl2n2
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = l2s2 + dl2s2
+ wint = wint + dwinc
+
+ ! Extend top external interface of CL upward after merging
+
+ kt = kt - 1
+ extend = .true.
+ extend_up = .true.
+ if( kt .eq. ntop_turb ) then
+ errstring = 'zisocl: Error: Tried to extend CL to the model top'
+ return
+ end if
+
+ ! If the top external interface of extending CL is the same as the
+ ! top interior interface of the overlying CL, overlying CL will be
+ ! automatically merged. Then,reduce total number of CL regime by 1.
+ ! and increase 'cntu'(number of merged CLs during upward extension)
+ ! by 1.
+
+ ktinc = kbase(i,ncv+cntu+1) - 1 ! Lowest interior interface of overlying CL
+
+ if( kt .eq. ktinc ) then
+
+ do k = kbase(i,ncv+cntu+1) - 1, ktop(i,ncv+cntu+1) + 1, -1
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(k), lz)
+
+ dzinc = z(i,k-1)-z(i,k)
+ dl2n2 = lz*lz*n2(i,k)*dzinc
+ dl2s2 = lz*lz*s2(i,k)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ lint = lint + dzinc
+ l2n2 = l2n2 + dl2n2
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = l2s2 + dl2s2
+ wint = wint + dwinc
+
+ end do
+
+ kt = ktop(i,ncv+cntu+1)
+ ncvfin(i) = ncvfin(i) - 1
+ cntu = cntu + 1
+
+ end if
+
+ ! Again, calculate the contribution of potentially incorporatable CL
+ ! top external interface of CL regime.
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,kt))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,kt) / (1._kind_phys+vk*zi(i,kt)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,kt), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(kt), lz)
+
+ dzinc = z(i,kt-1)-z(i,kt)
+ dl2n2 = lz*lz*n2(i,kt)*dzinc
+ dl2s2 = lz*lz*s2(i,kt)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ end do ! End of upward merging test 'do while' loop
+
+ ! Update CL interface indices appropriately if any CL was merged.
+ ! Note that below only updated the interface index of merged CL,
+ ! not the original merging CL. Updates of 'kbase' and 'ktop' of
+ ! the original merging CL will be done after finishing downward
+ ! extension also later.
+
+ if( cntu .gt. 0 ) then
+ do incv = 1, ncvfin(i) - ncv
+ kbase(i,ncv+incv) = kbase(i,ncv+cntu+incv)
+ ktop(i,ncv+incv) = ktop(i,ncv+cntu+incv)
+ end do
+ end if
+
+ ! ------------------------------ !
+ ! Step 2. Extend the CL downward !
+ ! ------------------------------ !
+
+ if( kb .ne. pver + 1 ) then
+
+ ! Calculate contribution of potentially incorporable CL base interface
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,kb))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,kb) / (1._kind_phys+vk*zi(i,kb)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,kb), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(kb), lz)
+
+ dzinc = z(i,kb-1)-z(i,kb)
+ dl2n2 = lz*lz*n2(i,kb)*dzinc
+ dl2s2 = lz*lz*s2(i,kb)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ ! ------------ !
+ ! Merging test !
+ ! ------------ !
+
+ ! In the below merging tests, I must keep '.and.(kb.ne.pver+1)',
+ ! since 'kb' is continuously updated within the 'do while' loop
+ ! whenever CL base is merged.
+
+ ! do while( ( dwinc .gt. ( rinc*dzinc*wint/(lint+(1._kind_phys-rinc)*dzinc)) ) & ! Merging test based on wint
+ ! do while( ( -dl2n2 .gt. (-rinc*dzinc*l2n2/(lint+(1._kind_phys-rinc)*dzinc)) ) & ! Merging test based on l2n2
+ ! .and.(kb.ne.pver+1))
+ do while( ( -dl2n2 .gt. (-rinc*l2n2/(1._kind_phys-rinc)) ) & ! Integral merging test
+ .and.(kb.ne.pver+1))
+
+ ! Add contributions from interfacial layer kb to CL interior
+
+ lint = lint + dzinc
+ l2n2 = l2n2 + dl2n2
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = l2s2 + dl2s2
+ wint = wint + dwinc
+
+ ! Extend the base external interface of CL downward after merging
+
+ kb = kb + 1
+ extend = .true.
+ extend_dn = .true.
+
+ ! If the base external interface of extending CL is the same as the
+ ! base interior interface of the underlying CL, underlying CL will
+ ! be automatically merged. Then, reduce total number of CL by 1.
+ ! For a consistent treatment with 'upward' extension, I should use
+ ! 'kbinc = kbase(i,ncv-1) - 1' instead of 'ktop(i,ncv-1) + 1' below.
+ ! However, it seems that these two methods produce the same results.
+ ! Note also that in contrast to upward merging, the decrease of ncv
+ ! should be performed here.
+ ! Note that below formula correctly works even when upperlying CL
+ ! regime incorporates below SBCL.
+
+ kbinc = 0
+ if( ncv .gt. 1 ) kbinc = ktop(i,ncv-1) + 1
+ if( kb .eq. kbinc ) then
+
+ do k = ktop(i,ncv-1) + 1, kbase(i,ncv-1) - 1
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(k), lz)
+
+ dzinc = z(i,k-1)-z(i,k)
+ dl2n2 = lz*lz*n2(i,k)*dzinc
+ dl2s2 = lz*lz*s2(i,k)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ lint = lint + dzinc
+ l2n2 = l2n2 + dl2n2
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = l2s2 + dl2s2
+ wint = wint + dwinc
+
+ end do
+
+ ! We are incorporating interior of CL ncv-1, so merge
+ ! this CL into the current CL.
+
+ kb = kbase(i,ncv-1)
+ ncv = ncv - 1
+ ncvfin(i) = ncvfin(i) -1
+ cntd = cntd + 1
+
+ end if
+
+ ! Calculate the contribution of potentially incorporatable CL
+ ! base external interface. Calculate separately when the base
+ ! of extended CL is surface and non-surface.
+
+ if( kb .eq. pver + 1 ) then
+
+ if( bflxs(i) .gt. 0._kind_phys ) then
+ ! Calculate stability functions of surface interfacial layer
+ gg = 0.5_kind_phys*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._kind_phys/2._kind_phys))
+ gh_surf = gg/(alph5-gg*alph3)
+ ! gh_surf = min(max(gh_surf,-0.28_kind_phys),0.0233_kind_phys)
+ gh_surf = min(max(gh_surf,-3.5334_kind_phys),0.0233_kind_phys)
+ sh_surf = alph5/(1._kind_phys+alph3*gh_surf)
+ sm_surf = (alph1 + alph2*gh_surf)/(1._kind_phys+alph3*gh_surf)/(1._kind_phys+alph4*gh_surf)
+ ! Calculate surface interfacial layer contribution. By construction,
+ ! it exactly becomes 'dw_surf = -dl2n2_surf + ds2n2_surf'
+ dlint_surf = z(i,pver)
+ dl2n2_surf = -vk*(z(i,pver)**2._kind_phys)*bprod(i,pver+1)/(sh_surf*sqrt(tkes(i)))
+ dl2s2_surf = vk*(z(i,pver)**2._kind_phys)*sprod(i,pver+1)/(sm_surf*sqrt(tkes(i)))
+ dw_surf = (tkes(i)/b1)*z(i,pver)
+ else
+ dlint_surf = 0._kind_phys
+ dl2n2_surf = 0._kind_phys
+ dl2s2_surf = 0._kind_phys
+ dw_surf = 0._kind_phys
+ end if
+ ! If (kb.eq.pver+1), updating of CL internal energetics should be
+ ! performed here inside of 'do while' loop, since 'do while' loop
+ ! contains the constraint of '.and.(kb.ne.pver+1)',so updating of
+ ! CL internal energetics cannot be performed within this do while
+ ! loop when kb.eq.pver+1. Even though I updated all 'l2n2','l2s2',
+ ! 'wint' below, only the updated 'wint' is used in the following
+ ! numerical calculation.
+ lint = lint + dlint_surf
+ l2n2 = l2n2 + dl2n2_surf
+ l2n2 = -min(-l2n2, tkemax*lint/(b1*sh))
+ l2s2 = l2s2 + dl2s2_surf
+ wint = wint + dw_surf
+
+ else
+
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,kb))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,kb) / (1._kind_phys+vk*zi(i,kb)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,kb), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(kb), lz)
+
+ dzinc = z(i,kb-1)-z(i,kb)
+ dl2n2 = lz*lz*n2(i,kb)*dzinc
+ dl2s2 = lz*lz*s2(i,kb)*dzinc
+ dwinc = -sh*dl2n2 + sm*dl2s2
+
+ end if
+
+ end do ! End of merging test 'do while' loop
+
+ if( (kb.eq.pver+1) .and. (ncv.ne.1) ) then
+ errstring = 'Major mistake zisocl: the CL based at surface is not indexed 1'
+ return
+ end if
+
+ end if ! Done with bottom extension of CL
+
+ ! Update CL interface indices appropriately if any CL was merged.
+ ! Note that below only updated the interface index of merged CL,
+ ! not the original merging CL. Updates of 'kbase' and 'ktop' of
+ ! the original merging CL will be done later below. I should
+ ! check in detail if below index updating is correct or not.
+
+ if( cntd .gt. 0 ) then
+ do incv = 1, ncvfin(i) - ncv
+ kbase(i,ncv+incv) = kbase(i,ncvinit+incv)
+ ktop(i,ncv+incv) = ktop(i,ncvinit+incv)
+ end do
+ end if
+
+ ! Sanity check for positive wint.
+
+ if( wint .lt. 0.01_kind_phys ) then
+ wint = 0.01_kind_phys
+ end if
+
+ ! -------------------------------------------------------------------------- !
+ ! Finally update CL mean internal energetics including surface contribution !
+ ! after finishing all the CL extension-merging process. As mentioned above, !
+ ! there are two possible ways in the treatment of surface interfacial layer, !
+ ! either through 'dw_surf' or 'dl2n2_surf and dl2s2_surf' by setting logical !
+ ! variable 'use_dw_surf' =.true. or .false. In any cases, we should avoid !
+ ! double counting of surface interfacial layer and one single consistent way !
+ ! should be used throughout the program. !
+ ! -------------------------------------------------------------------------- !
+
+ if( extend ) then
+
+ ktop(i,ncv) = kt
+ kbase(i,ncv) = kb
+
+ ! ------------------------------------------------------ !
+ ! Step 1: Include surface interfacial layer contribution !
+ ! ------------------------------------------------------ !
+
+ lbulk = zi(i,kt) - zi(i,kb)
+ lbulk = min( lbulk, lbulk_max )
+ dlint_surf = 0._kind_phys
+ dl2n2_surf = 0._kind_phys
+ dl2s2_surf = 0._kind_phys
+ dw_surf = 0._kind_phys
+ if( kb .eq. pver + 1 ) then
+ if( bflxs(i) .gt. 0._kind_phys ) then
+ ! Calculate stability functions of surface interfacial layer
+ gg = 0.5_kind_phys*vk*z(i,pver)*bprod(i,pver+1)/(tkes(i)**(3._kind_phys/2._kind_phys))
+ gh = gg/(alph5-gg*alph3)
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ sh = alph5/(1._kind_phys+alph3*gh)
+ sm = (alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh)
+ ! Calculate surface interfacial layer contribution. By construction,
+ ! it exactly becomes 'dw_surf = -dl2n2_surf + ds2n2_surf'
+ dlint_surf = z(i,pver)
+ dl2n2_surf = -vk*(z(i,pver)**2._kind_phys)*bprod(i,pver+1)/(sh*sqrt(tkes(i)))
+ dl2s2_surf = vk*(z(i,pver)**2._kind_phys)*sprod(i,pver+1)/(sm*sqrt(tkes(i)))
+ dw_surf = (tkes(i)/b1)*z(i,pver)
+ else
+ lbulk = zi(i,kt) - z(i,pver)
+ lbulk = min( lbulk, lbulk_max )
+ end if
+ end if
+ lint = dlint_surf
+ l2n2 = dl2n2_surf
+ l2s2 = dl2s2_surf
+ wint = dw_surf
+ if( use_dw_surf ) then
+ l2n2 = 0._kind_phys
+ l2s2 = 0._kind_phys
+ else
+ wint = 0._kind_phys
+ end if
+
+ ! -------------------------------------------------------------- !
+ ! Step 2. Include the contribution of 'pure internal interfaces' !
+ ! -------------------------------------------------------------- !
+
+ do k = kt + 1, kb - 1
+ if( choice_tunl .eq. 'rampcl' ) then
+ tunlramp = 0.5_kind_phys*(1._kind_phys+ctunl)*tunl
+ elseif( choice_tunl .eq. 'rampsl' ) then
+ tunlramp = ctunl*tunl
+ ! tunlramp = 0.765_kind_phys
+ else
+ tunlramp = tunl
+ endif
+ if( choice_leng .eq. 'origin' ) then
+ lz = ( (vk*zi(i,k))**(-cleng) + (tunlramp*lbulk)**(-cleng) )**(-1._kind_phys/cleng)
+ ! lz = vk*zi(i,k) / (1._kind_phys+vk*zi(i,k)/(tunlramp*lbulk))
+ else
+ lz = min( vk*zi(i,k), tunlramp*lbulk )
+ endif
+ lz = min(leng_max(k), lz)
+ dzinc = z(i,k-1) - z(i,k)
+ lint = lint + dzinc
+ l2n2 = l2n2 + lz*lz*n2(i,k)*dzinc
+ l2s2 = l2s2 + lz*lz*s2(i,k)*dzinc
+ end do
+
+ ricll = min(l2n2/max(l2s2,ntzero),ricrit)
+ trma = alph3*alph4*ricll+2._kind_phys*b1*(alph2-alph4*alph5*ricll)
+ trmb = ricll*(alph3+alph4)+2._kind_phys*b1*(-alph5*ricll+alph1)
+ trmc = ricll
+ det = max(trmb*trmb-4._kind_phys*trma*trmc,0._kind_phys)
+ gh = (-trmb + sqrt(det))/2._kind_phys/trma
+ ! gh = min(max(gh,-0.28_kind_phys),0.0233_kind_phys)
+ gh = min(max(gh,-3.5334_kind_phys),0.0233_kind_phys)
+ sh = alph5 / (1._kind_phys+alph3*gh)
+ sm = (alph1 + alph2*gh)/(1._kind_phys+alph3*gh)/(1._kind_phys+alph4*gh)
+ ! Even though the 'wint' after finishing merging was positive, it is
+ ! possible that re-calculated 'wint' here is negative. In this case,
+ ! correct 'wint' to be a small positive number
+ wint = max( wint - sh*l2n2 + sm*l2s2, 0.01_kind_phys )
+
+ end if
+
+ ! ---------------------------------------------------------------------- !
+ ! Calculate final output variables of each CL (either has merged or not) !
+ ! ---------------------------------------------------------------------- !
+
+ lbrk(i,ncv) = lint
+ wbrk(i,ncv) = wint/lint
+ ebrk(i,ncv) = b1*wbrk(i,ncv)
+ ebrk(i,ncv) = min(ebrk(i,ncv),tkemax)
+ ricl(i,ncv) = ricll
+ ghcl(i,ncv) = gh
+ shcl(i,ncv) = sh
+ smcl(i,ncv) = sm
+
+ ! Increment counter for next CL. I should check if the increament of 'ncv'
+ ! below is reasonable or not, since whenever CL is merged during downward
+ ! extension process, 'ncv' is lowered down continuously within 'do' loop.
+ ! But it seems that below 'ncv = ncv + 1' is perfectly correct.
+
+ ncv = ncv + 1
+
+ end do ! End of loop over each CL regime, ncv.
+
+ ! ---------------------------------------------------------- !
+ ! Re-initialize external interface indices which are not CLs !
+ ! ---------------------------------------------------------- !
+
+ do ncv = ncvfin(i) + 1, ncvmax
+ ktop(i,ncv) = 0
+ kbase(i,ncv) = 0
+ end do
+
+ ! ------------------------------------------------ !
+ ! Update CL interface identifiers, 'belongcv' !
+ ! CL external interfaces are also identified as CL !
+ ! ------------------------------------------------ !
+
+ do k = 1, pver + 1
+ belongcv(i,k) = .false.
+ end do
+
+ do ncv = 1, ncvfin(i)
+ do k = ktop(i,ncv), kbase(i,ncv)
+ belongcv(i,k) = .true.
+ end do
+ end do
+
+ end subroutine zisocl
+
+ real(kind_phys) function compute_cubic(a,b,c)
+ ! ------------------------------------------------------------------------- !
+ ! Solve canonical cubic : x^3 + a*x^2 + b*x + c = 0, x = sqrt(e)/sqrt() !
+ ! Set x = max(xmin,x) at the end !
+ ! ------------------------------------------------------------------------- !
+
+ real(kind_phys), intent(in) :: a, b, c
+ real(kind_phys) qq, rr, dd, theta, aa, bb, x1, x2, x3
+ real(kind_phys), parameter :: xmin = 1.e-2_kind_phys
+
+ qq = (a**2-3._kind_phys*b)/9._kind_phys
+ rr = (2._kind_phys*a**3 - 9._kind_phys*a*b + 27._kind_phys*c)/54._kind_phys
+
+ dd = rr**2 - qq**3
+ if( dd .le. 0._kind_phys ) then
+ theta = acos(rr/qq**(3._kind_phys/2._kind_phys))
+ x1 = -2._kind_phys*sqrt(qq)*cos(theta/3._kind_phys) - a/3._kind_phys
+ x2 = -2._kind_phys*sqrt(qq)*cos((theta+2._kind_phys*3.141592_kind_phys)/3._kind_phys) - a/3._kind_phys
+ x3 = -2._kind_phys*sqrt(qq)*cos((theta-2._kind_phys*3.141592_kind_phys)/3._kind_phys) - a/3._kind_phys
+ compute_cubic = max(max(max(x1,x2),x3),xmin)
+ else
+ if( rr .ge. 0._kind_phys ) then
+ aa = -(sqrt(rr**2-qq**3)+rr)**(1._kind_phys/3._kind_phys)
+ else
+ aa = (sqrt(rr**2-qq**3)-rr)**(1._kind_phys/3._kind_phys)
+ endif
+ if( aa .eq. 0._kind_phys ) then
+ bb = 0._kind_phys
+ else
+ bb = qq/aa
+ endif
+ compute_cubic = max((aa+bb)-a/3._kind_phys,xmin)
+ endif
+
+ end function compute_cubic
+
+ subroutine compute_radf( choice_radf, i, ncol, pver, ncvmax, ncvfin, ktop, qmin, &
+ ql, pi, qrlw, g, cldeff, zi, chs, lwp_CL, opt_depth_CL, &
+ radinvfrac_CL, radf_CL )
+ ! -------------------------------------------------------------------------- !
+ ! Purpose: !
+ ! Calculate cloud-top radiative cooling contribution to buoyancy production. !
+ ! Here, 'radf' [m2/s3] is additional buoyancy flux at the CL top interface !
+ ! associated with cloud-top LW cooling being mainly concentrated near the CL !
+ ! top interface ( just below CL top interface ). Contribution of SW heating !
+ ! within the cloud is not included in this radiative buoyancy production !
+ ! since SW heating is more broadly distributed throughout the CL top layer. !
+ ! -------------------------------------------------------------------------- !
+
+ !-----------------!
+ ! Input variables !
+ !-----------------!
+ character(len=6), intent(in) :: choice_radf ! Method for calculating radf
+ integer, intent(in) :: i ! Index of current column
+ integer, intent(in) :: ncol ! Number of atmospheric columns
+ integer, intent(in) :: pver ! Number of atmospheric layers
+ integer, intent(in) :: ncvmax ! Max numbers of CLs (perhaps equal to pver)
+ integer, intent(in) :: ncvfin(ncol) ! Total number of CL in column
+ integer, intent(in) :: ktop(ncol, ncvmax) ! ktop for current column
+ real(kind_phys), intent(in) :: qmin ! Minimum grid-mean LWC counted as clouds [kg/kg]
+ real(kind_phys), intent(in) :: ql(ncol, pver) ! Liquid water specific humidity [ kg/kg ]
+ real(kind_phys), intent(in) :: pi(ncol, pver+1) ! Interface pressures [ Pa ]
+ real(kind_phys), intent(in) :: qrlw(ncol, pver) ! Input grid-mean LW heating rate : [ K/s ] * cpair * dp = [ W/kg*Pa ]
+ real(kind_phys), intent(in) :: g ! Gravitational acceleration
+ real(kind_phys), intent(in) :: cldeff(ncol,pver) ! Effective Cloud Fraction [fraction]
+ real(kind_phys), intent(in) :: zi(ncol, pver+1) ! Interface heights [ m ]
+ real(kind_phys), intent(in) :: chs(ncol, pver+1) ! Buoyancy coeffi. saturated sl (heat) coef. at all interfaces.
+
+ !------------------!
+ ! Output variables !
+ !------------------!
+ real(kind_phys), intent(out) :: lwp_CL(ncvmax) ! LWP in the CL top layer [ kg/m2 ]
+ real(kind_phys), intent(out) :: opt_depth_CL(ncvmax) ! Optical depth of the CL top layer
+ real(kind_phys), intent(out) :: radinvfrac_CL(ncvmax) ! Fraction of LW radiative cooling confined in the top portion of CL
+ real(kind_phys), intent(out) :: radf_CL(ncvmax) ! Buoyancy production at the CL top due to radiative cooling [ m2/s3 ]
+
+ !-----------------!
+ ! Local variables !
+ !-----------------!
+ integer :: kt, ncv
+ real(kind_phys) :: lwp, opt_depth, radinvfrac, radf
+
+
+ !-----------------!
+ ! Begin main code !
+ !-----------------!
+ lwp_CL = 0._kind_phys
+ opt_depth_CL = 0._kind_phys
+ radinvfrac_CL = 0._kind_phys
+ radf_CL = 0._kind_phys
+
+ ! ---------------------------------------- !
+ ! Perform do loop for individual CL regime !
+ ! ---------------------------------------- !
+ do ncv = 1, ncvfin(i)
+ kt = ktop(i,ncv)
+ !-----------------------------------------------------!
+ ! Compute radf for each CL regime and for each column !
+ !-----------------------------------------------------!
+ if( choice_radf .eq. 'orig' ) then
+ if( ql(i,kt) .gt. qmin .and. ql(i,kt-1) .lt. qmin ) then
+ lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g
+ opt_depth = 156._kind_phys * lwp ! Estimated LW optical depth in the CL top layer
+ ! Approximate LW cooling fraction concentrated at the inversion by using
+ ! polynomial approx to exact formula 1-2/opt_depth+2/(exp(opt_depth)-1))
+
+ radinvfrac = opt_depth * ( 4._kind_phys + opt_depth ) / ( 6._kind_phys * ( 4._kind_phys + opt_depth ) + opt_depth**2 )
+ radf = qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) ! Cp*radiative cooling = [ W/kg ]
+ radf = max( radinvfrac * radf * ( zi(i,kt) - zi(i,kt+1) ), 0._kind_phys ) * chs(i,kt)
+ ! We can disable cloud LW cooling contribution to turbulence by uncommenting:
+ ! radf = 0._kind_phys
+ end if
+
+ elseif( choice_radf .eq. 'ramp' ) then
+
+ lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g
+ opt_depth = 156._kind_phys * lwp ! Estimated LW optical depth in the CL top layer
+ radinvfrac = opt_depth * ( 4._kind_phys + opt_depth ) / ( 6._kind_phys * ( 4._kind_phys + opt_depth ) + opt_depth**2 )
+ radinvfrac = max(cldeff(i,kt)-cldeff(i,kt-1),0._kind_phys) * radinvfrac
+ radf = qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) ! Cp*radiative cooling [W/kg]
+ radf = max( radinvfrac * radf * ( zi(i,kt) - zi(i,kt+1) ), 0._kind_phys ) * chs(i,kt)
+
+ elseif( choice_radf .eq. 'maxi' ) then
+
+ ! Radiative flux divergence both in 'kt' and 'kt-1' layers are included
+ ! 1. From 'kt' layer
+ lwp = ql(i,kt) * ( pi(i,kt+1) - pi(i,kt) ) / g
+ opt_depth = 156._kind_phys * lwp ! Estimated LW optical depth in the CL top layer
+ radinvfrac = opt_depth * ( 4._kind_phys + opt_depth ) / ( 6._kind_phys * ( 4._kind_phys + opt_depth ) + opt_depth**2 )
+ radf = max( radinvfrac * qrlw(i,kt) / ( pi(i,kt) - pi(i,kt+1) ) * ( zi(i,kt) - zi(i,kt+1) ), 0._kind_phys )
+ ! 2. From 'kt-1' layer and add the contribution from 'kt' layer
+ lwp = ql(i,kt-1) * ( pi(i,kt) - pi(i,kt-1) ) / g
+ opt_depth = 156._kind_phys * lwp ! Estimated LW optical depth in the CL top layer
+ radinvfrac = opt_depth * ( 4._kind_phys + opt_depth ) / ( 6._kind_phys * ( 4._kind_phys + opt_depth) + opt_depth**2 )
+ radf = radf + max( radinvfrac * qrlw(i,kt-1) / ( pi(i,kt-1) - pi(i,kt) ) * ( zi(i,kt-1) - zi(i,kt) ), 0._kind_phys )
+ radf = max( radf, 0._kind_phys ) * chs(i,kt)
+
+ endif
+
+ lwp_CL(ncv) = lwp
+ opt_depth_CL(ncv) = opt_depth
+ radinvfrac_CL(ncv) = radinvfrac
+ radf_CL(ncv) = radf
+ end do ! ncv = 1, ncvfin(i)
+ end subroutine compute_radf
+END MODULE eddy_diff
diff --git a/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.F90 b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.F90
new file mode 100644
index 00000000..9950f4b6
--- /dev/null
+++ b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.F90
@@ -0,0 +1,89 @@
+! Adjusts eddy diffusivities above the planetary boundary layer
+! to address potentially excessive values in the free troposphere and upper atmosphere
+! in the UW (Bretherton-Park) PBL scheme.
+module eddy_diffusivity_adjustment_above_pbl
+
+ implicit none
+ private
+
+ ! public CCPP-compliant subroutines
+ public :: eddy_diffusivity_adjustment_above_pbl_run
+
+contains
+
+ ! Adjust eddy diffusivities above the PBL to prevent excessive values
+ ! in the free troposphere and upper atmosphere.
+ !
+ ! The diffusivities from diag_TKE (UW/Bretherton-Park) can be much larger than
+ ! from HB (Holtslag-Boville) in the free
+ ! troposphere and upper atmosphere. These seem to be larger than observations,
+ ! and in WACCM the gravity_wave_drag code is already applying an eddy diffusivity
+ ! in the upper atmosphere. Optionally, adjust the diffusivities in the free
+ ! troposphere or the upper atmosphere.
+ !
+ ! NOTE: Further investigation should be done as to why the diffusivities are
+ ! larger in diag_TKE.
+!> \section arg_table_eddy_diffusivity_adjustment_above_pbl_run Argument Table
+!! \htmlinclude eddy_diffusivity_adjustment_above_pbl_run.html
+ subroutine eddy_diffusivity_adjustment_above_pbl_run( &
+ ncol, pverp, &
+ kv_top_pressure, &
+ kv_freetrop_scale, &
+ kv_top_scale, &
+ zi, pint, pblh, &
+ kvh, kvm, kvq, &
+ errmsg, errflg)
+
+ use ccpp_kinds, only: kind_phys
+
+ ! Input arguments
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pverp
+ real(kind_phys), intent(in) :: kv_top_pressure ! Upper atmosphere pressure threshold [Pa]
+ real(kind_phys), intent(in) :: kv_freetrop_scale ! Free troposphere scale factor
+ real(kind_phys), intent(in) :: kv_top_scale ! Upper atmosphere scale factor
+ real(kind_phys), intent(in) :: zi(:, :) ! Geopotential height at interfaces [m]
+ real(kind_phys), intent(in) :: pint(:, :) ! Pressure at interfaces [Pa]
+ real(kind_phys), intent(in) :: pblh(:) ! Planetary boundary layer height [m]
+
+ ! Input/Output arguments
+ real(kind_phys), intent(inout) :: kvh(:, :) ! Eddy diffusivity for heat at interfaces [m2 s-1]
+ real(kind_phys), intent(inout) :: kvm(:, :) ! Eddy diffusivity for momentum at interfaces [m2 s-1]
+ real(kind_phys), intent(inout) :: kvq(:, :) ! Eddy diffusivity for constituents at interfaces [m2 s-1]
+
+ ! Output arguments
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ ! Local variables
+ integer :: i, k
+
+ errmsg = ''
+ errflg = 0
+
+ ! Only apply adjustment if scaling factors differ from unity
+ if ((kv_freetrop_scale /= 1.0_kind_phys) .or. &
+ ((kv_top_scale /= 1.0_kind_phys) .and. (kv_top_pressure > 0.0_kind_phys))) then
+ do i = 1, ncol
+ do k = 1, pverp
+ ! Outside of the boundary layer?
+ if (zi(i, k) > pblh(i)) then
+ ! In the upper atmosphere?
+ if (pint(i, k) <= kv_top_pressure) then
+ kvh(i, k) = kvh(i, k) * kv_top_scale
+ kvm(i, k) = kvm(i, k) * kv_top_scale
+ kvq(i, k) = kvq(i, k) * kv_top_scale
+ else
+ ! In the free troposphere
+ kvh(i, k) = kvh(i, k) * kv_freetrop_scale
+ kvm(i, k) = kvm(i, k) * kv_freetrop_scale
+ kvq(i, k) = kvq(i, k) * kv_freetrop_scale
+ end if
+ end if
+ end do
+ end do
+ end if
+
+ end subroutine eddy_diffusivity_adjustment_above_pbl_run
+
+end module eddy_diffusivity_adjustment_above_pbl
diff --git a/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.meta b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.meta
new file mode 100644
index 00000000..704360f4
--- /dev/null
+++ b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl.meta
@@ -0,0 +1,86 @@
+[ccpp-table-properties]
+ name = eddy_diffusivity_adjustment_above_pbl
+ type = scheme
+
+[ccpp-arg-table]
+ name = eddy_diffusivity_adjustment_above_pbl_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pverp ]
+ standard_name = vertical_interface_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ kv_top_pressure ]
+ standard_name = air_pressure_threshold_for_eddy_diffusivity_adjustment
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ kv_freetrop_scale ]
+ standard_name = free_troposphere_eddy_diffusivity_scaling_factor_for_eddy_diffusivity_adjustment
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ kv_top_scale ]
+ standard_name = upper_atmosphere_eddy_diffusivity_scaling_factor_for_eddy_diffusivity_adjustment
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ zi ]
+ standard_name = geopotential_height_wrt_surface_at_interface
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ pint ]
+ standard_name = air_pressure_at_interface
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ pblh ]
+ standard_name = atmosphere_boundary_layer_thickness
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ kvh ]
+ standard_name = eddy_heat_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = inout
+[ kvm ]
+ standard_name = eddy_momentum_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = inout
+[ kvq ]
+ standard_name = eddy_constituent_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = inout
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
+
diff --git a/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl_namelist.xml b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl_namelist.xml
new file mode 100644
index 00000000..e17410ca
--- /dev/null
+++ b/schemes/bretherton_park/eddy_diffusivity_adjustment_above_pbl_namelist.xml
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_adj_nl
+ air_pressure_threshold_for_eddy_diffusivity_adjustment
+ Pa
+
+ Pressure (Pa) that defined the upper atmosphere for adjustment of eddy diffusivities from diag_TKE (the Bretherton-Park PBL scheme) using kv_top_scale.
+ Default: 0
+
+
+ 0.0
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_adj_nl
+ upper_atmosphere_eddy_diffusivity_scaling_factor_for_eddy_diffusivity_adjustment
+ 1
+
+ Scaling factor that is applied (multiplied) to the eddy diffusivities in the upper atmosphere (see kv_top_pressure).
+ Default: 1.0
+
+
+ 1.0
+
+
+
+
+ real
+ kind_phys
+ pbl
+ eddy_diff_adj_nl
+ free_troposphere_eddy_diffusivity_scaling_factor_for_eddy_diffusivity_adjustment
+ 1
+
+ Scaling factor that is applied (multiplied) to the eddy diffusivities in the free troposphere (boundary layer to kv_top_pressure)
+ Default: 1.0
+
+
+ 1.0
+
+
+
diff --git a/schemes/holtslag_boville/holtslag_boville_diff.F90 b/schemes/holtslag_boville/holtslag_boville_diff.F90
index 4baa83a6..cfc54270 100644
--- a/schemes/holtslag_boville/holtslag_boville_diff.F90
+++ b/schemes/holtslag_boville/holtslag_boville_diff.F90
@@ -139,51 +139,39 @@ end subroutine holtslag_boville_diff_init
!! \htmlinclude arg_table_hb_pbl_independent_coefficients_run.html
pure subroutine hb_pbl_independent_coefficients_run( &
ncol, pver, &
- zvir, rair, cpair, gravit, karman, &
- exner, t, &
+ zvir, rair, gravit, &
+ t, th, &
q_wv, &
z, &
pmid, &
u, v, &
taux, tauy, &
- shflx, q_wv_flx, &
! below output
- thv, ustar, &
- khfs, kqfs, kbfs, &
- obklen, s2, ri, &
+ thv, ustar, rrho, &
+ s2, ri, &
errmsg, errflg)
- use atmos_phys_pbl_utils, only: calc_virtual_temperature, calc_friction_velocity, calc_obukhov_length, &
- calc_ideal_gas_rrho, &
- calc_kinematic_heat_flux, calc_kinematic_water_vapor_flux, &
- calc_kinematic_buoyancy_flux
+ use atmos_phys_pbl_utils, only: calc_virtual_temperature, calc_friction_velocity, calc_ideal_gas_rrho
! Input arguments
integer, intent(in) :: ncol ! # of atmospheric columns
integer, intent(in) :: pver ! # of vertical levels
real(kind_phys), intent(in) :: zvir
real(kind_phys), intent(in) :: rair
- real(kind_phys), intent(in) :: cpair
real(kind_phys), intent(in) :: gravit
- real(kind_phys), intent(in) :: karman
- real(kind_phys), intent(in) :: exner(:,:) ! exner [1]
real(kind_phys), intent(in) :: t (:,:) ! temperature [K]
+ real(kind_phys), intent(in) :: th (:,:) ! potential temperature [K]
real(kind_phys), intent(in) :: q_wv(:,:) ! specific humidity [kg kg-1]
real(kind_phys), intent(in) :: z (:,:) ! height above surface [m]
real(kind_phys), intent(in) :: u (:,:) ! zonal velocity [m s-1]
real(kind_phys), intent(in) :: v (:,:) ! meridional velocity [m s-1]
real(kind_phys), intent(in) :: taux (:) ! zonal stress [N m-2]
real(kind_phys), intent(in) :: tauy (:) ! meridional stress [N m-2]
- real(kind_phys), intent(in) :: shflx(:) ! sensible heat flux [W m-2]
- real(kind_phys), intent(in) :: q_wv_flx(:) ! upward water vapor flux at surface [kg m-2 s-1]
real(kind_phys), intent(in) :: pmid(:,:) ! midpoint pressures
! Output arguments
real(kind_phys), intent(out) :: thv(:,:) ! virtual potential temperature [K]
real(kind_phys), intent(out) :: ustar(:) ! surface friction velocity [m s-1]
- real(kind_phys), intent(out) :: khfs(:) ! kinematic surface heat flux [K m s-1]
- real(kind_phys), intent(out) :: kqfs(:) ! kinematic surface water vapor flux [kg kg-1 m s-1]
- real(kind_phys), intent(out) :: kbfs(:) ! surface kinematic buoyancy flux [m^2 s-3]
- real(kind_phys), intent(out) :: obklen(:) ! Obukhov length [m]
+ real(kind_phys), intent(out) :: rrho(:) ! 1 / bottom level density [m3 kg-1]
real(kind_phys), intent(out) :: s2(:,:) ! shear squared [s-2]
real(kind_phys), intent(out) :: ri(:,:) ! richardson number: n2/s2 [1]
character(len=512), intent(out) :: errmsg ! error message
@@ -192,16 +180,11 @@ pure subroutine hb_pbl_independent_coefficients_run( &
integer :: i, k
real(kind_phys) :: dvdz2 ! velocity shear squared [m^2 s-2]
real(kind_phys) :: dz ! delta z between midpoints [m]
- real(kind_phys) :: rrho(ncol) ! 1 / bottom level density [m^3 kg-1]
real(kind_phys) :: n2(ncol, pver) ! brunt vaisaila frequency [s-2]
- real(kind_phys) :: th(ncol, pver) ! potential temperature [K]
errmsg = ''
errflg = 0
- ! calculate potential temperature [K]
- th(:ncol,:) = t(:ncol,:) * exner(:ncol,:)
-
! virtual temperature
thv(:,:) = 0._kind_phys
thv(:ncol,ntop_turb:) = calc_virtual_temperature(th(:ncol,ntop_turb:), q_wv(:ncol,ntop_turb:), zvir)
@@ -209,10 +192,6 @@ pure subroutine hb_pbl_independent_coefficients_run( &
! Compute ustar, Obukhov length, and kinematic surface fluxes.
rrho(:ncol) = calc_ideal_gas_rrho(rair, t(:ncol,pver), pmid(:ncol,pver))
ustar(:ncol) = calc_friction_velocity(taux(:ncol),tauy(:ncol), rrho(:ncol))
- khfs(:ncol) = calc_kinematic_heat_flux(shflx(:ncol), rrho(:ncol), cpair)
- kqfs(:ncol) = calc_kinematic_water_vapor_flux(q_wv_flx(:ncol), rrho(:ncol))
- kbfs(:ncol) = calc_kinematic_buoyancy_flux(khfs(:ncol), zvir, th(:ncol,pver), kqfs(:ncol))
- obklen(:ncol) = calc_obukhov_length(thv(:ncol,pver), ustar(:ncol), gravit, karman, kbfs(:ncol))
! Initialize output arrays outside of turbulence region to zeroes
s2(:,:) = 0._kind_phys
diff --git a/schemes/holtslag_boville/holtslag_boville_diff.meta b/schemes/holtslag_boville/holtslag_boville_diff.meta
index 75df7fd4..bda413f3 100644
--- a/schemes/holtslag_boville/holtslag_boville_diff.meta
+++ b/schemes/holtslag_boville/holtslag_boville_diff.meta
@@ -114,32 +114,20 @@
type = real | kind = kind_phys
dimensions = ()
intent = in
-[ cpair ]
- standard_name = specific_heat_of_dry_air_at_constant_pressure
- units = J kg-1 K-1
- type = real | kind = kind_phys
- dimensions = ()
- intent = in
[ gravit ]
standard_name = standard_gravitational_acceleration
units = m s-2
type = real | kind = kind_phys
dimensions = ()
intent = in
-[ karman ]
- standard_name = von_karman_constant
- units = 1
- type = real | kind = kind_phys
- dimensions = ()
- intent = in
-[ exner ]
- standard_name = reciprocal_of_dimensionless_exner_function_wrt_surface_air_pressure
- units = 1
+[ t ]
+ standard_name = air_temperature
+ units = K
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
intent = in
-[ t ]
- standard_name = air_temperature
+[ th ]
+ standard_name = potential_temperature_wrt_surface_pressure
units = K
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
@@ -176,32 +164,19 @@
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
intent = in
[ taux ]
- standard_name = eastward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
+ standard_name = eastward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
units = N m-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = in
[ tauy ]
- standard_name = northward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
+ standard_name = northward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
units = N m-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = in
-[ shflx ]
- standard_name = surface_upward_sensible_heat_flux_from_coupler
- units = W m-2
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = in
-[ q_wv_flx ]
- standard_name = surface_upward_water_vapor_flux
- # surface_upward_ccpp_constituent_fluxes but only for water vapor.
- units = kg m-2 s-1
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = in
[ thv ]
- standard_name = virtual_potential_temperature_wrt_surface_pressure_at_bottom_layer
+ standard_name = virtual_potential_temperature_wrt_surface_pressure
units = K
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
@@ -212,33 +187,14 @@
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = out
-[ khfs ]
- standard_name = kinematic_sensible_heat_flux_at_surface
- units = K m s-1
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = out
-[ kqfs ]
- standard_name = kinematic_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_flux_at_surface
- units = kg kg-1 m s-1
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = out
-[ kbfs ]
- standard_name = kinematic_buoyancy_flux_at_surface
- # m s-2 m s-1
- units = m2 s-3
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = out
-[ obklen ]
- standard_name = obukhov_length
- units = m
+[ rrho ]
+ standard_name = reciprocal_of_dry_air_density_of_bottom_layer
+ units = m3 kg-1
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = out
[ s2 ]
- standard_name = square_of_wind_shear
+ standard_name = square_of_vertical_wind_shear
units = s-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
@@ -324,7 +280,7 @@
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
intent = in
[ thv ]
- standard_name = virtual_potential_temperature_wrt_surface_pressure_at_bottom_layer
+ standard_name = virtual_potential_temperature_wrt_surface_pressure
units = K
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
@@ -460,7 +416,7 @@
dimensions = (horizontal_loop_extent)
intent = in
[ s2 ]
- standard_name = square_of_wind_shear
+ standard_name = square_of_vertical_wind_shear
units = s-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
@@ -532,7 +488,8 @@
dimensions = (horizontal_loop_extent)
intent = out
[ tke ]
- standard_name = specific_turbulent_kinetic_energy_at_interfaces
+ standard_name = tke_at_interfaces
+ long_name = specific Turbulent Kinetic Energy (TKE) at vertical interfaces
units = m2 s-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
@@ -576,7 +533,7 @@
dimensions = ()
intent = in
[ s2 ]
- standard_name = square_of_wind_shear
+ standard_name = square_of_vertical_wind_shear
units = s-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension)
diff --git a/schemes/holtslag_boville/holtslag_boville_diff_interstitials.F90 b/schemes/holtslag_boville/holtslag_boville_diff_interstitials.F90
index dcf12bb2..0d8ac17a 100644
--- a/schemes/holtslag_boville/holtslag_boville_diff_interstitials.F90
+++ b/schemes/holtslag_boville/holtslag_boville_diff_interstitials.F90
@@ -5,13 +5,10 @@ module holtslag_boville_diff_interstitials
implicit none
private
- save
! CCPP-compliant public interfaces
public :: hb_diff_set_vertical_diffusion_top_init
- public :: hb_diff_set_total_surface_stress_run
public :: hb_diff_prepare_vertical_diffusion_inputs_run
- public :: hb_diff_prepare_vertical_diffusion_inputs_timestep_final
public :: hb_free_atm_diff_prepare_vertical_diffusion_inputs_run
contains
@@ -48,97 +45,30 @@ subroutine hb_diff_set_vertical_diffusion_top_init( &
end subroutine hb_diff_set_vertical_diffusion_top_init
- ! Set total surface stresses for input into the HB PBL scheme.
- !
- ! NOTE: Temporarily, TMS and Beljaars are "hard-coupled" into this subroutine because
- ! the current focus is CAM4 and TMS/Beljaars drag have not been CCPPized.
- ! In the future, after TMS/Beljaars is implemented, this subroutine should only initialize
- ! surface stresses from the coupler, then TMS and Beljaars can work on adding the respective
- ! surface stresses to the tautotx/tautoty used by the PBL scheme.
-!> \section arg_table_hb_diff_set_total_surface_stress_run Argument Table
-!! \htmlinclude hb_diff_set_total_surface_stress_run.html
- subroutine hb_diff_set_total_surface_stress_run( &
- ncol, &
- wsx_from_coupler, wsy_from_coupler, &
- tautmsx, tautmsy, &
- taubljx, taubljy, &
- tautotx, tautoty, &
- errmsg, errflg)
-
- ! Input arguments
- integer, intent(in) :: ncol
- real(kind_phys), intent(in) :: wsx_from_coupler(:) ! Surface eastward wind stress from coupler [Pa]
- real(kind_phys), intent(in) :: wsy_from_coupler(:) ! Surface northward wind stress from coupler [Pa]
- real(kind_phys), intent(in) :: tautmsx(:) ! Eastward turbulent mountain surface stress [Pa]
- real(kind_phys), intent(in) :: tautmsy(:) ! Northward turbulent mountain surface stress [Pa]
- real(kind_phys), intent(in) :: taubljx(:) ! Eastward Beljaars surface stress [Pa]
- real(kind_phys), intent(in) :: taubljy(:) ! Northward Beljaars surface stress [Pa]
-
- ! Output arguments
- real(kind_phys), intent(out) :: tautotx(:) ! Eastward total stress at surface for boundary layer scheme [Pa]
- real(kind_phys), intent(out) :: tautoty(:) ! Northward total stress at surface for boundary layer scheme [Pa]
- character(len=512), intent(out) :: errmsg
- integer, intent(out) :: errflg
-
- errmsg = ''
- errflg = 0
-
- ! Initialize total surface stresses from coupler
- ! These are used for HB diffusion scheme and later PBL diagnostics but
- ! not for the vertical diffusion solver, which uses surface stresses from the coupler
- ! or just zero (in the case of CLUBB)
- tautotx(:ncol) = wsx_from_coupler(:ncol)
- tautoty(:ncol) = wsy_from_coupler(:ncol)
-
- ! Add turbulent mountain stress to total surface stress
- tautotx(:ncol) = tautotx(:ncol) + tautmsx(:ncol)
- tautoty(:ncol) = tautoty(:ncol) + tautmsy(:ncol)
-
- ! Add Beljaars integrated drag to total surface stress
- tautotx(:ncol) = tautotx(:ncol) + taubljx(:ncol)
- tautoty(:ncol) = tautoty(:ncol) + taubljy(:ncol)
-
- end subroutine hb_diff_set_total_surface_stress_run
-
! Interstitial for full HB (CAM4) to handle inputs from coupler and pass them
- ! to vertical diffusion solver, as well as vertical coordinate set up.
+ ! to vertical diffusion solver.
!> \section arg_table_hb_diff_prepare_vertical_diffusion_inputs_run Argument Table
!! \htmlinclude hb_diff_prepare_vertical_diffusion_inputs_run.html
subroutine hb_diff_prepare_vertical_diffusion_inputs_run( &
ncol, pverp, pcnst, &
- const_props, &
wsx_from_coupler, wsy_from_coupler, &
shf_from_coupler, &
cflx_from_coupler, &
- pint, &
! below output
taux, tauy, &
shflux, &
cflux, &
itaures, &
- p, &
- q_wv_cflx, &
errmsg, errflg)
- use coords_1d, only: Coords1D
-
- ! framework dependency for const_props
- use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t
-
- ! dependency to get constituent index
- use ccpp_const_utils, only: ccpp_const_get_idx
-
! Input arguments
integer, intent(in) :: ncol ! Number of atmospheric columns [count]
integer, intent(in) :: pverp ! Number of vertical interfaces [count]
integer, intent(in) :: pcnst ! Number of CCPP constituents [count]
- type(ccpp_constituent_prop_ptr_t), &
- intent(in) :: const_props(:) ! CCPP constituent properties pointer
real(kind_phys), intent(in) :: wsx_from_coupler(:) ! Surface eastward wind stress from coupler [Pa]
real(kind_phys), intent(in) :: wsy_from_coupler(:) ! Surface northward wind stress from coupler [Pa]
real(kind_phys), intent(in) :: shf_from_coupler(:) ! Surface upward sensible heat flux from coupler [W m-2]
real(kind_phys), intent(in) :: cflx_from_coupler(:,:) ! Surface upward constituent fluxes from coupler [kg m-2 s-1]
- real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa]
! Output arguments
real(kind_phys), intent(out) :: taux(:) ! Eastward stress at surface for vertical diffusion [Pa]
@@ -146,14 +76,9 @@ subroutine hb_diff_prepare_vertical_diffusion_inputs_run( &
real(kind_phys), intent(out) :: shflux(:) ! Surface upward sensible heat flux for vertical diffusion [W m-2]
real(kind_phys), intent(out) :: cflux(:,:) ! Surface upward constituent fluxes for vertical diffusion [kg m-2 s-1]
logical, intent(out) :: itaures ! Flag for updating residual stress at surface in vertical diffusion [flag]
- type(coords1d), intent(out) :: p ! Vertical moist pressure coordinates for vertical diffusion [Pa]
- real(kind_phys), intent(out) :: q_wv_cflx(:) ! Surface upward water vapor flux [kg m-2 s-1]
character(len=512), intent(out) :: errmsg ! Error message
integer, intent(out) :: errflg ! Error flag
- ! Local variables
- integer :: const_wv_idx ! Water vapor constituent index
-
errmsg = ''
errflg = 0
@@ -166,36 +91,8 @@ subroutine hb_diff_prepare_vertical_diffusion_inputs_run( &
! Set flag for updating residual stress to true
itaures = .true.
- ! Initialize pressure coordinate object for vertical diffusion solver
- p = Coords1D(pint(:ncol,:pverp))
-
- ! Get water vapor constituent index
- call ccpp_const_get_idx(const_props, &
- 'water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', &
- const_wv_idx, errmsg, errflg)
- if (errflg /= 0) return
-
- ! Extract water vapor flux for use in HB.
- q_wv_cflx(:ncol) = cflx_from_coupler(:ncol, const_wv_idx)
-
end subroutine hb_diff_prepare_vertical_diffusion_inputs_run
- ! Interstitial to clean up vertical coordinate after use.
-!> \section arg_table_hb_diff_prepare_vertical_diffusion_inputs_timestep_final Argument Table
-!! \htmlinclude hb_diff_prepare_vertical_diffusion_inputs_timestep_final.html
- subroutine hb_diff_prepare_vertical_diffusion_inputs_timestep_final(p, errmsg, errflg)
- use coords_1d, only: Coords1D
-
- type(coords1d), intent(inout) :: p ! Vertical moist pressure coordinates for vertical diffusion [Pa]
- character(len=512), intent(out) :: errmsg ! Error message
- integer, intent(out) :: errflg ! Error flag
-
- errmsg = ''
- errflg = 0
-
- call p%finalize()
- end subroutine hb_diff_prepare_vertical_diffusion_inputs_timestep_final
-
! Interstitial for free atmosphere version of HB used above CLUBB which will allow
! the diffusion solver to handle non-water vapor surface fluxes (CAM6)
! or no surface fluxes (CAM7)
@@ -206,14 +103,11 @@ subroutine hb_free_atm_diff_prepare_vertical_diffusion_inputs_run( &
const_props, &
apply_nonwv_cflx, &
cflx_from_coupler, &
- pint, &
! below output
taux, tauy, &
shflux, &
cflux, &
itaures, &
- p, &
- q_wv_cflx, &
errmsg, errflg)
use coords_1d, only: Coords1D
@@ -232,7 +126,6 @@ subroutine hb_free_atm_diff_prepare_vertical_diffusion_inputs_run( &
intent(in) :: const_props(:) ! CCPP constituent properties pointer
logical, intent(in) :: apply_nonwv_cflx ! Flag for applying constituent fluxes excluding water vapor [flag]
real(kind_phys), intent(in) :: cflx_from_coupler(:,:) ! Surface upward constituent fluxes from coupler [kg m-2 s-1]
- real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa]
! Output arguments
real(kind_phys), intent(out) :: taux(:) ! Eastward stress at surface for vertical diffusion [Pa]
@@ -240,8 +133,6 @@ subroutine hb_free_atm_diff_prepare_vertical_diffusion_inputs_run( &
real(kind_phys), intent(out) :: shflux(:) ! Surface upward sensible heat flux for vertical diffusion [W m-2]
real(kind_phys), intent(out) :: cflux(:,:) ! Surface upward constituent fluxes for vertical diffusion [kg m-2 s-1]
logical, intent(out) :: itaures ! Flag for updating residual stress at surface in vertical diffusion [flag]
- type(coords1d), intent(out) :: p ! Vertical moist pressure coordinates for vertical diffusion [Pa]
- real(kind_phys), intent(out) :: q_wv_cflx(:) ! Surface upward water vapor flux (for PBL scheme) [kg m-2 s-1]
character(len=512), intent(out) :: errmsg ! Error message
integer, intent(out) :: errflg ! Error flag
@@ -280,15 +171,6 @@ subroutine hb_free_atm_diff_prepare_vertical_diffusion_inputs_run( &
! Set flag for updating residual stress to true
itaures = .true.
- ! Initialize pressure coordinate object for vertical diffusion solver
- p = Coords1D(pint(:ncol,:pverp))
-
- ! Extract water vapor flux for use in the HB scheme to calculate
- ! kinematic water vapor fluxes.
- ! This is separate from the cflux above, which is provided to the diffusion
- ! solver for flux application.
- q_wv_cflx(:ncol) = cflx_from_coupler(:ncol, const_wv_idx)
-
end subroutine hb_free_atm_diff_prepare_vertical_diffusion_inputs_run
end module holtslag_boville_diff_interstitials
diff --git a/schemes/holtslag_boville/holtslag_boville_diff_interstitials.meta b/schemes/holtslag_boville/holtslag_boville_diff_interstitials.meta
index d9eeb452..64a67f60 100644
--- a/schemes/holtslag_boville/holtslag_boville_diff_interstitials.meta
+++ b/schemes/holtslag_boville/holtslag_boville_diff_interstitials.meta
@@ -25,80 +25,6 @@
type = integer
intent = out
-[ccpp-table-properties]
- name = hb_diff_set_total_surface_stress
- type = scheme
-
-[ccpp-arg-table]
- name = hb_diff_set_total_surface_stress_run
- type = scheme
-[ ncol ]
- standard_name = horizontal_loop_extent
- units = count
- dimensions = ()
- type = integer
- intent = in
-[ wsx_from_coupler ]
- standard_name = surface_eastward_wind_stress_from_coupler
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ wsy_from_coupler ]
- standard_name = surface_northward_wind_stress_from_coupler
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ tautmsx ]
- standard_name = eastward_turbulent_mountain_surface_stress_tbd
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ tautmsy ]
- standard_name = northward_turbulent_mountain_surface_stress_tbd
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ taubljx ]
- standard_name = eastward_beljaars_surface_stress_tbd
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ taubljy ]
- standard_name = northward_beljaars_surface_stress_tbd
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = in
-[ tautotx ]
- standard_name = eastward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = out
-[ tautoty ]
- standard_name = northward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
- units = N m-2
- dimensions = (horizontal_loop_extent)
- type = real | kind = kind_phys
- intent = out
-[ errmsg ]
- standard_name = ccpp_error_message
- units = none
- dimensions = ()
- type = character | kind = len=512
- intent = out
-[ errflg ]
- standard_name = ccpp_error_code
- units = 1
- dimensions = ()
- type = integer
- intent = out
-
[ccpp-table-properties]
name = hb_diff_prepare_vertical_diffusion_inputs
type = scheme
@@ -125,12 +51,6 @@
dimensions = ()
type = integer
intent = in
-[ const_props ]
- standard_name = ccpp_constituent_properties
- units = none
- type = ccpp_constituent_prop_ptr_t
- dimensions = (number_of_ccpp_constituents)
- intent = in
[ wsx_from_coupler ]
standard_name = surface_eastward_wind_stress_from_coupler
units = N m-2
@@ -155,12 +75,6 @@
dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
type = real | kind = kind_phys
intent = in
-[ pint ]
- standard_name = air_pressure_at_interface
- units = Pa
- dimensions = (horizontal_loop_extent, vertical_interface_dimension)
- type = real | kind = kind_phys
- intent = in
[ taux ]
standard_name = eastward_stress_at_surface_for_vertical_diffusion
units = N m-2
@@ -191,40 +105,6 @@
dimensions = ()
type = logical
intent = out
-[ p ]
- standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
- units = none
- dimensions = ()
- type = coords1d
- intent = out
-[ q_wv_cflx ]
- standard_name = surface_upward_water_vapor_flux
- units = kg m-2 s-1
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = out
-[ errmsg ]
- standard_name = ccpp_error_message
- units = none
- dimensions = ()
- type = character | kind = len=512
- intent = out
-[ errflg ]
- standard_name = ccpp_error_code
- units = 1
- dimensions = ()
- type = integer
- intent = out
-
-[ccpp-arg-table]
- name = hb_diff_prepare_vertical_diffusion_inputs_timestep_final
- type = scheme
-[ p ]
- standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
- units = none
- dimensions = ()
- type = coords1d
- intent = inout
[ errmsg ]
standard_name = ccpp_error_message
units = none
@@ -282,12 +162,6 @@
dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
type = real | kind = kind_phys
intent = in
-[ pint ]
- standard_name = air_pressure_at_interface
- units = Pa
- dimensions = (horizontal_loop_extent, vertical_interface_dimension)
- type = real | kind = kind_phys
- intent = in
[ taux ]
standard_name = eastward_stress_at_surface_for_vertical_diffusion
units = N m-2
@@ -318,18 +192,6 @@
dimensions = ()
type = logical
intent = out
-[ p ]
- standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
- units = none
- dimensions = ()
- type = coords1d
- intent = out
-[ q_wv_cflx ]
- standard_name = surface_upward_water_vapor_flux
- units = kg m-2 s-1
- type = real | kind = kind_phys
- dimensions = (horizontal_loop_extent)
- intent = out
[ errmsg ]
standard_name = ccpp_error_message
units = none
diff --git a/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.F90 b/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.F90
new file mode 100644
index 00000000..09f0d121
--- /dev/null
+++ b/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.F90
@@ -0,0 +1,434 @@
+! Diagnostics for Bretherton-Park (UW) PBL scheme
+module bretherton_park_diff_diagnostics
+
+ implicit none
+ private
+
+ public :: bretherton_park_diff_diagnostics_init
+ public :: bretherton_park_diff_diagnostics_run
+
+contains
+
+!> \section arg_table_bretherton_park_diff_diagnostics_init Argument Table
+!! \htmlinclude bretherton_park_diff_diagnostics_init.html
+ subroutine bretherton_park_diff_diagnostics_init(errmsg, errflg)
+ use cam_history, only: history_add_field
+ use cam_history_support, only: horiz_only
+
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ errmsg = ''
+ errflg = 0
+
+ ! History add field calls - surface and horizontal-only fields
+ call history_add_field('WGUSTD', 'Wind gusts from turbulence', horiz_only, 'avg', 'm s-1')
+ call history_add_field('UW_errorPBL', 'Error function of UW PBL', horiz_only, 'avg', 'm2 s-1')
+ call history_add_field('UW_pblh', 'PBL height', horiz_only, 'avg', 'm')
+ call history_add_field('UW_pblhp', 'PBL top pressure', horiz_only, 'avg', 'Pa')
+ call history_add_field('UW_tpert', 'Convective temperature excess', horiz_only, 'avg', 'K')
+ call history_add_field('UW_qpert', 'Convective moisture excess', horiz_only, 'avg', 'kg kg-1')
+ call history_add_field('UW_wpert', 'Convective velocity excess', horiz_only, 'avg', 'm s-1')
+ call history_add_field('UW_ustar', 'Surface friction velocity', horiz_only, 'avg', 'm s-1')
+ call history_add_field('UW_tkes', 'Surface TKE per unit mass', horiz_only, 'avg', 'm2 s-2')
+ call history_add_field('UW_minpblh', 'Minimum PBL height', horiz_only, 'avg', 'm')
+ call history_add_field('UW_ncvfin_o', 'Initial total number of CL regimes', horiz_only, 'avg', '1')
+ call history_add_field('UW_ncvfin_mg', 'Number of CLs after merging', horiz_only, 'avg', '1')
+ call history_add_field('UW_ncvfin_f', 'Final number of CLs with SRCL', horiz_only, 'avg', '1')
+
+ ! Level-based (midpoint) fields
+ call history_add_field('UW_n2', 'Buoyancy frequency', 'lev', 'avg', 's-2')
+ call history_add_field('UW_s2', 'Shear frequency', 'lev', 'avg', 's-2')
+ call history_add_field('UW_ri', 'Gradient Richardson number', 'lev', 'avg', '1')
+ call history_add_field('UW_sfuh', 'Upper-half saturation fraction', 'lev', 'avg', '1')
+ call history_add_field('UW_sflh', 'Lower-half saturation fraction', 'lev', 'avg', '1')
+ call history_add_field('UW_cldn', 'Cloud fraction', 'lev', 'avg', '1')
+ call history_add_field('UW_qrl', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness', 'lev', 'avg', 'K s-1')
+ call history_add_field('UW_ql', 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_for_eddy_diffusion', 'lev', 'avg', 'kg kg-1')
+
+ ! Interface-based fields
+ call history_add_field('BPROD', 'TKE production due to buoyancy', 'ilev', 'avg', 'm2 s-3')
+ call history_add_field('SFI', 'Interface-layer saturation fraction', 'ilev', 'avg', '1')
+ call history_add_field('SPROD', 'TKE production due to vertical shear', 'ilev', 'avg', 'm2 s-3')
+ call history_add_field('UW_sfi', 'Interface saturation fraction', 'ilev', 'avg', '1')
+ call history_add_field('UW_chu', 'Buoyancy coefficient chu', 'ilev', 'avg', 'm s-2 kg J-1')
+ call history_add_field('UW_chs', 'Buoyancy coefficient chs', 'ilev', 'avg', 'm s-2 kg J-1')
+ call history_add_field('UW_cmu', 'Buoyancy coefficient cmu', 'ilev', 'avg', 'm s-2 kg-1 kg')
+ call history_add_field('UW_cms', 'Buoyancy coefficient cms', 'ilev', 'avg', 'm s-2 kg-1 kg')
+ call history_add_field('UW_tke', 'Turbulent kinetic energy (TKE) per unit mass', 'ilev', 'avg', 'm2 s-2')
+ call history_add_field('UW_wcap', 'Normalized TKE per unit mass', 'ilev', 'avg', 'm2 s-2')
+ call history_add_field('UW_kvh', 'Eddy diffusivity of heat', 'ilev', 'avg', 'm2 s-1')
+ call history_add_field('UW_kvm', 'Eddy diffusivity of momentum', 'ilev', 'avg', 'm2 s-1')
+ call history_add_field('UW_turbtype', 'Interface turbulence type identifier', 'ilev', 'avg', '1')
+ call history_add_field('UW_gh', 'Normalized buoyancy production at all interfaces', 'ilev', 'avg', '1')
+ call history_add_field('UW_sh', 'Galperin instability function for heat-moisture at all interfaces', 'ilev', 'avg', '1')
+ call history_add_field('UW_sm', 'Galperin instability function for momentum at all interfaces', 'ilev', 'avg', '1')
+ call history_add_field('UW_ria', 'Gradient Richardson number at all interfaces', 'ilev', 'avg', '1')
+ call history_add_field('UW_leng', 'Turbulence length scale at all interfaces', 'ilev', 'avg', 'm')
+
+ ! Convective layer (CL) regime fields - these have dimension ncvmax
+ ! Note: These need special handling in metadata for the ncvmax dimension;
+ ! for history output, they are output throughout the vertical (and padded to zero otherwise)
+ !
+ ! Note: this logic is 'overbuilt' in this diagnostics scheme, because for now
+ ! ncvmax is hardcoded to pver in the UW PBL scheme.
+ ! But it is better to overbuild this now rather than risking an out-of-bounds error
+ ! down the line if ncvmax is set to less than pver.
+ call history_add_field('UW_kbase_o', 'Initial CL base external interface index', 'lev', 'avg', '1')
+ call history_add_field('UW_ktop_o', 'Initial CL top external interface index', 'lev', 'avg', '1')
+ call history_add_field('UW_kbase_mg', 'CL base after merging', 'lev', 'avg', '1')
+ call history_add_field('UW_ktop_mg', 'CL top after merging', 'lev', 'avg', '1')
+ call history_add_field('UW_kbase_f', 'Final CL base with SRCL', 'lev', 'avg', '1')
+ call history_add_field('UW_ktop_f', 'Final CL top with SRCL', 'lev', 'avg', '1')
+ call history_add_field('UW_wet', 'Entrainment rate at CL top', 'lev', 'avg', 'm s-1')
+ call history_add_field('UW_web', 'Entrainment rate at CL base', 'lev', 'avg', 'm s-1')
+ call history_add_field('UW_jtbu', 'Buoyancy jump across CL top', 'lev', 'avg', 'm s-2')
+ call history_add_field('UW_jbbu', 'Buoyancy jump across CL base', 'lev', 'avg', 'm s-2')
+ call history_add_field('UW_evhc', 'Evaporative enhancement factor at CL top', 'lev', 'avg', '1')
+ call history_add_field('UW_jt2slv', 'Liquid water virtual static energy jump for evhc', 'lev', 'avg', 'J kg-1')
+ call history_add_field('UW_n2ht', 'Buoyancy frequency at just below CL top interface', 'lev', 'avg', 's-2')
+ call history_add_field('UW_n2hb', 'Buoyancy frequency at just above CL base interface', 'lev', 'avg', 's-2')
+ call history_add_field('UW_lwp', 'Liquid water path in CL top layer', 'lev', 'avg', 'kg m-2')
+ call history_add_field('UW_optdepth', 'Optical depth of CL top layer', 'lev', 'avg', '1')
+ call history_add_field('UW_radfrac', 'Fraction of radiative cooling confined in CL top', 'lev', 'avg', '1')
+ call history_add_field('UW_radf', 'Buoyancy production at CL top by radiative cooling', 'lev', 'avg', 'm2 s-3')
+ call history_add_field('UW_wstar', 'Convective velocity in each CL', 'lev', 'avg', 'm s-1')
+ call history_add_field('UW_wstar3fact', 'Enhancement of wstar3 due to entrainment', 'lev', 'avg', '1')
+ call history_add_field('UW_ebrk', 'Net mean TKE of CL including entrainment effect', 'lev', 'avg', 'm2 s-2')
+ call history_add_field('UW_wbrk', 'Net mean normalized TKE of CL', 'lev', 'avg', 'm2 s-2')
+ call history_add_field('UW_lbrk', 'Energetic internal thickness of CL', 'lev', 'avg', 'm')
+ call history_add_field('UW_ricl', 'CL-averaged Richardson number', 'lev', 'avg', '1')
+ call history_add_field('UW_ghcl', 'CL-averaged normalized buoyancy production', 'lev', 'avg', '1')
+ call history_add_field('UW_shcl', 'CL-averaged Galperin instability function for heat-moisture', 'lev', 'avg', '1')
+ call history_add_field('UW_smcl', 'CL-averaged Galperin instability function for momentum', 'lev', 'avg', '1')
+ call history_add_field('UW_wsed', 'Sedimentation velocity at top of each CL', 'lev', 'avg', 'm s-1')
+
+ end subroutine bretherton_park_diff_diagnostics_init
+
+!> \section arg_table_bretherton_park_diff_diagnostics_run Argument Table
+!! \htmlinclude bretherton_park_diff_diagnostics_run.html
+ subroutine bretherton_park_diff_diagnostics_run( &
+ ncol, pver, pverp, ncvmax, &
+ ! Surface/horizontal-only fields
+ errorPBL, pblh, pblhp, &
+ tpert, qpert, wpert, &
+ ustar, tkes, minpblh, &
+ ncvfin_o, ncvfin_mg, ncvfin_f, &
+ ! Level fields
+ n2, s2, ri, &
+ sfuh, sflh, &
+ cldn, qrl, qlfd, &
+ ! Interface fields
+ bprod, sprod, sfi, &
+ chu, chs, cmu, cms, &
+ tke, wcap, &
+ kvh, kvm, &
+ turbtype, &
+ ghi, shi, smi, rii, lengi, &
+ ! Convective layer fields (ncvmax dimension)
+ kbase_o, ktop_o, &
+ kbase_mg, ktop_mg, &
+ kbase_f, ktop_f, &
+ wet, web, &
+ jtbu, jbbu, &
+ evhc, jt2slv, &
+ n2ht, n2hb, &
+ lwp, opt_depth, radinvfrac, radf, &
+ wstar, wstar3fact, &
+ ebrk, wbrk, lbrk, &
+ ricl, ghcl, shcl, smcl, &
+ wsed, &
+ errmsg, errflg)
+
+ use ccpp_kinds, only: kind_phys
+
+ use cam_history, only: history_out_field
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ integer, intent(in) :: pverp
+ integer, intent(in) :: ncvmax ! # of convective layers [count]
+
+ real(kind_phys), intent(in) :: errorPBL(:)
+ real(kind_phys), intent(in) :: pblh(:)
+ real(kind_phys), intent(in) :: pblhp(:)
+ real(kind_phys), intent(in) :: tpert(:)
+ real(kind_phys), intent(in) :: qpert(:)
+ real(kind_phys), intent(in) :: wpert(:)
+ real(kind_phys), intent(in) :: ustar(:)
+ real(kind_phys), intent(in) :: tkes(:)
+ real(kind_phys), intent(in) :: minpblh(:)
+ real(kind_phys), intent(in) :: ncvfin_o(:)
+ real(kind_phys), intent(in) :: ncvfin_mg(:)
+ real(kind_phys), intent(in) :: ncvfin_f(:)
+
+ real(kind_phys), intent(in) :: n2(:,:)
+ real(kind_phys), intent(in) :: s2(:,:)
+ real(kind_phys), intent(in) :: ri(:,:)
+ real(kind_phys), intent(in) :: sfuh(:,:)
+ real(kind_phys), intent(in) :: sflh(:,:)
+ real(kind_phys), intent(in) :: cldn(:,:)
+ real(kind_phys), intent(in) :: qrl(:,:)
+ real(kind_phys), intent(in) :: qlfd(:,:)
+
+ real(kind_phys), intent(in) :: bprod(:,:)
+ real(kind_phys), intent(in) :: sprod(:,:)
+ real(kind_phys), intent(in) :: sfi(:,:)
+ real(kind_phys), intent(in) :: chu(:,:)
+ real(kind_phys), intent(in) :: chs(:,:)
+ real(kind_phys), intent(in) :: cmu(:,:)
+ real(kind_phys), intent(in) :: cms(:,:)
+ real(kind_phys), intent(in) :: tke(:,:)
+ real(kind_phys), intent(in) :: wcap(:,:)
+ real(kind_phys), intent(in) :: kvh(:,:)
+ real(kind_phys), intent(in) :: kvm(:,:)
+ integer, intent(in) :: turbtype(:,:)
+ real(kind_phys), intent(in) :: ghi(:,:)
+ real(kind_phys), intent(in) :: shi(:,:)
+ real(kind_phys), intent(in) :: smi(:,:)
+ real(kind_phys), intent(in) :: rii(:,:)
+ real(kind_phys), intent(in) :: lengi(:,:)
+
+ ! Convective layer input parameters (ncvmax dimension)
+ real(kind_phys), intent(in) :: kbase_o(:,:)
+ real(kind_phys), intent(in) :: ktop_o(:,:)
+ real(kind_phys), intent(in) :: kbase_mg(:,:)
+ real(kind_phys), intent(in) :: ktop_mg(:,:)
+ real(kind_phys), intent(in) :: kbase_f(:,:)
+ real(kind_phys), intent(in) :: ktop_f(:,:)
+ real(kind_phys), intent(in) :: wet(:,:)
+ real(kind_phys), intent(in) :: web(:,:)
+ real(kind_phys), intent(in) :: jtbu(:,:)
+ real(kind_phys), intent(in) :: jbbu(:,:)
+ real(kind_phys), intent(in) :: evhc(:,:)
+ real(kind_phys), intent(in) :: jt2slv(:,:)
+ real(kind_phys), intent(in) :: n2ht(:,:)
+ real(kind_phys), intent(in) :: n2hb(:,:)
+ real(kind_phys), intent(in) :: lwp(:,:)
+ real(kind_phys), intent(in) :: opt_depth(:,:)
+ real(kind_phys), intent(in) :: radinvfrac(:,:)
+ real(kind_phys), intent(in) :: radf(:,:)
+ real(kind_phys), intent(in) :: wstar(:,:)
+ real(kind_phys), intent(in) :: wstar3fact(:,:)
+ real(kind_phys), intent(in) :: ebrk(:,:)
+ real(kind_phys), intent(in) :: wbrk(:,:)
+ real(kind_phys), intent(in) :: lbrk(:,:)
+ real(kind_phys), intent(in) :: ricl(:,:)
+ real(kind_phys), intent(in) :: ghcl(:,:)
+ real(kind_phys), intent(in) :: shcl(:,:)
+ real(kind_phys), intent(in) :: smcl(:,:)
+ real(kind_phys), intent(in) :: wsed(:,:)
+
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ ! Local variable for turbtype conversion from integer to real.
+ real(kind_phys) :: turbtype_real(ncol, pverp)
+
+ ! Temporary array for ncvmax to pver conversion (reusable)
+ ! Note that ncvmax is up to pver, so the maximum this temp array
+ ! is up to pver (not pverp).
+ real(kind_phys) :: tmp_lev(ncol, pver)
+
+ errmsg = ''
+ errflg = 0
+
+ ! Convert turbtype from integer to real for output
+ turbtype_real = real(turbtype, kind_phys)
+
+ ! Surface/horizontal-only fields
+ call history_out_field('WGUSTD', wpert)
+ call history_out_field('UW_errorPBL', errorPBL)
+ call history_out_field('UW_pblh', pblh)
+ call history_out_field('UW_pblhp', pblhp)
+ call history_out_field('UW_tpert', tpert)
+ call history_out_field('UW_qpert', qpert)
+ call history_out_field('UW_wpert', wpert)
+ call history_out_field('UW_ustar', ustar)
+ call history_out_field('UW_tkes', tkes)
+ call history_out_field('UW_minpblh', minpblh)
+ call history_out_field('UW_ncvfin_o', ncvfin_o)
+ call history_out_field('UW_ncvfin_mg', ncvfin_mg)
+ call history_out_field('UW_ncvfin_f', ncvfin_f)
+
+ ! Level fields
+ call history_out_field('UW_n2', n2)
+ call history_out_field('UW_s2', s2)
+ call history_out_field('UW_ri', ri)
+ call history_out_field('UW_sfuh', sfuh)
+ call history_out_field('UW_sflh', sflh)
+ call history_out_field('UW_cldn', cldn)
+ call history_out_field('UW_qrl', qrl)
+ call history_out_field('UW_ql', qlfd)
+
+ ! Interface fields
+ call history_out_field('BPROD', bprod)
+ call history_out_field('SFI', sfi)
+ call history_out_field('SPROD', sprod)
+ call history_out_field('UW_sfi', sfi)
+ call history_out_field('UW_chu', chu)
+ call history_out_field('UW_chs', chs)
+ call history_out_field('UW_cmu', cmu)
+ call history_out_field('UW_cms', cms)
+ call history_out_field('UW_tke', tke)
+ call history_out_field('UW_wcap', wcap)
+ call history_out_field('UW_kvh', kvh)
+ call history_out_field('UW_kvm', kvm)
+ call history_out_field('UW_turbtype', turbtype_real)
+ call history_out_field('UW_gh', ghi)
+ call history_out_field('UW_sh', shi)
+ call history_out_field('UW_sm', smi)
+ call history_out_field('UW_ria', rii)
+ call history_out_field('UW_leng', lengi)
+
+ ! Convective layer fields (convert from ncvmax to pver dimension)
+ ! Copy data up to ncvmax then pad with zeroes.
+ !
+ ! The following code is overbuilt for when ncvmax < pver
+ if (ncvmax < pver) then
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = kbase_o(:, :ncvmax)
+ call history_out_field('UW_kbase_o', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ktop_o(:, :ncvmax)
+ call history_out_field('UW_ktop_o', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = kbase_mg(:, :ncvmax)
+ call history_out_field('UW_kbase_mg', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ktop_mg(:, :ncvmax)
+ call history_out_field('UW_ktop_mg', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = kbase_f(:, :ncvmax)
+ call history_out_field('UW_kbase_f', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ktop_f(:, :ncvmax)
+ call history_out_field('UW_ktop_f', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = wet(:, :ncvmax)
+ call history_out_field('UW_wet', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = web(:, :ncvmax)
+ call history_out_field('UW_web', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = jtbu(:, :ncvmax)
+ call history_out_field('UW_jtbu', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = jbbu(:, :ncvmax)
+ call history_out_field('UW_jbbu', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = evhc(:, :ncvmax)
+ call history_out_field('UW_evhc', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = jt2slv(:, :ncvmax)
+ call history_out_field('UW_jt2slv', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = n2ht(:, :ncvmax)
+ call history_out_field('UW_n2ht', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = n2hb(:, :ncvmax)
+ call history_out_field('UW_n2hb', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = lwp(:, :ncvmax)
+ call history_out_field('UW_lwp', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = opt_depth(:, :ncvmax)
+ call history_out_field('UW_optdepth', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = radinvfrac(:, :ncvmax)
+ call history_out_field('UW_radfrac', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = radf(:, :ncvmax)
+ call history_out_field('UW_radf', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = wstar(:, :ncvmax)
+ call history_out_field('UW_wstar', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = wstar3fact(:, :ncvmax)
+ call history_out_field('UW_wstar3fact', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ebrk(:, :ncvmax)
+ call history_out_field('UW_ebrk', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = wbrk(:, :ncvmax)
+ call history_out_field('UW_wbrk', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = lbrk(:, :ncvmax)
+ call history_out_field('UW_lbrk', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ricl(:, :ncvmax)
+ call history_out_field('UW_ricl', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = ghcl(:, :ncvmax)
+ call history_out_field('UW_ghcl', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = shcl(:, :ncvmax)
+ call history_out_field('UW_shcl', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = smcl(:, :ncvmax)
+ call history_out_field('UW_smcl', tmp_lev)
+
+ tmp_lev = 0.0_kind_phys
+ tmp_lev(:, :ncvmax) = wsed(:, :ncvmax)
+ call history_out_field('UW_wsed', tmp_lev)
+ else
+ ! If ncvmax is pver, we do not need additional copying.
+ call history_out_field('UW_kbase_o', kbase_o)
+ call history_out_field('UW_ktop_o', ktop_o)
+ call history_out_field('UW_kbase_mg', kbase_mg)
+ call history_out_field('UW_ktop_mg', ktop_mg)
+ call history_out_field('UW_kbase_f', kbase_f)
+ call history_out_field('UW_ktop_f', ktop_f)
+ call history_out_field('UW_wet', wet)
+ call history_out_field('UW_web', web)
+ call history_out_field('UW_jtbu', jtbu)
+ call history_out_field('UW_jbbu', jbbu)
+ call history_out_field('UW_evhc', evhc)
+ call history_out_field('UW_jt2slv', jt2slv)
+ call history_out_field('UW_n2ht', n2ht)
+ call history_out_field('UW_n2hb', n2hb)
+ call history_out_field('UW_lwp', lwp)
+ call history_out_field('UW_optdepth', opt_depth)
+ call history_out_field('UW_radfrac', radinvfrac)
+ call history_out_field('UW_radf', radf)
+ call history_out_field('UW_wstar', wstar)
+ call history_out_field('UW_wstar3fact', wstar3fact)
+ call history_out_field('UW_ebrk', ebrk)
+ call history_out_field('UW_wbrk', wbrk)
+ call history_out_field('UW_lbrk', lbrk)
+ call history_out_field('UW_ricl', ricl)
+ call history_out_field('UW_ghcl', ghcl)
+ call history_out_field('UW_shcl', shcl)
+ call history_out_field('UW_smcl', smcl)
+ call history_out_field('UW_wsed', wsed)
+ end if
+
+ end subroutine bretherton_park_diff_diagnostics_run
+
+end module bretherton_park_diff_diagnostics
diff --git a/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.meta b/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.meta
new file mode 100644
index 00000000..9c935bdd
--- /dev/null
+++ b/schemes/sima_diagnostics/bretherton_park_diff_diagnostics.meta
@@ -0,0 +1,449 @@
+[ccpp-table-properties]
+ name = bretherton_park_diff_diagnostics
+ type = scheme
+
+[ccpp-arg-table]
+ name = bretherton_park_diff_diagnostics_init
+ type = scheme
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
+
+[ccpp-arg-table]
+ name = bretherton_park_diff_diagnostics_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pverp ]
+ standard_name = vertical_interface_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ ncvmax ]
+ standard_name = maximum_number_of_convective_layers_in_eddy_diffusion
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ errorPBL ]
+ standard_name = atmosphere_boundary_layer_convergence_indicator
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ pblh ]
+ standard_name = atmosphere_boundary_layer_thickness
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ pblhp ]
+ standard_name = air_pressure_at_top_of_atmosphere_boundary_layer
+ units = Pa
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ tpert ]
+ standard_name = convective_temperature_perturbation_due_to_pbl_eddies
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ qpert ]
+ standard_name = convective_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_perturbation_due_to_pbl_eddies
+ units = kg kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ wpert ]
+ standard_name = turbulent_vertical_velocity_excess
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ ustar ]
+ standard_name = surface_friction_velocity
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ tkes ]
+ standard_name = tke_at_surface
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ minpblh ]
+ standard_name = minimum_atmosphere_boundary_layer_thickness
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ ncvfin_o ]
+ standard_name = number_of_initial_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ ncvfin_mg ]
+ standard_name = number_of_merged_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ ncvfin_f ]
+ standard_name = number_of_final_convective_layer_regimes
+ units = count
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ n2 ]
+ standard_name = squared_buoyancy_frequency
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ s2 ]
+ standard_name = square_of_vertical_wind_shear
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ ri ]
+ standard_name = gradient_richardson_number
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ sfuh ]
+ standard_name = water_vapor_saturation_fraction_at_upper_half_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ sflh ]
+ standard_name = water_vapor_saturation_fraction_at_lower_half_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ cldn ]
+ standard_name = stratiform_cloud_area_fraction
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ qrl ]
+ standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness
+ units = J Pa kg-1 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ qlfd ]
+ standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_for_eddy_diffusion
+ units = kg kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ bprod ]
+ standard_name = tke_production_due_to_buoyancy
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ sprod ]
+ standard_name = tke_production_due_to_vertical_shear
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ sfi ]
+ standard_name = water_vapor_saturation_fraction_at_interfaces
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ chu ]
+ standard_name = heat_buoyancy_coefficient_for_unsaturated_air
+ units = m s-2 kg J-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ chs ]
+ standard_name = heat_buoyancy_coefficient_for_saturated_air
+ units = m s-2 kg J-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ cmu ]
+ standard_name = moisture_buoyancy_coefficient_for_unsaturated_air
+ units = m s-2 kg-1 kg
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ cms ]
+ standard_name = moisture_buoyancy_coefficient_for_saturated_air
+ units = m s-2 kg-1 kg
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ tke ]
+ standard_name = tke_at_interfaces
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ wcap ]
+ standard_name = normalized_tke_at_interfaces
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ kvh ]
+ standard_name = eddy_heat_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ kvm ]
+ standard_name = eddy_momentum_diffusivity_at_interfaces
+ units = m2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ turbtype ]
+ standard_name = atmosphere_turbulence_type_at_interfaces
+ units = 1
+ type = integer
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ ghi ]
+ standard_name = normalized_tke_production_due_to_buoyancy_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ shi ]
+ standard_name = galperin_instability_function_for_heat_and_moisture_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ smi ]
+ standard_name = galperin_instability_function_for_momentum_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ rii ]
+ standard_name = gradient_richardson_number_at_interfaces
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ lengi ]
+ standard_name = turbulent_mixing_length_at_interfaces
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ intent = in
+[ kbase_o ]
+ standard_name = vertical_index_at_bottom_of_initial_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ktop_o ]
+ standard_name = vertical_index_at_top_of_initial_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ kbase_mg ]
+ standard_name = vertical_index_at_bottom_of_merged_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ktop_mg ]
+ standard_name = vertical_index_at_top_of_merged_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ kbase_f ]
+ standard_name = vertical_index_at_bottom_of_final_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ktop_f ]
+ standard_name = vertical_index_at_top_of_final_convective_layer
+ units = index
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ wet ]
+ standard_name = entrainment_rate_at_top_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ web ]
+ standard_name = entrainment_rate_at_bottom_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ jtbu ]
+ standard_name = buoyancy_jump_at_top_of_convective_layer
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ jbbu ]
+ standard_name = buoyancy_jump_at_bottom_of_convective_layer
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ evhc ]
+ standard_name = evaporative_enhancement_factor_at_top_of_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ jt2slv ]
+ standard_name = liquid_water_virtual_static_energy_jump_at_top_of_convective_layer
+ units = J kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ n2ht ]
+ standard_name = squared_buoyancy_frequency_at_top_of_convective_layer
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ n2hb ]
+ standard_name = squared_buoyancy_frequency_at_bottom_of_convective_layer
+ units = s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ lwp ]
+ standard_name = liquid_water_path_at_top_of_convective_layer
+ units = kg m-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ opt_depth ]
+ standard_name = atmosphere_optical_depth_at_top_of_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ radinvfrac ]
+ standard_name = fraction_of_longwave_radiative_cooling_at_top_of_convective_layer
+ units = fraction
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ radf ]
+ standard_name = specific_eddy_kinetic_energy_buoyancy_production_due_to_longwave_radiative_cooling_at_top_of_convective_layer
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ wstar ]
+ standard_name = convective_velocity_scale_in_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ wstar3fact ]
+ standard_name = reciprocal_of_entrainment_enhancement_factor_of_convective_velocity_scale_cubed_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ebrk ]
+ standard_name = tke_in_convective_layer
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ wbrk ]
+ standard_name = normalized_tke_in_convective_layer
+ units = m2 s-2
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ lbrk ]
+ standard_name = energetic_thickness_of_convective_layer
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ricl ]
+ standard_name = bulk_richardson_number_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ ghcl ]
+ standard_name = normalized_tke_production_due_to_buoyancy_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ shcl ]
+ standard_name = galperin_instability_function_for_heat_and_moisture_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ smcl ]
+ standard_name = galperin_instability_function_for_momentum_in_convective_layer
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ wsed ]
+ standard_name = sedimentation_velocity_of_liquid_stratus_cloud_droplet_at_top_of_convective_layer
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, maximum_number_of_convective_layers_in_eddy_diffusion)
+ intent = in
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
diff --git a/schemes/sima_diagnostics/diffusion_solver_diagnostics.F90 b/schemes/sima_diagnostics/diffusion_solver_diagnostics.F90
index 54c3f375..797ac0b4 100644
--- a/schemes/sima_diagnostics/diffusion_solver_diagnostics.F90
+++ b/schemes/sima_diagnostics/diffusion_solver_diagnostics.F90
@@ -161,7 +161,7 @@ subroutine vertical_diffusion_tendencies_diagnostics_run( &
real(kind_phys), intent(in) :: cam_in_shf(:) ! Surface sensible heat flux [W m-2]
real(kind_phys), intent(in) :: cam_in_cflx(:,:) ! Surface constituent fluxes [kg m-2 s-1]
- ! Surface stresses
+ ! Surface stresses passed to underlying boundary layer scheme
real(kind_phys), intent(in) :: tautotx(:) ! Total zonal surface stress [N m-2]
real(kind_phys), intent(in) :: tautoty(:) ! Total meridional surface stress [N m-2]
diff --git a/schemes/sima_diagnostics/diffusion_solver_diagnostics.meta b/schemes/sima_diagnostics/diffusion_solver_diagnostics.meta
index fa52a731..0e6663c7 100644
--- a/schemes/sima_diagnostics/diffusion_solver_diagnostics.meta
+++ b/schemes/sima_diagnostics/diffusion_solver_diagnostics.meta
@@ -156,16 +156,16 @@
intent = in
[ tautotx ]
# these are the taux input to the underlying boundary layer scheme providing the inputs
- # to the diffusion solver.
- standard_name = eastward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
+ # to the diffusion solver. The surface momentum flux diagnostics are derived from these:
+ standard_name = eastward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
units = N m-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = in
[ tautoty ]
# these are the tauy input to the underlying boundary layer scheme providing the inputs
- # to the diffusion solver.
- standard_name = northward_total_stress_at_surface_for_holtslag_boville_boundary_layer_scheme
+ # to the diffusion solver. The surface momentum flux diagnostics are derived from these:
+ standard_name = northward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
units = N m-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
diff --git a/schemes/sima_diagnostics/holtslag_boville_diff_diagnostics.meta b/schemes/sima_diagnostics/holtslag_boville_diff_diagnostics.meta
index e1fb9a7c..7606c682 100644
--- a/schemes/sima_diagnostics/holtslag_boville_diff_diagnostics.meta
+++ b/schemes/sima_diagnostics/holtslag_boville_diff_diagnostics.meta
@@ -64,7 +64,7 @@
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
intent = in
[ tke ]
- standard_name = specific_turbulent_kinetic_energy_at_interfaces
+ standard_name = tke_at_interfaces
units = m2 s-2
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
diff --git a/schemes/vertical_diffusion/diffusion_solver.F90 b/schemes/vertical_diffusion/diffusion_solver.F90
index 5bc6cadf..af3266bd 100644
--- a/schemes/vertical_diffusion/diffusion_solver.F90
+++ b/schemes/vertical_diffusion/diffusion_solver.F90
@@ -794,19 +794,28 @@ end subroutine vertical_diffusion_diffuse_dry_static_energy_run
! Set tracers to diffuse using vertical diffusion.
!> \section arg_table_vertical_diffusion_diffuse_tracers_init Argument Table
!! \htmlinclude arg_table_vertical_diffusion_diffuse_tracers_init.html
- pure subroutine vertical_diffusion_diffuse_tracers_init( &
+ subroutine vertical_diffusion_diffuse_tracers_init( &
ncnst, &
+ const_props, &
do_diffusion_const, &
errmsg, errflg)
+ ! framework dependency for const_props
+ use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t
+
! Input arguments
- integer, intent(in) :: ncnst ! # of constituents to diffuse. In eddy_diff, only wv. Others, all advected CCPP constituents.
+ integer, intent(in) :: ncnst ! # of constituents
+ type(ccpp_constituent_prop_ptr_t), &
+ intent(in) :: const_props(:) ! CCPP constituent properties pointer
! Output arguments
logical, intent(out) :: do_diffusion_const(:) ! diffuse constituents (size ncnst) [flag]
character(len=512), intent(out) :: errmsg ! error message
integer, intent(out) :: errflg ! error flag
+ integer :: m
+ character(len=256) :: cnst_name
+
errmsg = ''
errflg = 0
@@ -821,10 +830,29 @@ pure subroutine vertical_diffusion_diffuse_tracers_init( &
! Diffuse all constituents using moist coordinates.
do_diffusion_const(:ncnst) = .true.
- ! TODO: in the future (when dropmixnuc is implemented),
- ! handle that if constituent is treated in dropmixnuc
- ! (vertically mixed by ndrop activation process) then
- ! do not handle vertical diffusion in this module.
+ ! FIXME: when dropmixnuc is CCPPized, it should flag if a constituent
+ ! is treated there (i.e., vertically mixed by ndrop activation process)
+ ! and use this flag to skip handling of vertical diffusion in this module.
+ !
+ ! For now, we replicate the chemistry.F90 code that skips modal aerosol
+ ! species (which undergo ndrop activation mixing) but we do not want to
+ ! do this specific handling here...
+ do m = 1, ncnst
+ call const_props(m)%standard_name(cnst_name, errflg, errmsg)
+ if(errflg /= 0) return
+
+ ! cannot match just _a because it would match something like
+ ! moist_air_and_condensed_water ...
+ if(index(cnst_name, '_a1') > 0 .or. & ! MAM modal species.
+ index(cnst_name, '_a2') > 0 .or. & ! MAM modal species.
+ index(cnst_name, '_a3') > 0 .or. & ! MAM modal species.
+ index(cnst_name, '_a4') > 0 .or. & ! MAM modal species.
+ index(cnst_name, 'NUMLIQ') > 0) then ! micro_pumas_cam if modal/trop_strat carma
+ ! is a modal aerosol species undergoing ndrop activation mixing.
+ ! in this case, vertical diffusion does not diffuse it.
+ do_diffusion_const(m) = .false.
+ end if
+ end do
end subroutine vertical_diffusion_diffuse_tracers_init
diff --git a/schemes/vertical_diffusion/diffusion_solver.meta b/schemes/vertical_diffusion/diffusion_solver.meta
index 1063cf92..6b1d9c8d 100644
--- a/schemes/vertical_diffusion/diffusion_solver.meta
+++ b/schemes/vertical_diffusion/diffusion_solver.meta
@@ -719,19 +719,21 @@
name = vertical_diffusion_diffuse_tracers_init
type = scheme
[ ncnst ]
- # note: this is set to ccpp_constituents for now because
- # q is sized number_of_ccpp_constituents as well, and cannot
- # yet be a custom dimension. when CAM5 is ported, ncnst = 1,
- # and q would have to have a custom dimension of, e.g.,
- # number_of_ccpp_constituents_for_vertical_diffusion_solver.
- # but this is not yet supported, so ncnst is all constituents for now.
standard_name = number_of_ccpp_constituents
units = count
type = integer
dimensions = ()
intent = in
+[ const_props ]
+ standard_name = ccpp_constituent_properties
+ units = none
+ type = ccpp_constituent_prop_ptr_t
+ dimensions = (number_of_ccpp_constituents)
+ intent = in
[ do_diffusion_const ]
- # only dimension should be ncnst, not pcnst.
+ # this is for all CCPP constituents.
+ # if a subset call is desired (i.e., in iterative calls from UW/Bretherton-Park PBL)
+ # the CCPPized subroutine should be called directly.
standard_name = flag_for_ccpp_constituent_vertical_diffusion
units = flag
type = logical
@@ -766,12 +768,10 @@
dimensions = ()
intent = in
[ ncnst ]
- # note: this is set to ccpp_constituents for now because
- # q is sized number_of_ccpp_constituents as well, and cannot
- # yet be a custom dimension. when CAM5 is ported, ncnst = 1,
- # and q would have to have a custom dimension of, e.g.,
- # number_of_ccpp_constituents_for_vertical_diffusion_solver.
- # but this is not yet supported, so ncnst is all constituents for now.
+ # note: this is set to ccpp_constituents because the constituent array
+ # has this dimension.
+ # If a subset call is desired (i.e., in iterative calls in CAM5 for wv only)
+ # the CCPPized subroutine should be called directly.
standard_name = number_of_ccpp_constituents
units = count
type = integer
@@ -821,12 +821,11 @@
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
intent = in
[ cflx ]
- # same note applies for the ncnst argument above that the second dimension
- # is actually ncnst, not pcnst.
+ # see note above on ncnst dimension.
#
- # when this is made ncnst, the standard name could be changed to
- # surface_upward_ccpp_constituent_fluxes_for_vertical_diffusion
- standard_name = surface_upward_ccpp_constituent_fluxes_from_coupler
+ # when CLUBB is active, this variant of cflx (provided by the interstitials of the PBL scheme) will be zero;
+ # otherwise, it is a copy of the cflx from coupler.
+ standard_name = surface_upward_ccpp_constituent_fluxes_for_vertical_diffusion
units = kg m-2 s-1
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
@@ -850,8 +849,7 @@
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
intent = in
[ qmincg ]
- # same note applies for the ncnst argument above that the only dimension
- # is actually ncnst, not pcnst.
+ # see note above on ncnst dimension.
standard_name = ccpp_constituent_minimum_values
units = kg kg-1
type = real | kind = kind_phys
@@ -864,28 +862,28 @@
dimensions = (horizontal_loop_extent, vertical_interface_dimension)
intent = in
[ ubc_mmr ]
- # same note applies for the ncnst argument above that the second dimension
- # is actually ncnst, not pcnst.
+ # see note above on ncnst dimension.
standard_name = upper_boundary_condition_of_ccpp_constituents
units = none
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
intent = in
[ cnst_fixed_ubc ]
- # same note applies for the ncnst argument above that the only dimension
- # is actually ncnst, not pcnst.
+ # see note above on ncnst dimension.
standard_name = use_fixed_upper_boundary_condition_of_ccpp_constituents_tbd
units = flag
type = logical
dimensions = (number_of_ccpp_constituents)
intent = in
[ q0 ]
+ # see note above on ncnst dimension.
standard_name = ccpp_constituents
units = none
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent, vertical_layer_dimension, number_of_ccpp_constituents)
intent = in
[ q1 ]
+ # see note above on ncnst dimension.
standard_name = ccpp_constituents_after_vertical_diffusion
units = none
type = real | kind = kind_phys
diff --git a/schemes/vertical_diffusion/diffusion_stubs.F90 b/schemes/vertical_diffusion/diffusion_stubs.F90
index 9f5357d3..611514da 100644
--- a/schemes/vertical_diffusion/diffusion_stubs.F90
+++ b/schemes/vertical_diffusion/diffusion_stubs.F90
@@ -9,12 +9,12 @@ module diffusion_stubs
implicit none
private
- save
! CCPP-compliant subroutines
public :: zero_upper_boundary_condition_init
public :: tms_beljaars_zero_stub_run
+ public :: beljaars_zero_stub_run
public :: turbulent_mountain_stress_add_drag_coefficient_run
public :: beljaars_add_wind_damping_rate_run
@@ -23,6 +23,8 @@ module diffusion_stubs
public :: vertical_diffusion_not_use_rairv_init
+ public :: dropmixnuc_apply_surface_fluxes_run
+
contains
! Stub for zero upper boundary conditions before UBC module is CCPPized
@@ -107,10 +109,55 @@ subroutine tms_beljaars_zero_stub_run( &
dragblj(:ncol,:pver) = 0._kind_phys
! Set do_beljaars flag to false
+ ! note: this is actually a namelist variable in the Beljaars scheme.
+ ! eventually, we want to remove this when Beljaars is CCPPized and we
+ ! can just read the namelist parameter. Both stubs can be removed
+ ! at that point.
do_beljaars = .false.
end subroutine tms_beljaars_zero_stub_run
+ ! Stub for Beljaars to be set to zero while they are not implemented.
+!> \section arg_table_beljaars_zero_stub_run Argument Table
+!! \htmlinclude beljaars_zero_stub_run.html
+ subroutine beljaars_zero_stub_run( &
+ ncol, pver, &
+ do_beljaars, &
+ dragblj, &
+ taubljx, taubljy, &
+ errmsg, errflg)
+
+ ! Input arguments
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+
+ ! Output arguments
+ logical, intent(out) :: do_beljaars
+ real(kind_phys), intent(out) :: dragblj(:,:)! Drag profile from Beljaars SGO form drag > 0. [s-1]
+ real(kind_phys), intent(out) :: taubljx(:) ! Eastward Beljaars surface stress [N m-2]
+ real(kind_phys), intent(out) :: taubljy(:) ! Northward Beljaars surface stress [N m-2]
+ character(len=512), intent(out) :: errmsg ! Error message
+ integer, intent(out) :: errflg ! Error flag
+
+ errmsg = ''
+ errflg = 0
+
+ ! Set all Beljaars stresses to zero (stub implementation)
+ taubljx(:ncol) = 0._kind_phys
+ taubljy(:ncol) = 0._kind_phys
+
+ ! Set Beljaars 3-D drag profile to zero (stub implementation)
+ dragblj(:ncol,:pver) = 0._kind_phys
+
+ ! Set do_beljaars flag to false
+ ! note: this is actually a namelist variable in the Beljaars scheme.
+ ! eventually, we want to remove this when Beljaars is CCPPized and we
+ ! can just read the namelist parameter. Both stubs can be removed
+ ! at that point.
+ do_beljaars = .false.
+
+ end subroutine beljaars_zero_stub_run
+
! Add turbulent mountain stress to the total surface drag coefficient
!> \section arg_table_turbulent_mountain_stress_add_drag_coefficient_run Argument Table
!! \htmlinclude arg_table_turbulent_mountain_stress_add_drag_coefficient_run.html
@@ -328,5 +375,60 @@ subroutine vertical_diffusion_not_use_rairv_init( &
end subroutine vertical_diffusion_not_use_rairv_init
+ ! For constituents not handled by vertical diffusion
+ ! i.e., vertically mixed by ndrop activation process (dropmixnuc = true)
+ ! the explicit surface fluxes in the lowest layer are added directly here.
+ !
+ ! This changes q1 (constituents after vertical diffusion) rather than q
+ ! directly because even if this change is not via vertical mixing, it is
+ ! still accounted for as part of the vertical diffusion tendencies scheme.
+ ! NOTE: this code assumes wet mass mixing ratio.
+!> \section arg_table_dropmixnuc_apply_surface_fluxes_run Argument Table
+!! \htmlinclude dropmixnuc_apply_surface_fluxes_run.html
+ subroutine dropmixnuc_apply_surface_fluxes_run( &
+ ncol, pver, ncnst, &
+ dt, gravit, &
+ do_diffusion_const, &
+ cflux, &
+ rpdel, &
+ q1, &
+ errmsg, errflg)
+
+ ! Input arguments
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ integer, intent(in) :: ncnst
+ real(kind_phys), intent(in) :: dt ! Physics timestep [s]
+ real(kind_phys), intent(in) :: gravit ! Gravitational acceleration [m s-2]
+ logical, intent(in) :: do_diffusion_const(:) ! Flag for constituent vertical diffusion [flag]
+ real(kind_phys), intent(in) :: cflux(:, :) ! Surface flux for vdiff [kg m-2 s-1]
+ real(kind_phys), intent(in) :: rpdel(:, :) ! Reciprocal of pressure layer thickness [Pa-1]
+
+ ! Input/output arguments
+ real(kind_phys), intent(inout) :: q1(:, :, :) ! Constituent array after "vertical diffusion" [kg kg-1]
+
+ ! Output arguments
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ ! Local variables
+ real(kind_phys) :: flux_to_state_conversion_factor(ncol)
+ integer :: m
+
+ errmsg = ''
+ errflg = 0
+
+ flux_to_state_conversion_factor(:ncol) = dt*gravit*rpdel(:ncol, pver)
+
+ ! Apply surface fluxes only to constituents not handled by vertical diffusion
+ do m = 1, ncnst
+ if (.not. do_diffusion_const(m)) then
+ ! Add surface flux contribution to constituent array at lowest model layer
+ q1(:ncol, pver, m) = q1(:ncol, pver, m) + &
+ flux_to_state_conversion_factor(:ncol) * cflux(:ncol, m)
+ end if
+ end do
+
+ end subroutine dropmixnuc_apply_surface_fluxes_run
end module diffusion_stubs
diff --git a/schemes/vertical_diffusion/diffusion_stubs.meta b/schemes/vertical_diffusion/diffusion_stubs.meta
index ff2836e0..ef24ceab 100644
--- a/schemes/vertical_diffusion/diffusion_stubs.meta
+++ b/schemes/vertical_diffusion/diffusion_stubs.meta
@@ -116,6 +116,63 @@
type = integer
intent = out
+
+[ccpp-table-properties]
+ name = beljaars_zero_stub
+ type = scheme
+
+[ccpp-arg-table]
+ name = beljaars_zero_stub_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ do_beljaars ]
+ standard_name = do_beljaars_drag_in_vertical_diffusion_tbd
+ units = flag
+ type = logical
+ dimensions = ()
+ intent = out
+[ dragblj ]
+ standard_name = turbulent_orographic_form_drag_coefficent
+ units = s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ taubljx ]
+ standard_name = eastward_beljaars_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = out
+[ taubljy ]
+ standard_name = northward_beljaars_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ dimensions = ()
+ type = character | kind = len=512
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ dimensions = ()
+ type = integer
+ intent = out
+
[ccpp-table-properties]
name = turbulent_mountain_stress_add_drag_coefficient
type = scheme
@@ -413,3 +470,79 @@
type = integer
dimensions = ()
intent = out
+
+[ccpp-table-properties]
+ name = dropmixnuc_apply_surface_fluxes
+ type = scheme
+
+[ccpp-arg-table]
+ name = dropmixnuc_apply_surface_fluxes_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ ncnst ]
+ standard_name = number_of_ccpp_constituents
+ units = count
+ type = integer
+ dimensions = ()
+ intent = in
+[ dt ]
+ standard_name = timestep_for_physics
+ units = s
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ gravit ]
+ standard_name = standard_gravitational_acceleration
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ do_diffusion_const ]
+ standard_name = flag_for_ccpp_constituent_vertical_diffusion
+ units = flag
+ type = logical
+ dimensions = (number_of_ccpp_constituents)
+ intent = in
+[ cflux ]
+ # when CLUBB is active, this variant of cflx (provided by the interstitials of the PBL scheme) will be zero;
+ # otherwise, it is a copy of the cflx from coupler.
+ standard_name = surface_upward_ccpp_constituent_fluxes_for_vertical_diffusion
+ units = kg m-2 s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
+ intent = in
+[ rpdel ]
+ standard_name = reciprocal_of_air_pressure_thickness
+ units = Pa-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ q1 ]
+ standard_name = ccpp_constituents_after_vertical_diffusion
+ units = none
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension, number_of_ccpp_constituents)
+ intent = inout
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
diff --git a/schemes/vertical_diffusion/vertical_diffusion_interstitials.F90 b/schemes/vertical_diffusion/vertical_diffusion_interstitials.F90
new file mode 100644
index 00000000..b1fe45e5
--- /dev/null
+++ b/schemes/vertical_diffusion/vertical_diffusion_interstitials.F90
@@ -0,0 +1,206 @@
+! Interstitial scheme to prepare inputs for vertical diffusion solver
+! common to the Holtslag-Boville (HB) and Bretherton-Park (UW/diag_TKE)
+! PBL schemes.
+!
+! These include:
+! - the p vertical coordinate (coords1d), including destroying this object at end of timestep.
+! - potential temperature (th)
+module vertical_diffusion_interstitials
+ use ccpp_kinds, only: kind_phys
+
+ implicit none
+ private
+
+ ! CCPP-compliant public interfaces
+ public :: vertical_diffusion_prepare_inputs_run
+ public :: vertical_diffusion_prepare_inputs_timestep_final
+
+ public :: compute_kinematic_fluxes_and_obklen_run
+
+ public :: vertical_diffusion_set_total_surface_stress_run
+
+contains
+
+ ! Interstitial to prepare moist vertical coordinate for solver,
+ ! and compute potential temperature.
+!> \section arg_table_vertical_diffusion_prepare_inputs_run Argument Table
+!! \htmlinclude vertical_diffusion_prepare_inputs_run.html
+ subroutine vertical_diffusion_prepare_inputs_run( &
+ ncol, pver, pverp, &
+ pint, &
+ t, exner, &
+ p, &
+ th, &
+ errmsg, errflg)
+
+ use coords_1d, only: coords1d
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ integer, intent(in) :: pverp
+ real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa]
+ real(kind_phys), intent(in) :: t(:,:) ! temperature [K]
+ real(kind_phys), intent(in) :: exner(:,:)! exner [1]
+ type(coords1d), intent(out) :: p ! Vertical moist pressure coordinates for vertical diffusion [Pa]
+ real(kind_phys), intent(out) :: th(:,:) ! Potential temperature [K]
+ character(len=512), intent(out) :: errmsg ! Error message
+ integer, intent(out) :: errflg ! Error flag
+
+ errmsg = ''
+ errflg = 0
+
+ ! Initialize pressure coordinate object for vertical diffusion solver
+ p = coords1d(pint(:ncol,:pverp))
+
+ ! Calculate potential temperature [K]
+ th(:ncol,:) = t(:ncol,:) * exner(:ncol,:)
+
+ end subroutine vertical_diffusion_prepare_inputs_run
+
+ ! Interstitial to clean up vertical coordinate after use.
+!> \section arg_table_vertical_diffusion_prepare_inputs_timestep_final Argument Table
+!! \htmlinclude vertical_diffusion_prepare_inputs_timestep_final.html
+ subroutine vertical_diffusion_prepare_inputs_timestep_final(p, errmsg, errflg)
+ use coords_1d, only: coords1d
+
+ type(coords1d), intent(inout) :: p ! Vertical moist pressure coordinates for vertical diffusion [Pa]
+ character(len=512), intent(out) :: errmsg ! Error message
+ integer, intent(out) :: errflg ! Error flag
+
+ errmsg = ''
+ errflg = 0
+
+ call p%finalize()
+ end subroutine vertical_diffusion_prepare_inputs_timestep_final
+
+ ! Compute kinematic fluxes (heat, water vapor, buoyancy), and obukhov length
+!> \section arg_table_compute_kinematic_fluxes_and_obklen_run Argument Table
+!! \htmlinclude compute_kinematic_fluxes_and_obklen_run.html
+ subroutine compute_kinematic_fluxes_and_obklen_run( &
+ ncol, pver, pcnst, &
+ const_props, &
+ zvir, cpair, gravit, karman, &
+ shf_from_coupler, cflx_from_coupler, &
+ q_wv, &
+ th, &
+ rrho, &
+ ustar, &
+ ! below output:
+ khfs, kqfs, kbfs, &
+ obklen, &
+ errmsg, errflg)
+
+ ! framework dependency for const_props
+ use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t
+
+ ! dependency to get constituent index
+ use ccpp_const_utils, only: ccpp_const_get_idx
+
+ use atmos_phys_pbl_utils, only: calc_virtual_temperature, calc_obukhov_length, &
+ calc_kinematic_heat_flux, calc_kinematic_water_vapor_flux, &
+ calc_kinematic_buoyancy_flux
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: pver
+ integer, intent(in) :: pcnst
+ type(ccpp_constituent_prop_ptr_t), &
+ intent(in) :: const_props(:) ! CCPP constituent properties pointer
+ real(kind_phys), intent(in) :: zvir
+ real(kind_phys), intent(in) :: cpair
+ real(kind_phys), intent(in) :: gravit
+ real(kind_phys), intent(in) :: karman
+ real(kind_phys), intent(in) :: shf_from_coupler(:) ! Surface upward sensible heat flux from coupler [W m-2]
+ real(kind_phys), intent(in) :: cflx_from_coupler(:,:) ! Surface upward constituent fluxes from coupler [kg m-2 s-1]
+ real(kind_phys), intent(in) :: q_wv(:,:) ! specific humidity [kg kg-1]
+
+ real(kind_phys), intent(in) :: th(:,:) ! Potential temperature [K]
+
+ ! rrho and ustar from PBL scheme.
+ ! for HB, it is computed in hb_pbl_independent_coefficients_run;
+ ! for UW, it is iteratively updated in bretherton_park_diff_run and returned as a final result.
+ real(kind_phys), intent(in) :: rrho(:) ! 1 / bottom level density [m3 kg-1]
+ real(kind_phys), intent(in) :: ustar(:) ! surface friction velocity [m s-1]
+
+ ! Output arguments:
+ real(kind_phys), intent(out) :: khfs(:) ! kinematic surface heat flux [K m s-1]
+ real(kind_phys), intent(out) :: kqfs(:) ! kinematic surface water vapor flux [kg kg-1 m s-1]
+ real(kind_phys), intent(out) :: kbfs(:) ! surface kinematic buoyancy flux [m2 s-3]
+ real(kind_phys), intent(out) :: obklen(:) ! Obukhov length [m]
+
+ character(len=512), intent(out) :: errmsg ! Error message
+ integer, intent(out) :: errflg ! Error flag
+
+ ! Local variables
+ integer :: const_wv_idx ! Water vapor constituent index
+ real(kind_phys) :: thvs(ncol) ! Virtual potential temperature at surface [K]
+
+ ! Check constituents list and locate water vapor index
+ ! (not assumed to be 1)
+ call ccpp_const_get_idx(const_props, &
+ 'water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', &
+ const_wv_idx, errmsg, errflg)
+ if (errflg /= 0) return
+
+ thvs (:ncol) = calc_virtual_temperature(th(:ncol,pver), q_wv(:ncol,pver), zvir)
+ khfs (:ncol) = calc_kinematic_heat_flux(shf_from_coupler(:ncol), rrho(:ncol), cpair)
+ kqfs (:ncol) = calc_kinematic_water_vapor_flux(cflx_from_coupler(:ncol,const_wv_idx), rrho(:ncol))
+ kbfs (:ncol) = calc_kinematic_buoyancy_flux(khfs(:ncol), zvir, th(:ncol,pver), kqfs(:ncol))
+ obklen(:ncol) = calc_obukhov_length(thvs(:ncol), ustar(:ncol), gravit, karman, kbfs(:ncol))
+
+ end subroutine compute_kinematic_fluxes_and_obklen_run
+
+ ! Set total surface stresses for input
+ ! 1) into the HB PBL scheme, and
+ ! 2) surface zonal/meridional momentum flux diagnostic output (all schemes)
+ !
+ ! NOTE: Temporarily, TMS and Beljaars are "hard-coupled" into this subroutine because
+ ! the current focus is CAM4 and TMS/Beljaars drag have not been CCPPized.
+ ! In the future, after TMS/Beljaars is implemented, this subroutine should only initialize
+ ! surface stresses from the coupler, then TMS and Beljaars can work on adding the respective
+ ! surface stresses to the tautotx/tautoty used by the PBL scheme.
+!> \section arg_table_vertical_diffusion_set_total_surface_stress_run Argument Table
+!! \htmlinclude vertical_diffusion_set_total_surface_stress_run.html
+ subroutine vertical_diffusion_set_total_surface_stress_run( &
+ ncol, &
+ wsx_from_coupler, wsy_from_coupler, &
+ tautmsx, tautmsy, &
+ taubljx, taubljy, &
+ tautotx, tautoty, &
+ errmsg, errflg)
+
+ ! Input arguments
+ integer, intent(in) :: ncol
+ real(kind_phys), intent(in) :: wsx_from_coupler(:) ! Surface eastward wind stress from coupler [Pa]
+ real(kind_phys), intent(in) :: wsy_from_coupler(:) ! Surface northward wind stress from coupler [Pa]
+ real(kind_phys), intent(in) :: tautmsx(:) ! Eastward turbulent mountain surface stress [Pa]
+ real(kind_phys), intent(in) :: tautmsy(:) ! Northward turbulent mountain surface stress [Pa]
+ real(kind_phys), intent(in) :: taubljx(:) ! Eastward Beljaars surface stress [Pa]
+ real(kind_phys), intent(in) :: taubljy(:) ! Northward Beljaars surface stress [Pa]
+
+ ! Output arguments
+ real(kind_phys), intent(out) :: tautotx(:) ! Eastward total stress at surface for boundary layer scheme [Pa]
+ real(kind_phys), intent(out) :: tautoty(:) ! Northward total stress at surface for boundary layer scheme [Pa]
+ character(len=512), intent(out) :: errmsg
+ integer, intent(out) :: errflg
+
+ errmsg = ''
+ errflg = 0
+
+ ! Initialize total surface stresses from coupler
+ ! These are used for HB diffusion scheme and later PBL diagnostics but
+ ! NOT for the vertical diffusion solver, which uses surface stresses from the coupler only,
+ ! or just zero (in the case of CLUBB)
+ tautotx(:ncol) = wsx_from_coupler(:ncol)
+ tautoty(:ncol) = wsy_from_coupler(:ncol)
+
+ ! Add turbulent mountain stress to total surface stress
+ tautotx(:ncol) = tautotx(:ncol) + tautmsx(:ncol)
+ tautoty(:ncol) = tautoty(:ncol) + tautmsy(:ncol)
+
+ ! Add Beljaars integrated drag to total surface stress
+ tautotx(:ncol) = tautotx(:ncol) + taubljx(:ncol)
+ tautoty(:ncol) = tautoty(:ncol) + taubljy(:ncol)
+
+ end subroutine vertical_diffusion_set_total_surface_stress_run
+
+end module vertical_diffusion_interstitials
diff --git a/schemes/vertical_diffusion/vertical_diffusion_interstitials.meta b/schemes/vertical_diffusion/vertical_diffusion_interstitials.meta
new file mode 100644
index 00000000..84d0392b
--- /dev/null
+++ b/schemes/vertical_diffusion/vertical_diffusion_interstitials.meta
@@ -0,0 +1,294 @@
+[ccpp-table-properties]
+ name = vertical_diffusion_prepare_inputs
+ type = scheme
+
+[ccpp-arg-table]
+ name = vertical_diffusion_prepare_inputs_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pverp ]
+ standard_name = vertical_interface_dimension
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pint ]
+ standard_name = air_pressure_at_interface
+ units = Pa
+ dimensions = (horizontal_loop_extent, vertical_interface_dimension)
+ type = real | kind = kind_phys
+ intent = in
+[ t ]
+ standard_name = air_temperature
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ exner ]
+ standard_name = reciprocal_of_dimensionless_exner_function_wrt_surface_air_pressure
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ p ]
+ standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
+ units = none
+ dimensions = ()
+ type = coords1d
+ intent = out
+[ th ]
+ standard_name = potential_temperature_wrt_surface_pressure
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ dimensions = ()
+ type = character | kind = len=512
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ dimensions = ()
+ type = integer
+ intent = out
+
+[ccpp-arg-table]
+ name = vertical_diffusion_prepare_inputs_timestep_final
+ type = scheme
+[ p ]
+ standard_name = vertical_moist_pressure_coordinates_for_vertical_diffusion
+ units = none
+ dimensions = ()
+ type = coords1d
+ intent = inout
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ dimensions = ()
+ type = character | kind = len=512
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ dimensions = ()
+ type = integer
+ intent = out
+
+[ccpp-table-properties]
+ name = compute_kinematic_fluxes_and_obklen
+ type = scheme
+
+[ccpp-arg-table]
+ name = compute_kinematic_fluxes_and_obklen_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pver ]
+ standard_name = vertical_layer_dimension
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ pcnst ]
+ standard_name = number_of_ccpp_constituents
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ const_props ]
+ standard_name = ccpp_constituent_properties
+ units = none
+ type = ccpp_constituent_prop_ptr_t
+ dimensions = (number_of_ccpp_constituents)
+ intent = in
+[ zvir ]
+ standard_name = ratio_of_water_vapor_to_dry_air_gas_constants_minus_one
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ cpair ]
+ standard_name = specific_heat_of_dry_air_at_constant_pressure
+ units = J kg-1 K-1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ gravit ]
+ standard_name = standard_gravitational_acceleration
+ units = m s-2
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ karman ]
+ standard_name = von_karman_constant
+ units = 1
+ type = real | kind = kind_phys
+ dimensions = ()
+ intent = in
+[ shf_from_coupler ]
+ standard_name = surface_upward_sensible_heat_flux_from_coupler
+ units = W m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ cflx_from_coupler ]
+ standard_name = surface_upward_ccpp_constituent_fluxes_from_coupler
+ units = kg m-2 s-1
+ dimensions = (horizontal_loop_extent, number_of_ccpp_constituents)
+ type = real | kind = kind_phys
+ intent = in
+[ q_wv ]
+ standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water
+ units = kg kg-1
+ advected = True
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ th ]
+ standard_name = potential_temperature_wrt_surface_pressure
+ units = K
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent, vertical_layer_dimension)
+ intent = in
+[ rrho ]
+ standard_name = reciprocal_of_dry_air_density_of_bottom_layer
+ units = m3 kg-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ ustar ]
+ standard_name = surface_friction_velocity
+ units = m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = in
+[ khfs ]
+ standard_name = kinematic_sensible_heat_flux_at_surface
+ units = K m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ kqfs ]
+ standard_name = kinematic_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_flux_at_surface
+ units = kg kg-1 m s-1
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ kbfs ]
+ standard_name = kinematic_buoyancy_flux_at_surface
+ # m s-2 m s-1
+ units = m2 s-3
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ obklen ]
+ standard_name = obukhov_length
+ units = m
+ type = real | kind = kind_phys
+ dimensions = (horizontal_loop_extent)
+ intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ type = character | kind = len=512
+ dimensions = ()
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ type = integer
+ dimensions = ()
+ intent = out
+
+
+[ccpp-table-properties]
+ name = vertical_diffusion_set_total_surface_stress
+ type = scheme
+
+[ccpp-arg-table]
+ name = vertical_diffusion_set_total_surface_stress_run
+ type = scheme
+[ ncol ]
+ standard_name = horizontal_loop_extent
+ units = count
+ dimensions = ()
+ type = integer
+ intent = in
+[ wsx_from_coupler ]
+ standard_name = surface_eastward_wind_stress_from_coupler
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ wsy_from_coupler ]
+ standard_name = surface_northward_wind_stress_from_coupler
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ tautmsx ]
+ standard_name = eastward_turbulent_mountain_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ tautmsy ]
+ standard_name = northward_turbulent_mountain_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ taubljx ]
+ standard_name = eastward_beljaars_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ taubljy ]
+ standard_name = northward_beljaars_surface_stress_tbd
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = in
+[ tautotx ]
+ standard_name = eastward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = out
+[ tautoty ]
+ standard_name = northward_total_stress_at_surface_including_turbulent_orographic_form_drag_stress
+ units = N m-2
+ dimensions = (horizontal_loop_extent)
+ type = real | kind = kind_phys
+ intent = out
+[ errmsg ]
+ standard_name = ccpp_error_message
+ units = none
+ dimensions = ()
+ type = character | kind = len=512
+ intent = out
+[ errflg ]
+ standard_name = ccpp_error_code
+ units = 1
+ dimensions = ()
+ type = integer
+ intent = out
diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml
index 0acd9cb8..c5e08e2d 100644
--- a/suites/suite_cam4.xml
+++ b/suites/suite_cam4.xml
@@ -296,18 +296,34 @@
hb_diff_set_vertical_diffusion_top
-
- tms_beljaars_zero_stub
- hb_diff_set_total_surface_stress
+
+ tms_beljaars_zero_stub
-
+
+ vertical_diffusion_prepare_inputs
+
+
hb_diff_prepare_vertical_diffusion_inputs
+
+
+ vertical_diffusion_not_use_rairv
+ vertical_diffusion_set_temperature_at_toa_default
+ vertical_diffusion_interpolate_to_interfaces
+
+
+ vertical_diffusion_set_total_surface_stress
+
holtslag_boville_diff
-
+
hb_pbl_independent_coefficients
+ compute_kinematic_fluxes_and_obklen
+
+
hb_pbl_dependent_coefficients
hb_diff_exchange_coefficients
@@ -317,17 +333,11 @@
holtslag_boville_diff_diagnostics
-
-
- vertical_diffusion_not_use_rairv
- vertical_diffusion_set_temperature_at_toa_default
- vertical_diffusion_interpolate_to_interfaces
-
-
+
implicit_surface_stress_add_drag_coefficient
-
+
vertical_diffusion_wind_damping_rate
diff --git a/suites/suite_cam5.xml b/suites/suite_cam5.xml
new file mode 100644
index 00000000..7025f2d4
--- /dev/null
+++ b/suites/suite_cam5.xml
@@ -0,0 +1,308 @@
+
+
+
+
+
+
+ to_be_ccppized_temporary
+ prescribe_radiative_gas_concentrations
+
+
+ zm_conv_options
+
+
+ check_energy_gmean
+
+ check_energy_gmean_diagnostics
+
+
+ check_energy_zero_fluxes
+ check_energy_fix
+ apply_heating_rate
+ geopotential_temp
+
+
+ check_energy_scaling
+ check_energy_chng
+
+
+ dadadj
+ apply_constituent_tendencies
+ apply_heating_rate
+ qneg
+ geopotential_temp
+
+
+ check_energy_zero_fluxes
+ zm_convr
+ zm_convr_tendency_diagnostics
+ apply_heating_rate
+ apply_constituent_tendencies
+ qneg
+ geopotential_temp
+ cloud_fraction_fice
+ set_deep_conv_fluxes_to_general
+ zm_conv_evap
+ set_general_conv_fluxes_to_deep
+ zm_evap_tendency_diagnostics
+ apply_heating_rate
+ apply_constituent_tendencies
+ qneg
+ geopotential_temp
+ cloud_fraction_fice
+ zm_conv_momtran
+ zm_momtran_tendency_diagnostics
+ apply_heating_rate
+ apply_tendency_of_eastward_wind
+ apply_tendency_of_northward_wind
+ geopotential_temp
+ zm_conv_convtran
+ zm_tendency_diagnostics
+ apply_constituent_tendencies
+ qneg
+ geopotential_temp
+ zm_diagnostics
+
+
+ check_energy_scaling
+ check_energy_chng
+
+
+
+
+ sima_state_diagnostics
+
+
+ rrtmgp_pre
+ rrtmgp_cloud_optics_setup
+ tropopause_find
+ rrtmgp_variables
+ rrtmgp_inputs
+ rrtmgp_sw_cloud_optics
+ rrtmgp_sw_mcica_subcol_gen
+ rrtmgp_cloud_diagnostics
+
+
+ rrtmgp_constituents
+ rrtmgp_sw_gas_optics_pre
+ rrtmgp_sw_gas_optics
+ solar_irradiance_data
+ rrtmgp_sw_solar_var
+ rrtmgp_sw_aerosols
+ rrtmgp_sw_rte
+ rrtmgp_sw_calculate_fluxes
+ rrtmgp_sw_calculate_heating_rate
+ rrtmgp_sw_diagnostics
+ rrtmgp_subcycle
+
+ rrtmgp_lw_cloud_optics
+ rrtmgp_lw_mcica_subcol_gen
+
+
+ rrtmgp_constituents
+ rrtmgp_lw_gas_optics_pre
+ rrtmgp_lw_gas_optics
+ rrtmgp_lw_aerosols
+ rrtmgp_lw_rte
+ rrtmgp_lw_calculate_fluxes
+ rrtmgp_lw_calculate_heating_rate
+ rrtmgp_lw_diagnostics
+ rrtmgp_subcycle
+
+
+ rrtmgp_inputs_setup
+ rrtmgp_sw_solar_var_setup
+ rrtmgp_dry_static_energy_tendency
+ calculate_net_heating
+ rrtmgp_post
+ rrtmgp_diagnostics
+
+ apply_heating_rate
+ geopotential_temp
+
+
+
+
+
+ tropopause_find
+ tropopause_diagnostics
+
+
+
+ calc_dry_air_ideal_gas_density
+ set_surface_coupling_vars
+
+
+
+
+
+
+
+
+
+ vertical_diffusion_options
+
+
+ zero_upper_boundary_condition
+
+
+ hb_diff_set_vertical_diffusion_top
+
+
+ beljaars_zero_stub
+
+
+ vertical_diffusion_prepare_inputs
+
+
+ hb_diff_prepare_vertical_diffusion_inputs
+
+
+
+ vertical_diffusion_not_use_rairv
+ vertical_diffusion_set_temperature_at_toa_default
+ vertical_diffusion_interpolate_to_interfaces
+
+
+ vertical_diffusion_set_total_surface_stress
+
+
+ bretherton_park_diff
+ bretherton_park_diff_diagnostics
+ compute_kinematic_fluxes_and_obklen
+ eddy_diffusivity_adjustment_above_pbl
+
+
+ vertical_diffusion_sponge_layer
+
+
+
+
+ implicit_surface_stress_add_drag_coefficient
+ turbulent_mountain_stress_add_drag_coefficient
+
+
+ vertical_diffusion_wind_damping_rate
+
+
+
+
+ vertical_diffusion_diffuse_horizontal_momentum
+
+
+ vertical_diffusion_set_dry_static_energy_at_toa_zero
+
+
+ vertical_diffusion_diffuse_dry_static_energy
+
+
+ vertical_diffusion_diffuse_tracers
+
+
+ dropmixnuc_apply_surface_fluxes
+
+
+ vertical_diffusion_tendencies
+
+
+ vertical_diffusion_tendencies_diagnostics
+
+
+ apply_tendency_of_northward_wind
+ apply_tendency_of_eastward_wind
+ apply_constituent_tendencies
+ apply_heating_rate
+ qneg
+ geopotential_temp
+ update_dry_static_energy
+
+
+
+
+ gravity_wave_drag_common
+
+
+ check_energy_zero_fluxes
+ gravity_wave_drag_prepare_profiles
+
+
+ gravity_wave_drag_top_taper
+
+
+ gravity_wave_drag_orographic
+
+
+ convert_dry_constituent_tendencies_to_dry_air_basis
+
+
+ gravity_wave_drag_common_diagnostics
+
+
+ apply_tendency_of_eastward_wind
+ apply_tendency_of_northward_wind
+ apply_constituent_tendencies
+ apply_heating_rate
+ qneg
+ geopotential_temp
+ update_dry_static_energy
+
+
+ check_energy_scaling
+ check_energy_chng
+
+
+
+
+ check_energy_save_teout
+
+
+
+
+
+
+
+ check_energy_scaling
+ dycore_energy_consistency_adjust
+ apply_tendency_of_air_temperature
+
+
+ sima_tend_diagnostics
+
+
+
+
diff --git a/test/test_schemes/initialize_constituents.F90 b/test/test_schemes/initialize_constituents.F90
index 2dd847b8..bb70d9e5 100644
--- a/test/test_schemes/initialize_constituents.F90
+++ b/test/test_schemes/initialize_constituents.F90
@@ -29,6 +29,8 @@ subroutine initialize_constituents_register(constituents, errmsg, errcode)
integer :: known_const_index
integer :: found_const_count
logical :: known_constituent
+ real(kind_phys) :: qmin_value
+ character(len=256) :: cnst_stdname
character(len=256) :: variable_name
character(len=512) :: alloc_err_msg
character(len=256), allocatable :: constituent_names(:)
@@ -138,12 +140,37 @@ subroutine initialize_constituents_register(constituents, errmsg, errcode)
errcode = errcode, &
errmsg = errmsg)
else
+ ! For chemistry species some special handling is necessary for qmin_value;
+ ! this logic is replicated from chem_register in src/chemistry/mozart in CAM.
+ qmin_value = 0.0_kind_phys
+ cnst_stdname = trim(constituent_names(var_index))
+ ! Special handling for specific chemical species
+ ! Aerosol number density species
+ if (index(cnst_stdname, 'num_a') > 0) then
+ qmin_value = 1.e-5_kind_phys
+ else if (index(cnst_stdname, 'O3') > 0) then
+ qmin_value = 1.e-12_kind_phys
+ else if (index(cnst_stdname, 'CH4') > 0) then
+ qmin_value = 1.e-12_kind_phys
+ else if (index(cnst_stdname, 'N2O') > 0) then
+ qmin_value = 1.e-15_kind_phys
+ ! CFCs
+ else if (index(cnst_stdname, 'CFC11') > 0 .or. &
+ index(cnst_stdname, 'CFC12') > 0 .or. &
+ index(cnst_stdname, 'cfc11') > 0 .or. &
+ index(cnst_stdname, 'cfc12') > 0) then
+ qmin_value = 1.e-20_kind_phys
+ end if
+ ! Note: other chemistry species should be 1e-36 but we have no way
+ ! of currently distinguishing between these and other non-chem
+ ! constituents, so leaving as 0.0_kind_phys for now. (hplin, 11/20/25)
+
call constituents(var_index)%instantiate( &
std_name = constituent_names(var_index), &
long_name = constituent_names(var_index), &
units = 'kg kg-1', &
vertical_dim = 'vertical_layer_dimension', &
- min_value = 0.0_kind_phys, &
+ min_value = qmin_value, &
advected = .true., &
diag_name = const_diag_names(var_index), &
errcode = errcode, &
diff --git a/test/test_suites/suite_vdiff_bretherton_park.xml b/test/test_suites/suite_vdiff_bretherton_park.xml
new file mode 100644
index 00000000..157dcedd
--- /dev/null
+++ b/test/test_suites/suite_vdiff_bretherton_park.xml
@@ -0,0 +1,98 @@
+
+
+
+
+ initialize_constituents
+ to_be_ccppized_temporary
+
+
+ vertical_diffusion_options
+
+
+ zero_upper_boundary_condition
+
+
+ hb_diff_set_vertical_diffusion_top
+
+
+ beljaars_zero_stub
+
+
+ vertical_diffusion_prepare_inputs
+
+
+ hb_diff_prepare_vertical_diffusion_inputs
+
+
+
+ vertical_diffusion_not_use_rairv
+ vertical_diffusion_set_temperature_at_toa_default
+ vertical_diffusion_interpolate_to_interfaces
+
+
+ vertical_diffusion_set_total_surface_stress
+
+
+ bretherton_park_diff
+ bretherton_park_diff_diagnostics
+ compute_kinematic_fluxes_and_obklen
+ eddy_diffusivity_adjustment_above_pbl
+
+
+ vertical_diffusion_sponge_layer
+
+
+
+
+ implicit_surface_stress_add_drag_coefficient
+ turbulent_mountain_stress_add_drag_coefficient
+
+
+ vertical_diffusion_wind_damping_rate
+
+
+
+ vertical_diffusion_diffuse_horizontal_momentum
+
+
+ vertical_diffusion_set_dry_static_energy_at_toa_zero
+
+
+ vertical_diffusion_diffuse_dry_static_energy
+
+
+ vertical_diffusion_diffuse_tracers
+
+
+ dropmixnuc_apply_surface_fluxes
+
+
+ vertical_diffusion_tendencies
+
+
+ vertical_diffusion_tendencies_diagnostics
+
+
+ apply_tendency_of_northward_wind
+ apply_tendency_of_eastward_wind
+ apply_constituent_tendencies
+ apply_heating_rate
+ qneg
+ geopotential_temp
+ update_dry_static_energy
+
+
diff --git a/test/test_suites/suite_vdiff_holtslag_boville.xml b/test/test_suites/suite_vdiff_holtslag_boville.xml
index 31b581c6..7692bd9e 100644
--- a/test/test_suites/suite_vdiff_holtslag_boville.xml
+++ b/test/test_suites/suite_vdiff_holtslag_boville.xml
@@ -21,18 +21,34 @@
hb_diff_set_vertical_diffusion_top
-
- tms_beljaars_zero_stub
- hb_diff_set_total_surface_stress
+
+ tms_beljaars_zero_stub
-
+
+ vertical_diffusion_prepare_inputs
+
+
hb_diff_prepare_vertical_diffusion_inputs
+
+
+ vertical_diffusion_not_use_rairv
+ vertical_diffusion_set_temperature_at_toa_default
+ vertical_diffusion_interpolate_to_interfaces
+
+
+ vertical_diffusion_set_total_surface_stress
+
holtslag_boville_diff
-
+
hb_pbl_independent_coefficients
+ compute_kinematic_fluxes_and_obklen
+
+
hb_pbl_dependent_coefficients
hb_diff_exchange_coefficients
@@ -42,17 +58,11 @@
holtslag_boville_diff_diagnostics
-
-
- vertical_diffusion_not_use_rairv
- vertical_diffusion_set_temperature_at_toa_default
- vertical_diffusion_interpolate_to_interfaces
-
-
+
implicit_surface_stress_add_drag_coefficient
-
+
vertical_diffusion_wind_damping_rate