From 9c41040035d710dec5eaeacd29135a83832c55da Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 3 Oct 2025 08:45:12 -0700 Subject: [PATCH 01/31] major ZM cleanup --- .../eam/src/physics/cam/convect_shallow.F90 | 2 +- .../eam/src/physics/cam/macrop_driver.F90 | 14 +- components/eam/src/physics/cam/zm_conv.F90 | 1223 +++++++---------- .../eam/src/physics/cam/zm_conv_intr.F90 | 37 +- .../physics/cam/zm_microphysics_history.F90 | 27 +- .../src/physics/cam/zm_microphysics_state.F90 | 734 +++++----- 6 files changed, 944 insertions(+), 1093 deletions(-) diff --git a/components/eam/src/physics/cam/convect_shallow.F90 b/components/eam/src/physics/cam/convect_shallow.F90 index 578dbd8668fd..fa4ba0f4fc47 100644 --- a/components/eam/src/physics/cam/convect_shallow.F90 +++ b/components/eam/src/physics/cam/convect_shallow.F90 @@ -911,7 +911,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , & sh_cldliq(:ncol,:) = 0._r8 sh_cldice(:ncol,:) = 0._r8 - call zm_conv_evap( state1%ncol, state1%lchnk, & + call zm_conv_evap( pcols, state1%ncol, pver, pverp, & state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & ptend_loc%q(:pcols,:pver,1), & diff --git a/components/eam/src/physics/cam/macrop_driver.F90 b/components/eam/src/physics/cam/macrop_driver.F90 index 2c675f5fe9ed..eac1049ad7ed 100644 --- a/components/eam/src/physics/cam/macrop_driver.F90 +++ b/components/eam/src/physics/cam/macrop_driver.F90 @@ -329,12 +329,14 @@ subroutine macrop_driver_init(pbuf2d) CC_ni_idx = pbuf_get_index('CC_ni') CC_qlst_idx = pbuf_get_index('CC_qlst') - dlfzm_idx = pbuf_get_index('DLFZM') - difzm_idx = pbuf_get_index('DIFZM') - dsfzm_idx = pbuf_get_index('DSFZM', err) - dnlfzm_idx = pbuf_get_index('DNLFZM', err) - dnifzm_idx = pbuf_get_index('DNIFZM', err) - dnsfzm_idx = pbuf_get_index('DNSFZM', err) + if (zm_param%zm_microp) then + dlfzm_idx = pbuf_get_index('DLFZM') + difzm_idx = pbuf_get_index('DIFZM') + dsfzm_idx = pbuf_get_index('DSFZM', err) + dnlfzm_idx = pbuf_get_index('DNLFZM', err) + dnifzm_idx = pbuf_get_index('DNIFZM', err) + dnsfzm_idx = pbuf_get_index('DNSFZM', err) + end if if (micro_do_icesupersat) then naai_idx = pbuf_get_index('NAAI') diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 6a1e1c5e5fcb..5eabe97eae77 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -2,14 +2,14 @@ module zm_conv !---------------------------------------------------------------------------- ! Purpose: primary methods for the Zhang-McFarlane convection scheme !---------------------------------------------------------------------------- - ! Contributors: Rich Neale, Byron Boville, Xiaoliang song + ! Contributors: Guang Zhang, Norman McFarlane, Michael Lazare, Phil Rasch, + ! Rich Neale, Byron Boville, Xiaoliang Song, Walter Hannah !---------------------------------------------------------------------------- #ifdef SCREAM_CONFIG_IS_CMAKE - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp + use zm_eamxx_bridge_params, only: r8 use zm_eamxx_bridge_methods,only: cldfrc_fice #else use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver, pverp use cloud_fraction, only: cldfrc_fice use zm_microphysics, only: zm_mphy #endif @@ -17,15 +17,16 @@ module zm_conv use zm_conv_types, only: zm_const_t, zm_param_t use zm_conv_util, only: qsat_hpa ! remove after moving cldprp to new module use zm_aero_type, only: zm_aero_t - use zm_microphysics_state, only: zm_microp_st, zm_microp_st_alloc, zm_microp_st_dealloc, zm_microp_st_ini, zm_microp_st_gb + use zm_microphysics_state, only: zm_microp_st, zm_microp_st_alloc, zm_microp_st_dealloc + use zm_microphysics_state, only: zm_microp_st_ini, zm_microp_st_zero, zm_microp_st_scatter !---------------------------------------------------------------------------- implicit none save private ! Make default type private !---------------------------------------------------------------------------- ! public methods - public zm_convi ! ZM schemea - public zm_convr ! ZM schemea + public zm_convi ! ZM scheme initialization + public zm_convr ! ZM scheme calculations public zm_conv_evap ! evaporation of precip from ZM schemea !---------------------------------------------------------------------------- ! public variables @@ -70,335 +71,184 @@ end subroutine zm_convi !=================================================================================================== -subroutine zm_convr(lchnk ,ncol ,is_first_step, & - t ,qh ,prec ,jctop ,jcbot , & - pblh ,zm ,geos ,zi ,qtnd , & - heat ,pap ,paph ,dpp ,omega , & - delt ,mcon ,cme ,cape , & - tpert ,dlf ,pflx ,zdu ,rprd , & - mu ,md ,du ,eu ,ed , & - dp ,dsubcld ,jt ,maxg ,ideep , & - lengath ,ql ,rliq ,landfrac, & - t_star ,q_star, dcape, & - aero ,qi ,dif ,dnlf ,dnif , & - dsf ,dnsf ,sprd ,rice ,frz , & - mudpcu ,lambdadpcu, microp_st, wuc) -!----------------------------------------------------------------------- -! -! Purpose: -! Main driver for zhang-mcfarlane convection scheme -! -! Method: -! performs deep convective adjustment based on mass-flux closure -! algorithm. -! -! Author:guang jun zhang, m.lazare, n.mcfarlane. CAM Contact: P. Rasch -! -! This is contributed code not fully standardized by the CAM core group. -! All variables have been typed, where most are identified in comments -! The current procedure will be reimplemented in a subsequent version -! of the CAM where it will include a more straightforward formulation -! and will make use of the standard CAM nomenclature -! -!----------------------------------------------------------------------- -! -! ************************ index of variables ********************** -! -! wg * alpha array of vertical differencing used (=1. for upstream). -! w * cape convective available potential energy. -! wg * capeg gathered convective available potential energy. -! c * capelmt threshold value for cape for deep convection. -! ic * cpres specific heat at constant pressure in j/kg-degk. -! i * dpp -! ic * delt length of model time-step in seconds. -! wg * dp layer thickness in mbs (between upper/lower interface). -! wg * dqdt mixing ratio tendency at gathered points. -! wg * dsdt dry static energy ("temp") tendency at gathered points. -! wg * dudt u-wind tendency at gathered points. -! wg * dvdt v-wind tendency at gathered points. -! wg * dsubcld layer thickness in mbs between lcl and maxi. -! ic * grav acceleration due to gravity in m/sec2. -! wg * du detrainment in updraft. specified in mid-layer -! wg * ed entrainment in downdraft. -! wg * eu entrainment in updraft. -! wg * hmn moist static energy. -! wg * hsat saturated moist static energy. -! w * ideep holds position of gathered points vs longitude index. -! ic * pver number of model levels. -! wg * j0 detrainment initiation level index. -! wg * jd downdraft initiation level index. -! ic * jlatpr gaussian latitude index for printing grids (if needed). -! wg * jt top level index of deep cumulus convection. -! w * lcl base level index of deep cumulus convection. -! wg * lclg gathered values of lcl. -! w * lel index of highest theoretical convective plume. -! wg * lelg gathered values of lel. -! w * lon index of onset level for deep convection. -! w * maxi index of level with largest moist static energy. -! wg * maxg gathered values of maxi. -! wg * mb cloud base mass flux. -! wg * mc net upward (scaled by mb) cloud mass flux. -! wg * md downward cloud mass flux (positive up). -! wg * mu upward cloud mass flux (positive up). specified -! at interface -! ic * msg number of missing moisture levels at the top of model. -! w * p grid slice of ambient mid-layer pressure in mbs. -! i * pblt row of pbl top indices. -! w * pcpdh scaled surface pressure. -! w * pf grid slice of ambient interface pressure in mbs. -! wg * pg grid slice of gathered values of p. -! w * q grid slice of mixing ratio. -! wg * qd grid slice of mixing ratio in downdraft. -! wg * qg grid slice of gathered values of q. -! i/o * qh grid slice of specific humidity. -! w * qh0 grid slice of initial specific humidity. -! wg * qhat grid slice of upper interface mixing ratio. -! wg * ql grid slice of cloud liquid water. -! wg * qs grid slice of saturation mixing ratio. -! w * qstp grid slice of parcel temp. saturation mixing ratio. -! wg * qstpg grid slice of gathered values of qstp. -! wg * qu grid slice of mixing ratio in updraft. -! ic * rgas dry air gas constant. -! wg * rl latent heat of vaporization. -! w * s grid slice of scaled dry static energy (t+gz/cp). -! wg * sd grid slice of dry static energy in downdraft. -! wg * sg grid slice of gathered values of s. -! wg * shat grid slice of upper interface dry static energy. -! wg * su grid slice of dry static energy in updraft. -! i/o * t -! o * jctop row of top-of-deep-convection indices passed out. -! O * jcbot row of base of cloud indices passed out. -! wg * tg grid slice of gathered values of t. -! w * tl row of parcel temperature at lcl. -! wg * tlg grid slice of gathered values of tl. -! w * tp grid slice of parcel temperatures. -! wg * tpg grid slice of gathered values of tp. -! i/o * u grid slice of u-wind (real). -! wg * ug grid slice of gathered values of u. -! i/o * utg grid slice of u-wind tendency (real). -! i/o * v grid slice of v-wind (real). -! w * va work array re-used by called subroutines. -! wg * vg grid slice of gathered values of v. -! i/o * vtg grid slice of v-wind tendency (real). -! i * w grid slice of diagnosed large-scale vertical velocity. -! w * z grid slice of ambient mid-layer height in metres. -! w * zf grid slice of ambient interface height in metres. -! wg * zfg grid slice of gathered values of zf. -! wg * zg grid slice of gathered values of z. -! -!----------------------------------------------------------------------- -! -! multi-level i/o fields: -! i => input arrays. -! i/o => input/output arrays. -! w => work arrays. -! wg => work arrays operating only on gathered points. -! ic => input data constants. -! c => data constants pertaining to subroutine itself. -! -! input arguments -! - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncol ! number of atmospheric columns - logical, intent(in) :: is_first_step ! flag to control DCAPE calculations - - real(r8), intent(in) :: t(pcols,pver) ! grid slice of temperature at mid-layer. - real(r8), intent(in) :: qh(pcols,pver) ! grid slice of specific humidity. - real(r8), intent(in) :: pap(pcols,pver) - real(r8), intent(in) :: paph(pcols,pver+1) - real(r8), intent(in) :: dpp(pcols,pver) ! local sigma half-level thickness (i.e. dshj). - real(r8), intent(in) :: omega(pcols,pver) ! Vertical velocity Pa/s - real(r8), intent(in) :: zm(pcols,pver) - real(r8), intent(in) :: geos(pcols) - real(r8), intent(in) :: zi(pcols,pver+1) - real(r8), intent(in) :: pblh(pcols) - real(r8), intent(in) :: tpert(pcols) - real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac - type(zm_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the - ! gathered arrays are set here - ! before passing object - ! to microphysics - type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics - -!DCAPE-ULL - real(r8), intent(in), pointer, dimension(:,:) :: t_star ! intermediate T between n and n-1 time step - real(r8), intent(in), pointer, dimension(:,:) :: q_star ! intermediate q between n and n-1 time step - - -! -! output arguments -! - real(r8), intent(out) :: qtnd(pcols,pver) ! specific humidity tendency (kg/kg/s) - real(r8), intent(out) :: heat(pcols,pver) ! heating rate (dry static energy tendency, W/kg) - real(r8), intent(out) :: mcon(pcols,pverp) - real(r8), intent(out) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend - real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level - real(r8), intent(out) :: cme(pcols,pver) - real(r8), intent(out) :: cape(pcols) ! w convective available potential energy. - real(r8), intent(out) :: zdu(pcols,pver) - real(r8), intent(out) :: rprd(pcols,pver) ! rain production rate - real(r8), intent(out) :: sprd(pcols,pver) ! snow production rate - real(r8), intent(out) :: dif(pcols,pver) ! detrained convective cloud ice mixing ratio. - real(r8), intent(out) :: dnlf(pcols,pver) ! detrained convective cloud water num concen. - real(r8), intent(out) :: dnif(pcols,pver) ! detrained convective cloud ice num concen. - real(r8), intent(out) :: dsf(pcols,pver) ! detrained convective snow mixing ratio. - real(r8), intent(out) :: dnsf(pcols,pver) ! detrained convective snow num concen. - real(r8), intent(out) :: lambdadpcu(pcols,pver) ! slope of cloud liquid size distr - real(r8), intent(out) :: mudpcu(pcols,pver) ! width parameter of droplet size distr - real(r8), intent(out) :: frz(pcols,pver) ! freezing heating - real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals - real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio. - real(r8), intent(inout),optional :: wuc(pcols,pver) ! vertical velocity from ZMmp -! move these vars from local storage to output so that convective -! transports can be done in outside of conv_cam. - real(r8), intent(out) :: mu(pcols,pver) - real(r8), intent(out) :: eu(pcols,pver) - real(r8), intent(out) :: du(pcols,pver) - real(r8), intent(out) :: md(pcols,pver) - real(r8), intent(out) :: ed(pcols,pver) - real(r8), intent(out) :: dp(pcols,pver) ! wg layer thickness in mbs (between upper/lower interface). - real(r8), intent(out) :: dsubcld(pcols) ! wg layer thickness in mbs between lcl and maxi. - integer, intent(out) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out. - integer, intent(out) :: jcbot(pcols) ! o row of base of cloud indices passed out. - real(r8), intent(out) :: prec(pcols) - real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals - real(r8), intent(out) :: dcape(pcols) ! output dynamical CAPE - - - real(r8) zs(pcols) - real(r8) dlg(pcols,pver) ! gathrd version of the detraining cld h2o tend - real(r8) pflxg(pcols,pverp) ! gather precip flux at each level - real(r8) cug(pcols,pver) ! gathered condensation rate - real(r8) evpg(pcols,pver) ! gathered evap rate of rain in downdraft - real(r8) mumax(pcols) - integer jt(pcols) ! wg top level index of deep cumulus convection. - integer maxg(pcols) ! wg gathered values of maxi. - integer ideep(pcols) ! w holds position of gathered points vs longitude index. - integer lengath -! diagnostic field used by chem/wetdep codes - real(r8) ql(pcols,pver) ! wg grid slice of cloud liquid water. - - integer pblt(pcols) ! i row of pbl top indices. - integer pbltg(pcols) ! i row of pbl top indices. - - - -! -!----------------------------------------------------------------------- -! -! general work fields (local variables): -! - real(r8) q(pcols,pver) ! w grid slice of mixing ratio. - real(r8) p(pcols,pver) ! w grid slice of ambient mid-layer pressure in mbs. - real(r8) z(pcols,pver) ! w grid slice of ambient mid-layer height in metres. - real(r8) s(pcols,pver) ! w grid slice of scaled dry static energy (t+gz/cp). - real(r8) tp(pcols,pver) ! w grid slice of parcel temperatures. - real(r8) zf(pcols,pver+1) ! w grid slice of ambient interface height in metres. - real(r8) pf(pcols,pver+1) ! w grid slice of ambient interface pressure in mbs. - real(r8) qstp(pcols,pver) ! w grid slice of parcel temp. saturation mixing ratio. - - real(r8) tl(pcols) ! w row of parcel temperature at lcl. - real(r8) tpm1(pcols,pver) ! w parcel temperatures at n-1 time step. - real(r8) qstpm1(pcols,pver) ! w parcel temp. saturation mixing ratio at n-1 time step - real(r8) tlm1(pcols) ! w LCL parcel Temperature at n-1 time step - real(r8) capem1(pcols) ! w CAPE at n-1 time step - integer lclm1(pcols) ! w base level index of deep cumulus convection. - integer lelm1(pcols) ! w index of highest theoretical convective plume. - integer lonm1(pcols) ! w index of onset level for deep convection. - integer maxim1(pcols) ! w index of level with largest moist static energy. - - logical iclosure ! switch on sequence of call to buoyan_dilute to derive DCAPE - real(r8) capelmt_wk ! work capelmt to allow diff values passed to closure with trigdcape - - integer lcl(pcols) ! w base level index of deep cumulus convection. - integer lel(pcols) ! w index of highest theoretical convective plume. - - integer lon(pcols) ! w index of onset level for deep convection. - integer maxi(pcols) ! w index of level with largest moist static energy. - integer index(pcols) - real(r8) precip -! -! gathered work fields: -! - real(r8) qg(pcols,pver) ! wg grid slice of gathered values of q. - real(r8) tg(pcols,pver) ! w grid slice of temperature at interface. - real(r8) pg(pcols,pver) ! wg grid slice of gathered values of p. - real(r8) zg(pcols,pver) ! wg grid slice of gathered values of z. - real(r8) sg(pcols,pver) ! wg grid slice of gathered values of s. - real(r8) tpg(pcols,pver) ! wg grid slice of gathered values of tp. - real(r8) zfg(pcols,pver+1) ! wg grid slice of gathered values of zf. - real(r8) qstpg(pcols,pver) ! wg grid slice of gathered values of qstp. - real(r8) ug(pcols,pver) ! wg grid slice of gathered values of u. - real(r8) vg(pcols,pver) ! wg grid slice of gathered values of v. - real(r8) cmeg(pcols,pver) - real(r8) omegag(pcols,pver) ! wg grid slice of gathered values of omega. +subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & + t, qh, omega, pap, paph, dpp, geos, zm, zi, pblh, & + tpert, landfrac, t_star, q_star, & + aero, microp_st, & + lengath, ideep, maxg, jctop, jcbot, jt, & + prec, heat, qtnd, cape, dcape, & + mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & + ql, rliq, rprd, dlf, & + qi, rice, sprd, dif, & + dsf, dnlf, dnif, dnsf, frz, & + mudpcu, lambdadpcu ) + !---------------------------------------------------------------------------- + ! Purpose: Main driver for Zhang-Mcfarlane convection scheme + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! maximum number of columns + integer, intent(in ) :: ncol ! actual number of columns + integer, intent(in ) :: pver ! number of mid-point levels + integer, intent(in ) :: pverp ! number of interface levels + logical, intent(in ) :: is_first_step ! flag for first step of run + real(r8), intent(in ) :: delt ! model time-step [s] + real(r8), dimension(pcols,pver), intent(in ) :: t ! temperature [K] + real(r8), dimension(pcols,pver), intent(in ) :: qh ! specific humidity [kg/kg] + real(r8), dimension(pcols,pver), intent(in ) :: omega ! vertical pressure velocity [Pa/s] + real(r8), dimension(pcols,pver), intent(in ) :: pap ! mid-point pressure [Pa] + real(r8), dimension(pcols,pverp),intent(in ) :: paph ! interface pressure [Pa] + real(r8), dimension(pcols,pver), intent(in ) :: dpp ! pressure thickness [Pa] + real(r8), dimension(pcols), intent(in ) :: geos ! surface geopotential [m2/s2] + real(r8), dimension(pcols,pver), intent(in ) :: zm ! mid-point geopotential [m2/s2] + real(r8), dimension(pcols,pverp),intent(in ) :: zi ! interface geopotential [m2/s2] + real(r8), dimension(pcols), intent(in ) :: pblh ! boundary layer height [m] + real(r8), dimension(pcols), intent(in ) :: tpert ! parcel temperature perturbation [K] + real(r8), dimension(pcols), intent(in ) :: landfrac ! land fraction + real(r8),pointer,dimension(:,:), intent(in ) :: t_star ! for DCAPE - prev temperature [K] + real(r8),pointer,dimension(:,:), intent(in ) :: q_star ! for DCAPE - prev sp. humidity [kg/kg] + type(zm_aero_t), intent(inout) :: aero ! aerosol object + type(zm_microp_st), intent(inout) :: microp_st ! convective microphysics state and tendencies + integer, intent( out) :: lengath ! number of active columns in chunk for gathering + integer, dimension(pcols), intent( out) :: ideep ! flag for active columns + integer, dimension(pcols), intent( out) :: maxg ! gathered level indices of max MSE (maxi) + integer, dimension(pcols), intent( out) :: jctop ! top-of-deep-convection indices + integer, dimension(pcols), intent( out) :: jcbot ! base of cloud indices + integer, dimension(pcols), intent( out) :: jt ! gathered top level index of deep cumulus convection + real(r8), dimension(pcols), intent( out) :: prec ! output precipitation + real(r8), dimension(pcols,pver), intent( out) :: heat ! dry static energy tendency [W/kg] + real(r8), dimension(pcols,pver), intent( out) :: qtnd ! specific humidity tendency [kg/kg/s] + real(r8), dimension(pcols), intent( out) :: cape ! conv. avail. potential energy [J] + real(r8), dimension(pcols), intent( out) :: dcape ! CAPE generated by dycor (dCAPE) [J] + real(r8), dimension(pcols,pverp),intent( out) :: mcon ! convective mass flux [mb/s] + real(r8), dimension(pcols,pverp),intent( out) :: pflx ! precip flux at each level [?] + real(r8), dimension(pcols,pver), intent( out) :: zdu ! detraining mass flux [?] + real(r8), dimension(pcols,pver), intent( out) :: mu ! updraft mass flux [?] + real(r8), dimension(pcols,pver), intent( out) :: eu ! updraft entrainment [?] + real(r8), dimension(pcols,pver), intent( out) :: du ! updraft detrainment [?] + real(r8), dimension(pcols,pver), intent( out) :: md ! downdraft mass flux [?] + real(r8), dimension(pcols,pver), intent( out) :: ed ! downdraft entrainment [?] + real(r8), dimension(pcols,pver), intent( out) :: dp ! layer thickness [mb] + real(r8), dimension(pcols), intent( out) :: dsubcld ! thickness between lcl and maxi [mb] + real(r8), dimension(pcols,pver), intent( out) :: ql ! cloud liquid water for chem/wetdep + real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals + real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate + real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio + real(r8), dimension(pcols,pver), intent( out) :: qi ! ZM microphysics - cloud ice mixing ratio + real(r8), dimension(pcols), intent( out) :: rice ! ZM microphysics - reserved ice (not yet in cldce) for energy integrals + real(r8), dimension(pcols,pver), intent( out) :: sprd ! ZM microphysics - snow production rate + real(r8), dimension(pcols,pver), intent( out) :: dif ! ZM microphysics - detrained cloud ice mixing ratio + real(r8), dimension(pcols,pver), intent( out) :: dsf ! ZM microphysics - detrained snow mixing ratio + real(r8), dimension(pcols,pver), intent( out) :: dnlf ! ZM microphysics - detrained cloud water num concen + real(r8), dimension(pcols,pver), intent( out) :: dnif ! ZM microphysics - detrained cloud ice num concen + real(r8), dimension(pcols,pver), intent( out) :: dnsf ! ZM microphysics - detrained snow num concen + real(r8), dimension(pcols,pver), intent( out) :: frz ! ZM microphysics - heating rate due to freezing + real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr + real(r8), dimension(pcols,pver), intent( out) :: lambdadpcu ! ZM microphysics - slope of cloud liquid size distr + !---------------------------------------------------------------------------- + ! Local variables + real(r8), dimension(pcols,pver) :: q ! local copy of specific humidity [kg/kg] + real(r8), dimension(pcols,pver) :: p ! local copy of mid-point pressure [mb] + real(r8), dimension(pcols,pver) :: z ! local copy of mid-point altitude [m] + real(r8), dimension(pcols,pverp):: zf ! local copy of interface altitude [m] + real(r8), dimension(pcols,pverp):: pf ! local copy of interface pressure [mb] + real(r8), dimension(pcols,pver) :: s ! scaled dry static energy (t+gz/cp) [K] + + real(r8), dimension(pcols) :: zs ! surface altitude [m] + real(r8), dimension(pcols,pver) :: dlg ! gathered detraining cld h2o tend + real(r8), dimension(pcols,pverp):: pflxg ! gathered precip flux at each level + real(r8), dimension(pcols,pver) :: cug ! gathered condensation rate + real(r8), dimension(pcols,pver) :: evpg ! gathered evap rate of rain in downdraft + real(r8), dimension(pcols) :: mumax ! max value of mu/dp + + integer, dimension(pcols) :: pblt ! pbl top indices + integer, dimension(pcols) :: pbltg ! gathered pbl top indices + + real(r8), dimension(pcols,pver) :: tp ! parcel temperature [K] + real(r8), dimension(pcols,pver) :: qstp ! parcel saturation specific humidity [kg/kg] + real(r8), dimension(pcols) :: tl ! parcel temperature at lcl [K] + integer, dimension(pcols) :: lcl ! base level index of deep cumulus convection + integer, dimension(pcols) :: lel ! index of highest theoretical convective plume + integer, dimension(pcols) :: lon ! index of onset level for deep convection + integer, dimension(pcols) :: maxi ! index of level with largest moist static energy + + real(r8), dimension(pcols,pver) :: tpm1 ! time n-1 parcel temperatures + real(r8), dimension(pcols,pver) :: qstpm1 ! time n-1 parcel saturation specific humidity + real(r8), dimension(pcols) :: tlm1 ! time n-1 parcel Temperature at LCL + integer, dimension(pcols) :: lclm1 ! time n-1 base level index of deep cumulus convection + integer, dimension(pcols) :: lelm1 ! time n-1 index of highest theoretical convective plume + integer, dimension(pcols) :: lonm1 ! time n-1 index of onset level for deep convection + integer, dimension(pcols) :: maxim1 ! time n-1 index of level with largest moist static energy + real(r8), dimension(pcols) :: capem1 ! time n-1 CAPE + + logical iclosure ! flag for compute_dilute_cape() + real(r8) capelmt_wk ! local capelmt to allow exceptions when calling closure() with trigdcape - real(r8) rprdg(pcols,pver) ! wg gathered rain production rate - real(r8) capeg(pcols) ! wg gathered convective available potential energy. - real(r8) tlg(pcols) ! wg grid slice of gathered values of tl. - real(r8) landfracg(pcols) ! wg grid slice of landfrac - real(r8) tpertg(pcols) ! wg grid slice of gathered values of tpert (temperature perturbation from PBL) - - integer lclg(pcols) ! wg gathered values of lcl. - integer lelg(pcols) -! -! work fields arising from gathered calculations. -! - real(r8) dqdt(pcols,pver) ! wg mixing ratio tendency at gathered points. - real(r8) dsdt(pcols,pver) ! wg dry static energy ("temp") tendency at gathered points. -! real(r8) alpha(pcols,pver) ! array of vertical differencing used (=1. for upstream). - real(r8) sd(pcols,pver) ! wg grid slice of dry static energy in downdraft. - real(r8) qd(pcols,pver) ! wg grid slice of mixing ratio in downdraft. - real(r8) mc(pcols,pver) ! wg net upward (scaled by mb) cloud mass flux. - real(r8) qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. - real(r8) qu(pcols,pver) ! wg grid slice of mixing ratio in updraft. - real(r8) su(pcols,pver) ! wg grid slice of dry static energy in updraft. - real(r8) qs(pcols,pver) ! wg grid slice of saturation mixing ratio. - real(r8) shat(pcols,pver) ! wg grid slice of upper interface dry static energy. - real(r8) hmn(pcols,pver) ! wg moist static energy. - real(r8) hsat(pcols,pver) ! wg saturated moist static energy. - real(r8) qlg(pcols,pver) - real(r8) dudt(pcols,pver) ! wg u-wind tendency at gathered points. - real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points. -! real(r8) ud(pcols,pver) -! real(r8) vd(pcols,pver) - real(r8) :: lambdadpcug(pcols,pver) ! slope of cloud liquid size distr - real(r8) :: mudpcug(pcols,pver) ! width parameter of droplet size distr - - real(r8) sprdg(pcols,pver) ! wg gathered snow production rate - real(r8) dig(pcols,pver) - real(r8) dsg(pcols,pver) - real(r8) dnlg(pcols,pver) - real(r8) dnig(pcols,pver) - real(r8) dnsg(pcols,pver) - - real(r8) qldeg(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg) - real(r8) qideg(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8) qsdeg(pcols,pver) ! snow mixing ratio for detrainment (kg/kg) - real(r8) ncdeg(pcols,pver) ! cloud water number concentration for detrainment (1/kg) - real(r8) nideg(pcols,pver) ! cloud ice number concentration for detrainment (1/kg) - real(r8) nsdeg(pcols,pver) ! snow concentration for detrainment (1/kg) - - real(r8) dsfmg(pcols,pver) ! mass tendency due to detrainment of snow - real(r8) dsfng(pcols,pver) ! num tendency due to detrainment of snow - real(r8) frzg(pcols,pver) ! gathered heating rate due to freezing - - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - - - real(r8) mb(pcols) ! wg cloud base mass flux. - - integer jlcl(pcols) - integer j0(pcols) ! wg detrainment initiation level index. - integer jd(pcols) ! wg downdraft initiation level index. - - real(r8) delt ! length of model time-step in seconds. - - integer i - integer ii - integer k, kk - integer msg ! ic number of missing moisture levels at the top of model. - integer ierror + integer, dimension(pcols) :: gather_index ! temporary variable used to set ideep + + real(r8), dimension(pcols,pver) :: qg ! gathered specific humidity + real(r8), dimension(pcols,pver) :: tg ! gathered temperature at interface + real(r8), dimension(pcols,pver) :: pg ! gathered values of p + real(r8), dimension(pcols,pver) :: zg ! gathered values of z + real(r8), dimension(pcols,pver) :: sg ! gathered values of s + real(r8), dimension(pcols,pver) :: tpg ! gathered values of tp + real(r8), dimension(pcols,pverp):: zfg ! gathered values of zf + real(r8), dimension(pcols,pver) :: qstpg ! gathered values of qstp + real(r8), dimension(pcols,pver) :: ug ! gathered values of u + real(r8), dimension(pcols,pver) :: vg ! gathered values of v + real(r8), dimension(pcols,pver) :: omegag ! gathered values of omega + real(r8), dimension(pcols,pver) :: rprdg ! gathered rain production rate + real(r8), dimension(pcols) :: capeg ! gathered convective available potential energy + real(r8), dimension(pcols) :: tlg ! gathered values of tl + real(r8), dimension(pcols) :: landfracg ! gathered landfrac + real(r8), dimension(pcols) :: tpertg ! gathered values of tpert (temperature perturbation from PBL) + integer, dimension(pcols) :: lclg ! gathered values of lcl level index + integer, dimension(pcols) :: lelg ! gathered values of equilibrium level index + + ! work fields arising from gathered calculations + real(r8), dimension(pcols,pver) :: dqdt ! gathered specific humidity tendency + real(r8), dimension(pcols,pver) :: dsdt ! gathered dry static energy ("temp") tendency at gathered points + real(r8), dimension(pcols,pver) :: sd ! gathered downdraft dry static energy + real(r8), dimension(pcols,pver) :: qd ! gathered downdraft specific humidity + real(r8), dimension(pcols,pver) :: mc ! gathered net upward (scaled by mb) cloud mass flux + real(r8), dimension(pcols,pver) :: qhat ! gathered upper interface specific humidity + real(r8), dimension(pcols,pver) :: qu ! gathered updraft specific humidity + real(r8), dimension(pcols,pver) :: su ! gathered updraft dry static energy + real(r8), dimension(pcols,pver) :: qs ! gathered saturation specific humidity + real(r8), dimension(pcols,pver) :: shat ! gathered upper interface dry static energy + real(r8), dimension(pcols,pver) :: hmn ! gathered moist static energy + real(r8), dimension(pcols,pver) :: hsat ! gathered saturated moist static energy + real(r8), dimension(pcols,pver) :: qlg ! gathered cloud liquid water + real(r8), dimension(pcols,pver) :: dudt ! gathered u-wind tendency at gathered points + real(r8), dimension(pcols,pver) :: dvdt ! gathered v-wind tendency at gathered points + + real(r8), dimension(pcols,pver) :: sprdg ! gathered snow production rate + real(r8), dimension(pcols,pver) :: dig ! ? + real(r8), dimension(pcols,pver) :: dsg ! ? + real(r8), dimension(pcols,pver) :: dnlg ! ? + real(r8), dimension(pcols,pver) :: dnig ! ? + real(r8), dimension(pcols,pver) :: dnsg ! ? + real(r8), dimension(pcols,pver) :: lambdadpcug ! gathered slope of cloud liquid size distr + real(r8), dimension(pcols,pver) :: mudpcug ! gathered width parameter of droplet size distr + + real(r8), dimension(pcols,pver) :: qldeg ! cloud water mixing ratio for detrainment [kg/kg] + real(r8), dimension(pcols,pver) :: qideg ! cloud ice mixing ratio for detrainment [kg/kg] + real(r8), dimension(pcols,pver) :: qsdeg ! snow mixing ratio for detrainment [kg/kg] + real(r8), dimension(pcols,pver) :: ncdeg ! cloud water number concentration for detrainment [1/kg] + real(r8), dimension(pcols,pver) :: nideg ! cloud ice number concentration for detrainment [1/kg] + real(r8), dimension(pcols,pver) :: nsdeg ! snow concentration for detrainment [1/kg] + real(r8), dimension(pcols,pver) :: dsfmg ! mass tendency due to detrainment of snow + real(r8), dimension(pcols,pver) :: dsfng ! num tendency due to detrainment of snow + real(r8), dimension(pcols,pver) :: frzg ! gathered heating rate due to freezing + + real(r8), dimension(pcols) :: mb ! cloud base mass flux + integer, dimension(pcols) :: jlcl ! updraft lifting cond level + integer, dimension(pcols) :: j0 ! detrainment initiation level index + integer, dimension(pcols) :: jd ! downdraft initiation level index + + type(zm_microp_st) :: loc_microp_st ! local (gathered) convective microphysics state and tendencies + + integer i, ii, k, kk ! loop iterators + integer msg ! number of missing moisture levels at the top of model real(r8) qdifr real(r8) sdifr @@ -407,41 +257,27 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & real(r8), parameter :: dcon = 25.e-6_r8 real(r8), parameter :: mucon = 5.3_r8 real(r8) negadq - logical doliq integer dcapemx(pcols) ! launching level index saved from 1st call for CAPE calculation; used in 2nd call when DCAPE-ULL active -! -!--------------------------Data statements------------------------------ -! -! Set internal variable "msg" (convection limit) to "limcnv-1" -! + !---------------------------------------------------------------------------- + ! Set upper limit of convection to "limcnv-1" msg = zm_param%limcnv - 1 -! -! initialize necessary arrays. -! zero out variables not used in cam -! - qtnd(:,:) = 0._r8 - heat(:,:) = 0._r8 - mcon(:,:) = 0._r8 - rliq(:ncol) = 0._r8 - rice(:ncol) = 0._r8 -! -! Allocate microphysics arrays - if (zm_param%zm_microp) call zm_microp_st_alloc(loc_microp_st) -! -! initialize convective tendencies -! - prec(:ncol) = 0._r8 - do k = 1,pver - do i = 1,ncol + + !---------------------------------------------------------------------------- + ! initialize various arrays + + do i = 1,ncol + do k = 1,pver + qtnd(i,k) = 0._r8 + heat(i,k) = 0._r8 + mcon(i,k) = 0._r8 dqdt(i,k) = 0._r8 dsdt(i,k) = 0._r8 dudt(i,k) = 0._r8 dvdt(i,k) = 0._r8 pflx(i,k) = 0._r8 pflxg(i,k) = 0._r8 - cme(i,k) = 0._r8 rprd(i,k) = 0._r8 zdu(i,k) = 0._r8 ql(i,k) = 0._r8 @@ -454,59 +290,44 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & dnlf(i,k) = 0._r8 dnif(i,k) = 0._r8 dnsf(i,k) = 0._r8 - dig(i,k) = 0._r8 dsg(i,k) = 0._r8 dnlg(i,k) = 0._r8 dnig(i,k) = 0._r8 dnsg(i,k) = 0._r8 - qi(i,k) = 0._r8 sprd(i,k) = 0._r8 frz(i,k) = 0._r8 - sprdg(i,k) = 0._r8 - frzg(i,k) = 0._r8 - - qldeg(i,k) = 0._r8 - qideg(i,k) = 0._r8 - qsdeg(i,k) = 0._r8 + frzg(i,k) = 0._r8 + qldeg(i,k) = 0._r8 + qideg(i,k) = 0._r8 + qsdeg(i,k) = 0._r8 ncdeg(i,k) = 0._r8 nideg(i,k) = 0._r8 nsdeg(i,k) = 0._r8 - dsfmg(i,k) = 0._r8 dsfng(i,k) = 0._r8 end do + prec(i) = 0._r8 + rliq(i) = 0._r8 + rice(i) = 0._r8 + pflx(i,pverp) = 0 + pflxg(i,pverp) = 0 + pblt(i) = pver + dsubcld(i) = 0._r8 + jctop(i) = pver + jcbot(i) = 1 end do -! Initialize microphysics arrays - if (zm_param%zm_microp) then - call zm_microp_st_ini(microp_st, ncol) - call zm_microp_st_ini(loc_microp_st,ncol) - end if - lambdadpcu = (mucon + 1._r8)/dcon mudpcu = mucon lambdadpcug = lambdadpcu mudpcug = mudpcu - do i = 1,ncol - pflx(i,pverp) = 0 - pflxg(i,pverp) = 0 - end do -! - do i = 1,ncol - pblt(i) = pver - dsubcld(i) = 0._r8 + !---------------------------------------------------------------------------- + ! calculate local pressure (mbs) and height (m) for both interface and mid-point - jctop(i) = pver - jcbot(i) = 1 - end do -! -! calculate local pressure (mbs) and height (m) for both interface -! and mid-layer locations. -! do i = 1,ncol zs(i) = geos(i)*zm_const%rgrav pf(i,pver+1) = paph(i,pver+1)*0.01_r8 @@ -520,36 +341,37 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & zf(i,k) = zi(i,k) + zs(i) end do end do -! + do k = pver - 1,msg + 1,-1 do i = 1,ncol if (abs(z(i,k)-zs(i)-pblh(i)) < (zf(i,k)-zf(i,k+1))*0.5_r8) pblt(i) = k end do end do -! -! store incoming specific humidity field for subsequent calculation -! of precipitation (through change in storage). -! define dry static energy (normalized by cp). -! + + !---------------------------------------------------------------------------- + ! store input sp. humidity for calculation of precip (through change in storage) + ! define dry static energy normalized by cp + do k = 1,pver do i = 1,ncol - q(i,k) = qh(i,k) - s(i,k) = t(i,k) + (zm_const%grav/zm_const%cpair)*z(i,k) - tp(i,k)=0.0_r8 + q(i,k) = qh(i,k) + s(i,k) = t(i,k) + (zm_const%grav/zm_const%cpair)*z(i,k) + tp(i,k) = 0.0_r8 shat(i,k) = s(i,k) qhat(i,k) = q(i,k) end do end do do i = 1,ncol - capeg(i) = 0._r8 - lclg(i) = 1 - lelg(i) = pver - maxg(i) = 1 - tlg(i) = 400._r8 + capeg(i) = 0._r8 + lclg(i) = 1 + lelg(i) = pver + maxg(i) = 1 + tlg(i) = 400._r8 dsubcld(i) = 0._r8 end do + !---------------------------------------------------------------------------- ! Evaluate Tparcel, qs(Tparcel), buoyancy, CAPE, lcl, lel, parcel launch level at index maxi()=hmax ! - call #1, iclosure=.true. standard calculation using state of current step ! - call #2, iclosure=.false. use state from previous step and launch level from call #1 @@ -565,11 +387,10 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & zm_const, zm_param, & iclosure ) - if (zm_param%trig_dcape) dcapemx(:ncol) = maxi(:ncol) - ! Calculate dcape trigger condition if ( .not.is_first_step .and. zm_param%trig_dcape ) then iclosure = .false. + dcapemx(:ncol) = maxi(:ncol) call compute_dilute_cape( pcols, ncol, pver, pverp, & zm_param%num_cin, msg, & q_star, t_star, z, p, pf, & @@ -581,11 +402,10 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & dcape(:ncol) = (cape(:ncol)-capem1(:ncol))/(delt*2._r8) endif -! -! determine whether grid points will undergo some deep convection -! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel -! (require cape.gt. 0 and lel0 and lel capelmt) then lengath = lengath + 1 - index(lengath) = i + gather_index(lengath) = i end if else if (cape(i) > 0.0_r8 .and. dcape(i) > trigdcapelmt) then ! use constant 0 or a separate threshold for capt because capelmt is for default trigger lengath = lengath + 1 - index(lengath) = i + gather_index(lengath) = i endif else if (cape(i) > capelmt) then lengath = lengath + 1 - index(lengath) = i + gather_index(lengath) = i end if end if end do if (lengath.eq.0) return + do ii=1,lengath - i=index(ii) - ideep(ii)=i + ideep(ii)=gather_index(ii) end do -! -! obtain gathered arrays necessary for ensuing calculations. -! - do k = 1,pver - do i = 1,lengath - dp(i,k) = 0.01_r8*dpp(ideep(i),k) - qg(i,k) = q(ideep(i),k) - tg(i,k) = t(ideep(i),k) - pg(i,k) = p(ideep(i),k) - zg(i,k) = z(ideep(i),k) - sg(i,k) = s(ideep(i),k) - tpg(i,k) = tp(ideep(i),k) - zfg(i,k) = zf(ideep(i),k) - qstpg(i,k) = qstp(ideep(i),k) + + !---------------------------------------------------------------------------- + ! Allocate and/or Initialize microphysics state/tend derived types + if (zm_param%zm_microp) then + ! call zm_microp_st_alloc(loc_microp_st, lengath, pver) + ! call zm_microp_st_ini(loc_microp_st, lengath, pver) + call zm_microp_st_alloc(loc_microp_st, ncol, pver) + call zm_microp_st_ini(loc_microp_st, ncol, pver) + call zm_microp_st_ini(microp_st, ncol, pver) + end if + + !---------------------------------------------------------------------------- + ! copy data to gathered arrays + + do i = 1,lengath + do k = 1,pver + dp(i,k) = 0.01_r8*dpp(ideep(i),k) + qg(i,k) = q(ideep(i),k) + tg(i,k) = t(ideep(i),k) + pg(i,k) = p(ideep(i),k) + zg(i,k) = z(ideep(i),k) + sg(i,k) = s(ideep(i),k) + tpg(i,k) = tp(ideep(i),k) + zfg(i,k) = zf(ideep(i),k) + qstpg(i,k) = qstp(ideep(i),k) omegag(i,k) = omega(ideep(i),k) - ug(i,k) = 0._r8 - vg(i,k) = 0._r8 + ug(i,k) = 0._r8 + vg(i,k) = 0._r8 end do + zfg(i,pverp) = zf(ideep(i),pver+1) + capeg(i) = cape(ideep(i)) + lclg(i) = lcl(ideep(i)) + lelg(i) = lel(ideep(i)) + maxg(i) = maxi(ideep(i)) + tlg(i) = tl(ideep(i)) + landfracg(i) = landfrac(ideep(i)) + pbltg(i) = pblt(ideep(i)) + tpertg(i) = tpert(ideep(i)) end do if (zm_param%zm_microp) then - if (aero%scheme == 'modal') then - do m = 1, aero%nmodes - - do k = 1,pver - do i = 1,lengath + do i = 1,lengath + do k = 1,pver aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k) aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k) - end do - end do - - do l = 1, aero%nspec(m) - do k = 1,pver - do i = 1,lengath + do l = 1, aero%nspec(m) aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k) end do end do end do - end do - else if (aero%scheme == 'bulk') then - do m = 1, aero%nbulk do k = 1,pver do i = 1,lengath @@ -670,29 +499,13 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end do end do end do - end if - end if -! - do i = 1,lengath - zfg(i,pver+1) = zf(ideep(i),pver+1) - end do - do i = 1,lengath - capeg(i) = cape(ideep(i)) - lclg(i) = lcl(ideep(i)) - lelg(i) = lel(ideep(i)) - maxg(i) = maxi(ideep(i)) - tlg(i) = tl(ideep(i)) - landfracg(i) = landfrac(ideep(i)) - pbltg(i) = pblt(ideep(i)) - tpertg(i) = tpert(ideep(i)) - end do -! -! calculate sub-cloud layer pressure "thickness" for use in -! closure and tendency routines. -! + !---------------------------------------------------------------------------- + ! calculate sub-cloud layer pressure "thickness" for use in + ! closure and tendency routines. + do k = msg + 1,pver do i = 1,lengath if (k >= maxg(i)) then @@ -700,14 +513,11 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end if end do end do -! -! define array of factors (alpha) which defines interfacial -! values, as well as interfacial values for (q,s) used in -! subsequent routines. -! + + !---------------------------------------------------------------------------- + ! define interfacial values for (q,s) used in subsequent routines. do k = msg + 2,pver do i = 1,lengath -! alpha(i,k) = 0.5 sdifr = 0._r8 qdifr = 0._r8 if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) & @@ -726,35 +536,34 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end if end do end do -! -! obtain cloud properties. -! - call cldprp(lchnk , zm_const, & + !---------------------------------------------------------------------------- + ! obtain cloud properties. + + call cldprp(zm_const, pcols, ncol, pver, pverp, & qg ,tg ,ug ,vg ,pg , & zg ,sg ,mu ,eu ,du , & md ,ed ,sd ,qd ,mc , & qu ,su ,zfg ,qs ,hmn , & hsat ,shat ,qlg , & - cmeg ,maxg ,lelg ,jt ,jlcl , & + maxg ,lelg ,jt ,jlcl , & maxg ,j0 ,jd ,lengath ,msg , & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & - aero ,qhat ,lambdadpcug,mudpcug ,sprdg ,frzg , & - qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, & - dsfmg ,dsfng ,loc_microp_st ) + aero ,lambdadpcug,mudpcug ,sprdg ,frzg , & ! < added for ZM micro + qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, & ! < added for ZM micro + dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro -! -! convert detrainment from units of "1/m" to "1/mb". -! + !---------------------------------------------------------------------------- + ! convert detrainment from units of "1/m" to "1/mb". + do k = msg + 1,pver do i = 1,lengath du (i,k) = du (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) eu (i,k) = eu (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - cmeg (i,k) = cmeg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) sprdg(i,k) = sprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) frzg (i,k) = frzg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) @@ -762,7 +571,9 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end do end do - call closure(lchnk , zm_const, & + !---------------------------------------------------------------------------- + + call closure(zm_const, pcols, ncol, pver, pverp, & qg ,tg ,pg ,zg ,sg , & tpg ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -770,34 +581,25 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & qlg ,dsubcld ,mb ,capeg ,tlg , & lclg ,lelg ,jt ,maxg ,1 , & lengath ,msg ,capelmt_wk ) -! -! limit cloud base mass flux to theoretical upper bound. -! + + !---------------------------------------------------------------------------- + ! limit cloud base mass flux to theoretical upper bound. + do i=1,lengath mumax(i) = 0 - end do - do k=msg + 2,pver - do i=1,lengath + do k=msg + 2,pver mumax(i) = max(mumax(i), mu(i,k)/dp(i,k)) end do - end do - - do i=1,lengath if (mumax(i) > 0._r8) then mb(i) = min(mb(i),0.5_r8/(delt*mumax(i))) else mb(i) = 0._r8 endif + if (zm_param%clos_dyn_adj) mb(i) = max(mb(i) - omegag(i,pbltg(i))*0.01_r8, 0._r8) end do - if (zm_param%clos_dyn_adj) then - do i = 1,lengath - mb(i) = max(mb(i) - omegag(i,pbltg(i))*0.01_r8, 0._r8) - end do - end if - - ! If no_deep_pbl = .true., don't allow convection entirely - ! within PBL (suggestion of Bjorn Stevens, 8-2000) + !---------------------------------------------------------------------------- + ! don't allow convection within PBL (suggestion of Bjorn Stevens, 8-2000) if (zm_param%no_deep_pbl) then do i=1,lengath @@ -805,16 +607,21 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end do end if + !---------------------------------------------------------------------------- + ! apply cloud base mass flux scaling - do k=msg+1,pver - do i=1,lengath + do i=1,lengath + + ! zero out micro data for inactive columns + if ( zm_param%zm_microp .and. mb(i).eq.0._r8) call zm_microp_st_zero(loc_microp_st,i,pver) + + do k=msg+1,pver mu (i,k) = mu (i,k)*mb(i) md (i,k) = md (i,k)*mb(i) mc (i,k) = mc (i,k)*mb(i) du (i,k) = du (i,k)*mb(i) eu (i,k) = eu (i,k)*mb(i) ed (i,k) = ed (i,k)*mb(i) - cmeg (i,k) = cmeg (i,k)*mb(i) rprdg(i,k) = rprdg(i,k)*mb(i) cug (i,k) = cug (i,k)*mb(i) evpg (i,k) = evpg (i,k)*mb(i) @@ -822,102 +629,20 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & sprdg(i,k) = sprdg(i,k)*mb(i) frzg(i,k) = frzg(i,k)*mb(i) - if ( zm_param%zm_microp .and. mb(i).eq.0._r8) then - qlg (i,k) = 0._r8 + qlg (i,k) = 0._r8 dsfmg(i,k) = 0._r8 - dsfng(i,k) = 0._r8 + dsfng(i,k) = 0._r8 frzg (i,k) = 0._r8 - loc_microp_st%wu(i,k) = 0._r8 - loc_microp_st%qliq (i,k) = 0._r8 - loc_microp_st%qice (i,k) = 0._r8 - loc_microp_st%qrain(i,k) = 0._r8 - loc_microp_st%qsnow(i,k) = 0._r8 - loc_microp_st%qgraupel(i,k)= 0._r8 - loc_microp_st%qnl (i,k) = 0._r8 - loc_microp_st%qni (i,k) = 0._r8 - loc_microp_st%qnr (i,k) = 0._r8 - loc_microp_st%qns (i,k) = 0._r8 - loc_microp_st%qng (i,k) = 0._r8 - - loc_microp_st%autolm(i,k) = 0._r8 - loc_microp_st%accrlm(i,k) = 0._r8 - loc_microp_st%bergnm(i,k) = 0._r8 - loc_microp_st%fhtimm(i,k) = 0._r8 - loc_microp_st%fhtctm(i,k) = 0._r8 - loc_microp_st%fhmlm (i,k) = 0._r8 - loc_microp_st%hmpim (i,k) = 0._r8 - loc_microp_st%accslm(i,k) = 0._r8 - loc_microp_st%dlfm (i,k) = 0._r8 - - loc_microp_st%autoln(i,k) = 0._r8 - loc_microp_st%accrln(i,k) = 0._r8 - loc_microp_st%bergnn(i,k) = 0._r8 - loc_microp_st%fhtimn(i,k) = 0._r8 - loc_microp_st%fhtctn(i,k) = 0._r8 - loc_microp_st%fhmln (i,k) = 0._r8 - loc_microp_st%accsln(i,k) = 0._r8 - loc_microp_st%activn(i,k) = 0._r8 - loc_microp_st%dlfn (i,k) = 0._r8 - loc_microp_st%cmel (i,k) = 0._r8 - - - loc_microp_st%autoim(i,k) = 0._r8 - loc_microp_st%accsim(i,k) = 0._r8 - loc_microp_st%difm (i,k) = 0._r8 - loc_microp_st%cmei (i,k) = 0._r8 - - loc_microp_st%nuclin(i,k) = 0._r8 - loc_microp_st%autoin(i,k) = 0._r8 - loc_microp_st%accsin(i,k) = 0._r8 - loc_microp_st%hmpin (i,k) = 0._r8 - loc_microp_st%difn (i,k) = 0._r8 - - loc_microp_st%trspcm(i,k) = 0._r8 - loc_microp_st%trspcn(i,k) = 0._r8 - loc_microp_st%trspim(i,k) = 0._r8 - loc_microp_st%trspin(i,k) = 0._r8 - - loc_microp_st%accgrm(i,k) = 0._r8 - loc_microp_st%accglm(i,k) = 0._r8 - loc_microp_st%accgslm(i,k)= 0._r8 - loc_microp_st%accgsrm(i,k)= 0._r8 - loc_microp_st%accgirm(i,k)= 0._r8 - loc_microp_st%accgrim(i,k)= 0._r8 - loc_microp_st%accgrsm(i,k)= 0._r8 - - loc_microp_st%accgsln(i,k)= 0._r8 - loc_microp_st%accgsrn(i,k)= 0._r8 - loc_microp_st%accgirn(i,k)= 0._r8 - - loc_microp_st%accsrim(i,k)= 0._r8 - loc_microp_st%acciglm(i,k)= 0._r8 - loc_microp_st%accigrm(i,k)= 0._r8 - loc_microp_st%accsirm(i,k)= 0._r8 - - loc_microp_st%accigln(i,k)= 0._r8 - loc_microp_st%accigrn(i,k)= 0._r8 - loc_microp_st%accsirn(i,k)= 0._r8 - loc_microp_st%accgln(i,k) = 0._r8 - loc_microp_st%accgrn(i,k) = 0._r8 - - loc_microp_st%accilm(i,k) = 0._r8 - loc_microp_st%acciln(i,k) = 0._r8 - - loc_microp_st%fallrm(i,k) = 0._r8 - loc_microp_st%fallsm(i,k) = 0._r8 - loc_microp_st%fallgm(i,k) = 0._r8 - loc_microp_st%fallrn(i,k) = 0._r8 - loc_microp_st%fallsn(i,k) = 0._r8 - loc_microp_st%fallgn(i,k) = 0._r8 - loc_microp_st%fhmrm (i,k) = 0._r8 end if + end do end do -! -! compute temperature and moisture changes due to convection. -! - call q1q2_pjr(lchnk , zm_const, & + + !---------------------------------------------------------------------------- + ! compute temperature and moisture changes due to convection. + + call q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & dqdt ,dsdt ,qg ,qs ,qu , & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,qldeg , & @@ -926,117 +651,110 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & ncdeg ,nideg ,dnlg ,dnig ,frzg , & qsdeg ,nsdeg ,dsg ,dnsg ) -! -! Conservation check -! - if (zm_param%zm_microp) then - do k = msg + 1,pver + !---------------------------------------------------------------------------- + ! conservation check + + if (zm_param%zm_microp) then + do k = msg + 1,pver #ifdef CPRCRAY !DIR$ CONCURRENT #endif - do i = 1,lengath - if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then - negadq = dqdt(i,k)+0.5_r8*qg(i,k)/delt - dqdt(i,k) = dqdt(i,k)-negadq - - ! First evaporate precipitation from k layer to cloud top assuming that the preciptation - ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer. - do kk=k,jt(i),-1 - if (negadq<0._r8) then - if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - ! precipitation is enough - dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair - if (rprdg(i,kk)>sprdg(i,kk)) then - ! if there is rain, evaporate it first - if(rprdg(i,kk)-sprdg(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then - ! if rain is not enough, evaporate snow and graupel - dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-sprdg(i,kk))*dp(i,kk)/dp(i,k))*zm_const%latice/zm_const%cpair - sprdg(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) - end if - else - ! if there is not rain, evaporate snow and graupel - sprdg(i,kk) = sprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latice/zm_const%cpair - end if - rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! precipitation is not enough. calculate the residue and evaporate next layer - negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq - dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*zm_const%latvap/zm_const%cpair*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - sprdg(i,kk)*zm_const%latice/zm_const%cpair*dp(i,kk)/dp(i,k) - sprdg(i,kk) = 0._r8 - rprdg(i,kk) = 0._r8 - end if - - - if (negadq<0._r8) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - ! first evaporate (detrained) cloud liquid water + do i = 1,lengath + if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then + negadq = dqdt(i,k)+0.5_r8*qg(i,k)/delt + dqdt(i,k) = dqdt(i,k)-negadq + + ! First evaporate precipitation from k layer to cloud top assuming that the preciptation + ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer. + do kk=k,jt(i),-1 + if (negadq<0._r8) then + if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + ! precipitation is enough dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair - dnlg(i,kk) = dnlg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) + if (rprdg(i,kk)>sprdg(i,kk)) then + ! if there is rain, evaporate it first + if(rprdg(i,kk)-sprdg(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then + ! if rain is not enough, evaporate snow and graupel + dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-sprdg(i,kk))*dp(i,kk)/dp(i,k))*zm_const%latice/zm_const%cpair + sprdg(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) + end if + else + ! if there is not rain, evaporate snow and graupel + sprdg(i,kk) = sprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) + dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latice/zm_const%cpair + end if + rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) negadq = 0._r8 else - ! if cloud liquid water is not enough then calculate the residual and evaporate the detrained cloud ice - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*zm_const%latvap/zm_const%cpair - dlg(i,kk) = 0._r8 - dnlg(i,kk) = 0._r8 - if (dig(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dnig(i,kk) = dnig(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dig(i,kk)) - dig(i,kk) = dig(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow - negadq = negadq + dig(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dig(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dig(i,kk) = 0._r8 - dnig(i,kk) = 0._r8 - if (dsg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dnsg(i,kk) = dnsg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dsg(i,kk)) - dsg(i,kk) = dsg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! if cloud ice is not enough, then calculate the residual and evaporate next layer - negadq = negadq + dsg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dsg(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dsg(i,kk) = 0._r8 - dnsg(i,kk) = 0._r8 - end if - end if + ! precipitation is not enough. calculate the residue and evaporate next layer + negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq + dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*zm_const%latvap/zm_const%cpair*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - sprdg(i,kk)*zm_const%latice/zm_const%cpair*dp(i,kk)/dp(i,k) + sprdg(i,kk) = 0._r8 + rprdg(i,kk) = 0._r8 end if - end if - end if - end do + if (negadq<0._r8) then + if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + ! first evaporate (detrained) cloud liquid water + dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair + dnlg(i,kk) = dnlg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) + dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud liquid water is not enough then calculate the residual and evaporate the detrained cloud ice + negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*zm_const%latvap/zm_const%cpair + dlg(i,kk) = 0._r8 + dnlg(i,kk) = 0._r8 + if (dig(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair + dnig(i,kk) = dnig(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dig(i,kk)) + dig(i,kk) = dig(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow + negadq = negadq + dig(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dig(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + dig(i,kk) = 0._r8 + dnig(i,kk) = 0._r8 + if (dsg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair + dnsg(i,kk) = dnsg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dsg(i,kk)) + dsg(i,kk) = dsg(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud ice is not enough, then calculate the residual and evaporate next layer + negadq = negadq + dsg(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dsg(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + dsg(i,kk) = 0._r8 + dnsg(i,kk) = 0._r8 + end if + end if + end if + end if - if (negadq<0._r8) then - dqdt(i,k) = dqdt(i,k) - negadq - end if + end if ! negadq<0._r8 + end do ! kk - end if - end do - end do - end if + if (negadq<0._r8) dqdt(i,k) = dqdt(i,k) - negadq + end if + end do ! i = 1,lengath + end do ! k = msg + 1,pver + end if ! zm_microp + !---------------------------------------------------------------------------- + ! scatter data (i.e. undo the gathering) -! gather back temperature and mixing ratio. -! do k = msg + 1,pver #ifdef CPRCRAY !DIR$ CONCURRENT #endif do i = 1,lengath -! -! q is updated to compute net precip. -! + ! q is updated to compute net precip. q(ideep(i),k) = qh(ideep(i),k) + 2._r8*delt*dqdt(i,k) qtnd(ideep(i),k) = dqdt (i,k) - cme (ideep(i),k) = cmeg (i,k) rprd(ideep(i),k) = rprdg(i,k) zdu (ideep(i),k) = du (i,k) mcon(ideep(i),k) = mc (i,k) @@ -1058,15 +776,16 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & end do end do -! Gather back microphysics arrays. - if (zm_param%zm_microp) call zm_microp_st_gb(microp_st,loc_microp_st,ideep,lengath) + !---------------------------------------------------------------------------- + ! Scatter microphysics data (i.e. undo the gathering) + + if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) if (zm_param%zm_microp) then do k = msg + 1,pver do i = 1,ncol - !Interpolate variable from interface to mid-layer. - + ! Interpolate variable from interface to mid-layer. if(k.lt.pver) then microp_st%qice (i,k) = 0.5_r8*(microp_st%qice(i,k)+microp_st%qice(i,k+1)) microp_st%qliq (i,k) = 0.5_r8*(microp_st%qliq(i,k)+microp_st%qliq(i,k+1)) @@ -1079,85 +798,85 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & microp_st%qns (i,k) = 0.5_r8*(microp_st%qns(i,k)+microp_st%qns(i,k+1)) microp_st%qng (i,k) = 0.5_r8*(microp_st%qng(i,k)+microp_st%qng(i,k+1)) microp_st%wu(i,k) = 0.5_r8*(microp_st%wu(i,k)+microp_st%wu(i,k+1)) - wuc(i,k) = microp_st%wu(i,k) end if if (t(i,k).gt.zm_const%tfreez .and. t(i,k-1).le.zm_const%tfreez) then - microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) - microp_st%qice (i,k) = 0._r8 - microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) - microp_st%qni (i,k) = 0._r8 - microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) - microp_st%qsnow (i,k) = 0._r8 - microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) - microp_st%qns (i,k) = 0._r8 - microp_st%qgraupel (i,k-1) = microp_st%qgraupel (i,k-1) + microp_st%qgraupel (i,k) - microp_st%qgraupel (i,k) = 0._r8 - microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) - microp_st%qng (i,k) = 0._r8 + microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) + microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) + microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) + microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) + microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k) + microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) + microp_st%qice (i,k) = 0._r8 + microp_st%qni (i,k) = 0._r8 + microp_st%qsnow (i,k) = 0._r8 + microp_st%qns (i,k) = 0._r8 + microp_st%qgraupel(i,k) = 0._r8 + microp_st%qng (i,k) = 0._r8 end if - !Convert it from units of "kg/kg" to "g/m3" - microp_st%qice (i,k) = microp_st%qice(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qliq (i,k) = microp_st%qliq(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qrain (i,k) = microp_st%qrain(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qgraupel (i,k) = microp_st%qgraupel(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qni (i,k) = microp_st%qni(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qnl (i,k) = microp_st%qnl(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qnr (i,k) = microp_st%qnr(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qns (i,k) = microp_st%qns(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qng (i,k) = microp_st%qng(i,k) * pap(i,k)/t(i,k)/zm_const%rdair + ! Convert units from "kg/kg" to "g/m3" + microp_st%qice (i,k) = microp_st%qice(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 + microp_st%qliq (i,k) = microp_st%qliq(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 + microp_st%qrain (i,k) = microp_st%qrain(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 + microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 + microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 + microp_st%qni (i,k) = microp_st%qni(i,k) * pap(i,k)/t(i,k)/zm_const%rdair + microp_st%qnl (i,k) = microp_st%qnl(i,k) * pap(i,k)/t(i,k)/zm_const%rdair + microp_st%qnr (i,k) = microp_st%qnr(i,k) * pap(i,k)/t(i,k)/zm_const%rdair + microp_st%qns (i,k) = microp_st%qns(i,k) * pap(i,k)/t(i,k)/zm_const%rdair + microp_st%qng (i,k) = microp_st%qng(i,k) * pap(i,k)/t(i,k)/zm_const%rdair end do end do end if -! + #ifdef CPRCRAY !DIR$ CONCURRENT #endif + do i = 1,lengath jctop(ideep(i)) = jt(i) -!++bee jcbot(ideep(i)) = maxg(i) -!--bee pflx(ideep(i),pverp) = pflxg(i,pverp) end do -! Compute precip by integrating change in water vapor minus detrained cloud water - do k = pver,msg + 1,-1 - do i = 1,ncol - prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k)+dsf(i,k))*2._r8*delt - end do - end do - -! obtain final precipitation rate in m/s. + !---------------------------------------------------------------------------- + ! Compute precip by integrating change in water vapor minus detrained cloud water do i = 1,ncol + do k = pver,msg + 1,-1 + prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k)+dsf(i,k))*2._r8*delt + end do + ! obtain final precipitation rate in m/s prec(i) = zm_const%rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8 end do -! Compute reserved liquid (not yet in cldliq) for energy integrals. -! Treat rliq as flux out bottom, to be added back later. + !---------------------------------------------------------------------------- + ! Compute reserved liquid (not yet in cldliq) for energy integrals. + ! Treat rliq as flux out bottom, to be added back later. do k = 1, pver do i = 1, ncol - rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav - rice(i) = rice(i) + (dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav + rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav + rice(i) = rice(i) + (dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav end do end do rliq(:ncol) = rliq(:ncol) /1000._r8 rice(:ncol) = rice(:ncol) /1000._r8 -! Deallocate microphysics arrays. + !---------------------------------------------------------------------------- + ! Deallocate microphysics arrays. if (zm_param%zm_microp) call zm_microp_st_dealloc(loc_microp_st) + !---------------------------------------------------------------------------- return end subroutine zm_convr !=================================================================================================== -subroutine zm_conv_evap(ncol,lchnk, & - t,pmid,pdel,q, & - tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & - prdprec, cldfrc, deltat, & - prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow, old_snow ) +subroutine zm_conv_evap(pcols, ncol, pver, pverp, & + t, pmid, pdel, q, & + tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & + prdprec, cldfrc, deltat, & + prec, snow, ntprprd, ntsnprd, & + flxprec, flxsnow, prdsnow, old_snow ) !----------------------------------------------------------------------- ! Compute tendencies due to evaporation of rain from ZM scheme !-- @@ -1172,7 +891,10 @@ subroutine zm_conv_evap(ncol,lchnk, & use wv_saturation, only: qsat #endif !------------------------------Arguments-------------------------------- - integer,intent(in) :: ncol, lchnk ! number of columns and chunk index + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point vertical levels + integer, intent(in) :: pverp ! number of interface vertical levels real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) @@ -1403,17 +1125,17 @@ end subroutine zm_conv_evap !=================================================================================================== -subroutine cldprp(lchnk , zm_const, & +subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & q ,t ,u ,v ,p , & z ,s ,mu ,eu ,du , & md ,ed ,sd ,qd ,mc , & qu ,su ,zf ,qst ,hmn , & hsat ,shat ,ql , & - cmeg ,jb ,lel ,jt ,jlcl , & + jb ,lel ,jt ,jlcl , & mx ,j0 ,jd ,il2g ,msg , & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & - aero ,qhat ,lambdadpcu ,mudpcu ,sprd ,frz1 , & + aero ,lambdadpcu ,mudpcu ,sprd ,frz1 , & qcde ,qide ,qsde ,ncde ,nide ,nsde , & dsfm ,dsfn ,loc_microp_st ) @@ -1444,8 +1166,11 @@ subroutine cldprp(lchnk , zm_const, & ! ! Input arguments ! - integer, intent(in) :: lchnk ! chunk identifier type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point vertical levels + integer, intent(in) :: pverp ! number of interface vertical levels real(r8), intent(in) :: q(pcols,pver) ! spec. humidity of env real(r8), intent(in) :: t(pcols,pver) ! temp of env real(r8), intent(in) :: p(pcols,pver) ! pressure of env @@ -1470,7 +1195,6 @@ subroutine cldprp(lchnk , zm_const, & real(r8), intent(in) :: shat(pcols,pver) ! interface values of dry stat energy real(r8), intent(in) :: tpertg(pcols) - real(r8), intent(in) :: qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio. type(zm_aero_t), intent(in) :: aero ! aerosol object ! @@ -1533,7 +1257,6 @@ subroutine cldprp(lchnk , zm_const, & real(r8) gamhat(pcols,pver) real(r8) cu(pcols,pver) real(r8) evp(pcols,pver) - real(r8) cmeg(pcols,pver) real(r8) qds(pcols,pver) ! RBN For c0mask real(r8) c0mask(pcols) @@ -1702,7 +1425,6 @@ subroutine cldprp(lchnk , zm_const, & ql(i,k) = 0._r8 cu(i,k) = 0._r8 evp(i,k) = 0._r8 - cmeg(i,k) = 0._r8 qds(i,k) = q(i,k) md(i,k) = 0._r8 ed(i,k) = 0._r8 @@ -2362,9 +2084,7 @@ subroutine cldprp(lchnk , zm_const, & ed(i,k) = 0._r8 evp(i,k) = 0._r8 end if -! cmeg is the cloud water condensed - rain water evaporated ! rprd is the cloud water converted to rain - (rain evaporated) - cmeg(i,k) = cu(i,k) - evp(i,k) if (zm_param%zm_microp) then if (rprd(i,k)> 0._r8) then frz1(i,k) = frz1(i,k)- evp(i,k)*min(1._r8,sprd(i,k)/rprd(i,k)) @@ -2416,7 +2136,6 @@ subroutine cldprp(lchnk , zm_const, & ql(i,k) = 0._r8 cu(i,k) = 0._r8 evp(i,k) = 0._r8 - cmeg(i,k) = 0._r8 md(i,k) = 0._r8 ed(i,k) = 0._r8 mc(i,k) = 0._r8 @@ -2452,7 +2171,7 @@ end subroutine cldprp !=================================================================================================== -subroutine closure(lchnk , zm_const, & +subroutine closure(zm_const, pcols, ncol, pver, pverp, & q ,t ,p ,z ,s , & tp ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -2484,8 +2203,11 @@ subroutine closure(lchnk , zm_const, & ! !-----------------------------Arguments--------------------------------- ! - integer, intent(in) :: lchnk ! chunk identifier type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point vertical levels + integer, intent(in) :: pverp ! number of interface vertical levels real(r8), intent(inout) :: q(pcols,pver) ! spec humidity real(r8), intent(inout) :: t(pcols,pver) ! temperature real(r8), intent(inout) :: p(pcols,pver) ! pressure (mb) @@ -2664,7 +2386,7 @@ end subroutine closure !=================================================================================================== -subroutine q1q2_pjr(lchnk , zm_const, & +subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & dqdt ,dsdt ,q ,qs ,qu , & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,ql , & @@ -2689,8 +2411,11 @@ subroutine q1q2_pjr(lchnk , zm_const, & !----------------------------------------------------------------------- - integer, intent(in) :: lchnk ! chunk identifier type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point vertical levels + integer, intent(in) :: pverp ! number of interface vertical levels integer, intent(in) :: il1g integer, intent(in) :: il2g integer, intent(in) :: msg diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 74d1c57796c1..42e16eb7f7f5 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -500,7 +500,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & real(r8), pointer, dimension(:,:) :: flxsnow ! convective-scale flux of snow at interfaces (kg/m2/s) real(r8), pointer, dimension(:,:) :: dp_cldliq ! cloud liq water real(r8), pointer, dimension(:,:) :: dp_cldice ! cloud ice water - real(r8), pointer, dimension(:,:) :: wuc ! vertical velocity + real(r8), pointer, dimension(:,:) :: wuc ! vertical velocity from ZM microphysics ! DCAPE-ULL real(r8), pointer, dimension(:,:) :: t_star ! DCAPE T from time step n-1 @@ -543,7 +543,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & !---------------------------------------------------------------------------- - if (zm_param%zm_microp) call zm_microp_st_alloc(microp_st) + if (zm_param%zm_microp) call zm_microp_st_alloc(microp_st, pcols, pver) !---------------------------------------------------------------------------- ! Initialize stuff @@ -596,6 +596,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call pbuf_get_field(pbuf, dsfzm_idx, dsf) call pbuf_get_field(pbuf, dnsfzm_idx, dnsf) call pbuf_get_field(pbuf, wuc_idx, wuc) + wuc(1:pcols,1:pver) = 0 else allocate(dnlf(pcols,pver), & dnif(pcols,pver), & @@ -603,7 +604,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & dnsf(pcols,pver), & wuc(pcols,pver) ) end if - wuc(1:pcols,1:pver) = 0 call pbuf_get_field(pbuf, lambdadpcu_idx, lambdadpcu) call pbuf_get_field(pbuf, mudpcu_idx, mudpcu) @@ -634,19 +634,28 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & ! Call the primary Zhang-McFarlane convection parameterization call t_startf ('zm_convr') - call zm_convr( lchnk, ncol, is_first_step_loc, & - state%t, state%q(:,:,1), prec, jctop, jcbot, & - pblh, state%zm, state%phis, state%zi, ptend_loc%q(:,:,1), & - ptend_loc%s, state%pmid, state%pint, state%pdel, state%omega, & - 0.5*ztodt, mcon, cme, cape, tpert, dlf, pflx, zdu, rprd, mu, md, du, eu, ed, & - dp, dsubcld, jt, maxg, ideep, lengath, ql, rliq, landfrac, & - t_star, q_star, dcape, & - aero(lchnk), qi, dif, dnlf, dnif, dsf, dnsf, sprd, rice, frz, mudpcu, & - lambdadpcu, microp_st, wuc ) + call zm_convr( pcols, ncol, pver, pverp, is_first_step_loc, 0.5*ztodt, & + state%t, state%q(:,:,1), state%omega, & + state%pmid, state%pint, state%pdel, & + state%phis, state%zm, state%zi, pblh, & + tpert, landfrac, t_star, q_star, & + aero(lchnk), microp_st, & + lengath, ideep, maxg, jctop, jcbot, jt, & + prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & + mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & + ql, rliq, rprd, dlf, & + qi, rice, sprd, dif, dsf, dnlf, dnif, dnsf, frz, & + mudpcu, lambdadpcu ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then + microp_st%dif (1:ncol,1:pver) = dif (1:ncol,1:pver) + microp_st%dsf (1:ncol,1:pver) = dsf (1:ncol,1:pver) + microp_st%dnlf(1:ncol,1:pver) = dnlf(1:ncol,1:pver) + microp_st%dnif(1:ncol,1:pver) = dnif(1:ncol,1:pver) + microp_st%frz (1:ncol,1:pver) = frz (1:ncol,1:pver) dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) + wuc(1:pcols,1:pver) = microp_st%wu(1:pcols,1:pver) else dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) end if @@ -766,7 +775,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & dp_cldice(1:ncol,1:pver) = 0 call t_startf ('zm_conv_evap') - call zm_conv_evap(state1%ncol, state1%lchnk, & + call zm_conv_evap(pcols, state1%ncol, pver, pverp, & state1%t, state1%pmid, state1%pdel, state1%q(1:pcols,1:pver,1), & ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & rprd, cld, ztodt, prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, sprd, old_snow) @@ -791,7 +800,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call outfld('PRECCDZM', prec, pcols, lchnk ) call outfld('PRECZ ', prec, pcols, lchnk ) - if (zm_param%zm_microp) call zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, dnlf, dnif, frz ) + if (zm_param%zm_microp) call zm_microphysics_history_out(lchnk, ncol, microp_st, prec, dlf) ! add tendency from this process to tend from other processes here call physics_ptend_sum(ptend_loc,ptend_all, ncol) diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 index 87dbee3f0416..182c73cf79c2 100644 --- a/components/eam/src/physics/cam/zm_microphysics_history.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_history.F90 @@ -132,7 +132,7 @@ end subroutine zm_microphysics_history_init !=================================================================================================== -subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, dnlf, dnif, frz ) +subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf ) !---------------------------------------------------------------------------- ! Purpose: write out history variables for convective microphysics !---------------------------------------------------------------------------- @@ -144,10 +144,6 @@ subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, type(zm_microp_st), intent(in) :: microp_st ! ZM microphysics data structure real(r8), dimension(pcols), intent(in) :: prec ! convective precip rate real(r8), dimension(pcols,pver), intent(in) :: dlf ! detrainment of conv cld liq water mixing ratio - real(r8), dimension(pcols,pver), intent(in) :: dif ! detrainment of conv cld ice mixing ratio - real(r8), dimension(pcols,pver), intent(in) :: dnlf ! detrainment of conv cld liq water num concen - real(r8), dimension(pcols,pver), intent(in) :: dnif ! detrainment of conv cld ice num concen - real(r8), dimension(pcols,pver), intent(in) :: frz ! heating rate due to freezing !---------------------------------------------------------------------------- ! Local variables integer :: i,k @@ -159,20 +155,21 @@ subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, real(r8), dimension(pcols,pver) :: cgraupel_snum ! convective graupel sample number real(r8), dimension(pcols,pver) :: wu_snum ! vertical velocity sample number !---------------------------------------------------------------------------- + cice_snum (1:ncol,1:pver) = 0 + cliq_snum (1:ncol,1:pver) = 0 + csnow_snum (1:ncol,1:pver) = 0 + crain_snum (1:ncol,1:pver) = 0 + cgraupel_snum(1:ncol,1:pver) = 0 + wu_snum (1:ncol,1:pver) = 0 + do k = 1,pver do i = 1,ncol if (microp_st%qice(i,k) > 0) cice_snum(i,k) = 1 - if (microp_st%qice(i,k) <= 0) cice_snum(i,k) = 0 if (microp_st%qliq(i,k) > 0) cliq_snum(i,k) = 1 - if (microp_st%qliq(i,k) <= 0) cliq_snum(i,k) = 0 if (microp_st%qsnow(i,k) > 0) csnow_snum(i,k) = 1 - if (microp_st%qsnow(i,k) <= 0) csnow_snum(i,k) = 0 if (microp_st%qrain(i,k) > 0) crain_snum(i,k) = 1 - if (microp_st%qrain(i,k) <= 0) crain_snum(i,k) = 0 if (microp_st%qgraupel(i,k) > 0) cgraupel_snum(i,k) = 1 - if (microp_st%qgraupel(i,k) <= 0) cgraupel_snum(i,k) = 0 if (microp_st%wu(i,k) > 0) wu_snum(i,k) = 1 - if (microp_st%wu(i,k) <= 0) wu_snum(i,k) = 0 end do end do @@ -183,11 +180,11 @@ subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf, dif, call outfld('CGRAPNUM',cgraupel_snum , pcols, lchnk ) call outfld('WUZMSNUM',wu_snum , pcols, lchnk ) - call outfld('DIFZM' ,dif , pcols, lchnk ) call outfld('DLFZM' ,dlf , pcols, lchnk ) - call outfld('DNIFZM' ,dnif , pcols, lchnk ) - call outfld('DNLFZM' ,dnlf , pcols, lchnk ) - call outfld('FRZZM' ,frz , pcols, lchnk ) + call outfld('DIFZM' ,microp_st%dif , pcols, lchnk ) + call outfld('DNIFZM' ,microp_st%dnif , pcols, lchnk ) + call outfld('DNLFZM' ,microp_st%dnlf , pcols, lchnk ) + call outfld('FRZZM' ,microp_st%frz , pcols, lchnk ) call outfld('WUZM' ,microp_st%wu , pcols, lchnk ) diff --git a/components/eam/src/physics/cam/zm_microphysics_state.F90 b/components/eam/src/physics/cam/zm_microphysics_state.F90 index 07639ea866bf..80f5a64ae91f 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -4,32 +4,37 @@ module zm_microphysics_state ! Original Author: Xialiang Song and Guang Zhang, June 2010 !---------------------------------------------------------------------------- #ifdef SCREAM_CONFIG_IS_CMAKE - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp + use zm_eamxx_bridge_params, only: r8 #else use shr_kind_mod, only: r8=>shr_kind_r8 - use ppgrid, only: pcols, pver, pverp #endif public :: zm_microp_st ! structure to hold state and tendency of ZM microphysics public :: zm_microp_st_alloc ! allocate zm_microp_st variables public :: zm_microp_st_dealloc ! deallocate zm_microp_st variables public :: zm_microp_st_ini ! intialize zm_microp_st variables - public :: zm_microp_st_gb ! gather microphysic arrays + public :: zm_microp_st_zero ! zero out zm_microp_st variables for a single column + public :: zm_microp_st_scatter ! scatter the gathered microphysic array data !=================================================================================================== type :: zm_microp_st real(r8), allocatable, dimension(:,:) :: wu ! vertical velocity - real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water. - real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice. - real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water. - real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow. - real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel. + real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water + real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice + real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water + real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow + real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel real(r8), allocatable, dimension(:,:) :: qnl ! convective cloud liquid water num concen. real(r8), allocatable, dimension(:,:) :: qni ! convective cloud ice num concen. real(r8), allocatable, dimension(:,:) :: qnr ! convective rain water num concen. real(r8), allocatable, dimension(:,:) :: qns ! convective snow num concen. real(r8), allocatable, dimension(:,:) :: qng ! convective graupel num concen. + real(r8), allocatable, dimension(:,:) :: dif ! detrainment of cloud ice water mixing ratio + real(r8), allocatable, dimension(:,:) :: dsf ! detrained convective snow mixing ratio + real(r8), allocatable, dimension(:,:) :: dnlf ! detrainment of conv cld liq water num concen + real(r8), allocatable, dimension(:,:) :: dnif ! detrainment of conv cld ice num concen + real(r8), allocatable, dimension(:,:) :: frz ! heating rate due to freezing real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain real(r8), allocatable, dimension(:,:) :: bergnm ! mass tendency due to Bergeron process @@ -96,346 +101,459 @@ module zm_microphysics_state contains !=================================================================================================== -subroutine zm_microp_st_alloc(loc_microp_st) +subroutine zm_microp_st_alloc(microp_st_in,ncol_in,nlev_in) !---------------------------------------------------------------------------- ! Purpose: allocate zm_microp_st variables !---------------------------------------------------------------------------- ! Arguments - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics + type(zm_microp_st), intent(inout) :: microp_st_in ! state and tendency of convective microphysics + integer, intent(in ) :: ncol_in ! number of atmospheric columns to allocate + integer, intent(in ) :: nlev_in ! number of atmospheric levels to allocate !---------------------------------------------------------------------------- allocate( & - loc_microp_st%wu (pcols,pver), & - loc_microp_st%qliq (pcols,pver), & - loc_microp_st%qice (pcols,pver), & - loc_microp_st%qrain (pcols,pver), & - loc_microp_st%qsnow (pcols,pver), & - loc_microp_st%qgraupel (pcols,pver), & - loc_microp_st%qnl (pcols,pver), & - loc_microp_st%qni (pcols,pver), & - loc_microp_st%qnr (pcols,pver), & - loc_microp_st%qns (pcols,pver), & - loc_microp_st%qng (pcols,pver), & - loc_microp_st%autolm (pcols,pver), & - loc_microp_st%accrlm (pcols,pver), & - loc_microp_st%bergnm (pcols,pver), & - loc_microp_st%fhtimm (pcols,pver), & - loc_microp_st%fhtctm (pcols,pver), & - loc_microp_st%fhmlm (pcols,pver), & - loc_microp_st%hmpim (pcols,pver), & - loc_microp_st%accslm (pcols,pver), & - loc_microp_st%dlfm (pcols,pver), & - loc_microp_st%autoln (pcols,pver), & - loc_microp_st%accrln (pcols,pver), & - loc_microp_st%bergnn (pcols,pver), & - loc_microp_st%fhtimn (pcols,pver), & - loc_microp_st%fhtctn (pcols,pver), & - loc_microp_st%fhmln (pcols,pver), & - loc_microp_st%accsln (pcols,pver), & - loc_microp_st%activn (pcols,pver), & - loc_microp_st%dlfn (pcols,pver), & - loc_microp_st%autoim (pcols,pver), & - loc_microp_st%accsim (pcols,pver), & - loc_microp_st%difm (pcols,pver), & - loc_microp_st%nuclin (pcols,pver), & - loc_microp_st%autoin (pcols,pver), & - loc_microp_st%accsin (pcols,pver), & - loc_microp_st%hmpin (pcols,pver), & - loc_microp_st%difn (pcols,pver), & - loc_microp_st%cmel (pcols,pver), & - loc_microp_st%cmei (pcols,pver), & - loc_microp_st%trspcm (pcols,pver), & - loc_microp_st%trspcn (pcols,pver), & - loc_microp_st%trspim (pcols,pver), & - loc_microp_st%trspin (pcols,pver), & - loc_microp_st%accgrm (pcols,pver), & - loc_microp_st%accglm (pcols,pver), & - loc_microp_st%accgslm (pcols,pver), & - loc_microp_st%accgsrm (pcols,pver), & - loc_microp_st%accgirm (pcols,pver), & - loc_microp_st%accgrim (pcols,pver), & - loc_microp_st%accgrsm (pcols,pver), & - loc_microp_st%accgsln (pcols,pver), & - loc_microp_st%accgsrn (pcols,pver), & - loc_microp_st%accgirn (pcols,pver), & - loc_microp_st%accsrim (pcols,pver), & - loc_microp_st%acciglm (pcols,pver), & - loc_microp_st%accigrm (pcols,pver), & - loc_microp_st%accsirm (pcols,pver), & - loc_microp_st%accigln (pcols,pver), & - loc_microp_st%accigrn (pcols,pver), & - loc_microp_st%accsirn (pcols,pver), & - loc_microp_st%accgln (pcols,pver), & - loc_microp_st%accgrn (pcols,pver), & - loc_microp_st%accilm (pcols,pver), & - loc_microp_st%acciln (pcols,pver), & - loc_microp_st%fallrm (pcols,pver), & - loc_microp_st%fallsm (pcols,pver), & - loc_microp_st%fallgm (pcols,pver), & - loc_microp_st%fallrn (pcols,pver), & - loc_microp_st%fallsn (pcols,pver), & - loc_microp_st%fallgn (pcols,pver), & - loc_microp_st%fhmrm (pcols,pver) ) + microp_st_in%wu (ncol_in,nlev_in), & + microp_st_in%qliq (ncol_in,nlev_in), & + microp_st_in%qice (ncol_in,nlev_in), & + microp_st_in%qrain (ncol_in,nlev_in), & + microp_st_in%qsnow (ncol_in,nlev_in), & + microp_st_in%qgraupel (ncol_in,nlev_in), & + microp_st_in%qnl (ncol_in,nlev_in), & + microp_st_in%qni (ncol_in,nlev_in), & + microp_st_in%qnr (ncol_in,nlev_in), & + microp_st_in%qns (ncol_in,nlev_in), & + microp_st_in%qng (ncol_in,nlev_in), & + microp_st_in%dif (ncol_in,nlev_in), & + microp_st_in%dsf (ncol_in,nlev_in), & + microp_st_in%dnlf (ncol_in,nlev_in), & + microp_st_in%dnif (ncol_in,nlev_in), & + microp_st_in%frz (ncol_in,nlev_in), & + microp_st_in%autolm (ncol_in,nlev_in), & + microp_st_in%accrlm (ncol_in,nlev_in), & + microp_st_in%bergnm (ncol_in,nlev_in), & + microp_st_in%fhtimm (ncol_in,nlev_in), & + microp_st_in%fhtctm (ncol_in,nlev_in), & + microp_st_in%fhmlm (ncol_in,nlev_in), & + microp_st_in%hmpim (ncol_in,nlev_in), & + microp_st_in%accslm (ncol_in,nlev_in), & + microp_st_in%dlfm (ncol_in,nlev_in), & + microp_st_in%autoln (ncol_in,nlev_in), & + microp_st_in%accrln (ncol_in,nlev_in), & + microp_st_in%bergnn (ncol_in,nlev_in), & + microp_st_in%fhtimn (ncol_in,nlev_in), & + microp_st_in%fhtctn (ncol_in,nlev_in), & + microp_st_in%fhmln (ncol_in,nlev_in), & + microp_st_in%accsln (ncol_in,nlev_in), & + microp_st_in%activn (ncol_in,nlev_in), & + microp_st_in%dlfn (ncol_in,nlev_in), & + microp_st_in%autoim (ncol_in,nlev_in), & + microp_st_in%accsim (ncol_in,nlev_in), & + microp_st_in%difm (ncol_in,nlev_in), & + microp_st_in%nuclin (ncol_in,nlev_in), & + microp_st_in%autoin (ncol_in,nlev_in), & + microp_st_in%accsin (ncol_in,nlev_in), & + microp_st_in%hmpin (ncol_in,nlev_in), & + microp_st_in%difn (ncol_in,nlev_in), & + microp_st_in%cmel (ncol_in,nlev_in), & + microp_st_in%cmei (ncol_in,nlev_in), & + microp_st_in%trspcm (ncol_in,nlev_in), & + microp_st_in%trspcn (ncol_in,nlev_in), & + microp_st_in%trspim (ncol_in,nlev_in), & + microp_st_in%trspin (ncol_in,nlev_in), & + microp_st_in%accgrm (ncol_in,nlev_in), & + microp_st_in%accglm (ncol_in,nlev_in), & + microp_st_in%accgslm (ncol_in,nlev_in), & + microp_st_in%accgsrm (ncol_in,nlev_in), & + microp_st_in%accgirm (ncol_in,nlev_in), & + microp_st_in%accgrim (ncol_in,nlev_in), & + microp_st_in%accgrsm (ncol_in,nlev_in), & + microp_st_in%accgsln (ncol_in,nlev_in), & + microp_st_in%accgsrn (ncol_in,nlev_in), & + microp_st_in%accgirn (ncol_in,nlev_in), & + microp_st_in%accsrim (ncol_in,nlev_in), & + microp_st_in%acciglm (ncol_in,nlev_in), & + microp_st_in%accigrm (ncol_in,nlev_in), & + microp_st_in%accsirm (ncol_in,nlev_in), & + microp_st_in%accigln (ncol_in,nlev_in), & + microp_st_in%accigrn (ncol_in,nlev_in), & + microp_st_in%accsirn (ncol_in,nlev_in), & + microp_st_in%accgln (ncol_in,nlev_in), & + microp_st_in%accgrn (ncol_in,nlev_in), & + microp_st_in%accilm (ncol_in,nlev_in), & + microp_st_in%acciln (ncol_in,nlev_in), & + microp_st_in%fallrm (ncol_in,nlev_in), & + microp_st_in%fallsm (ncol_in,nlev_in), & + microp_st_in%fallgm (ncol_in,nlev_in), & + microp_st_in%fallrn (ncol_in,nlev_in), & + microp_st_in%fallsn (ncol_in,nlev_in), & + microp_st_in%fallgn (ncol_in,nlev_in), & + microp_st_in%fhmrm (ncol_in,nlev_in) ) end subroutine zm_microp_st_alloc !=================================================================================================== -subroutine zm_microp_st_dealloc(loc_microp_st) +subroutine zm_microp_st_dealloc(microp_st_in) !---------------------------------------------------------------------------- ! Purpose: deallocate zm_microp_st variables !---------------------------------------------------------------------------- ! Arguments - type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics + type(zm_microp_st) :: microp_st_in ! state and tendency of convective microphysics !---------------------------------------------------------------------------- deallocate( & - loc_microp_st%wu, & - loc_microp_st%qliq, & - loc_microp_st%qice, & - loc_microp_st%qrain, & - loc_microp_st%qsnow, & - loc_microp_st%qgraupel, & - loc_microp_st%qnl, & - loc_microp_st%qni, & - loc_microp_st%qnr, & - loc_microp_st%qns, & - loc_microp_st%qng, & - loc_microp_st%autolm, & - loc_microp_st%accrlm, & - loc_microp_st%bergnm, & - loc_microp_st%fhtimm, & - loc_microp_st%fhtctm, & - loc_microp_st%fhmlm , & - loc_microp_st%hmpim , & - loc_microp_st%accslm, & - loc_microp_st%dlfm , & - loc_microp_st%autoln, & - loc_microp_st%accrln, & - loc_microp_st%bergnn, & - loc_microp_st%fhtimn, & - loc_microp_st%fhtctn, & - loc_microp_st%fhmln , & - loc_microp_st%accsln, & - loc_microp_st%activn, & - loc_microp_st%dlfn , & - loc_microp_st%autoim, & - loc_microp_st%accsim, & - loc_microp_st%difm , & - loc_microp_st%nuclin, & - loc_microp_st%autoin, & - loc_microp_st%accsin, & - loc_microp_st%hmpin, & - loc_microp_st%difn, & - loc_microp_st%cmel, & - loc_microp_st%cmei, & - loc_microp_st%trspcm, & - loc_microp_st%trspcn, & - loc_microp_st%trspim, & - loc_microp_st%trspin, & - loc_microp_st%accgrm, & - loc_microp_st%accglm, & - loc_microp_st%accgslm, & - loc_microp_st%accgsrm, & - loc_microp_st%accgirm, & - loc_microp_st%accgrim, & - loc_microp_st%accgrsm, & - loc_microp_st%accgsln, & - loc_microp_st%accgsrn, & - loc_microp_st%accgirn, & - loc_microp_st%accsrim, & - loc_microp_st%acciglm, & - loc_microp_st%accigrm, & - loc_microp_st%accsirm, & - loc_microp_st%accigln, & - loc_microp_st%accigrn, & - loc_microp_st%accsirn, & - loc_microp_st%accgln, & - loc_microp_st%accgrn, & - loc_microp_st%accilm, & - loc_microp_st%acciln, & - loc_microp_st%fallrm, & - loc_microp_st%fallsm, & - loc_microp_st%fallgm, & - loc_microp_st%fallrn, & - loc_microp_st%fallsn, & - loc_microp_st%fallgn, & - loc_microp_st%fhmrm ) + microp_st_in%wu, & + microp_st_in%qliq, & + microp_st_in%qice, & + microp_st_in%qrain, & + microp_st_in%qsnow, & + microp_st_in%qgraupel, & + microp_st_in%qnl, & + microp_st_in%qni, & + microp_st_in%qnr, & + microp_st_in%qns, & + microp_st_in%qng, & + microp_st_in%dif, & + microp_st_in%dsf, & + microp_st_in%dnlf, & + microp_st_in%dnif, & + microp_st_in%frz, & + microp_st_in%autolm, & + microp_st_in%accrlm, & + microp_st_in%bergnm, & + microp_st_in%fhtimm, & + microp_st_in%fhtctm, & + microp_st_in%fhmlm , & + microp_st_in%hmpim , & + microp_st_in%accslm, & + microp_st_in%dlfm , & + microp_st_in%autoln, & + microp_st_in%accrln, & + microp_st_in%bergnn, & + microp_st_in%fhtimn, & + microp_st_in%fhtctn, & + microp_st_in%fhmln , & + microp_st_in%accsln, & + microp_st_in%activn, & + microp_st_in%dlfn , & + microp_st_in%autoim, & + microp_st_in%accsim, & + microp_st_in%difm , & + microp_st_in%nuclin, & + microp_st_in%autoin, & + microp_st_in%accsin, & + microp_st_in%hmpin, & + microp_st_in%difn, & + microp_st_in%cmel, & + microp_st_in%cmei, & + microp_st_in%trspcm, & + microp_st_in%trspcn, & + microp_st_in%trspim, & + microp_st_in%trspin, & + microp_st_in%accgrm, & + microp_st_in%accglm, & + microp_st_in%accgslm, & + microp_st_in%accgsrm, & + microp_st_in%accgirm, & + microp_st_in%accgrim, & + microp_st_in%accgrsm, & + microp_st_in%accgsln, & + microp_st_in%accgsrn, & + microp_st_in%accgirn, & + microp_st_in%accsrim, & + microp_st_in%acciglm, & + microp_st_in%accigrm, & + microp_st_in%accsirm, & + microp_st_in%accigln, & + microp_st_in%accigrn, & + microp_st_in%accsirn, & + microp_st_in%accgln, & + microp_st_in%accgrn, & + microp_st_in%accilm, & + microp_st_in%acciln, & + microp_st_in%fallrm, & + microp_st_in%fallsm, & + microp_st_in%fallgm, & + microp_st_in%fallrn, & + microp_st_in%fallsn, & + microp_st_in%fallgn, & + microp_st_in%fhmrm ) end subroutine zm_microp_st_dealloc !=================================================================================================== -subroutine zm_microp_st_ini(microp_st,ncol) +subroutine zm_microp_st_ini(microp_st_in,ncol_in,nlev_in) !---------------------------------------------------------------------------- ! Purpose: initialize zm_microp_st variables !---------------------------------------------------------------------------- ! Arguments - type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics - integer, intent(in ) :: ncol ! number of atmospheric columns + type(zm_microp_st), intent(inout) :: microp_st_in ! state and tendency of convective microphysics + integer, intent(in ) :: ncol_in ! number of atmospheric columns to initialize + integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize !---------------------------------------------------------------------------- - microp_st%wu (1:ncol,1:pver) = 0._r8 - microp_st%qliq (1:ncol,1:pver) = 0._r8 - microp_st%qice (1:ncol,1:pver) = 0._r8 - microp_st%qrain (1:ncol,1:pver) = 0._r8 - microp_st%qsnow (1:ncol,1:pver) = 0._r8 - microp_st%qgraupel (1:ncol,1:pver) = 0._r8 - microp_st%qnl (1:ncol,1:pver) = 0._r8 - microp_st%qni (1:ncol,1:pver) = 0._r8 - microp_st%qnr (1:ncol,1:pver) = 0._r8 - microp_st%qns (1:ncol,1:pver) = 0._r8 - microp_st%qng (1:ncol,1:pver) = 0._r8 - microp_st%autolm (1:ncol,1:pver) = 0._r8 - microp_st%accrlm (1:ncol,1:pver) = 0._r8 - microp_st%bergnm (1:ncol,1:pver) = 0._r8 - microp_st%fhtimm (1:ncol,1:pver) = 0._r8 - microp_st%fhtctm (1:ncol,1:pver) = 0._r8 - microp_st%fhmlm (1:ncol,1:pver) = 0._r8 - microp_st%hmpim (1:ncol,1:pver) = 0._r8 - microp_st%accslm (1:ncol,1:pver) = 0._r8 - microp_st%dlfm (1:ncol,1:pver) = 0._r8 - microp_st%autoln (1:ncol,1:pver) = 0._r8 - microp_st%accrln (1:ncol,1:pver) = 0._r8 - microp_st%bergnn (1:ncol,1:pver) = 0._r8 - microp_st%fhtimn (1:ncol,1:pver) = 0._r8 - microp_st%fhtctn (1:ncol,1:pver) = 0._r8 - microp_st%fhmln (1:ncol,1:pver) = 0._r8 - microp_st%accsln (1:ncol,1:pver) = 0._r8 - microp_st%activn (1:ncol,1:pver) = 0._r8 - microp_st%dlfn (1:ncol,1:pver) = 0._r8 - microp_st%cmel (1:ncol,1:pver) = 0._r8 - microp_st%autoim (1:ncol,1:pver) = 0._r8 - microp_st%accsim (1:ncol,1:pver) = 0._r8 - microp_st%difm (1:ncol,1:pver) = 0._r8 - microp_st%cmei (1:ncol,1:pver) = 0._r8 - microp_st%nuclin (1:ncol,1:pver) = 0._r8 - microp_st%autoin (1:ncol,1:pver) = 0._r8 - microp_st%accsin (1:ncol,1:pver) = 0._r8 - microp_st%hmpin (1:ncol,1:pver) = 0._r8 - microp_st%difn (1:ncol,1:pver) = 0._r8 - microp_st%trspcm (1:ncol,1:pver) = 0._r8 - microp_st%trspcn (1:ncol,1:pver) = 0._r8 - microp_st%trspim (1:ncol,1:pver) = 0._r8 - microp_st%trspin (1:ncol,1:pver) = 0._r8 - microp_st%accgrm (1:ncol,1:pver) = 0._r8 - microp_st%accglm (1:ncol,1:pver) = 0._r8 - microp_st%accgslm (1:ncol,1:pver) = 0._r8 - microp_st%accgsrm (1:ncol,1:pver) = 0._r8 - microp_st%accgirm (1:ncol,1:pver) = 0._r8 - microp_st%accgrim (1:ncol,1:pver) = 0._r8 - microp_st%accgrsm (1:ncol,1:pver) = 0._r8 - microp_st%accgsln (1:ncol,1:pver) = 0._r8 - microp_st%accgsrn (1:ncol,1:pver) = 0._r8 - microp_st%accgirn (1:ncol,1:pver) = 0._r8 - microp_st%accsrim (1:ncol,1:pver) = 0._r8 - microp_st%acciglm (1:ncol,1:pver) = 0._r8 - microp_st%accigrm (1:ncol,1:pver) = 0._r8 - microp_st%accsirm (1:ncol,1:pver) = 0._r8 - microp_st%accigln (1:ncol,1:pver) = 0._r8 - microp_st%accigrn (1:ncol,1:pver) = 0._r8 - microp_st%accsirn (1:ncol,1:pver) = 0._r8 - microp_st%accgln (1:ncol,1:pver) = 0._r8 - microp_st%accgrn (1:ncol,1:pver) = 0._r8 - microp_st%accilm (1:ncol,1:pver) = 0._r8 - microp_st%acciln (1:ncol,1:pver) = 0._r8 - microp_st%fallrm (1:ncol,1:pver) = 0._r8 - microp_st%fallsm (1:ncol,1:pver) = 0._r8 - microp_st%fallgm (1:ncol,1:pver) = 0._r8 - microp_st%fallrn (1:ncol,1:pver) = 0._r8 - microp_st%fallsn (1:ncol,1:pver) = 0._r8 - microp_st%fallgn (1:ncol,1:pver) = 0._r8 - microp_st%fhmrm (1:ncol,1:pver) = 0._r8 - + microp_st_in%wu (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qliq (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qice (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qrain (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qsnow (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qgraupel (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qnl (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qni (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qnr (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qns (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qng (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dif (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dsf (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dnlf (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dnif (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%frz (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autolm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accrlm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmlm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accslm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accrln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%activn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%cmel (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%difm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%cmei (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%nuclin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%difn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accglm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgslm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrsm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsrim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%acciglm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accilm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%acciln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmrm (1:ncol_in,1:nlev_in) = 0._r8 end subroutine zm_microp_st_ini !=================================================================================================== -subroutine zm_microp_st_gb(microp_st,loc_microp_st,ideep,lengath) +subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) + !---------------------------------------------------------------------------- + ! Purpose: zero out zm_microp_st variables for a single column + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st), intent(inout) :: microp_st_in ! state and tendency of convective microphysics + integer, intent(in ) :: icol_in ! atmospheric column index + integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize + !---------------------------------------------------------------------------- + microp_st_in%wu (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qliq (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qice (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qrain (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qsnow (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qgraupel (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qnl (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qni (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qnr (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qns (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qng (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dif (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dsf (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dnlf (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dnif (icol_in,1:nlev_in) = 0._r8 + microp_st_in%frz (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autolm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accrlm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmlm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accslm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accrln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%activn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%cmel (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%difm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%cmei (icol_in,1:nlev_in) = 0._r8 + microp_st_in%nuclin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%difn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accglm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgslm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrsm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsrim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%acciglm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accilm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%acciln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmrm (icol_in,1:nlev_in) = 0._r8 +end subroutine zm_microp_st_zero + +!=================================================================================================== + +subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_in,ideep) !---------------------------------------------------------------------------- - ! Purpose: gather microphysic arrays from microp_st to loc_microp_st + ! Purpose: gather microphysic arrays from microp_st to microp_st_in !---------------------------------------------------------------------------- ! Arguments - type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics - type(zm_microp_st), intent(in ) :: loc_microp_st ! state and tendency of convective microphysics - integer, intent(in ) :: ideep(pcols) ! holds position of gathered points vs longitude index. - integer, intent(in ) :: lengath + type(zm_microp_st), intent(in ) :: microp_st_gth ! input gathered state and tendency of convective microphysics + type(zm_microp_st), intent(inout) :: microp_st_out ! output scattered state and tendency of convective microphysics + integer, intent(in ) :: lengath ! number of gathered columns + integer, intent(in ) :: pcols ! number of columns for ideep + integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize + integer, intent(in ) :: ideep(pcols) ! flag for active columns !---------------------------------------------------------------------------- integer :: i,k !---------------------------------------------------------------------------- - do k = 1,pver + do k = 1,nlev_in do i = 1,lengath - microp_st%wu (ideep(i),k) = loc_microp_st%wu (i,k) - microp_st%qliq (ideep(i),k) = loc_microp_st%qliq (i,k) - microp_st%qice (ideep(i),k) = loc_microp_st%qice (i,k) - microp_st%qrain (ideep(i),k) = loc_microp_st%qrain (i,k) - microp_st%qsnow (ideep(i),k) = loc_microp_st%qsnow (i,k) - microp_st%qgraupel (ideep(i),k) = loc_microp_st%qgraupel (i,k) - microp_st%qnl (ideep(i),k) = loc_microp_st%qnl (i,k) - microp_st%qni (ideep(i),k) = loc_microp_st%qni (i,k) - microp_st%qnr (ideep(i),k) = loc_microp_st%qnr (i,k) - microp_st%qns (ideep(i),k) = loc_microp_st%qns (i,k) - microp_st%qng (ideep(i),k) = loc_microp_st%qng (i,k) - microp_st%autolm (ideep(i),k) = loc_microp_st%autolm (i,k) - microp_st%accrlm (ideep(i),k) = loc_microp_st%accrlm (i,k) - microp_st%bergnm (ideep(i),k) = loc_microp_st%bergnm (i,k) - microp_st%fhtimm (ideep(i),k) = loc_microp_st%fhtimm (i,k) - microp_st%fhtctm (ideep(i),k) = loc_microp_st%fhtctm (i,k) - microp_st%fhmlm (ideep(i),k) = loc_microp_st%fhmlm (i,k) - microp_st%hmpim (ideep(i),k) = loc_microp_st%hmpim (i,k) - microp_st%accslm (ideep(i),k) = loc_microp_st%accslm (i,k) - microp_st%dlfm (ideep(i),k) = loc_microp_st%dlfm (i,k) - microp_st%autoln (ideep(i),k) = loc_microp_st%autoln (i,k) - microp_st%accrln (ideep(i),k) = loc_microp_st%accrln (i,k) - microp_st%bergnn (ideep(i),k) = loc_microp_st%bergnn (i,k) - microp_st%fhtimn (ideep(i),k) = loc_microp_st%fhtimn (i,k) - microp_st%fhtctn (ideep(i),k) = loc_microp_st%fhtctn (i,k) - microp_st%fhmln (ideep(i),k) = loc_microp_st%fhmln (i,k) - microp_st%accsln (ideep(i),k) = loc_microp_st%accsln (i,k) - microp_st%activn (ideep(i),k) = loc_microp_st%activn (i,k) - microp_st%dlfn (ideep(i),k) = loc_microp_st%dlfn (i,k) - microp_st%cmel (ideep(i),k) = loc_microp_st%cmel (i,k) - microp_st%autoim (ideep(i),k) = loc_microp_st%autoim (i,k) - microp_st%accsim (ideep(i),k) = loc_microp_st%accsim (i,k) - microp_st%difm (ideep(i),k) = loc_microp_st%difm (i,k) - microp_st%cmei (ideep(i),k) = loc_microp_st%cmei (i,k) - microp_st%nuclin (ideep(i),k) = loc_microp_st%nuclin (i,k) - microp_st%autoin (ideep(i),k) = loc_microp_st%autoin (i,k) - microp_st%accsin (ideep(i),k) = loc_microp_st%accsin (i,k) - microp_st%hmpin (ideep(i),k) = loc_microp_st%hmpin (i,k) - microp_st%difn (ideep(i),k) = loc_microp_st%difn (i,k) - microp_st%trspcm (ideep(i),k) = loc_microp_st%trspcm (i,k) - microp_st%trspcn (ideep(i),k) = loc_microp_st%trspcn (i,k) - microp_st%trspim (ideep(i),k) = loc_microp_st%trspim (i,k) - microp_st%trspin (ideep(i),k) = loc_microp_st%trspin (i,k) - microp_st%accgrm (ideep(i),k) = loc_microp_st%accgrm (i,k) - microp_st%accglm (ideep(i),k) = loc_microp_st%accglm (i,k) - microp_st%accgslm (ideep(i),k) = loc_microp_st%accgslm (i,k) - microp_st%accgsrm (ideep(i),k) = loc_microp_st%accgsrm (i,k) - microp_st%accgirm (ideep(i),k) = loc_microp_st%accgirm (i,k) - microp_st%accgrim (ideep(i),k) = loc_microp_st%accgrim (i,k) - microp_st%accgrsm (ideep(i),k) = loc_microp_st%accgrsm (i,k) - microp_st%accgsln (ideep(i),k) = loc_microp_st%accgsln (i,k) - microp_st%accgsrn (ideep(i),k) = loc_microp_st%accgsrn (i,k) - microp_st%accgirn (ideep(i),k) = loc_microp_st%accgirn (i,k) - microp_st%accsrim (ideep(i),k) = loc_microp_st%accsrim (i,k) - microp_st%acciglm (ideep(i),k) = loc_microp_st%acciglm (i,k) - microp_st%accigrm (ideep(i),k) = loc_microp_st%accigrm (i,k) - microp_st%accsirm (ideep(i),k) = loc_microp_st%accsirm (i,k) - microp_st%accigln (ideep(i),k) = loc_microp_st%accigln (i,k) - microp_st%accigrn (ideep(i),k) = loc_microp_st%accigrn (i,k) - microp_st%accsirn (ideep(i),k) = loc_microp_st%accsirn (i,k) - microp_st%accgln (ideep(i),k) = loc_microp_st%accgln (i,k) - microp_st%accgrn (ideep(i),k) = loc_microp_st%accgrn (i,k) - microp_st%accilm (ideep(i),k) = loc_microp_st%accilm (i,k) - microp_st%acciln (ideep(i),k) = loc_microp_st%acciln (i,k) - microp_st%fallrm (ideep(i),k) = loc_microp_st%fallrm (i,k) - microp_st%fallsm (ideep(i),k) = loc_microp_st%fallsm (i,k) - microp_st%fallgm (ideep(i),k) = loc_microp_st%fallgm (i,k) - microp_st%fallrn (ideep(i),k) = loc_microp_st%fallrn (i,k) - microp_st%fallsn (ideep(i),k) = loc_microp_st%fallsn (i,k) - microp_st%fallgn (ideep(i),k) = loc_microp_st%fallgn (i,k) - microp_st%fhmrm (ideep(i),k) = loc_microp_st%fhmrm (i,k) + microp_st_out%wu (ideep(i),k) = microp_st_gth%wu (i,k) + microp_st_out%qliq (ideep(i),k) = microp_st_gth%qliq (i,k) + microp_st_out%qice (ideep(i),k) = microp_st_gth%qice (i,k) + microp_st_out%qrain (ideep(i),k) = microp_st_gth%qrain (i,k) + microp_st_out%qsnow (ideep(i),k) = microp_st_gth%qsnow (i,k) + microp_st_out%qgraupel (ideep(i),k) = microp_st_gth%qgraupel (i,k) + microp_st_out%qnl (ideep(i),k) = microp_st_gth%qnl (i,k) + microp_st_out%qni (ideep(i),k) = microp_st_gth%qni (i,k) + microp_st_out%qnr (ideep(i),k) = microp_st_gth%qnr (i,k) + microp_st_out%qns (ideep(i),k) = microp_st_gth%qns (i,k) + microp_st_out%qng (ideep(i),k) = microp_st_gth%qng (i,k) + microp_st_out%dif (ideep(i),k) = microp_st_gth%dif (i,k) + microp_st_out%dsf (ideep(i),k) = microp_st_gth%dsf (i,k) + microp_st_out%dnlf (ideep(i),k) = microp_st_gth%dnlf (i,k) + microp_st_out%dnif (ideep(i),k) = microp_st_gth%dnif (i,k) + microp_st_out%frz (ideep(i),k) = microp_st_gth%frz (i,k) + microp_st_out%autolm (ideep(i),k) = microp_st_gth%autolm (i,k) + microp_st_out%accrlm (ideep(i),k) = microp_st_gth%accrlm (i,k) + microp_st_out%bergnm (ideep(i),k) = microp_st_gth%bergnm (i,k) + microp_st_out%fhtimm (ideep(i),k) = microp_st_gth%fhtimm (i,k) + microp_st_out%fhtctm (ideep(i),k) = microp_st_gth%fhtctm (i,k) + microp_st_out%fhmlm (ideep(i),k) = microp_st_gth%fhmlm (i,k) + microp_st_out%hmpim (ideep(i),k) = microp_st_gth%hmpim (i,k) + microp_st_out%accslm (ideep(i),k) = microp_st_gth%accslm (i,k) + microp_st_out%dlfm (ideep(i),k) = microp_st_gth%dlfm (i,k) + microp_st_out%autoln (ideep(i),k) = microp_st_gth%autoln (i,k) + microp_st_out%accrln (ideep(i),k) = microp_st_gth%accrln (i,k) + microp_st_out%bergnn (ideep(i),k) = microp_st_gth%bergnn (i,k) + microp_st_out%fhtimn (ideep(i),k) = microp_st_gth%fhtimn (i,k) + microp_st_out%fhtctn (ideep(i),k) = microp_st_gth%fhtctn (i,k) + microp_st_out%fhmln (ideep(i),k) = microp_st_gth%fhmln (i,k) + microp_st_out%accsln (ideep(i),k) = microp_st_gth%accsln (i,k) + microp_st_out%activn (ideep(i),k) = microp_st_gth%activn (i,k) + microp_st_out%dlfn (ideep(i),k) = microp_st_gth%dlfn (i,k) + microp_st_out%cmel (ideep(i),k) = microp_st_gth%cmel (i,k) + microp_st_out%autoim (ideep(i),k) = microp_st_gth%autoim (i,k) + microp_st_out%accsim (ideep(i),k) = microp_st_gth%accsim (i,k) + microp_st_out%difm (ideep(i),k) = microp_st_gth%difm (i,k) + microp_st_out%cmei (ideep(i),k) = microp_st_gth%cmei (i,k) + microp_st_out%nuclin (ideep(i),k) = microp_st_gth%nuclin (i,k) + microp_st_out%autoin (ideep(i),k) = microp_st_gth%autoin (i,k) + microp_st_out%accsin (ideep(i),k) = microp_st_gth%accsin (i,k) + microp_st_out%hmpin (ideep(i),k) = microp_st_gth%hmpin (i,k) + microp_st_out%difn (ideep(i),k) = microp_st_gth%difn (i,k) + microp_st_out%trspcm (ideep(i),k) = microp_st_gth%trspcm (i,k) + microp_st_out%trspcn (ideep(i),k) = microp_st_gth%trspcn (i,k) + microp_st_out%trspim (ideep(i),k) = microp_st_gth%trspim (i,k) + microp_st_out%trspin (ideep(i),k) = microp_st_gth%trspin (i,k) + microp_st_out%accgrm (ideep(i),k) = microp_st_gth%accgrm (i,k) + microp_st_out%accglm (ideep(i),k) = microp_st_gth%accglm (i,k) + microp_st_out%accgslm (ideep(i),k) = microp_st_gth%accgslm (i,k) + microp_st_out%accgsrm (ideep(i),k) = microp_st_gth%accgsrm (i,k) + microp_st_out%accgirm (ideep(i),k) = microp_st_gth%accgirm (i,k) + microp_st_out%accgrim (ideep(i),k) = microp_st_gth%accgrim (i,k) + microp_st_out%accgrsm (ideep(i),k) = microp_st_gth%accgrsm (i,k) + microp_st_out%accgsln (ideep(i),k) = microp_st_gth%accgsln (i,k) + microp_st_out%accgsrn (ideep(i),k) = microp_st_gth%accgsrn (i,k) + microp_st_out%accgirn (ideep(i),k) = microp_st_gth%accgirn (i,k) + microp_st_out%accsrim (ideep(i),k) = microp_st_gth%accsrim (i,k) + microp_st_out%acciglm (ideep(i),k) = microp_st_gth%acciglm (i,k) + microp_st_out%accigrm (ideep(i),k) = microp_st_gth%accigrm (i,k) + microp_st_out%accsirm (ideep(i),k) = microp_st_gth%accsirm (i,k) + microp_st_out%accigln (ideep(i),k) = microp_st_gth%accigln (i,k) + microp_st_out%accigrn (ideep(i),k) = microp_st_gth%accigrn (i,k) + microp_st_out%accsirn (ideep(i),k) = microp_st_gth%accsirn (i,k) + microp_st_out%accgln (ideep(i),k) = microp_st_gth%accgln (i,k) + microp_st_out%accgrn (ideep(i),k) = microp_st_gth%accgrn (i,k) + microp_st_out%accilm (ideep(i),k) = microp_st_gth%accilm (i,k) + microp_st_out%acciln (ideep(i),k) = microp_st_gth%acciln (i,k) + microp_st_out%fallrm (ideep(i),k) = microp_st_gth%fallrm (i,k) + microp_st_out%fallsm (ideep(i),k) = microp_st_gth%fallsm (i,k) + microp_st_out%fallgm (ideep(i),k) = microp_st_gth%fallgm (i,k) + microp_st_out%fallrn (ideep(i),k) = microp_st_gth%fallrn (i,k) + microp_st_out%fallsn (ideep(i),k) = microp_st_gth%fallsn (i,k) + microp_st_out%fallgn (ideep(i),k) = microp_st_gth%fallgn (i,k) + microp_st_out%fhmrm (ideep(i),k) = microp_st_gth%fhmrm (i,k) end do end do -end subroutine zm_microp_st_gb +end subroutine zm_microp_st_scatter !=================================================================================================== From dc2ce59536f64e24bb08c2dce28b74056ca34bd7 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 8 Oct 2025 08:25:09 -0700 Subject: [PATCH 02/31] major cleanup of microphysics related arguments whitespace alignment --- components/eam/src/physics/cam/zm_conv.F90 | 412 +++----- .../eam/src/physics/cam/zm_conv_intr.F90 | 27 +- .../src/physics/cam/zm_microphysics_state.F90 | 944 +++++++++--------- 3 files changed, 648 insertions(+), 735 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 5eabe97eae77..210716ce9174 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -79,9 +79,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - qi, rice, sprd, dif, & - dsf, dnlf, dnif, dnsf, frz, & - mudpcu, lambdadpcu ) + qi, sprd, frz, mudpcu, lambdadpcu ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -134,13 +132,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio real(r8), dimension(pcols,pver), intent( out) :: qi ! ZM microphysics - cloud ice mixing ratio - real(r8), dimension(pcols), intent( out) :: rice ! ZM microphysics - reserved ice (not yet in cldce) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: sprd ! ZM microphysics - snow production rate - real(r8), dimension(pcols,pver), intent( out) :: dif ! ZM microphysics - detrained cloud ice mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: dsf ! ZM microphysics - detrained snow mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: dnlf ! ZM microphysics - detrained cloud water num concen - real(r8), dimension(pcols,pver), intent( out) :: dnif ! ZM microphysics - detrained cloud ice num concen - real(r8), dimension(pcols,pver), intent( out) :: dnsf ! ZM microphysics - detrained snow num concen real(r8), dimension(pcols,pver), intent( out) :: frz ! ZM microphysics - heating rate due to freezing real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr real(r8), dimension(pcols,pver), intent( out) :: lambdadpcu ! ZM microphysics - slope of cloud liquid size distr @@ -182,7 +174,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & logical iclosure ! flag for compute_dilute_cape() real(r8) capelmt_wk ! local capelmt to allow exceptions when calling closure() with trigdcape - + integer, dimension(pcols) :: gather_index ! temporary variable used to set ideep real(r8), dimension(pcols,pver) :: qg ! gathered specific humidity @@ -222,11 +214,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: dvdt ! gathered v-wind tendency at gathered points real(r8), dimension(pcols,pver) :: sprdg ! gathered snow production rate - real(r8), dimension(pcols,pver) :: dig ! ? - real(r8), dimension(pcols,pver) :: dsg ! ? - real(r8), dimension(pcols,pver) :: dnlg ! ? - real(r8), dimension(pcols,pver) :: dnig ! ? - real(r8), dimension(pcols,pver) :: dnsg ! ? real(r8), dimension(pcols,pver) :: lambdadpcug ! gathered slope of cloud liquid size distr real(r8), dimension(pcols,pver) :: mudpcug ! gathered width parameter of droplet size distr @@ -285,16 +272,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & dlf(i,k) = 0._r8 dlg(i,k) = 0._r8 ! Convective microphysics - dif(i,k) = 0._r8 - dsf(i,k) = 0._r8 - dnlf(i,k) = 0._r8 - dnif(i,k) = 0._r8 - dnsf(i,k) = 0._r8 - dig(i,k) = 0._r8 - dsg(i,k) = 0._r8 - dnlg(i,k) = 0._r8 - dnig(i,k) = 0._r8 - dnsg(i,k) = 0._r8 qi(i,k) = 0._r8 sprd(i,k) = 0._r8 frz(i,k) = 0._r8 @@ -311,7 +288,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & end do prec(i) = 0._r8 rliq(i) = 0._r8 - rice(i) = 0._r8 pflx(i,pverp) = 0 pflxg(i,pverp) = 0 pblt(i) = pver @@ -325,6 +301,14 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & lambdadpcug = lambdadpcu mudpcug = mudpcu + !---------------------------------------------------------------------------- + ! Allocate and/or Initialize microphysics state/tend derived types + if (zm_param%zm_microp) then + call zm_microp_st_alloc(loc_microp_st, ncol, pver) + call zm_microp_st_ini(loc_microp_st, ncol, pver) + call zm_microp_st_ini(microp_st, ncol, pver) + end if + !---------------------------------------------------------------------------- ! calculate local pressure (mbs) and height (m) for both interface and mid-point @@ -439,16 +423,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ideep(ii)=gather_index(ii) end do - !---------------------------------------------------------------------------- - ! Allocate and/or Initialize microphysics state/tend derived types - if (zm_param%zm_microp) then - ! call zm_microp_st_alloc(loc_microp_st, lengath, pver) - ! call zm_microp_st_ini(loc_microp_st, lengath, pver) - call zm_microp_st_alloc(loc_microp_st, ncol, pver) - call zm_microp_st_ini(loc_microp_st, ncol, pver) - call zm_microp_st_ini(microp_st, ncol, pver) - end if - !---------------------------------------------------------------------------- ! copy data to gathered arrays @@ -549,7 +523,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & maxg ,lelg ,jt ,jlcl , & maxg ,j0 ,jd ,lengath ,msg , & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & - landfracg, tpertg, & + landfracg, tpertg, & aero ,lambdadpcug,mudpcug ,sprdg ,frzg , & ! < added for ZM micro qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, & ! < added for ZM micro dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro @@ -647,9 +621,13 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,qldeg , & dsubcld ,jt ,maxg ,1 ,lengath , msg, & - dlg ,evpg ,cug ,qideg ,dig , & - ncdeg ,nideg ,dnlg ,dnig ,frzg , & - qsdeg ,nsdeg ,dsg ,dnsg ) + dlg ,evpg ,cug ,qideg ,& + ncdeg ,& + nideg ,& + frzg , & + qsdeg ,& + nsdeg ,& + loc_microp_st) !---------------------------------------------------------------------------- ! conservation check @@ -664,7 +642,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & negadq = dqdt(i,k)+0.5_r8*qg(i,k)/delt dqdt(i,k) = dqdt(i,k)-negadq - ! First evaporate precipitation from k layer to cloud top assuming that the preciptation + ! First evaporate precipitation from k layer to cloud top assuming that the preciptation ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer. do kk=k,jt(i),-1 if (negadq<0._r8) then @@ -698,7 +676,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then ! first evaporate (detrained) cloud liquid water dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair - dnlg(i,kk) = dnlg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) + loc_microp_st%dnlf(i,kk) = loc_microp_st%dnlf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) negadq = 0._r8 else @@ -706,35 +684,35 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*zm_const%latvap/zm_const%cpair dlg(i,kk) = 0._r8 - dnlg(i,kk) = 0._r8 - if (dig(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + loc_microp_st%dnlf(i,kk) = 0._r8 ! dnlg(i,kk) = 0._r8 + if (loc_microp_st%dif(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dnig(i,kk) = dnig(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dig(i,kk)) - dig(i,kk) = dig(i,kk)+negadq*dp(i,k)/dp(i,kk) + loc_microp_st%dnif(i,kk) = loc_microp_st%dnif(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_microp_st%dif(i,kk)) + loc_microp_st%dif(i,kk) = loc_microp_st%dif(i,kk)+negadq*dp(i,k)/dp(i,kk) negadq = 0._r8 else ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow - negadq = negadq + dig(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dig(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dig(i,kk) = 0._r8 - dnig(i,kk) = 0._r8 - if (dsg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + negadq = negadq + loc_microp_st%dif(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - loc_microp_st%dif(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + loc_microp_st%dif(i,kk) = 0._r8 + loc_microp_st%dnif(i,kk) = 0._r8 + if (loc_microp_st%dsf(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dnsg(i,kk) = dnsg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dsg(i,kk)) - dsg(i,kk) = dsg(i,kk)+negadq*dp(i,k)/dp(i,kk) + loc_microp_st%dnsf(i,kk) = loc_microp_st%dnsf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_microp_st%dsf(i,kk)) + loc_microp_st%dsf(i,kk) = loc_microp_st%dsf(i,kk)+negadq*dp(i,k)/dp(i,kk) negadq = 0._r8 else ! if cloud ice is not enough, then calculate the residual and evaporate next layer - negadq = negadq + dsg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dsg(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - dsg(i,kk) = 0._r8 - dnsg(i,kk) = 0._r8 + negadq = negadq + loc_microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - loc_microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + loc_microp_st%dsf(i,kk) = 0._r8 + loc_microp_st%dnsf(i,kk) = 0._r8 end if end if end if - end if + end if - end if ! negadq<0._r8 + end if ! negadq<0._r8 end do ! kk if (negadq<0._r8) dqdt(i,k) = dqdt(i,k) - negadq @@ -764,11 +742,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ql (ideep(i),k) = qlg (i,k) sprd(ideep(i),k) = sprdg(i,k) - dif (ideep(i),k) = dig (i,k) - dsf (ideep(i),k) = dsg (i,k) - dnlf(ideep(i),k) = dnlg (i,k) - dnif(ideep(i),k) = dnig (i,k) - dnsf(ideep(i),k) = dnsg (i,k) lambdadpcu(ideep(i),k) = lambdadpcug(i,k) mudpcu(ideep(i),k) = mudpcug(i,k) frz(ideep(i),k) = frzg(i,k)*zm_const%latice/zm_const%cpair @@ -779,25 +752,25 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- ! Scatter microphysics data (i.e. undo the gathering) - if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) - + if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) + if (zm_param%zm_microp) then do k = msg + 1,pver do i = 1,ncol ! Interpolate variable from interface to mid-layer. if(k.lt.pver) then - microp_st%qice (i,k) = 0.5_r8*(microp_st%qice(i,k)+microp_st%qice(i,k+1)) - microp_st%qliq (i,k) = 0.5_r8*(microp_st%qliq(i,k)+microp_st%qliq(i,k+1)) - microp_st%qrain (i,k) = 0.5_r8*(microp_st%qrain(i,k)+microp_st%qrain(i,k+1)) - microp_st%qsnow (i,k) = 0.5_r8*(microp_st%qsnow(i,k)+microp_st%qsnow(i,k+1)) + microp_st%qice (i,k) = 0.5_r8*(microp_st%qice (i,k)+microp_st%qice (i,k+1)) + microp_st%qliq (i,k) = 0.5_r8*(microp_st%qliq (i,k)+microp_st%qliq (i,k+1)) + microp_st%qrain (i,k) = 0.5_r8*(microp_st%qrain (i,k)+microp_st%qrain (i,k+1)) + microp_st%qsnow (i,k) = 0.5_r8*(microp_st%qsnow (i,k)+microp_st%qsnow (i,k+1)) microp_st%qgraupel(i,k) = 0.5_r8*(microp_st%qgraupel(i,k)+microp_st%qgraupel(i,k+1)) - microp_st%qni (i,k) = 0.5_r8*(microp_st%qni(i,k)+microp_st%qni(i,k+1)) - microp_st%qnl (i,k) = 0.5_r8*(microp_st%qnl(i,k)+microp_st%qnl(i,k+1)) - microp_st%qnr (i,k) = 0.5_r8*(microp_st%qnr(i,k)+microp_st%qnr(i,k+1)) - microp_st%qns (i,k) = 0.5_r8*(microp_st%qns(i,k)+microp_st%qns(i,k+1)) - microp_st%qng (i,k) = 0.5_r8*(microp_st%qng(i,k)+microp_st%qng(i,k+1)) - microp_st%wu(i,k) = 0.5_r8*(microp_st%wu(i,k)+microp_st%wu(i,k+1)) + microp_st%qni (i,k) = 0.5_r8*(microp_st%qni (i,k)+microp_st%qni (i,k+1)) + microp_st%qnl (i,k) = 0.5_r8*(microp_st%qnl (i,k)+microp_st%qnl (i,k+1)) + microp_st%qnr (i,k) = 0.5_r8*(microp_st%qnr (i,k)+microp_st%qnr (i,k+1)) + microp_st%qns (i,k) = 0.5_r8*(microp_st%qns (i,k)+microp_st%qns (i,k+1)) + microp_st%qng (i,k) = 0.5_r8*(microp_st%qng (i,k)+microp_st%qng (i,k+1)) + microp_st%wu (i,k) = 0.5_r8*(microp_st%wu (i,k)+microp_st%wu (i,k+1)) end if if (t(i,k).gt.zm_const%tfreez .and. t(i,k-1).le.zm_const%tfreez) then @@ -843,26 +816,35 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ! Compute precip by integrating change in water vapor minus detrained cloud water do i = 1,ncol do k = pver,msg + 1,-1 - prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k)+dsf(i,k))*2._r8*delt + if (zm_param%zm_microp) then + prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+microp_st%dif(i,k)+microp_st%dsf(i,k))*2._r8*delt + else + prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k))*2._r8*delt + end if end do ! obtain final precipitation rate in m/s prec(i) = zm_const%rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8 end do !---------------------------------------------------------------------------- - ! Compute reserved liquid (not yet in cldliq) for energy integrals. - ! Treat rliq as flux out bottom, to be added back later. + ! Compute reserved liquid (and ice) that is not yet in cldliq for energy integrals + ! Treat rliq as flux out bottom, to be added back later do k = 1, pver do i = 1, ncol - rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav - rice(i) = rice(i) + (dif(i,k)+dsf(i,k))*dpp(i,k)/zm_const%grav + if (zm_param%zm_microp) then + rliq(i) = rliq(i) + (dlf(i,k)+microp_st%dif(i,k)+microp_st%dsf(i,k))*dpp(i,k)/zm_const%grav + microp_st%rice(i) = microp_st%rice(i) \ + + (microp_st%dif(i,k)+microp_st%dsf(i,k))*dpp(i,k)/zm_const%grav + else + rliq(i) = rliq(i) + dlf(i,k)*dpp(i,k)/zm_const%grav + end if end do end do rliq(:ncol) = rliq(:ncol) /1000._r8 - rice(:ncol) = rice(:ncol) /1000._r8 + if (zm_param%zm_microp) microp_st%rice(:ncol) = microp_st%rice(:ncol) /1000._r8 !---------------------------------------------------------------------------- - ! Deallocate microphysics arrays. + ! Deallocate microphysics arrays if (zm_param%zm_microp) call zm_microp_st_dealloc(loc_microp_st) !---------------------------------------------------------------------------- @@ -896,14 +878,14 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & integer, intent(in) :: pver ! number of mid-point vertical levels integer, intent(in) :: pverp ! number of interface vertical levels real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) - real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) + real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg) real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s) real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s) real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow - + real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s) @@ -965,7 +947,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & do k = 1, pver do i = 1, ncol -! Melt snow falling into layer, if necessary. +! Melt snow falling into layer, if necessary. if( old_snow ) then if (t(i,k) > zm_const%tfreez) then flxsntm(i) = 0._r8 @@ -1045,7 +1027,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & ! net snow production is precip production * ice fraction - evaporation - melting !pjrworks ntsnprd(i,k) = prdprec(i,k)*fice(i,k) - evpsnow(i) - snowmlt(i) !pjrwrks2 ntsnprd(i,k) = prdprec(i,k)*fsnow_conv(i,k) - evpsnow(i) - snowmlt(i) -! the small amount added to flxprec in the work1 expression has been increased from +! the small amount added to flxprec in the work1 expression has been increased from ! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning ! scheme to be used for small flxprec amounts. This is to address error growth problems. @@ -1081,7 +1063,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & ! more protection (pjr) ! flxsnow(i,k+1) = min(flxsnow(i,k+1), flxprec(i,k+1)) -! heating (cooling) and moistening due to evaporation +! heating (cooling) and moistening due to evaporation ! - latent heat of vaporization for precip production has already been accounted for ! - snow is contained in prec if( old_snow ) then @@ -1139,15 +1121,15 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & qcde ,qide ,qsde ,ncde ,nide ,nsde , & dsfm ,dsfn ,loc_microp_st ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: ! may 09/91 - guang jun zhang, m.lazare, n.mcfarlane. ! original version cldprop. -! +! ! Author: See above, modified by P. Rasch ! This is contributed code not fully standardized by the CCM core group. ! @@ -1290,7 +1272,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & real(r8) frz1(pcols,pver) ! rate of freezing real(r8) frz (pcols,pver) ! rate of freezing real(r8) pflxs(pcols,pverp) ! frozen precipitation flux thru layer - real(r8) dum, sdum + real(r8) dum, sdum real(r8), parameter :: omsm=0.99999_r8 ! to prevent problems due to round off error real(r8), parameter :: mu_min = 0.02_r8 ! minimum value of mu @@ -1315,82 +1297,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & !------------------------------------------------------------------------------ dsfm (:il2g,:) = 0._r8 dsfn (:il2g,:) = 0._r8 - if (zm_param%zm_microp) then - loc_microp_st%autolm(:il2g,:) = 0._r8 - loc_microp_st%accrlm(:il2g,:) = 0._r8 - loc_microp_st%bergnm(:il2g,:) = 0._r8 - loc_microp_st%fhtimm(:il2g,:) = 0._r8 - loc_microp_st%fhtctm(:il2g,:) = 0._r8 - loc_microp_st%fhmlm (:il2g,:) = 0._r8 - loc_microp_st%hmpim (:il2g,:) = 0._r8 - loc_microp_st%accslm(:il2g,:) = 0._r8 - loc_microp_st%dlfm (:il2g,:) = 0._r8 - - loc_microp_st%autoln(:il2g,:) = 0._r8 - loc_microp_st%accrln(:il2g,:) = 0._r8 - loc_microp_st%bergnn(:il2g,:) = 0._r8 - loc_microp_st%fhtimn(:il2g,:) = 0._r8 - loc_microp_st%fhtctn(:il2g,:) = 0._r8 - loc_microp_st%fhmln (:il2g,:) = 0._r8 - loc_microp_st%accsln(:il2g,:) = 0._r8 - loc_microp_st%activn(:il2g,:) = 0._r8 - loc_microp_st%dlfn (:il2g,:) = 0._r8 - - loc_microp_st%autoim(:il2g,:) = 0._r8 - loc_microp_st%accsim(:il2g,:) = 0._r8 - loc_microp_st%difm (:il2g,:) = 0._r8 - - - loc_microp_st%nuclin(:il2g,:) = 0._r8 - loc_microp_st%autoin(:il2g,:) = 0._r8 - loc_microp_st%accsin(:il2g,:) = 0._r8 - loc_microp_st%hmpin (:il2g,:) = 0._r8 - loc_microp_st%difn (:il2g,:) = 0._r8 - - loc_microp_st%trspcm(:il2g,:) = 0._r8 - loc_microp_st%trspcn(:il2g,:) = 0._r8 - loc_microp_st%trspim(:il2g,:) = 0._r8 - loc_microp_st%trspin(:il2g,:) = 0._r8 - do k = 1,pver - do i = 1,il2g - loc_microp_st%accgrm(i,k) = 0._r8 - loc_microp_st%accglm(i,k) = 0._r8 - loc_microp_st%accgslm(i,k)= 0._r8 - loc_microp_st%accgsrm(i,k)= 0._r8 - loc_microp_st%accgirm(i,k)= 0._r8 - loc_microp_st%accgrim(i,k)= 0._r8 - loc_microp_st%accgrsm(i,k)= 0._r8 - - loc_microp_st%accgsln(i,k)= 0._r8 - loc_microp_st%accgsrn(i,k)= 0._r8 - loc_microp_st%accgirn(i,k)= 0._r8 - - loc_microp_st%accsrim(i,k)= 0._r8 - loc_microp_st%acciglm(i,k)= 0._r8 - loc_microp_st%accigrm(i,k)= 0._r8 - loc_microp_st%accsirm(i,k)= 0._r8 - - loc_microp_st%accigln(i,k)= 0._r8 - loc_microp_st%accigrn(i,k)= 0._r8 - loc_microp_st%accsirn(i,k)= 0._r8 - loc_microp_st%accgln(i,k) = 0._r8 - loc_microp_st%accgrn(i,k) = 0._r8 - - loc_microp_st%accilm(i,k) = 0._r8 - loc_microp_st%acciln(i,k) = 0._r8 - - loc_microp_st%fallrm(i,k) = 0._r8 - loc_microp_st%fallsm(i,k) = 0._r8 - loc_microp_st%fallgm(i,k) = 0._r8 - loc_microp_st%fallrn(i,k) = 0._r8 - loc_microp_st%fallsn(i,k) = 0._r8 - loc_microp_st%fallgn(i,k) = 0._r8 - loc_microp_st%fhmrm (i,k) = 0._r8 - end do - end do - end if -! do i = 1,il2g ftemp(i) = 0._r8 expnum(i) = 0._r8 @@ -1458,19 +1365,19 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & frz(i,k) = 0._r8 frz1(i,k) = 0._r8 if (zm_param%zm_microp) then - loc_microp_st%cmel(i,k) = 0._r8 - loc_microp_st%cmei(i,k) = 0._r8 - loc_microp_st%wu(i,k) = 0._r8 - loc_microp_st%qliq(i,k) = 0._r8 - loc_microp_st%qice(i,k) = 0._r8 - loc_microp_st%qrain(i,k)= 0._r8 - loc_microp_st%qsnow(i,k)= 0._r8 + loc_microp_st%cmel(i,k) = 0._r8 + loc_microp_st%cmei(i,k) = 0._r8 + loc_microp_st%wu(i,k) = 0._r8 + loc_microp_st%qliq(i,k) = 0._r8 + loc_microp_st%qice(i,k) = 0._r8 + loc_microp_st%qrain(i,k) = 0._r8 + loc_microp_st%qsnow(i,k) = 0._r8 loc_microp_st%qgraupel(i,k) = 0._r8 - loc_microp_st%qnl(i,k) = 0._r8 - loc_microp_st%qni(i,k) = 0._r8 - loc_microp_st%qnr(i,k) = 0._r8 - loc_microp_st%qns(i,k) = 0._r8 - loc_microp_st%qng(i,k) = 0._r8 + loc_microp_st%qnl(i,k) = 0._r8 + loc_microp_st%qni(i,k) = 0._r8 + loc_microp_st%qnr(i,k) = 0._r8 + loc_microp_st%qns(i,k) = 0._r8 + loc_microp_st%qng(i,k) = 0._r8 end if end do end do @@ -1518,7 +1425,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & !jr changed hard-wired 4 to limcnv+1 (not to exceed pver) ! jt(:) = pver - jto(:)= pver + jto(:)= pver do i = 1,il2g jt(i) = max(lel(i),limcnv+1) jt(i) = min(jt(i),pver) @@ -1552,13 +1459,13 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & do k = msg + 1,pver do i = 1,il2g if (k >= jt(i) .and. k <= jb(i)) then - ! Tunable temperature perturbation (tiedke_add) was already added to parcel hu/su to + ! Tunable temperature perturbation (tiedke_add) was already added to parcel hu/su to ! represent subgrid temperature perturbation. If PBL temperature perturbation (tpert) - ! is used to represent subgrid temperature perturbation, tiedke_add may need to be - ! removed. In addition, current calculation of PBL temperature perturbation is not + ! is used to represent subgrid temperature perturbation, tiedke_add may need to be + ! removed. In addition, current calculation of PBL temperature perturbation is not ! accurate enough so that a new tunable parameter tpert_fac was introduced. This introduced - ! new uncertainties into the ZM scheme. The original code of ZM scheme will be used - ! when tpert_fix=.true. + ! new uncertainties into the ZM scheme. The original code of ZM scheme will be used + ! when tpert_fix=.true. if(zm_param%tpert_fix) then hu(i,k) = hmn(i,mx(i)) + zm_const%cpair*zm_param%tiedke_add su(i,k) = s(i,mx(i)) + zm_param%tiedke_add @@ -1645,9 +1552,11 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & eps0(i) = f(i,j0(i)) eps(i,jb(i)) = eps0(i) end do -! -! This is set to match the Rasch and Kristjansson paper -! + + ! This is set to match: + ! Rasch, P. J., J. E. Kristjánsson, A comparison of the CCM3 model climate + ! using diagnosed and predicted condensate parameterizations, J. Clim., 1997. + do k = pver,msg + 1,-1 do i = 1,il2g if (k >= j0(i) .and. k <= jb(i)) then @@ -1888,10 +1797,10 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & end do #ifndef SCREAM_CONFIG_IS_CMAKE - call zm_mphy(su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, zf, p, & + call zm_mphy(su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, zf, p, & t, q, eps0, jb, jt, jlcl, msg, il2g, zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & - qcde, qide, ncde, nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & + qcde, qide, ncde, nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, & loc_microp_st%qng, qsde, nsde, loc_microp_st%autolm, loc_microp_st%accrlm, & loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, & @@ -1909,17 +1818,17 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%accsirn,loc_microp_st%accgln ,loc_microp_st%accgrn ,loc_microp_st%accilm , & loc_microp_st%acciln ,loc_microp_st%fallrm ,loc_microp_st%fallsm ,loc_microp_st%fallgm , & loc_microp_st%fallrn ,loc_microp_st%fallsn ,loc_microp_st%fallgn ,loc_microp_st%fhmrm , & - dsfm, dsfn, zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) + dsfm, dsfn, zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) #endif do k = pver,msg + 2,-1 do i = 1,il2g - ! In the original ZM scheme, which does not consider ice phase, ql actually represents total cloud + ! In the original ZM scheme, which does not consider ice phase, ql actually represents total cloud ! water. With convective microphysics, loc_microp_st%qliq and loc_microp_st%qice represent cloud ! liquid water and cloud ice, respectively. Since ql is still used in other subroutines as total - ! cloud water, here ql is calculated as total cloud water for consistency. + ! cloud water, here ql is calculated as total cloud water for consistency. ql(i,k) = loc_microp_st%qliq(i,k)+ loc_microp_st%qice(i,k) - frz1(i,k) = frz(i,k) + frz1(i,k) = frz(i,k) end do end do @@ -2118,7 +2027,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & end if end do end if - end do + end do end if do k = msg + 1,pver @@ -2129,7 +2038,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! do i = 1,il2g if ( zm_param%zm_microp .and. jt(i)>=jlcl(i)) then - do k = msg + 1,pver + do k = msg + 1,pver mu(i,k) = 0._r8 eu(i,k) = 0._r8 du(i,k) = 0._r8 @@ -2150,7 +2059,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & nsde(i,k) = 0._r8 frz(i,k) = 0._r8 frz1(i,k) = 0._r8 - loc_microp_st%wu(i,k) = 0._r8 + loc_microp_st%wu(i,k) = 0._r8 loc_microp_st%cmel(i,k) = 0._r8 loc_microp_st%cmei(i,k) = 0._r8 loc_microp_st%qliq(i,k) = 0._r8 @@ -2165,7 +2074,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%qng(i,k) = 0._r8 end do end if - end do + end do return end subroutine cldprp @@ -2179,15 +2088,15 @@ subroutine closure(zm_const, pcols, ncol, pver, pverp, & ql ,dsubcld ,mb ,cape ,tl , & lcl ,lel ,jt ,mx ,il1g , & il2g ,msg ,capelmt ) -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! +!----------------------------------------------------------------------- +! +! Purpose: +! +! +! Method: +! +! +! ! Author: G. Zhang and collaborators. CCM contact:P. Rasch ! This is contributed code not fully standardized by the CCM core group. ! @@ -2195,7 +2104,7 @@ subroutine closure(zm_const, pcols, ncol, pver, pverp, & ! We expect to release cleaner code in a future release ! ! the documentation has been enhanced to the degree that we are able -! +! !----------------------------------------------------------------------- implicit none @@ -2391,26 +2300,19 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,ql , & dsubcld ,jt ,mx ,il1g ,il2g , msg, & - dl ,evp ,cu ,qice ,dice , & - qnl ,qni ,dnl ,dni ,frz , & - qsde ,nsde ,dsnow ,dns ) - + dl ,evp ,cu ,qice ,& + qnl ,& + qni ,& + frz , & + qsde ,& + nsde ,& + loc_microp_st) + !---------------------------------------------------------------------------- + ! Purpose: initialize quantities for ZM convection scheme + !---------------------------------------------------------------------------- implicit none - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: phil rasch dec 19 1995 -! -!----------------------------------------------------------------------- - - + !---------------------------------------------------------------------------- + ! Arguments type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants integer, intent(in) :: pcols ! maximum number of columns integer, intent(in) :: ncol ! actual number of columns @@ -2448,42 +2350,31 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) real(r8),intent(out) :: dl(pcols,pver) - ! Convective microphysics - real(r8),intent(out) :: dice(pcols,pver) - real(r8),intent(out) :: dnl(pcols,pver) - real(r8),intent(out) :: dni(pcols,pver) - real(r8),intent(out) :: dsnow(pcols,pver) - real(r8),intent(out) :: dns(pcols,pver) - - + type(zm_microp_st), intent(inout) :: loc_microp_st ! convective microphysics state and tendencies + !---------------------------------------------------------------------------- + ! Local variables + integer i,k integer kbm integer ktm integer jt(pcols) integer mx(pcols) -! -! work fields: -! - integer i - integer k - real(r8) emc -!------------------------------------------------------------------- + !---------------------------------------------------------------------------- do k = msg + 1,pver do i = il1g,il2g dsdt(i,k) = 0._r8 dqdt(i,k) = 0._r8 dl(i,k) = 0._r8 ! Convective microphysics - dice(i,k) = 0._r8 - dnl(i,k) = 0._r8 - dni(i,k) = 0._r8 - dsnow(i,k) = 0._r8 - dns(i,k) = 0._r8 + loc_microp_st%dif(i,k) = 0._r8 + loc_microp_st%dsf(i,k) = 0._r8 + loc_microp_st%dnlf(i,k) = 0._r8 + loc_microp_st%dnif(i,k) = 0._r8 + loc_microp_st%dnsf(i,k) = 0._r8 end do end do -! -! find the highest level top and bottom levels of convection -! + + ! find the highest level top and bottom levels of convection ktm = pver kbm = pver do i = il1g, il2g @@ -2493,8 +2384,7 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & do k = ktm,pver-1 do i = il1g,il2g - emc = -cu (i,k) & ! condensation in updraft - +evp(i,k) ! evaporating rain in downdraft + emc = -cu(i,k) + evp(i,k) ! condensation in updraft and evaporating rain in downdraft dsdt(i,k) = -zm_const%latvap/zm_const%cpair*emc & + (+mu(i,k+1)* (su(i,k+1)-shat(i,k+1)) & @@ -2514,11 +2404,11 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & dl(i,k) = du(i,k)*ql(i,k+1) if (zm_param%zm_microp) then - dice(i,k) = du(i,k)*qice(i,k+1) - dnl(i,k) = du(i,k)*qnl(i,k+1) - dni(i,k) = du(i,k)*qni(i,k+1) - dsnow(i,k) = du(i,k)*qsde(i,k+1) - dns(i,k) = du(i,k)*nsde(i,k+1) + loc_microp_st%dif(i,k) = du(i,k)*qice(i,k+1) + loc_microp_st%dnlf(i,k) = du(i,k)*qnl(i,k+1) + loc_microp_st%dnif(i,k) = du(i,k)*qni(i,k+1) + loc_microp_st%dsf(i,k) = du(i,k)*qsde(i,k+1) + loc_microp_st%dnsf(i,k) = du(i,k)*nsde(i,k+1) end if end do diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 42e16eb7f7f5..e9189580cfc6 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -597,12 +597,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call pbuf_get_field(pbuf, dnsfzm_idx, dnsf) call pbuf_get_field(pbuf, wuc_idx, wuc) wuc(1:pcols,1:pver) = 0 - else - allocate(dnlf(pcols,pver), & - dnif(pcols,pver), & - dsf(pcols,pver), & - dnsf(pcols,pver), & - wuc(pcols,pver) ) end if call pbuf_get_field(pbuf, lambdadpcu_idx, lambdadpcu) @@ -644,15 +638,18 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - qi, rice, sprd, dif, dsf, dnlf, dnif, dnsf, frz, & - mudpcu, lambdadpcu ) + qi, sprd, frz, mudpcu, lambdadpcu ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then - microp_st%dif (1:ncol,1:pver) = dif (1:ncol,1:pver) - microp_st%dsf (1:ncol,1:pver) = dsf (1:ncol,1:pver) - microp_st%dnlf(1:ncol,1:pver) = dnlf(1:ncol,1:pver) - microp_st%dnif(1:ncol,1:pver) = dnif(1:ncol,1:pver) + ! update ZM micro variables in pbuf + dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) + dsf (1:ncol,1:pver) = microp_st%dsf (1:ncol,1:pver) + dnlf(1:ncol,1:pver) = microp_st%dnlf(1:ncol,1:pver) + dnif(1:ncol,1:pver) = microp_st%dnif(1:ncol,1:pver) + dnsf(1:ncol,1:pver) = microp_st%dnsf(1:ncol,1:pver) + ! update other micro variables + rice(1:ncol) = microp_st%rice(1:ncol) microp_st%frz (1:ncol,1:pver) = frz (1:ncol,1:pver) dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) wuc(1:pcols,1:pver) = microp_st%wu(1:pcols,1:pver) @@ -882,11 +879,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call physics_state_dealloc(state1) call physics_ptend_dealloc(ptend_loc) - if (zm_param%zm_microp) then - call zm_microp_st_dealloc(microp_st) - else - deallocate(dnlf, dnif, dsf, dnsf) - end if + if (zm_param%zm_microp) call zm_microp_st_dealloc(microp_st) end subroutine zm_conv_tend diff --git a/components/eam/src/physics/cam/zm_microphysics_state.F90 b/components/eam/src/physics/cam/zm_microphysics_state.F90 index 80f5a64ae91f..60917a8bbb63 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -19,82 +19,87 @@ module zm_microphysics_state !=================================================================================================== type :: zm_microp_st - real(r8), allocatable, dimension(:,:) :: wu ! vertical velocity - real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water - real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice - real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water - real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow - real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel - real(r8), allocatable, dimension(:,:) :: qnl ! convective cloud liquid water num concen. - real(r8), allocatable, dimension(:,:) :: qni ! convective cloud ice num concen. - real(r8), allocatable, dimension(:,:) :: qnr ! convective rain water num concen. - real(r8), allocatable, dimension(:,:) :: qns ! convective snow num concen. - real(r8), allocatable, dimension(:,:) :: qng ! convective graupel num concen. - real(r8), allocatable, dimension(:,:) :: dif ! detrainment of cloud ice water mixing ratio - real(r8), allocatable, dimension(:,:) :: dsf ! detrained convective snow mixing ratio - real(r8), allocatable, dimension(:,:) :: dnlf ! detrainment of conv cld liq water num concen - real(r8), allocatable, dimension(:,:) :: dnif ! detrainment of conv cld ice num concen - real(r8), allocatable, dimension(:,:) :: frz ! heating rate due to freezing - real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain - real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain - real(r8), allocatable, dimension(:,:) :: bergnm ! mass tendency due to Bergeron process - real(r8), allocatable, dimension(:,:) :: fhtimm ! mass tendency due to immersion freezing - real(r8), allocatable, dimension(:,:) :: fhtctm ! mass tendency due to contact freezing - real(r8), allocatable, dimension(:,:) :: fhmlm ! mass tendency due to homogeneous freezing - real(r8), allocatable, dimension(:,:) :: hmpim ! mass tendency due to HM process - real(r8), allocatable, dimension(:,:) :: accslm ! mass tendency due to accretion of droplets by snow - real(r8), allocatable, dimension(:,:) :: dlfm ! mass tendency due to detrainment of droplet - real(r8), allocatable, dimension(:,:) :: autoln ! num tendency due to autoconversion of droplets to rain - real(r8), allocatable, dimension(:,:) :: accrln ! num tendency due to accretion of droplets by rain - real(r8), allocatable, dimension(:,:) :: bergnn ! num tendency due to Bergeron process - real(r8), allocatable, dimension(:,:) :: fhtimn ! num tendency due to immersion freezing - real(r8), allocatable, dimension(:,:) :: fhtctn ! num tendency due to contact freezing - real(r8), allocatable, dimension(:,:) :: fhmln ! num tendency due to homogeneous freezing - real(r8), allocatable, dimension(:,:) :: accsln ! num tendency due to accretion of droplets by snow - real(r8), allocatable, dimension(:,:) :: activn ! num tendency due to droplets activation - real(r8), allocatable, dimension(:,:) :: dlfn ! num tendency due to detrainment of droplet - real(r8), allocatable, dimension(:,:) :: autoim ! mass tendency due to autoconversion of cloud ice to snow - real(r8), allocatable, dimension(:,:) :: accsim ! mass tendency due to accretion of cloud ice by snow - real(r8), allocatable, dimension(:,:) :: difm ! mass tendency due to detrainment of cloud ice - real(r8), allocatable, dimension(:,:) :: nuclin ! num tendency due to ice nucleation - real(r8), allocatable, dimension(:,:) :: autoin ! num tendency due to autoconversion of cloud ice to snow - real(r8), allocatable, dimension(:,:) :: accsin ! num tendency due to accretion of cloud ice by snow - real(r8), allocatable, dimension(:,:) :: hmpin ! num tendency due to HM process - real(r8), allocatable, dimension(:,:) :: difn ! num tendency due to detrainment of cloud ice - real(r8), allocatable, dimension(:,:) :: cmel ! mass tendency due to condensation - real(r8), allocatable, dimension(:,:) :: cmei ! mass tendency due to deposition - real(r8), allocatable, dimension(:,:) :: trspcm ! LWC tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspcn ! droplet num tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspim ! IWC tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: trspin ! ice crystal num tendency due to convective transport - real(r8), allocatable, dimension(:,:) :: accgrm ! mass tendency due to collection of rain by graupel - real(r8), allocatable, dimension(:,:) :: accglm ! mass tendency due to collection of droplets by graupel - real(r8), allocatable, dimension(:,:) :: accgslm ! mass tendency of graupel due to collection of droplets by snow - real(r8), allocatable, dimension(:,:) :: accgsrm ! mass tendency of graupel due to collection of rain by snow - real(r8), allocatable, dimension(:,:) :: accgirm ! mass tendency of graupel due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accgrim ! mass tendency of graupel due to collection of ice by rain - real(r8), allocatable, dimension(:,:) :: accgrsm ! mass tendency due to collection of snow by rain - real(r8), allocatable, dimension(:,:) :: accgsln ! num tendency of graupel due to collection of droplets by snow - real(r8), allocatable, dimension(:,:) :: accgsrn ! num tendency of graupel due to collection of rain by snow - real(r8), allocatable, dimension(:,:) :: accgirn ! num tendency of graupel due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accsrim ! mass tendency of snow due to collection of ice by rain - real(r8), allocatable, dimension(:,:) :: acciglm ! mass tendency of ice mult(splintering) due to acc droplets by graupel - real(r8), allocatable, dimension(:,:) :: accigrm ! mass tendency of ice mult(splintering) due to acc rain by graupel - real(r8), allocatable, dimension(:,:) :: accsirm ! mass tendency of snow due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accigln ! num tendency of ice mult(splintering) due to acc droplets by graupel - real(r8), allocatable, dimension(:,:) :: accigrn ! num tendency of ice mult(splintering) due to acc rain by graupel - real(r8), allocatable, dimension(:,:) :: accsirn ! num tendency of snow due to collection of rain by ice - real(r8), allocatable, dimension(:,:) :: accgln ! num tendency due to collection of droplets by graupel - real(r8), allocatable, dimension(:,:) :: accgrn ! num tendency due to collection of rain by graupel - real(r8), allocatable, dimension(:,:) :: accilm ! mass tendency of cloud ice due to collection of droplet by cloud ice - real(r8), allocatable, dimension(:,:) :: acciln ! number conc tendency of cloud ice due to collection of droplet by cloud ice - real(r8), allocatable, dimension(:,:) :: fallrm ! mass tendency of rain fallout - real(r8), allocatable, dimension(:,:) :: fallsm ! mass tendency of snow fallout - real(r8), allocatable, dimension(:,:) :: fallgm ! mass tendency of graupel fallout - real(r8), allocatable, dimension(:,:) :: fallrn ! num tendency of rain fallout - real(r8), allocatable, dimension(:,:) :: fallsn ! num tendency of snow fallout - real(r8), allocatable, dimension(:,:) :: fallgn ! num tendency of graupel fallout - real(r8), allocatable, dimension(:,:) :: fhmrm ! mass tendency due to homogeneous freezing of rain + real(r8), allocatable, dimension(:,:) :: wu ! vertical velocity + real(r8), allocatable, dimension(:,:) :: qliq ! convective cloud liquid water + real(r8), allocatable, dimension(:,:) :: qice ! convective cloud ice + real(r8), allocatable, dimension(:,:) :: qrain ! convective rain water + real(r8), allocatable, dimension(:,:) :: qsnow ! convective snow + real(r8), allocatable, dimension(:,:) :: qgraupel ! convective graupel + real(r8), allocatable, dimension(:,:) :: qnl ! convective cloud liquid water num concen. + real(r8), allocatable, dimension(:,:) :: qni ! convective cloud ice num concen. + real(r8), allocatable, dimension(:,:) :: qnr ! convective rain water num concen. + real(r8), allocatable, dimension(:,:) :: qns ! convective snow num concen. + real(r8), allocatable, dimension(:,:) :: qng ! convective graupel num concen. + real(r8), allocatable, dimension(:) :: rice ! reserved ice (not yet in cldce) for energy integrals + real(r8), allocatable, dimension(:,:) :: sprd ! snow production rate + real(r8), allocatable, dimension(:,:) :: mudpcu ! width parameter of droplet size distr + real(r8), allocatable, dimension(:,:) :: lambdadpcu ! slope of cloud liquid size distr + real(r8), allocatable, dimension(:,:) :: dif ! detrainment of cloud ice water mixing ratio + real(r8), allocatable, dimension(:,:) :: dsf ! detrained convective snow mixing ratio + real(r8), allocatable, dimension(:,:) :: dnlf ! detrainment of conv cld liq water num concen + real(r8), allocatable, dimension(:,:) :: dnif ! detrainment of conv cld ice num concen + real(r8), allocatable, dimension(:,:) :: dnsf ! detrained snow num concen + real(r8), allocatable, dimension(:,:) :: frz ! heating rate due to freezing + real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain + real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain + real(r8), allocatable, dimension(:,:) :: bergnm ! mass tendency due to Bergeron process + real(r8), allocatable, dimension(:,:) :: fhtimm ! mass tendency due to immersion freezing + real(r8), allocatable, dimension(:,:) :: fhtctm ! mass tendency due to contact freezing + real(r8), allocatable, dimension(:,:) :: fhmlm ! mass tendency due to homogeneous freezing + real(r8), allocatable, dimension(:,:) :: hmpim ! mass tendency due to HM process + real(r8), allocatable, dimension(:,:) :: accslm ! mass tendency due to accretion of droplets by snow + real(r8), allocatable, dimension(:,:) :: dlfm ! mass tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: autoln ! num tendency due to autoconversion of droplets to rain + real(r8), allocatable, dimension(:,:) :: accrln ! num tendency due to accretion of droplets by rain + real(r8), allocatable, dimension(:,:) :: bergnn ! num tendency due to Bergeron process + real(r8), allocatable, dimension(:,:) :: fhtimn ! num tendency due to immersion freezing + real(r8), allocatable, dimension(:,:) :: fhtctn ! num tendency due to contact freezing + real(r8), allocatable, dimension(:,:) :: fhmln ! num tendency due to homogeneous freezing + real(r8), allocatable, dimension(:,:) :: accsln ! num tendency due to accretion of droplets by snow + real(r8), allocatable, dimension(:,:) :: activn ! num tendency due to droplets activation + real(r8), allocatable, dimension(:,:) :: dlfn ! num tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: autoim ! mass tendency due to autoconversion of cloud ice to snow + real(r8), allocatable, dimension(:,:) :: accsim ! mass tendency due to accretion of cloud ice by snow + real(r8), allocatable, dimension(:,:) :: difm ! mass tendency due to detrainment of cloud ice + real(r8), allocatable, dimension(:,:) :: nuclin ! num tendency due to ice nucleation + real(r8), allocatable, dimension(:,:) :: autoin ! num tendency due to autoconversion of cloud ice to snow + real(r8), allocatable, dimension(:,:) :: accsin ! num tendency due to accretion of cloud ice by snow + real(r8), allocatable, dimension(:,:) :: hmpin ! num tendency due to HM process + real(r8), allocatable, dimension(:,:) :: difn ! num tendency due to detrainment of cloud ice + real(r8), allocatable, dimension(:,:) :: cmel ! mass tendency due to condensation + real(r8), allocatable, dimension(:,:) :: cmei ! mass tendency due to deposition + real(r8), allocatable, dimension(:,:) :: trspcm ! LWC tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspcn ! droplet num tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspim ! IWC tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: trspin ! ice crystal num tendency due to convective transport + real(r8), allocatable, dimension(:,:) :: accgrm ! mass tendency due to collection of rain by graupel + real(r8), allocatable, dimension(:,:) :: accglm ! mass tendency due to collection of droplets by graupel + real(r8), allocatable, dimension(:,:) :: accgslm ! mass tendency of graupel due to collection of droplets by snow + real(r8), allocatable, dimension(:,:) :: accgsrm ! mass tendency of graupel due to collection of rain by snow + real(r8), allocatable, dimension(:,:) :: accgirm ! mass tendency of graupel due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accgrim ! mass tendency of graupel due to collection of ice by rain + real(r8), allocatable, dimension(:,:) :: accgrsm ! mass tendency due to collection of snow by rain + real(r8), allocatable, dimension(:,:) :: accgsln ! num tendency of graupel due to collection of droplets by snow + real(r8), allocatable, dimension(:,:) :: accgsrn ! num tendency of graupel due to collection of rain by snow + real(r8), allocatable, dimension(:,:) :: accgirn ! num tendency of graupel due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accsrim ! mass tendency of snow due to collection of ice by rain + real(r8), allocatable, dimension(:,:) :: acciglm ! mass tendency of ice mult(splintering) due to acc droplets by graupel + real(r8), allocatable, dimension(:,:) :: accigrm ! mass tendency of ice mult(splintering) due to acc rain by graupel + real(r8), allocatable, dimension(:,:) :: accsirm ! mass tendency of snow due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accigln ! num tendency of ice mult(splintering) due to acc droplets by graupel + real(r8), allocatable, dimension(:,:) :: accigrn ! num tendency of ice mult(splintering) due to acc rain by graupel + real(r8), allocatable, dimension(:,:) :: accsirn ! num tendency of snow due to collection of rain by ice + real(r8), allocatable, dimension(:,:) :: accgln ! num tendency due to collection of droplets by graupel + real(r8), allocatable, dimension(:,:) :: accgrn ! num tendency due to collection of rain by graupel + real(r8), allocatable, dimension(:,:) :: accilm ! mass tendency of cloud ice due to collection of droplet by cloud ice + real(r8), allocatable, dimension(:,:) :: acciln ! number conc tendency of cloud ice due to collection of droplet by cloud ice + real(r8), allocatable, dimension(:,:) :: fallrm ! mass tendency of rain fallout + real(r8), allocatable, dimension(:,:) :: fallsm ! mass tendency of snow fallout + real(r8), allocatable, dimension(:,:) :: fallgm ! mass tendency of graupel fallout + real(r8), allocatable, dimension(:,:) :: fallrn ! num tendency of rain fallout + real(r8), allocatable, dimension(:,:) :: fallsn ! num tendency of snow fallout + real(r8), allocatable, dimension(:,:) :: fallgn ! num tendency of graupel fallout + real(r8), allocatable, dimension(:,:) :: fhmrm ! mass tendency due to homogeneous freezing of rain end type zm_microp_st !=================================================================================================== @@ -111,82 +116,87 @@ subroutine zm_microp_st_alloc(microp_st_in,ncol_in,nlev_in) integer, intent(in ) :: nlev_in ! number of atmospheric levels to allocate !---------------------------------------------------------------------------- allocate( & - microp_st_in%wu (ncol_in,nlev_in), & - microp_st_in%qliq (ncol_in,nlev_in), & - microp_st_in%qice (ncol_in,nlev_in), & - microp_st_in%qrain (ncol_in,nlev_in), & - microp_st_in%qsnow (ncol_in,nlev_in), & - microp_st_in%qgraupel (ncol_in,nlev_in), & - microp_st_in%qnl (ncol_in,nlev_in), & - microp_st_in%qni (ncol_in,nlev_in), & - microp_st_in%qnr (ncol_in,nlev_in), & - microp_st_in%qns (ncol_in,nlev_in), & - microp_st_in%qng (ncol_in,nlev_in), & - microp_st_in%dif (ncol_in,nlev_in), & - microp_st_in%dsf (ncol_in,nlev_in), & - microp_st_in%dnlf (ncol_in,nlev_in), & - microp_st_in%dnif (ncol_in,nlev_in), & - microp_st_in%frz (ncol_in,nlev_in), & - microp_st_in%autolm (ncol_in,nlev_in), & - microp_st_in%accrlm (ncol_in,nlev_in), & - microp_st_in%bergnm (ncol_in,nlev_in), & - microp_st_in%fhtimm (ncol_in,nlev_in), & - microp_st_in%fhtctm (ncol_in,nlev_in), & - microp_st_in%fhmlm (ncol_in,nlev_in), & - microp_st_in%hmpim (ncol_in,nlev_in), & - microp_st_in%accslm (ncol_in,nlev_in), & - microp_st_in%dlfm (ncol_in,nlev_in), & - microp_st_in%autoln (ncol_in,nlev_in), & - microp_st_in%accrln (ncol_in,nlev_in), & - microp_st_in%bergnn (ncol_in,nlev_in), & - microp_st_in%fhtimn (ncol_in,nlev_in), & - microp_st_in%fhtctn (ncol_in,nlev_in), & - microp_st_in%fhmln (ncol_in,nlev_in), & - microp_st_in%accsln (ncol_in,nlev_in), & - microp_st_in%activn (ncol_in,nlev_in), & - microp_st_in%dlfn (ncol_in,nlev_in), & - microp_st_in%autoim (ncol_in,nlev_in), & - microp_st_in%accsim (ncol_in,nlev_in), & - microp_st_in%difm (ncol_in,nlev_in), & - microp_st_in%nuclin (ncol_in,nlev_in), & - microp_st_in%autoin (ncol_in,nlev_in), & - microp_st_in%accsin (ncol_in,nlev_in), & - microp_st_in%hmpin (ncol_in,nlev_in), & - microp_st_in%difn (ncol_in,nlev_in), & - microp_st_in%cmel (ncol_in,nlev_in), & - microp_st_in%cmei (ncol_in,nlev_in), & - microp_st_in%trspcm (ncol_in,nlev_in), & - microp_st_in%trspcn (ncol_in,nlev_in), & - microp_st_in%trspim (ncol_in,nlev_in), & - microp_st_in%trspin (ncol_in,nlev_in), & - microp_st_in%accgrm (ncol_in,nlev_in), & - microp_st_in%accglm (ncol_in,nlev_in), & - microp_st_in%accgslm (ncol_in,nlev_in), & - microp_st_in%accgsrm (ncol_in,nlev_in), & - microp_st_in%accgirm (ncol_in,nlev_in), & - microp_st_in%accgrim (ncol_in,nlev_in), & - microp_st_in%accgrsm (ncol_in,nlev_in), & - microp_st_in%accgsln (ncol_in,nlev_in), & - microp_st_in%accgsrn (ncol_in,nlev_in), & - microp_st_in%accgirn (ncol_in,nlev_in), & - microp_st_in%accsrim (ncol_in,nlev_in), & - microp_st_in%acciglm (ncol_in,nlev_in), & - microp_st_in%accigrm (ncol_in,nlev_in), & - microp_st_in%accsirm (ncol_in,nlev_in), & - microp_st_in%accigln (ncol_in,nlev_in), & - microp_st_in%accigrn (ncol_in,nlev_in), & - microp_st_in%accsirn (ncol_in,nlev_in), & - microp_st_in%accgln (ncol_in,nlev_in), & - microp_st_in%accgrn (ncol_in,nlev_in), & - microp_st_in%accilm (ncol_in,nlev_in), & - microp_st_in%acciln (ncol_in,nlev_in), & - microp_st_in%fallrm (ncol_in,nlev_in), & - microp_st_in%fallsm (ncol_in,nlev_in), & - microp_st_in%fallgm (ncol_in,nlev_in), & - microp_st_in%fallrn (ncol_in,nlev_in), & - microp_st_in%fallsn (ncol_in,nlev_in), & - microp_st_in%fallgn (ncol_in,nlev_in), & - microp_st_in%fhmrm (ncol_in,nlev_in) ) + microp_st_in%wu (ncol_in,nlev_in), & + microp_st_in%qliq (ncol_in,nlev_in), & + microp_st_in%qice (ncol_in,nlev_in), & + microp_st_in%qrain (ncol_in,nlev_in), & + microp_st_in%qsnow (ncol_in,nlev_in), & + microp_st_in%qgraupel (ncol_in,nlev_in), & + microp_st_in%qnl (ncol_in,nlev_in), & + microp_st_in%qni (ncol_in,nlev_in), & + microp_st_in%qnr (ncol_in,nlev_in), & + microp_st_in%qns (ncol_in,nlev_in), & + microp_st_in%qng (ncol_in,nlev_in), & + microp_st_in%rice (ncol_in), & + microp_st_in%sprd (ncol_in,nlev_in), & + microp_st_in%mudpcu (ncol_in,nlev_in), & + microp_st_in%lambdadpcu (ncol_in,nlev_in), & + microp_st_in%dif (ncol_in,nlev_in), & + microp_st_in%dsf (ncol_in,nlev_in), & + microp_st_in%dnlf (ncol_in,nlev_in), & + microp_st_in%dnif (ncol_in,nlev_in), & + microp_st_in%dnsf (ncol_in,nlev_in), & + microp_st_in%frz (ncol_in,nlev_in), & + microp_st_in%autolm (ncol_in,nlev_in), & + microp_st_in%accrlm (ncol_in,nlev_in), & + microp_st_in%bergnm (ncol_in,nlev_in), & + microp_st_in%fhtimm (ncol_in,nlev_in), & + microp_st_in%fhtctm (ncol_in,nlev_in), & + microp_st_in%fhmlm (ncol_in,nlev_in), & + microp_st_in%hmpim (ncol_in,nlev_in), & + microp_st_in%accslm (ncol_in,nlev_in), & + microp_st_in%dlfm (ncol_in,nlev_in), & + microp_st_in%autoln (ncol_in,nlev_in), & + microp_st_in%accrln (ncol_in,nlev_in), & + microp_st_in%bergnn (ncol_in,nlev_in), & + microp_st_in%fhtimn (ncol_in,nlev_in), & + microp_st_in%fhtctn (ncol_in,nlev_in), & + microp_st_in%fhmln (ncol_in,nlev_in), & + microp_st_in%accsln (ncol_in,nlev_in), & + microp_st_in%activn (ncol_in,nlev_in), & + microp_st_in%dlfn (ncol_in,nlev_in), & + microp_st_in%autoim (ncol_in,nlev_in), & + microp_st_in%accsim (ncol_in,nlev_in), & + microp_st_in%difm (ncol_in,nlev_in), & + microp_st_in%nuclin (ncol_in,nlev_in), & + microp_st_in%autoin (ncol_in,nlev_in), & + microp_st_in%accsin (ncol_in,nlev_in), & + microp_st_in%hmpin (ncol_in,nlev_in), & + microp_st_in%difn (ncol_in,nlev_in), & + microp_st_in%cmel (ncol_in,nlev_in), & + microp_st_in%cmei (ncol_in,nlev_in), & + microp_st_in%trspcm (ncol_in,nlev_in), & + microp_st_in%trspcn (ncol_in,nlev_in), & + microp_st_in%trspim (ncol_in,nlev_in), & + microp_st_in%trspin (ncol_in,nlev_in), & + microp_st_in%accgrm (ncol_in,nlev_in), & + microp_st_in%accglm (ncol_in,nlev_in), & + microp_st_in%accgslm (ncol_in,nlev_in), & + microp_st_in%accgsrm (ncol_in,nlev_in), & + microp_st_in%accgirm (ncol_in,nlev_in), & + microp_st_in%accgrim (ncol_in,nlev_in), & + microp_st_in%accgrsm (ncol_in,nlev_in), & + microp_st_in%accgsln (ncol_in,nlev_in), & + microp_st_in%accgsrn (ncol_in,nlev_in), & + microp_st_in%accgirn (ncol_in,nlev_in), & + microp_st_in%accsrim (ncol_in,nlev_in), & + microp_st_in%acciglm (ncol_in,nlev_in), & + microp_st_in%accigrm (ncol_in,nlev_in), & + microp_st_in%accsirm (ncol_in,nlev_in), & + microp_st_in%accigln (ncol_in,nlev_in), & + microp_st_in%accigrn (ncol_in,nlev_in), & + microp_st_in%accsirn (ncol_in,nlev_in), & + microp_st_in%accgln (ncol_in,nlev_in), & + microp_st_in%accgrn (ncol_in,nlev_in), & + microp_st_in%accilm (ncol_in,nlev_in), & + microp_st_in%acciln (ncol_in,nlev_in), & + microp_st_in%fallrm (ncol_in,nlev_in), & + microp_st_in%fallsm (ncol_in,nlev_in), & + microp_st_in%fallgm (ncol_in,nlev_in), & + microp_st_in%fallrn (ncol_in,nlev_in), & + microp_st_in%fallsn (ncol_in,nlev_in), & + microp_st_in%fallgn (ncol_in,nlev_in), & + microp_st_in%fhmrm (ncol_in,nlev_in) ) end subroutine zm_microp_st_alloc @@ -200,81 +210,86 @@ subroutine zm_microp_st_dealloc(microp_st_in) type(zm_microp_st) :: microp_st_in ! state and tendency of convective microphysics !---------------------------------------------------------------------------- deallocate( & - microp_st_in%wu, & - microp_st_in%qliq, & - microp_st_in%qice, & - microp_st_in%qrain, & - microp_st_in%qsnow, & - microp_st_in%qgraupel, & - microp_st_in%qnl, & - microp_st_in%qni, & - microp_st_in%qnr, & - microp_st_in%qns, & - microp_st_in%qng, & - microp_st_in%dif, & - microp_st_in%dsf, & - microp_st_in%dnlf, & - microp_st_in%dnif, & - microp_st_in%frz, & - microp_st_in%autolm, & - microp_st_in%accrlm, & - microp_st_in%bergnm, & - microp_st_in%fhtimm, & - microp_st_in%fhtctm, & - microp_st_in%fhmlm , & - microp_st_in%hmpim , & - microp_st_in%accslm, & - microp_st_in%dlfm , & - microp_st_in%autoln, & - microp_st_in%accrln, & - microp_st_in%bergnn, & - microp_st_in%fhtimn, & - microp_st_in%fhtctn, & - microp_st_in%fhmln , & - microp_st_in%accsln, & - microp_st_in%activn, & - microp_st_in%dlfn , & - microp_st_in%autoim, & - microp_st_in%accsim, & - microp_st_in%difm , & - microp_st_in%nuclin, & - microp_st_in%autoin, & - microp_st_in%accsin, & - microp_st_in%hmpin, & - microp_st_in%difn, & - microp_st_in%cmel, & - microp_st_in%cmei, & - microp_st_in%trspcm, & - microp_st_in%trspcn, & - microp_st_in%trspim, & - microp_st_in%trspin, & - microp_st_in%accgrm, & - microp_st_in%accglm, & - microp_st_in%accgslm, & - microp_st_in%accgsrm, & - microp_st_in%accgirm, & - microp_st_in%accgrim, & - microp_st_in%accgrsm, & - microp_st_in%accgsln, & - microp_st_in%accgsrn, & - microp_st_in%accgirn, & - microp_st_in%accsrim, & - microp_st_in%acciglm, & - microp_st_in%accigrm, & - microp_st_in%accsirm, & - microp_st_in%accigln, & - microp_st_in%accigrn, & - microp_st_in%accsirn, & - microp_st_in%accgln, & - microp_st_in%accgrn, & - microp_st_in%accilm, & - microp_st_in%acciln, & - microp_st_in%fallrm, & - microp_st_in%fallsm, & - microp_st_in%fallgm, & - microp_st_in%fallrn, & - microp_st_in%fallsn, & - microp_st_in%fallgn, & + microp_st_in%wu, & + microp_st_in%qliq, & + microp_st_in%qice, & + microp_st_in%qrain, & + microp_st_in%qsnow, & + microp_st_in%qgraupel, & + microp_st_in%qnl, & + microp_st_in%qni, & + microp_st_in%qnr, & + microp_st_in%qns, & + microp_st_in%qng, & + microp_st_in%rice, & + microp_st_in%sprd, & + microp_st_in%mudpcu, & + microp_st_in%lambdadpcu,& + microp_st_in%dif, & + microp_st_in%dsf, & + microp_st_in%dnlf, & + microp_st_in%dnif, & + microp_st_in%dnsf, & + microp_st_in%frz, & + microp_st_in%autolm, & + microp_st_in%accrlm, & + microp_st_in%bergnm, & + microp_st_in%fhtimm, & + microp_st_in%fhtctm, & + microp_st_in%fhmlm , & + microp_st_in%hmpim , & + microp_st_in%accslm, & + microp_st_in%dlfm , & + microp_st_in%autoln, & + microp_st_in%accrln, & + microp_st_in%bergnn, & + microp_st_in%fhtimn, & + microp_st_in%fhtctn, & + microp_st_in%fhmln , & + microp_st_in%accsln, & + microp_st_in%activn, & + microp_st_in%dlfn , & + microp_st_in%autoim, & + microp_st_in%accsim, & + microp_st_in%difm , & + microp_st_in%nuclin, & + microp_st_in%autoin, & + microp_st_in%accsin, & + microp_st_in%hmpin, & + microp_st_in%difn, & + microp_st_in%cmel, & + microp_st_in%cmei, & + microp_st_in%trspcm, & + microp_st_in%trspcn, & + microp_st_in%trspim, & + microp_st_in%trspin, & + microp_st_in%accgrm, & + microp_st_in%accglm, & + microp_st_in%accgslm, & + microp_st_in%accgsrm, & + microp_st_in%accgirm, & + microp_st_in%accgrim, & + microp_st_in%accgrsm, & + microp_st_in%accgsln, & + microp_st_in%accgsrn, & + microp_st_in%accgirn, & + microp_st_in%accsrim, & + microp_st_in%acciglm, & + microp_st_in%accigrm, & + microp_st_in%accsirm, & + microp_st_in%accigln, & + microp_st_in%accigrn, & + microp_st_in%accsirn, & + microp_st_in%accgln, & + microp_st_in%accgrn, & + microp_st_in%accilm, & + microp_st_in%acciln, & + microp_st_in%fallrm, & + microp_st_in%fallsm, & + microp_st_in%fallgm, & + microp_st_in%fallrn, & + microp_st_in%fallsn, & + microp_st_in%fallgn, & microp_st_in%fhmrm ) end subroutine zm_microp_st_dealloc @@ -290,82 +305,87 @@ subroutine zm_microp_st_ini(microp_st_in,ncol_in,nlev_in) integer, intent(in ) :: ncol_in ! number of atmospheric columns to initialize integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize !---------------------------------------------------------------------------- - microp_st_in%wu (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qliq (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qice (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qrain (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qsnow (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qgraupel (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qnl (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qni (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qnr (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qns (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qng (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dif (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dsf (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dnlf (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dnif (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%frz (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autolm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accrlm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmlm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accslm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accrln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%activn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%cmel (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%difm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%cmei (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%nuclin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%difn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accglm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgslm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrsm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsrim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%acciglm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accilm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%acciln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%wu (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qliq (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qice (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qrain (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qsnow (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qgraupel (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qnl (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qni (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qnr (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qns (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%qng (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%rice (1:ncol_in) = 0._r8 + microp_st_in%sprd (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%mudpcu (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%lambdadpcu(1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dif (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dsf (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dnlf (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dnif (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dnsf (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%frz (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autolm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accrlm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmlm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accslm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accrln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%activn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%cmel (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%difm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%cmei (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%nuclin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%autoin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%difn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%trspin (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accglm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgslm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrsm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsrim (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%acciglm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%accilm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%acciln (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgm (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgn (1:ncol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmrm (1:ncol_in,1:nlev_in) = 0._r8 end subroutine zm_microp_st_ini !=================================================================================================== @@ -379,82 +399,87 @@ subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) integer, intent(in ) :: icol_in ! atmospheric column index integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize !---------------------------------------------------------------------------- - microp_st_in%wu (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qliq (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qice (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qrain (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qsnow (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qgraupel (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qnl (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qni (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qnr (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qns (icol_in,1:nlev_in) = 0._r8 - microp_st_in%qng (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dif (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dsf (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dnlf (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dnif (icol_in,1:nlev_in) = 0._r8 - microp_st_in%frz (icol_in,1:nlev_in) = 0._r8 - microp_st_in%autolm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accrlm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmlm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accslm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%autoln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accrln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%activn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%cmel (icol_in,1:nlev_in) = 0._r8 - microp_st_in%autoim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%difm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%cmei (icol_in,1:nlev_in) = 0._r8 - microp_st_in%nuclin (icol_in,1:nlev_in) = 0._r8 - microp_st_in%autoin (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsin (icol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpin (icol_in,1:nlev_in) = 0._r8 - microp_st_in%difn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%trspim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%trspin (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accglm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgslm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrsm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsrim (icol_in,1:nlev_in) = 0._r8 - microp_st_in%acciglm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accigln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%accilm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%acciln (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgm (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgn (icol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%wu (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qliq (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qice (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qrain (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qsnow (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qgraupel (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qnl (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qni (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qnr (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qns (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qng (icol_in,1:nlev_in) = 0._r8 + microp_st_in%rice (icol_in) = 0._r8 + microp_st_in%sprd (icol_in,1:nlev_in) = 0._r8 + microp_st_in%mudpcu (icol_in,1:nlev_in) = 0._r8 + microp_st_in%lambdadpcu(icol_in,1:nlev_in) = 0._r8 + microp_st_in%dif (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dsf (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dnlf (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dnif (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dnsf (icol_in,1:nlev_in) = 0._r8 + microp_st_in%frz (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autolm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accrlm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmlm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accslm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accrln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%bergnn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtimn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhtctn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%activn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dlfn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%cmel (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%difm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%cmei (icol_in,1:nlev_in) = 0._r8 + microp_st_in%nuclin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%autoin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%hmpin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%difn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspcn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%trspin (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accglm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgslm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrsm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgsrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgirn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsrim (icol_in,1:nlev_in) = 0._r8 + microp_st_in%acciglm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accigrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accsirn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accgrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%accilm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%acciln (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallrn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallsn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fallgn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%fhmrm (icol_in,1:nlev_in) = 0._r8 end subroutine zm_microp_st_zero !=================================================================================================== @@ -473,84 +498,89 @@ subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_i !---------------------------------------------------------------------------- integer :: i,k !---------------------------------------------------------------------------- - do k = 1,nlev_in - do i = 1,lengath - microp_st_out%wu (ideep(i),k) = microp_st_gth%wu (i,k) - microp_st_out%qliq (ideep(i),k) = microp_st_gth%qliq (i,k) - microp_st_out%qice (ideep(i),k) = microp_st_gth%qice (i,k) - microp_st_out%qrain (ideep(i),k) = microp_st_gth%qrain (i,k) - microp_st_out%qsnow (ideep(i),k) = microp_st_gth%qsnow (i,k) - microp_st_out%qgraupel (ideep(i),k) = microp_st_gth%qgraupel (i,k) - microp_st_out%qnl (ideep(i),k) = microp_st_gth%qnl (i,k) - microp_st_out%qni (ideep(i),k) = microp_st_gth%qni (i,k) - microp_st_out%qnr (ideep(i),k) = microp_st_gth%qnr (i,k) - microp_st_out%qns (ideep(i),k) = microp_st_gth%qns (i,k) - microp_st_out%qng (ideep(i),k) = microp_st_gth%qng (i,k) - microp_st_out%dif (ideep(i),k) = microp_st_gth%dif (i,k) - microp_st_out%dsf (ideep(i),k) = microp_st_gth%dsf (i,k) - microp_st_out%dnlf (ideep(i),k) = microp_st_gth%dnlf (i,k) - microp_st_out%dnif (ideep(i),k) = microp_st_gth%dnif (i,k) - microp_st_out%frz (ideep(i),k) = microp_st_gth%frz (i,k) - microp_st_out%autolm (ideep(i),k) = microp_st_gth%autolm (i,k) - microp_st_out%accrlm (ideep(i),k) = microp_st_gth%accrlm (i,k) - microp_st_out%bergnm (ideep(i),k) = microp_st_gth%bergnm (i,k) - microp_st_out%fhtimm (ideep(i),k) = microp_st_gth%fhtimm (i,k) - microp_st_out%fhtctm (ideep(i),k) = microp_st_gth%fhtctm (i,k) - microp_st_out%fhmlm (ideep(i),k) = microp_st_gth%fhmlm (i,k) - microp_st_out%hmpim (ideep(i),k) = microp_st_gth%hmpim (i,k) - microp_st_out%accslm (ideep(i),k) = microp_st_gth%accslm (i,k) - microp_st_out%dlfm (ideep(i),k) = microp_st_gth%dlfm (i,k) - microp_st_out%autoln (ideep(i),k) = microp_st_gth%autoln (i,k) - microp_st_out%accrln (ideep(i),k) = microp_st_gth%accrln (i,k) - microp_st_out%bergnn (ideep(i),k) = microp_st_gth%bergnn (i,k) - microp_st_out%fhtimn (ideep(i),k) = microp_st_gth%fhtimn (i,k) - microp_st_out%fhtctn (ideep(i),k) = microp_st_gth%fhtctn (i,k) - microp_st_out%fhmln (ideep(i),k) = microp_st_gth%fhmln (i,k) - microp_st_out%accsln (ideep(i),k) = microp_st_gth%accsln (i,k) - microp_st_out%activn (ideep(i),k) = microp_st_gth%activn (i,k) - microp_st_out%dlfn (ideep(i),k) = microp_st_gth%dlfn (i,k) - microp_st_out%cmel (ideep(i),k) = microp_st_gth%cmel (i,k) - microp_st_out%autoim (ideep(i),k) = microp_st_gth%autoim (i,k) - microp_st_out%accsim (ideep(i),k) = microp_st_gth%accsim (i,k) - microp_st_out%difm (ideep(i),k) = microp_st_gth%difm (i,k) - microp_st_out%cmei (ideep(i),k) = microp_st_gth%cmei (i,k) - microp_st_out%nuclin (ideep(i),k) = microp_st_gth%nuclin (i,k) - microp_st_out%autoin (ideep(i),k) = microp_st_gth%autoin (i,k) - microp_st_out%accsin (ideep(i),k) = microp_st_gth%accsin (i,k) - microp_st_out%hmpin (ideep(i),k) = microp_st_gth%hmpin (i,k) - microp_st_out%difn (ideep(i),k) = microp_st_gth%difn (i,k) - microp_st_out%trspcm (ideep(i),k) = microp_st_gth%trspcm (i,k) - microp_st_out%trspcn (ideep(i),k) = microp_st_gth%trspcn (i,k) - microp_st_out%trspim (ideep(i),k) = microp_st_gth%trspim (i,k) - microp_st_out%trspin (ideep(i),k) = microp_st_gth%trspin (i,k) - microp_st_out%accgrm (ideep(i),k) = microp_st_gth%accgrm (i,k) - microp_st_out%accglm (ideep(i),k) = microp_st_gth%accglm (i,k) - microp_st_out%accgslm (ideep(i),k) = microp_st_gth%accgslm (i,k) - microp_st_out%accgsrm (ideep(i),k) = microp_st_gth%accgsrm (i,k) - microp_st_out%accgirm (ideep(i),k) = microp_st_gth%accgirm (i,k) - microp_st_out%accgrim (ideep(i),k) = microp_st_gth%accgrim (i,k) - microp_st_out%accgrsm (ideep(i),k) = microp_st_gth%accgrsm (i,k) - microp_st_out%accgsln (ideep(i),k) = microp_st_gth%accgsln (i,k) - microp_st_out%accgsrn (ideep(i),k) = microp_st_gth%accgsrn (i,k) - microp_st_out%accgirn (ideep(i),k) = microp_st_gth%accgirn (i,k) - microp_st_out%accsrim (ideep(i),k) = microp_st_gth%accsrim (i,k) - microp_st_out%acciglm (ideep(i),k) = microp_st_gth%acciglm (i,k) - microp_st_out%accigrm (ideep(i),k) = microp_st_gth%accigrm (i,k) - microp_st_out%accsirm (ideep(i),k) = microp_st_gth%accsirm (i,k) - microp_st_out%accigln (ideep(i),k) = microp_st_gth%accigln (i,k) - microp_st_out%accigrn (ideep(i),k) = microp_st_gth%accigrn (i,k) - microp_st_out%accsirn (ideep(i),k) = microp_st_gth%accsirn (i,k) - microp_st_out%accgln (ideep(i),k) = microp_st_gth%accgln (i,k) - microp_st_out%accgrn (ideep(i),k) = microp_st_gth%accgrn (i,k) - microp_st_out%accilm (ideep(i),k) = microp_st_gth%accilm (i,k) - microp_st_out%acciln (ideep(i),k) = microp_st_gth%acciln (i,k) - microp_st_out%fallrm (ideep(i),k) = microp_st_gth%fallrm (i,k) - microp_st_out%fallsm (ideep(i),k) = microp_st_gth%fallsm (i,k) - microp_st_out%fallgm (ideep(i),k) = microp_st_gth%fallgm (i,k) - microp_st_out%fallrn (ideep(i),k) = microp_st_gth%fallrn (i,k) - microp_st_out%fallsn (ideep(i),k) = microp_st_gth%fallsn (i,k) - microp_st_out%fallgn (ideep(i),k) = microp_st_gth%fallgn (i,k) - microp_st_out%fhmrm (ideep(i),k) = microp_st_gth%fhmrm (i,k) + do i = 1,lengath + microp_st_out%rice (ideep(i)) = microp_st_gth%rice (i) + do k = 1,nlev_in + microp_st_out%wu (ideep(i),k) = microp_st_gth%wu (i,k) + microp_st_out%qliq (ideep(i),k) = microp_st_gth%qliq (i,k) + microp_st_out%qice (ideep(i),k) = microp_st_gth%qice (i,k) + microp_st_out%qrain (ideep(i),k) = microp_st_gth%qrain (i,k) + microp_st_out%qsnow (ideep(i),k) = microp_st_gth%qsnow (i,k) + microp_st_out%qgraupel (ideep(i),k) = microp_st_gth%qgraupel (i,k) + microp_st_out%qnl (ideep(i),k) = microp_st_gth%qnl (i,k) + microp_st_out%qni (ideep(i),k) = microp_st_gth%qni (i,k) + microp_st_out%qnr (ideep(i),k) = microp_st_gth%qnr (i,k) + microp_st_out%qns (ideep(i),k) = microp_st_gth%qns (i,k) + microp_st_out%qng (ideep(i),k) = microp_st_gth%qng (i,k) + microp_st_out%sprd (ideep(i),k) = microp_st_gth%sprd (i,k) + microp_st_out%mudpcu (ideep(i),k) = microp_st_gth%mudpcu (i,k) + microp_st_out%lambdadpcu(ideep(i),k) = microp_st_gth%lambdadpcu(i,k) + microp_st_out%dif (ideep(i),k) = microp_st_gth%dif (i,k) + microp_st_out%dsf (ideep(i),k) = microp_st_gth%dsf (i,k) + microp_st_out%dnlf (ideep(i),k) = microp_st_gth%dnlf (i,k) + microp_st_out%dnif (ideep(i),k) = microp_st_gth%dnif (i,k) + microp_st_out%dnsf (ideep(i),k) = microp_st_gth%dnsf (i,k) + microp_st_out%frz (ideep(i),k) = microp_st_gth%frz (i,k) + microp_st_out%autolm (ideep(i),k) = microp_st_gth%autolm (i,k) + microp_st_out%accrlm (ideep(i),k) = microp_st_gth%accrlm (i,k) + microp_st_out%bergnm (ideep(i),k) = microp_st_gth%bergnm (i,k) + microp_st_out%fhtimm (ideep(i),k) = microp_st_gth%fhtimm (i,k) + microp_st_out%fhtctm (ideep(i),k) = microp_st_gth%fhtctm (i,k) + microp_st_out%fhmlm (ideep(i),k) = microp_st_gth%fhmlm (i,k) + microp_st_out%hmpim (ideep(i),k) = microp_st_gth%hmpim (i,k) + microp_st_out%accslm (ideep(i),k) = microp_st_gth%accslm (i,k) + microp_st_out%dlfm (ideep(i),k) = microp_st_gth%dlfm (i,k) + microp_st_out%autoln (ideep(i),k) = microp_st_gth%autoln (i,k) + microp_st_out%accrln (ideep(i),k) = microp_st_gth%accrln (i,k) + microp_st_out%bergnn (ideep(i),k) = microp_st_gth%bergnn (i,k) + microp_st_out%fhtimn (ideep(i),k) = microp_st_gth%fhtimn (i,k) + microp_st_out%fhtctn (ideep(i),k) = microp_st_gth%fhtctn (i,k) + microp_st_out%fhmln (ideep(i),k) = microp_st_gth%fhmln (i,k) + microp_st_out%accsln (ideep(i),k) = microp_st_gth%accsln (i,k) + microp_st_out%activn (ideep(i),k) = microp_st_gth%activn (i,k) + microp_st_out%dlfn (ideep(i),k) = microp_st_gth%dlfn (i,k) + microp_st_out%cmel (ideep(i),k) = microp_st_gth%cmel (i,k) + microp_st_out%autoim (ideep(i),k) = microp_st_gth%autoim (i,k) + microp_st_out%accsim (ideep(i),k) = microp_st_gth%accsim (i,k) + microp_st_out%difm (ideep(i),k) = microp_st_gth%difm (i,k) + microp_st_out%cmei (ideep(i),k) = microp_st_gth%cmei (i,k) + microp_st_out%nuclin (ideep(i),k) = microp_st_gth%nuclin (i,k) + microp_st_out%autoin (ideep(i),k) = microp_st_gth%autoin (i,k) + microp_st_out%accsin (ideep(i),k) = microp_st_gth%accsin (i,k) + microp_st_out%hmpin (ideep(i),k) = microp_st_gth%hmpin (i,k) + microp_st_out%difn (ideep(i),k) = microp_st_gth%difn (i,k) + microp_st_out%trspcm (ideep(i),k) = microp_st_gth%trspcm (i,k) + microp_st_out%trspcn (ideep(i),k) = microp_st_gth%trspcn (i,k) + microp_st_out%trspim (ideep(i),k) = microp_st_gth%trspim (i,k) + microp_st_out%trspin (ideep(i),k) = microp_st_gth%trspin (i,k) + microp_st_out%accgrm (ideep(i),k) = microp_st_gth%accgrm (i,k) + microp_st_out%accglm (ideep(i),k) = microp_st_gth%accglm (i,k) + microp_st_out%accgslm (ideep(i),k) = microp_st_gth%accgslm (i,k) + microp_st_out%accgsrm (ideep(i),k) = microp_st_gth%accgsrm (i,k) + microp_st_out%accgirm (ideep(i),k) = microp_st_gth%accgirm (i,k) + microp_st_out%accgrim (ideep(i),k) = microp_st_gth%accgrim (i,k) + microp_st_out%accgrsm (ideep(i),k) = microp_st_gth%accgrsm (i,k) + microp_st_out%accgsln (ideep(i),k) = microp_st_gth%accgsln (i,k) + microp_st_out%accgsrn (ideep(i),k) = microp_st_gth%accgsrn (i,k) + microp_st_out%accgirn (ideep(i),k) = microp_st_gth%accgirn (i,k) + microp_st_out%accsrim (ideep(i),k) = microp_st_gth%accsrim (i,k) + microp_st_out%acciglm (ideep(i),k) = microp_st_gth%acciglm (i,k) + microp_st_out%accigrm (ideep(i),k) = microp_st_gth%accigrm (i,k) + microp_st_out%accsirm (ideep(i),k) = microp_st_gth%accsirm (i,k) + microp_st_out%accigln (ideep(i),k) = microp_st_gth%accigln (i,k) + microp_st_out%accigrn (ideep(i),k) = microp_st_gth%accigrn (i,k) + microp_st_out%accsirn (ideep(i),k) = microp_st_gth%accsirn (i,k) + microp_st_out%accgln (ideep(i),k) = microp_st_gth%accgln (i,k) + microp_st_out%accgrn (ideep(i),k) = microp_st_gth%accgrn (i,k) + microp_st_out%accilm (ideep(i),k) = microp_st_gth%accilm (i,k) + microp_st_out%acciln (ideep(i),k) = microp_st_gth%acciln (i,k) + microp_st_out%fallrm (ideep(i),k) = microp_st_gth%fallrm (i,k) + microp_st_out%fallsm (ideep(i),k) = microp_st_gth%fallsm (i,k) + microp_st_out%fallgm (ideep(i),k) = microp_st_gth%fallgm (i,k) + microp_st_out%fallrn (ideep(i),k) = microp_st_gth%fallrn (i,k) + microp_st_out%fallsn (ideep(i),k) = microp_st_gth%fallsn (i,k) + microp_st_out%fallgn (ideep(i),k) = microp_st_gth%fallgn (i,k) + microp_st_out%fhmrm (ideep(i),k) = microp_st_gth%fhmrm (i,k) end do end do end subroutine zm_microp_st_scatter From 6cd876fc29d80fd0df0bd26f24045381fad01861 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 10 Oct 2025 14:23:35 -0700 Subject: [PATCH 03/31] more major ZM fortran refactoring --- components/eam/src/physics/cam/zm_conv.F90 | 257 +++++++----------- .../eam/src/physics/cam/zm_conv_intr.F90 | 10 +- .../physics/cam/zm_microphysics_history.F90 | 75 ++++- .../src/physics/cam/zm_microphysics_state.F90 | 148 ++++------ 4 files changed, 223 insertions(+), 267 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 210716ce9174..610917a55d9b 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -79,7 +79,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - qi, sprd, frz, mudpcu, lambdadpcu ) + sprd, frz, mudpcu, lambdadpcu ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -131,7 +131,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: qi ! ZM microphysics - cloud ice mixing ratio real(r8), dimension(pcols,pver), intent( out) :: sprd ! ZM microphysics - snow production rate real(r8), dimension(pcols,pver), intent( out) :: frz ! ZM microphysics - heating rate due to freezing real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr @@ -216,13 +215,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: sprdg ! gathered snow production rate real(r8), dimension(pcols,pver) :: lambdadpcug ! gathered slope of cloud liquid size distr real(r8), dimension(pcols,pver) :: mudpcug ! gathered width parameter of droplet size distr - - real(r8), dimension(pcols,pver) :: qldeg ! cloud water mixing ratio for detrainment [kg/kg] - real(r8), dimension(pcols,pver) :: qideg ! cloud ice mixing ratio for detrainment [kg/kg] - real(r8), dimension(pcols,pver) :: qsdeg ! snow mixing ratio for detrainment [kg/kg] - real(r8), dimension(pcols,pver) :: ncdeg ! cloud water number concentration for detrainment [1/kg] - real(r8), dimension(pcols,pver) :: nideg ! cloud ice number concentration for detrainment [1/kg] - real(r8), dimension(pcols,pver) :: nsdeg ! snow concentration for detrainment [1/kg] real(r8), dimension(pcols,pver) :: dsfmg ! mass tendency due to detrainment of snow real(r8), dimension(pcols,pver) :: dsfng ! num tendency due to detrainment of snow real(r8), dimension(pcols,pver) :: frzg ! gathered heating rate due to freezing @@ -272,17 +264,10 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & dlf(i,k) = 0._r8 dlg(i,k) = 0._r8 ! Convective microphysics - qi(i,k) = 0._r8 sprd(i,k) = 0._r8 frz(i,k) = 0._r8 sprdg(i,k) = 0._r8 frzg(i,k) = 0._r8 - qldeg(i,k) = 0._r8 - qideg(i,k) = 0._r8 - qsdeg(i,k) = 0._r8 - ncdeg(i,k) = 0._r8 - nideg(i,k) = 0._r8 - nsdeg(i,k) = 0._r8 dsfmg(i,k) = 0._r8 dsfng(i,k) = 0._r8 end do @@ -525,7 +510,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & aero ,lambdadpcug,mudpcug ,sprdg ,frzg , & ! < added for ZM micro - qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, & ! < added for ZM micro dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro @@ -619,14 +603,10 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & call q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & dqdt ,dsdt ,qg ,qs ,qu , & su ,du ,qhat ,shat ,dp , & - mu ,md ,sd ,qd ,qldeg , & + mu ,md ,sd ,qd ,qlg , & dsubcld ,jt ,maxg ,1 ,lengath , msg, & - dlg ,evpg ,cug ,qideg ,& - ncdeg ,& - nideg ,& + dlg ,evpg ,cug ,& frzg , & - qsdeg ,& - nsdeg ,& loc_microp_st) !---------------------------------------------------------------------------- @@ -745,61 +725,22 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & lambdadpcu(ideep(i),k) = lambdadpcug(i,k) mudpcu(ideep(i),k) = mudpcug(i,k) frz(ideep(i),k) = frzg(i,k)*zm_const%latice/zm_const%cpair - if (zm_param%zm_microp) qi(ideep(i),k) = loc_microp_st%qice(i,k) end do end do !---------------------------------------------------------------------------- ! Scatter microphysics data (i.e. undo the gathering) - if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) - if (zm_param%zm_microp) then - do k = msg + 1,pver - do i = 1,ncol - - ! Interpolate variable from interface to mid-layer. - if(k.lt.pver) then - microp_st%qice (i,k) = 0.5_r8*(microp_st%qice (i,k)+microp_st%qice (i,k+1)) - microp_st%qliq (i,k) = 0.5_r8*(microp_st%qliq (i,k)+microp_st%qliq (i,k+1)) - microp_st%qrain (i,k) = 0.5_r8*(microp_st%qrain (i,k)+microp_st%qrain (i,k+1)) - microp_st%qsnow (i,k) = 0.5_r8*(microp_st%qsnow (i,k)+microp_st%qsnow (i,k+1)) - microp_st%qgraupel(i,k) = 0.5_r8*(microp_st%qgraupel(i,k)+microp_st%qgraupel(i,k+1)) - microp_st%qni (i,k) = 0.5_r8*(microp_st%qni (i,k)+microp_st%qni (i,k+1)) - microp_st%qnl (i,k) = 0.5_r8*(microp_st%qnl (i,k)+microp_st%qnl (i,k+1)) - microp_st%qnr (i,k) = 0.5_r8*(microp_st%qnr (i,k)+microp_st%qnr (i,k+1)) - microp_st%qns (i,k) = 0.5_r8*(microp_st%qns (i,k)+microp_st%qns (i,k+1)) - microp_st%qng (i,k) = 0.5_r8*(microp_st%qng (i,k)+microp_st%qng (i,k+1)) - microp_st%wu (i,k) = 0.5_r8*(microp_st%wu (i,k)+microp_st%wu (i,k+1)) - end if - - if (t(i,k).gt.zm_const%tfreez .and. t(i,k-1).le.zm_const%tfreez) then - microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) - microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) - microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) - microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) - microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k) - microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) - microp_st%qice (i,k) = 0._r8 - microp_st%qni (i,k) = 0._r8 - microp_st%qsnow (i,k) = 0._r8 - microp_st%qns (i,k) = 0._r8 - microp_st%qgraupel(i,k) = 0._r8 - microp_st%qng (i,k) = 0._r8 - end if - ! Convert units from "kg/kg" to "g/m3" - microp_st%qice (i,k) = microp_st%qice(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qliq (i,k) = microp_st%qliq(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qrain (i,k) = microp_st%qrain(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * pap(i,k)/t(i,k)/zm_const%rdair *1000._r8 - microp_st%qni (i,k) = microp_st%qni(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qnl (i,k) = microp_st%qnl(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qnr (i,k) = microp_st%qnr(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qns (i,k) = microp_st%qns(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - microp_st%qng (i,k) = microp_st%qng(i,k) * pap(i,k)/t(i,k)/zm_const%rdair - end do - end do + call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) + ! we also need to interpolate the wu variable from interface to mid-point + do i = 1,ncol + do k = msg + 1,pver + if(k.lt.pver) then + microp_st%wu(i,k) = 0.5_r8 * ( microp_st%wu(i,k) + microp_st%wu(i,k+1) ) + end if + end do + end do end if #ifdef CPRCRAY @@ -1118,7 +1059,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & aero ,lambdadpcu ,mudpcu ,sprd ,frz1 , & - qcde ,qide ,qsde ,ncde ,nide ,nsde , & dsfm ,dsfn ,loc_microp_st ) !----------------------------------------------------------------------- @@ -1202,12 +1142,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! Convective microphysics type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg) - real(r8), intent(out) :: qide(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg) - real(r8), intent(out) :: qsde(pcols,pver) ! snow mixing ratio for detrainment (kg/kg) - real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number concentration for detrainment (1/kg) - real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number concentration for detrainment (1/kg) - real(r8), intent(out) :: nsde(pcols,pver) ! snow number concentration for detrainment (1/kg) real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer ! tendency for output @@ -1356,28 +1290,28 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & sprd(i,k) = 0._r8 fice(i,k) = 0._r8 tug(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - qsde(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - nsde(i,k) = 0._r8 frz(i,k) = 0._r8 frz1(i,k) = 0._r8 if (zm_param%zm_microp) then - loc_microp_st%cmel(i,k) = 0._r8 - loc_microp_st%cmei(i,k) = 0._r8 - loc_microp_st%wu(i,k) = 0._r8 - loc_microp_st%qliq(i,k) = 0._r8 - loc_microp_st%qice(i,k) = 0._r8 - loc_microp_st%qrain(i,k) = 0._r8 - loc_microp_st%qsnow(i,k) = 0._r8 - loc_microp_st%qgraupel(i,k) = 0._r8 - loc_microp_st%qnl(i,k) = 0._r8 - loc_microp_st%qni(i,k) = 0._r8 - loc_microp_st%qnr(i,k) = 0._r8 - loc_microp_st%qns(i,k) = 0._r8 - loc_microp_st%qng(i,k) = 0._r8 + loc_microp_st%qcde(i,k) = 0._r8 + loc_microp_st%qide(i,k) = 0._r8 + loc_microp_st%qsde(i,k) = 0._r8 + loc_microp_st%ncde(i,k) = 0._r8 + loc_microp_st%nide(i,k) = 0._r8 + loc_microp_st%nsde(i,k) = 0._r8 + loc_microp_st%cmel(i,k) = 0._r8 + loc_microp_st%cmei(i,k) = 0._r8 + loc_microp_st%wu(i,k) = 0._r8 + loc_microp_st%qliq(i,k) = 0._r8 + loc_microp_st%qice(i,k) = 0._r8 + loc_microp_st%qrain(i,k) = 0._r8 + loc_microp_st%qsnow(i,k) = 0._r8 + loc_microp_st%qgraupel(i,k) = 0._r8 + loc_microp_st%qnl(i,k) = 0._r8 + loc_microp_st%qni(i,k) = 0._r8 + loc_microp_st%qnr(i,k) = 0._r8 + loc_microp_st%qns(i,k) = 0._r8 + loc_microp_st%qng(i,k) = 0._r8 end if end do end do @@ -1799,12 +1733,13 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & #ifndef SCREAM_CONFIG_IS_CMAKE call zm_mphy(su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, zf, p, & t, q, eps0, jb, jt, jlcl, msg, il2g, zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & - loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & - qcde, qide, ncde, nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & - loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, & - loc_microp_st%qng, qsde, nsde, loc_microp_st%autolm, loc_microp_st%accrlm, & + loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & + loc_microp_st%qcde, loc_microp_st%qide, loc_microp_st%ncde, & + loc_microp_st%nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & + loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, & + loc_microp_st%qng, loc_microp_st%qsde, loc_microp_st%nsde, loc_microp_st%autolm, loc_microp_st%accrlm, & loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, & - loc_microp_st%hmpim, loc_microp_st%accslm, loc_microp_st%dlfm, loc_microp_st%autoln, & + loc_microp_st%hmpim, loc_microp_st%accslm, loc_microp_st%dlfm, loc_microp_st%autoln, & loc_microp_st%accrln, loc_microp_st%bergnn, loc_microp_st%fhtimn, loc_microp_st%fhtctn, & loc_microp_st%fhmln, loc_microp_st%accsln, loc_microp_st%activn, loc_microp_st%dlfn, & loc_microp_st%autoim, loc_microp_st%accsim, loc_microp_st%difm, loc_microp_st%nuclin, & @@ -1844,7 +1779,9 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & do k = pver,msg + 2,-1 do i = 1,il2g if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*(qcde(i,k+1)+qide(i,k+1)+qsde(i,k+1) )) + totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*( loc_microp_st%qcde(i,k+1) & + +loc_microp_st%qide(i,k+1) & + +loc_microp_st%qsde(i,k+1) )) end if end do end do @@ -1872,12 +1809,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) ! reset convective microphysics variables - qcde(i,k) = ql(i,k) - qide(i,k) = 0._r8 - qsde(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - nsde(i,k) = 0._r8 sprd(i,k) = 0._r8 frz1(i,k) = 0._r8 end if @@ -2035,46 +1966,49 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & mc(i,k) = mu(i,k) + md(i,k) end do end do -! - do i = 1,il2g - if ( zm_param%zm_microp .and. jt(i)>=jlcl(i)) then - do k = msg + 1,pver - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - ql(i,k) = 0._r8 - cu(i,k) = 0._r8 - evp(i,k) = 0._r8 - md(i,k) = 0._r8 - ed(i,k) = 0._r8 - mc(i,k) = 0._r8 - rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 - fice(i,k) = 0._r8 - qcde(i,k) = 0._r8 - qide(i,k) = 0._r8 - qsde(i,k) = 0._r8 - ncde(i,k) = 0._r8 - nide(i,k) = 0._r8 - nsde(i,k) = 0._r8 - frz(i,k) = 0._r8 - frz1(i,k) = 0._r8 - loc_microp_st%wu(i,k) = 0._r8 - loc_microp_st%cmel(i,k) = 0._r8 - loc_microp_st%cmei(i,k) = 0._r8 - loc_microp_st%qliq(i,k) = 0._r8 - loc_microp_st%qice(i,k) = 0._r8 - loc_microp_st%qrain(i,k)= 0._r8 - loc_microp_st%qsnow(i,k)= 0._r8 - loc_microp_st%qgraupel(i,k) = 0._r8 - loc_microp_st%qnl(i,k) = 0._r8 - loc_microp_st%qni(i,k) = 0._r8 - loc_microp_st%qnr(i,k) = 0._r8 - loc_microp_st%qns(i,k) = 0._r8 - loc_microp_st%qng(i,k) = 0._r8 - end do - end if - end do + + if (zm_param%zm_microp) then + do i = 1,il2g + if ( jt(i)>=jlcl(i) ) then + do k = msg + 1,pver + mu(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = 0._r8 + ql(i,k) = 0._r8 + cu(i,k) = 0._r8 + evp(i,k) = 0._r8 + md(i,k) = 0._r8 + ed(i,k) = 0._r8 + mc(i,k) = 0._r8 + rprd(i,k) = 0._r8 + sprd(i,k) = 0._r8 + fice(i,k) = 0._r8 + loc_microp_st%qcde(i,k) = 0._r8 + loc_microp_st%qide(i,k) = 0._r8 + loc_microp_st%qsde(i,k) = 0._r8 + loc_microp_st%ncde(i,k) = 0._r8 + loc_microp_st%nide(i,k) = 0._r8 + loc_microp_st%nsde(i,k) = 0._r8 + frz(i,k) = 0._r8 + frz1(i,k) = 0._r8 + loc_microp_st%wu(i,k) = 0._r8 + loc_microp_st%cmel(i,k) = 0._r8 + loc_microp_st%cmei(i,k) = 0._r8 + loc_microp_st%qliq(i,k) = 0._r8 + loc_microp_st%qice(i,k) = 0._r8 + loc_microp_st%qrain(i,k)= 0._r8 + loc_microp_st%qsnow(i,k)= 0._r8 + loc_microp_st%qgraupel(i,k) = 0._r8 + loc_microp_st%qnl(i,k) = 0._r8 + loc_microp_st%qni(i,k) = 0._r8 + loc_microp_st%qnr(i,k) = 0._r8 + loc_microp_st%qns(i,k) = 0._r8 + loc_microp_st%qng(i,k) = 0._r8 + end do + end if + end do + end if + return end subroutine cldprp @@ -2300,12 +2234,8 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,ql , & dsubcld ,jt ,mx ,il1g ,il2g , msg, & - dl ,evp ,cu ,qice ,& - qnl ,& - qni ,& + dl ,evp ,cu ,& frz , & - qsde ,& - nsde ,& loc_microp_st) !---------------------------------------------------------------------------- ! Purpose: initialize quantities for ZM convection scheme @@ -2341,11 +2271,6 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & ! Convective microphysics real(r8), intent(in) :: frz(pcols,pver) - real(r8), intent(in) :: qice(pcols,pver) - real(r8), intent(in) :: qnl(pcols,pver) - real(r8), intent(in) :: qni(pcols,pver) - real(r8), intent(in) :: qsde(pcols,pver) - real(r8), intent(in) :: nsde(pcols,pver) real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) real(r8),intent(out) :: dl(pcols,pver) @@ -2402,13 +2327,15 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & -md(i,k)* (qd(i,k)-qhat(i,k)) & )/dp(i,k) - dl(i,k) = du(i,k)*ql(i,k+1) if (zm_param%zm_microp) then - loc_microp_st%dif(i,k) = du(i,k)*qice(i,k+1) - loc_microp_st%dnlf(i,k) = du(i,k)*qnl(i,k+1) - loc_microp_st%dnif(i,k) = du(i,k)*qni(i,k+1) - loc_microp_st%dsf(i,k) = du(i,k)*qsde(i,k+1) - loc_microp_st%dnsf(i,k) = du(i,k)*nsde(i,k+1) + dl (i,k) = du(i,k)*loc_microp_st%qcde(i,k+1) + loc_microp_st%dif (i,k) = du(i,k)*loc_microp_st%qide(i,k+1) + loc_microp_st%dnlf(i,k) = du(i,k)*loc_microp_st%ncde(i,k+1) + loc_microp_st%dnif(i,k) = du(i,k)*loc_microp_st%nide(i,k+1) + loc_microp_st%dsf (i,k) = du(i,k)*loc_microp_st%qsde(i,k+1) + loc_microp_st%dnsf(i,k) = du(i,k)*loc_microp_st%nsde(i,k+1) + else + dl(i,k) = du(i,k)*ql(i,k+1) end if end do diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index e9189580cfc6..f3165baaf11a 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -429,7 +429,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & use zm_conv_mcsp, only: zm_conv_mcsp_tend use zm_microphysics, only: dnlfzm_idx, dnifzm_idx, dsfzm_idx, dnsfzm_idx, wuc_idx use zm_microphysics_state, only: zm_microp_st_alloc, zm_microp_st_dealloc - use zm_microphysics_history, only: zm_microphysics_history_out + use zm_microphysics_history, only: zm_microphysics_history_convert, zm_microphysics_history_out !---------------------------------------------------------------------------- ! Arguments type(physics_state),target, intent(in) :: state ! Physics state variables @@ -638,11 +638,12 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - qi, sprd, frz, mudpcu, lambdadpcu ) + sprd, frz, mudpcu, lambdadpcu ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then ! update ZM micro variables in pbuf + qi (1:ncol,1:pver) = microp_st%qice(1:ncol,1:pver) dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) dsf (1:ncol,1:pver) = microp_st%dsf (1:ncol,1:pver) dnlf(1:ncol,1:pver) = microp_st%dnlf(1:ncol,1:pver) @@ -797,7 +798,10 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call outfld('PRECCDZM', prec, pcols, lchnk ) call outfld('PRECZ ', prec, pcols, lchnk ) - if (zm_param%zm_microp) call zm_microphysics_history_out(lchnk, ncol, microp_st, prec, dlf) + if (zm_param%zm_microp) then + call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t) + call zm_microphysics_history_out(lchnk, ncol, microp_st, prec, dlf) + end if ! add tendency from this process to tend from other processes here call physics_ptend_sum(ptend_loc,ptend_all, ncol) diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 index 182c73cf79c2..e7c8f72f29e8 100644 --- a/components/eam/src/physics/cam/zm_microphysics_history.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_history.F90 @@ -7,8 +7,9 @@ module zm_microphysics_history use ppgrid, only: pcols, pver, pverp use zm_microphysics_state, only: zm_microp_st - public :: zm_microphysics_history_init ! add fields for history output - public :: zm_microphysics_history_out ! write history output related to ZM microphysics + public :: zm_microphysics_history_init ! add fields for history output + public :: zm_microphysics_history_convert ! convert ZM microphysics prior to output + public :: zm_microphysics_history_out ! write history output related to ZM microphysics !=================================================================================================== contains @@ -132,6 +133,76 @@ end subroutine zm_microphysics_history_init !=================================================================================================== +subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature ) + !---------------------------------------------------------------------------- + ! Purpose: convert ZM microphysics prior to output + !---------------------------------------------------------------------------- + use zm_conv, only: zm_const + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: ncol ! number of columns in chunk + type(zm_microp_st), intent(inout) :: microp_st ! ZM microphysics data structure + real(r8), dimension(pcols,pver), intent(in ) :: pmid ! pressure at mid-points [Pa] + real(r8), dimension(pcols,pver), intent(in ) :: temperature ! ambient temperature [K] + !---------------------------------------------------------------------------- + ! Local variables + integer :: i,k + real(r8) :: rho + !---------------------------------------------------------------------------- + do i = 1,ncol + do k = 1,pver + ! Interpolate variable from interface to mid-layer. + if (k1) then + if ( temperature(i,k).gt.zm_const%tfreez .and. temperature(i,k-1).le.zm_const%tfreez ) then + microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) + microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) + microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) + microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) + microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k) + microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) + microp_st%qice (i,k) = 0._r8 + microp_st%qni (i,k) = 0._r8 + microp_st%qsnow (i,k) = 0._r8 + microp_st%qns (i,k) = 0._r8 + microp_st%qgraupel(i,k) = 0._r8 + microp_st%qng (i,k) = 0._r8 + end if + end if + end do ! k + ! Convert units from "kg/kg" to "g/m3" + do k = 1,pver + rho = pmid(i,k)/(temperature(i,k)*zm_const%rdair) + microp_st%qice (i,k) = microp_st%qice(i,k) * rho *1000._r8 + microp_st%qliq (i,k) = microp_st%qliq(i,k) * rho *1000._r8 + microp_st%qrain (i,k) = microp_st%qrain(i,k) * rho *1000._r8 + microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * rho *1000._r8 + microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * rho *1000._r8 + microp_st%qni (i,k) = microp_st%qni(i,k) * rho + microp_st%qnl (i,k) = microp_st%qnl(i,k) * rho + microp_st%qnr (i,k) = microp_st%qnr(i,k) * rho + microp_st%qns (i,k) = microp_st%qns(i,k) * rho + microp_st%qng (i,k) = microp_st%qng(i,k) * rho + end do ! k + end do ! i + +end subroutine zm_microphysics_history_convert + +!=================================================================================================== + subroutine zm_microphysics_history_out( lchnk, ncol, microp_st, prec, dlf ) !---------------------------------------------------------------------------- ! Purpose: write out history variables for convective microphysics diff --git a/components/eam/src/physics/cam/zm_microphysics_state.F90 b/components/eam/src/physics/cam/zm_microphysics_state.F90 index 60917a8bbb63..b06c79ec1cc2 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -34,11 +34,17 @@ module zm_microphysics_state real(r8), allocatable, dimension(:,:) :: sprd ! snow production rate real(r8), allocatable, dimension(:,:) :: mudpcu ! width parameter of droplet size distr real(r8), allocatable, dimension(:,:) :: lambdadpcu ! slope of cloud liquid size distr - real(r8), allocatable, dimension(:,:) :: dif ! detrainment of cloud ice water mixing ratio - real(r8), allocatable, dimension(:,:) :: dsf ! detrained convective snow mixing ratio + real(r8), allocatable, dimension(:,:) :: qcde ! tmp for detrainment - cld liq mixing ratio [kg/kg] + real(r8), allocatable, dimension(:,:) :: qide ! tmp for detrainment - cld ice mixing ratio [kg/kg] + real(r8), allocatable, dimension(:,:) :: qsde ! tmp for detrainment - snow mixing ratio [kg/kg] + real(r8), allocatable, dimension(:,:) :: ncde ! tmp for detrainment - cld liq number conc [1/kg] + real(r8), allocatable, dimension(:,:) :: nide ! tmp for detrainment - cld ice number conc [1/kg] + real(r8), allocatable, dimension(:,:) :: nsde ! tmp for detrainment - snow number conc [1/kg] + real(r8), allocatable, dimension(:,:) :: dif ! detrainment of conv cld ice water mixing ratio + real(r8), allocatable, dimension(:,:) :: dsf ! detrainment of conv snow mixing ratio real(r8), allocatable, dimension(:,:) :: dnlf ! detrainment of conv cld liq water num concen real(r8), allocatable, dimension(:,:) :: dnif ! detrainment of conv cld ice num concen - real(r8), allocatable, dimension(:,:) :: dnsf ! detrained snow num concen + real(r8), allocatable, dimension(:,:) :: dnsf ! detrainment of snow num concen real(r8), allocatable, dimension(:,:) :: frz ! heating rate due to freezing real(r8), allocatable, dimension(:,:) :: autolm ! mass tendency due to autoconversion of droplets to rain real(r8), allocatable, dimension(:,:) :: accrlm ! mass tendency due to accretion of droplets by rain @@ -131,6 +137,12 @@ subroutine zm_microp_st_alloc(microp_st_in,ncol_in,nlev_in) microp_st_in%sprd (ncol_in,nlev_in), & microp_st_in%mudpcu (ncol_in,nlev_in), & microp_st_in%lambdadpcu (ncol_in,nlev_in), & + microp_st_in%qcde (ncol_in,nlev_in), & + microp_st_in%qide (ncol_in,nlev_in), & + microp_st_in%qsde (ncol_in,nlev_in), & + microp_st_in%ncde (ncol_in,nlev_in), & + microp_st_in%nide (ncol_in,nlev_in), & + microp_st_in%nsde (ncol_in,nlev_in), & microp_st_in%dif (ncol_in,nlev_in), & microp_st_in%dsf (ncol_in,nlev_in), & microp_st_in%dnlf (ncol_in,nlev_in), & @@ -225,6 +237,12 @@ subroutine zm_microp_st_dealloc(microp_st_in) microp_st_in%sprd, & microp_st_in%mudpcu, & microp_st_in%lambdadpcu,& + microp_st_in%qcde, & + microp_st_in%qide, & + microp_st_in%qsde, & + microp_st_in%ncde, & + microp_st_in%nide, & + microp_st_in%nsde, & microp_st_in%dif, & microp_st_in%dsf, & microp_st_in%dnlf, & @@ -296,100 +314,6 @@ end subroutine zm_microp_st_dealloc !=================================================================================================== -subroutine zm_microp_st_ini(microp_st_in,ncol_in,nlev_in) - !---------------------------------------------------------------------------- - ! Purpose: initialize zm_microp_st variables - !---------------------------------------------------------------------------- - ! Arguments - type(zm_microp_st), intent(inout) :: microp_st_in ! state and tendency of convective microphysics - integer, intent(in ) :: ncol_in ! number of atmospheric columns to initialize - integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize - !---------------------------------------------------------------------------- - microp_st_in%wu (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qliq (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qice (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qrain (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qsnow (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qgraupel (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qnl (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qni (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qnr (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qns (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%qng (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%rice (1:ncol_in) = 0._r8 - microp_st_in%sprd (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%mudpcu (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%lambdadpcu(1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dif (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dsf (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dnlf (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dnif (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dnsf (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%frz (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autolm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accrlm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmlm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accslm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accrln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%bergnn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtimn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhtctn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%activn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%dlfn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%cmel (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%difm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%cmei (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%nuclin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%autoin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%hmpin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%difn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspcn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%trspin (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accglm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgslm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrsm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgsrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgirn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsrim (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%acciglm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accigrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accsirn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accgrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%accilm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%acciln (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgm (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallrn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallsn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fallgn (1:ncol_in,1:nlev_in) = 0._r8 - microp_st_in%fhmrm (1:ncol_in,1:nlev_in) = 0._r8 -end subroutine zm_microp_st_ini - -!=================================================================================================== - subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) !---------------------------------------------------------------------------- ! Purpose: zero out zm_microp_st variables for a single column @@ -414,6 +338,12 @@ subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) microp_st_in%sprd (icol_in,1:nlev_in) = 0._r8 microp_st_in%mudpcu (icol_in,1:nlev_in) = 0._r8 microp_st_in%lambdadpcu(icol_in,1:nlev_in) = 0._r8 + microp_st_in%qcde (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qide (icol_in,1:nlev_in) = 0._r8 + microp_st_in%qsde (icol_in,1:nlev_in) = 0._r8 + microp_st_in%ncde (icol_in,1:nlev_in) = 0._r8 + microp_st_in%nide (icol_in,1:nlev_in) = 0._r8 + microp_st_in%nsde (icol_in,1:nlev_in) = 0._r8 microp_st_in%dif (icol_in,1:nlev_in) = 0._r8 microp_st_in%dsf (icol_in,1:nlev_in) = 0._r8 microp_st_in%dnlf (icol_in,1:nlev_in) = 0._r8 @@ -484,6 +414,24 @@ end subroutine zm_microp_st_zero !=================================================================================================== +subroutine zm_microp_st_ini(microp_st_in,ncol_in,nlev_in) + !---------------------------------------------------------------------------- + ! Purpose: initialize zm_microp_st variables + !---------------------------------------------------------------------------- + ! Arguments + type(zm_microp_st), intent(inout) :: microp_st_in ! state and tendency of convective microphysics + integer, intent(in ) :: ncol_in ! number of atmospheric columns to initialize + integer, intent(in ) :: nlev_in ! number of atmospheric levels to initialize + !---------------------------------------------------------------------------- + integer :: i + !---------------------------------------------------------------------------- + do i = 1,ncol_in + call zm_microp_st_zero(microp_st_in,i,nlev_in) + end do +end subroutine zm_microp_st_ini + +!=================================================================================================== + subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_in,ideep) !---------------------------------------------------------------------------- ! Purpose: gather microphysic arrays from microp_st to microp_st_in @@ -515,6 +463,12 @@ subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_i microp_st_out%sprd (ideep(i),k) = microp_st_gth%sprd (i,k) microp_st_out%mudpcu (ideep(i),k) = microp_st_gth%mudpcu (i,k) microp_st_out%lambdadpcu(ideep(i),k) = microp_st_gth%lambdadpcu(i,k) + microp_st_out%qcde (ideep(i),k) = microp_st_gth%qcde (i,k) + microp_st_out%qide (ideep(i),k) = microp_st_gth%qide (i,k) + microp_st_out%qsde (ideep(i),k) = microp_st_gth%qsde (i,k) + microp_st_out%ncde (ideep(i),k) = microp_st_gth%ncde (i,k) + microp_st_out%nide (ideep(i),k) = microp_st_gth%nide (i,k) + microp_st_out%nsde (ideep(i),k) = microp_st_gth%nsde (i,k) microp_st_out%dif (ideep(i),k) = microp_st_gth%dif (i,k) microp_st_out%dsf (ideep(i),k) = microp_st_gth%dsf (i,k) microp_st_out%dnlf (ideep(i),k) = microp_st_gth%dnlf (i,k) From 688e78223a3b23b5f7fb0e0224a5f87937db7bd2 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 10:11:13 -0700 Subject: [PATCH 04/31] remove hack scheme support to avoid ZM build issues --- .../eam/src/physics/cam/convect_shallow.F90 | 132 ------------------ 1 file changed, 132 deletions(-) diff --git a/components/eam/src/physics/cam/convect_shallow.F90 b/components/eam/src/physics/cam/convect_shallow.F90 index fa4ba0f4fc47..435cdd52fff3 100644 --- a/components/eam/src/physics/cam/convect_shallow.F90 +++ b/components/eam/src/physics/cam/convect_shallow.F90 @@ -32,7 +32,6 @@ module convect_shallow convect_shallow_use_shfrc ! ! The following namelist variable controls which shallow convection package is used. - ! 'Hack' = Hack shallow convection (default) ! 'UW' = UW shallow convection by Sungsu Park and Christopher S. Bretherton ! 'off' = No shallow convection @@ -134,7 +133,6 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) use cam_history, only : addfld, horiz_only, add_default use ppgrid, only : pcols, pver - use hk_conv, only : mfinti use uwshcu, only : init_uwshcu use physconst, only : rair, gravit, latvap, rhoh2o, zvir, & cappa, latice, mwdry, mwh2o @@ -196,14 +194,6 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) 'Cloud ice tendency - shallow convection' ) call addfld( 'CMFDQR' , (/ 'lev' /) , 'A' , 'kg/kg/s', & 'Q tendency - shallow convection rainout' ) - call addfld( 'EVAPTCM' , (/ 'lev' /) , 'A' , 'K/s', & - 'T tendency - Evaporation/snow prod from Hack convection' ) - call addfld( 'FZSNTCM' , (/ 'lev' /) , 'A' , 'K/s', & - 'T tendency - Rain to snow conversion from Hack convection' ) - call addfld( 'EVSNTCM' , (/ 'lev' /) , 'A' , 'K/s', & - 'T tendency - Snow to rain prod from Hack convection' ) - call addfld( 'EVAPQCM' , (/ 'lev' /) , 'A' , 'kg/kg/s', & - 'Q tendency - Evaporation from Hack convection' ) call addfld( 'QC' , (/ 'lev' /) , 'A' , 'kg/kg/s', & 'Q tendency - shallow convection LW export' ) call addfld( 'PRECSH' , horiz_only, 'A' , 'm/s', & @@ -229,17 +219,6 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call addfld( 'FREQSH' , horiz_only , 'A' , 'fraction', & 'Fractional occurance of shallow convection' ) - - call addfld( 'HKFLXPRC' , (/ 'ilev' /), 'A' , 'kg/m2/s', & - 'Flux of precipitation from HK convection' ) - call addfld( 'HKFLXSNW' , (/ 'ilev' /), 'A' , 'kg/m2/s', & - 'Flux of snow from HK convection' ) - call addfld( 'HKNTPRPD' , (/ 'lev' /) , 'A' , 'kg/kg/s', & - 'Net precipitation production from HK convection' ) - call addfld( 'HKNTSNPD' , (/ 'lev' /) , 'A' , 'kg/kg/s', & - 'Net snow production from HK convection' ) - call addfld( 'HKEIHEAT' , (/ 'lev' /) , 'A' , 'W/kg' , & - 'Heating by ice and evaporation in HK convection' ) call addfld ('ICWMRSH' , (/ 'lev' /), 'A' , 'kg/kg', & 'Shallow Convection in-cloud water mixing ratio ' ) @@ -279,32 +258,6 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) if( masterproc ) write(iulog,*) 'convect_shallow_init: shallow convection OFF' continue - case('Hack') ! Hack scheme - - qpert_idx = pbuf_get_index('qpert') - - if( masterproc ) write(iulog,*) 'convect_shallow_init: Hack shallow convection' - ! Limit shallow convection to regions below 40 mb - ! Note this calculation is repeated in the deep convection interface - if( pref_edge(1) >= 4.e3_r8 ) then - limcnv = 1 - else - do k = 1, plev - if( pref_edge(k) < 4.e3_r8 .and. pref_edge(k+1) >= 4.e3_r8 ) then - limcnv = k - goto 10 - end if - end do - limcnv = plevp - end if -10 continue - - if( masterproc ) then - write(iulog,*) 'MFINTI: Convection will be capped at intfc ', limcnv, ' which is ', pref_edge(limcnv), ' pascals' - end if - - call mfinti( rair, cpair, gravit, latvap, rhoh2o, limcnv) ! Get args from inti.F90 - case('UW') ! Park and Bretherton shallow convection scheme if( masterproc ) write(iulog,*) 'convect_shallow_init: UW shallow convection scheme (McCaa)' @@ -413,7 +366,6 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , & use camsrfexch, only : cam_in_t use constituents, only : pcnst, cnst_get_ind, cnst_get_type_byind - use hk_conv, only : cmfmca use uwshcu, only : compute_uwshcu_inv use time_manager, only : get_nstep, is_first_step @@ -608,22 +560,6 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , & flxprec(:ncol,:) = 0._r8 flxsnow(:ncol,:) = 0._r8 - case('Hack') ! Hack scheme - - lq(:) = .TRUE. - call physics_ptend_init( ptend_loc, state%psetcols, 'cmfmca', ls=.true., lq=lq ) ! Initialize local ptend type - - call pbuf_get_field(pbuf, qpert_idx, qpert) - qpert(:ncol,2:pcnst) = 0._r8 - - call cmfmca( lchnk , ncol , & - nstep , ztodt , state%pmid , state%pdel , & - state%rpdel , state%zm , tpert , qpert , state%phis , & - pblh , state%t , state%q , ptend_loc%s , ptend_loc%q , & - cmfmc2 , rprdsh , cmfsl , cmflq , precc , & - qc2 , cnt2 , cnb2 , icwmr , rliq2 , & - state%pmiddry, state%pdeldry, state%rpdeldry ) - case('UW') ! UW shallow convection scheme ! -------------------------------------- ! @@ -883,74 +819,6 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , & ! NOT perform below 'zm_conv_evap'. ! ! ------------------------------------------------------------------------ ! - if( shallow_scheme .eq. 'Hack' ) then - - ! ------------------------------------------------------------------------------- ! - ! Determine the phase of the precipitation produced and add latent heat of fusion ! - ! Evaporate some of the precip directly into the environment (Sundqvist) ! - ! Allow this to use the updated state1 and a fresh ptend_loc type ! - ! Heating and specific humidity tendencies produced ! - ! ------------------------------------------------------------------------------- ! - - ! --------------------------------- ! - ! initialize ptend for next process ! - ! --------------------------------- ! - - lq(1) = .TRUE. - lq(2:) = .FALSE. - call physics_ptend_init(ptend_loc, state1%psetcols, 'shallow_hack', ls=.true., lq=lq) - - call pbuf_get_field(pbuf, sh_flxprc_idx, flxprec ) - call pbuf_get_field(pbuf, sh_flxsnw_idx, flxsnow ) - call pbuf_get_field(pbuf, sh_cldliq_idx, sh_cldliq ) - call pbuf_get_field(pbuf, sh_cldice_idx, sh_cldice ) - - sprd = 0._r8 - - !! clouds have no water... :) - sh_cldliq(:ncol,:) = 0._r8 - sh_cldice(:ncol,:) = 0._r8 - - call zm_conv_evap( pcols, state1%ncol, pver, pverp, & - state1%t, state1%pmid, state1%pdel, state1%q(:pcols,:pver,1), & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, & - ptend_loc%q(:pcols,:pver,1), & - rprdsh, cld, ztodt, & - precc, snow, ntprprd, ntsnprd , flxprec, flxsnow, sprd, .true.) - - ! ------------------------------------------ ! - ! record history variables from zm_conv_evap ! - ! ------------------------------------------ ! - - evapcsh(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1) - - ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver) / cpair - call outfld( 'EVAPTCM ' , ftem , pcols, lchnk ) - ftem(:ncol,:pver) = tend_s_snwprd(:ncol,:pver) / cpair - call outfld( 'FZSNTCM ' , ftem , pcols, lchnk ) - ftem(:ncol,:pver) = tend_s_snwevmlt(:ncol,:pver) / cpair - call outfld( 'EVSNTCM ' , ftem , pcols, lchnk ) - call outfld( 'EVAPQCM ' , ptend_loc%q(1,1,1) , pcols, lchnk ) - call outfld( 'PRECSH ' , precc , pcols, lchnk ) - call outfld( 'HKFLXPRC' , flxprec , pcols, lchnk ) - call outfld( 'HKFLXSNW' , flxsnow , pcols, lchnk ) - call outfld( 'HKNTPRPD' , ntprprd , pcols, lchnk ) - call outfld( 'HKNTSNPD' , ntsnprd , pcols, lchnk ) - call outfld( 'HKEIHEAT' , ptend_loc%s , pcols, lchnk ) - - ! ---------------------------------------------------------------- ! - ! Add tendency from this process to tend from other processes here ! - ! ---------------------------------------------------------------- ! - - call physics_ptend_sum( ptend_loc, ptend_all, ncol ) - call physics_ptend_dealloc(ptend_loc) - - ! -------------------------------------------- ! - ! Do not perform evaporation process for UW-Cu ! - ! -------------------------------------------- ! - - end if - ! ------------------------------------------------------------- ! ! Update name of parameterization tendencies to send to tphysbc ! ! ------------------------------------------------------------- ! From 7310aac2422c80e6fdceaf2767ccb8f87020bc3c Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 10:12:28 -0700 Subject: [PATCH 05/31] add old_snow to zm_params white space alignment fix --- components/eam/src/physics/cam/zm_conv_types.F90 | 2 ++ components/eam/src/physics/cam/zm_microphysics_history.F90 | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/components/eam/src/physics/cam/zm_conv_types.F90 b/components/eam/src/physics/cam/zm_conv_types.F90 index 35db6011daa8..a0cef8316fa8 100644 --- a/components/eam/src/physics/cam/zm_conv_types.F90 +++ b/components/eam/src/physics/cam/zm_conv_types.F90 @@ -72,6 +72,7 @@ module zm_conv_types logical :: no_deep_pbl = .false. ! flag to eliminate deep convection within PBL ! ZM micro parameters logical :: zm_microp = .false. ! switch for convective microphysics + logical :: old_snow = .true. ! switch to revert snow production in zm_conv_evap (i.e. before zm_micro additions) real(r8) :: auto_fac = unset_r8 ! ZM microphysics enhancement factor for droplet-rain autoconversion real(r8) :: accr_fac = unset_r8 ! ZM microphysics enhancement factor for droplet-rain accretion real(r8) :: micro_dcs = unset_r8 ! ZM microphysics size threshold for cloud ice to snow autoconversion [m] @@ -207,6 +208,7 @@ subroutine zm_param_set_for_testing(zm_param) zm_param%no_deep_pbl = .false. ! ZM micro parameters zm_param%zm_microp = .true. + zm_param%old_snow = .false. zm_param%auto_fac = 7.0D0 zm_param%accr_fac = 1.5D0 zm_param%micro_dcs = 150.E-6 diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 index e7c8f72f29e8..62f765934dac 100644 --- a/components/eam/src/physics/cam/zm_microphysics_history.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_history.F90 @@ -140,7 +140,7 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature ) use zm_conv, only: zm_const !---------------------------------------------------------------------------- ! Arguments - integer, intent(in ) :: ncol ! number of columns in chunk + integer, intent(in ) :: ncol ! number of columns in chunk type(zm_microp_st), intent(inout) :: microp_st ! ZM microphysics data structure real(r8), dimension(pcols,pver), intent(in ) :: pmid ! pressure at mid-points [Pa] real(r8), dimension(pcols,pver), intent(in ) :: temperature ! ambient temperature [K] From 3852f5f36ffbc29537b9563b7d0298a675a8ab6a Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 10:17:41 -0700 Subject: [PATCH 06/31] add sprd to ZM microp_st and create zm_microphysics_adjust --- components/eam/src/physics/cam/zm_conv.F90 | 287 ++++++------------ .../eam/src/physics/cam/zm_conv_intr.F90 | 15 +- .../eam/src/physics/cam/zm_microphysics.F90 | 120 ++++++++ 3 files changed, 219 insertions(+), 203 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 610917a55d9b..82ef06662a55 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -11,7 +11,7 @@ module zm_conv #else use shr_kind_mod, only: r8 => shr_kind_r8 use cloud_fraction, only: cldfrc_fice - use zm_microphysics, only: zm_mphy + use zm_microphysics, only: zm_mphy, zm_microphysics_adjust #endif use zm_conv_cape, only: compute_dilute_cape use zm_conv_types, only: zm_const_t, zm_param_t @@ -79,7 +79,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - sprd, frz, mudpcu, lambdadpcu ) + frz, mudpcu, lambdadpcu ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -131,7 +131,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: sprd ! ZM microphysics - snow production rate real(r8), dimension(pcols,pver), intent( out) :: frz ! ZM microphysics - heating rate due to freezing real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr real(r8), dimension(pcols,pver), intent( out) :: lambdadpcu ! ZM microphysics - slope of cloud liquid size distr @@ -212,7 +211,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: dudt ! gathered u-wind tendency at gathered points real(r8), dimension(pcols,pver) :: dvdt ! gathered v-wind tendency at gathered points - real(r8), dimension(pcols,pver) :: sprdg ! gathered snow production rate real(r8), dimension(pcols,pver) :: lambdadpcug ! gathered slope of cloud liquid size distr real(r8), dimension(pcols,pver) :: mudpcug ! gathered width parameter of droplet size distr real(r8), dimension(pcols,pver) :: dsfmg ! mass tendency due to detrainment of snow @@ -235,7 +233,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & integer l, m real(r8), parameter :: dcon = 25.e-6_r8 real(r8), parameter :: mucon = 5.3_r8 - real(r8) negadq integer dcapemx(pcols) ! launching level index saved from 1st call for CAPE calculation; used in 2nd call when DCAPE-ULL active @@ -264,9 +261,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & dlf(i,k) = 0._r8 dlg(i,k) = 0._r8 ! Convective microphysics - sprd(i,k) = 0._r8 frz(i,k) = 0._r8 - sprdg(i,k) = 0._r8 frzg(i,k) = 0._r8 dsfmg(i,k) = 0._r8 dsfng(i,k) = 0._r8 @@ -509,8 +504,8 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & maxg ,j0 ,jd ,lengath ,msg , & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & - aero ,lambdadpcug,mudpcug ,sprdg ,frzg , & ! < added for ZM micro - dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro + aero ,lambdadpcug,mudpcug,frzg , & ! < added for ZM micro + dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro !---------------------------------------------------------------------------- @@ -523,9 +518,11 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - sprdg(i,k) = sprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) frzg (i,k) = frzg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + if (zm_param%zm_microp) then + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + end if end do end do @@ -584,14 +581,16 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & cug (i,k) = cug (i,k)*mb(i) evpg (i,k) = evpg (i,k)*mb(i) pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/zm_const%grav - sprdg(i,k) = sprdg(i,k)*mb(i) frzg(i,k) = frzg(i,k)*mb(i) - if ( zm_param%zm_microp .and. mb(i).eq.0._r8) then - qlg (i,k) = 0._r8 - dsfmg(i,k) = 0._r8 - dsfng(i,k) = 0._r8 - frzg (i,k) = 0._r8 + if (zm_param%zm_microp) then + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)*mb(i) + if (mb(i).eq.0._r8) then + qlg (i,k) = 0._r8 + dsfmg(i,k) = 0._r8 + dsfng(i,k) = 0._r8 + frzg (i,k) = 0._r8 + end if end if end do @@ -610,97 +609,11 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & loc_microp_st) !---------------------------------------------------------------------------- - ! conservation check - - if (zm_param%zm_microp) then - do k = msg + 1,pver -#ifdef CPRCRAY -!DIR$ CONCURRENT + ! conservation check and adjusment +#ifndef SCREAM_CONFIG_IS_CMAKE + if (zm_param%zm_microp) call zm_microphysics_adjust(pcols, lengath, pver, jt, msg, delt, & + dp, qg, dlg, dsdt, dqdt, rprd, loc_microp_st) #endif - do i = 1,lengath - if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then - negadq = dqdt(i,k)+0.5_r8*qg(i,k)/delt - dqdt(i,k) = dqdt(i,k)-negadq - - ! First evaporate precipitation from k layer to cloud top assuming that the preciptation - ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer. - do kk=k,jt(i),-1 - if (negadq<0._r8) then - if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - ! precipitation is enough - dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair - if (rprdg(i,kk)>sprdg(i,kk)) then - ! if there is rain, evaporate it first - if(rprdg(i,kk)-sprdg(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then - ! if rain is not enough, evaporate snow and graupel - dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-sprdg(i,kk))*dp(i,kk)/dp(i,k))*zm_const%latice/zm_const%cpair - sprdg(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk) - end if - else - ! if there is not rain, evaporate snow and graupel - sprdg(i,kk) = sprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latice/zm_const%cpair - end if - rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! precipitation is not enough. calculate the residue and evaporate next layer - negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq - dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*zm_const%latvap/zm_const%cpair*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - sprdg(i,kk)*zm_const%latice/zm_const%cpair*dp(i,kk)/dp(i,k) - sprdg(i,kk) = 0._r8 - rprdg(i,kk) = 0._r8 - end if - - if (negadq<0._r8) then - if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - ! first evaporate (detrained) cloud liquid water - dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair - loc_microp_st%dnlf(i,kk) = loc_microp_st%dnlf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk)) - dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! if cloud liquid water is not enough then calculate the residual and evaporate the detrained cloud ice - negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*zm_const%latvap/zm_const%cpair - dlg(i,kk) = 0._r8 - loc_microp_st%dnlf(i,kk) = 0._r8 ! dnlg(i,kk) = 0._r8 - if (loc_microp_st%dif(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - loc_microp_st%dnif(i,kk) = loc_microp_st%dnif(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_microp_st%dif(i,kk)) - loc_microp_st%dif(i,kk) = loc_microp_st%dif(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow - negadq = negadq + loc_microp_st%dif(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - loc_microp_st%dif(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - loc_microp_st%dif(i,kk) = 0._r8 - loc_microp_st%dnif(i,kk) = 0._r8 - if (loc_microp_st%dsf(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then - dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair - loc_microp_st%dnsf(i,kk) = loc_microp_st%dnsf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_microp_st%dsf(i,kk)) - loc_microp_st%dsf(i,kk) = loc_microp_st%dsf(i,kk)+negadq*dp(i,k)/dp(i,kk) - negadq = 0._r8 - else - ! if cloud ice is not enough, then calculate the residual and evaporate next layer - negadq = negadq + loc_microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k) - dsdt(i,k) = dsdt(i,k) - loc_microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair - loc_microp_st%dsf(i,kk) = 0._r8 - loc_microp_st%dnsf(i,kk) = 0._r8 - end if - end if - end if - end if - - end if ! negadq<0._r8 - end do ! kk - - if (negadq<0._r8) dqdt(i,k) = dqdt(i,k) - negadq - - end if - end do ! i = 1,lengath - end do ! k = msg + 1,pver - end if ! zm_microp !---------------------------------------------------------------------------- ! scatter data (i.e. undo the gathering) @@ -721,7 +634,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & pflx(ideep(i),k) = pflxg(i,k) ql (ideep(i),k) = qlg (i,k) - sprd(ideep(i),k) = sprdg(i,k) lambdadpcu(ideep(i),k) = lambdadpcug(i,k) mudpcu(ideep(i),k) = mudpcug(i,k) frz(ideep(i),k) = frzg(i,k)*zm_const%latice/zm_const%cpair @@ -794,80 +706,70 @@ end subroutine zm_convr !=================================================================================================== -subroutine zm_conv_evap(pcols, ncol, pver, pverp, & - t, pmid, pdel, q, & - tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, & - prdprec, cldfrc, deltat, & - prec, snow, ntprprd, ntsnprd, & - flxprec, flxsnow, prdsnow, old_snow ) -!----------------------------------------------------------------------- -! Compute tendencies due to evaporation of rain from ZM scheme -!-- -! Compute the total precipitation and snow fluxes at the surface. -! Add in the latent heat of fusion for snow formation and melt, since it not dealt with -! in the Zhang-MacFarlane parameterization. -! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm -!----------------------------------------------------------------------- +subroutine zm_conv_evap(pcols, ncol, pver, pverp, deltat, & + pmid, pdel, t, q, prdprec, cldfrc, & + tend_s, tend_q, tend_s_snwprd, tend_s_snwevmlt, & + prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, microp_st ) + !---------------------------------------------------------------------------- + ! Purpose: - compute tendencies due to evaporation of rain from ZM scheme, + ! - compute total precip and snow fluxes at the surface + ! - add the latent heat of fusion for snow formation and melt + ! - evaporate some precip directly into the environment using a Sundqvist type algorithm + !---------------------------------------------------------------------------- #ifdef SCREAM_CONFIG_IS_CMAKE use zm_eamxx_bridge_wv_saturation, only: qsat #else use wv_saturation, only: qsat #endif -!------------------------------Arguments-------------------------------- - integer, intent(in) :: pcols ! maximum number of columns - integer, intent(in) :: ncol ! actual number of columns - integer, intent(in) :: pver ! number of mid-point vertical levels - integer, intent(in) :: pverp ! number of interface vertical levels - real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K) - real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa) - real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa) - real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg) - real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s) - real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s) - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production - real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow - - - - real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s) - real(r8), intent(in ) :: cldfrc(pcols,pver) ! cloud fraction - real(r8), intent(in ) :: deltat ! time step - - real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate - real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate - - ! Convective microphysics - real(r8), intent(in ) :: prdsnow(pcols,pver)! snow production (kg/ks/s) - logical, intent(in) :: old_snow ! true for old estimate of snow production -! -!---------------------------Local storage------------------------------- - - real(r8) :: es (pcols,pver) ! Saturation vapor pressure - real(r8) :: fice (pcols,pver) ! ice fraction in precip production - real(r8) :: fsnow_conv(pcols,pver) ! snow fraction in precip production - real(r8) :: qs (pcols,pver) ! saturation specific humidity - real(r8),intent(out) :: flxprec(pcols,pverp) ! Convective-scale flux of precip at interfaces (kg/m2/s) - real(r8),intent(out) :: flxsnow(pcols,pverp) ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8),intent(out) :: ntprprd(pcols,pver) ! net precip production in layer - real(r8),intent(out) :: ntsnprd(pcols,pver) ! net snow production in layer - real(r8) :: work1 ! temp variable (pjr) - real(r8) :: work2 ! temp variable (pjr) - - real(r8) :: evpvint(pcols) ! vertical integral of evaporation - real(r8) :: evpprec(pcols) ! evaporation of precipitation (kg/kg/s) - real(r8) :: evpsnow(pcols) ! evaporation of snowfall (kg/kg/s) - real(r8) :: snowmlt(pcols) ! snow melt tendency in layer - real(r8) :: flxsntm(pcols) ! flux of snow into layer, after melting - - real(r8) :: evplimit ! temp variable for evaporation limits - real(r8) :: rlat(pcols) - - real(r8) :: dum - real(r8) :: omsm - integer :: i,k ! longitude,level indices - + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! maximum number of columns + integer, intent(in ) :: ncol ! actual number of columns + integer, intent(in ) :: pver ! number of mid-point vertical levels + integer, intent(in ) :: pverp ! number of interface vertical levels + real(r8), intent(in ) :: deltat ! time step [s] + real(r8), dimension(pcols,pver), intent(in ) :: pmid ! midpoint pressure [Pa] + real(r8), dimension(pcols,pver), intent(in ) :: pdel ! layer thickness [Pa] + real(r8), dimension(pcols,pver), intent(in ) :: t ! temperature [K] + real(r8), dimension(pcols,pver), intent(in ) :: q ! water vapor [kg/kg] + real(r8), dimension(pcols,pver), intent(in ) :: prdprec ! precipitation production [kg/ks/s] + real(r8), dimension(pcols,pver), intent(in ) :: cldfrc ! cloud fraction + real(r8), dimension(pcols,pver), intent(inout) :: tend_s ! heating rate [J/kg/s] + real(r8), dimension(pcols,pver), intent(inout) :: tend_q ! water vapor tendency [kg/kg/s] + real(r8), dimension(pcols,pver), intent(out ) :: tend_s_snwprd ! Heating rate of snow production [J/kg/s] + real(r8), dimension(pcols,pver), intent(out ) :: tend_s_snwevmlt ! Heating rate of snow evap/melt [J/kg/s] + real(r8), dimension(pcols), intent(inout) :: prec(pcols) ! Convective-scale prec rate [m/s] + real(r8), dimension(pcols), intent(out ) :: snow(pcols) ! Convective-scale snow rate [m/s] + real(r8), dimension(pcols,pver), intent(out ) :: ntprprd ! net precip production in layer [?] + real(r8), dimension(pcols,pver), intent(out ) :: ntsnprd ! net snow production in layer [?] + real(r8), dimension(pcols,pverp),intent(out ) :: flxprec ! Convective flux of prec at interfaces [kg/m2/s] + real(r8), dimension(pcols,pverp),intent(out ) :: flxsnow ! Convective flux of snow at interfaces [kg/m2/s] + type(zm_microp_st), intent(inout) :: microp_st ! ZM microphysics data structure + !---------------------------------------------------------------------------- + ! Local variables + integer :: i,k ! loop iterators + real(r8), dimension(pcols,pver) :: es ! Saturation vapor pressure + real(r8), dimension(pcols,pver) :: fice ! ice fraction in precip production + real(r8), dimension(pcols,pver) :: fsnow_conv ! snow fraction in precip production + real(r8), dimension(pcols,pver) :: qs ! saturation specific humidity + real(r8), dimension(pcols,pver) :: prdsnow ! snow production [kg/ks/s] + real(r8), dimension(pcols) :: evpvint ! vertical integral of evaporation + real(r8), dimension(pcols) :: evpprec ! evaporation of precipitation [kg/kg/s] + real(r8), dimension(pcols) :: evpsnow ! evaporation of snowfall [kg/kg/s] + real(r8), dimension(pcols) :: snowmlt ! snow melt tendency in layer + real(r8), dimension(pcols) :: flxsntm ! flux of snow into layer, after melting + real(r8) :: work1 ! temporary work variable + real(r8) :: work2 ! temporary work variable + real(r8) :: evplimit ! temporary work variable for evaporation limits + real(r8) :: dum ! temporary work variable + real(r8) :: omsm ! to prevent problems due to round off error -!----------------------------------------------------------------------- + !---------------------------------------------------------------------------- + if (zm_param%zm_microp) then + prdsnow(1:ncol,1:pver) = microp_st%sprd(1:ncol,1:pver) + else + prdsnow(1:ncol,1:pver) = 0._r8 + end if ! convert input precip to kg/m2/s prec(:ncol) = prec(:ncol)*1000._r8 @@ -889,7 +791,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & do i = 1, ncol ! Melt snow falling into layer, if necessary. - if( old_snow ) then + if( zm_param%old_snow ) then if (t(i,k) > zm_const%tfreez) then flxsntm(i) = 0._r8 snowmlt(i) = flxsnow(i,k) * zm_const%grav/ pdel(i,k) @@ -944,7 +846,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & evpprec(i) = min(evplimit, evpprec(i)) - if( .not.old_snow ) then + if( .not.zm_param%old_snow ) then evpprec(i) = max(0._r8, evpprec(i)) evpprec(i) = evpprec(i)*omsm end if @@ -954,7 +856,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & ! evpsnow(i) = evpprec(i) * flxsntm(i) / flxprec(i,k) ! prevent roundoff problems work1 = min(max(0._r8,flxsntm(i)/flxprec(i,k)),1._r8) - if (.not.old_snow .and. prdsnow(i,k)>prdprec(i,k)) work1 = 1._r8 + if (.not.zm_param%old_snow .and. prdsnow(i,k)>prdprec(i,k)) work1 = 1._r8 evpsnow(i) = evpprec(i) * work1 else evpsnow(i) = 0._r8 @@ -972,7 +874,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & ! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning ! scheme to be used for small flxprec amounts. This is to address error growth problems. - if( old_snow ) then + if( zm_param%old_snow ) then #ifdef PERGRO work1 = min(max(0._r8,flxsnow(i,k)/(flxprec(i,k)+8.64e-11_r8)),1._r8) #else @@ -1007,7 +909,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & ! heating (cooling) and moistening due to evaporation ! - latent heat of vaporization for precip production has already been accounted for ! - snow is contained in prec - if( old_snow ) then + if( zm_param%old_snow ) then tend_s(i,k) =-evpprec(i)*zm_const%latvap + ntsnprd(i,k)*zm_const%latice else tend_s(i,k) =-evpprec(i)*zm_const%latvap + tend_s_snwevmlt(i,k) @@ -1018,7 +920,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, & end do ! protect against rounding error - if( .not.old_snow ) then + if( .not.zm_param%old_snow ) then do i = 1, ncol if(flxsnow(i,pverp).gt.flxprec(i,pverp)) then dum = (flxsnow(i,pverp)-flxprec(i,pverp))*zm_const%grav @@ -1058,7 +960,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & mx ,j0 ,jd ,il2g ,msg , & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & - aero ,lambdadpcu ,mudpcu ,sprd ,frz1 , & + aero ,lambdadpcu ,mudpcu,frz1 , & dsfm ,dsfn ,loc_microp_st ) !----------------------------------------------------------------------- @@ -1142,8 +1044,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! Convective microphysics type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer - ! tendency for output real(r8), intent(out) :: dsfm (pcols,pver) !mass tendency due to detrainment of snow @@ -1287,7 +1187,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & hd(i,k) = hmn(i,k) rprd(i,k) = 0._r8 ! Convective microphysics - sprd(i,k) = 0._r8 fice(i,k) = 0._r8 tug(i,k) = 0._r8 frz(i,k) = 0._r8 @@ -1312,6 +1211,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%qnr(i,k) = 0._r8 loc_microp_st%qns(i,k) = 0._r8 loc_microp_st%qng(i,k) = 0._r8 + loc_microp_st%sprd(i,k) = 0._r8 end if end do end do @@ -1735,7 +1635,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & t, q, eps0, jb, jt, jlcl, msg, il2g, zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & loc_microp_st%qcde, loc_microp_st%qide, loc_microp_st%ncde, & - loc_microp_st%nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & + loc_microp_st%nide, rprd, loc_microp_st%sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, & loc_microp_st%qng, loc_microp_st%qsde, loc_microp_st%nsde, loc_microp_st%autolm, loc_microp_st%accrlm, & loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, & @@ -1809,7 +1709,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) ! reset convective microphysics variables - sprd(i,k) = 0._r8 frz1(i,k) = 0._r8 end if end do @@ -1927,8 +1826,8 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! rprd is the cloud water converted to rain - (rain evaporated) if (zm_param%zm_microp) then if (rprd(i,k)> 0._r8) then - frz1(i,k) = frz1(i,k)- evp(i,k)*min(1._r8,sprd(i,k)/rprd(i,k)) - sprd(i,k) = sprd(i,k)- evp(i,k)*min(1._r8,sprd(i,k)/rprd(i,k)) + frz1(i,k) = frz1(i,k)- evp(i,k)*min(1._r8,loc_microp_st%sprd(i,k)/rprd(i,k)) + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)- evp(i,k)*min(1._r8,loc_microp_st%sprd(i,k)/rprd(i,k)) end if end if rprd(i,k) = rprd(i,k)-evp(i,k) @@ -1941,7 +1840,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & do k = 2,pverp do i = 1,il2g pflx(i,k) = pflx(i,k-1) + rprd(i,k-1)*dz(i,k-1) - if (zm_param%zm_microp) pflxs(i,k) = pflxs(i,k-1) + sprd(i,k-1)*dz(i,k-1) + if (zm_param%zm_microp) pflxs(i,k) = pflxs(i,k-1) + loc_microp_st%sprd(i,k-1)*dz(i,k-1) end do end do ! protect against rounding error @@ -1950,9 +1849,9 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & if(pflxs(i,pverp).gt.pflx(i,pverp)) then dum = (pflxs(i,pverp)-pflx(i,pverp))/omsm do k = pver, msg+2, -1 - if (sprd(i,k) > 0._r8 .and. dum > 0._r8) then - sdum = min(sprd(i,k),dum/dz(i,k)) - sprd(i,k) = sprd(i,k)- sdum + if (loc_microp_st%sprd(i,k) > 0._r8 .and. dum > 0._r8) then + sdum = min(loc_microp_st%sprd(i,k),dum/dz(i,k)) + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)- sdum frz1(i,k) = frz1(i,k)- sdum dum = dum - sdum*dz(i,k) end if @@ -1981,7 +1880,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ed(i,k) = 0._r8 mc(i,k) = 0._r8 rprd(i,k) = 0._r8 - sprd(i,k) = 0._r8 + loc_microp_st%sprd(i,k) = 0._r8 fice(i,k) = 0._r8 loc_microp_st%qcde(i,k) = 0._r8 loc_microp_st%qide(i,k) = 0._r8 diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index f3165baaf11a..fbfae9c33051 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -59,8 +59,6 @@ module zm_conv_intr logical :: convproc_do_aer logical :: convproc_do_gas logical :: clim_modal_aero - logical :: old_snow = .true. ! flag to use old estimate of snow production in zm_conv_evap - ! set false to use snow production from zm microphysics integer :: nmodes integer :: nbulk type(zm_aero_t), allocatable :: aero(:) ! object contains aerosol information @@ -384,7 +382,7 @@ subroutine zm_conv_init(pref_edge) call zm_mphyi() ! use old estimate of snow production in zm_conv_evap - old_snow = .false. + zm_param%old_snow = .false. ! Initialize the aerosol object with data from the modes/species ! affecting climate, i.e., the list index is hardcoded to 0 @@ -538,7 +536,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & real(r8), dimension(pcols,pver,2) :: icwd real(r8), dimension(pcols,pver) :: seten - real(r8), dimension(pcols,pver) :: sprd real(r8), dimension(pcols,pver) :: frz !---------------------------------------------------------------------------- @@ -638,7 +635,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - sprd, frz, mudpcu, lambdadpcu ) + frz, mudpcu, lambdadpcu ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then @@ -773,10 +770,10 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & dp_cldice(1:ncol,1:pver) = 0 call t_startf ('zm_conv_evap') - call zm_conv_evap(pcols, state1%ncol, pver, pverp, & - state1%t, state1%pmid, state1%pdel, state1%q(1:pcols,1:pver,1), & - ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), & - rprd, cld, ztodt, prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, sprd, old_snow) + call zm_conv_evap(pcols, state1%ncol, pver, pverp, ztodt, & + state1%pmid, state1%pdel, state1%t, state1%q(1:pcols,1:pver,1), rprd, cld, & + ptend_loc%s, ptend_loc%q(:pcols,:pver,1), tend_s_snwprd, tend_s_snwevmlt, & + prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, microp_st) call t_stopf ('zm_conv_evap') evapcdp(1:ncol,1:pver) = ptend_loc%q(1:ncol,1:pver,1) diff --git a/components/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90 index 4e01fa14343c..b1023da785ff 100644 --- a/components/eam/src/physics/cam/zm_microphysics.F90 +++ b/components/eam/src/physics/cam/zm_microphysics.F90 @@ -28,6 +28,7 @@ module zm_microphysics save public :: zm_microphysics_register + public :: zm_microphysics_adjust public :: zm_mphyi public :: zm_mphy @@ -3210,4 +3211,123 @@ end subroutine zm_mphy !=================================================================================================== +subroutine zm_microphysics_adjust(pcols, ncol, pver, jt, msg, delt, & + dp, qv, dl, dsdt, dqdt, rprd, microp_st) + !---------------------------------------------------------------------------- + ! Purpose: adjust ZM microphysics variables to avoid negative water + !---------------------------------------------------------------------------- + use zm_conv, only: zm_const + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in ) :: pcols ! maximum number of columns + integer, intent(in ) :: ncol ! actual number of columns + integer, intent(in ) :: pver ! number of mid-point levels + integer, intent(in ) :: msg ! number of levels to skip at model top + integer, dimension(pcols), intent(in ) :: jt ! top index of deep convection + real(r8), intent(in ) :: delt ! model time-step [s] + real(r8), dimension(pcols,pver), intent(in ) :: dp ! pressure thickness [Pa] + real(r8), dimension(pcols,pver), intent(in ) :: qv ! specific humidity [kg/kg] + real(r8), dimension(pcols,pver), intent(inout) :: dl ! detraining cld h2o tend + real(r8), dimension(pcols,pver), intent(inout) :: dsdt ! DSE tendency [K/s] + real(r8), dimension(pcols,pver), intent(inout) :: dqdt ! specific humidity tendency [kg/kg/s] + real(r8), dimension(pcols,pver), intent(inout) :: rprd ! rain production rate [?] + type(zm_microp_st), intent(inout) :: microp_st ! ZM microphysics data structure + !---------------------------------------------------------------------------- + ! Local variables + real(r8) negadq + integer :: i,k,kk + !---------------------------------------------------------------------------- + do k = msg + 1,pver +#ifdef CPRCRAY +!DIR$ CONCURRENT +#endif + do i = 1,ncol + if (dqdt(i,k)*2._r8*delt+qv(i,k)<0._r8) then + negadq = dqdt(i,k)+0.5_r8*qv(i,k)/delt + dqdt(i,k) = dqdt(i,k)-negadq + !---------------------------------------------------------------- + ! First evaporate precipitation from k layer to cloud top assuming that the preciptation + ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer. + do kk=k,jt(i),-1 + if (negadq<0._r8) then + !---------------------------------------------------------- + if (rprd(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + ! precipitation is enough + dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair + if (rprd(i,kk)>microp_st%sprd(i,kk)) then + ! if there is rain, evaporate it first + if(rprd(i,kk)-microp_st%sprd(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then + ! if rain is not enough, evaporate snow and graupel + dsdt(i,k) = dsdt(i,k) + (negadq+ (rprd(i,kk)-microp_st%sprd(i,kk))*dp(i,kk)/dp(i,k))*zm_const%latice/zm_const%cpair + microp_st%sprd(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprd(i,kk) + end if + else + ! if there is not rain, evaporate snow and graupel + microp_st%sprd(i,kk) = microp_st%sprd(i,kk) + negadq*dp(i,k)/dp(i,kk) + dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latice/zm_const%cpair + end if + rprd(i,kk) = rprd(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! precipitation is not enough. calculate the residue and evaporate next layer + negadq = rprd(i,kk)*dp(i,kk)/dp(i,k)+negadq + dsdt(i,k) = dsdt(i,k) - rprd(i,kk) *zm_const%latvap/zm_const%cpair*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - microp_st%sprd(i,kk)*zm_const%latice/zm_const%cpair*dp(i,kk)/dp(i,k) + microp_st%sprd(i,kk) = 0._r8 + rprd(i,kk) = 0._r8 + end if + !---------------------------------------------------------- + if (negadq<0._r8) then + if (dl(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + ! first evaporate (detrained) cloud liquid water + dsdt(i,k) = dsdt(i,k) + negadq*zm_const%latvap/zm_const%cpair + microp_st%dnlf(i,kk) = microp_st%dnlf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dl(i,kk)) + dl(i,kk) = dl(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud liquid water is not enough then calculate the residual and evaporate the detrained cloud ice + negadq = negadq + dl(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - dl(i,kk)*dp(i,kk)/dp(i,k)*zm_const%latvap/zm_const%cpair + dl(i,kk) = 0._r8 + microp_st%dnlf(i,kk) = 0._r8 ! dnlg(i,kk) = 0._r8 + if (microp_st%dif(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair + microp_st%dnif(i,kk) = microp_st%dnif(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/microp_st%dif(i,kk)) + microp_st%dif(i,kk) = microp_st%dif(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow + negadq = negadq + microp_st%dif(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - microp_st%dif(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + microp_st%dif(i,kk) = 0._r8 + microp_st%dnif(i,kk) = 0._r8 + if (microp_st%dsf(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then + dsdt(i,k) = dsdt(i,k) + negadq*(zm_const%latvap+zm_const%latice)/zm_const%cpair + microp_st%dnsf(i,kk) = microp_st%dnsf(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/microp_st%dsf(i,kk)) + microp_st%dsf(i,kk) = microp_st%dsf(i,kk)+negadq*dp(i,k)/dp(i,kk) + negadq = 0._r8 + else + ! if cloud ice is not enough, then calculate the residual and evaporate next layer + negadq = negadq + microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k) + dsdt(i,k) = dsdt(i,k) - microp_st%dsf(i,kk)*dp(i,kk)/dp(i,k)*(zm_const%latvap+zm_const%latice)/zm_const%cpair + microp_st%dsf(i,kk) = 0._r8 + microp_st%dnsf(i,kk) = 0._r8 + end if + end if + end if + end if ! negadq<0._r8 + !---------------------------------------------------------- + end if ! negadq<0._r8 + end do ! kk + + if (negadq<0._r8) dqdt(i,k) = dqdt(i,k) - negadq + + end if + end do ! i = 1,ncol + end do ! k = msg + 1,pver + +end subroutine zm_microphysics_adjust + +!=================================================================================================== + end module zm_microphysics From 21dc4d5f1cac19a52cf709ad43a2d025fe609e96 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 10:56:57 -0700 Subject: [PATCH 07/31] dd snow mass/num detrainment tendencies --- components/eam/src/physics/cam/zm_conv.F90 | 24 +++++-------------- .../src/physics/cam/zm_microphysics_state.F90 | 10 ++++++++ 2 files changed, 16 insertions(+), 18 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 82ef06662a55..ca273c02eda9 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -211,11 +211,9 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: dudt ! gathered u-wind tendency at gathered points real(r8), dimension(pcols,pver) :: dvdt ! gathered v-wind tendency at gathered points - real(r8), dimension(pcols,pver) :: lambdadpcug ! gathered slope of cloud liquid size distr - real(r8), dimension(pcols,pver) :: mudpcug ! gathered width parameter of droplet size distr - real(r8), dimension(pcols,pver) :: dsfmg ! mass tendency due to detrainment of snow - real(r8), dimension(pcols,pver) :: dsfng ! num tendency due to detrainment of snow - real(r8), dimension(pcols,pver) :: frzg ! gathered heating rate due to freezing + real(r8), dimension(pcols,pver) :: lambdadpcug ! ZM microphysics - gathered slope of cloud liquid size distr + real(r8), dimension(pcols,pver) :: mudpcug ! ZM microphysics - gathered width parameter of droplet size distr + real(r8), dimension(pcols,pver) :: frzg ! ZM microphysics - gathered heating rate due to freezing real(r8), dimension(pcols) :: mb ! cloud base mass flux integer, dimension(pcols) :: jlcl ! updraft lifting cond level @@ -263,8 +261,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ! Convective microphysics frz(i,k) = 0._r8 frzg(i,k) = 0._r8 - dsfmg(i,k) = 0._r8 - dsfng(i,k) = 0._r8 end do prec(i) = 0._r8 rliq(i) = 0._r8 @@ -505,7 +501,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & aero ,lambdadpcug,mudpcug,frzg , & ! < added for ZM micro - dsfmg ,dsfng ,loc_microp_st ) ! < added for ZM micro + loc_microp_st ) ! < added for ZM micro !---------------------------------------------------------------------------- @@ -587,8 +583,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)*mb(i) if (mb(i).eq.0._r8) then qlg (i,k) = 0._r8 - dsfmg(i,k) = 0._r8 - dsfng(i,k) = 0._r8 frzg (i,k) = 0._r8 end if end if @@ -961,7 +955,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & aero ,lambdadpcu ,mudpcu,frz1 , & - dsfm ,dsfn ,loc_microp_st ) + loc_microp_st ) !----------------------------------------------------------------------- ! @@ -1045,10 +1039,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics ! tendency for output - - real(r8), intent(out) :: dsfm (pcols,pver) !mass tendency due to detrainment of snow - real(r8), intent(out) :: dsfn (pcols,pver) !num tendency due to detrainment of snow - real(r8), intent(inout) :: lambdadpcu(pcols,pver) ! slope of cloud liquid size distr real(r8), intent(inout) :: mudpcu(pcols,pver) ! width parameter of droplet size distr @@ -1129,8 +1119,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! !------------------------------------------------------------------------------ - dsfm (:il2g,:) = 0._r8 - dsfn (:il2g,:) = 0._r8 do i = 1,il2g ftemp(i) = 0._r8 @@ -1653,7 +1641,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%accsirn,loc_microp_st%accgln ,loc_microp_st%accgrn ,loc_microp_st%accilm , & loc_microp_st%acciln ,loc_microp_st%fallrm ,loc_microp_st%fallsm ,loc_microp_st%fallgm , & loc_microp_st%fallrn ,loc_microp_st%fallsn ,loc_microp_st%fallgn ,loc_microp_st%fhmrm , & - dsfm, dsfn, zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) + loc_microp_st%dsfm, loc_microp_st%dsfn, zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) #endif do k = pver,msg + 2,-1 diff --git a/components/eam/src/physics/cam/zm_microphysics_state.F90 b/components/eam/src/physics/cam/zm_microphysics_state.F90 index b06c79ec1cc2..847978575d23 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -55,6 +55,7 @@ module zm_microphysics_state real(r8), allocatable, dimension(:,:) :: hmpim ! mass tendency due to HM process real(r8), allocatable, dimension(:,:) :: accslm ! mass tendency due to accretion of droplets by snow real(r8), allocatable, dimension(:,:) :: dlfm ! mass tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: dsfm ! mass tendency due to detrainment of snow real(r8), allocatable, dimension(:,:) :: autoln ! num tendency due to autoconversion of droplets to rain real(r8), allocatable, dimension(:,:) :: accrln ! num tendency due to accretion of droplets by rain real(r8), allocatable, dimension(:,:) :: bergnn ! num tendency due to Bergeron process @@ -64,6 +65,7 @@ module zm_microphysics_state real(r8), allocatable, dimension(:,:) :: accsln ! num tendency due to accretion of droplets by snow real(r8), allocatable, dimension(:,:) :: activn ! num tendency due to droplets activation real(r8), allocatable, dimension(:,:) :: dlfn ! num tendency due to detrainment of droplet + real(r8), allocatable, dimension(:,:) :: dsfn ! num tendency due to detrainment of snow real(r8), allocatable, dimension(:,:) :: autoim ! mass tendency due to autoconversion of cloud ice to snow real(r8), allocatable, dimension(:,:) :: accsim ! mass tendency due to accretion of cloud ice by snow real(r8), allocatable, dimension(:,:) :: difm ! mass tendency due to detrainment of cloud ice @@ -158,6 +160,7 @@ subroutine zm_microp_st_alloc(microp_st_in,ncol_in,nlev_in) microp_st_in%hmpim (ncol_in,nlev_in), & microp_st_in%accslm (ncol_in,nlev_in), & microp_st_in%dlfm (ncol_in,nlev_in), & + microp_st_in%dsfm (ncol_in,nlev_in), & microp_st_in%autoln (ncol_in,nlev_in), & microp_st_in%accrln (ncol_in,nlev_in), & microp_st_in%bergnn (ncol_in,nlev_in), & @@ -167,6 +170,7 @@ subroutine zm_microp_st_alloc(microp_st_in,ncol_in,nlev_in) microp_st_in%accsln (ncol_in,nlev_in), & microp_st_in%activn (ncol_in,nlev_in), & microp_st_in%dlfn (ncol_in,nlev_in), & + microp_st_in%dsfn (ncol_in,nlev_in), & microp_st_in%autoim (ncol_in,nlev_in), & microp_st_in%accsim (ncol_in,nlev_in), & microp_st_in%difm (ncol_in,nlev_in), & @@ -258,6 +262,7 @@ subroutine zm_microp_st_dealloc(microp_st_in) microp_st_in%hmpim , & microp_st_in%accslm, & microp_st_in%dlfm , & + microp_st_in%dsfm , & microp_st_in%autoln, & microp_st_in%accrln, & microp_st_in%bergnn, & @@ -267,6 +272,7 @@ subroutine zm_microp_st_dealloc(microp_st_in) microp_st_in%accsln, & microp_st_in%activn, & microp_st_in%dlfn , & + microp_st_in%dsfn , & microp_st_in%autoim, & microp_st_in%accsim, & microp_st_in%difm , & @@ -359,6 +365,7 @@ subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) microp_st_in%hmpim (icol_in,1:nlev_in) = 0._r8 microp_st_in%accslm (icol_in,1:nlev_in) = 0._r8 microp_st_in%dlfm (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dsfm (icol_in,1:nlev_in) = 0._r8 microp_st_in%autoln (icol_in,1:nlev_in) = 0._r8 microp_st_in%accrln (icol_in,1:nlev_in) = 0._r8 microp_st_in%bergnn (icol_in,1:nlev_in) = 0._r8 @@ -368,6 +375,7 @@ subroutine zm_microp_st_zero(microp_st_in,icol_in,nlev_in) microp_st_in%accsln (icol_in,1:nlev_in) = 0._r8 microp_st_in%activn (icol_in,1:nlev_in) = 0._r8 microp_st_in%dlfn (icol_in,1:nlev_in) = 0._r8 + microp_st_in%dsfn (icol_in,1:nlev_in) = 0._r8 microp_st_in%cmel (icol_in,1:nlev_in) = 0._r8 microp_st_in%autoim (icol_in,1:nlev_in) = 0._r8 microp_st_in%accsim (icol_in,1:nlev_in) = 0._r8 @@ -484,6 +492,7 @@ subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_i microp_st_out%hmpim (ideep(i),k) = microp_st_gth%hmpim (i,k) microp_st_out%accslm (ideep(i),k) = microp_st_gth%accslm (i,k) microp_st_out%dlfm (ideep(i),k) = microp_st_gth%dlfm (i,k) + microp_st_out%dsfm (ideep(i),k) = microp_st_gth%dsfm (i,k) microp_st_out%autoln (ideep(i),k) = microp_st_gth%autoln (i,k) microp_st_out%accrln (ideep(i),k) = microp_st_gth%accrln (i,k) microp_st_out%bergnn (ideep(i),k) = microp_st_gth%bergnn (i,k) @@ -493,6 +502,7 @@ subroutine zm_microp_st_scatter(microp_st_gth,microp_st_out,pcols,lengath,nlev_i microp_st_out%accsln (ideep(i),k) = microp_st_gth%accsln (i,k) microp_st_out%activn (ideep(i),k) = microp_st_gth%activn (i,k) microp_st_out%dlfn (ideep(i),k) = microp_st_gth%dlfn (i,k) + microp_st_out%dsfn (ideep(i),k) = microp_st_gth%dsfn (i,k) microp_st_out%cmel (ideep(i),k) = microp_st_gth%cmel (i,k) microp_st_out%autoim (ideep(i),k) = microp_st_gth%autoim (i,k) microp_st_out%accsim (ideep(i),k) = microp_st_gth%accsim (i,k) From 8ece7999c1ecc881585a956976d315a72ddc408b Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 15:13:39 -0700 Subject: [PATCH 08/31] move frz argument to microp_st --- components/eam/src/physics/cam/zm_conv.F90 | 610 +++++++++--------- .../eam/src/physics/cam/zm_conv_intr.F90 | 5 +- 2 files changed, 301 insertions(+), 314 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index ca273c02eda9..ba0cdc83783b 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -79,7 +79,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - frz, mudpcu, lambdadpcu ) + mudpcu, lambdadpcu ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -131,7 +131,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: frz ! ZM microphysics - heating rate due to freezing real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr real(r8), dimension(pcols,pver), intent( out) :: lambdadpcu ! ZM microphysics - slope of cloud liquid size distr !---------------------------------------------------------------------------- @@ -213,7 +212,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: lambdadpcug ! ZM microphysics - gathered slope of cloud liquid size distr real(r8), dimension(pcols,pver) :: mudpcug ! ZM microphysics - gathered width parameter of droplet size distr - real(r8), dimension(pcols,pver) :: frzg ! ZM microphysics - gathered heating rate due to freezing real(r8), dimension(pcols) :: mb ! cloud base mass flux integer, dimension(pcols) :: jlcl ! updraft lifting cond level @@ -258,9 +256,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & qlg(i,k) = 0._r8 dlf(i,k) = 0._r8 dlg(i,k) = 0._r8 - ! Convective microphysics - frz(i,k) = 0._r8 - frzg(i,k) = 0._r8 end do prec(i) = 0._r8 rliq(i) = 0._r8 @@ -500,7 +495,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & maxg ,j0 ,jd ,lengath ,msg , & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & - aero ,lambdadpcug,mudpcug,frzg , & ! < added for ZM micro + aero ,lambdadpcug,mudpcug, & ! < added for ZM micro loc_microp_st ) ! < added for ZM micro @@ -514,10 +509,10 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) - frzg (i,k) = frzg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) if (zm_param%zm_microp) then - loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k) + loc_microp_st%frz (i,k) = loc_microp_st%frz (i,k) * (zfg(i,k)-zfg(i,k+1))/dp(i,k) + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k) * (zfg(i,k)-zfg(i,k+1))/dp(i,k) end if end do end do @@ -577,13 +572,12 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & cug (i,k) = cug (i,k)*mb(i) evpg (i,k) = evpg (i,k)*mb(i) pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/zm_const%grav - frzg(i,k) = frzg(i,k)*mb(i) if (zm_param%zm_microp) then loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)*mb(i) + loc_microp_st%frz (i,k) = loc_microp_st%frz (i,k)*mb(i) if (mb(i).eq.0._r8) then qlg (i,k) = 0._r8 - frzg (i,k) = 0._r8 end if end if @@ -599,7 +593,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & mu ,md ,sd ,qd ,qlg , & dsubcld ,jt ,maxg ,1 ,lengath , msg, & dlg ,evpg ,cug ,& - frzg , & loc_microp_st) !---------------------------------------------------------------------------- @@ -630,7 +623,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & lambdadpcu(ideep(i),k) = lambdadpcug(i,k) mudpcu(ideep(i),k) = mudpcug(i,k) - frz(ideep(i),k) = frzg(i,k)*zm_const%latice/zm_const%cpair end do end do @@ -639,12 +631,15 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & if (zm_param%zm_microp) then call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) - ! we also need to interpolate the wu variable from interface to mid-point + ! we also need to do a few miscellaneous things to the micro variables do i = 1,ncol do k = msg + 1,pver if(k.lt.pver) then + ! interpolate from interface to mid-point microp_st%wu(i,k) = 0.5_r8 * ( microp_st%wu(i,k) + microp_st%wu(i,k+1) ) end if + ! convert freezing rate to a heating rate due to freezing => [K/s] + microp_st%frz(i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair end do end do end if @@ -954,7 +949,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & mx ,j0 ,jd ,il2g ,msg , & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & - aero ,lambdadpcu ,mudpcu,frz1 , & + aero ,lambdadpcu ,mudpcu, & loc_microp_st ) !----------------------------------------------------------------------- @@ -1089,19 +1084,17 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & real(r8) mdt ! Convective microphysics - real(r8) fice(pcols,pver) ! ice fraction in precip production - real(r8) tug(pcols,pver) - - real(r8) totfrz(pcols) - real(r8) frz1(pcols,pver) ! rate of freezing - real(r8) frz (pcols,pver) ! rate of freezing - real(r8) pflxs(pcols,pverp) ! frozen precipitation flux thru layer + real(r8), dimension(pcols,pver) :: fice ! ice fraction in precip production + real(r8), dimension(pcols,pver) :: tug ! temporary updraft temperature + real(r8), dimension(pcols,pver) :: tmp_frz ! temporary rate of freezing + real(r8), dimension(pcols) :: tot_frz ! total column freezing rate + real(r8), dimension(pcols,pverp):: pflxs ! frozen precipitation flux thru layer real(r8) dum, sdum - real(r8), parameter :: omsm=0.99999_r8 ! to prevent problems due to round off error - real(r8), parameter :: mu_min = 0.02_r8 ! minimum value of mu - real(r8), parameter :: t_homofrz = 233.15_r8 ! homogeneous freezing temperature - real(r8), parameter :: t_mphase = 40._r8 ! mixed phase temperature = tfreez-t_homofrz = 273.15K - 233.15K + real(r8), parameter :: omsm = 0.99999_r8 ! to prevent problems due to round off error + real(r8), parameter :: mu_min = 0.02_r8 ! minimum value of mu + real(r8), parameter :: t_homofrz = 233.15_r8 ! homogeneous freezing temperature + real(r8), parameter :: t_mphase = 40._r8 ! mixed phase temperature = tfreez-t_homofrz = 273.15K - 233.15K integer jto(pcols) ! updraft plume old top integer tmplel(pcols) @@ -1177,8 +1170,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! Convective microphysics fice(i,k) = 0._r8 tug(i,k) = 0._r8 - frz(i,k) = 0._r8 - frz1(i,k) = 0._r8 if (zm_param%zm_microp) then loc_microp_st%qcde(i,k) = 0._r8 loc_microp_st%qide(i,k) = 0._r8 @@ -1199,7 +1190,9 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%qnr(i,k) = 0._r8 loc_microp_st%qns(i,k) = 0._r8 loc_microp_st%qng(i,k) = 0._r8 - loc_microp_st%sprd(i,k) = 0._r8 + loc_microp_st%sprd(i,k) = 0._r8 + loc_microp_st%frz(i,k) = 0._r8 + tmp_frz(i,k) = 0._r8 end if end do end do @@ -1396,314 +1389,316 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & itnum = 1 if (zm_param%zm_microp) itnum = 2 - do iter=1, itnum + do iter = 1,itnum do k = pver,msg + 1,-1 - do i = 1,il2g - cu(i,k) = 0._r8 - if (zm_param%zm_microp) loc_microp_st%qliq(i,k) = 0._r8 - if (zm_param%zm_microp) loc_microp_st%qice(i,k) = 0._r8 - ql(i,k) = 0._r8 - frz1(i,k) = 0._r8 - end do + do i = 1,il2g + cu(i,k) = 0._r8 + ql(i,k) = 0._r8 + if (zm_param%zm_microp) then + loc_microp_st%qliq(i,k) = 0._r8 + loc_microp_st%qice(i,k) = 0._r8 + loc_microp_st%frz(i,k) = 0._r8 + end if + end do end do do i = 1,il2g totpcp(i) = 0._r8 if (zm_param%zm_microp) hu(i,jb(i)) = hmn(i,jb(i)) + zm_const%cpair*zm_param%tiedke_add end do -! -! specify the updraft mass flux mu, entrainment eu, detrainment du -! and moist static energy hu. -! here and below mu, eu,du, md and ed are all normalized by mb -! - do i = 1,il2g - if (eps0(i) > 0._r8) then - mu(i,jb(i)) = 1._r8 - eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i)) - end if - if (zm_param%zm_microp) then - tmplel(i) = lel(i) - else - tmplel(i) = jt(i) - end if - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then - zuef(i) = zf(i,k) - zf(i,jb(i)) - rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i) - mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i) - eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k) - du(i,k) = (rmue(i)-mu(i,k))/dz(i,k) - end if - end do - end do -! - khighest = pverp - klowest = 1 - do i=1,il2g - khighest = min(khighest,lel(i)) - klowest = max(klowest,jb(i)) - end do - do k = klowest-1,khighest,-1 + ! specify the updraft mass flux mu, entrainment eu, detrainment du and moist static energy hu. + ! here and below mu, eu,du, md and ed are all normalized by mb do i = 1,il2g - if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then - if (mu(i,k) < 0.02_r8) then - hu(i,k) = hmn(i,k) - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = mu(i,k+1)/dz(i,k) - else - if (zm_param%zm_microp) then - hu(i,k) = (mu(i,k+1)*hu(i,k+1) + dz(i,k)*(eu(i,k)*hmn(i,k) + & - zm_const%latice*frz(i,k)))/(mu(i,k)+ dz(i,k)*du(i,k)) - else - hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k)) - end if - end if + if (eps0(i) > 0._r8) then + mu(i,jb(i)) = 1._r8 + eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i)) + end if + if (zm_param%zm_microp) then + tmplel(i) = lel(i) + else + tmplel(i) = jt(i) end if end do - end do -! -! -! reset cloud top index beginning from two layers above the -! cloud base (i.e. if cloud is only one layer thick, top is not reset -! - do i=1,il2g - doit(i) = .true. - totfrz(i)= 0._r8 do k = pver,msg + 1,-1 - totfrz(i)= totfrz(i)+ frz(i,k)*dz(i,k) + do i = 1,il2g + if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then + zuef(i) = zf(i,k) - zf(i,jb(i)) + rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i) + mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i) + eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k) + du(i,k) = (rmue(i)-mu(i,k))/dz(i,k) + end if + end do end do - end do - do k=klowest-2,khighest-1,-1 + + khighest = pverp + klowest = 1 do i=1,il2g - if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then - if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) .and. mu(i,k) >= mu_min) then - if (hu(i,k)-hsthat(i,k) < -2000._r8) then - jt(i) = k + 1 - doit(i) = .false. + khighest = min(khighest,lel(i)) + klowest = max(klowest,jb(i)) + end do + + do k = klowest-1,khighest,-1 + do i = 1,il2g + if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then + if (mu(i,k) < 0.02_r8) then + hu(i,k) = hmn(i,k) + mu(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = mu(i,k+1)/dz(i,k) else - jt(i) = k - doit(i) = .false. + if (zm_param%zm_microp) then + hu(i,k) = ( mu(i,k+1)*hu(i,k+1) & + +dz(i,k)*( eu(i,k)*hmn(i,k) & + +zm_const%latice*tmp_frz(i,k) ) & + ) / ( mu(i,k) + dz(i,k)*du(i,k) ) + else + hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + & + dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k)) + end if end if - else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < mu_min) then - jt(i) = k + 1 - doit(i) = .false. end if - end if + end do end do - end do - - do i = 1,il2g - if (iter == 1) jto(i) = jt(i) - end do - do k = pver,msg + 1,-1 - do i = 1,il2g - if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then - mu(i,k) = 0._r8 - eu(i,k) = 0._r8 - du(i,k) = 0._r8 - hu(i,k) = hmn(i,k) - end if - if (k == jt(i) .and. eps0(i) > 0._r8) then - du(i,k) = mu(i,k+1)/dz(i,k) - eu(i,k) = 0._r8 - mu(i,k) = 0._r8 - end if + ! reset cloud top index beginning from two layers above the + ! cloud base (i.e. if cloud is only one layer thick, top is not reset + do i=1,il2g + doit(i) = .true. + tot_frz(i)= 0._r8 + do k = pver,msg + 1,-1 + tot_frz(i)= tot_frz(i) + tmp_frz(i,k)*dz(i,k) + end do end do - end do -! - do i = 1,il2g - done(i) = .false. - end do - kount = 0 - do k = pver,msg + 2,-1 - do i = 1,il2g - if (k == jb(i) .and. eps0(i) > 0._r8) then - qu(i,k) = q(i,mx(i)) - su(i,k) = (hu(i,k)-zm_const%latvap*qu(i,k))/zm_const%cpair - end if - if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then - su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + & - dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k) - qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- & - du(i,k)*qst(i,k)) - tu = su(i,k) - zm_const%grav/zm_const%cpair*zf(i,k) - call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu) - if (qu(i,k) >= qstu) then - jlcl(i) = k - kount = kount + 1 - done(i) = .true. + + do k=klowest-2,khighest-1,-1 + do i=1,il2g + if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then + if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) .and. mu(i,k) >= mu_min) then + if (hu(i,k)-hsthat(i,k) < -2000._r8) then + jt(i) = k + 1 + doit(i) = .false. + else + jt(i) = k + doit(i) = .false. + end if + else if ( (hu(i,k) > hu(i,jb(i)) .and. tot_frz(i)<=0._r8) .or. mu(i,k) < mu_min) then + jt(i) = k + 1 + doit(i) = .false. + end if end if - end if - end do - if (kount >= il2g) goto 690 - end do -690 continue - do k = msg + 2,pver - do i = 1,il2g - if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then - su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(zm_const%cpair* (1._r8+gamhat(i,k))) - qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ & - (zm_const%latvap* (1._r8+gamhat(i,k))) - end if + end do end do - end do - - do i = 1,il2g - if (zm_param%zm_microp) then - tmplel(i) = jlcl(i)+1 - else - tmplel(i) = jb(i) - end if - end do -! compute condensation in updraft - do k = pver,msg + 2,-1 do i = 1,il2g - if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then - if (zm_param%zm_microp) then - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(zm_const%latvap/zm_const%cpair) & - - zm_const%latice*frz(i,k)/zm_const%latvap - else - - cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & - dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(zm_const%latvap/zm_const%cpair) - end if - if (k == jt(i)) cu(i,k) = 0._r8 - cu(i,k) = max(0._r8,cu(i,k)) - end if + if (iter == 1) jto(i) = jt(i) end do - end do - - if (zm_param%zm_microp) then - tug(:il2g,:) = t(:il2g,:) - fice(:,:) = 0._r8 - - do k = pver, msg+2, -1 - do i = 1, il2g - tug(i,k) = su(i,k) - zm_const%grav/zm_const%cpair*zf(i,k) - end do - end do - do k = 1, pver-1 - do i = 1, il2g - - if (tug(i,k+1) > zm_const%tfreez) then - ! If warmer than zm_const%tfreez then water phase - fice(i,k) = 0._r8 - - else if (tug(i,k+1) < t_homofrz) then - ! If colder than t_homofrz then ice phase - fice(i,k) = 1._r8 - - else - ! Otherwise mixed phase, with ice fraction decreasing linearly - ! from t_homofrz to zm_const%tfreez - fice(i,k) =(zm_const%tfreez - tug(i,k+1)) / t_mphase + do k = pver,msg + 1,-1 + do i = 1,il2g + if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then + mu(i,k) = 0._r8 + eu(i,k) = 0._r8 + du(i,k) = 0._r8 + hu(i,k) = hmn(i,k) + end if + if (k == jt(i) .and. eps0(i) > 0._r8) then + du(i,k) = mu(i,k+1)/dz(i,k) + eu(i,k) = 0._r8 + mu(i,k) = 0._r8 end if end do end do - do k = 1, pver + do i = 1,il2g + done(i) = .false. + end do + kount = 0 + do k = pver,msg + 2,-1 do i = 1,il2g - loc_microp_st%cmei(i,k) = cu(i,k)* fice(i,k) - loc_microp_st%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k)) + if (k == jb(i) .and. eps0(i) > 0._r8) then + qu(i,k) = q(i,mx(i)) + su(i,k) = (hu(i,k)-zm_const%latvap*qu(i,k))/zm_const%cpair + end if + if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then + su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + & + dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k) + qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- & + du(i,k)*qst(i,k)) + tu = su(i,k) - zm_const%grav/zm_const%cpair*zf(i,k) + call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu) + if (qu(i,k) >= qstu) then + jlcl(i) = k + kount = kount + 1 + done(i) = .true. + end if + end if end do + if (kount >= il2g) goto 690 end do -#ifndef SCREAM_CONFIG_IS_CMAKE - call zm_mphy(su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, zf, p, & - t, q, eps0, jb, jt, jlcl, msg, il2g, zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & - loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & - loc_microp_st%qcde, loc_microp_st%qide, loc_microp_st%ncde, & - loc_microp_st%nide, rprd, loc_microp_st%sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, & - loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, & - loc_microp_st%qng, loc_microp_st%qsde, loc_microp_st%nsde, loc_microp_st%autolm, loc_microp_st%accrlm, & - loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, & - loc_microp_st%hmpim, loc_microp_st%accslm, loc_microp_st%dlfm, loc_microp_st%autoln, & - loc_microp_st%accrln, loc_microp_st%bergnn, loc_microp_st%fhtimn, loc_microp_st%fhtctn, & - loc_microp_st%fhmln, loc_microp_st%accsln, loc_microp_st%activn, loc_microp_st%dlfn, & - loc_microp_st%autoim, loc_microp_st%accsim, loc_microp_st%difm, loc_microp_st%nuclin, & - loc_microp_st%autoin, loc_microp_st%accsin, loc_microp_st%hmpin, loc_microp_st%difn, & - loc_microp_st%trspcm, loc_microp_st%trspcn, loc_microp_st%trspim, loc_microp_st%trspin, & - lambdadpcu, mudpcu, & - loc_microp_st%accgrm, loc_microp_st%accglm, loc_microp_st%accgslm,loc_microp_st%accgsrm, & - loc_microp_st%accgirm,loc_microp_st%accgrim,loc_microp_st%accgrsm,loc_microp_st%accgsln, & - loc_microp_st%accgsrn,loc_microp_st%accgirn,loc_microp_st%accsrim,loc_microp_st%acciglm, & - loc_microp_st%accigrm,loc_microp_st%accsirm,loc_microp_st%accigln,loc_microp_st%accigrn, & - loc_microp_st%accsirn,loc_microp_st%accgln ,loc_microp_st%accgrn ,loc_microp_st%accilm , & - loc_microp_st%acciln ,loc_microp_st%fallrm ,loc_microp_st%fallsm ,loc_microp_st%fallgm , & - loc_microp_st%fallrn ,loc_microp_st%fallsn ,loc_microp_st%fallgn ,loc_microp_st%fhmrm , & - loc_microp_st%dsfm, loc_microp_st%dsfn, zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) -#endif +690 continue - do k = pver,msg + 2,-1 + do k = msg + 2,pver do i = 1,il2g - ! In the original ZM scheme, which does not consider ice phase, ql actually represents total cloud - ! water. With convective microphysics, loc_microp_st%qliq and loc_microp_st%qice represent cloud - ! liquid water and cloud ice, respectively. Since ql is still used in other subroutines as total - ! cloud water, here ql is calculated as total cloud water for consistency. - ql(i,k) = loc_microp_st%qliq(i,k)+ loc_microp_st%qice(i,k) - frz1(i,k) = frz(i,k) + if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then + su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(zm_const%cpair* (1._r8+gamhat(i,k))) + qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ & + (zm_const%latvap* (1._r8+gamhat(i,k))) + end if end do end do do i = 1,il2g - if (iter == 2 .and. jt(i)> jto(i)) then - do k = jt(i), jto(i), -1 - frz1(i,k) = 0.0_r8 - cu(i,k)=0.0_r8 - end do + if (zm_param%zm_microp) then + tmplel(i) = jlcl(i)+1 + else + tmplel(i) = jb(i) end if end do + ! compute condensation in updraft do k = pver,msg + 2,-1 do i = 1,il2g - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*( loc_microp_st%qcde(i,k+1) & - +loc_microp_st%qide(i,k+1) & - +loc_microp_st%qsde(i,k+1) )) + if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then + if (zm_param%zm_microp) then + cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & + dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(zm_const%latvap/zm_const%cpair) & + - zm_const%latice*tmp_frz(i,k)/zm_const%latvap + else + + cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ & + dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(zm_const%latvap/zm_const%cpair) + end if + if (k == jt(i)) cu(i,k) = 0._r8 + cu(i,k) = max(0._r8,cu(i,k)) end if end do end do - else ! no microphysics - -! compute condensed liquid, rain production rate -! accumulate total precipitation (condensation - detrainment of liquid) -! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k) -! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is -! consistently applied. -! mu, ql are interface quantities -! cu, du, eu, rprd are midpoint quantites - do k = pver,msg + 2,-1 - do i = 1,il2g - rprd(i,k) = 0._r8 - if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then - if (mu(i,k) > 0._r8) then - ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- & - dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k)) - ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i)) - else - ql(i,k) = 0._r8 - end if - totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) - rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) - ! reset convective microphysics variables - frz1(i,k) = 0._r8 - end if - end do - end do - end if ! zm_param%zm_microp + if (zm_param%zm_microp) then + + tug(:il2g,:) = t(:il2g,:) + fice(:,:) = 0._r8 + + do k = pver, msg+2, -1 + do i = 1, il2g + tug(i,k) = su(i,k) - zm_const%grav/zm_const%cpair*zf(i,k) + end do + end do + + do k = 1, pver-1 + do i = 1, il2g + if (tug(i,k+1) > zm_const%tfreez) then + ! If warmer than zm_const%tfreez then water phase + fice(i,k) = 0._r8 + else if (tug(i,k+1) < t_homofrz) then + ! If colder than t_homofrz then ice phase + fice(i,k) = 1._r8 + else + ! mixed phase - ice frac decreasing linearly from t_homofrz to zm_const%tfreez + fice(i,k) =(zm_const%tfreez - tug(i,k+1)) / t_mphase + end if + end do + end do + + do k = 1, pver + do i = 1,il2g + loc_microp_st%cmei(i,k) = cu(i,k)* fice(i,k) + loc_microp_st%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k)) + end do + end do + +#ifndef SCREAM_CONFIG_IS_CMAKE + call zm_mphy( su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, & + zf, p, t, q, eps0, jb, jt, jlcl, msg, il2g, & + zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & + loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & + loc_microp_st%qcde, loc_microp_st%qide, loc_microp_st%ncde, loc_microp_st%nide, & + rprd, loc_microp_st%sprd, tmp_frz, loc_microp_st%wu, & + loc_microp_st%qrain, loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, & + loc_microp_st%qgraupel, loc_microp_st%qng, loc_microp_st%qsde, loc_microp_st%nsde, & + loc_microp_st%autolm, loc_microp_st%accrlm, & + loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, & + loc_microp_st%hmpim, loc_microp_st%accslm, loc_microp_st%dlfm, loc_microp_st%autoln, & + loc_microp_st%accrln, loc_microp_st%bergnn, loc_microp_st%fhtimn, loc_microp_st%fhtctn, & + loc_microp_st%fhmln, loc_microp_st%accsln, loc_microp_st%activn, loc_microp_st%dlfn, & + loc_microp_st%autoim, loc_microp_st%accsim, loc_microp_st%difm, loc_microp_st%nuclin, & + loc_microp_st%autoin, loc_microp_st%accsin, loc_microp_st%hmpin, loc_microp_st%difn, & + loc_microp_st%trspcm, loc_microp_st%trspcn, loc_microp_st%trspim, loc_microp_st%trspin, & + lambdadpcu, mudpcu, & + loc_microp_st%accgrm, loc_microp_st%accglm, loc_microp_st%accgslm, loc_microp_st%accgsrm, & + loc_microp_st%accgirm, loc_microp_st%accgrim, loc_microp_st%accgrsm, loc_microp_st%accgsln, & + loc_microp_st%accgsrn, loc_microp_st%accgirn, loc_microp_st%accsrim, loc_microp_st%acciglm, & + loc_microp_st%accigrm, loc_microp_st%accsirm, loc_microp_st%accigln, loc_microp_st%accigrn, & + loc_microp_st%accsirn, loc_microp_st%accgln, loc_microp_st%accgrn, loc_microp_st%accilm, & + loc_microp_st%acciln, loc_microp_st%fallrm, loc_microp_st%fallsm, loc_microp_st%fallgm, & + loc_microp_st%fallrn, loc_microp_st%fallsn, loc_microp_st%fallgn, loc_microp_st%fhmrm, & + loc_microp_st%dsfm, loc_microp_st%dsfn, & + zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) +#endif + + do k = pver,msg + 2,-1 + do i = 1,il2g + ! In the original ZM scheme, which does not consider ice phase, ql actually represents total cloud + ! water. With convective microphysics, loc_microp_st%qliq and loc_microp_st%qice represent cloud + ! liquid water and cloud ice, respectively. Since ql is still used in other subroutines as total + ! cloud water, here ql is calculated as total cloud water for consistency. + ql(i,k) = loc_microp_st%qliq(i,k)+ loc_microp_st%qice(i,k) + loc_microp_st%frz(i,k) = tmp_frz(i,k) + end do + end do + + do i = 1,il2g + if (iter == 2 .and. jt(i)> jto(i)) then + do k = jt(i), jto(i), -1 + loc_microp_st%frz(i,k) = 0.0_r8 + cu(i,k)=0.0_r8 + end do + end if + end do - end do !iter + do k = pver,msg + 2,-1 + do i = 1,il2g + if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then + totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*( loc_microp_st%qcde(i,k+1) & + +loc_microp_st%qide(i,k+1) & + +loc_microp_st%qsde(i,k+1) )) + end if + end do + end do + + else ! no microphysics + + ! compute condensed liquid, rain production rate + ! accumulate total precipitation (condensation - detrainment of liquid) + ! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k) + ! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is + ! consistently applied. + ! mu, ql are interface quantities + ! cu, du, eu, rprd are midpoint quantites + do k = pver,msg + 2,-1 + do i = 1,il2g + rprd(i,k) = 0._r8 + if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then + if (mu(i,k) > 0._r8) then + ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- & + dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k)) + ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i)) + else + ql(i,k) = 0._r8 + end if + totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1)) + rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k) + end if + end do + end do + + end if ! zm_param%zm_microp + + end do ! iter = 1,itnum ! specify downdraft properties (no downdrafts if jd.ge.jb). ! scale down downward mass flux profile so that net flux @@ -1811,10 +1806,10 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ed(i,k) = 0._r8 evp(i,k) = 0._r8 end if -! rprd is the cloud water converted to rain - (rain evaporated) + ! rprd is the cloud water converted to rain - (rain evaporated) if (zm_param%zm_microp) then if (rprd(i,k)> 0._r8) then - frz1(i,k) = frz1(i,k)- evp(i,k)*min(1._r8,loc_microp_st%sprd(i,k)/rprd(i,k)) + loc_microp_st%frz(i,k) = loc_microp_st%frz(i,k) - evp(i,k)*min(1._r8,loc_microp_st%sprd(i,k)/rprd(i,k)) loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)- evp(i,k)*min(1._r8,loc_microp_st%sprd(i,k)/rprd(i,k)) end if end if @@ -1831,22 +1826,22 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & if (zm_param%zm_microp) pflxs(i,k) = pflxs(i,k-1) + loc_microp_st%sprd(i,k-1)*dz(i,k-1) end do end do -! protect against rounding error + ! protect against rounding error if (zm_param%zm_microp) then - do i = 1,il2g - if(pflxs(i,pverp).gt.pflx(i,pverp)) then - dum = (pflxs(i,pverp)-pflx(i,pverp))/omsm - do k = pver, msg+2, -1 - if (loc_microp_st%sprd(i,k) > 0._r8 .and. dum > 0._r8) then - sdum = min(loc_microp_st%sprd(i,k),dum/dz(i,k)) - loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)- sdum - frz1(i,k) = frz1(i,k)- sdum - dum = dum - sdum*dz(i,k) - end if - end do - end if - end do - end if + do i = 1,il2g + if(pflxs(i,pverp).gt.pflx(i,pverp)) then + dum = (pflxs(i,pverp)-pflx(i,pverp))/omsm + do k = pver, msg+2, -1 + if (loc_microp_st%sprd(i,k) > 0._r8 .and. dum > 0._r8) then + sdum = min(loc_microp_st%sprd(i,k),dum/dz(i,k)) + loc_microp_st%sprd(i,k) = loc_microp_st%sprd(i,k)- sdum + loc_microp_st%frz(i,k) = loc_microp_st%frz(i,k) - sdum + dum = dum - sdum*dz(i,k) + end if + end do ! k + end if + end do ! i + end if ! zm_param%zm_microp do k = msg + 1,pver do i = 1,il2g @@ -1876,8 +1871,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%ncde(i,k) = 0._r8 loc_microp_st%nide(i,k) = 0._r8 loc_microp_st%nsde(i,k) = 0._r8 - frz(i,k) = 0._r8 - frz1(i,k) = 0._r8 + loc_microp_st%frz(i,k) = 0._r8 loc_microp_st%wu(i,k) = 0._r8 loc_microp_st%cmel(i,k) = 0._r8 loc_microp_st%cmei(i,k) = 0._r8 @@ -2122,7 +2116,6 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & mu ,md ,sd ,qd ,ql , & dsubcld ,jt ,mx ,il1g ,il2g , msg, & dl ,evp ,cu ,& - frz , & loc_microp_st) !---------------------------------------------------------------------------- ! Purpose: initialize quantities for ZM convection scheme @@ -2156,9 +2149,6 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & real(r8), intent(in) :: cu(pcols,pver) real(r8), intent(in) :: dsubcld(pcols) - ! Convective microphysics - real(r8), intent(in) :: frz(pcols,pver) - real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver) real(r8),intent(out) :: dl(pcols,pver) @@ -2205,7 +2195,7 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & -md(i,k)* (sd(i,k)-shat(i,k)) & )/dp(i,k) - if (zm_param%zm_microp) dsdt(i,k) = dsdt(i,k) + zm_const%latice/zm_const%cpair*frz(i,k) + if (zm_param%zm_microp) dsdt(i,k) = dsdt(i,k) + zm_const%latice/zm_const%cpair*loc_microp_st%frz(i,k) dqdt(i,k) = emc + & (+mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)) & diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index fbfae9c33051..6f403f163c91 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -536,8 +536,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & real(r8), dimension(pcols,pver,2) :: icwd real(r8), dimension(pcols,pver) :: seten - real(r8), dimension(pcols,pver) :: frz - !---------------------------------------------------------------------------- if (zm_param%zm_microp) call zm_microp_st_alloc(microp_st, pcols, pver) @@ -635,7 +633,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & ql, rliq, rprd, dlf, & - frz, mudpcu, lambdadpcu ) + mudpcu, lambdadpcu ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then @@ -648,7 +646,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & dnsf(1:ncol,1:pver) = microp_st%dnsf(1:ncol,1:pver) ! update other micro variables rice(1:ncol) = microp_st%rice(1:ncol) - microp_st%frz (1:ncol,1:pver) = frz (1:ncol,1:pver) dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) wuc(1:pcols,1:pver) = microp_st%wu(1:pcols,1:pver) else From 605bc289d7fbe0c9a81360c9cc280ecceeb1cd7e Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 15:39:25 -0700 Subject: [PATCH 09/31] move mudpcu and lambdadpcu to microp_st --- components/eam/src/physics/cam/zm_conv.F90 | 30 ++++--------------- .../eam/src/physics/cam/zm_conv_intr.F90 | 17 ++++++----- 2 files changed, 15 insertions(+), 32 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index ba0cdc83783b..9078ddfb2da9 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -78,8 +78,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & lengath, ideep, maxg, jctop, jcbot, jt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & - ql, rliq, rprd, dlf, & - mudpcu, lambdadpcu ) + ql, rliq, rprd, dlf ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -131,8 +130,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio - real(r8), dimension(pcols,pver), intent( out) :: mudpcu ! ZM microphysics - width parameter of droplet size distr - real(r8), dimension(pcols,pver), intent( out) :: lambdadpcu ! ZM microphysics - slope of cloud liquid size distr !---------------------------------------------------------------------------- ! Local variables real(r8), dimension(pcols,pver) :: q ! local copy of specific humidity [kg/kg] @@ -210,9 +207,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols,pver) :: dudt ! gathered u-wind tendency at gathered points real(r8), dimension(pcols,pver) :: dvdt ! gathered v-wind tendency at gathered points - real(r8), dimension(pcols,pver) :: lambdadpcug ! ZM microphysics - gathered slope of cloud liquid size distr - real(r8), dimension(pcols,pver) :: mudpcug ! ZM microphysics - gathered width parameter of droplet size distr - real(r8), dimension(pcols) :: mb ! cloud base mass flux integer, dimension(pcols) :: jlcl ! updraft lifting cond level integer, dimension(pcols) :: j0 ! detrainment initiation level index @@ -267,17 +261,14 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & jcbot(i) = 1 end do - lambdadpcu = (mucon + 1._r8)/dcon - mudpcu = mucon - lambdadpcug = lambdadpcu - mudpcug = mudpcu - !---------------------------------------------------------------------------- ! Allocate and/or Initialize microphysics state/tend derived types if (zm_param%zm_microp) then call zm_microp_st_alloc(loc_microp_st, ncol, pver) call zm_microp_st_ini(loc_microp_st, ncol, pver) call zm_microp_st_ini(microp_st, ncol, pver) + loc_microp_st%lambdadpcu = (mucon + 1._r8)/dcon + loc_microp_st%mudpcu = mucon end if !---------------------------------------------------------------------------- @@ -495,8 +486,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & maxg ,j0 ,jd ,lengath ,msg , & pflxg ,evpg ,cug ,rprdg ,zm_param%limcnv , & landfracg, tpertg, & - aero ,lambdadpcug,mudpcug, & ! < added for ZM micro - loc_microp_st ) ! < added for ZM micro + aero ,loc_microp_st ) ! < added for ZM micro !---------------------------------------------------------------------------- @@ -620,9 +610,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & dlf (ideep(i),k) = dlg (i,k) pflx(ideep(i),k) = pflxg(i,k) ql (ideep(i),k) = qlg (i,k) - - lambdadpcu(ideep(i),k) = lambdadpcug(i,k) - mudpcu(ideep(i),k) = mudpcug(i,k) end do end do @@ -949,8 +936,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & mx ,j0 ,jd ,il2g ,msg , & pflx ,evp ,cu ,rprd ,limcnv , & landfrac,tpertg , & - aero ,lambdadpcu ,mudpcu, & - loc_microp_st ) + aero ,loc_microp_st ) !----------------------------------------------------------------------- ! @@ -1033,10 +1019,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! Convective microphysics type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics - ! tendency for output - real(r8), intent(inout) :: lambdadpcu(pcols,pver) ! slope of cloud liquid size distr - real(r8), intent(inout) :: mudpcu(pcols,pver) ! width parameter of droplet size distr - ! ! Local workspace ! @@ -1628,7 +1610,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%autoim, loc_microp_st%accsim, loc_microp_st%difm, loc_microp_st%nuclin, & loc_microp_st%autoin, loc_microp_st%accsin, loc_microp_st%hmpin, loc_microp_st%difn, & loc_microp_st%trspcm, loc_microp_st%trspcn, loc_microp_st%trspim, loc_microp_st%trspin, & - lambdadpcu, mudpcu, & + loc_microp_st%lambdadpcu,loc_microp_st%mudpcu, & loc_microp_st%accgrm, loc_microp_st%accglm, loc_microp_st%accgslm, loc_microp_st%accgsrm, & loc_microp_st%accgirm, loc_microp_st%accgrim, loc_microp_st%accgrsm, loc_microp_st%accgsln, & loc_microp_st%accgsrn, loc_microp_st%accgirn, loc_microp_st%accsrim, loc_microp_st%acciglm, & diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 6f403f163c91..9e740116dba1 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -632,18 +632,19 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & lengath, ideep, maxg, jctop, jcbot, jt, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & - ql, rliq, rprd, dlf, & - mudpcu, lambdadpcu ) + ql, rliq, rprd, dlf ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then ! update ZM micro variables in pbuf - qi (1:ncol,1:pver) = microp_st%qice(1:ncol,1:pver) - dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) - dsf (1:ncol,1:pver) = microp_st%dsf (1:ncol,1:pver) - dnlf(1:ncol,1:pver) = microp_st%dnlf(1:ncol,1:pver) - dnif(1:ncol,1:pver) = microp_st%dnif(1:ncol,1:pver) - dnsf(1:ncol,1:pver) = microp_st%dnsf(1:ncol,1:pver) + qi (1:ncol,1:pver) = microp_st%qice (1:ncol,1:pver) + dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) + dsf (1:ncol,1:pver) = microp_st%dsf (1:ncol,1:pver) + dnlf (1:ncol,1:pver) = microp_st%dnlf (1:ncol,1:pver) + dnif (1:ncol,1:pver) = microp_st%dnif (1:ncol,1:pver) + dnsf (1:ncol,1:pver) = microp_st%dnsf (1:ncol,1:pver) + mudpcu (1:ncol,1:pver) = microp_st%mudpcu (1:ncol,1:pver) + lambdadpcu(1:ncol,1:pver) = microp_st%lambdadpcu(1:ncol,1:pver) ! update other micro variables rice(1:ncol) = microp_st%rice(1:ncol) dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) From 05989e02bee7e754829e9ff53f9f20e55452e428 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 13 Oct 2025 15:46:45 -0700 Subject: [PATCH 10/31] move aero/micro to end of arg list bug fix for circular dependency --- components/eam/src/physics/cam/zm_conv.F90 | 9 ++++----- components/eam/src/physics/cam/zm_conv_intr.F90 | 3 +-- components/eam/src/physics/cam/zm_microphysics.F90 | 7 ++++--- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 9078ddfb2da9..639a0e52a241 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -74,11 +74,10 @@ end subroutine zm_convi subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & t, qh, omega, pap, paph, dpp, geos, zm, zi, pblh, & tpert, landfrac, t_star, q_star, & - aero, microp_st, & lengath, ideep, maxg, jctop, jcbot, jt, & prec, heat, qtnd, cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & - ql, rliq, rprd, dlf ) + ql, rliq, rprd, dlf, aero, microp_st ) !---------------------------------------------------------------------------- ! Purpose: Main driver for Zhang-Mcfarlane convection scheme !---------------------------------------------------------------------------- @@ -103,8 +102,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent(in ) :: landfrac ! land fraction real(r8),pointer,dimension(:,:), intent(in ) :: t_star ! for DCAPE - prev temperature [K] real(r8),pointer,dimension(:,:), intent(in ) :: q_star ! for DCAPE - prev sp. humidity [kg/kg] - type(zm_aero_t), intent(inout) :: aero ! aerosol object - type(zm_microp_st), intent(inout) :: microp_st ! convective microphysics state and tendencies integer, intent( out) :: lengath ! number of active columns in chunk for gathering integer, dimension(pcols), intent( out) :: ideep ! flag for active columns integer, dimension(pcols), intent( out) :: maxg ! gathered level indices of max MSE (maxi) @@ -130,6 +127,8 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & real(r8), dimension(pcols), intent( out) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals real(r8), dimension(pcols,pver), intent( out) :: rprd ! rain production rate real(r8), dimension(pcols,pver), intent( out) :: dlf ! detrained cloud liq mixing ratio + type(zm_aero_t), intent(inout) :: aero ! aerosol object + type(zm_microp_st), intent(inout) :: microp_st ! convective microphysics state and tendencies !---------------------------------------------------------------------------- ! Local variables real(r8), dimension(pcols,pver) :: q ! local copy of specific humidity [kg/kg] @@ -588,7 +587,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- ! conservation check and adjusment #ifndef SCREAM_CONFIG_IS_CMAKE - if (zm_param%zm_microp) call zm_microphysics_adjust(pcols, lengath, pver, jt, msg, delt, & + if (zm_param%zm_microp) call zm_microphysics_adjust(pcols, lengath, pver, jt, msg, delt, zm_const, & dp, qg, dlg, dsdt, dqdt, rprd, loc_microp_st) #endif diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 9e740116dba1..a6676196b031 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -628,11 +628,10 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & state%pmid, state%pint, state%pdel, & state%phis, state%zm, state%zi, pblh, & tpert, landfrac, t_star, q_star, & - aero(lchnk), microp_st, & lengath, ideep, maxg, jctop, jcbot, jt, & prec, ptend_loc%s, ptend_loc%q(:,:,1), cape, dcape, & mcon, pflx, zdu, mu, eu, du, md, ed, dp, dsubcld, & - ql, rliq, rprd, dlf ) + ql, rliq, rprd, dlf, aero(lchnk), microp_st ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then diff --git a/components/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90 index b1023da785ff..9c9333da4125 100644 --- a/components/eam/src/physics/cam/zm_microphysics.F90 +++ b/components/eam/src/physics/cam/zm_microphysics.F90 @@ -3211,20 +3211,21 @@ end subroutine zm_mphy !=================================================================================================== -subroutine zm_microphysics_adjust(pcols, ncol, pver, jt, msg, delt, & +subroutine zm_microphysics_adjust(pcols, ncol, pver, jt, msg, delt, zm_const, & dp, qv, dl, dsdt, dqdt, rprd, microp_st) !---------------------------------------------------------------------------- ! Purpose: adjust ZM microphysics variables to avoid negative water !---------------------------------------------------------------------------- - use zm_conv, only: zm_const + use zm_conv_types, only: zm_const_t !---------------------------------------------------------------------------- ! Arguments integer, intent(in ) :: pcols ! maximum number of columns integer, intent(in ) :: ncol ! actual number of columns integer, intent(in ) :: pver ! number of mid-point levels - integer, intent(in ) :: msg ! number of levels to skip at model top integer, dimension(pcols), intent(in ) :: jt ! top index of deep convection + integer, intent(in ) :: msg ! number of levels to skip at model top real(r8), intent(in ) :: delt ! model time-step [s] + type(zm_const_t), intent(in ) :: zm_const ! derived type to hold ZM constants real(r8), dimension(pcols,pver), intent(in ) :: dp ! pressure thickness [Pa] real(r8), dimension(pcols,pver), intent(in ) :: qv ! specific humidity [kg/kg] real(r8), dimension(pcols,pver), intent(inout) :: dl ! detraining cld h2o tend From 6b49592c9f61e7d705598f5e88607989da48fdde Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 14 Oct 2025 09:31:55 -0700 Subject: [PATCH 11/31] move MCSP output to zm_conv_mcsp_hist --- .../eam/src/physics/cam/zm_conv_intr.F90 | 21 +++++- .../eam/src/physics/cam/zm_conv_mcsp.F90 | 69 ++++++++++++------- 2 files changed, 62 insertions(+), 28 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index a6676196b031..7c61ae4aa228 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -424,7 +424,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & use time_manager, only: get_curr_date use interpolate_data, only: vertinterp use zm_conv, only: zm_const, zm_param - use zm_conv_mcsp, only: zm_conv_mcsp_tend + use zm_conv_mcsp, only: zm_conv_mcsp_tend, zm_conv_mcsp_hist use zm_microphysics, only: dnlfzm_idx, dnifzm_idx, dsfzm_idx, dnsfzm_idx, wuc_idx use zm_microphysics_state, only: zm_microp_st_alloc, zm_microp_st_dealloc use zm_microphysics_history, only: zm_microphysics_history_convert, zm_microphysics_history_out @@ -486,6 +486,15 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & logical :: do_mcsp_u = .false. logical :: do_mcsp_v = .false. + ! MCSP history output variables + real(r8), dimension(pcols,pver) :: mcsp_dt_out ! MCSP tendency for DSE + real(r8), dimension(pcols,pver) :: mcsp_dq_out ! MCSP tendency for qv + real(r8), dimension(pcols,pver) :: mcsp_du_out ! MCSP tendency for u wind + real(r8), dimension(pcols,pver) :: mcsp_dv_out ! MCSP tendency for v wind + real(r8), dimension(pcols) :: mcsp_freq ! MSCP frequency for output + real(r8), dimension(pcols) :: mcsp_shear ! shear used to check against threshold + real(r8), dimension(pcols) :: zm_depth ! pressure depth of ZM heating + ! physics buffer fields real(r8), pointer, dimension(:) :: prec ! total precipitation real(r8), pointer, dimension(:) :: snow ! snow from ZM convection @@ -669,13 +678,19 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call physics_ptend_init( ptend_mcsp, state%psetcols, 'zm_conv_mcsp_tend', & ls=do_mcsp_t, lq=do_mcsp_q, lu=do_mcsp_u, lv=do_mcsp_v) - call zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & + call zm_conv_mcsp_tend( pcols, ncol, pver, pverp, & ztodt, jctop, zm_const, zm_param, & state%pmid, state%pint, state%pdel, & state%s, state%q, state%u, state%v, & ptend_loc%s, ptend_loc%q(:,:,1), & ptend_mcsp%s(:,:), ptend_mcsp%q(:,:,1), & - ptend_mcsp%u(:,:), ptend_mcsp%v(:,:) ) + ptend_mcsp%u(:,:), ptend_mcsp%v(:,:), & + mcsp_dt_out, mcsp_dq_out, mcsp_du_out, mcsp_dv_out, & + mcsp_freq, mcsp_shear, zm_depth ) + + call zm_conv_mcsp_hist( lchnk, pcols, pver, & + mcsp_dt_out, mcsp_dq_out, mcsp_du_out, mcsp_dv_out, & + mcsp_freq, mcsp_shear, zm_depth ) ! add MCSP tendencies to ZM convective tendencies call physics_ptend_sum( ptend_mcsp, ptend_loc, ncol) diff --git a/components/eam/src/physics/cam/zm_conv_mcsp.F90 b/components/eam/src/physics/cam/zm_conv_mcsp.F90 index d797d98d69cf..c4b1fee83f2d 100644 --- a/components/eam/src/physics/cam/zm_conv_mcsp.F90 +++ b/components/eam/src/physics/cam/zm_conv_mcsp.F90 @@ -39,10 +39,9 @@ module zm_conv_mcsp implicit none private -#ifndef SCREAM_CONFIG_IS_CMAKE public :: zm_conv_mcsp_init ! Initialize MCSP output fields -#endif public :: zm_conv_mcsp_tend ! Perform MCSP tendency calculations + public :: zm_conv_mcsp_hist ! Write diagnostic quantities to history files real(r8), parameter :: MCSP_storm_speed_pref = 600e2_r8 ! pressure level for winds in MCSP calculation [Pa] real(r8), parameter :: MCSP_conv_depth_min = 700e2_r8 ! pressure thickness of convective heating [Pa] @@ -53,13 +52,11 @@ module zm_conv_mcsp contains !=================================================================================================== -! We need to avoid building this for now when bridging from EAMxx -#ifndef SCREAM_CONFIG_IS_CMAKE - subroutine zm_conv_mcsp_init() !---------------------------------------------------------------------------- ! Purpose: initialize MCSP output fields !---------------------------------------------------------------------------- +#ifndef SCREAM_CONFIG_IS_CMAKE use cam_history, only: addfld, horiz_only use mpishorthand !---------------------------------------------------------------------------- @@ -71,11 +68,10 @@ subroutine zm_conv_mcsp_init() call addfld('MCSP_freq', horiz_only, 'A', '1', 'MCSP frequency of activation') call addfld('MCSP_shear', horiz_only, 'A', 'm/s', 'MCSP vertical shear of zonal wind') call addfld('MCSP_zm_depth', horiz_only, 'A', 'Pa', 'ZM convection depth for MCSP') +#endif /* SCREAM_CONFIG_IS_CMAKE */ end subroutine zm_conv_mcsp_init -#endif /* SCREAM_CONFIG_IS_CMAKE */ - !=================================================================================================== subroutine zm_conv_mcsp_calculate_shear( pcols, ncol, pver, state_pmid, state_u, state_v, mcsp_shear) @@ -128,21 +124,18 @@ end subroutine zm_conv_mcsp_calculate_shear !=================================================================================================== -subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & +subroutine zm_conv_mcsp_tend( pcols, ncol, pver, pverp, & ztodt, jctop, zm_const, zm_param, & state_pmid, state_pint, state_pdel, & state_s, state_q, state_u, state_v, & ptend_zm_s, ptend_zm_q, & - ptend_s, ptend_q, ptend_u, ptend_v ) + ptend_s, ptend_q, ptend_u, ptend_v, & + mcsp_dt_out, mcsp_dq_out, mcsp_du_out, mcsp_dv_out, & + mcsp_freq, mcsp_shear, zm_depth ) !---------------------------------------------------------------------------- ! Purpose: perform MCSP tendency calculations !---------------------------------------------------------------------------- -#ifndef SCREAM_CONFIG_IS_CMAKE - use cam_history, only: outfld -#endif - !---------------------------------------------------------------------------- ! Arguments - integer, intent(in ) :: lchnk ! chunk identifier integer, intent(in ) :: pcols ! number of atmospheric columns (max) integer, intent(in ) :: ncol ! number of atmospheric columns (actual) integer, intent(in ) :: pver ! number of mid-point vertical levels @@ -164,6 +157,13 @@ subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & real(r8), dimension(pcols,pver), intent(inout) :: ptend_q ! output tendency of qv real(r8), dimension(pcols,pver), intent(inout) :: ptend_u ! output tendency of u-wind real(r8), dimension(pcols,pver), intent(inout) :: ptend_v ! output tendency of v-wind + real(r8), dimension(pcols,pver), intent( out) :: mcsp_dt_out! final MCSP tendency for DSE + real(r8), dimension(pcols,pver), intent( out) :: mcsp_dq_out! final MCSP tendency for qv + real(r8), dimension(pcols,pver), intent( out) :: mcsp_du_out! final MCSP tendency for u wind + real(r8), dimension(pcols,pver), intent( out) :: mcsp_dv_out! final MCSP tendency for v wind + real(r8), dimension(pcols), intent( out) :: mcsp_freq ! MSCP frequency for output + real(r8), dimension(pcols), intent( out) :: mcsp_shear ! shear used to check against threshold + real(r8), dimension(pcols), intent( out) :: zm_depth ! pressure depth of ZM heating !---------------------------------------------------------------------------- ! Local variables integer :: i, k @@ -174,8 +174,6 @@ subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & real(r8), dimension(pcols) :: zm_avg_tend_s ! mass weighted column average DSE tendency from ZM real(r8), dimension(pcols) :: zm_avg_tend_q ! mass weighted column average qv tendency from ZM - real(r8), dimension(pcols) :: zm_depth ! pressure depth of ZM heating - real(r8), dimension(pcols) :: mcsp_shear ! shear used to check against threshold real(r8), dimension(pcols) :: pdel_sum ! column integrated pressure thickness real(r8), dimension(pcols,pver) :: mcsp_tend_s ! MCSP tendency before energy fixer for DSE @@ -187,12 +185,6 @@ subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & real(r8), dimension(pcols) :: mcsp_avg_tend_q ! mass weighted column average MCSP tendency of qv real(r8), dimension(pcols) :: mcsp_avg_tend_k ! mass weighted column average MCSP tendency of kinetic energy - real(r8), dimension(pcols) :: mcsp_freq ! MSCP frequency for output - real(r8), dimension(pcols,pver) :: mcsp_dt_out ! final MCSP tendency for DSE - real(r8), dimension(pcols,pver) :: mcsp_dq_out ! final MCSP tendency for qv - real(r8), dimension(pcols,pver) :: mcsp_du_out ! final MCSP tendency for u wind - real(r8), dimension(pcols,pver) :: mcsp_dv_out ! final MCSP tendency for v wind - logical :: do_mcsp_t = .false. ! internal flag to enable tendency calculations logical :: do_mcsp_q = .false. ! internal flag to enable tendency calculations logical :: do_mcsp_u = .false. ! internal flag to enable tendency calculations @@ -351,13 +343,40 @@ subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & end do !---------------------------------------------------------------------------- - ! write out MCSP diagnostic history fields + return + +end subroutine zm_conv_mcsp_tend + +!=================================================================================================== + +subroutine zm_conv_mcsp_hist( lchnk, pcols, pver, & + mcsp_dt_out, mcsp_dq_out, mcsp_du_out, mcsp_dv_out, & + mcsp_freq, mcsp_shear, zm_depth ) + !---------------------------------------------------------------------------- + ! Purpose: write diagnostic quantities to history files + !---------------------------------------------------------------------------- #ifndef SCREAM_CONFIG_IS_CMAKE + use cam_history, only: outfld +#endif + !---------------------------------------------------------------------------- + ! Arguments + integer, intent(in) :: lchnk ! chunk identifier + integer, intent(in) :: pcols ! number of atmospheric columns (max) + integer, intent(in) :: pver ! number of mid-point vertical levels + real(r8), dimension(pcols,pver), intent(in) :: mcsp_dt_out ! final MCSP tendency for DSE + real(r8), dimension(pcols,pver), intent(in) :: mcsp_dq_out ! final MCSP tendency for qv + real(r8), dimension(pcols,pver), intent(in) :: mcsp_du_out ! final MCSP tendency for u wind + real(r8), dimension(pcols,pver), intent(in) :: mcsp_dv_out ! final MCSP tendency for v wind + real(r8), dimension(pcols), intent(in) :: mcsp_freq ! MSCP frequency for output + real(r8), dimension(pcols), intent(in) :: mcsp_shear ! shear used to check against threshold + real(r8), dimension(pcols), intent(in) :: zm_depth ! pressure depth of ZM heating + !---------------------------------------------------------------------------- +#ifndef SCREAM_CONFIG_IS_CMAKE + ! write out MCSP diagnostic history fields call outfld('MCSP_DT', mcsp_dt_out, pcols, lchnk ) call outfld('MCSP_DQ', mcsp_dq_out, pcols, lchnk ) call outfld('MCSP_DU', mcsp_du_out, pcols, lchnk ) call outfld('MCSP_DV', mcsp_dv_out, pcols, lchnk ) - call outfld('MCSP_freq', mcsp_freq, pcols, lchnk ) call outfld('MCSP_shear', mcsp_shear, pcols, lchnk ) call outfld('MCSP_zm_depth', zm_depth, pcols, lchnk ) @@ -365,7 +384,7 @@ subroutine zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & !---------------------------------------------------------------------------- return -end subroutine zm_conv_mcsp_tend +end subroutine zm_conv_mcsp_hist !=================================================================================================== From 3eb60260f2d639217c7edce0c7da13b624008fb7 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 14 Oct 2025 16:03:20 -0700 Subject: [PATCH 12/31] remove pcols from ZM fortran bridge ZM fixes for EAMxx bridge fix zm_transport_tracer call --- components/eam/src/physics/cam/zm_conv.F90 | 12 +- .../eam/src/physics/cam/zm_conv_intr.F90 | 8 +- .../eam/src/physics/cam/zm_conv_mcsp.F90 | 2 +- .../eam/src/physics/cam/zm_transport.F90 | 15 +- .../physics/zm/eamxx_zm_process_interface.cpp | 45 ++- .../physics/zm/eamxx_zm_process_interface.hpp | 1 - .../zm/fortran_bridge/zm_eamxx_bridge.cpp | 7 +- .../zm/fortran_bridge/zm_eamxx_bridge.hpp | 2 +- .../fortran_bridge/zm_eamxx_bridge_main.F90 | 278 ++++++++---------- .../zm_eamxx_bridge_methods.F90 | 73 +++-- .../fortran_bridge/zm_eamxx_bridge_params.F90 | 1 - .../zm_eamxx_bridge_physconst.F90 | 4 +- .../eamxx/src/physics/zm/zm_functions.hpp | 2 +- 13 files changed, 210 insertions(+), 240 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 639a0e52a241..bf59c289314d 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -2149,11 +2149,13 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & dqdt(i,k) = 0._r8 dl(i,k) = 0._r8 ! Convective microphysics - loc_microp_st%dif(i,k) = 0._r8 - loc_microp_st%dsf(i,k) = 0._r8 - loc_microp_st%dnlf(i,k) = 0._r8 - loc_microp_st%dnif(i,k) = 0._r8 - loc_microp_st%dnsf(i,k) = 0._r8 + if (zm_param%zm_microp) then + loc_microp_st%dif(i,k) = 0._r8 + loc_microp_st%dsf(i,k) = 0._r8 + loc_microp_st%dnlf(i,k) = 0._r8 + loc_microp_st%dnif(i,k) = 0._r8 + loc_microp_st%dnsf(i,k) = 0._r8 + end if end do end do diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 7c61ae4aa228..4ebfd0ca315a 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -827,7 +827,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & winds(1:ncol,1:pver,2) = state1%v(1:ncol,1:pver) call t_startf ('zm_transport_momentum') - call zm_transport_momentum( ncol, winds, 2, & + call zm_transport_momentum( pcols, ncol, pver, pverp, winds, 2, & mu, md, du, eu, ed, dp, & jt, maxg, ideep, 1, lengath, & wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten ) @@ -874,7 +874,8 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & fake_dpdry(1:ncol,1:pver) = 0 call t_startf ('zm_transport_tracer_1') - call zm_transport_tracer( ptend_loc%lq, state1%q, pcnst, & + call zm_transport_tracer( pcols, ncol, pver, & + ptend_loc%lq, state1%q, pcnst, & mu, md, du, eu, ed, dp, & jt, maxg, ideep, 1, lengath, & fracis, ptend_loc%q, fake_dpdry, ztodt) @@ -970,7 +971,8 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf, mu, eu, du, md, ed, dp, dpdry(i,1:pver) = state%pdeldry(ideep(i),1:pver)/100_r8 end do call t_startf ('zm_transport_tracer_2') - call zm_transport_tracer( ptend%lq, state%q, pcnst, & + call zm_transport_tracer( pcols, ncol, pver, & + ptend%lq, state%q, pcnst, & mu, md, du, eu, ed, dp, & jt, maxg, ideep, 1, lengath, & fracis, ptend%q, dpdry, ztodt) diff --git a/components/eam/src/physics/cam/zm_conv_mcsp.F90 b/components/eam/src/physics/cam/zm_conv_mcsp.F90 index c4b1fee83f2d..68a56817f5f6 100644 --- a/components/eam/src/physics/cam/zm_conv_mcsp.F90 +++ b/components/eam/src/physics/cam/zm_conv_mcsp.F90 @@ -28,7 +28,7 @@ module zm_conv_mcsp ! !---------------------------------------------------------------------------- #ifdef SCREAM_CONFIG_IS_CMAKE - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp + use zm_eamxx_bridge_params, only: r8 #else use shr_kind_mod, only: r8=>shr_kind_r8 use cam_abortutils, only: endrun diff --git a/components/eam/src/physics/cam/zm_transport.F90 b/components/eam/src/physics/cam/zm_transport.F90 index 0cba04a9a28c..6a38a212a2a9 100644 --- a/components/eam/src/physics/cam/zm_transport.F90 +++ b/components/eam/src/physics/cam/zm_transport.F90 @@ -5,7 +5,7 @@ module zm_transport ! !---------------------------------------------------------------------------- #ifdef SCREAM_CONFIG_IS_CMAKE - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp + use zm_eamxx_bridge_params, only: r8 #else use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid @@ -32,7 +32,8 @@ module zm_transport ! We need to avoid building this for now when bridging from EAMxx #ifndef SCREAM_CONFIG_IS_CMAKE -subroutine zm_transport_tracer( doconvtran, q, ncnst, & +subroutine zm_transport_tracer( pcols, ncol, pver, & + doconvtran, q, ncnst, & mu, md, du, eu, ed, dp, & jt, mx, ideep, il1g, il2g, & fracis, dqdt, dpdry, dt ) @@ -43,6 +44,9 @@ subroutine zm_transport_tracer( doconvtran, q, ncnst, & use constituents, only: cnst_get_type_byind !---------------------------------------------------------------------------- ! Arguments + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point levels integer, intent(in) :: ncnst ! number of tracers to transport logical, dimension(ncnst), intent(in) :: doconvtran ! flag for doing convective transport real(r8), dimension(pcols,pver,ncnst), intent(in) :: q ! tracer array (including water vapor) @@ -308,7 +312,7 @@ end subroutine zm_transport_tracer !=================================================================================================== -subroutine zm_transport_momentum( ncol, wind_in, nwind, & +subroutine zm_transport_momentum( pcols, ncol, pver, pverp, wind_in, nwind, & mu, md, du, eu, ed, dp, & jt, mx, ideep, il1g, il2g, & wind_tend, pguall, pgdall, icwu, icwd, dt, seten ) @@ -318,7 +322,10 @@ subroutine zm_transport_momentum( ncol, wind_in, nwind, & use zm_conv, only: zm_param !---------------------------------------------------------------------------- ! Arguments - integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: pcols ! maximum number of columns + integer, intent(in) :: ncol ! actual number of columns + integer, intent(in) :: pver ! number of mid-point levels + integer, intent(in) :: pverp ! number of interface levels integer, intent(in) :: nwind ! number of tracers to transport real(r8), dimension(pcols,pver,nwind), intent(in) :: wind_in ! input Momentum array real(r8), dimension(pcols,pver), intent(in) :: mu ! mass flux up diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 9e43331b22e0..9efb6fd0ec3e 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -47,10 +47,6 @@ void ZMDeepConvection::set_grids (const std::shared_ptr grid m_ncol = m_grid->get_num_local_dofs(); m_nlev = m_grid->get_num_vertical_levels(); - // get max ncol value across ranks to mimic how pcols is used on the fortran side - m_pcol = m_ncol; - comm.all_reduce(&m_pcol, 1, MPI_MAX); - const auto nondim = Units::nondimensional(); const auto m2 = pow(m,2); const auto s2 = pow(s,2); @@ -106,7 +102,7 @@ void ZMDeepConvection::initialize_impl (const RunType) add_postcondition_check(get_field_out("precip_ice_surf_mass"),m_grid,0.0,false); // initialize variables on the fortran side - zm::zm_eamxx_bridge_init(m_pcol, m_nlev); + zm::zm_eamxx_bridge_init(m_nlev); } /*------------------------------------------------------------------------------------------------*/ @@ -173,7 +169,7 @@ void ZMDeepConvection::run_impl (const double dt) zm_input.landfrac = landfrac; // initialize output buffer variables - zm_output.init(m_pcol, m_nlev); + zm_output.init(m_ncol, m_nlev); //---------------------------------------------------------------------------- // calculate altitude on interfaces (z_int) and mid-points (z_mid) @@ -261,7 +257,6 @@ void ZMDeepConvection::run_impl (const double dt) // Update output fields // NOTE - in the future we might want to clean this up using Kokkos::deep_copy(), - // but this is currently not possible due to the pcol/ncol thing for the fortran bridge // 2D output (no vertical dimension) const auto& zm_prec = get_field_out("zm_prec") .get_view(); @@ -306,21 +301,21 @@ size_t ZMDeepConvection::requested_buffer_size_in_bytes() const const int nlevi_packs = ekat::npack(m_nlev+1); size_t zm_buffer_size = 0; - zm_buffer_size+= ZMF::zm_input_state::num_1d_intgr_views * sizeof(Int) * m_pcol; - zm_buffer_size+= ZMF::zm_input_state::num_1d_scalr_views * sizeof(Scalar)* m_pcol; + zm_buffer_size+= ZMF::zm_input_state::num_1d_intgr_views * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_1d_scalr_views * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_c_views * sizeof(Spack) * m_pcol * nlevm_packs; - zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_c_views * sizeof(Spack) * m_pcol * nlevi_packs; - zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_f_views * sizeof(Real) * m_pcol * m_nlev; - zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_f_views * sizeof(Real) * m_pcol * (m_nlev+1); + zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_c_views * sizeof(Spack) * m_ncol * nlevm_packs; + zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_c_views * sizeof(Spack) * m_ncol * nlevi_packs; + zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_f_views * sizeof(Real) * m_ncol * m_nlev; + zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_f_views * sizeof(Real) * m_ncol * (m_nlev+1); - zm_buffer_size+= ZMF::zm_output_tend::num_1d_scalr_views * sizeof(Scalar)* m_pcol; - zm_buffer_size+= ZMF::zm_output_tend::num_1d_intgr_views * sizeof(Int) * m_pcol; + zm_buffer_size+= ZMF::zm_output_tend::num_1d_scalr_views * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_1d_intgr_views * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_c_views * sizeof(Spack) * m_pcol * nlevm_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_c_views * sizeof(Spack) * m_pcol * nlevi_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_f_views * sizeof(Real) * m_pcol * m_nlev; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_f_views * sizeof(Real) * m_pcol * (m_nlev+1); + zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_c_views * sizeof(Spack) * m_ncol * nlevm_packs; + zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_c_views * sizeof(Spack) * m_ncol * nlevi_packs; + zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_f_views * sizeof(Real) * m_ncol * m_nlev; + zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_f_views * sizeof(Real) * m_ncol * (m_nlev+1); return zm_buffer_size; } @@ -349,7 +344,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) ZMF::uview_1d* int_ptrs[num_1d_intgr_views] = { &zm_output.activity }; for (int i=0; i(i_mem, m_pcol); + *int_ptrs[i] = ZMF::uview_1d(i_mem, m_ncol); i_mem += int_ptrs[i]->size(); } //---------------------------------------------------------------------------- @@ -362,7 +357,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.cape }; for (int i=0; i(scl_mem, m_pcol); + *scl_ptrs[i] = ZMF::uview_1d(scl_mem, m_ncol); scl_mem += scl_ptrs[i]->size(); } //---------------------------------------------------------------------------- @@ -386,7 +381,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_snow_prod }; for (int i=0; i(r_mem, m_pcol, m_nlev); + *midlv_f_ptrs[i] = ZMF::uview_2dl(r_mem, m_ncol, m_nlev); r_mem += midlv_f_ptrs[i]->size(); } //---------------------------------------------------------------------------- @@ -398,7 +393,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_mass_flux }; for (int i=0; i(r_mem, m_pcol, (m_nlev+1)); + *intfc_f_ptrs[i] = ZMF::uview_2dl(r_mem, m_ncol, (m_nlev+1)); r_mem += intfc_f_ptrs[i]->size(); } //---------------------------------------------------------------------------- @@ -415,7 +410,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.snow_prod }; for (int i=0; i(spk_mem, m_pcol, nlevm_packs); + *midlv_c_ptrs[i] = ZMF::uview_2d(spk_mem, m_ncol, nlevm_packs); spk_mem += midlv_c_ptrs[i]->size(); } //---------------------------------------------------------------------------- @@ -426,7 +421,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.mass_flux }; for (int i=0; i(spk_mem, m_pcol, nlevi_packs); + *intfc_c_ptrs[i] = ZMF::uview_2d(spk_mem, m_ncol, nlevi_packs); spk_mem += intfc_c_ptrs[i]->size(); } //---------------------------------------------------------------------------- diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.hpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.hpp index 67b3508d380a..8d400a52c913 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.hpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.hpp @@ -58,7 +58,6 @@ class ZMDeepConvection : public AtmosphereProcess // define ZM process variables std::shared_ptr m_grid; - int m_pcol; int m_ncol; int m_nlev; diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp index a106c6efa4d0..dfcff605a1d9 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp @@ -6,8 +6,7 @@ using scream::Int; // A C++ interface to ZM fortran calls and vice versa extern "C" { - void zm_eamxx_bridge_init_c(Int pcol_in, - Int pver_in ); + void zm_eamxx_bridge_init_c( Int pver_in ); void zm_eamxx_bridge_run_c( Int ncol, // 01 Real dtime, // 02 @@ -46,8 +45,8 @@ extern "C" { namespace scream { namespace zm { -void zm_eamxx_bridge_init( Int pcol, Int pver ){ - zm_eamxx_bridge_init_c( pcol, pver ); +void zm_eamxx_bridge_init( Int pver ){ + zm_eamxx_bridge_init_c( pver ); } void zm_eamxx_bridge_run( Int ncol, Int pver, diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.hpp b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.hpp index bbb550ef168f..6282a39b9537 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.hpp +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.hpp @@ -14,7 +14,7 @@ namespace zm { using ZMF = zm::Functions; // Glue functions to call fortran from from C++ with the Data struct -void zm_eamxx_bridge_init( Int pcols, Int pver ); +void zm_eamxx_bridge_init( Int pver ); void zm_eamxx_bridge_run( Int ncol, Int pver, ZMF::zm_input_state& zm_input, ZMF::zm_output_tend& zm_output, diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 index c6c19bbc24f3..52344df3a2d4 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 @@ -6,7 +6,7 @@ module zm_eamxx_bridge_main use iso_c_binding use cam_logfile, only: iulog use shr_sys_mod, only: shr_sys_flush - use zm_eamxx_bridge_params, only: masterproc, r8, pcols, pver, pverp, top_lev + use zm_eamxx_bridge_params, only: masterproc, r8, pver, pverp, top_lev !----------------------------------------------------------------------------- implicit none private @@ -26,7 +26,7 @@ module zm_eamxx_bridge_main contains !=================================================================================================== -subroutine zm_eamxx_bridge_init_c( pcol_in, pver_in ) bind(C) +subroutine zm_eamxx_bridge_init_c( pver_in ) bind(C) use mpi use zm_conv, only: zm_const, zm_param use zm_conv_types, only: zm_const_set_for_testing, zm_param_set_for_testing @@ -34,13 +34,11 @@ subroutine zm_eamxx_bridge_init_c( pcol_in, pver_in ) bind(C) use zm_eamxx_bridge_wv_saturation, only: wv_sat_init !----------------------------------------------------------------------------- ! Arguments - integer(kind=c_int), value, intent(in) :: pcol_in integer(kind=c_int), value, intent(in) :: pver_in !----------------------------------------------------------------------------- ! Local variables integer :: mpi_rank, ierror !----------------------------------------------------------------------------- - pcols = pcol_in pver = pver_in pverp = pver+1 top_lev = 1 @@ -90,37 +88,37 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & use zm_conv_types, only: zm_param_print, zm_const_print !----------------------------------------------------------------------------- ! Arguments - integer(kind=c_int), value, intent(in ) :: ncol ! 01 number of columns on rank - real(kind=c_real), value, intent(in ) :: dtime ! 02 time step - logical(kind=c_bool), value, intent(in ) :: is_first_step ! 03 flag for first step - real(kind=c_real), dimension(pcols), intent(in ) :: state_phis ! 04 input state surface geopotential height - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_zm ! 05 input state altitude at mid-levels - real(kind=c_real), dimension(pcols,pverp),intent(in ) :: state_zi ! 06 input state altitude at interfaces - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_p_mid ! 07 input state mid-point pressure - real(kind=c_real), dimension(pcols,pverp),intent(in ) :: state_p_int ! 08 input state interface pressure - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_p_del ! 09 input state pressure thickness - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_t ! 10 input state temperature - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_qv ! 11 input state water vapor - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_u ! 12 input state zonal wind - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_v ! 13 input state meridional wind - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_omega ! 14 input state vertical pressure velocity - real(kind=c_real), dimension(pcols,pver), intent(in ) :: state_cldfrac ! 15 input state cloud fraction (cld) - real(kind=c_real), dimension(pcols), intent(in ) :: state_pblh ! 16 input planetary boundary layer height (pblh) - real(kind=c_real), dimension(pcols), intent(in ) :: tpert ! 17 input parcel temperature perturbation - real(kind=c_real), dimension(pcols), intent(in ) :: landfrac ! 18 land fraction - real(kind=c_real), dimension(pcols), intent( out) :: output_prec ! 19 output total precipitation (prec) - real(kind=c_real), dimension(pcols), intent( out) :: output_snow ! 20 output frozen precipitation (snow) - real(kind=c_real), dimension(pcols), intent( out) :: output_cape ! 21 output convective avail. pot. energy (cape) - integer(kind=c_int),dimension(pcols), intent( out) :: output_activity ! 22 integer deep convection activity flag (ideep) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_tend_s ! 23 output tendency of dry static energy (ptend_loc_s) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_tend_q ! 24 output tendency of water vapor (ptend_loc_q) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_tend_u ! 25 output tendency of zonal wind (ptend_loc_u) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_tend_v ! 26 output tendency of meridional wind (ptend_loc_v) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_rain_prod ! 27 rain production rate (rprd) - real(kind=c_real), dimension(pcols,pver), intent( out) :: output_snow_prod ! 28 snow production rate (sprd) - real(kind=c_real), dimension(pcols,pverp),intent( out) :: output_prec_flux ! 29 output precip flux at each mid-levels (flxprec/pflx) - real(kind=c_real), dimension(pcols,pverp),intent( out) :: output_snow_flux ! 30 output precip flux at each mid-levels (flxsnow) - real(kind=c_real), dimension(pcols,pverp),intent( out) :: output_mass_flux ! 31 output convective mass flux--m sub c (mcon) + integer(kind=c_int), value, intent(in ) :: ncol ! 01 number of columns on rank + real(kind=c_real), value, intent(in ) :: dtime ! 02 time step + logical(kind=c_bool), value, intent(in ) :: is_first_step ! 03 flag for first step + real(kind=c_real), dimension(ncol), intent(in ) :: state_phis ! 04 input state surface geopotential height + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_zm ! 05 input state altitude at mid-levels + real(kind=c_real), dimension(ncol,pverp),intent(in ) :: state_zi ! 06 input state altitude at interfaces + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_p_mid ! 07 input state mid-point pressure + real(kind=c_real), dimension(ncol,pverp),intent(in ) :: state_p_int ! 08 input state interface pressure + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_p_del ! 09 input state pressure thickness + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_t ! 10 input state temperature + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_qv ! 11 input state water vapor + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_u ! 12 input state zonal wind + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_v ! 13 input state meridional wind + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_omega ! 14 input state vertical pressure velocity + real(kind=c_real), dimension(ncol,pver), intent(in ) :: state_cldfrac ! 15 input state cloud fraction (cld) + real(kind=c_real), dimension(ncol), intent(in ) :: state_pblh ! 16 input planetary boundary layer height (pblh) + real(kind=c_real), dimension(ncol), intent(in ) :: tpert ! 17 input parcel temperature perturbation + real(kind=c_real), dimension(ncol), intent(in ) :: landfrac ! 18 land fraction + real(kind=c_real), dimension(ncol), intent( out) :: output_prec ! 19 output total precipitation (prec) + real(kind=c_real), dimension(ncol), intent( out) :: output_snow ! 20 output frozen precipitation (snow) + real(kind=c_real), dimension(ncol), intent( out) :: output_cape ! 21 output convective avail. pot. energy (cape) + integer(kind=c_int),dimension(ncol), intent( out) :: output_activity ! 22 integer deep convection activity flag (ideep) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_s ! 23 output tendency of dry static energy (ptend_loc_s) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_q ! 24 output tendency of water vapor (ptend_loc_q) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_u ! 25 output tendency of zonal wind (ptend_loc_u) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_v ! 26 output tendency of meridional wind (ptend_loc_v) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_rain_prod ! 27 rain production rate (rprd) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_snow_prod ! 28 snow production rate (sprd) + real(kind=c_real), dimension(ncol,pverp),intent( out) :: output_prec_flux ! 29 output precip flux at each mid-levels (flxprec/pflx) + real(kind=c_real), dimension(ncol,pverp),intent( out) :: output_snow_flux ! 30 output precip flux at each mid-levels (flxsnow) + real(kind=c_real), dimension(ncol,pverp),intent( out) :: output_mass_flux ! 31 output convective mass flux--m sub c (mcon) !----------------------------------------------------------------------------- ! Local variables integer :: i,k @@ -130,78 +128,74 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & ! arguments for zm_convr - order somewhat consistent with current interface integer :: lchnk = 0 - integer, dimension(pcols) :: jctop ! output top-of-deep-convection indices - integer, dimension(pcols) :: jcbot ! output bot-of-deep-convection indices - ! real(r8), dimension(pcols,pverp):: mcon ! convective mass flux--m sub c - real(r8), dimension(pcols,pver) :: cme ! condensation - evaporation - ! real(r8), dimension(pcols) :: cape ! convective available potential energy - ! real(r8), dimension(pcols) :: tpert ! thermal temperature excess - real(r8), dimension(pcols,pver) :: dlf ! detrained convective cloud water mixing ratio - ! real(r8), dimension(pcols,pverp):: pflx ! precip flux at each level - real(r8), dimension(pcols,pver) :: zdu ! detraining mass flux - ! real(r8), dimension(pcols,pver) :: rprd ! rain production rate - ! real(r8), dimension(pcols,pver) :: sprd ! snow production rate - real(r8), dimension(pcols,pver) :: mu ! upward cloud mass flux - real(r8), dimension(pcols,pver) :: md ! entrainment in updraft - real(r8), dimension(pcols,pver) :: du ! detrainment in updraft - real(r8), dimension(pcols,pver) :: eu ! downward cloud mass flux - real(r8), dimension(pcols,pver) :: ed ! entrainment in downdraft - real(r8), dimension(pcols,pver) :: dp ! layer thickness [mb] - real(r8), dimension(pcols) :: dsubcld ! sub-cloud layer thickness - integer, dimension(pcols) :: jt ! top level index of convection - integer, dimension(pcols) :: maxg ! gathered values of maxi - integer, dimension(pcols) :: ideep ! flag to indicate ZM is active - integer :: lengath ! number of gathered columns per chunk - real(r8), dimension(pcols) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals - real(r8), dimension(pcols,pver), target :: t_star ! DCAPE T from time step n-1 - real(r8), dimension(pcols,pver), target :: q_star ! DCAPE q from time step n-1 - real(r8), dimension(pcols) :: dcape ! DCAPE cape change - real(r8), dimension(pcols,pver) :: qi ! grid slice of cloud ice - real(r8), dimension(pcols,pver) :: dif ! detrained convective cloud ice mixing ratio - real(r8), dimension(pcols,pver) :: dnlf ! detrained convective cloud water num concen - real(r8), dimension(pcols,pver) :: dnif ! detrained convective cloud ice num concen - real(r8), dimension(pcols,pver) :: dsf ! detrained convective snow mixing ratio - real(r8), dimension(pcols,pver) :: dnsf ! detrained convective snow num concen - real(r8), dimension(pcols) :: rice ! reserved ice (not yet in cldice) for energy integrals - real(r8), dimension(pcols,pver) :: frz ! freezing rate - real(r8), dimension(pcols,pver) :: mudpcu ! width parameter of droplet size distr - real(r8), dimension(pcols,pver) :: lambdadpcu ! slope of cloud liquid size distr - type(zm_aero_t) :: aero ! derived type for aerosol information - type(zm_microp_st) :: microp_st ! ZM microphysics data structure - real(r8), dimension(pcols,pver) :: wuc ! pbuf variable for in-cloud vertical velocity - - real(r8), dimension(pcols,pver) :: state_s - real(r8), dimension(pcols,pver) :: zm_qc ! ZM in-cloud liquid water + integer, dimension(ncol) :: jctop ! output top-of-deep-convection indices + integer, dimension(ncol) :: jcbot ! output bot-of-deep-convection indices + ! real(r8), dimension(ncol,pverp):: mcon ! convective mass flux--m sub c + real(r8), dimension(ncol,pver) :: cme ! condensation - evaporation + ! real(r8), dimension(ncol) :: cape ! convective available potential energy + ! real(r8), dimension(ncol) :: tpert ! thermal temperature excess + real(r8), dimension(ncol,pver) :: dlf ! detrained convective cloud water mixing ratio + ! real(r8), dimension(ncol,pverp):: pflx ! precip flux at each level + real(r8), dimension(ncol,pver) :: zdu ! detraining mass flux + ! real(r8), dimension(ncol,pver) :: rprd ! rain production rate + ! real(r8), dimension(ncol,pver) :: sprd ! snow production rate + real(r8), dimension(ncol,pver) :: mu ! upward cloud mass flux + real(r8), dimension(ncol,pver) :: md ! entrainment in updraft + real(r8), dimension(ncol,pver) :: du ! detrainment in updraft + real(r8), dimension(ncol,pver) :: eu ! downward cloud mass flux + real(r8), dimension(ncol,pver) :: ed ! entrainment in downdraft + real(r8), dimension(ncol,pver) :: dp ! layer thickness [mb] + real(r8), dimension(ncol) :: dsubcld ! sub-cloud layer thickness + integer, dimension(ncol) :: jt ! top level index of convection + integer, dimension(ncol) :: maxg ! gathered values of maxi + integer, dimension(ncol) :: ideep ! flag to indicate ZM is active + integer :: lengath ! number of gathered columns per chunk + real(r8), dimension(ncol) :: rliq ! reserved liquid (not yet in cldliq) for energy integrals + real(r8), dimension(ncol,pver), target :: t_star ! DCAPE T from time step n-1 + real(r8), dimension(ncol,pver), target :: q_star ! DCAPE q from time step n-1 + real(r8), dimension(ncol) :: dcape ! DCAPE cape change + type(zm_aero_t) :: aero ! derived type for aerosol information + type(zm_microp_st) :: microp_st ! ZM microphysics data structure + + real(r8), dimension(ncol,pver) :: state_s + real(r8), dimension(ncol,pver) :: zm_qc ! ZM in-cloud liquid water ! local copy of state variables for calling zm_conv_evap() - real(r8), dimension(pcols,pver) :: local_state_t - real(r8), dimension(pcols,pver) :: local_state_qv - real(r8), dimension(pcols,pver) :: local_state_zm - real(r8), dimension(pcols,pverp):: local_state_zi + real(r8), dimension(ncol,pver) :: local_state_t + real(r8), dimension(ncol,pver) :: local_state_qv + real(r8), dimension(ncol,pver) :: local_state_zm + real(r8), dimension(ncol,pverp):: local_state_zi ! temporary local tendencies for calling zm_conv_evap() - real(r8), dimension(pcols,pver) :: local_tend_s ! output tendency of dry static energy (ptend_loc_s) - real(r8), dimension(pcols,pver) :: local_tend_q ! output tendency of water vapor (ptend_loc_q) - real(r8), dimension(pcols,pver) :: local_tend_u ! output tendency of zonal wind - real(r8), dimension(pcols,pver) :: local_tend_v ! output tendency of meridional wind - - real(r8), dimension(pcols,pver) :: tend_s_snwprd ! DSE tend from snow production - real(r8), dimension(pcols,pver) :: tend_s_snwevmlt ! DSE tend from snow evap/melt - ! real(r8), dimension(pcols,pver) :: snow - real(r8), dimension(pcols,pver) :: ntprprd ! net precip production in layer - real(r8), dimension(pcols,pver) :: ntsnprd ! net snow production in layer - ! real(r8), dimension(pcols,pverp):: flxprec - ! real(r8), dimension(pcols,pverp):: flxsnow + real(r8), dimension(ncol,pver) :: local_tend_s ! output tendency of dry static energy (ptend_loc_s) + real(r8), dimension(ncol,pver) :: local_tend_q ! output tendency of water vapor (ptend_loc_q) + real(r8), dimension(ncol,pver) :: local_tend_u ! output tendency of zonal wind + real(r8), dimension(ncol,pver) :: local_tend_v ! output tendency of meridional wind + + real(r8), dimension(ncol,pver) :: tend_s_snwprd ! DSE tend from snow production + real(r8), dimension(ncol,pver) :: tend_s_snwevmlt ! DSE tend from snow evap/melt + ! real(r8), dimension(ncol,pver) :: snow + real(r8), dimension(ncol,pver) :: ntprprd ! net precip production in layer + real(r8), dimension(ncol,pver) :: ntsnprd ! net snow production in layer + ! real(r8), dimension(ncol,pverp):: flxprec + ! real(r8), dimension(ncol,pverp):: flxsnow ! used in momentum transport calculations - real(r8), dimension(pcols,pver,2) :: tx_winds - real(r8), dimension(pcols,pver,2) :: tx_wind_tend - real(r8), dimension(pcols,pver,2) :: tx_pguall - real(r8), dimension(pcols,pver,2) :: tx_pgdall - real(r8), dimension(pcols,pver,2) :: tx_icwu - real(r8), dimension(pcols,pver,2) :: tx_icwd - - logical :: old_snow ! flag to use snow production from zm_conv_evap - set false when using zm microphysics + real(r8), dimension(ncol,pver,2) :: tx_winds + real(r8), dimension(ncol,pver,2) :: tx_wind_tend + real(r8), dimension(ncol,pver,2) :: tx_pguall + real(r8), dimension(ncol,pver,2) :: tx_pgdall + real(r8), dimension(ncol,pver,2) :: tx_icwu + real(r8), dimension(ncol,pver,2) :: tx_icwd + + ! MCSP history output variables + real(r8), dimension(ncol,pver) :: mcsp_dt_out ! MCSP tendency for DSE + real(r8), dimension(ncol,pver) :: mcsp_dq_out ! MCSP tendency for qv + real(r8), dimension(ncol,pver) :: mcsp_du_out ! MCSP tendency for u wind + real(r8), dimension(ncol,pver) :: mcsp_dv_out ! MCSP tendency for v wind + real(r8), dimension(ncol) :: mcsp_freq ! MSCP frequency for output + real(r8), dimension(ncol) :: mcsp_shear ! shear used to check against threshold + real(r8), dimension(ncol) :: zm_depth ! pressure depth of ZM heating !----------------------------------------------------------------------------- ! initialize various thing @@ -209,9 +203,9 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & loc_is_first_step = is_first_step if (zm_param%zm_microp) then - old_snow = .false. + zm_param%old_snow = .false. else - old_snow = .true. + zm_param%old_snow = .true. end if !----------------------------------------------------------------------------- @@ -244,37 +238,17 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & !----------------------------------------------------------------------------- ! Call the primary Zhang-McFarlane convection parameterization - call zm_convr( lchnk, ncol, loc_is_first_step, & - state_t, state_qv, & - output_prec, & - jctop, jcbot, & - state_pblh, & - state_zm, state_phis, state_zi, & - output_tend_q, output_tend_s, & - state_p_mid, state_p_int, state_p_del, state_omega, & - 0.5*dtime, & - output_mass_flux, & - cme, & - output_cape, & - tpert, & - dlf, & - output_prec_flux, & - zdu, & - output_rain_prod, & - mu, md, du, eu, ed, dp, & - dsubcld, & - jt, & - maxg, ideep, lengath, & - zm_qc, rliq, & - landfrac, & - t_star, q_star, dcape, & - aero, & - qi, dif, dnlf, dnif, dsf, dnsf, & - output_snow_prod, & - rice, frz, & - mudpcu, lambdadpcu, & - microp_st, & - wuc ) + call zm_convr( ncol, ncol, pver, pverp, loc_is_first_step, 0.5*dtime, & + state_t, state_qv, state_omega, & + state_p_mid, state_p_int, state_p_del, & + state_phis, state_zm, state_zi, state_pblh, & + tpert, landfrac, t_star, q_star, & + lengath, ideep, maxg, jctop, jcbot, jt, & + output_prec, output_tend_s, output_tend_q, & + output_cape, dcape, output_mass_flux, output_prec_flux, & + zdu, mu, md, du, eu, ed, dp, dsubcld, & + zm_qc, rliq, output_rain_prod, dlf, & + aero, microp_st ) !----------------------------------------------------------------------------- ! mesoscale coherent structure parameterization (MCSP)- modifies tendencies from zm_convr() prior to updating the state @@ -282,7 +256,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & if (zm_param%mcsp_enabled) then ! initialize local output tendencies for MCSP - call zm_tend_init( ncol, pcols, pver, local_tend_s, local_tend_q, local_tend_u, local_tend_v ) + call zm_tend_init( ncol, pver, local_tend_s, local_tend_q, local_tend_u, local_tend_v ) do i = 1,ncol do k = 1,pver @@ -291,13 +265,15 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & end do ! perform the MCSP calculations - call zm_conv_mcsp_tend( lchnk, pcols, ncol, pver, pverp, & + call zm_conv_mcsp_tend( ncol, ncol, pver, pverp, & dtime, jctop, zm_const, zm_param, & state_p_mid, state_p_int, state_p_del, & state_s, state_qv, state_u, state_v, & output_tend_s, output_tend_q, & local_tend_s, local_tend_q, & - local_tend_u, local_tend_v ) + local_tend_u, local_tend_v, & + mcsp_dt_out, mcsp_dq_out, mcsp_du_out, mcsp_dv_out, & + mcsp_freq, mcsp_shear, zm_depth ) ! add MCSP tendencies to ZM convective tendencies do i = 1,ncol @@ -314,7 +290,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & !----------------------------------------------------------------------------- ! apply tendencies from zm_convr() & MCSP to local copy of state variables - call zm_physics_update( ncol, pcols, dtime, & + call zm_physics_update( ncol, dtime, & state_phis, local_state_zm, local_state_zi, & state_p_mid, state_p_int, state_p_del, & local_state_t, local_state_qv, & @@ -325,21 +301,17 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & ! Note - this routine expects an updated state following zm_convr() (+MCSP) ! initialize local output tendencies for zm_conv_evap() - call zm_tend_init( ncol, pcols, pver, local_tend_s, local_tend_q, local_tend_u, local_tend_v ) + call zm_tend_init( ncol, pver, local_tend_s, local_tend_q, local_tend_u, local_tend_v ) ! perform the convective evaporation calculations - call zm_conv_evap(ncol, lchnk, & - local_state_t, state_p_mid, state_p_del, local_state_qv, & - local_tend_s, & - tend_s_snwprd, & - tend_s_snwevmlt, & - local_tend_q, & + call zm_conv_evap(ncol, ncol, pver, pverp, dtime, & + state_p_mid, state_p_del, & + local_state_t, local_state_qv, & output_rain_prod, state_cldfrac, & - dtime, & - output_prec, output_snow, & - ntprprd, ntsnprd, & - output_prec_flux, output_snow_flux, & - output_snow_prod, old_snow) + local_tend_s, local_tend_q, & + tend_s_snwprd, tend_s_snwevmlt, & + output_prec, output_snow, ntprprd, ntsnprd, & + output_prec_flux, output_snow_flux, microp_st) ! add tendencies from zm_conv_evap() to output tendencies do i = 1,ncol @@ -350,7 +322,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & end do ! apply tendencies from zm_conv_evap() to local copy of state variables - call zm_physics_update( ncol, pcols, dtime, & + call zm_physics_update( ncol, dtime, & state_phis, local_state_zm, local_state_zi, & state_p_mid, state_p_int, state_p_del, & local_state_t, local_state_qv, & @@ -360,7 +332,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & ! convective momentum transport ! initialize local output tendencies for zm_conv_evap() - call zm_tend_init( ncol, pcols, pver, local_tend_s, local_tend_q, tx_wind_tend(:,:,1), tx_wind_tend(:,:,2) ) + call zm_tend_init( ncol, pver, local_tend_s, local_tend_q, tx_wind_tend(:,:,1), tx_wind_tend(:,:,2) ) do i = 1,ncol do k = 1,pver @@ -369,7 +341,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & end do end do - call zm_transport_momentum( ncol, tx_winds, 2, & + call zm_transport_momentum( ncol, ncol, pver, pverp, tx_winds, 2, & mu, md, du, eu, ed, dp, & jt, maxg, ideep, 1, lengath, & tx_wind_tend, tx_pguall, tx_pgdall, & diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_methods.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_methods.F90 index cdc0cc1159de..9962c202efa0 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_methods.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_methods.F90 @@ -1,6 +1,6 @@ module zm_eamxx_bridge_methods !----------------------------------------------------------------------------- - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp, top_lev + use zm_eamxx_bridge_params, only: r8, pver, pverp, top_lev !----------------------------------------------------------------------------- implicit none private @@ -29,10 +29,10 @@ subroutine cldfrc_fice(ncol, t, fice, fsnow) ! Arguments integer, intent(in) :: ncol ! number of active columns - real(r8), intent(in) :: t(pcols,pver) ! temperature + real(r8), intent(in) :: t(ncol,pver) ! temperature - real(r8), intent(out) :: fice(pcols,pver) ! Fractional ice content within cloud - real(r8), intent(out) :: fsnow(pcols,pver) ! Fractional snow content for convection + real(r8), intent(out) :: fice(ncol,pver) ! Fractional ice content within cloud + real(r8), intent(out) :: fsnow(ncol,pver) ! Fractional snow content for convection ! Local variables real(r8) :: tmax_fice ! max temperature for cloud ice formation @@ -82,16 +82,15 @@ end subroutine cldfrc_fice !=================================================================================================== ! This mimics the functionality of physics_ptend_init() -subroutine zm_tend_init( ncol, pcols, pver, tend_s, tend_q, tend_u, tend_v ) +subroutine zm_tend_init( ncol, pver, tend_s, tend_q, tend_u, tend_v ) !----------------------------------------------------------------------------- ! Arguments - integer, intent(in ) :: ncol ! number of local columns - integer, intent(in ) :: pcols ! max number of columns for variable dimensions - integer, intent(in ) :: pver ! number of local columns - real(r8), dimension(pcols,pver), intent(inout) :: tend_s ! tendency of dry static energy - real(r8), dimension(pcols,pver), intent(inout) :: tend_q ! tendency of water vapor - real(r8), dimension(pcols,pver), intent(inout) :: tend_u ! tendency of zonal wind - real(r8), dimension(pcols,pver), intent(inout) :: tend_v ! tendency of meridional wind + integer, intent(in ) :: ncol ! number of local columns + integer, intent(in ) :: pver ! number of local columns + real(r8), dimension(ncol,pver), intent(inout) :: tend_s ! tendency of dry static energy + real(r8), dimension(ncol,pver), intent(inout) :: tend_q ! tendency of water vapor + real(r8), dimension(ncol,pver), intent(inout) :: tend_u ! tendency of zonal wind + real(r8), dimension(ncol,pver), intent(inout) :: tend_v ! tendency of meridional wind !----------------------------------------------------------------------------- ! Local variables integer :: i,k @@ -112,26 +111,25 @@ subroutine zm_tend_init( ncol, pcols, pver, tend_s, tend_q, tend_u, tend_v ) ! This combines functionality of: ! - physics_update() [see physics_update_mod.F90] ! - physics_update_main() [see physics_types.F90] -subroutine zm_physics_update( ncol, pcols, dt, state_phis, state_zm, state_zi, & +subroutine zm_physics_update( ncol, dt, state_phis, state_zm, state_zi, & state_p_mid, state_p_int, state_p_del, & state_t, state_qv, ptend_s, ptend_q) use zm_eamxx_bridge_physconst, only: cpair !----------------------------------------------------------------------------- ! Arguments - integer, intent(in ) :: ncol ! number of local columns - integer, intent(in ) :: pcols ! max number of columns for variable dimensions - real(r8), intent(in ) :: dt ! time step - real(r8), dimension(pcols), intent(in ) :: state_phis ! input state surface geopotential height - real(r8), dimension(pcols,pver), intent(inout) :: state_zm ! input state altitude at mid-levels - real(r8), dimension(pcols,pverp),intent(inout) :: state_zi ! input state altitude at interfaces - real(r8), dimension(pcols,pver), intent(in ) :: state_p_mid ! input state mid-point pressure - real(r8), dimension(pcols,pverp),intent(in ) :: state_p_int ! input state interface pressure - real(r8), dimension(pcols,pver), intent(in ) :: state_p_del ! input state pressure thickness - ! real(r8), dimension(pcols,pver), intent(inout) :: state_dse ! input state dry static energy - real(r8), dimension(pcols,pver), intent(inout) :: state_t ! input state temperature - real(r8), dimension(pcols,pver), intent(inout) :: state_qv ! input state water vapor - real(r8), dimension(pcols,pver), intent(in ) :: ptend_s ! tendency of dry static energy - real(r8), dimension(pcols,pver), intent(in ) :: ptend_q ! tendency of water vapor + integer, intent(in ) :: ncol ! number of local columns + real(r8), intent(in ) :: dt ! time step + real(r8), dimension(ncol), intent(in ) :: state_phis ! input state surface geopotential height + real(r8), dimension(ncol,pver), intent(inout) :: state_zm ! input state altitude at mid-levels + real(r8), dimension(ncol,pverp),intent(inout) :: state_zi ! input state altitude at interfaces + real(r8), dimension(ncol,pver), intent(in ) :: state_p_mid ! input state mid-point pressure + real(r8), dimension(ncol,pverp),intent(in ) :: state_p_int ! input state interface pressure + real(r8), dimension(ncol,pver), intent(in ) :: state_p_del ! input state pressure thickness + ! real(r8), dimension(ncol,pver), intent(inout) :: state_dse ! input state dry static energy + real(r8), dimension(ncol,pver), intent(inout) :: state_t ! input state temperature + real(r8), dimension(ncol,pver), intent(inout) :: state_qv ! input state water vapor + real(r8), dimension(ncol,pver), intent(in ) :: ptend_s ! tendency of dry static energy + real(r8), dimension(ncol,pver), intent(in ) :: ptend_q ! tendency of water vapor !----------------------------------------------------------------------------- ! Local variables integer :: i,k @@ -145,7 +143,7 @@ subroutine zm_physics_update( ncol, pcols, dt, state_phis, state_zm, state_zi, & end do end do - call zm_geopotential_t( ncol, pcols, state_p_int, state_p_mid, state_p_del, state_t, state_qv, state_zi, state_zm ) + call zm_geopotential_t( ncol, state_p_int, state_p_mid, state_p_del, state_t, state_qv, state_zi, state_zm ) ! skip DSE update for EAMxx ! do i = 1,ncol @@ -160,22 +158,21 @@ end subroutine zm_physics_update !=================================================================================================== ! copied and modified from geopotential.F90 -subroutine zm_geopotential_t( ncol, pcols, pint, pmid, pdel, t, q, zi, zm ) +subroutine zm_geopotential_t( ncol, pint, pmid, pdel, t, q, zi, zm ) use zm_eamxx_bridge_physconst, only: zvir, rair, gravit !----------------------------------------------------------------------- ! Purpose: Compute the geopotential height (above the surface) at the ! midpoints and interfaces using the input temperatures and pressures !----------------------------------------------------------------------------- ! Arguments - integer, intent(in ) :: ncol ! Number of columns - integer, intent(in ) :: pcols - real(r8), dimension(pcols,pverp),intent(in ) :: pint ! Interface pressures - real(r8), dimension(pcols,pver), intent(in ) :: pmid ! Midpoint pressures - real(r8), dimension(pcols,pver), intent(in ) :: pdel ! layer thickness - real(r8), dimension(pcols,pver), intent(in ) :: t ! temperature - real(r8), dimension(pcols,pver), intent(in ) :: q ! specific humidity - real(r8), dimension(pcols,pverp),intent(inout) :: zi ! Height above surface at interfaces - real(r8), dimension(pcols,pver), intent(inout) :: zm ! Geopotential height at mid level + integer, intent(in ) :: ncol ! Number of columns + real(r8), dimension(ncol,pverp),intent(in ) :: pint ! Interface pressures + real(r8), dimension(ncol,pver), intent(in ) :: pmid ! Midpoint pressures + real(r8), dimension(ncol,pver), intent(in ) :: pdel ! layer thickness + real(r8), dimension(ncol,pver), intent(in ) :: t ! temperature + real(r8), dimension(ncol,pver), intent(in ) :: q ! specific humidity + real(r8), dimension(ncol,pverp),intent(inout) :: zi ! Height above surface at interfaces + real(r8), dimension(ncol,pver), intent(inout) :: zm ! Geopotential height at mid level !----------------------------------------------------------------------------- ! Local variables integer :: i,k ! Lon, level indices diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_params.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_params.F90 index 4f2625359ad3..a5a13a15f21e 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_params.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_params.F90 @@ -17,7 +17,6 @@ module zm_eamxx_bridge_params integer, public, parameter :: btype = c_bool logical, public :: masterproc - integer, public :: pcols integer, public :: pver integer, public :: pverp integer, public :: top_lev diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_physconst.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_physconst.F90 index 6f2d7737d0e8..91d42d48647b 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_physconst.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_physconst.F90 @@ -4,8 +4,7 @@ module zm_eamxx_bridge_physconst ! Physical constants. Use CCSM shared values whenever available. - use zm_eamxx_bridge_params, only: r8, pcols, pver, pverp - ! use shr_kind_mod, only: r8 => shr_kind_r8 + use zm_eamxx_bridge_params, only: r8, pver, pverp use shr_const_mod, only: shr_const_g, shr_const_stebol, shr_const_tkfrz, & shr_const_mwdair, shr_const_rdair, shr_const_mwwv, & shr_const_latice, shr_const_latvap, shr_const_cpdair, & @@ -16,7 +15,6 @@ module zm_eamxx_bridge_physconst shr_const_rearth, shr_const_sday, shr_const_cday, & shr_const_spval, shr_const_omega, shr_const_cpvir, & shr_const_tktrip - ! use ppgrid, only: pcols, pver, pverp, begchunk, endchunk ! Dimensions and chunk bounds implicit none diff --git a/components/eamxx/src/physics/zm/zm_functions.hpp b/components/eamxx/src/physics/zm/zm_functions.hpp index 76277b6562eb..8dd842b5c276 100644 --- a/components/eamxx/src/physics/zm/zm_functions.hpp +++ b/components/eamxx/src/physics/zm/zm_functions.hpp @@ -216,7 +216,7 @@ struct Functions { } }; // ------------------------------------------------------------------------- - void init(int ncol_in,int pver_in) { + void init(int ncol_in, int pver_in) { Real init_fill_value = -999; // 1D scalar variables for (int i=0; i Date: Wed, 15 Oct 2025 17:26:08 -0500 Subject: [PATCH 13/31] zm bridge - fix ol_snow and output initialization bug fix and clean up --- .../eam/src/physics/cam/zm_conv_types.F90 | 2 ++ .../physics/zm/eamxx_zm_process_interface.cpp | 1 - .../fortran_bridge/zm_eamxx_bridge_main.F90 | 32 +++++++------------ 3 files changed, 14 insertions(+), 21 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv_types.F90 b/components/eam/src/physics/cam/zm_conv_types.F90 index a0cef8316fa8..55f19383cb5c 100644 --- a/components/eam/src/physics/cam/zm_conv_types.F90 +++ b/components/eam/src/physics/cam/zm_conv_types.F90 @@ -249,6 +249,7 @@ subroutine zm_param_mpi_broadcast(zm_param) call mpibcast(zm_param%clos_dyn_adj, 1, mpilog, 0, mpicom) call mpibcast(zm_param%no_deep_pbl, 1, mpilog, 0, mpicom) call mpibcast(zm_param%zm_microp, 1, mpilog, 0, mpicom) ! ZM micro parameters + call mpibcast(zm_param%old_snow, 1, mpilog, 0, mpicom) call mpibcast(zm_param%auto_fac, 1, mpir8, 0, mpicom) call mpibcast(zm_param%accr_fac, 1, mpir8, 0, mpicom) call mpibcast(zm_param%micro_dcs, 1, mpir8, 0, mpicom) @@ -291,6 +292,7 @@ subroutine zm_param_print(zm_param) write(iulog,*) indent,'no_deep_pbl : ',zm_param%no_deep_pbl ! ZM micro parameters write(iulog,*) indent,'zm_microp : ',zm_param%zm_microp + write(iulog,*) indent,'old_snow : ',zm_param%old_snow write(iulog,*) indent,'auto_fac : ',zm_param%auto_fac write(iulog,*) indent,'accr_fac : ',zm_param%accr_fac write(iulog,*) indent,'micro_dcs : ',zm_param%micro_dcs diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 9efb6fd0ec3e..63905d6450e7 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -41,7 +41,6 @@ void ZMDeepConvection::set_grids (const std::shared_ptr grid const auto& grid_name = m_grid->name(); const auto layout = m_grid->get_3d_scalar_layout(true); - const auto comm = m_grid->get_comm(); // retrieve local grid parameters m_ncol = m_grid->get_num_local_dofs(); diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 index 52344df3a2d4..f8ac63723f06 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 @@ -56,6 +56,7 @@ subroutine zm_eamxx_bridge_init_c( pver_in ) bind(C) !----------------------------------------------------------------------------- ! make sure we are turning off the extra stuff zm_param%zm_microp = .false. + zm_param%old_snow = .true. zm_param%trig_dcape = .false. zm_param%trig_ull = .true. zm_param%clos_dyn_adj = .true. @@ -130,15 +131,9 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & integer, dimension(ncol) :: jctop ! output top-of-deep-convection indices integer, dimension(ncol) :: jcbot ! output bot-of-deep-convection indices - ! real(r8), dimension(ncol,pverp):: mcon ! convective mass flux--m sub c real(r8), dimension(ncol,pver) :: cme ! condensation - evaporation - ! real(r8), dimension(ncol) :: cape ! convective available potential energy - ! real(r8), dimension(ncol) :: tpert ! thermal temperature excess real(r8), dimension(ncol,pver) :: dlf ! detrained convective cloud water mixing ratio - ! real(r8), dimension(ncol,pverp):: pflx ! precip flux at each level real(r8), dimension(ncol,pver) :: zdu ! detraining mass flux - ! real(r8), dimension(ncol,pver) :: rprd ! rain production rate - ! real(r8), dimension(ncol,pver) :: sprd ! snow production rate real(r8), dimension(ncol,pver) :: mu ! upward cloud mass flux real(r8), dimension(ncol,pver) :: md ! entrainment in updraft real(r8), dimension(ncol,pver) :: du ! detrainment in updraft @@ -157,8 +152,8 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & type(zm_aero_t) :: aero ! derived type for aerosol information type(zm_microp_st) :: microp_st ! ZM microphysics data structure - real(r8), dimension(ncol,pver) :: state_s - real(r8), dimension(ncol,pver) :: zm_qc ! ZM in-cloud liquid water + real(r8), dimension(ncol,pver) :: state_s ! dry static energy + real(r8), dimension(ncol,pver) :: zm_qc ! convective in-cloud liquid water ! local copy of state variables for calling zm_conv_evap() real(r8), dimension(ncol,pver) :: local_state_t @@ -174,11 +169,8 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & real(r8), dimension(ncol,pver) :: tend_s_snwprd ! DSE tend from snow production real(r8), dimension(ncol,pver) :: tend_s_snwevmlt ! DSE tend from snow evap/melt - ! real(r8), dimension(ncol,pver) :: snow real(r8), dimension(ncol,pver) :: ntprprd ! net precip production in layer real(r8), dimension(ncol,pver) :: ntsnprd ! net snow production in layer - ! real(r8), dimension(ncol,pverp):: flxprec - ! real(r8), dimension(ncol,pverp):: flxsnow ! used in momentum transport calculations real(r8), dimension(ncol,pver,2) :: tx_winds @@ -202,24 +194,24 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & loc_is_first_step = is_first_step - if (zm_param%zm_microp) then - zm_param%old_snow = .false. - else - zm_param%old_snow = .true. - end if - !----------------------------------------------------------------------------- ! initialize output tendencies - normally done by physics_ptend_init() do i = 1,ncol - output_prec(i) = -1 - output_cape(i) = -1 + output_prec(i) = 0 + output_snow(i) = 0 + output_cape(i) = 0 output_activity(i) = 0 do k = 1,pver output_tend_s(i,k) = 0 output_tend_q(i,k) = 0 output_tend_u(i,k) = 0 output_tend_v(i,k) = 0 + output_rain_prod(i,k) = 0 + output_snow_prod(i,k) = 0 + output_prec_flux(i,k) = 0 + output_snow_flux(i,k) = 0 + output_mass_flux(i,k) = 0 end do end do @@ -246,7 +238,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & lengath, ideep, maxg, jctop, jcbot, jt, & output_prec, output_tend_s, output_tend_q, & output_cape, dcape, output_mass_flux, output_prec_flux, & - zdu, mu, md, du, eu, ed, dp, dsubcld, & + zdu, mu, eu, du, md, ed, dp, dsubcld, & zm_qc, rliq, output_rain_prod, dlf, & aero, microp_st ) From de7bbdf841041240fffb1fa445e0cf5213a000dd Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 17 Oct 2025 15:12:56 -0700 Subject: [PATCH 14/31] enable host mirroring of ZM variables --- .../physics/zm/eamxx_zm_process_interface.cpp | 40 +++++++ .../zm/fortran_bridge/zm_eamxx_bridge.cpp | 56 ++++----- .../eamxx/src/physics/zm/zm_functions.hpp | 110 +++++++++++++++--- 3 files changed, 163 insertions(+), 43 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 63905d6450e7..f0a9dd58146c 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -102,6 +102,45 @@ void ZMDeepConvection::initialize_impl (const RunType) // initialize variables on the fortran side zm::zm_eamxx_bridge_init(m_nlev); + + //---------------------------------------------------------------------------- + // initialize host mirror variables + zm_input.h_z_mid = Kokkos::create_mirror_view(zm_input.f_z_mid); + zm_input.h_p_mid = Kokkos::create_mirror_view(zm_input.f_p_mid); + zm_input.h_p_del = Kokkos::create_mirror_view(zm_input.f_p_del); + zm_input.h_T_mid = Kokkos::create_mirror_view(zm_input.f_T_mid); + zm_input.h_qv = Kokkos::create_mirror_view(zm_input.f_qv); + zm_input.h_uwind = Kokkos::create_mirror_view(zm_input.f_uwind); + zm_input.h_vwind = Kokkos::create_mirror_view(zm_input.f_vwind); + zm_input.h_omega = Kokkos::create_mirror_view(zm_input.f_omega); + zm_input.h_cldfrac = Kokkos::create_mirror_view(zm_input.f_cldfrac); + zm_input.h_z_int = Kokkos::create_mirror_view(zm_input.f_z_int); + zm_input.h_p_int = Kokkos::create_mirror_view(zm_input.f_p_int); + zm_input.h_tpert = Kokkos::create_mirror_view(zm_input.tpert); + + zm_output.h_tend_s = Kokkos::create_mirror_view(zm_output.f_tend_s); + zm_output.h_tend_qv = Kokkos::create_mirror_view(zm_output.f_tend_qv); + zm_output.h_tend_u = Kokkos::create_mirror_view(zm_output.f_tend_u); + zm_output.h_tend_v = Kokkos::create_mirror_view(zm_output.f_tend_v); + zm_output.h_rain_prod = Kokkos::create_mirror_view(zm_output.f_rain_prod); + zm_output.h_snow_prod = Kokkos::create_mirror_view(zm_output.f_snow_prod); + zm_output.h_prec_flux = Kokkos::create_mirror_view(zm_output.f_prec_flux); + zm_output.h_snow_flux = Kokkos::create_mirror_view(zm_output.f_snow_flux); + zm_output.h_mass_flux = Kokkos::create_mirror_view(zm_output.f_mass_flux); + zm_output.h_prec = Kokkos::create_mirror_view(zm_output.prec); + zm_output.h_snow = Kokkos::create_mirror_view(zm_output.snow); + zm_output.h_cape = Kokkos::create_mirror_view(zm_output.cape); + zm_output.h_activity = Kokkos::create_mirror_view(zm_output.activity); + + //---------------------------------------------------------------------------- + // initialize host mirror variables for managed views + const auto& phis = get_field_in("phis") .get_view(); + const auto& pblh = get_field_in("pbl_height") .get_view(); + const auto& landfrac = get_field_in("landfrac") .get_view(); + zm_input.h_phis = Kokkos::create_mirror_view(phis); + zm_input.h_pblh = Kokkos::create_mirror_view(pblh); + zm_input.h_landfrac = Kokkos::create_mirror_view(landfrac); + } /*------------------------------------------------------------------------------------------------*/ @@ -428,6 +467,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) size_t used_mem = (reinterpret_cast(total_mem) - buffer_manager.get_memory())*sizeof(Real); auto mem_chk = ( used_mem == requested_buffer_size_in_bytes() ); EKAT_REQUIRE_MSG(mem_chk,"Error! Used memory != requested memory for ZMDeepConvection."); + //---------------------------------------------------------------------------- } /*------------------------------------------------------------------------------------------------*/ diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp index dfcff605a1d9..541ec7e12dd6 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp @@ -61,34 +61,34 @@ void zm_eamxx_bridge_run( Int ncol, Int pver, zm_eamxx_bridge_run_c( ncol, // 01 zm_input.dtime, // 02 zm_input.is_first_step, // 03 - zm_input.phis .data(), // 04 - zm_input.f_z_mid .data(), // 05 - zm_input.f_z_int .data(), // 06 - zm_input.f_p_mid .data(), // 07 - zm_input.f_p_int .data(), // 08 - zm_input.f_p_del .data(), // 09 - zm_input.f_T_mid .data(), // 10 - zm_input.f_qv .data(), // 11 - zm_input.f_uwind .data(), // 12 - zm_input.f_vwind .data(), // 13 - zm_input.f_omega .data(), // 14 - zm_input.f_cldfrac .data(), // 15 - zm_input.pblh .data(), // 16 - zm_input.tpert .data(), // 17 - zm_input.landfrac .data(), // 18 - zm_output.prec .data(), // 19 - zm_output.snow .data(), // 20 - zm_output.cape .data(), // 21 - zm_output.activity .data(), // 22 - zm_output.f_tend_s .data(), // 23 - zm_output.f_tend_qv .data(), // 24 - zm_output.f_tend_u .data(), // 25 - zm_output.f_tend_v .data(), // 26 - zm_output.f_rain_prod .data(), // 27 - zm_output.f_snow_prod .data(), // 28 - zm_output.f_prec_flux .data(), // 29 - zm_output.f_snow_flux .data(), // 30 - zm_output.f_mass_flux .data() // 31 + zm_input.h_phis .data(), // 04 + zm_input.h_z_mid .data(), // 05 + zm_input.h_z_int .data(), // 06 + zm_input.h_p_mid .data(), // 07 + zm_input.h_p_int .data(), // 08 + zm_input.h_p_del .data(), // 09 + zm_input.h_T_mid .data(), // 10 + zm_input.h_qv .data(), // 11 + zm_input.h_uwind .data(), // 12 + zm_input.h_vwind .data(), // 13 + zm_input.h_omega .data(), // 14 + zm_input.h_cldfrac .data(), // 15 + zm_input.h_pblh .data(), // 16 + zm_input.h_tpert .data(), // 17 + zm_input.h_landfrac .data(), // 18 + zm_output.h_prec .data(), // 19 + zm_output.h_snow .data(), // 20 + zm_output.h_cape .data(), // 21 + zm_output.h_activity .data(), // 22 + zm_output.h_tend_s .data(), // 23 + zm_output.h_tend_qv .data(), // 24 + zm_output.h_tend_u .data(), // 25 + zm_output.h_tend_v .data(), // 26 + zm_output.h_rain_prod .data(), // 27 + zm_output.h_snow_prod .data(), // 28 + zm_output.h_prec_flux .data(), // 29 + zm_output.h_snow_flux .data(), // 30 + zm_output.h_mass_flux .data() // 31 ); zm_input.transpose(ncol,pver); diff --git a/components/eamxx/src/physics/zm/zm_functions.hpp b/components/eamxx/src/physics/zm/zm_functions.hpp index 8dd842b5c276..3101b63a4ab8 100644 --- a/components/eamxx/src/physics/zm/zm_functions.hpp +++ b/components/eamxx/src/physics/zm/zm_functions.hpp @@ -41,6 +41,8 @@ struct Functions { template using uview_2d = typename ekat::template Unmanaged >; template using uview_2dl = typename ekat::template Unmanaged >; template using uview_2d_strided = typename ekat::template Unmanaged >; + template using uview_2dh = typename ekat::template Unmanaged>::HostMirror; + template using uview_1dh = typename ekat::template Unmanaged>::HostMirror; // --------------------------------------------------------------------------- // Structs @@ -89,18 +91,35 @@ struct Functions { view_1d landfrac; // land area fraction // unmanaged LayoutLeft views for fortran bridging - uview_2dl f_z_mid; - uview_2dl f_p_mid; - uview_2dl f_p_del; - uview_2dl f_T_mid; - uview_2dl f_qv; - uview_2dl f_uwind; - uview_2dl f_vwind; - uview_2dl f_omega; - uview_2dl f_cldfrac; - - uview_2dl f_z_int; - uview_2dl f_p_int; + uview_2dl f_z_mid; + uview_2dl f_p_mid; + uview_2dl f_p_del; + uview_2dl f_T_mid; + uview_2dl f_qv; + uview_2dl f_uwind; + uview_2dl f_vwind; + uview_2dl f_omega; + uview_2dl f_cldfrac; + uview_2dl f_z_int; + uview_2dl f_p_int; + + // host mirror versions of ZM interface variables + uview_2dh h_z_mid; + uview_2dh h_p_mid; + uview_2dh h_p_del; + uview_2dh h_T_mid; + uview_2dh h_qv; + uview_2dh h_uwind; + uview_2dh h_vwind; + uview_2dh h_omega; + uview_2dh h_cldfrac; + uview_2dh h_z_int; + uview_2dh h_p_int; + + uview_1dh h_phis; + uview_1dh h_pblh; + uview_1dh h_tpert; + uview_1dh h_landfrac; // ------------------------------------------------------------------------- // transpose method for fortran bridging @@ -125,6 +144,23 @@ struct Functions { f_p_int (i,j) = p_int (i,j/Spack::n)[j%Spack::n]; } } + //---------------------------------------------------------------------- + // copy to host mirrors + Kokkos::deep_copy(h_z_mid, f_z_mid); + Kokkos::deep_copy(h_p_mid, f_p_mid); + Kokkos::deep_copy(h_p_del, f_p_del); + Kokkos::deep_copy(h_T_mid, f_T_mid); + Kokkos::deep_copy(h_qv, f_qv); + Kokkos::deep_copy(h_uwind, f_uwind); + Kokkos::deep_copy(h_vwind, f_vwind); + Kokkos::deep_copy(h_omega, f_omega); + Kokkos::deep_copy(h_cldfrac, f_cldfrac); + Kokkos::deep_copy(h_z_int, f_z_int); + Kokkos::deep_copy(h_p_int, f_p_int); + Kokkos::deep_copy(h_phis, phis); + Kokkos::deep_copy(h_pblh, pblh); + Kokkos::deep_copy(h_tpert, tpert); + Kokkos::deep_copy(h_landfrac, landfrac); } } // ------------------------------------------------------------------------- @@ -164,11 +200,26 @@ struct Functions { uview_2dl f_tend_v; uview_2dl f_rain_prod; uview_2dl f_snow_prod; - uview_2dl f_prec_flux; uview_2dl f_snow_flux; uview_2dl f_mass_flux; + // host mirror versions of ZM interface variables + uview_2dh h_tend_s; + uview_2dh h_tend_qv; + uview_2dh h_tend_u; + uview_2dh h_tend_v; + uview_2dh h_rain_prod; + uview_2dh h_snow_prod; + uview_2dh h_prec_flux; + uview_2dh h_snow_flux; + uview_2dh h_mass_flux; + + uview_1dh h_prec; + uview_1dh h_snow; + uview_1dh h_cape; + uview_1dh h_activity; + // ------------------------------------------------------------------------- // transpose method for fortran bridging template @@ -192,10 +243,39 @@ struct Functions { f_mass_flux(i,j) = mass_flux(i,j/Spack::n)[j%Spack::n]; } } - // sync_to_host here? + //---------------------------------------------------------------------- + // copy to host mirror + Kokkos::deep_copy(h_tend_s, f_tend_s); + Kokkos::deep_copy(h_tend_qv, f_tend_qv); + Kokkos::deep_copy(h_tend_u, f_tend_u); + Kokkos::deep_copy(h_tend_v, f_tend_v); + Kokkos::deep_copy(h_rain_prod,f_rain_prod); + Kokkos::deep_copy(h_snow_prod,f_snow_prod); + Kokkos::deep_copy(h_prec_flux,f_prec_flux); + Kokkos::deep_copy(h_snow_flux,f_snow_flux); + Kokkos::deep_copy(h_mass_flux,f_mass_flux); + Kokkos::deep_copy(h_prec, prec); + Kokkos::deep_copy(h_snow, snow); + Kokkos::deep_copy(h_cape, cape); + Kokkos::deep_copy(h_activity, activity); } if (D == ekat::TransposeDirection::f2c) { - // sync_to_device? + //---------------------------------------------------------------------- + // copy to host mirror + Kokkos::deep_copy(f_tend_s, h_tend_s); + Kokkos::deep_copy(f_tend_qv, h_tend_qv); + Kokkos::deep_copy(f_tend_u, h_tend_u); + Kokkos::deep_copy(f_tend_v, h_tend_v); + Kokkos::deep_copy(f_rain_prod,h_rain_prod); + Kokkos::deep_copy(f_snow_prod,h_snow_prod); + Kokkos::deep_copy(f_prec_flux,h_prec_flux); + Kokkos::deep_copy(f_snow_flux,h_snow_flux); + Kokkos::deep_copy(f_mass_flux,h_mass_flux); + Kokkos::deep_copy(prec, h_prec); + Kokkos::deep_copy(snow, h_snow); + Kokkos::deep_copy(cape, h_cape); + Kokkos::deep_copy(activity, h_activity); + //---------------------------------------------------------------------- for (int i=0; i Date: Mon, 20 Oct 2025 08:00:13 -0700 Subject: [PATCH 15/31] remove GPU clause for building zm --- components/eamxx/src/physics/CMakeLists.txt | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/components/eamxx/src/physics/CMakeLists.txt b/components/eamxx/src/physics/CMakeLists.txt index 64458831ec5b..556dae0475c2 100644 --- a/components/eamxx/src/physics/CMakeLists.txt +++ b/components/eamxx/src/physics/CMakeLists.txt @@ -7,9 +7,7 @@ if (SCREAM_DOUBLE_PRECISION) add_subdirectory(cosp) add_subdirectory(tms) add_subdirectory(iop_forcing) - if (NOT EAMXX_ENABLE_GPU) - add_subdirectory(zm) - endif() + add_subdirectory(zm) else() message(STATUS "WARNING: RRTMGP, COSP, TMS, ZM, and IOPForcing only supported for double precision builds; skipping") endif() From a108e6159e4be4ad693b0e0ff7e6244d9824474a Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 22 Oct 2025 08:48:49 -0700 Subject: [PATCH 16/31] update ZM bridge to output temperature tendency --- .../zm/fortran_bridge/zm_eamxx_bridge.cpp | 4 +-- .../fortran_bridge/zm_eamxx_bridge_main.F90 | 25 +++++++++++++------ 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp index 541ec7e12dd6..ec28b42ac9f2 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp @@ -30,7 +30,7 @@ extern "C" { Real *output_snow, // 20 Real *output_cape, // 21 Int *output_activity, // 22 - Real *output_tend_s, // 23 + Real *output_tend_t, // 23 Real *output_tend_q, // 24 Real *output_tend_u, // 25 Real *output_tend_v, // 26 @@ -80,7 +80,7 @@ void zm_eamxx_bridge_run( Int ncol, Int pver, zm_output.h_snow .data(), // 20 zm_output.h_cape .data(), // 21 zm_output.h_activity .data(), // 22 - zm_output.h_tend_s .data(), // 23 + zm_output.h_tend_t .data(), // 23 zm_output.h_tend_qv .data(), // 24 zm_output.h_tend_u .data(), // 25 zm_output.h_tend_v .data(), // 26 diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 index f8ac63723f06..569b67c48ac3 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 @@ -75,7 +75,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & state_t, state_qv, state_u, state_v, & state_omega, state_cldfrac, state_pblh, tpert, landfrac, & output_prec, output_snow, output_cape, output_activity, & - output_tend_s, output_tend_q, output_tend_u, output_tend_v, & + output_tend_t, output_tend_q, output_tend_u, output_tend_v, & output_rain_prod, output_snow_prod, & output_prec_flux, output_snow_flux, output_mass_flux ) bind(C) use zm_conv, only: zm_const, zm_param @@ -111,7 +111,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & real(kind=c_real), dimension(ncol), intent( out) :: output_snow ! 20 output frozen precipitation (snow) real(kind=c_real), dimension(ncol), intent( out) :: output_cape ! 21 output convective avail. pot. energy (cape) integer(kind=c_int),dimension(ncol), intent( out) :: output_activity ! 22 integer deep convection activity flag (ideep) - real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_s ! 23 output tendency of dry static energy (ptend_loc_s) + real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_t ! 23 output tendency of temperature (ptend_loc_s) real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_q ! 24 output tendency of water vapor (ptend_loc_q) real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_u ! 25 output tendency of zonal wind (ptend_loc_u) real(kind=c_real), dimension(ncol,pver), intent( out) :: output_tend_v ! 26 output tendency of meridional wind (ptend_loc_v) @@ -161,11 +161,13 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & real(r8), dimension(ncol,pver) :: local_state_zm real(r8), dimension(ncol,pverp):: local_state_zi + real(r8), dimension(ncol,pver) :: output_tend_s ! dry static energy tendency used to set output_tend_t + ! temporary local tendencies for calling zm_conv_evap() - real(r8), dimension(ncol,pver) :: local_tend_s ! output tendency of dry static energy (ptend_loc_s) - real(r8), dimension(ncol,pver) :: local_tend_q ! output tendency of water vapor (ptend_loc_q) - real(r8), dimension(ncol,pver) :: local_tend_u ! output tendency of zonal wind - real(r8), dimension(ncol,pver) :: local_tend_v ! output tendency of meridional wind + real(r8), dimension(ncol,pver) :: local_tend_s ! temporary tendency of dry static energy (ptend_loc_s) + real(r8), dimension(ncol,pver) :: local_tend_q ! temporary tendency of water vapor (ptend_loc_q) + real(r8), dimension(ncol,pver) :: local_tend_u ! temporary tendency of zonal wind + real(r8), dimension(ncol,pver) :: local_tend_v ! temporary tendency of meridional wind real(r8), dimension(ncol,pver) :: tend_s_snwprd ! DSE tend from snow production real(r8), dimension(ncol,pver) :: tend_s_snwevmlt ! DSE tend from snow evap/melt @@ -203,7 +205,7 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & output_cape(i) = 0 output_activity(i) = 0 do k = 1,pver - output_tend_s(i,k) = 0 + output_tend_t(i,k) = 0 output_tend_q(i,k) = 0 output_tend_u(i,k) = 0 output_tend_v(i,k) = 0 @@ -363,6 +365,15 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & end do end if + !----------------------------------------------------------------------------- + ! convert dry static energy tendency to temperature tendency + + do i = 1,ncol + do k = 1,pver + output_tend_t(i,k) = output_tend_s(i,k)/zm_const%cpair + end do + end do + !----------------------------------------------------------------------------- return end subroutine zm_eamxx_bridge_run_c From b6c0670569fab35aee59ec645231ba8b2f5a22bf Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 22 Oct 2025 08:52:59 -0700 Subject: [PATCH 17/31] interim update to facilitate rebase correct variable type --- .../physics/zm/eamxx_zm_process_interface.cpp | 356 +++++----- .../eamxx/src/physics/zm/zm_functions.hpp | 624 ++++++++++++------ 2 files changed, 624 insertions(+), 356 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index f0a9dd58146c..da03b53a43ab 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -104,33 +104,34 @@ void ZMDeepConvection::initialize_impl (const RunType) zm::zm_eamxx_bridge_init(m_nlev); //---------------------------------------------------------------------------- - // initialize host mirror variables - zm_input.h_z_mid = Kokkos::create_mirror_view(zm_input.f_z_mid); - zm_input.h_p_mid = Kokkos::create_mirror_view(zm_input.f_p_mid); - zm_input.h_p_del = Kokkos::create_mirror_view(zm_input.f_p_del); - zm_input.h_T_mid = Kokkos::create_mirror_view(zm_input.f_T_mid); - zm_input.h_qv = Kokkos::create_mirror_view(zm_input.f_qv); - zm_input.h_uwind = Kokkos::create_mirror_view(zm_input.f_uwind); - zm_input.h_vwind = Kokkos::create_mirror_view(zm_input.f_vwind); - zm_input.h_omega = Kokkos::create_mirror_view(zm_input.f_omega); - zm_input.h_cldfrac = Kokkos::create_mirror_view(zm_input.f_cldfrac); - zm_input.h_z_int = Kokkos::create_mirror_view(zm_input.f_z_int); - zm_input.h_p_int = Kokkos::create_mirror_view(zm_input.f_p_int); - zm_input.h_tpert = Kokkos::create_mirror_view(zm_input.tpert); - - zm_output.h_tend_s = Kokkos::create_mirror_view(zm_output.f_tend_s); - zm_output.h_tend_qv = Kokkos::create_mirror_view(zm_output.f_tend_qv); - zm_output.h_tend_u = Kokkos::create_mirror_view(zm_output.f_tend_u); - zm_output.h_tend_v = Kokkos::create_mirror_view(zm_output.f_tend_v); - zm_output.h_rain_prod = Kokkos::create_mirror_view(zm_output.f_rain_prod); - zm_output.h_snow_prod = Kokkos::create_mirror_view(zm_output.f_snow_prod); - zm_output.h_prec_flux = Kokkos::create_mirror_view(zm_output.f_prec_flux); - zm_output.h_snow_flux = Kokkos::create_mirror_view(zm_output.f_snow_flux); - zm_output.h_mass_flux = Kokkos::create_mirror_view(zm_output.f_mass_flux); - zm_output.h_prec = Kokkos::create_mirror_view(zm_output.prec); - zm_output.h_snow = Kokkos::create_mirror_view(zm_output.snow); - zm_output.h_cape = Kokkos::create_mirror_view(zm_output.cape); - zm_output.h_activity = Kokkos::create_mirror_view(zm_output.activity); + // initialize host mirrors here to ensure managed variables are allocated + + // zm_input.h_z_mid = Kokkos::create_mirror_view(zm_input.f_z_mid); + // zm_input.h_p_mid = Kokkos::create_mirror_view(zm_input.f_p_mid); + // zm_input.h_p_del = Kokkos::create_mirror_view(zm_input.f_p_del); + // zm_input.h_T_mid = Kokkos::create_mirror_view(zm_input.f_T_mid); + // zm_input.h_qv = Kokkos::create_mirror_view(zm_input.f_qv); + // zm_input.h_uwind = Kokkos::create_mirror_view(zm_input.f_uwind); + // zm_input.h_vwind = Kokkos::create_mirror_view(zm_input.f_vwind); + // zm_input.h_omega = Kokkos::create_mirror_view(zm_input.f_omega); + // zm_input.h_cldfrac = Kokkos::create_mirror_view(zm_input.f_cldfrac); + // zm_input.h_z_int = Kokkos::create_mirror_view(zm_input.f_z_int); + // zm_input.h_p_int = Kokkos::create_mirror_view(zm_input.f_p_int); + // zm_input.h_tpert = Kokkos::create_mirror_view(zm_input.tpert); + + // zm_output.h_tend_t = Kokkos::create_mirror_view(zm_output.f_tend_t); + // zm_output.h_tend_qv = Kokkos::create_mirror_view(zm_output.f_tend_qv); + // zm_output.h_tend_u = Kokkos::create_mirror_view(zm_output.f_tend_u); + // zm_output.h_tend_v = Kokkos::create_mirror_view(zm_output.f_tend_v); + // zm_output.h_rain_prod = Kokkos::create_mirror_view(zm_output.f_rain_prod); + // zm_output.h_snow_prod = Kokkos::create_mirror_view(zm_output.f_snow_prod); + // zm_output.h_prec_flux = Kokkos::create_mirror_view(zm_output.f_prec_flux); + // zm_output.h_snow_flux = Kokkos::create_mirror_view(zm_output.f_snow_flux); + // zm_output.h_mass_flux = Kokkos::create_mirror_view(zm_output.f_mass_flux); + // zm_output.h_prec = Kokkos::create_mirror_view(zm_output.prec); + // zm_output.h_snow = Kokkos::create_mirror_view(zm_output.snow); + // zm_output.h_cape = Kokkos::create_mirror_view(zm_output.cape); + // zm_output.h_activity = Kokkos::create_mirror_view(zm_output.activity); //---------------------------------------------------------------------------- // initialize host mirror variables for managed views @@ -147,12 +148,12 @@ void ZMDeepConvection::initialize_impl (const RunType) void ZMDeepConvection::run_impl (const double dt) { constexpr int pack_size = Spack::n; - const int nlevm_packs = ekat::npack(m_nlev); + const int nlev_mid_packs = ekat::npack(m_nlev); // calculate_z_int() contains a team-level parallel_scan, which requires a special policy using TPF = ekat::TeamPolicyFactory; - const auto scan_policy = TPF::get_thread_range_parallel_scan_team_policy(m_ncol, nlevm_packs); - const auto team_policy = TPF::get_default_team_policy(m_ncol, nlevm_packs); + const auto scan_policy = TPF::get_thread_range_parallel_scan_team_policy(m_ncol, nlev_mid_packs); + const auto team_policy = TPF::get_default_team_policy(m_ncol, nlev_mid_packs); auto ts_start = start_of_step_ts(); bool is_first_step = (ts_start.get_num_steps()==0); @@ -166,24 +167,49 @@ void ZMDeepConvection::run_impl (const double dt) //---------------------------------------------------------------------------- // get fields + // // variables not updated by ZM + // const auto& phis = get_field_in("phis") .get_view(); + // const auto& p_mid = get_field_in("p_mid") .get_view(); + // const auto& p_int = get_field_in("p_int") .get_view(); + // const auto& p_del = get_field_in("pseudo_density").get_view(); + // const auto& omega = get_field_in("omega") .get_view(); + // const auto& cldfrac = get_field_in("cldfrac_tot") .get_view(); + // const auto& pblh = get_field_in("pbl_height") .get_view(); + // const auto& landfrac = get_field_in("landfrac") .get_view(); + // const auto& thl_sec = get_field_in("thl_sec") .get_view(); + // const auto& qc = get_field_in("qc") .get_view(); + + // // variables updated by ZM + // const auto& T_mid = get_field_out("T_mid") .get_view(); + // const auto& qv = get_field_out("qv") .get_view(); + // const auto& hwinds_fld = get_field_out("horiz_winds"); + // const auto& uwind = hwinds_fld.get_component(0) .get_view(); + // const auto& vwind = hwinds_fld.get_component(1) .get_view(); + + // const auto& precip_liq_surf_mass = get_field_out("precip_liq_surf_mass").get_view(); + // const auto& precip_ice_surf_mass = get_field_out("precip_ice_surf_mass").get_view(); + + //---------------------------------------------------------------------------- + // get fields + // variables not updated by ZM const auto& phis = get_field_in("phis") .get_view(); - const auto& p_mid = get_field_in("p_mid") .get_view(); - const auto& p_int = get_field_in("p_int") .get_view(); - const auto& p_del = get_field_in("pseudo_density").get_view(); - const auto& omega = get_field_in("omega") .get_view(); - const auto& cldfrac = get_field_in("cldfrac_tot") .get_view(); + const auto& p_mid = get_field_in("p_mid") .get_view(); + const auto& p_int = get_field_in("p_int") .get_view(); + const auto& p_del = get_field_in("pseudo_density").get_view(); + const auto& omega = get_field_in("omega") .get_view(); + const auto& cldfrac = get_field_in("cldfrac_tot") .get_view(); const auto& pblh = get_field_in("pbl_height") .get_view(); const auto& landfrac = get_field_in("landfrac") .get_view(); - const auto& thl_sec = get_field_in("thl_sec") .get_view(); - const auto& qc = get_field_in("qc") .get_view(); + const auto& thl_sec = get_field_in("thl_sec") .get_view(); + const auto& qc = get_field_in("qc") .get_view(); // variables updated by ZM - const auto& T_mid = get_field_out("T_mid") .get_view(); - const auto& qv = get_field_out("qv") .get_view(); + const auto& T_mid = get_field_out("T_mid") .get_view(); + const auto& qv = get_field_out("qv") .get_view(); const auto& hwinds_fld = get_field_out("horiz_winds"); - const auto& uwind = hwinds_fld.get_component(0) .get_view(); - const auto& vwind = hwinds_fld.get_component(1) .get_view(); + const auto& uwind = hwinds_fld.get_component(0) .get_view(); + const auto& vwind = hwinds_fld.get_component(1) .get_view(); const auto& precip_liq_surf_mass = get_field_out("precip_liq_surf_mass").get_view(); const auto& precip_ice_surf_mass = get_field_out("precip_ice_surf_mass").get_view(); @@ -206,8 +232,8 @@ void ZMDeepConvection::run_impl (const double dt) zm_input.pblh = pblh; zm_input.landfrac = landfrac; - // initialize output buffer variables - zm_output.init(m_ncol, m_nlev); + // // initialize output buffer variables + // zm_output.init(m_ncol, m_nlev); //---------------------------------------------------------------------------- // calculate altitude on interfaces (z_int) and mid-points (z_mid) @@ -279,16 +305,16 @@ void ZMDeepConvection::run_impl (const double dt) precip_liq_surf_mass(i) += std::max(prec_liq,0.0) * PC::RHO_H2O * dt; precip_ice_surf_mass(i) += zm_output_loc.snow(i) * PC::RHO_H2O * dt; }); - // update 3D prognostic variables - Kokkos::parallel_for("zm_update_prognostics",team_policy, KOKKOS_LAMBDA (const KT::MemberType& team) { - const int i = team.league_rank(); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlevm_packs), [&](const int k) { - T_mid(i,k) += zm_output_loc.tend_s (i,k)/cpair * dt; - qv (i,k) += zm_output_loc.tend_qv(i,k) * dt; - uwind(i,k) += zm_output_loc.tend_u (i,k) * dt; - vwind(i,k) += zm_output_loc.tend_v (i,k) * dt; - }); + + Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { + const int i = idx/nlev_mid_packs; + const int k = idx%nlev_mid_packs; + T_mid(i,k) += zm_output_loc.tend_t (i,k) * dt; + qv (i,k) += zm_output_loc.tend_qv(i,k) * dt; + uwind(i,k) += zm_output_loc.tend_u (i,k) * dt; + vwind(i,k) += zm_output_loc.tend_v (i,k) * dt; }); + } //---------------------------------------------------------------------------- @@ -313,14 +339,13 @@ void ZMDeepConvection::run_impl (const double dt) const auto& zm_qv_tend = get_field_out("zm_qv_tend") .get_view(); const auto& zm_u_tend = get_field_out("zm_u_tend") .get_view(); const auto& zm_v_tend = get_field_out("zm_v_tend") .get_view(); - Kokkos::parallel_for("zm_diag_outputs",team_policy, KOKKOS_LAMBDA (const KT::MemberType& team) { - const auto i = team.league_rank(); - Kokkos::parallel_for(Kokkos::TeamVectorRange(team, nlevm_packs), [&](const int k) { - zm_T_mid_tend(i,k) = zm_output_loc.tend_s (i,k)/cpair; - zm_qv_tend (i,k) = zm_output_loc.tend_qv(i,k); - zm_u_tend (i,k) = zm_output_loc.tend_u (i,k); - zm_v_tend (i,k) = zm_output_loc.tend_v (i,k); - }); + Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { + const int i = idx/nlev_mid_packs; + const int k = idx%nlev_mid_packs; + zm_T_mid_tend(i,k) = zm_output_loc.tend_t (i,k); + zm_qv_tend (i,k) = zm_output_loc.tend_qv(i,k); + zm_u_tend (i,k) = zm_output_loc.tend_u (i,k); + zm_v_tend (i,k) = zm_output_loc.tend_v (i,k); }); } @@ -335,25 +360,27 @@ void ZMDeepConvection::finalize_impl () size_t ZMDeepConvection::requested_buffer_size_in_bytes() const { - const int nlevm_packs = ekat::npack(m_nlev); - const int nlevi_packs = ekat::npack(m_nlev+1); + const int nlev_mid_packs = ekat::npack(m_nlev); + const int nlev_int_packs = ekat::npack(m_nlev+1); size_t zm_buffer_size = 0; - zm_buffer_size+= ZMF::zm_input_state::num_1d_intgr_views * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_1d_scalr_views * sizeof(Scalar)* m_ncol; - - zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_c_views * sizeof(Spack) * m_ncol * nlevm_packs; - zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_c_views * sizeof(Spack) * m_ncol * nlevi_packs; - zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv_f_views * sizeof(Real) * m_ncol * m_nlev; - zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc_f_views * sizeof(Real) * m_ncol * (m_nlev+1); - - zm_buffer_size+= ZMF::zm_output_tend::num_1d_scalr_views * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_1d_intgr_views * sizeof(Int) * m_ncol; - - zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_c_views * sizeof(Spack) * m_ncol * nlevm_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_c_views * sizeof(Spack) * m_ncol * nlevi_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv_f_views * sizeof(Real) * m_ncol * m_nlev; - zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc_f_views * sizeof(Real) * m_ncol * (m_nlev+1); + zm_buffer_size+= ZMF::zm_input_state::num_dvc_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_dvc_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_dvc_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; + zm_buffer_size+= ZMF::zm_input_state::num_dvc_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; + zm_buffer_size+= ZMF::zm_input_state::num_hst_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_hst_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_hst_2d_midlv * sizeof(Real) * m_ncol * m_nlev; + zm_buffer_size+= ZMF::zm_input_state::num_hst_2d_intfc * sizeof(Real) * m_ncol * (m_nlev+1); + + zm_buffer_size+= ZMF::zm_output_tend::num_dvc_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_dvc_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_dvc_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; + zm_buffer_size+= ZMF::zm_output_tend::num_dvc_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; + zm_buffer_size+= ZMF::zm_output_tend::num_hst_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_hst_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_hst_2d_midlv * sizeof(Real) * m_ncol * m_nlev; + zm_buffer_size+= ZMF::zm_output_tend::num_hst_2d_intfc * sizeof(Real) * m_ncol * (m_nlev+1); return zm_buffer_size; } @@ -365,102 +392,127 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) auto buffer_chk = ( buffer_manager.allocated_bytes() >= requested_buffer_size_in_bytes() ); EKAT_REQUIRE_MSG(buffer_chk,"Error! Buffers size not sufficient.\n"); - const int nlevm_packs = ekat::npack(m_nlev); - const int nlevi_packs = ekat::npack(m_nlev+1); + const int nlev_mid_packs = ekat::npack(m_nlev); + const int nlev_int_packs = ekat::npack(m_nlev+1); - constexpr auto num_1d_intgr_views = ZMF::zm_input_state::num_1d_intgr_views + ZMF::zm_output_tend::num_1d_intgr_views; - constexpr auto num_1d_scalr_views = ZMF::zm_input_state::num_1d_scalr_views + ZMF::zm_output_tend::num_1d_scalr_views; - constexpr auto num_2d_midlv_c_views = ZMF::zm_input_state::num_2d_midlv_c_views + ZMF::zm_output_tend::num_2d_midlv_c_views; - constexpr auto num_2d_intfc_c_views = ZMF::zm_input_state::num_2d_intfc_c_views + ZMF::zm_output_tend::num_2d_intfc_c_views; - constexpr auto num_2d_midlv_f_views = ZMF::zm_input_state::num_2d_midlv_f_views + ZMF::zm_output_tend::num_2d_midlv_f_views; - constexpr auto num_2d_intfc_f_views = ZMF::zm_input_state::num_2d_intfc_f_views + ZMF::zm_output_tend::num_2d_intfc_f_views; + constexpr auto num_dvc_1d_intgr = ZMF::zm_input_state::num_dvc_1d_intgr + ZMF::zm_output_tend::num_dvc_1d_intgr; + constexpr auto num_dvc_1d_scalr = ZMF::zm_input_state::num_dvc_1d_scalr + ZMF::zm_output_tend::num_dvc_1d_scalr; + constexpr auto num_dvc_2d_midlv = ZMF::zm_input_state::num_dvc_2d_midlv + ZMF::zm_output_tend::num_dvc_2d_midlv; + constexpr auto num_dvc_2d_intfc = ZMF::zm_input_state::num_dvc_2d_intfc + ZMF::zm_output_tend::num_dvc_2d_intfc; + + constexpr auto num_hst_1d_intgr = ZMF::zm_input_state::num_hst_1d_intgr + ZMF::zm_output_tend::num_hst_1d_intgr; + constexpr auto num_hst_1d_scalr = ZMF::zm_input_state::num_hst_1d_scalr + ZMF::zm_output_tend::num_hst_1d_scalr; + constexpr auto num_hst_2d_midlv = ZMF::zm_input_state::num_hst_2d_midlv + ZMF::zm_output_tend::num_hst_2d_midlv; + constexpr auto num_hst_2d_intfc = ZMF::zm_input_state::num_hst_2d_intfc + ZMF::zm_output_tend::num_hst_2d_intfc; //---------------------------------------------------------------------------- Int* i_mem = reinterpret_cast(buffer_manager.get_memory()); //---------------------------------------------------------------------------- - // 1D integer variables - ZMF::uview_1d* int_ptrs[num_1d_intgr_views] = { &zm_output.activity - }; - for (int i=0; i(i_mem, m_ncol); - i_mem += int_ptrs[i]->size(); + // device 1D integer variables + ZMF::uview_1d* ptrs_dvc_1d_intgr[num_dvc_1d_intgr] = { &zm_output.activity + }; + for (int i=0; i(i_mem, m_ncol); + i_mem += ptrs_dvc_1d_intgr[i]->size(); + } + //---------------------------------------------------------------------------- + // host 1D integer variables + ZMF::uview_1dh* ptrs_hst_1d_intgr[num_hst_1d_intgr] = { &zm_output.h_activity + }; + for (int i=0; i(i_mem, m_ncol); + i_mem += ptrs_hst_1d_intgr[i]->size(); } //---------------------------------------------------------------------------- Scalar* scl_mem = reinterpret_cast(i_mem); //---------------------------------------------------------------------------- - // 1D scalar variables - ZMF::uview_1d* scl_ptrs[num_1d_scalr_views] = { &zm_input.tpert, - &zm_output.prec, - &zm_output.snow, - &zm_output.cape - }; - for (int i=0; i(scl_mem, m_ncol); - scl_mem += scl_ptrs[i]->size(); + // device 1D scalar scalars + ZMF::uview_1d* ptrs_dvc_1d_scalr[num_dvc_1d_scalr] = { &zm_input.tpert, + &zm_output.prec, + &zm_output.snow, + &zm_output.cape, + }; + for (int i=0; i(scl_mem, m_ncol); + scl_mem += ptrs_dvc_1d_scalr[i]->size(); + } + //---------------------------------------------------------------------------- + // host 1D scalar scalars + ZMF::uview_1dh* ptrs_hst_1d_scalr[num_hst_1d_scalr] = { &zm_input.h_phis, + &zm_input.h_pblh, + &zm_input.h_tpert, + &zm_input.h_landfrac, + &zm_output.h_prec, + &zm_output.h_snow, + &zm_output.h_cape, + }; + for (int i=0; i(scl_mem, m_ncol); + scl_mem += ptrs_hst_1d_scalr[i]->size(); } //---------------------------------------------------------------------------- Real* r_mem = reinterpret_cast(scl_mem); //---------------------------------------------------------------------------- - // 2D "f_" views on mid-point levels - ZMF::uview_2dl* midlv_f_ptrs[num_2d_midlv_f_views] = { &zm_input.f_z_mid, - &zm_input.f_p_mid, - &zm_input.f_p_del, - &zm_input.f_T_mid, - &zm_input.f_qv, - &zm_input.f_uwind, - &zm_input.f_vwind, - &zm_input.f_omega, - &zm_input.f_cldfrac, - &zm_output.f_tend_s, - &zm_output.f_tend_qv, - &zm_output.f_tend_u, - &zm_output.f_tend_v, - &zm_output.f_rain_prod, - &zm_output.f_snow_prod - }; - for (int i=0; i(r_mem, m_ncol, m_nlev); - r_mem += midlv_f_ptrs[i]->size(); + // host 2D views on mid-point levels + ZMF::uview_2dh* ptrs_hst_2d_midlv[num_hst_2d_midlv] = { &zm_input.h_z_mid, + &zm_input.h_p_mid, + &zm_input.h_p_del, + &zm_input.h_T_mid, + &zm_input.h_qv, + &zm_input.h_uwind, + &zm_input.h_vwind, + &zm_input.h_omega, + &zm_input.h_cldfrac, + &zm_output.h_tend_t, + &zm_output.h_tend_qv, + &zm_output.h_tend_u, + &zm_output.h_tend_v, + &zm_output.h_rain_prod, + &zm_output.h_snow_prod + }; + for (int i=0; i(r_mem, m_ncol, m_nlev); + r_mem += ptrs_hst_2d_midlv[i]->size(); } //---------------------------------------------------------------------------- - // 2D "f_" views on interface levels - ZMF::uview_2dl* intfc_f_ptrs[num_2d_intfc_f_views] = { &zm_input.f_z_int, - &zm_input.f_p_int, - &zm_output.f_prec_flux, - &zm_output.f_snow_flux, - &zm_output.f_mass_flux - }; - for (int i=0; i(r_mem, m_ncol, (m_nlev+1)); - r_mem += intfc_f_ptrs[i]->size(); + // host 2D views on interface levels + ZMF::uview_2dh* intfc_h_ptrs[num_hst_2d_intfc] = { &zm_input.h_z_int, + &zm_input.h_p_int, + &zm_output.h_prec_flux, + &zm_output.h_snow_flux, + &zm_output.h_mass_flux + }; + for (int i=0; i(r_mem, m_ncol, (m_nlev+1)); + r_mem += intfc_h_ptrs[i]->size(); } //---------------------------------------------------------------------------- Spack* spk_mem = reinterpret_cast(r_mem); //---------------------------------------------------------------------------- - // 2D views on mid-point levels - ZMF::uview_2d* midlv_c_ptrs[num_2d_midlv_c_views] = { &zm_input.z_mid, - &zm_input.z_del, - &zm_output.tend_s, - &zm_output.tend_qv, - &zm_output.tend_u, - &zm_output.tend_v, - &zm_output.rain_prod, - &zm_output.snow_prod - }; - for (int i=0; i(spk_mem, m_ncol, nlevm_packs); - spk_mem += midlv_c_ptrs[i]->size(); + // device 2D views on mid-point levels + ZMF::uview_2d* ptrs_dvc_2d_midlv[num_dvc_2d_midlv] = { &zm_input.z_mid, + &zm_input.z_del, + &zm_output.tend_t, + &zm_output.tend_qv, + &zm_output.tend_u, + &zm_output.tend_v, + &zm_output.rain_prod, + &zm_output.snow_prod + }; + for (int i=0; i(spk_mem, m_ncol, nlev_mid_packs); + spk_mem += ptrs_dvc_2d_midlv[i]->size(); } //---------------------------------------------------------------------------- - // 2D variables on interface levels - ZMF::uview_2d* intfc_c_ptrs[num_2d_intfc_c_views] = { &zm_input.z_int, - &zm_output.prec_flux, - &zm_output.snow_flux, - &zm_output.mass_flux - }; - for (int i=0; i(spk_mem, m_ncol, nlevi_packs); - spk_mem += intfc_c_ptrs[i]->size(); + // device 2D views on interface levels + ZMF::uview_2d* ptrs_dvc_2d_intfc[num_dvc_2d_intfc] = { &zm_input.z_int, + &zm_output.prec_flux, + &zm_output.snow_flux, + &zm_output.mass_flux + }; + for (int i=0; i(spk_mem, m_ncol, nlev_int_packs); + spk_mem += ptrs_dvc_2d_intfc[i]->size(); } //---------------------------------------------------------------------------- Real* total_mem = reinterpret_cast(spk_mem); diff --git a/components/eamxx/src/physics/zm/zm_functions.hpp b/components/eamxx/src/physics/zm/zm_functions.hpp index 3101b63a4ab8..521762a3331a 100644 --- a/components/eamxx/src/physics/zm/zm_functions.hpp +++ b/components/eamxx/src/physics/zm/zm_functions.hpp @@ -40,7 +40,7 @@ struct Functions { template using uview_1d = typename ekat::template Unmanaged >; template using uview_2d = typename ekat::template Unmanaged >; template using uview_2dl = typename ekat::template Unmanaged >; - template using uview_2d_strided = typename ekat::template Unmanaged >; + // template using uview_2d_strided = typename ekat::template Unmanaged >; template using uview_2dh = typename ekat::template Unmanaged>::HostMirror; template using uview_1dh = typename ekat::template Unmanaged>::HostMirror; @@ -62,12 +62,20 @@ struct Functions { Real dtime; // model phsyics time step [s] bool is_first_step; // flag for first call - static constexpr int num_1d_scalr_views = 1; // number of 1D scalar variables - static constexpr int num_1d_intgr_views = 0; // number of 1D integer variables - static constexpr int num_2d_midlv_c_views = 2; // number of 2D variables on mid-point levels - static constexpr int num_2d_intfc_c_views = 1; // number of 2D variables on interface levels - static constexpr int num_2d_midlv_f_views = 9; // number of 2D variables on mid-point levels - static constexpr int num_2d_intfc_f_views = 2; // number of 2D variables on interface levels + static constexpr int num_dvc_1d_intgr = 0; // number of device 1D integer views + static constexpr int num_dvc_1d_scalr = 1; // number of device 1D scalar views + static constexpr int num_dvc_2d_midlv = 2; // number of device 2D views on mid-point levels + static constexpr int num_dvc_2d_intfc = 1; // number of device 2D views on interface levels + + // static constexpr int num_lol_1d_intgr = 0; // number of layout-left 1D integer views + // static constexpr int num_lol_1d_scalr = 0; // number of layout-left 1D scalar views + // static constexpr int num_lol_2d_midlv = 9; // number of layout-left 2D views on mid-point levels + // static constexpr int num_lol_2d_intfc = 2; // number of layout-left 2D views on interface levels + + static constexpr int num_hst_1d_intgr = 0; // number of host 1D integer views + static constexpr int num_hst_1d_scalr = 4; // number of host 1D scalar views + static constexpr int num_hst_2d_midlv = 9; // number of host 2D views on mid-point levels + static constexpr int num_hst_2d_intfc = 2; // number of host 2D views on interface levels uview_1d< Scalar> tpert; // temperature perturbation at top of PBL @@ -90,78 +98,100 @@ struct Functions { view_1d pblh; // PBL height [m] view_1d landfrac; // land area fraction - // unmanaged LayoutLeft views for fortran bridging - uview_2dl f_z_mid; - uview_2dl f_p_mid; - uview_2dl f_p_del; - uview_2dl f_T_mid; - uview_2dl f_qv; - uview_2dl f_uwind; - uview_2dl f_vwind; - uview_2dl f_omega; - uview_2dl f_cldfrac; - uview_2dl f_z_int; - uview_2dl f_p_int; + // LayoutLeft views for fortran bridging + // uview_2dl f_z_mid; + // uview_2dl f_p_mid; + // uview_2dl f_p_del; + // uview_2dl f_T_mid; + // uview_2dl f_qv; + // uview_2dl f_uwind; + // uview_2dl f_vwind; + // uview_2dl f_omega; + // uview_2dl f_cldfrac; + // uview_2dl f_z_int; + // uview_2dl f_p_int; // host mirror versions of ZM interface variables - uview_2dh h_z_mid; - uview_2dh h_p_mid; - uview_2dh h_p_del; - uview_2dh h_T_mid; - uview_2dh h_qv; - uview_2dh h_uwind; - uview_2dh h_vwind; - uview_2dh h_omega; - uview_2dh h_cldfrac; - uview_2dh h_z_int; - uview_2dh h_p_int; - uview_1dh h_phis; uview_1dh h_pblh; uview_1dh h_tpert; uview_1dh h_landfrac; + uview_2dh h_z_mid; + uview_2dh h_p_mid; + uview_2dh h_p_del; + uview_2dh h_T_mid; + uview_2dh h_qv; + uview_2dh h_uwind; + uview_2dh h_vwind; + uview_2dh h_omega; + uview_2dh h_cldfrac; + + uview_2dh h_z_int; + uview_2dh h_p_int; + // ------------------------------------------------------------------------- // transpose method for fortran bridging template - void transpose(int ncol_in, int pver_in) { - auto pverp = pver_in+1; + void transpose(int ncol, int nlev_mid) { + + // auto pverp = pver_in+1; + // if (D == ekat::TransposeDirection::c2f) { + // for (int i=0; i>{phis}); + ekat::device_to_host({h_pblh.data()}, ncol, std::vector< view_1d>{pblh}); + ekat::device_to_host({h_tpert.data()}, ncol, std::vector>{tpert}); + ekat::device_to_host({h_landfrac.data()}, ncol, std::vector< view_1d>{landfrac}); + ekat::device_to_host({h_z_mid.data()}, ncol, nlev_mid, std::vector>{z_mid}); + ekat::device_to_host({h_p_mid.data()}, ncol, nlev_mid, std::vector< view_2d>{p_mid}); + ekat::device_to_host({h_p_del.data()}, ncol, nlev_mid, std::vector< view_2d>{p_del}); + ekat::device_to_host({h_T_mid.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{T_mid}); + ekat::device_to_host({h_qv.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{qv}); + ekat::device_to_host({h_uwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{uwind}); + ekat::device_to_host({h_vwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{vwind}); + ekat::device_to_host({h_omega.data()}, ncol, nlev_mid, std::vector< view_2d>{omega}); + ekat::device_to_host({h_cldfrac.data()}, ncol, nlev_mid, std::vector< view_2d>{cldfrac}); + ekat::device_to_host({h_z_int.data()}, ncol, nlev_int, std::vector>{z_int}); + ekat::device_to_host({h_p_int.data()}, ncol, nlev_int, std::vector< view_2d>{p_int}); } + } // ------------------------------------------------------------------------- }; @@ -169,12 +199,20 @@ struct Functions { struct zm_output_tend { zm_output_tend() = default; - static constexpr int num_1d_intgr_views = 1; // number of 1D integer variables - static constexpr int num_1d_scalr_views = 3; // number of 1D scalar variables - static constexpr int num_2d_midlv_c_views = 6; // number of 2D variables on mid-point levels - static constexpr int num_2d_intfc_c_views = 3; // number of 2D variables on interface levels - static constexpr int num_2d_midlv_f_views = 6; // number of 2D variables on mid-point levels - static constexpr int num_2d_intfc_f_views = 3; // number of 2D variables on interface levels + static constexpr int num_dvc_1d_intgr = 1; // number of device 1D integer views + static constexpr int num_dvc_1d_scalr = 3; // number of device 1D scalar views + static constexpr int num_dvc_2d_midlv = 6; // number of device 2D views on mid-point levels + static constexpr int num_dvc_2d_intfc = 3; // number of device 2D views on interface levels + + // static constexpr int num_lol_1d_intgr = 0; // number of layout-left 1D integer views + // static constexpr int num_lol_1d_scalr = 0; // number of layout-left 1D scalar views + // static constexpr int num_lol_2d_midlv = 6; // number of layout-left 2D views on mid-point levels + // static constexpr int num_lol_2d_intfc = 3; // number of layout-left 2D views on interface levels + + static constexpr int num_hst_1d_intgr = 1; // number of host 1D integer views + static constexpr int num_hst_1d_scalr = 3; // number of host 1D scalar views + static constexpr int num_hst_2d_midlv = 6; // number of host 2D views on mid-point levels + static constexpr int num_hst_2d_intfc = 3; // number of host 2D views on interface levels uview_1d activity; // integer deep convection activity flag @@ -182,7 +220,7 @@ struct Functions { uview_1d snow; // surface snow [m/s] uview_1d cape; // convective available potential energy [J] - uview_2d tend_s; // output tendency of dry static energy [] + uview_2d tend_t; // output tendency of dry static energy [] uview_2d tend_qv; // output tendency of water vapor [] uview_2d tend_u; // output tendency of zonal wind [] uview_2d tend_v; // output tendency of meridional wind [] @@ -194,147 +232,325 @@ struct Functions { uview_2d mass_flux; // output convective mass flux [] // LayoutLeft views for fortran bridging - uview_2dl f_tend_s; - uview_2dl f_tend_qv; - uview_2dl f_tend_u; - uview_2dl f_tend_v; - uview_2dl f_rain_prod; - uview_2dl f_snow_prod; - uview_2dl f_prec_flux; - uview_2dl f_snow_flux; - uview_2dl f_mass_flux; - - // host mirror versions of ZM interface variables - uview_2dh h_tend_s; - uview_2dh h_tend_qv; - uview_2dh h_tend_u; - uview_2dh h_tend_v; - uview_2dh h_rain_prod; - uview_2dh h_snow_prod; - uview_2dh h_prec_flux; - uview_2dh h_snow_flux; - uview_2dh h_mass_flux; + // uview_2dl f_tend_t; + // uview_2dl f_tend_qv; + // uview_2dl f_tend_u; + // uview_2dl f_tend_v; + // uview_2dl f_rain_prod; + // uview_2dl f_snow_prod; + + // uview_2dl f_prec_flux; + // uview_2dl f_snow_flux; + // uview_2dl f_mass_flux; + + // host versions of ZM interface variables + uview_1dh h_activity; uview_1dh h_prec; uview_1dh h_snow; uview_1dh h_cape; - uview_1dh h_activity; + + uview_2dh h_tend_t; + uview_2dh h_tend_qv; + uview_2dh h_tend_u; + uview_2dh h_tend_v; + uview_2dh h_rain_prod; + uview_2dh h_snow_prod; + + uview_2dh h_prec_flux; + uview_2dh h_snow_flux; + uview_2dh h_mass_flux; // ------------------------------------------------------------------------- // transpose method for fortran bridging template - void transpose(int ncol_in, int pver_in) { - auto pverp = pver_in+1; - if (D == ekat::TransposeDirection::c2f) { - for (int i=0; i> tmp_vector_d[1]; + + // std::vector> tmp_vector_d = {h_prec}; + // std::vector< view_1d > tmp_vector_h = {prec.data()}; + + // std::vector> tmp(1); + // ekat::host_to_device({h_prec.data()}, ncol, tmp); + // Kokkos::deep_copy(prec,tmp[0]); + + ekat::host_to_device({h_prec.data()}, ncol, std::vector> {prec}); + + + // prec = tmp_vector[0]; + // ekat::host_to_device({prec}, ncol, std::vector>{h_prec}); + // ekat::host_to_device({h_prec.data()}, ncol, std::vector< view_1d >{prec}); + + // ekat::host_to_device({h_activity}, ncol, std::vector> {activity}); + // ekat::host_to_device({h_prec}, ncol, std::vector>{prec}); + // ekat::host_to_device({h_snow}, ncol, std::vector>{snow}); + // ekat::host_to_device({h_cape}, ncol, std::vector>{cape}); + // ekat::host_to_device({h_tend_t}, ncol, nlev_mid, std::vector> {tend_t}); + // ekat::host_to_device({h_tend_qv}, ncol, nlev_mid, std::vector> {tend_qv}); + // ekat::host_to_device({h_tend_u}, ncol, nlev_mid, std::vector> {tend_u}); + // ekat::host_to_device({h_tend_v}, ncol, nlev_mid, std::vector> {tend_v}); + // ekat::host_to_device({h_rain_prod},ncol, nlev_mid, std::vector> {rain_prod}); + // ekat::host_to_device({h_snow_prod},ncol, nlev_mid, std::vector> {snow_prod}); + // ekat::host_to_device({h_prec_flux},ncol, nlev_int, std::vector> {prec_flux}); + // ekat::host_to_device({h_snow_flux},ncol, nlev_int, std::vector> {snow_flux}); + // ekat::host_to_device({h_mass_flux},ncol, nlev_int, std::vector> {mass_flux}); } + + + // auto nlev_int = nlev_mid+1; + // if (D == ekat::TransposeDirection::f2c) { + // ekat::host_to_device({h_activity}, ncol, std::vector> {activity}); + // ekat::host_to_device({h_prec}, ncol, std::vector< view_1d >{prec}); + // ekat::host_to_device({h_snow}, ncol, std::vector< view_1d >{snow}); + // ekat::host_to_device({h_cape}, ncol, std::vector< view_1d >{cape}); + // ekat::host_to_device({h_tend_t}, ncol, nlev_mid, std::vector> {tend_t}); + // ekat::host_to_device({h_tend_qv}, ncol, nlev_mid, std::vector> {tend_qv}); + // ekat::host_to_device({h_tend_u}, ncol, nlev_mid, std::vector> {tend_u}); + // ekat::host_to_device({h_tend_v}, ncol, nlev_mid, std::vector> {tend_v}); + // ekat::host_to_device({h_rain_prod},ncol, nlev_mid, std::vector> {rain_prod}); + // ekat::host_to_device({h_snow_prod},ncol, nlev_mid, std::vector> {snow_prod}); + // ekat::host_to_device({h_prec_flux},ncol, nlev_int, std::vector> {prec_flux}); + // ekat::host_to_device({h_snow_flux},ncol, nlev_int, std::vector> {snow_flux}); + // ekat::host_to_device({h_mass_flux},ncol, nlev_int, std::vector> {mass_flux}); + // } + + // std::vector> h_int_vector_1d = {h_activity}; + // std::vector> d_int_vector_1d = {activity}; + // std::vector> h_scl_vector_1d = {h_prec, + // h_snow, + // h_cape}; + // std::vector< view_1d > d_scl_vector_1d = {prec, + // snow, + // cape}; + // std::vector> h_vector_2d_mid = {h_tend_t, + // h_tend_qv, + // h_tend_u, + // h_tend_v, + // h_rain_prod, + // h_snow_prod}; + // std::vector> d_vector_2d_mid = {tend_t, + // tend_qv, + // tend_u, + // tend_v, + // rain_prod, + // snow_prod}; + // std::vector> h_vector_2d_int = {h_prec_flux, + // h_snow_flux, + // h_mass_flux}; + // std::vector< view_2d > d_vector_2d_int = {prec_flux, + // snow_flux, + // mass_flux}; + + // ekat::device_to_host(h_int_vector_1d, ncol, d_int_vector_1d); + // ekat::device_to_host(h_scl_vector_1d, ncol, d_scl_vector_1d); + // ekat::device_to_host(h_vector_2d_mid, ncol, nlev_mid, d_vector_2d_mid); + // ekat::device_to_host(h_vector_2d_int, ncol, nlev_int, d_vector_2d_int); + // } + }; + // // ------------------------------------------------------------------------- + // void init(int ncol_in, int nlev_mid_in) { + // auto nlev_int_in = nlev_mid_in+1; + // auto nlev_int_packs = ekat::npack(pverp); + // auto nlev_int_packs = ekat::npack(pverp); + // Kokkos::parallel_for("zm_output_init", KT::RangePolicy(0, m_ncol), KOKKOS_LAMBDA (const int i) { + // Real init_fill_value = -999; + // // 1D scalar variables + // prec(i) = init_fill_value; + // snow(i) = init_fill_value; + // cape(i) = init_fill_value; + // activity(i) = -1; + // } + // // mid-point level variables + // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlevm_packs), KOKKOS_LAMBDA (const int i) { + // const int icol = i/nlevm_packs; + // const int ilev = i%nlevm_packs; + // tend_t (i,k) = init_fill_value; + // tend_qv (i,k) = init_fill_value; + // tend_u (i,k) = init_fill_value; + // tend_v (i,k) = init_fill_value; + // rain_prod(i,k) = init_fill_value; + // snow_prod(i,k) = init_fill_value; + // } + // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*pver_in), KOKKOS_LAMBDA (const int i) { + // const int icol = i/pver_in; + // const int ilev = i%pver_in; + // f_tend_t (i,k) = init_fill_value; + // f_tend_qv (i,k) = init_fill_value; + // f_tend_u (i,k) = init_fill_value; + // f_tend_v (i,k) = init_fill_value; + // f_rain_prod(i,k) = init_fill_value; + // f_snow_prod(i,k) = init_fill_value; + // } + // // interface level variables + // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlevi_packs), KOKKOS_LAMBDA (const int i) { + // const int icol = i/nlevi_packs; + // const int ilev = i%nlevi_packs; + // prec_flux(i,k) = init_fill_value; + // snow_flux(i,k) = init_fill_value; + // mass_flux(i,k) = init_fill_value; + // } + // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*pverp), KOKKOS_LAMBDA (const int i) { + // const int icol = i/pverp; + // const int ilev = i%pverp; + // f_prec_flux(i,k) = init_fill_value; + // f_snow_flux(i,k) = init_fill_value; + // f_mass_flux(i,k) = init_fill_value; + // } + + // // mid-point level variables + // for (int i=0; i Date: Thu, 23 Oct 2025 11:20:47 -0700 Subject: [PATCH 18/31] major updates for GPU support cosmetic variable renaming remove unnecessary transpose calls --- .../physics/zm/eamxx_zm_process_interface.cpp | 350 ++++------ .../zm/fortran_bridge/zm_eamxx_bridge.cpp | 2 - .../eamxx/src/physics/zm/zm_functions.hpp | 602 +++++------------- 3 files changed, 287 insertions(+), 667 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index da03b53a43ab..32dd7960ca27 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -100,54 +100,47 @@ void ZMDeepConvection::initialize_impl (const RunType) add_postcondition_check(get_field_out("precip_liq_surf_mass"),m_grid,0.0,false); add_postcondition_check(get_field_out("precip_ice_surf_mass"),m_grid,0.0,false); - // initialize variables on the fortran side - zm::zm_eamxx_bridge_init(m_nlev); - //---------------------------------------------------------------------------- - // initialize host mirrors here to ensure managed variables are allocated - - // zm_input.h_z_mid = Kokkos::create_mirror_view(zm_input.f_z_mid); - // zm_input.h_p_mid = Kokkos::create_mirror_view(zm_input.f_p_mid); - // zm_input.h_p_del = Kokkos::create_mirror_view(zm_input.f_p_del); - // zm_input.h_T_mid = Kokkos::create_mirror_view(zm_input.f_T_mid); - // zm_input.h_qv = Kokkos::create_mirror_view(zm_input.f_qv); - // zm_input.h_uwind = Kokkos::create_mirror_view(zm_input.f_uwind); - // zm_input.h_vwind = Kokkos::create_mirror_view(zm_input.f_vwind); - // zm_input.h_omega = Kokkos::create_mirror_view(zm_input.f_omega); - // zm_input.h_cldfrac = Kokkos::create_mirror_view(zm_input.f_cldfrac); - // zm_input.h_z_int = Kokkos::create_mirror_view(zm_input.f_z_int); - // zm_input.h_p_int = Kokkos::create_mirror_view(zm_input.f_p_int); - // zm_input.h_tpert = Kokkos::create_mirror_view(zm_input.tpert); - - // zm_output.h_tend_t = Kokkos::create_mirror_view(zm_output.f_tend_t); - // zm_output.h_tend_qv = Kokkos::create_mirror_view(zm_output.f_tend_qv); - // zm_output.h_tend_u = Kokkos::create_mirror_view(zm_output.f_tend_u); - // zm_output.h_tend_v = Kokkos::create_mirror_view(zm_output.f_tend_v); - // zm_output.h_rain_prod = Kokkos::create_mirror_view(zm_output.f_rain_prod); - // zm_output.h_snow_prod = Kokkos::create_mirror_view(zm_output.f_snow_prod); - // zm_output.h_prec_flux = Kokkos::create_mirror_view(zm_output.f_prec_flux); - // zm_output.h_snow_flux = Kokkos::create_mirror_view(zm_output.f_snow_flux); - // zm_output.h_mass_flux = Kokkos::create_mirror_view(zm_output.f_mass_flux); - // zm_output.h_prec = Kokkos::create_mirror_view(zm_output.prec); - // zm_output.h_snow = Kokkos::create_mirror_view(zm_output.snow); - // zm_output.h_cape = Kokkos::create_mirror_view(zm_output.cape); - // zm_output.h_activity = Kokkos::create_mirror_view(zm_output.activity); + // allocate host mirror variables + + zm_input.h_phis = ZMF::view_1dh("zm_input_h_phis" ,m_ncol); + zm_input.h_pblh = ZMF::view_1dh("zm_input_h_pblh" ,m_ncol); + zm_input.h_tpert = ZMF::view_1dh("zm_input_h_tpert" ,m_ncol); + zm_input.h_landfrac = ZMF::view_1dh("zm_input_h_landfrac" ,m_ncol); + zm_input.h_z_mid = ZMF::view_2dh ("zm_input_h_z_mid" ,m_ncol, m_nlev); + zm_input.h_p_mid = ZMF::view_2dh ("zm_input_h_p_mid" ,m_ncol, m_nlev); + zm_input.h_p_del = ZMF::view_2dh ("zm_input_h_p_del" ,m_ncol, m_nlev); + zm_input.h_T_mid = ZMF::view_2dh ("zm_input_h_T_mid" ,m_ncol, m_nlev); + zm_input.h_qv = ZMF::view_2dh ("zm_input_h_qv" ,m_ncol, m_nlev); + zm_input.h_uwind = ZMF::view_2dh ("zm_input_h_uwind" ,m_ncol, m_nlev); + zm_input.h_vwind = ZMF::view_2dh ("zm_input_h_vwind" ,m_ncol, m_nlev); + zm_input.h_omega = ZMF::view_2dh ("zm_input_h_omega" ,m_ncol, m_nlev); + zm_input.h_cldfrac = ZMF::view_2dh ("zm_input_h_cldfrac" ,m_ncol, m_nlev); + zm_input.h_z_int = ZMF::view_2dh ("zm_input_h_z_int" ,m_ncol, m_nlev+1); + zm_input.h_p_int = ZMF::view_2dh ("zm_input_h_p_int" ,m_ncol, m_nlev+1); + zm_output.h_activity = ZMF::view_1dh ("zm_output_h_activity" ,m_ncol); + zm_output.h_prec = ZMF::view_1dh("zm_output_h_prec" ,m_ncol); + zm_output.h_snow = ZMF::view_1dh("zm_output_h_snow" ,m_ncol); + zm_output.h_cape = ZMF::view_1dh("zm_output_h_cape" ,m_ncol); + zm_output.h_tend_t = ZMF::view_2dh ("zm_output_h_tend_t" ,m_ncol, m_nlev); + zm_output.h_tend_qv = ZMF::view_2dh ("zm_output_h_tend_qv" ,m_ncol, m_nlev); + zm_output.h_tend_u = ZMF::view_2dh ("zm_output_h_tend_u" ,m_ncol, m_nlev); + zm_output.h_tend_v = ZMF::view_2dh ("zm_output_h_tend_v" ,m_ncol, m_nlev); + zm_output.h_rain_prod = ZMF::view_2dh ("zm_output_h_rain_prod" ,m_ncol, m_nlev); + zm_output.h_snow_prod = ZMF::view_2dh ("zm_output_h_snow_prod" ,m_ncol, m_nlev); + zm_output.h_prec_flux = ZMF::view_2dh ("zm_output_h_prec_flux" ,m_ncol, m_nlev+1); + zm_output.h_snow_flux = ZMF::view_2dh ("zm_output_h_snow_flux" ,m_ncol, m_nlev+1); + zm_output.h_mass_flux = ZMF::view_2dh ("zm_output_h_mass_flux" ,m_ncol, m_nlev+1); //---------------------------------------------------------------------------- - // initialize host mirror variables for managed views - const auto& phis = get_field_in("phis") .get_view(); - const auto& pblh = get_field_in("pbl_height") .get_view(); - const auto& landfrac = get_field_in("landfrac") .get_view(); - zm_input.h_phis = Kokkos::create_mirror_view(phis); - zm_input.h_pblh = Kokkos::create_mirror_view(pblh); - zm_input.h_landfrac = Kokkos::create_mirror_view(landfrac); + // initialize variables on the fortran side + zm::zm_eamxx_bridge_init(m_nlev); } /*------------------------------------------------------------------------------------------------*/ void ZMDeepConvection::run_impl (const double dt) { - constexpr int pack_size = Spack::n; const int nlev_mid_packs = ekat::npack(m_nlev); // calculate_z_int() contains a team-level parallel_scan, which requires a special policy @@ -158,37 +151,6 @@ void ZMDeepConvection::run_impl (const double dt) auto ts_start = start_of_step_ts(); bool is_first_step = (ts_start.get_num_steps()==0); - //---------------------------------------------------------------------------- - // get constants - - const Real cpair = PC::Cpair; - const Real latvap = PC::LatVap; - - //---------------------------------------------------------------------------- - // get fields - - // // variables not updated by ZM - // const auto& phis = get_field_in("phis") .get_view(); - // const auto& p_mid = get_field_in("p_mid") .get_view(); - // const auto& p_int = get_field_in("p_int") .get_view(); - // const auto& p_del = get_field_in("pseudo_density").get_view(); - // const auto& omega = get_field_in("omega") .get_view(); - // const auto& cldfrac = get_field_in("cldfrac_tot") .get_view(); - // const auto& pblh = get_field_in("pbl_height") .get_view(); - // const auto& landfrac = get_field_in("landfrac") .get_view(); - // const auto& thl_sec = get_field_in("thl_sec") .get_view(); - // const auto& qc = get_field_in("qc") .get_view(); - - // // variables updated by ZM - // const auto& T_mid = get_field_out("T_mid") .get_view(); - // const auto& qv = get_field_out("qv") .get_view(); - // const auto& hwinds_fld = get_field_out("horiz_winds"); - // const auto& uwind = hwinds_fld.get_component(0) .get_view(); - // const auto& vwind = hwinds_fld.get_component(1) .get_view(); - - // const auto& precip_liq_surf_mass = get_field_out("precip_liq_surf_mass").get_view(); - // const auto& precip_ice_surf_mass = get_field_out("precip_ice_surf_mass").get_view(); - //---------------------------------------------------------------------------- // get fields @@ -231,62 +193,47 @@ void ZMDeepConvection::run_impl (const double dt) zm_input.cldfrac = cldfrac; zm_input.pblh = pblh; zm_input.landfrac = landfrac; + zm_input.thl_sec = thl_sec; + zm_input.qc = qc; - // // initialize output buffer variables - // zm_output.init(m_ncol, m_nlev); + // initialize output buffer variables + zm_output.init(m_ncol, m_nlev); //---------------------------------------------------------------------------- // calculate altitude on interfaces (z_int) and mid-points (z_mid) - // const auto zm_input_loc = zm_input; + // create temporaries to avoid "Implicit capture" warning + const auto loc_zm_input_p_mid = zm_input.p_mid; + const auto loc_zm_input_p_del = zm_input.p_del; + const auto loc_zm_input_T_mid = zm_input.T_mid; + const auto loc_zm_input_qv = zm_input.qv; + auto loc_zm_input_z_mid = zm_input.z_mid; + auto loc_zm_input_z_del = zm_input.z_del; + auto loc_zm_input_z_int = zm_input.z_int; + auto loc_nlev = m_nlev; + Kokkos::parallel_for(scan_policy, KOKKOS_LAMBDA (const KT::MemberType& team) { const int i = team.league_rank(); - const auto z_mid_i = ekat::subview(zm_input.z_mid, i); - const auto z_del_i = ekat::subview(zm_input.z_del, i); - const auto z_int_i = ekat::subview(zm_input.z_int, i); - const auto p_mid_i = ekat::subview(zm_input.p_mid, i); - const auto p_del_i = ekat::subview(zm_input.p_del, i); - const auto T_mid_i = ekat::subview(zm_input.T_mid, i); - const auto qv_i = ekat::subview(zm_input.qv, i); + const auto p_mid_i = ekat::subview(loc_zm_input_p_mid, i); + const auto p_del_i = ekat::subview(loc_zm_input_p_del, i); + const auto T_mid_i = ekat::subview(loc_zm_input_T_mid, i); + const auto qv_i = ekat::subview(loc_zm_input_qv, i); + auto z_mid_i = ekat::subview(loc_zm_input_z_mid, i); + auto z_del_i = ekat::subview(loc_zm_input_z_del, i); + auto z_int_i = ekat::subview(loc_zm_input_z_int, i); auto z_surf = 0.0; // ZM expects z_mid & z_int to be altitude above the surface PF::calculate_dz(team, p_del_i, p_mid_i, T_mid_i, qv_i, z_del_i); team.team_barrier(); - PF::calculate_z_int(team, m_nlev, z_del_i, z_surf, z_int_i); + PF::calculate_z_int(team, loc_nlev, z_del_i, z_surf, z_int_i); team.team_barrier(); - PF::calculate_z_mid(team, m_nlev, z_int_i, z_mid_i); + PF::calculate_z_mid(team, loc_nlev, z_int_i, z_mid_i); team.team_barrier(); }); //---------------------------------------------------------------------------- // calculate temperature perturbation from SHOC thetal varance for ZM parcel/CAPE - Kokkos::parallel_for("zm_calculate_tpert",m_ncol, KOKKOS_LAMBDA (const int i) { - if (is_first_step) { - zm_input.tpert(i) = 0.0; - } else { - // identify interface index for top of PBL - int pblh_k_ind = -1; - for (int k=0; kpblh(i) && z_int_tmp_kp1<=pblh(i) ) { - pblh_k_ind = k; - } - } - if (pblh_k_ind==-1) { - // PBL top index not found, so just set the perturbation to zero - zm_input.tpert(i) = 0.0; - } else { - // calculate tpert as std deviation of temperature from SHOC's theta-l variance - auto exner_pbl = PF::exner_function( p_mid(i,pblh_k_ind/pack_size)[pblh_k_ind%pack_size] ); - auto qc_pbl = qc(i,pblh_k_ind/pack_size)[pblh_k_ind%pack_size]; - auto thl_sec_pbl = thl_sec(i,pblh_k_ind/pack_size)[pblh_k_ind%pack_size]; - auto thl_std_pbl = sqrt( thl_sec_pbl ); // std deviation of thetal; - zm_input.tpert(i) = ( thl_std_pbl + (latvap/cpair)*qc_pbl ) / exner_pbl; - zm_input.tpert(i) = std::min(2.0,zm_input.tpert(i)); // apply limiter - } - } - }); + zm_input.calculate_tpert(m_ncol,m_nlev,is_first_step); //---------------------------------------------------------------------------- // run the ZM scheme @@ -294,25 +241,35 @@ void ZMDeepConvection::run_impl (const double dt) zm_eamxx_bridge_run(m_ncol, m_nlev, zm_input, zm_output, zm_opts); //---------------------------------------------------------------------------- - // update prognostic fields + // create temporaries of output variables to avoid "Implicit capture" warning - const auto zm_output_loc = zm_output; // create temp to avoid "Implicit capture" warning + const auto loc_zm_output_prec = zm_output.prec; + const auto loc_zm_output_snow = zm_output.snow; + const auto loc_zm_output_cape = zm_output.cape; + const auto loc_zm_output_activity = zm_output.activity; + const auto loc_zm_output_tend_t = zm_output.tend_t; + const auto loc_zm_output_tend_qv = zm_output.tend_qv; + const auto loc_zm_output_tend_u = zm_output.tend_u; + const auto loc_zm_output_tend_v = zm_output.tend_v; + + //---------------------------------------------------------------------------- + // update prognostic fields if (zm_opts.apply_tendencies) { // accumulate surface precipitation fluxes Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol), KOKKOS_LAMBDA (const int i) { - auto prec_liq = zm_output_loc.prec(i) - zm_output_loc.snow(i); - precip_liq_surf_mass(i) += std::max(prec_liq,0.0) * PC::RHO_H2O * dt; - precip_ice_surf_mass(i) += zm_output_loc.snow(i) * PC::RHO_H2O * dt; + Real prec_liq = loc_zm_output_prec(i) - loc_zm_output_snow(i); + precip_liq_surf_mass(i) += ekat::impl::max(0.0,prec_liq) * PC::RHO_H2O * dt; + precip_ice_surf_mass(i) += loc_zm_output_snow(i) * PC::RHO_H2O * dt; }); Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { const int i = idx/nlev_mid_packs; const int k = idx%nlev_mid_packs; - T_mid(i,k) += zm_output_loc.tend_t (i,k) * dt; - qv (i,k) += zm_output_loc.tend_qv(i,k) * dt; - uwind(i,k) += zm_output_loc.tend_u (i,k) * dt; - vwind(i,k) += zm_output_loc.tend_v (i,k) * dt; + T_mid(i,k) += loc_zm_output_tend_t (i,k) * dt; + qv (i,k) += loc_zm_output_tend_qv(i,k) * dt; + uwind(i,k) += loc_zm_output_tend_u (i,k) * dt; + vwind(i,k) += loc_zm_output_tend_v (i,k) * dt; }); } @@ -320,32 +277,30 @@ void ZMDeepConvection::run_impl (const double dt) //---------------------------------------------------------------------------- // Update output fields - // NOTE - in the future we might want to clean this up using Kokkos::deep_copy(), - // 2D output (no vertical dimension) const auto& zm_prec = get_field_out("zm_prec") .get_view(); const auto& zm_snow = get_field_out("zm_snow") .get_view(); const auto& zm_cape = get_field_out("zm_cape") .get_view(); const auto& zm_activity = get_field_out("zm_activity") .get_view(); Kokkos::parallel_for("zm_diag_outputs_2D",m_ncol, KOKKOS_LAMBDA (const int i) { - zm_prec (i) = zm_output_loc.prec (i); - zm_snow (i) = zm_output_loc.snow (i); - zm_cape (i) = zm_output_loc.cape (i); - zm_activity(i) = zm_output_loc.activity(i); + zm_prec (i) = loc_zm_output_prec (i); + zm_snow (i) = loc_zm_output_snow (i); + zm_cape (i) = loc_zm_output_cape (i); + zm_activity(i) = loc_zm_output_activity(i); }); // 3D output (vertically resolved) - const auto& zm_T_mid_tend = get_field_out("zm_T_mid_tend") .get_view(); - const auto& zm_qv_tend = get_field_out("zm_qv_tend") .get_view(); - const auto& zm_u_tend = get_field_out("zm_u_tend") .get_view(); - const auto& zm_v_tend = get_field_out("zm_v_tend") .get_view(); + const auto& zm_T_mid_tend = get_field_out("zm_T_mid_tend") .get_view(); + const auto& zm_qv_tend = get_field_out("zm_qv_tend") .get_view(); + const auto& zm_u_tend = get_field_out("zm_u_tend") .get_view(); + const auto& zm_v_tend = get_field_out("zm_v_tend") .get_view(); Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { const int i = idx/nlev_mid_packs; const int k = idx%nlev_mid_packs; - zm_T_mid_tend(i,k) = zm_output_loc.tend_t (i,k); - zm_qv_tend (i,k) = zm_output_loc.tend_qv(i,k); - zm_u_tend (i,k) = zm_output_loc.tend_u (i,k); - zm_v_tend (i,k) = zm_output_loc.tend_v (i,k); + zm_T_mid_tend(i,k) = loc_zm_output_tend_t (i,k); + zm_qv_tend (i,k) = loc_zm_output_tend_qv(i,k); + zm_u_tend (i,k) = loc_zm_output_tend_u (i,k); + zm_v_tend (i,k) = loc_zm_output_tend_v (i,k); }); } @@ -364,23 +319,15 @@ size_t ZMDeepConvection::requested_buffer_size_in_bytes() const const int nlev_int_packs = ekat::npack(m_nlev+1); size_t zm_buffer_size = 0; - zm_buffer_size+= ZMF::zm_input_state::num_dvc_1d_intgr * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_dvc_1d_scalr * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_dvc_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; - zm_buffer_size+= ZMF::zm_input_state::num_dvc_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; - zm_buffer_size+= ZMF::zm_input_state::num_hst_1d_intgr * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_hst_1d_scalr * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_input_state::num_hst_2d_midlv * sizeof(Real) * m_ncol * m_nlev; - zm_buffer_size+= ZMF::zm_input_state::num_hst_2d_intfc * sizeof(Real) * m_ncol * (m_nlev+1); - - zm_buffer_size+= ZMF::zm_output_tend::num_dvc_1d_intgr * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_dvc_1d_scalr * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_dvc_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_dvc_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; - zm_buffer_size+= ZMF::zm_output_tend::num_hst_1d_intgr * sizeof(Int) * m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_hst_1d_scalr * sizeof(Scalar)* m_ncol; - zm_buffer_size+= ZMF::zm_output_tend::num_hst_2d_midlv * sizeof(Real) * m_ncol * m_nlev; - zm_buffer_size+= ZMF::zm_output_tend::num_hst_2d_intfc * sizeof(Real) * m_ncol * (m_nlev+1); + zm_buffer_size+= ZMF::zm_input_state::num_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_input_state::num_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; + zm_buffer_size+= ZMF::zm_input_state::num_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; + + zm_buffer_size+= ZMF::zm_output_tend::num_1d_intgr * sizeof(Int) * m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_1d_scalr * sizeof(Scalar)* m_ncol; + zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; + zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; return zm_buffer_size; } @@ -395,102 +342,39 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) const int nlev_mid_packs = ekat::npack(m_nlev); const int nlev_int_packs = ekat::npack(m_nlev+1); - constexpr auto num_dvc_1d_intgr = ZMF::zm_input_state::num_dvc_1d_intgr + ZMF::zm_output_tend::num_dvc_1d_intgr; - constexpr auto num_dvc_1d_scalr = ZMF::zm_input_state::num_dvc_1d_scalr + ZMF::zm_output_tend::num_dvc_1d_scalr; - constexpr auto num_dvc_2d_midlv = ZMF::zm_input_state::num_dvc_2d_midlv + ZMF::zm_output_tend::num_dvc_2d_midlv; - constexpr auto num_dvc_2d_intfc = ZMF::zm_input_state::num_dvc_2d_intfc + ZMF::zm_output_tend::num_dvc_2d_intfc; - - constexpr auto num_hst_1d_intgr = ZMF::zm_input_state::num_hst_1d_intgr + ZMF::zm_output_tend::num_hst_1d_intgr; - constexpr auto num_hst_1d_scalr = ZMF::zm_input_state::num_hst_1d_scalr + ZMF::zm_output_tend::num_hst_1d_scalr; - constexpr auto num_hst_2d_midlv = ZMF::zm_input_state::num_hst_2d_midlv + ZMF::zm_output_tend::num_hst_2d_midlv; - constexpr auto num_hst_2d_intfc = ZMF::zm_input_state::num_hst_2d_intfc + ZMF::zm_output_tend::num_hst_2d_intfc; + constexpr auto num_1d_intgr = ZMF::zm_input_state::num_1d_intgr + ZMF::zm_output_tend::num_1d_intgr; + constexpr auto num_1d_scalr = ZMF::zm_input_state::num_1d_scalr + ZMF::zm_output_tend::num_1d_scalr; + constexpr auto num_2d_midlv = ZMF::zm_input_state::num_2d_midlv + ZMF::zm_output_tend::num_2d_midlv; + constexpr auto num_2d_intfc = ZMF::zm_input_state::num_2d_intfc + ZMF::zm_output_tend::num_2d_intfc; //---------------------------------------------------------------------------- Int* i_mem = reinterpret_cast(buffer_manager.get_memory()); //---------------------------------------------------------------------------- // device 1D integer variables - ZMF::uview_1d* ptrs_dvc_1d_intgr[num_dvc_1d_intgr] = { &zm_output.activity + ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity }; - for (int i=0; i(i_mem, m_ncol); - i_mem += ptrs_dvc_1d_intgr[i]->size(); - } - //---------------------------------------------------------------------------- - // host 1D integer variables - ZMF::uview_1dh* ptrs_hst_1d_intgr[num_hst_1d_intgr] = { &zm_output.h_activity - }; - for (int i=0; i(i_mem, m_ncol); - i_mem += ptrs_hst_1d_intgr[i]->size(); + for (int i=0; i(i_mem, m_ncol); + i_mem += ptrs_1d_intgr[i]->size(); } //---------------------------------------------------------------------------- Scalar* scl_mem = reinterpret_cast(i_mem); //---------------------------------------------------------------------------- // device 1D scalar scalars - ZMF::uview_1d* ptrs_dvc_1d_scalr[num_dvc_1d_scalr] = { &zm_input.tpert, + ZMF::uview_1d* ptrs_1d_scalr[num_1d_scalr] = { &zm_input.tpert, &zm_output.prec, &zm_output.snow, &zm_output.cape, }; - for (int i=0; i(scl_mem, m_ncol); - scl_mem += ptrs_dvc_1d_scalr[i]->size(); - } - //---------------------------------------------------------------------------- - // host 1D scalar scalars - ZMF::uview_1dh* ptrs_hst_1d_scalr[num_hst_1d_scalr] = { &zm_input.h_phis, - &zm_input.h_pblh, - &zm_input.h_tpert, - &zm_input.h_landfrac, - &zm_output.h_prec, - &zm_output.h_snow, - &zm_output.h_cape, - }; - for (int i=0; i(scl_mem, m_ncol); - scl_mem += ptrs_hst_1d_scalr[i]->size(); - } - //---------------------------------------------------------------------------- - Real* r_mem = reinterpret_cast(scl_mem); - //---------------------------------------------------------------------------- - // host 2D views on mid-point levels - ZMF::uview_2dh* ptrs_hst_2d_midlv[num_hst_2d_midlv] = { &zm_input.h_z_mid, - &zm_input.h_p_mid, - &zm_input.h_p_del, - &zm_input.h_T_mid, - &zm_input.h_qv, - &zm_input.h_uwind, - &zm_input.h_vwind, - &zm_input.h_omega, - &zm_input.h_cldfrac, - &zm_output.h_tend_t, - &zm_output.h_tend_qv, - &zm_output.h_tend_u, - &zm_output.h_tend_v, - &zm_output.h_rain_prod, - &zm_output.h_snow_prod - }; - for (int i=0; i(r_mem, m_ncol, m_nlev); - r_mem += ptrs_hst_2d_midlv[i]->size(); - } - //---------------------------------------------------------------------------- - // host 2D views on interface levels - ZMF::uview_2dh* intfc_h_ptrs[num_hst_2d_intfc] = { &zm_input.h_z_int, - &zm_input.h_p_int, - &zm_output.h_prec_flux, - &zm_output.h_snow_flux, - &zm_output.h_mass_flux - }; - for (int i=0; i(r_mem, m_ncol, (m_nlev+1)); - r_mem += intfc_h_ptrs[i]->size(); + for (int i=0; i(scl_mem, m_ncol); + scl_mem += ptrs_1d_scalr[i]->size(); } //---------------------------------------------------------------------------- - Spack* spk_mem = reinterpret_cast(r_mem); + Spack* spk_mem = reinterpret_cast(scl_mem); //---------------------------------------------------------------------------- // device 2D views on mid-point levels - ZMF::uview_2d* ptrs_dvc_2d_midlv[num_dvc_2d_midlv] = { &zm_input.z_mid, + ZMF::uview_2d* ptrs_2d_midlv[num_2d_midlv] = { &zm_input.z_mid, &zm_input.z_del, &zm_output.tend_t, &zm_output.tend_qv, @@ -499,20 +383,20 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.rain_prod, &zm_output.snow_prod }; - for (int i=0; i(spk_mem, m_ncol, nlev_mid_packs); - spk_mem += ptrs_dvc_2d_midlv[i]->size(); + for (int i=0; i(spk_mem, m_ncol, nlev_mid_packs); + spk_mem += ptrs_2d_midlv[i]->size(); } //---------------------------------------------------------------------------- // device 2D views on interface levels - ZMF::uview_2d* ptrs_dvc_2d_intfc[num_dvc_2d_intfc] = { &zm_input.z_int, + ZMF::uview_2d* ptrs_2d_intfc[num_2d_intfc] = { &zm_input.z_int, &zm_output.prec_flux, &zm_output.snow_flux, &zm_output.mass_flux }; - for (int i=0; i(spk_mem, m_ncol, nlev_int_packs); - spk_mem += ptrs_dvc_2d_intfc[i]->size(); + for (int i=0; i(spk_mem, m_ncol, nlev_int_packs); + spk_mem += ptrs_2d_intfc[i]->size(); } //---------------------------------------------------------------------------- Real* total_mem = reinterpret_cast(spk_mem); diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp index ec28b42ac9f2..9a3ed0543969 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge.cpp @@ -56,7 +56,6 @@ void zm_eamxx_bridge_run( Int ncol, Int pver, ){ //---------------------------------------------------------------------------- zm_input.transpose(ncol,pver); - zm_output.transpose(ncol,pver); zm_eamxx_bridge_run_c( ncol, // 01 zm_input.dtime, // 02 @@ -91,7 +90,6 @@ void zm_eamxx_bridge_run( Int ncol, Int pver, zm_output.h_mass_flux .data() // 31 ); - zm_input.transpose(ncol,pver); zm_output.transpose(ncol,pver); //---------------------------------------------------------------------------- diff --git a/components/eamxx/src/physics/zm/zm_functions.hpp b/components/eamxx/src/physics/zm/zm_functions.hpp index 521762a3331a..b91b278a8408 100644 --- a/components/eamxx/src/physics/zm/zm_functions.hpp +++ b/components/eamxx/src/physics/zm/zm_functions.hpp @@ -2,10 +2,12 @@ #define ZM_FUNCTIONS_HPP #include "share/physics/physics_constants.hpp" +#include "share/physics/eamxx_common_physics_functions.hpp" #include "share/core/eamxx_types.hpp" #include #include +#include namespace scream { namespace zm { @@ -16,7 +18,7 @@ namespace zm { template struct Functions { - // --------------------------------------------------------------------------- + // ----------------------------------------------------------------------------------------------- // Types using Scalar = ScalarT; @@ -29,7 +31,10 @@ struct Functions { using BPack = BigPack; using Spack = SmallPack; - using KT = ekat::KokkosTypes; + using PF = scream::PhysicsFunctions; + using PC = scream::physics::Constants; + + using KT = ekat::KokkosTypes; template using view_1d = typename KT::template view_1d; template using view_2d = typename KT::template view_2d; @@ -39,12 +44,10 @@ struct Functions { template using view_3d_strided = typename KT::template sview; template using uview_1d = typename ekat::template Unmanaged >; template using uview_2d = typename ekat::template Unmanaged >; - template using uview_2dl = typename ekat::template Unmanaged >; - // template using uview_2d_strided = typename ekat::template Unmanaged >; - template using uview_2dh = typename ekat::template Unmanaged>::HostMirror; - template using uview_1dh = typename ekat::template Unmanaged>::HostMirror; + template using view_2dh = typename view_2dl::HostMirror; + template using view_1dh = typename view_1d::HostMirror; - // --------------------------------------------------------------------------- + // ----------------------------------------------------------------------------------------------- // Structs struct zm_runtime_opt { @@ -56,32 +59,23 @@ struct Functions { } }; + // ----------------------------------------------------------------------------------------------- + struct zm_input_state { zm_input_state() = default; // ------------------------------------------------------------------------- Real dtime; // model phsyics time step [s] bool is_first_step; // flag for first call - static constexpr int num_dvc_1d_intgr = 0; // number of device 1D integer views - static constexpr int num_dvc_1d_scalr = 1; // number of device 1D scalar views - static constexpr int num_dvc_2d_midlv = 2; // number of device 2D views on mid-point levels - static constexpr int num_dvc_2d_intfc = 1; // number of device 2D views on interface levels - - // static constexpr int num_lol_1d_intgr = 0; // number of layout-left 1D integer views - // static constexpr int num_lol_1d_scalr = 0; // number of layout-left 1D scalar views - // static constexpr int num_lol_2d_midlv = 9; // number of layout-left 2D views on mid-point levels - // static constexpr int num_lol_2d_intfc = 2; // number of layout-left 2D views on interface levels - - static constexpr int num_hst_1d_intgr = 0; // number of host 1D integer views - static constexpr int num_hst_1d_scalr = 4; // number of host 1D scalar views - static constexpr int num_hst_2d_midlv = 9; // number of host 2D views on mid-point levels - static constexpr int num_hst_2d_intfc = 2; // number of host 2D views on interface levels - - uview_1d< Scalar> tpert; // temperature perturbation at top of PBL + // variable counters for device-side only + static constexpr int num_1d_intgr = 0; // number of 1D integer views + static constexpr int num_1d_scalr = 1; // number of 1D scalar views + static constexpr int num_2d_midlv = 2; // number of 2D mid-point views + static constexpr int num_2d_intfc = 1; // number of 2D interface views + uview_1d< Scalar> tpert; // PBL top temperature perturb. [K] uview_2d< Spack> z_mid; // mid-point level altitude [m] uview_2d< Spack> z_del; // altitude thickness [m] - uview_2d< Spack> z_int; // interface level altitude [m] // variables we get from the field manager @@ -91,88 +85,36 @@ struct Functions { view_2d p_del; // pressure thickness [Pa] view_2d< Spack> T_mid; // temperature [K] view_2d< Spack> qv; // water vapor mixing ratio [kg kg-1] + view_2d qc; // cloud liquid water [kg kg-1] view_2d< Spack> uwind; // zonal wind [m/s] view_2d< Spack> vwind; // meridional wind [m/s] view_2d omega; // vertical pressure velocity [Pa/s] - view_2d cldfrac; // total cloud fraction + view_2d cldfrac; // total cloud fraction [frac] view_1d pblh; // PBL height [m] - view_1d landfrac; // land area fraction - - // LayoutLeft views for fortran bridging - // uview_2dl f_z_mid; - // uview_2dl f_p_mid; - // uview_2dl f_p_del; - // uview_2dl f_T_mid; - // uview_2dl f_qv; - // uview_2dl f_uwind; - // uview_2dl f_vwind; - // uview_2dl f_omega; - // uview_2dl f_cldfrac; - // uview_2dl f_z_int; - // uview_2dl f_p_int; + view_1d landfrac; // land area fraction [frac] + view_2d thl_sec; // thetal variance from SHOC [K^2] // host mirror versions of ZM interface variables - uview_1dh h_phis; - uview_1dh h_pblh; - uview_1dh h_tpert; - uview_1dh h_landfrac; - - uview_2dh h_z_mid; - uview_2dh h_p_mid; - uview_2dh h_p_del; - uview_2dh h_T_mid; - uview_2dh h_qv; - uview_2dh h_uwind; - uview_2dh h_vwind; - uview_2dh h_omega; - uview_2dh h_cldfrac; - - uview_2dh h_z_int; - uview_2dh h_p_int; + view_1dh h_phis; + view_1dh h_pblh; + view_1dh h_tpert; + view_1dh h_landfrac; + view_2dh h_z_mid; + view_2dh h_p_mid; + view_2dh h_p_del; + view_2dh h_T_mid; + view_2dh h_qv; + view_2dh h_uwind; + view_2dh h_vwind; + view_2dh h_omega; + view_2dh h_cldfrac; + view_2dh h_z_int; + view_2dh h_p_int; // ------------------------------------------------------------------------- // transpose method for fortran bridging template void transpose(int ncol, int nlev_mid) { - - // auto pverp = pver_in+1; - // if (D == ekat::TransposeDirection::c2f) { - // for (int i=0; i>{phis}); @@ -191,374 +133,170 @@ struct Functions { ekat::device_to_host({h_z_int.data()}, ncol, nlev_int, std::vector>{z_int}); ekat::device_to_host({h_p_int.data()}, ncol, nlev_int, std::vector< view_2d>{p_int}); } - } // ------------------------------------------------------------------------- + void calculate_tpert(int ncol,int nlev,bool is_first_step) { + const Real cpair = PC::Cpair; + const Real latvap = PC::LatVap; + + // create temporaries to avoid "Implicit capture" warning + auto loc_tpert = tpert; + auto loc_pblh = pblh; + auto loc_z_int = z_int; + auto loc_p_mid = p_mid; + auto loc_qc = qc; + auto loc_thl_sec = thl_sec; + + Kokkos::parallel_for("zm_calculate_tpert",ncol, KOKKOS_LAMBDA (const int i) { + if (is_first_step) { + loc_tpert(i) = 0.0; + } else { + // identify interface index for top of PBL + int pblh_k_ind = -1; + for (int k=0; kloc_pblh(i) && z_int_tmp_kp1<=loc_pblh(i) ) { + pblh_k_ind = k; + } + } + if (pblh_k_ind==-1) { + // PBL top index not found, so just set the perturbation to zero + loc_tpert(i) = 0.0; + } else { + // calculate tpert as std deviation of temperature from SHOC's theta-l variance + auto exner_pbl = PF::exner_function( loc_p_mid(i,pblh_k_ind/Spack::n)[pblh_k_ind%Spack::n] ); + auto qc_pbl = loc_qc(i,pblh_k_ind/Spack::n)[pblh_k_ind%Spack::n]; + auto thl_sec_pbl = loc_thl_sec(i,pblh_k_ind/Spack::n)[pblh_k_ind%Spack::n]; + auto thl_std_pbl = sqrt( thl_sec_pbl ); // std deviation of thetal; + loc_tpert(i) = ( thl_std_pbl + (latvap/cpair)*qc_pbl ) / exner_pbl; + loc_tpert(i) = ekat::impl::min(2.0,loc_tpert(i)); // apply limiter + } + } + }); + } }; + // ----------------------------------------------------------------------------------------------- + struct zm_output_tend { zm_output_tend() = default; - static constexpr int num_dvc_1d_intgr = 1; // number of device 1D integer views - static constexpr int num_dvc_1d_scalr = 3; // number of device 1D scalar views - static constexpr int num_dvc_2d_midlv = 6; // number of device 2D views on mid-point levels - static constexpr int num_dvc_2d_intfc = 3; // number of device 2D views on interface levels - - // static constexpr int num_lol_1d_intgr = 0; // number of layout-left 1D integer views - // static constexpr int num_lol_1d_scalr = 0; // number of layout-left 1D scalar views - // static constexpr int num_lol_2d_midlv = 6; // number of layout-left 2D views on mid-point levels - // static constexpr int num_lol_2d_intfc = 3; // number of layout-left 2D views on interface levels - - static constexpr int num_hst_1d_intgr = 1; // number of host 1D integer views - static constexpr int num_hst_1d_scalr = 3; // number of host 1D scalar views - static constexpr int num_hst_2d_midlv = 6; // number of host 2D views on mid-point levels - static constexpr int num_hst_2d_intfc = 3; // number of host 2D views on interface levels + // variable counters for device-side only + static constexpr int num_1d_intgr = 1; // number of 1D integer views + static constexpr int num_1d_scalr = 3; // number of 1D scalar views + static constexpr int num_2d_midlv = 6; // number of 2D mid-point views + static constexpr int num_2d_intfc = 3; // number of 2D interface views uview_1d activity; // integer deep convection activity flag - uview_1d prec; // surface precipitation [m/s] uview_1d snow; // surface snow [m/s] uview_1d cape; // convective available potential energy [J] - - uview_2d tend_t; // output tendency of dry static energy [] - uview_2d tend_qv; // output tendency of water vapor [] - uview_2d tend_u; // output tendency of zonal wind [] - uview_2d tend_v; // output tendency of meridional wind [] - uview_2d rain_prod; // rain production rate - uview_2d snow_prod; // snow production rate - - uview_2d prec_flux; // output convective precipitation flux [] - uview_2d snow_flux; // output convective precipitation flux [] - uview_2d mass_flux; // output convective mass flux [] - - // LayoutLeft views for fortran bridging - // uview_2dl f_tend_t; - // uview_2dl f_tend_qv; - // uview_2dl f_tend_u; - // uview_2dl f_tend_v; - // uview_2dl f_rain_prod; - // uview_2dl f_snow_prod; - - // uview_2dl f_prec_flux; - // uview_2dl f_snow_flux; - // uview_2dl f_mass_flux; + uview_2d tend_t; // output tendency of temperature [K/s] + uview_2d tend_qv; // output tendency of water vapor [kg/kg/s] + uview_2d tend_u; // output tendency of zonal wind [m/s/s] + uview_2d tend_v; // output tendency of meridional wind [m/s/s] + uview_2d rain_prod; // rain production rate [?] + uview_2d snow_prod; // snow production rate [?] + uview_2d prec_flux; // output convective precipitation flux [?] + uview_2d snow_flux; // output convective precipitation flux [?] + uview_2d mass_flux; // output convective mass flux [?] // host versions of ZM interface variables - uview_1dh h_activity; - - uview_1dh h_prec; - uview_1dh h_snow; - uview_1dh h_cape; - - uview_2dh h_tend_t; - uview_2dh h_tend_qv; - uview_2dh h_tend_u; - uview_2dh h_tend_v; - uview_2dh h_rain_prod; - uview_2dh h_snow_prod; - - uview_2dh h_prec_flux; - uview_2dh h_snow_flux; - uview_2dh h_mass_flux; + view_1dh h_activity; + view_1dh h_prec; + view_1dh h_snow; + view_1dh h_cape; + view_2dh h_tend_t; + view_2dh h_tend_qv; + view_2dh h_tend_u; + view_2dh h_tend_v; + view_2dh h_rain_prod; + view_2dh h_snow_prod; + view_2dh h_prec_flux; + view_2dh h_snow_flux; + view_2dh h_mass_flux; // ------------------------------------------------------------------------- // transpose method for fortran bridging template void transpose(int ncol, int nlev_mid) { - - // if (D == ekat::TransposeDirection::c2f) { - // for (int i=0; i> tmp_vector_d[1]; - - // std::vector> tmp_vector_d = {h_prec}; - // std::vector< view_1d > tmp_vector_h = {prec.data()}; - - // std::vector> tmp(1); - // ekat::host_to_device({h_prec.data()}, ncol, tmp); - // Kokkos::deep_copy(prec,tmp[0]); - - ekat::host_to_device({h_prec.data()}, ncol, std::vector> {prec}); - - - // prec = tmp_vector[0]; - // ekat::host_to_device({prec}, ncol, std::vector>{h_prec}); - // ekat::host_to_device({h_prec.data()}, ncol, std::vector< view_1d >{prec}); - - // ekat::host_to_device({h_activity}, ncol, std::vector> {activity}); - // ekat::host_to_device({h_prec}, ncol, std::vector>{prec}); - // ekat::host_to_device({h_snow}, ncol, std::vector>{snow}); - // ekat::host_to_device({h_cape}, ncol, std::vector>{cape}); - // ekat::host_to_device({h_tend_t}, ncol, nlev_mid, std::vector> {tend_t}); - // ekat::host_to_device({h_tend_qv}, ncol, nlev_mid, std::vector> {tend_qv}); - // ekat::host_to_device({h_tend_u}, ncol, nlev_mid, std::vector> {tend_u}); - // ekat::host_to_device({h_tend_v}, ncol, nlev_mid, std::vector> {tend_v}); - // ekat::host_to_device({h_rain_prod},ncol, nlev_mid, std::vector> {rain_prod}); - // ekat::host_to_device({h_snow_prod},ncol, nlev_mid, std::vector> {snow_prod}); - // ekat::host_to_device({h_prec_flux},ncol, nlev_int, std::vector> {prec_flux}); - // ekat::host_to_device({h_snow_flux},ncol, nlev_int, std::vector> {snow_flux}); - // ekat::host_to_device({h_mass_flux},ncol, nlev_int, std::vector> {mass_flux}); + ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); + ekat::host_to_device({h_activity.data()}, ncol, std::vector> {activity}); + ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); + ekat::host_to_device({h_snow.data()}, ncol, std::vector>{snow}); + ekat::host_to_device({h_cape.data()}, ncol, std::vector>{cape}); + ekat::host_to_device({h_tend_t.data()}, ncol, nlev_mid, std::vector> {tend_t}, true); + ekat::host_to_device({h_tend_qv.data()}, ncol, nlev_mid, std::vector> {tend_qv}, true); + ekat::host_to_device({h_tend_u.data()}, ncol, nlev_mid, std::vector> {tend_u}, true); + ekat::host_to_device({h_tend_v.data()}, ncol, nlev_mid, std::vector> {tend_v}, true); + ekat::host_to_device({h_rain_prod.data()},ncol, nlev_mid, std::vector> {rain_prod}, true); + ekat::host_to_device({h_snow_prod.data()},ncol, nlev_mid, std::vector> {snow_prod}, true); + ekat::host_to_device({h_prec_flux.data()},ncol, nlev_int, std::vector> {prec_flux}, true); + ekat::host_to_device({h_snow_flux.data()},ncol, nlev_int, std::vector> {snow_flux}, true); + ekat::host_to_device({h_mass_flux.data()},ncol, nlev_int, std::vector> {mass_flux}, true); } + }; - - // auto nlev_int = nlev_mid+1; - // if (D == ekat::TransposeDirection::f2c) { - // ekat::host_to_device({h_activity}, ncol, std::vector> {activity}); - // ekat::host_to_device({h_prec}, ncol, std::vector< view_1d >{prec}); - // ekat::host_to_device({h_snow}, ncol, std::vector< view_1d >{snow}); - // ekat::host_to_device({h_cape}, ncol, std::vector< view_1d >{cape}); - // ekat::host_to_device({h_tend_t}, ncol, nlev_mid, std::vector> {tend_t}); - // ekat::host_to_device({h_tend_qv}, ncol, nlev_mid, std::vector> {tend_qv}); - // ekat::host_to_device({h_tend_u}, ncol, nlev_mid, std::vector> {tend_u}); - // ekat::host_to_device({h_tend_v}, ncol, nlev_mid, std::vector> {tend_v}); - // ekat::host_to_device({h_rain_prod},ncol, nlev_mid, std::vector> {rain_prod}); - // ekat::host_to_device({h_snow_prod},ncol, nlev_mid, std::vector> {snow_prod}); - // ekat::host_to_device({h_prec_flux},ncol, nlev_int, std::vector> {prec_flux}); - // ekat::host_to_device({h_snow_flux},ncol, nlev_int, std::vector> {snow_flux}); - // ekat::host_to_device({h_mass_flux},ncol, nlev_int, std::vector> {mass_flux}); - // } - - // std::vector> h_int_vector_1d = {h_activity}; - // std::vector> d_int_vector_1d = {activity}; - // std::vector> h_scl_vector_1d = {h_prec, - // h_snow, - // h_cape}; - // std::vector< view_1d > d_scl_vector_1d = {prec, - // snow, - // cape}; - // std::vector> h_vector_2d_mid = {h_tend_t, - // h_tend_qv, - // h_tend_u, - // h_tend_v, - // h_rain_prod, - // h_snow_prod}; - // std::vector> d_vector_2d_mid = {tend_t, - // tend_qv, - // tend_u, - // tend_v, - // rain_prod, - // snow_prod}; - // std::vector> h_vector_2d_int = {h_prec_flux, - // h_snow_flux, - // h_mass_flux}; - // std::vector< view_2d > d_vector_2d_int = {prec_flux, - // snow_flux, - // mass_flux}; - - // ekat::device_to_host(h_int_vector_1d, ncol, d_int_vector_1d); - // ekat::device_to_host(h_scl_vector_1d, ncol, d_scl_vector_1d); - // ekat::device_to_host(h_vector_2d_mid, ncol, nlev_mid, d_vector_2d_mid); - // ekat::device_to_host(h_vector_2d_int, ncol, nlev_int, d_vector_2d_int); - // } - + // ------------------------------------------------------------------------- + void init(int ncol, int nlev_mid) { + auto nlev_int = nlev_mid+1; + auto nlev_mid_packs = ekat::npack(nlev_mid); + auto nlev_int_packs = ekat::npack(nlev_int); + Real init_fill_value = 0; + // create temporaries to avoid "Implicit capture" warning + auto loc_prec = prec; + auto loc_snow = snow; + auto loc_cape = cape; + auto loc_activity = activity; + auto loc_tend_t = tend_t; + auto loc_tend_qv = tend_qv; + auto loc_tend_u = tend_u; + auto loc_tend_v = tend_v; + auto loc_rain_prod = rain_prod; + auto loc_snow_prod = snow_prod; + auto loc_prec_flux = prec_flux; + auto loc_snow_flux = snow_flux; + auto loc_mass_flux = mass_flux; + // 1D scalar variables + Kokkos::parallel_for("zm_output_init_s", KT::RangePolicy(0, ncol), KOKKOS_LAMBDA (const int i) { + loc_prec(i) = init_fill_value; + loc_snow(i) = init_fill_value; + loc_cape(i) = init_fill_value; + loc_activity(i) = -1; + }); + // mid-point level variables + Kokkos::parallel_for("zm_output_init_m",KT::RangePolicy(0, ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_mid_packs; + const int klev = i%nlev_mid_packs; + loc_tend_t (icol,klev) = init_fill_value; + loc_tend_qv (icol,klev) = init_fill_value; + loc_tend_u (icol,klev) = init_fill_value; + loc_tend_v (icol,klev) = init_fill_value; + loc_rain_prod(icol,klev) = init_fill_value; + loc_snow_prod(icol,klev) = init_fill_value; + }); + // interface level variables + Kokkos::parallel_for("zm_output_init_i",KT::RangePolicy(0, ncol*nlev_int_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_int_packs; + const int klev = i%nlev_int_packs; + loc_prec_flux(icol,klev) = init_fill_value; + loc_snow_flux(icol,klev) = init_fill_value; + loc_mass_flux(icol,klev) = init_fill_value; + }); }; - // // ------------------------------------------------------------------------- - // void init(int ncol_in, int nlev_mid_in) { - // auto nlev_int_in = nlev_mid_in+1; - // auto nlev_int_packs = ekat::npack(pverp); - // auto nlev_int_packs = ekat::npack(pverp); - // Kokkos::parallel_for("zm_output_init", KT::RangePolicy(0, m_ncol), KOKKOS_LAMBDA (const int i) { - // Real init_fill_value = -999; - // // 1D scalar variables - // prec(i) = init_fill_value; - // snow(i) = init_fill_value; - // cape(i) = init_fill_value; - // activity(i) = -1; - // } - // // mid-point level variables - // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlevm_packs), KOKKOS_LAMBDA (const int i) { - // const int icol = i/nlevm_packs; - // const int ilev = i%nlevm_packs; - // tend_t (i,k) = init_fill_value; - // tend_qv (i,k) = init_fill_value; - // tend_u (i,k) = init_fill_value; - // tend_v (i,k) = init_fill_value; - // rain_prod(i,k) = init_fill_value; - // snow_prod(i,k) = init_fill_value; - // } - // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*pver_in), KOKKOS_LAMBDA (const int i) { - // const int icol = i/pver_in; - // const int ilev = i%pver_in; - // f_tend_t (i,k) = init_fill_value; - // f_tend_qv (i,k) = init_fill_value; - // f_tend_u (i,k) = init_fill_value; - // f_tend_v (i,k) = init_fill_value; - // f_rain_prod(i,k) = init_fill_value; - // f_snow_prod(i,k) = init_fill_value; - // } - // // interface level variables - // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlevi_packs), KOKKOS_LAMBDA (const int i) { - // const int icol = i/nlevi_packs; - // const int ilev = i%nlevi_packs; - // prec_flux(i,k) = init_fill_value; - // snow_flux(i,k) = init_fill_value; - // mass_flux(i,k) = init_fill_value; - // } - // Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*pverp), KOKKOS_LAMBDA (const int i) { - // const int icol = i/pverp; - // const int ilev = i%pverp; - // f_prec_flux(i,k) = init_fill_value; - // f_snow_flux(i,k) = init_fill_value; - // f_mass_flux(i,k) = init_fill_value; - // } - - // // mid-point level variables - // for (int i=0; i Date: Fri, 24 Oct 2025 11:04:45 -0700 Subject: [PATCH 19/31] add temporary explicit transpose/copy method for ZM bridge variable rename --- .../physics/zm/eamxx_zm_process_interface.cpp | 121 +++++++---- .../eamxx/src/physics/zm/zm_functions.hpp | 192 +++++++++++++++--- 2 files changed, 250 insertions(+), 63 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 32dd7960ca27..31a6dce46aec 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -103,34 +103,35 @@ void ZMDeepConvection::initialize_impl (const RunType) //---------------------------------------------------------------------------- // allocate host mirror variables - zm_input.h_phis = ZMF::view_1dh("zm_input_h_phis" ,m_ncol); - zm_input.h_pblh = ZMF::view_1dh("zm_input_h_pblh" ,m_ncol); - zm_input.h_tpert = ZMF::view_1dh("zm_input_h_tpert" ,m_ncol); - zm_input.h_landfrac = ZMF::view_1dh("zm_input_h_landfrac" ,m_ncol); - zm_input.h_z_mid = ZMF::view_2dh ("zm_input_h_z_mid" ,m_ncol, m_nlev); - zm_input.h_p_mid = ZMF::view_2dh ("zm_input_h_p_mid" ,m_ncol, m_nlev); - zm_input.h_p_del = ZMF::view_2dh ("zm_input_h_p_del" ,m_ncol, m_nlev); - zm_input.h_T_mid = ZMF::view_2dh ("zm_input_h_T_mid" ,m_ncol, m_nlev); - zm_input.h_qv = ZMF::view_2dh ("zm_input_h_qv" ,m_ncol, m_nlev); - zm_input.h_uwind = ZMF::view_2dh ("zm_input_h_uwind" ,m_ncol, m_nlev); - zm_input.h_vwind = ZMF::view_2dh ("zm_input_h_vwind" ,m_ncol, m_nlev); - zm_input.h_omega = ZMF::view_2dh ("zm_input_h_omega" ,m_ncol, m_nlev); - zm_input.h_cldfrac = ZMF::view_2dh ("zm_input_h_cldfrac" ,m_ncol, m_nlev); - zm_input.h_z_int = ZMF::view_2dh ("zm_input_h_z_int" ,m_ncol, m_nlev+1); - zm_input.h_p_int = ZMF::view_2dh ("zm_input_h_p_int" ,m_ncol, m_nlev+1); - zm_output.h_activity = ZMF::view_1dh ("zm_output_h_activity" ,m_ncol); - zm_output.h_prec = ZMF::view_1dh("zm_output_h_prec" ,m_ncol); - zm_output.h_snow = ZMF::view_1dh("zm_output_h_snow" ,m_ncol); - zm_output.h_cape = ZMF::view_1dh("zm_output_h_cape" ,m_ncol); - zm_output.h_tend_t = ZMF::view_2dh ("zm_output_h_tend_t" ,m_ncol, m_nlev); - zm_output.h_tend_qv = ZMF::view_2dh ("zm_output_h_tend_qv" ,m_ncol, m_nlev); - zm_output.h_tend_u = ZMF::view_2dh ("zm_output_h_tend_u" ,m_ncol, m_nlev); - zm_output.h_tend_v = ZMF::view_2dh ("zm_output_h_tend_v" ,m_ncol, m_nlev); - zm_output.h_rain_prod = ZMF::view_2dh ("zm_output_h_rain_prod" ,m_ncol, m_nlev); - zm_output.h_snow_prod = ZMF::view_2dh ("zm_output_h_snow_prod" ,m_ncol, m_nlev); - zm_output.h_prec_flux = ZMF::view_2dh ("zm_output_h_prec_flux" ,m_ncol, m_nlev+1); - zm_output.h_snow_flux = ZMF::view_2dh ("zm_output_h_snow_flux" ,m_ncol, m_nlev+1); - zm_output.h_mass_flux = ZMF::view_2dh ("zm_output_h_mass_flux" ,m_ncol, m_nlev+1); + zm_input.h_phis = ZMF::view_1dh("zm_input.h_phis", m_ncol); + zm_input.h_pblh = ZMF::view_1dh("zm_input.h_pblh", m_ncol); + zm_input.h_tpert = ZMF::view_1dh("zm_input.h_tpert", m_ncol); + zm_input.h_landfrac = ZMF::view_1dh("zm_input.h_landfrac", m_ncol); + zm_input.h_z_mid = ZMF::view_2dh ("zm_input.h_z_mid", m_ncol, m_nlev); + zm_input.h_p_mid = ZMF::view_2dh ("zm_input.h_p_mid", m_ncol, m_nlev); + zm_input.h_p_del = ZMF::view_2dh ("zm_input.h_p_del", m_ncol, m_nlev); + zm_input.h_T_mid = ZMF::view_2dh ("zm_input.h_T_mid", m_ncol, m_nlev); + zm_input.h_qv = ZMF::view_2dh ("zm_input.h_qv", m_ncol, m_nlev); + zm_input.h_uwind = ZMF::view_2dh ("zm_input.h_uwind", m_ncol, m_nlev); + zm_input.h_vwind = ZMF::view_2dh ("zm_input.h_vwind", m_ncol, m_nlev); + zm_input.h_omega = ZMF::view_2dh ("zm_input.h_omega", m_ncol, m_nlev); + zm_input.h_cldfrac = ZMF::view_2dh ("zm_input.h_cldfrac", m_ncol, m_nlev); + zm_input.h_z_int = ZMF::view_2dh ("zm_input.h_z_int", m_ncol, m_nlev+1); + zm_input.h_p_int = ZMF::view_2dh ("zm_input.h_p_int", m_ncol, m_nlev+1); + + zm_output.h_activity = ZMF::view_1dh ("zm_output.h_activity", m_ncol); + zm_output.h_prec = ZMF::view_1dh("zm_output.h_prec", m_ncol); + zm_output.h_snow = ZMF::view_1dh("zm_output.h_snow", m_ncol); + zm_output.h_cape = ZMF::view_1dh("zm_output.h_cape", m_ncol); + zm_output.h_tend_t = ZMF::view_2dh ("zm_output.h_tend_t", m_ncol, m_nlev); + zm_output.h_tend_qv = ZMF::view_2dh ("zm_output.h_tend_qv", m_ncol, m_nlev); + zm_output.h_tend_u = ZMF::view_2dh ("zm_output.h_tend_u", m_ncol, m_nlev); + zm_output.h_tend_v = ZMF::view_2dh ("zm_output.h_tend_v", m_ncol, m_nlev); + zm_output.h_rain_prod = ZMF::view_2dh ("zm_output.h_rain_prod", m_ncol, m_nlev); + zm_output.h_snow_prod = ZMF::view_2dh ("zm_output.h_snow_prod", m_ncol, m_nlev); + zm_output.h_prec_flux = ZMF::view_2dh ("zm_output.h_prec_flux", m_ncol, m_nlev+1); + zm_output.h_snow_flux = ZMF::view_2dh ("zm_output.h_snow_flux", m_ncol, m_nlev+1); + zm_output.h_mass_flux = ZMF::view_2dh ("zm_output.h_mass_flux", m_ncol, m_nlev+1); //---------------------------------------------------------------------------- // initialize variables on the fortran side @@ -329,6 +330,11 @@ size_t ZMDeepConvection::requested_buffer_size_in_bytes() const zm_buffer_size+= ZMF::zm_output_tend::num_2d_midlv * sizeof(Spack) * m_ncol * nlev_mid_packs; zm_buffer_size+= ZMF::zm_output_tend::num_2d_intfc * sizeof(Spack) * m_ncol * nlev_int_packs; + int num_f_mid = (9+6); + int num_f_int = (2+3); + zm_buffer_size+= num_f_mid * sizeof(Real) * m_ncol * m_nlev; + zm_buffer_size+= num_f_int * sizeof(Real) * m_ncol * (m_nlev+1); + return zm_buffer_size; } @@ -347,12 +353,14 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) constexpr auto num_2d_midlv = ZMF::zm_input_state::num_2d_midlv + ZMF::zm_output_tend::num_2d_midlv; constexpr auto num_2d_intfc = ZMF::zm_input_state::num_2d_intfc + ZMF::zm_output_tend::num_2d_intfc; + int num_f_mid = (9+6); + int num_f_int = (2+3); + //---------------------------------------------------------------------------- Int* i_mem = reinterpret_cast(buffer_manager.get_memory()); //---------------------------------------------------------------------------- // device 1D integer variables - ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity - }; + ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity }; for (int i=0; i(i_mem, m_ncol); i_mem += ptrs_1d_intgr[i]->size(); @@ -361,7 +369,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) Scalar* scl_mem = reinterpret_cast(i_mem); //---------------------------------------------------------------------------- // device 1D scalar scalars - ZMF::uview_1d* ptrs_1d_scalr[num_1d_scalr] = { &zm_input.tpert, + ZMF::uview_1d* ptrs_1d_scalr[num_1d_scalr] = { &zm_input.tpert, &zm_output.prec, &zm_output.snow, &zm_output.cape, @@ -371,7 +379,52 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) scl_mem += ptrs_1d_scalr[i]->size(); } //---------------------------------------------------------------------------- - Spack* spk_mem = reinterpret_cast(scl_mem); + + // *************************************************************************** + // TEMPORARY + // *************************************************************************** + Real* r_mem = reinterpret_cast(scl_mem); + //---------------------------------------------------------------------------- + // device 2D views on mid-point levels + ZMF::uview_2dl* ptrs_f_midlv[num_f_mid] = { &zm_input.f_z_mid, + &zm_input.f_p_mid, + &zm_input.f_p_del, + &zm_input.f_T_mid, + &zm_input.f_qv, + &zm_input.f_uwind, + &zm_input.f_vwind, + &zm_input.f_omega, + &zm_input.f_cldfrac, + &zm_output.f_tend_t, + &zm_output.f_tend_qv, + &zm_output.f_tend_u, + &zm_output.f_tend_v, + &zm_output.f_rain_prod, + &zm_output.f_snow_prod, + }; + for (int i=0; i(r_mem, m_ncol, m_nlev); + r_mem += ptrs_f_midlv[i]->size(); + } + //---------------------------------------------------------------------------- + // device 2D views on interface levels + ZMF::uview_2dl* ptrs_f_intfc[num_f_int] = { &zm_input.f_z_int, + &zm_input.f_p_int, + &zm_output.f_prec_flux, + &zm_output.f_snow_flux, + &zm_output.f_mass_flux, + }; + for (int i=0; i(r_mem, m_ncol, (m_nlev+1)); + r_mem += ptrs_f_intfc[i]->size(); + } + //---------------------------------------------------------------------------- + Spack* spk_mem = reinterpret_cast(r_mem); + // *************************************************************************** + // TEMPORARY + // *************************************************************************** + + // Spack* spk_mem = reinterpret_cast(scl_mem); //---------------------------------------------------------------------------- // device 2D views on mid-point levels ZMF::uview_2d* ptrs_2d_midlv[num_2d_midlv] = { &zm_input.z_mid, @@ -381,7 +434,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.tend_u, &zm_output.tend_v, &zm_output.rain_prod, - &zm_output.snow_prod + &zm_output.snow_prod, }; for (int i=0; i(spk_mem, m_ncol, nlev_mid_packs); @@ -392,7 +445,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) ZMF::uview_2d* ptrs_2d_intfc[num_2d_intfc] = { &zm_input.z_int, &zm_output.prec_flux, &zm_output.snow_flux, - &zm_output.mass_flux + &zm_output.mass_flux, }; for (int i=0; i(spk_mem, m_ncol, nlev_int_packs); diff --git a/components/eamxx/src/physics/zm/zm_functions.hpp b/components/eamxx/src/physics/zm/zm_functions.hpp index b91b278a8408..9c77fc274c69 100644 --- a/components/eamxx/src/physics/zm/zm_functions.hpp +++ b/components/eamxx/src/physics/zm/zm_functions.hpp @@ -44,6 +44,7 @@ struct Functions { template using view_3d_strided = typename KT::template sview; template using uview_1d = typename ekat::template Unmanaged >; template using uview_2d = typename ekat::template Unmanaged >; + template using uview_2dl = typename ekat::template Unmanaged >; template using view_2dh = typename view_2dl::HostMirror; template using view_1dh = typename view_1d::HostMirror; @@ -94,6 +95,25 @@ struct Functions { view_1d landfrac; // land area fraction [frac] view_2d thl_sec; // thetal variance from SHOC [K^2] + // ************************************************************************* + // TEMPORARY + // ************************************************************************* + // LayoutLeft views for fortran bridging + uview_2dl f_z_mid; + uview_2dl f_p_mid; + uview_2dl f_p_del; + uview_2dl f_T_mid; + uview_2dl f_qv; + uview_2dl f_uwind; + uview_2dl f_vwind; + uview_2dl f_omega; + uview_2dl f_cldfrac; + uview_2dl f_z_int; + uview_2dl f_p_int; + // ************************************************************************* + // TEMPORARY + // ************************************************************************* + // host mirror versions of ZM interface variables view_1dh h_phis; view_1dh h_pblh; @@ -116,23 +136,74 @@ struct Functions { template void transpose(int ncol, int nlev_mid) { auto nlev_int = nlev_mid+1; + + // *********************************************************************** + // TEMPORARY + // *********************************************************************** + auto nlev_mid_packs = ekat::npack(nlev_mid); + auto nlev_int_packs = ekat::npack(nlev_int); if (D == ekat::TransposeDirection::c2f) { - ekat::device_to_host({h_phis.data()}, ncol, std::vector< view_1d>{phis}); - ekat::device_to_host({h_pblh.data()}, ncol, std::vector< view_1d>{pblh}); - ekat::device_to_host({h_tpert.data()}, ncol, std::vector>{tpert}); - ekat::device_to_host({h_landfrac.data()}, ncol, std::vector< view_1d>{landfrac}); - ekat::device_to_host({h_z_mid.data()}, ncol, nlev_mid, std::vector>{z_mid}); - ekat::device_to_host({h_p_mid.data()}, ncol, nlev_mid, std::vector< view_2d>{p_mid}); - ekat::device_to_host({h_p_del.data()}, ncol, nlev_mid, std::vector< view_2d>{p_del}); - ekat::device_to_host({h_T_mid.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{T_mid}); - ekat::device_to_host({h_qv.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{qv}); - ekat::device_to_host({h_uwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{uwind}); - ekat::device_to_host({h_vwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{vwind}); - ekat::device_to_host({h_omega.data()}, ncol, nlev_mid, std::vector< view_2d>{omega}); - ekat::device_to_host({h_cldfrac.data()}, ncol, nlev_mid, std::vector< view_2d>{cldfrac}); - ekat::device_to_host({h_z_int.data()}, ncol, nlev_int, std::vector>{z_int}); - ekat::device_to_host({h_p_int.data()}, ncol, nlev_int, std::vector< view_2d>{p_int}); + //---------------------------------------------------------------------- + // mid-point level variables + Kokkos::parallel_for("zm_output_tx_mid",KT::RangePolicy(0, ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_mid_packs; + const int klev = i%nlev_mid_packs; + f_z_mid (icol,klev) = z_mid (icol,klev/Spack::n)[klev%Spack::n]; + f_p_mid (icol,klev) = p_mid (icol,klev/Spack::n)[klev%Spack::n]; + f_p_del (icol,klev) = p_del (icol,klev/Spack::n)[klev%Spack::n]; + f_T_mid (icol,klev) = T_mid (icol,klev/Spack::n)[klev%Spack::n]; + f_qv (icol,klev) = qv (icol,klev/Spack::n)[klev%Spack::n]; + f_uwind (icol,klev) = uwind (icol,klev/Spack::n)[klev%Spack::n]; + f_vwind (icol,klev) = vwind (icol,klev/Spack::n)[klev%Spack::n]; + f_omega (icol,klev) = omega (icol,klev/Spack::n)[klev%Spack::n]; + f_cldfrac (icol,klev) = cldfrac (icol,klev/Spack::n)[klev%Spack::n]; + }); + // interface level variables + Kokkos::parallel_for("zm_output_tx_mid",KT::RangePolicy(0, ncol*nlev_int_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_int_packs; + const int klev = i%nlev_int_packs; + f_z_int (icol,klev) = z_int (icol,klev/Spack::n)[klev%Spack::n]; + f_p_int (icol,klev) = p_int (icol,klev/Spack::n)[klev%Spack::n]; + }); + //---------------------------------------------------------------------- + // copy to host mirrors + Kokkos::deep_copy(h_phis, phis ); + Kokkos::deep_copy(h_pblh, pblh ); + Kokkos::deep_copy(h_tpert, tpert ); + Kokkos::deep_copy(h_landfrac, landfrac ); + Kokkos::deep_copy(h_z_mid, f_z_mid ); + Kokkos::deep_copy(h_p_mid, f_p_mid ); + Kokkos::deep_copy(h_p_del, f_p_del ); + Kokkos::deep_copy(h_T_mid, f_T_mid ); + Kokkos::deep_copy(h_qv, f_qv ); + Kokkos::deep_copy(h_uwind, f_uwind ); + Kokkos::deep_copy(h_vwind, f_vwind ); + Kokkos::deep_copy(h_omega, f_omega ); + Kokkos::deep_copy(h_cldfrac, f_cldfrac ); + Kokkos::deep_copy(h_z_int, f_z_int ); + Kokkos::deep_copy(h_p_int, f_p_int ); } + // *********************************************************************** + // TEMPORARY + // *********************************************************************** + + // if (D == ekat::TransposeDirection::c2f) { + // ekat::device_to_host({h_phis.data()}, ncol, std::vector< view_1d>{phis}); + // ekat::device_to_host({h_pblh.data()}, ncol, std::vector< view_1d>{pblh}); + // ekat::device_to_host({h_tpert.data()}, ncol, std::vector>{tpert}); + // ekat::device_to_host({h_landfrac.data()}, ncol, std::vector< view_1d>{landfrac}); + // ekat::device_to_host({h_z_mid.data()}, ncol, nlev_mid, std::vector>{z_mid}); + // ekat::device_to_host({h_p_mid.data()}, ncol, nlev_mid, std::vector< view_2d>{p_mid}); + // ekat::device_to_host({h_p_del.data()}, ncol, nlev_mid, std::vector< view_2d>{p_del}); + // ekat::device_to_host({h_T_mid.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{T_mid}); + // ekat::device_to_host({h_qv.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{qv}); + // ekat::device_to_host({h_uwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{uwind}); + // ekat::device_to_host({h_vwind.data()}, ncol, nlev_mid, std::vector< view_2d< Spack >>{vwind}); + // ekat::device_to_host({h_omega.data()}, ncol, nlev_mid, std::vector< view_2d>{omega}); + // ekat::device_to_host({h_cldfrac.data()}, ncol, nlev_mid, std::vector< view_2d>{cldfrac}); + // ekat::device_to_host({h_z_int.data()}, ncol, nlev_int, std::vector>{z_int}); + // ekat::device_to_host({h_p_int.data()}, ncol, nlev_int, std::vector< view_2d>{p_int}); + // } } // ------------------------------------------------------------------------- void calculate_tpert(int ncol,int nlev,bool is_first_step) { @@ -202,6 +273,23 @@ struct Functions { uview_2d snow_flux; // output convective precipitation flux [?] uview_2d mass_flux; // output convective mass flux [?] + // ************************************************************************* + // TEMPORARY + // ************************************************************************* + // LayoutLeft views for fortran bridging + uview_2dl f_tend_t; + uview_2dl f_tend_qv; + uview_2dl f_tend_u; + uview_2dl f_tend_v; + uview_2dl f_rain_prod; + uview_2dl f_snow_prod; + uview_2dl f_prec_flux; + uview_2dl f_snow_flux; + uview_2dl f_mass_flux; + // ************************************************************************* + // TEMPORARY + // ************************************************************************* + // host versions of ZM interface variables view_1dh h_activity; view_1dh h_prec; @@ -222,22 +310,68 @@ struct Functions { template void transpose(int ncol, int nlev_mid) { auto nlev_int = nlev_mid+1; + + // *********************************************************************** + // TEMPORARY + // *********************************************************************** + auto nlev_mid_packs = ekat::npack(nlev_mid); + auto nlev_int_packs = ekat::npack(nlev_int); if (D == ekat::TransposeDirection::f2c) { - ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); - ekat::host_to_device({h_activity.data()}, ncol, std::vector> {activity}); - ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); - ekat::host_to_device({h_snow.data()}, ncol, std::vector>{snow}); - ekat::host_to_device({h_cape.data()}, ncol, std::vector>{cape}); - ekat::host_to_device({h_tend_t.data()}, ncol, nlev_mid, std::vector> {tend_t}, true); - ekat::host_to_device({h_tend_qv.data()}, ncol, nlev_mid, std::vector> {tend_qv}, true); - ekat::host_to_device({h_tend_u.data()}, ncol, nlev_mid, std::vector> {tend_u}, true); - ekat::host_to_device({h_tend_v.data()}, ncol, nlev_mid, std::vector> {tend_v}, true); - ekat::host_to_device({h_rain_prod.data()},ncol, nlev_mid, std::vector> {rain_prod}, true); - ekat::host_to_device({h_snow_prod.data()},ncol, nlev_mid, std::vector> {snow_prod}, true); - ekat::host_to_device({h_prec_flux.data()},ncol, nlev_int, std::vector> {prec_flux}, true); - ekat::host_to_device({h_snow_flux.data()},ncol, nlev_int, std::vector> {snow_flux}, true); - ekat::host_to_device({h_mass_flux.data()},ncol, nlev_int, std::vector> {mass_flux}, true); + // copy back to device + Kokkos::deep_copy(f_tend_t, h_tend_t); + Kokkos::deep_copy(f_tend_qv, h_tend_qv); + Kokkos::deep_copy(f_tend_u, h_tend_u); + Kokkos::deep_copy(f_tend_v, h_tend_v); + Kokkos::deep_copy(f_rain_prod,h_rain_prod); + Kokkos::deep_copy(f_snow_prod,h_snow_prod); + Kokkos::deep_copy(f_prec_flux,h_prec_flux); + Kokkos::deep_copy(f_snow_flux,h_snow_flux); + Kokkos::deep_copy(f_mass_flux,h_mass_flux); + Kokkos::deep_copy(prec, h_prec); + Kokkos::deep_copy(snow, h_snow); + Kokkos::deep_copy(cape, h_cape); + Kokkos::deep_copy(activity, h_activity); + //---------------------------------------------------------------------- + // mid-point level variables + Kokkos::parallel_for("zm_output_tx_mid",KT::RangePolicy(0, ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_mid_packs; + const int klev = i%nlev_mid_packs; + tend_t (icol,klev/Spack::n)[klev%Spack::n] = f_tend_t (icol,klev); + tend_qv (icol,klev/Spack::n)[klev%Spack::n] = f_tend_qv (icol,klev); + tend_u (icol,klev/Spack::n)[klev%Spack::n] = f_tend_u (icol,klev); + tend_v (icol,klev/Spack::n)[klev%Spack::n] = f_tend_v (icol,klev); + rain_prod(icol,klev/Spack::n)[klev%Spack::n] = f_rain_prod(icol,klev); + snow_prod(icol,klev/Spack::n)[klev%Spack::n] = f_snow_prod(icol,klev); + }); + // interface level variables + Kokkos::parallel_for("zm_output_tx_mid",KT::RangePolicy(0, ncol*nlev_int_packs), KOKKOS_LAMBDA (const int i) { + const int icol = i/nlev_int_packs; + const int klev = i%nlev_int_packs; + prec_flux(icol,klev/Spack::n)[klev%Spack::n] = f_prec_flux(icol,klev); + snow_flux(icol,klev/Spack::n)[klev%Spack::n] = f_snow_flux(icol,klev); + mass_flux(icol,klev/Spack::n)[klev%Spack::n] = f_mass_flux(icol,klev); + }); } + // *********************************************************************** + // TEMPORARY + // *********************************************************************** + + // if (D == ekat::TransposeDirection::f2c) { + // ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); + // ekat::host_to_device({h_activity.data()}, ncol, std::vector> {activity}); + // ekat::host_to_device({h_prec.data()}, ncol, std::vector>{prec}); + // ekat::host_to_device({h_snow.data()}, ncol, std::vector>{snow}); + // ekat::host_to_device({h_cape.data()}, ncol, std::vector>{cape}); + // ekat::host_to_device({h_tend_t.data()}, ncol, nlev_mid, std::vector> {tend_t}, true); + // ekat::host_to_device({h_tend_qv.data()}, ncol, nlev_mid, std::vector> {tend_qv}, true); + // ekat::host_to_device({h_tend_u.data()}, ncol, nlev_mid, std::vector> {tend_u}, true); + // ekat::host_to_device({h_tend_v.data()}, ncol, nlev_mid, std::vector> {tend_v}, true); + // ekat::host_to_device({h_rain_prod.data()},ncol, nlev_mid, std::vector> {rain_prod}, true); + // ekat::host_to_device({h_snow_prod.data()},ncol, nlev_mid, std::vector> {snow_prod}, true); + // ekat::host_to_device({h_prec_flux.data()},ncol, nlev_int, std::vector> {prec_flux}, true); + // ekat::host_to_device({h_snow_flux.data()},ncol, nlev_int, std::vector> {snow_flux}, true); + // ekat::host_to_device({h_mass_flux.data()},ncol, nlev_int, std::vector> {mass_flux}, true); + // } }; // ------------------------------------------------------------------------- From a3d31b54a985706470104a1c087d23a111006fde Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 27 Oct 2025 14:29:02 -0700 Subject: [PATCH 20/31] unod packed type for phis in SHOC --- .../eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp index bf33224d8abe..22a244babc52 100644 --- a/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp +++ b/components/eamxx/src/physics/shoc/eamxx_shoc_process_interface.cpp @@ -75,7 +75,7 @@ void SHOCMacrophysics::set_grids(const std::shared_ptr grids add_field("p_mid", scalar3d_mid, Pa, grid_name, ps); add_field("p_int", scalar3d_int, Pa, grid_name, ps); add_field("pseudo_density", scalar3d_mid, Pa, grid_name, ps); - add_field("phis", scalar2d , m2/s2, grid_name, ps); + add_field("phis", scalar2d , m2/s2, grid_name); // Input/Output variables add_field("horiz_winds", vector3d_mid, m/s, grid_name, ps); From a91d55b01a214b7c9ae6d7b84ac15362bc578cc0 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 28 Oct 2025 12:00:18 -0700 Subject: [PATCH 21/31] updates from PR review --- .../physics/zm/eamxx_zm_process_interface.cpp | 42 +++++++++---------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 31a6dce46aec..597dac52443d 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -259,7 +259,7 @@ void ZMDeepConvection::run_impl (const double dt) if (zm_opts.apply_tendencies) { // accumulate surface precipitation fluxes Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol), KOKKOS_LAMBDA (const int i) { - Real prec_liq = loc_zm_output_prec(i) - loc_zm_output_snow(i); + auto prec_liq = loc_zm_output_prec(i) - loc_zm_output_snow(i); precip_liq_surf_mass(i) += ekat::impl::max(0.0,prec_liq) * PC::RHO_H2O * dt; precip_ice_surf_mass(i) += loc_zm_output_snow(i) * PC::RHO_H2O * dt; }); @@ -361,9 +361,9 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) //---------------------------------------------------------------------------- // device 1D integer variables ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity }; - for (int i=0; i(i_mem, m_ncol); - i_mem += ptrs_1d_intgr[i]->size(); + for (auto& v : ptrs_1d_intgr) { + *v[i] = ZMF::uview_1d(i_mem, m_ncol); + i_mem += v[i]->size(); } //---------------------------------------------------------------------------- Scalar* scl_mem = reinterpret_cast(i_mem); @@ -374,9 +374,9 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.snow, &zm_output.cape, }; - for (int i=0; i(scl_mem, m_ncol); - scl_mem += ptrs_1d_scalr[i]->size(); + for (auto& v : ptrs_1d_scalr) { + *v[i] = ZMF::uview_1d(scl_mem, m_ncol); + scl_mem += v[i]->size(); } //---------------------------------------------------------------------------- @@ -402,9 +402,9 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_rain_prod, &zm_output.f_snow_prod, }; - for (int i=0; i(r_mem, m_ncol, m_nlev); - r_mem += ptrs_f_midlv[i]->size(); + for (auto& v : ptrs_f_midlv) { + *v[i] = ZMF::uview_2dl(r_mem, m_ncol, m_nlev); + r_mem += v[i]->size(); } //---------------------------------------------------------------------------- // device 2D views on interface levels @@ -414,9 +414,9 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_snow_flux, &zm_output.f_mass_flux, }; - for (int i=0; i(r_mem, m_ncol, (m_nlev+1)); - r_mem += ptrs_f_intfc[i]->size(); + for (auto& v : ptrs_f_intfc) { + *v[i] = ZMF::uview_2dl(r_mem, m_ncol, (m_nlev+1)); + r_mem += v[i]->size(); } //---------------------------------------------------------------------------- Spack* spk_mem = reinterpret_cast(r_mem); @@ -427,7 +427,7 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) // Spack* spk_mem = reinterpret_cast(scl_mem); //---------------------------------------------------------------------------- // device 2D views on mid-point levels - ZMF::uview_2d* ptrs_2d_midlv[num_2d_midlv] = { &zm_input.z_mid, + ZMF::uview_2d* ptrs_2d_midlv[num_2d_midlv] = { &zm_input.z_mid, &zm_input.z_del, &zm_output.tend_t, &zm_output.tend_qv, @@ -436,20 +436,20 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.rain_prod, &zm_output.snow_prod, }; - for (int i=0; i(spk_mem, m_ncol, nlev_mid_packs); - spk_mem += ptrs_2d_midlv[i]->size(); + for (auto& v : ptrs_2d_midlv) { + *v[i] = ZMF::uview_2d(spk_mem, m_ncol, nlev_mid_packs); + spk_mem += v[i]->size(); } //---------------------------------------------------------------------------- // device 2D views on interface levels - ZMF::uview_2d* ptrs_2d_intfc[num_2d_intfc] = { &zm_input.z_int, + ZMF::uview_2d* ptrs_2d_intfc[num_2d_intfc] = { &zm_input.z_int, &zm_output.prec_flux, &zm_output.snow_flux, &zm_output.mass_flux, }; - for (int i=0; i(spk_mem, m_ncol, nlev_int_packs); - spk_mem += ptrs_2d_intfc[i]->size(); + for (auto& v : ptrs_2d_intfc) { + *v[i] = ZMF::uview_2d(spk_mem, m_ncol, nlev_int_packs); + spk_mem += v[i]->size(); } //---------------------------------------------------------------------------- Real* total_mem = reinterpret_cast(spk_mem); From f5be2bc983009643bc605999d2ed10bbad59914c Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Tue, 28 Oct 2025 14:26:01 -0700 Subject: [PATCH 22/31] bug fix --- .../physics/zm/eamxx_zm_process_interface.cpp | 27 +++++++++---------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 597dac52443d..d601107219dc 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -264,7 +264,7 @@ void ZMDeepConvection::run_impl (const double dt) precip_ice_surf_mass(i) += loc_zm_output_snow(i) * PC::RHO_H2O * dt; }); - Kokkos::parallel_for("zm_update_precip",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { + Kokkos::parallel_for("zm_update_prognostic",KT::RangePolicy(0, m_ncol*nlev_mid_packs), KOKKOS_LAMBDA (const int idx) { const int i = idx/nlev_mid_packs; const int k = idx%nlev_mid_packs; T_mid(i,k) += loc_zm_output_tend_t (i,k) * dt; @@ -362,8 +362,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) // device 1D integer variables ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity }; for (auto& v : ptrs_1d_intgr) { - *v[i] = ZMF::uview_1d(i_mem, m_ncol); - i_mem += v[i]->size(); + *v = ZMF::uview_1d(i_mem, m_ncol); + i_mem += v->size(); } //---------------------------------------------------------------------------- Scalar* scl_mem = reinterpret_cast(i_mem); @@ -375,8 +375,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.cape, }; for (auto& v : ptrs_1d_scalr) { - *v[i] = ZMF::uview_1d(scl_mem, m_ncol); - scl_mem += v[i]->size(); + *v = ZMF::uview_1d(scl_mem, m_ncol); + scl_mem += v->size(); } //---------------------------------------------------------------------------- @@ -403,8 +403,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_snow_prod, }; for (auto& v : ptrs_f_midlv) { - *v[i] = ZMF::uview_2dl(r_mem, m_ncol, m_nlev); - r_mem += v[i]->size(); + *v = ZMF::uview_2dl(r_mem, m_ncol, m_nlev); + r_mem += v->size(); } //---------------------------------------------------------------------------- // device 2D views on interface levels @@ -415,15 +415,14 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.f_mass_flux, }; for (auto& v : ptrs_f_intfc) { - *v[i] = ZMF::uview_2dl(r_mem, m_ncol, (m_nlev+1)); - r_mem += v[i]->size(); + *v = ZMF::uview_2dl(r_mem, m_ncol, (m_nlev+1)); + r_mem += v->size(); } //---------------------------------------------------------------------------- Spack* spk_mem = reinterpret_cast(r_mem); // *************************************************************************** // TEMPORARY // *************************************************************************** - // Spack* spk_mem = reinterpret_cast(scl_mem); //---------------------------------------------------------------------------- // device 2D views on mid-point levels @@ -437,8 +436,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.snow_prod, }; for (auto& v : ptrs_2d_midlv) { - *v[i] = ZMF::uview_2d(spk_mem, m_ncol, nlev_mid_packs); - spk_mem += v[i]->size(); + *v = ZMF::uview_2d(spk_mem, m_ncol, nlev_mid_packs); + spk_mem += v->size(); } //---------------------------------------------------------------------------- // device 2D views on interface levels @@ -448,8 +447,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) &zm_output.mass_flux, }; for (auto& v : ptrs_2d_intfc) { - *v[i] = ZMF::uview_2d(spk_mem, m_ncol, nlev_int_packs); - spk_mem += v[i]->size(); + *v = ZMF::uview_2d(spk_mem, m_ncol, nlev_int_packs); + spk_mem += v->size(); } //---------------------------------------------------------------------------- Real* total_mem = reinterpret_cast(spk_mem); From 7e04eb8f010ff5a141995a8d25f98a65aaa1a2ba Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 29 Oct 2025 07:47:50 -0700 Subject: [PATCH 23/31] move call for zm_microphysics_history_convert --- components/eam/src/physics/cam/zm_conv_intr.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 4ebfd0ca315a..4af47a36faa6 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -644,6 +644,8 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call t_stopf ('zm_convr') if (zm_param%zm_microp) then + ! perform some miscellaneous conversions on the ZM microphysics data + call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t) ! update ZM micro variables in pbuf qi (1:ncol,1:pver) = microp_st%qice (1:ncol,1:pver) dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) @@ -807,10 +809,7 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call outfld('PRECCDZM', prec, pcols, lchnk ) call outfld('PRECZ ', prec, pcols, lchnk ) - if (zm_param%zm_microp) then - call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t) - call zm_microphysics_history_out(lchnk, ncol, microp_st, prec, dlf) - end if + if (zm_param%zm_microp) call zm_microphysics_history_out(lchnk, ncol, microp_st, prec, dlf) ! add tendency from this process to tend from other processes here call physics_ptend_sum(ptend_loc,ptend_all, ncol) From 404f99a0d9911fbd3459426ff0467bef79b4c5f3 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 29 Oct 2025 07:48:36 -0700 Subject: [PATCH 24/31] remove team_policy --- components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index d601107219dc..22ebdf054615 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -147,7 +147,6 @@ void ZMDeepConvection::run_impl (const double dt) // calculate_z_int() contains a team-level parallel_scan, which requires a special policy using TPF = ekat::TeamPolicyFactory; const auto scan_policy = TPF::get_thread_range_parallel_scan_team_policy(m_ncol, nlev_mid_packs); - const auto team_policy = TPF::get_default_team_policy(m_ncol, nlev_mid_packs); auto ts_start = start_of_step_ts(); bool is_first_step = (ts_start.get_num_steps()==0); From 33f3720fe5d96db193e439475c6d1434c298e820 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 29 Oct 2025 09:22:24 -0700 Subject: [PATCH 25/31] fixes to restor BFB for EAM tests e --- components/eam/src/physics/cam/zm_conv.F90 | 29 +++------ .../eam/src/physics/cam/zm_conv_intr.F90 | 10 +-- .../physics/cam/zm_microphysics_history.F90 | 62 ++++++++++--------- 3 files changed, 45 insertions(+), 56 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index bf59c289314d..5f619a63ae15 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -612,34 +612,21 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & end do end do + do i = 1,lengath + jctop(ideep(i)) = jt(i) + jcbot(ideep(i)) = maxg(i) + pflx(ideep(i),pverp) = pflxg(i,pverp) + end do + !---------------------------------------------------------------------------- - ! Scatter microphysics data (i.e. undo the gathering) + ! scatter microphysics data (i.e. undo the gathering) - if (zm_param%zm_microp) then - call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) - ! we also need to do a few miscellaneous things to the micro variables - do i = 1,ncol - do k = msg + 1,pver - if(k.lt.pver) then - ! interpolate from interface to mid-point - microp_st%wu(i,k) = 0.5_r8 * ( microp_st%wu(i,k) + microp_st%wu(i,k+1) ) - end if - ! convert freezing rate to a heating rate due to freezing => [K/s] - microp_st%frz(i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair - end do - end do - end if + if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep) #ifdef CPRCRAY !DIR$ CONCURRENT #endif - do i = 1,lengath - jctop(ideep(i)) = jt(i) - jcbot(ideep(i)) = maxg(i) - pflx(ideep(i),pverp) = pflxg(i,pverp) - end do - !---------------------------------------------------------------------------- ! Compute precip by integrating change in water vapor minus detrained cloud water do i = 1,ncol diff --git a/components/eam/src/physics/cam/zm_conv_intr.F90 b/components/eam/src/physics/cam/zm_conv_intr.F90 index 4af47a36faa6..00f0fe8a4450 100644 --- a/components/eam/src/physics/cam/zm_conv_intr.F90 +++ b/components/eam/src/physics/cam/zm_conv_intr.F90 @@ -644,8 +644,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & call t_stopf ('zm_convr') if (zm_param%zm_microp) then - ! perform some miscellaneous conversions on the ZM microphysics data - call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t) ! update ZM micro variables in pbuf qi (1:ncol,1:pver) = microp_st%qice (1:ncol,1:pver) dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver) @@ -655,10 +653,12 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, & dnsf (1:ncol,1:pver) = microp_st%dnsf (1:ncol,1:pver) mudpcu (1:ncol,1:pver) = microp_st%mudpcu (1:ncol,1:pver) lambdadpcu(1:ncol,1:pver) = microp_st%lambdadpcu(1:ncol,1:pver) + ! perform some miscellaneous conversions on the ZM microphysics data + call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t) ! update other micro variables - rice(1:ncol) = microp_st%rice(1:ncol) - dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) - wuc(1:pcols,1:pver) = microp_st%wu(1:pcols,1:pver) + wuc (1:ncol,1:pver) = microp_st%wu (1:ncol,1:pver) + rice (1:ncol) = microp_st%rice (1:ncol) + dlftot (1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) else dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) end if diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 index 62f765934dac..d425033d3a6b 100644 --- a/components/eam/src/physics/cam/zm_microphysics_history.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_history.F90 @@ -137,7 +137,7 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature ) !---------------------------------------------------------------------------- ! Purpose: convert ZM microphysics prior to output !---------------------------------------------------------------------------- - use zm_conv, only: zm_const + use zm_conv, only: zm_const, zm_param !---------------------------------------------------------------------------- ! Arguments integer, intent(in ) :: ncol ! number of columns in chunk @@ -147,10 +147,13 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature ) !---------------------------------------------------------------------------- ! Local variables integer :: i,k + integer :: msg ! number of missing moisture levels at the top of model real(r8) :: rho !---------------------------------------------------------------------------- + msg = zm_param%limcnv - 1 ! set this to match zm_convr() + do i = 1,ncol - do k = 1,pver + do k = msg + 1,pver ! Interpolate variable from interface to mid-layer. if (k1) then - if ( temperature(i,k).gt.zm_const%tfreez .and. temperature(i,k-1).le.zm_const%tfreez ) then - microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) - microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) - microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) - microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) - microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k) - microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) - microp_st%qice (i,k) = 0._r8 - microp_st%qni (i,k) = 0._r8 - microp_st%qsnow (i,k) = 0._r8 - microp_st%qns (i,k) = 0._r8 - microp_st%qgraupel(i,k) = 0._r8 - microp_st%qng (i,k) = 0._r8 - end if + if ( temperature(i,k).gt.zm_const%tfreez .and. temperature(i,k-1).le.zm_const%tfreez ) then + microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k) + microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k) + microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k) + microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k) + microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k) + microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k) + microp_st%qice (i,k) = 0._r8 + microp_st%qni (i,k) = 0._r8 + microp_st%qsnow (i,k) = 0._r8 + microp_st%qns (i,k) = 0._r8 + microp_st%qgraupel(i,k) = 0._r8 + microp_st%qng (i,k) = 0._r8 end if end do ! k - ! Convert units from "kg/kg" to "g/m3" - do k = 1,pver - rho = pmid(i,k)/(temperature(i,k)*zm_const%rdair) - microp_st%qice (i,k) = microp_st%qice(i,k) * rho *1000._r8 - microp_st%qliq (i,k) = microp_st%qliq(i,k) * rho *1000._r8 - microp_st%qrain (i,k) = microp_st%qrain(i,k) * rho *1000._r8 - microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * rho *1000._r8 - microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * rho *1000._r8 - microp_st%qni (i,k) = microp_st%qni(i,k) * rho - microp_st%qnl (i,k) = microp_st%qnl(i,k) * rho - microp_st%qnr (i,k) = microp_st%qnr(i,k) * rho - microp_st%qns (i,k) = microp_st%qns(i,k) * rho - microp_st%qng (i,k) = microp_st%qng(i,k) * rho + ! Convert units + do k = msg + 1,pver + microp_st%qice (i,k) = microp_st%qice(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8 + microp_st%qliq (i,k) = microp_st%qliq(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8 + microp_st%qrain (i,k) = microp_st%qrain(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8 + microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8 + microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8 + microp_st%qni (i,k) = microp_st%qni(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair + microp_st%qnl (i,k) = microp_st%qnl(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair + microp_st%qnr (i,k) = microp_st%qnr(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair + microp_st%qns (i,k) = microp_st%qns(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair + microp_st%qng (i,k) = microp_st%qng(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair + ! convert freezing rate to a heating rate due to freezing => [K/s] + microp_st%frz (i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair end do ! k end do ! i From ddc6db5555c77e04947808e76aef086d379f8b13 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 3 Nov 2025 17:01:09 -0600 Subject: [PATCH 26/31] bug fix for run-time issue in EAM --- components/eam/src/physics/cam/zm_conv.F90 | 39 ++++++++-------- .../eam/src/physics/cam/zm_microphysics.F90 | 46 +++++++++---------- 2 files changed, 43 insertions(+), 42 deletions(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 5f619a63ae15..84fb500e0bb9 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -263,9 +263,9 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- ! Allocate and/or Initialize microphysics state/tend derived types if (zm_param%zm_microp) then - call zm_microp_st_alloc(loc_microp_st, ncol, pver) - call zm_microp_st_ini(loc_microp_st, ncol, pver) - call zm_microp_st_ini(microp_st, ncol, pver) + call zm_microp_st_alloc(loc_microp_st, pcols, pver) + call zm_microp_st_ini(loc_microp_st, pcols, pver) + call zm_microp_st_ini(microp_st, pcols, pver) loc_microp_st%lambdadpcu = (mucon + 1._r8)/dcon loc_microp_st%mudpcu = mucon end if @@ -378,7 +378,11 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & end if end do - if (lengath.eq.0) return + if (lengath.eq.0) then + ! Deallocate local microphysics arrays before returning + if (zm_param%zm_microp) call zm_microp_st_dealloc(loc_microp_st) + return + end if do ii=1,lengath ideep(ii)=gather_index(ii) @@ -475,7 +479,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- ! obtain cloud properties. - call cldprp(zm_const, pcols, ncol, pver, pverp, & + call cldprp(pcols, ncol, pver, pverp, & qg ,tg ,ug ,vg ,pg , & zg ,sg ,mu ,eu ,du , & md ,ed ,sd ,qd ,mc , & @@ -487,7 +491,6 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & landfracg, tpertg, & aero ,loc_microp_st ) ! < added for ZM micro - !---------------------------------------------------------------------------- ! convert detrainment from units of "1/m" to "1/mb". @@ -508,7 +511,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- - call closure(zm_const, pcols, ncol, pver, pverp, & + call closure(pcols, ncol, pver, pverp, & qg ,tg ,pg ,zg ,sg , & tpg ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -576,7 +579,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & !---------------------------------------------------------------------------- ! compute temperature and moisture changes due to convection. - call q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & + call q1q2_pjr(pcols, ncol, pver, pverp, & dqdt ,dsdt ,qg ,qs ,qu , & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,qlg , & @@ -912,7 +915,7 @@ end subroutine zm_conv_evap !=================================================================================================== -subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & +subroutine cldprp(pcols, ncol, pver, pverp, & q ,t ,u ,v ,p , & z ,s ,mu ,eu ,du , & md ,ed ,sd ,qd ,mc , & @@ -951,7 +954,6 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & ! ! Input arguments ! - type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants integer, intent(in) :: pcols ! maximum number of columns integer, intent(in) :: ncol ! actual number of columns integer, intent(in) :: pver ! number of mid-point vertical levels @@ -1580,9 +1582,11 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & end do #ifndef SCREAM_CONFIG_IS_CMAKE - call zm_mphy( su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, & - zf, p, t, q, eps0, jb, jt, jlcl, msg, il2g, & - zm_const%grav, zm_const%cpair, zm_const%rdair, aero, gamhat, & + call zm_mphy( pcols, il2g, msg, & + zm_const%grav, zm_const%cpair, zm_const%rdair, & + zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs, & + jb, jt, jlcl, su, qu, mu, du, eu, zf, p, t, q, gamhat, eps0, & + loc_microp_st%cmel, loc_microp_st%cmei, aero, & loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, & loc_microp_st%qcde, loc_microp_st%qide, loc_microp_st%ncde, loc_microp_st%nide, & rprd, loc_microp_st%sprd, tmp_frz, loc_microp_st%wu, & @@ -1604,8 +1608,7 @@ subroutine cldprp(zm_const, pcols, ncol, pver, pverp, & loc_microp_st%accsirn, loc_microp_st%accgln, loc_microp_st%accgrn, loc_microp_st%accilm, & loc_microp_st%acciln, loc_microp_st%fallrm, loc_microp_st%fallsm, loc_microp_st%fallgm, & loc_microp_st%fallrn, loc_microp_st%fallsn, loc_microp_st%fallgn, loc_microp_st%fhmrm, & - loc_microp_st%dsfm, loc_microp_st%dsfn, & - zm_param%auto_fac, zm_param%accr_fac, zm_param%micro_dcs) + loc_microp_st%dsfm, loc_microp_st%dsfn ) #endif do k = pver,msg + 2,-1 @@ -1863,7 +1866,7 @@ end subroutine cldprp !=================================================================================================== -subroutine closure(zm_const, pcols, ncol, pver, pverp, & +subroutine closure(pcols, ncol, pver, pverp, & q ,t ,p ,z ,s , & tp ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -1895,7 +1898,6 @@ subroutine closure(zm_const, pcols, ncol, pver, pverp, & ! !-----------------------------Arguments--------------------------------- ! - type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants integer, intent(in) :: pcols ! maximum number of columns integer, intent(in) :: ncol ! actual number of columns integer, intent(in) :: pver ! number of mid-point vertical levels @@ -2078,7 +2080,7 @@ end subroutine closure !=================================================================================================== -subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & +subroutine q1q2_pjr(pcols, ncol, pver, pverp, & dqdt ,dsdt ,q ,qs ,qu , & su ,du ,qhat ,shat ,dp , & mu ,md ,sd ,qd ,ql , & @@ -2091,7 +2093,6 @@ subroutine q1q2_pjr(zm_const, pcols, ncol, pver, pverp, & implicit none !---------------------------------------------------------------------------- ! Arguments - type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants integer, intent(in) :: pcols ! maximum number of columns integer, intent(in) :: ncol ! actual number of columns integer, intent(in) :: pver ! number of mid-point vertical levels diff --git a/components/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90 index 9c9333da4125..c067558d978e 100644 --- a/components/eam/src/physics/cam/zm_microphysics.F90 +++ b/components/eam/src/physics/cam/zm_microphysics.F90 @@ -7,7 +7,7 @@ module zm_microphysics !---------------------------------------------------------------------------- use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp + use ppgrid, only: pver, pverp use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o use physconst, only: latvap, latice use activate_drop_mam, only: actdrop_mam_calc @@ -112,6 +112,7 @@ subroutine zm_microphysics_register() ! Purpose: register pbuf variables for convective microphysics !---------------------------------------------------------------------------- use physics_buffer, only : pbuf_add_field, dtype_r8 + use ppgrid, only: pcols !---------------------------------------------------------------------------- ! detrained convective cloud water num concen. @@ -197,8 +198,8 @@ end subroutine zm_mphyi !=================================================================================================== -subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, & - eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, & +subroutine zm_mphy(pcols, il2g, msg, grav, cp, rd, auto_fac, accr_fac, dcs, jb, jt, jlcl, & + su, qu, mu, du, eu, zf, pm, te, qe, gamhat, eps0, cmel, cmei, aero, & qc, qi, nc, ni, qcde, qide, ncde, nide, rprd, sprd, frz, & wu, qr, qni, nr, ns, qg, ng, qnide,nsde, & autolm, accrlm, bergnm, fhtimm, fhtctm, & @@ -208,7 +209,7 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, accgrm, accglm, accgslm,accgsrm,accgirm,accgrim,accgrsm,accgsln,accgsrn, & accgirn,accsrim,acciglm,accigrm,accsirm,accigln,accigrn,accsirn,accgln, & accgrn ,accilm, acciln ,fallrm ,fallsm ,fallgm ,fallrn ,fallsn ,fallgn, & - fhmrm ,dsfm, dsfn, auto_fac, accr_fac, dcs) + fhmrm ,dsfm, dsfn) ! Purpose: @@ -224,35 +225,33 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, implicit none ! input variables + integer, intent(in) :: pcols ! declared column dimension size + integer, intent(in) :: il2g ! number of columns in gathered arrays + integer, intent(in) :: msg ! missing moisture vals + real(r8), intent(in) :: grav ! gravity + real(r8), intent(in) :: cp ! heat capacity of dry air + real(r8), intent(in) :: rd ! gas constant for dry air + integer, intent(in) :: jb(pcols) ! updraft base level + real(r8), intent(in) :: auto_fac ! droplet-rain autoconversion enhancement factor + real(r8), intent(in) :: accr_fac ! droplet-rain accretion enhancement factor + real(r8), intent(in) :: dcs ! autoconversion size threshold for cloud ice to snow (m) + integer, intent(in) :: jt(pcols) ! updraft plume top + integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft real(r8), intent(in) :: qu(pcols,pver) ! spec hum of updraft real(r8), intent(in) :: mu(pcols,pver) ! updraft mass flux real(r8), intent(in) :: du(pcols,pver) ! detrainement rate of updraft real(r8), intent(in) :: eu(pcols,pver) ! entrainment rate of updraft - real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft - real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces real(r8), intent(in) :: pm(pcols,pver) ! pressure of env real(r8), intent(in) :: te(pcols,pver) ! temp of env real(r8), intent(in) :: qe(pcols,pver) ! spec. humidity of env - real(r8), intent(in) :: eps0(pcols) real(r8), intent(in) :: gamhat(pcols,pver) ! gamma=L/cp(dq*/dT) at interface - - integer, intent(in) :: jb(pcols) ! updraft base level - integer, intent(in) :: jt(pcols) ! updraft plume top - integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level - integer, intent(in) :: msg ! missing moisture vals - integer, intent(in) :: il2g ! number of columns in gathered arrays - + real(r8), intent(in) :: eps0(pcols) ! ??? + real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft + real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft type(zm_aero_t), intent(in) :: aero ! aerosol object - real(r8) grav ! gravity - real(r8) cp ! heat capacity of dry air - real(r8) rd ! gas constant for dry air - real(r8) auto_fac ! droplet-rain autoconversion enhancement factor - real(r8) accr_fac ! droplet-rain accretion enhancement factor - real(r8) dcs ! autoconversion size threshold for cloud ice to snow (m) - ! output variables real(r8), intent(out) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg) real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg) @@ -650,11 +649,12 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, cwifrac = 0.5_r8 retv = 0.608_r8 bergtsf = 1800._r8 + ! initialize multi-level fields do i=1,il2g do k=1,pver - q(i,k) = qu(i,k) + q(i,k) = qu(i,k) tu(i,k)= su(i,k) - grav/cp*zf(i,k) t(i,k) = su(i,k) - grav/cp*zf(i,k) p(i,k) = 100._r8*pm(i,k) @@ -678,7 +678,7 @@ subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qcic(i,k) = 0._r8 qiic(i,k) = 0._r8 ncic(i,k) = 0._r8 - niic(i,k) = 0._r8 + niic(i,k) = 0._r8 qr(i,k) = 0._r8 qni(i,k) = 0._r8 qg(i,k) = 0._r8 From 0ac147657ec620afd5b511dbb1330dfd46faeb77 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Mon, 3 Nov 2025 17:46:35 -0600 Subject: [PATCH 27/31] add constexpr to fix build error --- .../eamxx/src/physics/zm/eamxx_zm_process_interface.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp index 22ebdf054615..37a435426fec 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -352,8 +352,8 @@ void ZMDeepConvection::init_buffers(const ATMBufferManager &buffer_manager) constexpr auto num_2d_midlv = ZMF::zm_input_state::num_2d_midlv + ZMF::zm_output_tend::num_2d_midlv; constexpr auto num_2d_intfc = ZMF::zm_input_state::num_2d_intfc + ZMF::zm_output_tend::num_2d_intfc; - int num_f_mid = (9+6); - int num_f_int = (2+3); + constexpr int num_f_mid = (9+6); + constexpr int num_f_int = (2+3); //---------------------------------------------------------------------------- Int* i_mem = reinterpret_cast(buffer_manager.get_memory()); From 1dc8c982e547cf09346613c068d63e2261b439ca Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Wed, 5 Nov 2025 16:28:53 -0600 Subject: [PATCH 28/31] bug fix to address diffs in ne30 tests --- components/eam/src/physics/cam/zm_conv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index 84fb500e0bb9..b5efe9a23285 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -591,7 +591,7 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, & ! conservation check and adjusment #ifndef SCREAM_CONFIG_IS_CMAKE if (zm_param%zm_microp) call zm_microphysics_adjust(pcols, lengath, pver, jt, msg, delt, zm_const, & - dp, qg, dlg, dsdt, dqdt, rprd, loc_microp_st) + dp, qg, dlg, dsdt, dqdt, rprdg, loc_microp_st) #endif !---------------------------------------------------------------------------- From f6527c14d69e4aa8d26243f44ed3b5fbb3b76b60 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 7 Nov 2025 06:52:23 -0800 Subject: [PATCH 29/31] fix variable descriptions --- .../src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 index 569b67c48ac3..3ed33f800dc9 100644 --- a/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 +++ b/components/eamxx/src/physics/zm/fortran_bridge/zm_eamxx_bridge_main.F90 @@ -134,10 +134,10 @@ subroutine zm_eamxx_bridge_run_c( ncol, dtime, is_first_step, & real(r8), dimension(ncol,pver) :: cme ! condensation - evaporation real(r8), dimension(ncol,pver) :: dlf ! detrained convective cloud water mixing ratio real(r8), dimension(ncol,pver) :: zdu ! detraining mass flux - real(r8), dimension(ncol,pver) :: mu ! upward cloud mass flux - real(r8), dimension(ncol,pver) :: md ! entrainment in updraft + real(r8), dimension(ncol,pver) :: mu ! updraft cloud mass flux + real(r8), dimension(ncol,pver) :: md ! downdraft cloud mass flux real(r8), dimension(ncol,pver) :: du ! detrainment in updraft - real(r8), dimension(ncol,pver) :: eu ! downward cloud mass flux + real(r8), dimension(ncol,pver) :: eu ! entrainment in updraft real(r8), dimension(ncol,pver) :: ed ! entrainment in downdraft real(r8), dimension(ncol,pver) :: dp ! layer thickness [mb] real(r8), dimension(ncol) :: dsubcld ! sub-cloud layer thickness From ef879949f1f0768b34a9b33ae01514547d5b6bf2 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 7 Nov 2025 06:55:34 -0800 Subject: [PATCH 30/31] fix variable descriptions --- components/eam/src/physics/cam/zm_conv_types.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/cam/zm_conv_types.F90 b/components/eam/src/physics/cam/zm_conv_types.F90 index 55f19383cb5c..f204719c41ba 100644 --- a/components/eam/src/physics/cam/zm_conv_types.F90 +++ b/components/eam/src/physics/cam/zm_conv_types.F90 @@ -72,7 +72,7 @@ module zm_conv_types logical :: no_deep_pbl = .false. ! flag to eliminate deep convection within PBL ! ZM micro parameters logical :: zm_microp = .false. ! switch for convective microphysics - logical :: old_snow = .true. ! switch to revert snow production in zm_conv_evap (i.e. before zm_micro additions) + logical :: old_snow = .true. ! switch to calculate snow prod in zm_conv_evap() (old treatment before zm_microp was implemented) real(r8) :: auto_fac = unset_r8 ! ZM microphysics enhancement factor for droplet-rain autoconversion real(r8) :: accr_fac = unset_r8 ! ZM microphysics enhancement factor for droplet-rain accretion real(r8) :: micro_dcs = unset_r8 ! ZM microphysics size threshold for cloud ice to snow autoconversion [m] From a9f4f79a11566462c9af2f3e105380021fe17685 Mon Sep 17 00:00:00 2001 From: Walter Hannah Date: Fri, 7 Nov 2025 06:56:39 -0800 Subject: [PATCH 31/31] fix units --- components/eam/src/physics/cam/zm_conv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90 index b5efe9a23285..90daee0517a9 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -697,7 +697,7 @@ subroutine zm_conv_evap(pcols, ncol, pver, pverp, deltat, & real(r8), dimension(pcols,pver), intent(in ) :: pdel ! layer thickness [Pa] real(r8), dimension(pcols,pver), intent(in ) :: t ! temperature [K] real(r8), dimension(pcols,pver), intent(in ) :: q ! water vapor [kg/kg] - real(r8), dimension(pcols,pver), intent(in ) :: prdprec ! precipitation production [kg/ks/s] + real(r8), dimension(pcols,pver), intent(in ) :: prdprec ! precipitation production [kg/kg/s] real(r8), dimension(pcols,pver), intent(in ) :: cldfrc ! cloud fraction real(r8), dimension(pcols,pver), intent(inout) :: tend_s ! heating rate [J/kg/s] real(r8), dimension(pcols,pver), intent(inout) :: tend_q ! water vapor tendency [kg/kg/s]