diff --git a/components/eam/src/physics/cam/convect_shallow.F90 b/components/eam/src/physics/cam/convect_shallow.F90 index 578dbd8668fd..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( state1%ncol, state1%lchnk, & - 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 ! ! ------------------------------------------------------------- ! 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..90daee0517a9 100644 --- a/components/eam/src/physics/cam/zm_conv.F90 +++ b/components/eam/src/physics/cam/zm_conv.F90 @@ -2,30 +2,31 @@ 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 + 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 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,150 @@ 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. - - 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 +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, & + 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, aero, microp_st ) + !---------------------------------------------------------------------------- + ! 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] + 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 + 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] + 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 + + 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) :: 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 @@ -406,107 +222,57 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & integer l, m 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 qlg(i,k) = 0._r8 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 - - 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 + prec(i) = 0._r8 + rliq(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 + !---------------------------------------------------------------------------- + ! Allocate and/or Initialize microphysics state/tend derived types if (zm_param%zm_microp) then - call zm_microp_st_ini(microp_st, ncol) - call zm_microp_st_ini(loc_microp_st,ncol) + 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 - 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 +286,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 +332,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 +347,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 + 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 - 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) + + !---------------------------------------------------------------------------- + ! 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 +438,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 +452,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,43 +475,43 @@ 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(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 ) + landfracg, tpertg, & + aero ,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) 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%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 - call closure(lchnk , zm_const, & + !---------------------------------------------------------------------------- + + call closure(pcols, ncol, pver, pverp, & qg ,tg ,pg ,zg ,sg , & tpg ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -770,34 +519,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,238 +545,66 @@ 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) 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 - 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 + + 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 + end if 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(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 ,dig , & - ncdeg ,nideg ,dnlg ,dnig ,frzg , & - qsdeg ,nsdeg ,dsg ,dnsg ) + dlg ,evpg ,cug ,& + 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, zm_const, & + dp, qg, dlg, dsdt, dqdt, rprdg, 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 - 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 - - end if - end do - - if (negadq<0._r8) then - dqdt(i,k) = dqdt(i,k) - negadq - end if - - end if - end do - end do - end if - + !---------------------------------------------------------------------------- + ! 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) @@ -1044,185 +612,129 @@ subroutine zm_convr(lchnk ,ncol ,is_first_step, & dlf (ideep(i),k) = dlg (i,k) pflx(ideep(i),k) = pflxg(i,k) 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 - if (zm_param%zm_microp) qi(ideep(i),k) = loc_microp_st%qice(i,k) 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) - - 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)) - 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 - 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 - 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 + !---------------------------------------------------------------------------- + ! 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) -! obtain final precipitation rate in m/s. +#ifdef CPRCRAY +!DIR$ CONCURRENT +#endif + + !---------------------------------------------------------------------------- + ! Compute precip by integrating change in water vapor minus detrained cloud water do i = 1,ncol + do k = pver,msg + 1,-1 + 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) + !---------------------------------------------------------------------------- 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 ) -!----------------------------------------------------------------------- -! 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) :: ncol, lchnk ! number of columns and chunk index - 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/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] + 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 @@ -1243,8 +755,8 @@ subroutine zm_conv_evap(ncol,lchnk, & do k = 1, pver do i = 1, ncol -! Melt snow falling into layer, if necessary. - if( old_snow ) then +! Melt snow falling into layer, if necessary. + 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) @@ -1299,7 +811,7 @@ subroutine zm_conv_evap(ncol,lchnk, & 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 @@ -1309,7 +821,7 @@ subroutine zm_conv_evap(ncol,lchnk, & ! 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 @@ -1323,11 +835,11 @@ subroutine zm_conv_evap(ncol,lchnk, & ! 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. - 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 @@ -1359,10 +871,10 @@ subroutine zm_conv_evap(ncol,lchnk, & ! 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 + 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) @@ -1373,7 +885,7 @@ subroutine zm_conv_evap(ncol,lchnk, & 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 @@ -1403,29 +915,27 @@ end subroutine zm_conv_evap !=================================================================================================== -subroutine cldprp(lchnk , zm_const, & +subroutine cldprp(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 , & - qcde ,qide ,qsde ,ncde ,nide ,nsde , & - dsfm ,dsfn ,loc_microp_st ) - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: + aero ,loc_microp_st ) + +!----------------------------------------------------------------------- +! +! 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. ! @@ -1444,8 +954,10 @@ 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 +982,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 ! @@ -1496,22 +1007,6 @@ subroutine cldprp(lchnk , zm_const, & ! 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 - - 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 - ! ! Local workspace ! @@ -1533,7 +1028,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) @@ -1560,19 +1054,17 @@ subroutine cldprp(lchnk , zm_const, & 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) 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), 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 integer jto(pcols) ! updraft plume old top integer tmplel(pcols) @@ -1590,84 +1082,7 @@ subroutine cldprp(lchnk , zm_const, & ! !------------------------------------------------------------------------------ - 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 @@ -1702,7 +1117,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 @@ -1724,31 +1138,31 @@ subroutine cldprp(lchnk , zm_const, & 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 - 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 + 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 @@ -1796,7 +1210,7 @@ subroutine cldprp(lchnk , zm_const, & !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) @@ -1830,13 +1244,13 @@ subroutine cldprp(lchnk , zm_const, & 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 @@ -1923,9 +1337,11 @@ subroutine cldprp(lchnk , zm_const, & 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 @@ -1943,318 +1359,317 @@ subroutine cldprp(lchnk , zm_const, & 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 - 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 + if (iter == 1) jto(i) = jt(i) 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, & - 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, & - 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 , & - dsfm, 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)*(qcde(i,k+1)+qide(i,k+1)+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 - 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 - 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( 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, & + 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, & + 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, & + 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 ) +#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 + + 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 do !iter + 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 @@ -2362,13 +1777,11 @@ 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) + ! 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)) + 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 rprd(i,k) = rprd(i,k)-evp(i,k) @@ -2381,78 +1794,79 @@ subroutine cldprp(lchnk , zm_const, & 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 + ! 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 (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 - 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 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 - cmeg(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 + 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 + 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%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 + 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 !=================================================================================================== -subroutine closure(lchnk , zm_const, & +subroutine closure(pcols, ncol, pver, pverp, & q ,t ,p ,z ,s , & tp ,qs ,qu ,su ,mc , & du ,mu ,md ,qd ,sd , & @@ -2460,15 +1874,15 @@ subroutine closure(lchnk , zm_const, & 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. ! @@ -2476,7 +1890,7 @@ subroutine closure(lchnk , zm_const, & ! We expect to release cleaner code in a future release ! ! the documentation has been enhanced to the degree that we are able -! +! !----------------------------------------------------------------------- implicit none @@ -2484,8 +1898,10 @@ 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,33 +2080,23 @@ end subroutine closure !=================================================================================================== -subroutine q1q2_pjr(lchnk , zm_const, & +subroutine q1q2_pjr(pcols, ncol, pver, pverp, & dqdt ,dsdt ,q ,qs ,qu , & 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 ,& + loc_microp_st) + !---------------------------------------------------------------------------- + ! Purpose: initialize quantities for ZM convection scheme + !---------------------------------------------------------------------------- implicit none - -!----------------------------------------------------------------------- -! -! Purpose: -! -! -! Method: -! -! -! -! Author: phil rasch dec 19 1995 -! -!----------------------------------------------------------------------- - - - integer, intent(in) :: lchnk ! chunk identifier - type(zm_const_t), intent(in) :: zm_const ! derived type to hold ZM constants + !---------------------------------------------------------------------------- + ! 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 integer, intent(in) :: il1g integer, intent(in) :: il2g integer, intent(in) :: msg @@ -2712,53 +2118,36 @@ subroutine q1q2_pjr(lchnk , zm_const, & 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(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) - ! 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 + 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 -! -! 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 @@ -2768,8 +2157,7 @@ subroutine q1q2_pjr(lchnk , zm_const, & 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)) & @@ -2778,7 +2166,7 @@ subroutine q1q2_pjr(lchnk , zm_const, & -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)) & @@ -2787,13 +2175,15 @@ subroutine q1q2_pjr(lchnk , zm_const, & -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 - 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) + 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 74d1c57796c1..00f0fe8a4450 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 @@ -426,10 +424,10 @@ 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_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 @@ -488,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 @@ -500,7 +507,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 @@ -538,12 +545,9 @@ 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 - !---------------------------------------------------------------------------- - 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,14 +600,8 @@ 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) - else - allocate(dnlf(pcols,pver), & - dnif(pcols,pver), & - dsf(pcols,pver), & - dnsf(pcols,pver), & - wuc(pcols,pver) ) + wuc(1:pcols,1:pver) = 0 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 +632,33 @@ 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, & + 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, aero(lchnk), microp_st ) call t_stopf ('zm_convr') if (zm_param%zm_microp) then - dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver) + ! 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) + 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 + 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 @@ -668,13 +680,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) @@ -766,10 +784,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(state1%ncol, state1%lchnk, & - 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) @@ -791,7 +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) 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) @@ -808,7 +826,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 ) @@ -855,7 +873,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) @@ -873,11 +892,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 @@ -955,7 +970,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 d797d98d69cf..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 @@ -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 !=================================================================================================== diff --git a/components/eam/src/physics/cam/zm_conv_types.F90 b/components/eam/src/physics/cam/zm_conv_types.F90 index 35db6011daa8..f204719c41ba 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 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] @@ -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 @@ -247,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) @@ -289,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/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90 index 4e01fa14343c..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 @@ -28,6 +28,7 @@ module zm_microphysics save public :: zm_microphysics_register + public :: zm_microphysics_adjust public :: zm_mphyi public :: zm_mphy @@ -111,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. @@ -196,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, & @@ -207,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: @@ -223,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) @@ -649,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) @@ -677,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 @@ -3210,4 +3211,124 @@ end subroutine zm_mphy !=================================================================================================== +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_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, 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 + 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 diff --git a/components/eam/src/physics/cam/zm_microphysics_history.F90 b/components/eam/src/physics/cam/zm_microphysics_history.F90 index 87dbee3f0416..d425033d3a6b 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,7 +133,79 @@ 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_convert( ncol, microp_st, pmid, temperature ) + !---------------------------------------------------------------------------- + ! Purpose: convert ZM microphysics prior to output + !---------------------------------------------------------------------------- + use zm_conv, only: zm_const, zm_param + !---------------------------------------------------------------------------- + ! 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 + 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 = msg + 1,pver + ! Interpolate variable from interface to mid-layer. + if (k [K/s] + microp_st%frz (i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair + 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 !---------------------------------------------------------------------------- @@ -144,10 +217,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 +228,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 +253,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..847978575d23 100644 --- a/components/eam/src/physics/cam/zm_microphysics_state.F90 +++ b/components/eam/src/physics/cam/zm_microphysics_state.F90 @@ -4,438 +4,550 @@ 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(:,:) :: 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(:,:) :: 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(:,:) :: 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 ! 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 + 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(:,:) :: 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 + 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(:,:) :: 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 + 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 !=================================================================================================== 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%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%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), & + 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%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), & + 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%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), & + 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%rice, & + 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, & + 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%dsfm , & + 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%dsfn , & + 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_zero(microp_st_in,icol_in,nlev_in) !---------------------------------------------------------------------------- - ! Purpose: initialize zm_microp_st variables + ! Purpose: zero out zm_microp_st variables for a single column !---------------------------------------------------------------------------- ! 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 ) :: icol_in ! atmospheric column index + 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 (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%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 + 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%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 + 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%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 + 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_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_gb(microp_st,loc_microp_st,ideep,lengath) +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 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) + 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%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) + 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%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) + 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%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) + 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 !=================================================================================================== 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/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() 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); 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..37a435426fec 100644 --- a/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp +++ b/components/eamxx/src/physics/zm/eamxx_zm_process_interface.cpp @@ -41,16 +41,11 @@ 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(); 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); @@ -105,51 +100,78 @@ 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); + //---------------------------------------------------------------------------- + // 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 variables on the fortran side - zm::zm_eamxx_bridge_init(m_pcol, m_nlev); + zm::zm_eamxx_bridge_init(m_nlev); + } /*------------------------------------------------------------------------------------------------*/ 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); 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& 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(); @@ -171,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_pcol, m_nlev); + 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 @@ -234,60 +241,66 @@ 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; + 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; }); - // 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_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; + 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; }); + } //---------------------------------------------------------------------------- // 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(); 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(); - 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); - }); + 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) = 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); }); } @@ -302,25 +315,24 @@ 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_pcol; - zm_buffer_size+= ZMF::zm_input_state::num_1d_scalr_views * sizeof(Scalar)* m_pcol; - - 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_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_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_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; - 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); + 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; } @@ -332,108 +344,117 @@ 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 = 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; - 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 int num_f_mid = (9+6); + constexpr int num_f_int = (2+3); //---------------------------------------------------------------------------- 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_pcol); - i_mem += int_ptrs[i]->size(); + // device 1D integer variables + ZMF::uview_1d* ptrs_1d_intgr[num_1d_intgr] = { &zm_output.activity }; + for (auto& v : ptrs_1d_intgr) { + *v = ZMF::uview_1d(i_mem, m_ncol); + i_mem += v->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_pcol); - scl_mem += scl_ptrs[i]->size(); + // device 1D scalar scalars + ZMF::uview_1d* ptrs_1d_scalr[num_1d_scalr] = { &zm_input.tpert, + &zm_output.prec, + &zm_output.snow, + &zm_output.cape, + }; + for (auto& v : ptrs_1d_scalr) { + *v = ZMF::uview_1d(scl_mem, m_ncol); + scl_mem += v->size(); } //---------------------------------------------------------------------------- + + // *************************************************************************** + // TEMPORARY + // *************************************************************************** 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_pcol, m_nlev); - r_mem += midlv_f_ptrs[i]->size(); + // 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 (auto& v : ptrs_f_midlv) { + *v = ZMF::uview_2dl(r_mem, m_ncol, m_nlev); + r_mem += v->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_pcol, (m_nlev+1)); - r_mem += intfc_f_ptrs[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 (auto& v : ptrs_f_intfc) { + *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); //---------------------------------------------------------------------------- - // 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_pcol, nlevm_packs); - spk_mem += midlv_c_ptrs[i]->size(); + // device 2D views on mid-point levels + 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, + &zm_output.tend_u, + &zm_output.tend_v, + &zm_output.rain_prod, + &zm_output.snow_prod, + }; + for (auto& v : ptrs_2d_midlv) { + *v = ZMF::uview_2d(spk_mem, m_ncol, nlev_mid_packs); + spk_mem += v->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_pcol, nlevi_packs); - spk_mem += intfc_c_ptrs[i]->size(); + // device 2D views on interface levels + 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 (auto& v : ptrs_2d_intfc) { + *v = ZMF::uview_2d(spk_mem, m_ncol, nlev_int_packs); + spk_mem += v->size(); } //---------------------------------------------------------------------------- Real* total_mem = reinterpret_cast(spk_mem); 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/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..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 @@ -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 @@ -31,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 @@ -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, @@ -57,42 +56,40 @@ 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 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_t .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); zm_output.transpose(ncol,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..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 @@ -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 @@ -58,6 +56,7 @@ subroutine zm_eamxx_bridge_init_c( pcol_in, 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. @@ -76,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 @@ -90,37 +89,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_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) + 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,102 +129,91 @@ 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,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 ! 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 ! 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 + 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 ! 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(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 + + 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(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 ! 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 + real(r8), dimension(ncol,pver) :: ntprprd ! net precip production in layer + real(r8), dimension(ncol,pver) :: ntsnprd ! net snow production in layer ! 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 loc_is_first_step = is_first_step - if (zm_param%zm_microp) then - old_snow = .false. - else - 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_t(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 @@ -244,37 +232,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, eu, du, md, 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 +250,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 +259,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 +284,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 +295,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 +316,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 +326,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 +335,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, & @@ -399,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 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..9c77fc274c69 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; @@ -40,9 +45,10 @@ 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 view_2dh = typename view_2dl::HostMirror; + template using view_1dh = typename view_1d::HostMirror; - // --------------------------------------------------------------------------- + // ----------------------------------------------------------------------------------------------- // Structs struct zm_runtime_opt { @@ -54,24 +60,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_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 - - 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 @@ -81,188 +86,351 @@ 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 - - // 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; + 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; + 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_in, int pver_in) { - auto pverp = pver_in+1; + 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) { - 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}); + // } + } + // ------------------------------------------------------------------------- + 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; + } } - for (int j=0; j 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_s; // 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 [] - + 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 [?] + + // ************************************************************************* + // TEMPORARY + // ************************************************************************* // LayoutLeft views for fortran bridging - uview_2dl f_tend_s; + 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; + 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_in, int pver_in) { - auto pverp = pver_in+1; - if (D == ekat::TransposeDirection::c2f) { - for (int i=0; i(nlev_mid); + auto nlev_int_packs = ekat::npack(nlev_int); if (D == ekat::TransposeDirection::f2c) { - // sync_to_device? - for (int i=0; i>{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); + // } }; + // ------------------------------------------------------------------------- - void init(int ncol_in,int pver_in) { - Real init_fill_value = -999; + 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 - for (int i=0; i