Skip to content

Complete CCPPization of conv_water_4rad #1634

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
jimmielin wants to merge 1 commit into
base: cam_development
Choose a base branch
from
Open

Complete CCPPization of conv_water_4rad #1634

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions bld/configure
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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";
Expand Down
218 changes: 63 additions & 155 deletions src/physics/cam/conv_water.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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')
Expand All @@ -170,46 +169,44 @@ 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 !
! average in emissivity. !
! !
!---------------------------------------------------------------------- !


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(:)

! --------------- !
! 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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 )
Expand Down
Loading