diff --git a/bld/configure b/bld/configure index d89a353e7f..13d02d2696 100755 --- a/bld/configure +++ b/bld/configure @@ -2199,6 +2199,7 @@ sub write_filepath print $fh "$camsrcdir/src/atmos_phys/schemes/bretherton_park\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/beljaars_drag\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/microp_aero\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/cloud_water\n"; # Dynamics package and test utilities print $fh "$camsrcdir/src/dynamics/$dyn\n"; diff --git a/src/physics/cam/conv_water.F90 b/src/physics/cam/conv_water.F90 index fb054c87b1..69e11ea20f 100644 --- a/src/physics/cam/conv_water.F90 +++ b/src/physics/cam/conv_water.F90 @@ -18,7 +18,7 @@ module conv_water use shr_kind_mod, only: r8=>shr_kind_r8 use spmd_utils, only: masterproc use ppgrid, only: pcols, pver, pverp - use physconst, only: gravit, latvap, latice + use physconst, only: gravit use cam_abortutils, only: endrun use perf_mod @@ -37,7 +37,7 @@ module conv_water ! pbuf indices - integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, & + integer :: icwmrsh_idx, icwmrdp_idx, sh_frac_idx, dp_frac_idx, & ast_idx, rei_idx integer :: ixcldice, ixcldliq @@ -145,7 +145,6 @@ subroutine conv_water_init() icwmrsh_idx = pbuf_get_index('ICWMRSH') icwmrdp_idx = pbuf_get_index('ICWMRDP') - fice_idx = pbuf_get_index('FICE') sh_frac_idx = pbuf_get_index('SH_FRAC') dp_frac_idx = pbuf_get_index('DP_FRAC') ast_idx = pbuf_get_index('AST') @@ -170,14 +169,15 @@ end subroutine conv_water_init subroutine conv_water_4rad(state, pbuf) - ! --------------------------------------------------------------------- ! + ! --------------------------------------------------------------------- ! ! Purpose: ! ! Computes grid-box average liquid (and ice) from stratus and cumulus ! ! Just for the purposes of radiation. ! - ! ! + ! ! ! Method: ! ! Extract information about deep+shallow liquid and cloud fraction from ! - ! the physics buffer. ! + ! the physics buffer; the science lives in the portable core ! + ! (convective_cloud_water.F90). ! ! ! ! Author: Rich Neale, August 2006 ! ! October 2006: Allow averaging of liquid to give a linear ! @@ -185,20 +185,21 @@ subroutine conv_water_4rad(state, pbuf) ! ! !---------------------------------------------------------------------- ! - + use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx use physics_types, only: physics_state use cam_history, only: outfld use phys_control, only: phys_getopts - + use convective_cloud_water, only: convective_cloud_water_run + implicit none ! ---------------------- ! ! Input-Output Arguments ! ! ---------------------- ! - + type(physics_state), target, intent(in) :: state ! state variables type(physics_buffer_desc), pointer :: pbuf(:) @@ -206,10 +207,6 @@ subroutine conv_water_4rad(state, pbuf) ! Local Workspace ! ! --------------- ! - real(r8), pointer, dimension(:,:) :: pdel ! Moist pressure difference across layer - real(r8), pointer, dimension(:,:) :: ls_liq ! Large-scale contributions to GBA cloud liq - real(r8), pointer, dimension(:,:) :: ls_ice ! Large-scale contributions to GBA cloud ice - ! Physics buffer fields real(r8), pointer, dimension(:,:) :: ast ! Physical liquid+ice stratus cloud fraction real(r8), pointer, dimension(:,:) :: sh_frac ! Shallow convective cloud fraction @@ -218,7 +215,6 @@ subroutine conv_water_4rad(state, pbuf) real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water - real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio real(r8), pointer, dimension(:,:) :: totg_ice ! Grid box total cloud ice mixing ratio real(r8), pointer, dimension(:,:) :: totg_liq ! Grid box total cloud liquid mixing ratio @@ -228,14 +224,7 @@ subroutine conv_water_4rad(state, pbuf) real(r8) :: tot_ice(pcols,pver) ! Total IC ice real(r8) :: tot_liq(pcols,pver) ! Total IC liquid - integer :: i,k,itim_old ! Lon, lev indices buff stuff. - real(r8) :: cu_icwmr ! Convective water for this grid-box. - real(r8) :: ls_icwmr ! Large-scale water for this grid-box. - real(r8) :: tot_icwmr ! Large-scale water for this grid-box. - real(r8) :: ls_frac ! Large-scale cloud frac for this grid-box. - real(r8) :: tot0_frac, cu0_frac, dp0_frac, sh0_frac - real(r8) :: kabs, kabsi, kabsl, alpha, dp0, sh0, ic_limit - real(r8) :: wrk1 + integer :: itim_old ! Time index buff stuff. real(r8) :: totg_ice_sh(pcols,pver) ! Grid-mean IWP from shallow convective cloud real(r8) :: totg_liq_sh(pcols,pver) ! Grid-mean LWP from shallow convective cloud @@ -246,171 +235,90 @@ subroutine conv_water_4rad(state, pbuf) real(r8) :: frecu(pcols,pver) ! Fractional occurrence of cumulus real(r8) :: fretot(pcols,pver) ! Fractional occurrence of cloud + character(len=512) :: errmsg + integer :: errflg + integer :: lchnk integer :: ncol - ! --------- ! - ! Parameter ! - ! --------- ! - - parameter( kabsl = 0.090361_r8, ic_limit = 1.e-12_r8 ) - character(len=16) :: microp_scheme + character(len=16) :: microp_scheme ncol = state%ncol lchnk = state%lchnk - pdel => state%pdel - ls_liq => state%q(:,:,ixcldliq) - ls_ice => state%q(:,:,ixcldice) ! Get microphysics option call phys_getopts( microp_scheme_out = microp_scheme ) - ! Get convective in-cloud water and ice/water temperature partitioning. + ! Get convective in-cloud water. call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr ) call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr ) - call pbuf_get_field(pbuf, fice_idx, fice ) - ! Get convective in-cloud fraction + ! Get convective in-cloud fraction call pbuf_get_field(pbuf, sh_frac_idx, sh_frac ) call pbuf_get_field(pbuf, dp_frac_idx, dp_frac ) call pbuf_get_field(pbuf, rei_idx, rei ) itim_old = pbuf_old_tim_idx() - call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) ! Fields computed below and stored in pbuf. call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) - ! --------------------------------------------------------------- ! - ! Loop through grid-boxes and determine: ! - ! 1. Effective mean in-cloud convective ice/liquid (deep+shallow) ! - ! 2. Effective mean in-cloud total ice/liquid (ls+convective) ! - ! --------------------------------------------------------------- ! - + ! Zero the diagnostic arrays so columns beyond ncol hold no garbage. + conv_ice(:,:) = 0._r8 + conv_liq(:,:) = 0._r8 + tot_ice(:,:) = 0._r8 + tot_liq(:,:) = 0._r8 + totg_ice_sh(:,:) = 0._r8 + totg_liq_sh(:,:) = 0._r8 + totg_ice_dp(:,:) = 0._r8 + totg_liq_dp(:,:) = 0._r8 fresh(:,:) = 0._r8 fredp(:,:) = 0._r8 frecu(:,:) = 0._r8 fretot(:,:) = 0._r8 - do k = 1, pver - do i = 1, ncol - - if( sh_frac(i,k) <= frac_limit .or. sh_icwmr(i,k) <= ic_limit ) then - sh0_frac = 0._r8 - else - sh0_frac = sh_frac(i,k) - endif - if( dp_frac(i,k) <= frac_limit .or. dp_icwmr(i,k) <= ic_limit ) then - dp0_frac = 0._r8 - else - dp0_frac = dp_frac(i,k) - endif - cu0_frac = sh0_frac + dp0_frac - - ! For the moment calculate the emissivity based upon the ls clouds ice fraction - - wrk1 = min(1._r8,max(0._r8, ls_ice(i,k)/(ls_ice(i,k)+ls_liq(i,k)+1.e-36_r8))) - - if( ( cu0_frac < frac_limit ) .or. ( ( sh_icwmr(i,k) + dp_icwmr(i,k) ) < ic_limit ) ) then - - cu0_frac = 0._r8 - cu_icwmr = 0._r8 - - ls_frac = ast(i,k) - if( ls_frac < frac_limit ) then - ls_frac = 0._r8 - ls_icwmr = 0._r8 - else - ls_icwmr = ( ls_liq(i,k) + ls_ice(i,k) )/max(frac_limit,ls_frac) ! Convert to IC value. - end if - - tot0_frac = ls_frac - tot_icwmr = ls_icwmr - - else - - ! Select radiation constants (effective radii) for emissivity averaging. - - if( microp_scheme == 'RK') then - kabsi = 0.005_r8 + 1._r8/rei(i,k) - else - kabsi = 0.005_r8 + 1._r8/min(max(13._r8,rei(i,k)),130._r8) - endif - kabs = kabsl * ( 1._r8 - wrk1 ) + kabsi * wrk1 - alpha = -1.66_r8*kabs*pdel(i,k)/gravit*1000.0_r8 - - ! Selecting cumulus in-cloud water. - - select case (conv_water_mode) ! Type of average - case (1) ! Area weighted arithmetic average - cu_icwmr = ( sh0_frac * sh_icwmr(i,k) + dp0_frac*dp_icwmr(i,k))/max(frac_limit,cu0_frac) - case (2) - sh0 = exp(alpha*sh_icwmr(i,k)) - dp0 = exp(alpha*dp_icwmr(i,k)) - cu_icwmr = log((sh0_frac*sh0+dp0_frac*dp0)/max(frac_limit,cu0_frac)) - cu_icwmr = cu_icwmr/alpha - case default ! Area weighted 'arithmetic in emissivity' average. -! call endrun ('CONV_WATER_4_RAD: Unknown option for conv_water_in_rad - exiting') - end select - - ! Selecting total in-cloud water. - ! Attribute large-scale/convective area fraction differently from default. - - ls_frac = ast(i,k) - ls_icwmr = (ls_liq(i,k) + ls_ice(i,k))/max(frac_limit,ls_frac) ! Convert to IC value. - tot0_frac = (ls_frac + cu0_frac) - - select case (conv_water_mode) ! Type of average - case (1) ! Area weighted 'arithmetic in emissivity' average - tot_icwmr = (ls_frac*ls_icwmr + cu0_frac*cu_icwmr)/max(frac_limit,tot0_frac) - case (2) - tot_icwmr = log((ls_frac*exp(alpha*ls_icwmr)+cu0_frac*exp(alpha*cu_icwmr))/max(frac_limit,tot0_frac)) - tot_icwmr = tot_icwmr/alpha - case default ! Area weighted 'arithmetic in emissivity' average. -! call endrun ('CONV_WATER_4_RAD: Unknown option for conv_water_in_rad - exiting') - end select - - end if - - ! Repartition convective cloud water into liquid and ice phase. - ! Currently, this partition is made using the ice fraction of stratus condensate. - ! In future, we should use ice fraction explicitly computed from the convection scheme. - - conv_ice(i,k) = cu_icwmr * wrk1 - conv_liq(i,k) = cu_icwmr * (1._r8-wrk1) - - tot_ice(i,k) = tot_icwmr * wrk1 - tot_liq(i,k) = tot_icwmr * (1._r8-wrk1) - - totg_ice(i,k) = tot0_frac * tot_icwmr * wrk1 - totg_liq(i,k) = tot0_frac * tot_icwmr * (1._r8-wrk1) - - ! Grid-mean convective water - totg_ice_sh(i,k) = sh0_frac * sh_icwmr(i,k) * wrk1 - totg_ice_dp(i,k) = dp0_frac * dp_icwmr(i,k) * wrk1 - totg_liq_sh(i,k) = sh0_frac * sh_icwmr(i,k) * (1._r8-wrk1) - totg_liq_dp(i,k) = dp0_frac * dp_icwmr(i,k) * (1._r8-wrk1) - if( sh0_frac > frac_limit ) then - fresh(i,k) = 1._r8 - endif - if( dp0_frac > frac_limit ) then - fredp(i,k) = 1._r8 - endif - if( cu0_frac > frac_limit ) then - frecu(i,k) = 1._r8 - endif - if( tot0_frac > frac_limit ) then - fretot(i,k) = 1._r8 - endif - - end do - end do + call convective_cloud_water_run( & + ncol = ncol, & + pver = pver, & + conv_water_in_rad = conv_water_mode, & + frac_limit = frac_limit, & + one_mom_clouds = (microp_scheme == 'RK'), & + gravit = gravit, & + pdel = state%pdel(:ncol,:), & + ls_liq = state%q(:ncol,:,ixcldliq), & + ls_ice = state%q(:ncol,:,ixcldice), & + sh_icwmr = sh_icwmr(:ncol,:), & + dp_icwmr = dp_icwmr(:ncol,:), & + sh_frac = sh_frac(:ncol,:), & + dp_frac = dp_frac(:ncol,:), & + ast = ast(:ncol,:), & + rei = rei(:ncol,:), & + totg_liq = totg_liq(:ncol,:), & + totg_ice = totg_ice(:ncol,:), & + conv_liq = conv_liq(:ncol,:), & + conv_ice = conv_ice(:ncol,:), & + tot_liq = tot_liq(:ncol,:), & + tot_ice = tot_ice(:ncol,:), & + totg_liq_sh = totg_liq_sh(:ncol,:), & + totg_liq_dp = totg_liq_dp(:ncol,:), & + totg_ice_sh = totg_ice_sh(:ncol,:), & + totg_ice_dp = totg_ice_dp(:ncol,:), & + fresh = fresh(:ncol,:), & + fredp = fredp(:ncol,:), & + frecu = frecu(:ncol,:), & + fretot = fretot(:ncol,:), & + errmsg = errmsg, & + errflg = errflg) + if (errflg /= 0) then + call endrun('conv_water_4rad: '//trim(errmsg)) + end if ! Output convective IC WMRs - + call outfld( 'ICLMRCU ', conv_liq , pcols, lchnk ) call outfld( 'ICIMRCU ', conv_ice , pcols, lchnk ) call outfld( 'ICLMRTOT', tot_liq , pcols, lchnk )