Skip to content

Commit

Permalink
address review comments
Browse files Browse the repository at this point in the history
  • Loading branch information
brian-eaton committed Feb 13, 2024
1 parent e6f1f70 commit 29da94d
Show file tree
Hide file tree
Showing 14 changed files with 89 additions and 102 deletions.
2 changes: 1 addition & 1 deletion bld/configure
Original file line number Diff line number Diff line change
Expand Up @@ -1077,7 +1077,7 @@ if (defined $opts{'rad'}) {
# the radiation package name in the config_cache file.
if ($rad_pkg eq 'rrtmgp_gpu') {
$use_rrtmgp_gpu = 1;
$rad_pkg =~ s!_gpu!!
$rad_pkg = 'rrtmgp';
}
}

Expand Down
2 changes: 1 addition & 1 deletion src/physics/cam/aer_rad_props.F90
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,7 @@ subroutine aer_rad_props_sw(list_idx, state, pbuf, nnite, idxnite, &

real(r8), intent(out) :: tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
real(r8), intent(out) :: tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * tau * w
real(r8), intent(out) :: tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * tau * w
real(r8), intent(out) :: tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * tau * w

! Local variables
Expand Down
20 changes: 11 additions & 9 deletions src/physics/cam/cloud_rad_props.F90
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,8 @@ module cloud_rad_props
ixcldice, & ! cloud ice water index
ixcldliq ! cloud liquid water index

real(r8), parameter :: tiny = 1.e-80_r8

!==============================================================================
contains
!==============================================================================
Expand Down Expand Up @@ -347,7 +349,7 @@ subroutine get_ice_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f)

real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w

real(r8), pointer :: iciwpth(:,:), dei(:,:)
Expand All @@ -370,7 +372,7 @@ subroutine get_snow_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f)

real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w

real(r8), pointer :: icswpth(:,:), des(:,:)
Expand All @@ -393,7 +395,7 @@ subroutine get_grau_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f)

real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w

real(r8), pointer :: icgrauwpth(:,:), degrau(:,:)
Expand Down Expand Up @@ -433,7 +435,7 @@ subroutine get_liquid_optics_sw(state, pbuf, tau, tau_w, tau_w_g, tau_w_f)

real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w

real(r8), pointer, dimension(:,:) :: lamc, pgam, iclwpth
Expand Down Expand Up @@ -568,7 +570,7 @@ subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, &

real(r8),intent(out) :: tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymetry parameter * tau * w
real(r8),intent(out) :: tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w

type(interp_type) :: dei_wgts
Expand All @@ -578,7 +580,7 @@ subroutine interpolate_ice_optics_sw(ncol, iciwpth, dei, tau, tau_w, &

do k = 1,pver
do i = 1,ncol
if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then
if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then
! if ice water path is too small, OD := 0
tau (:,i,k) = 0._r8
tau_w (:,i,k) = 0._r8
Expand Down Expand Up @@ -626,7 +628,7 @@ subroutine interpolate_ice_optics_lw(ncol, iciwpth, dei, abs_od)
do k = 1,pver
do i = 1,ncol
! if ice water path is too small, OD := 0
if( iciwpth(i,k) < 1.e-80_r8 .or. dei(i,k) == 0._r8) then
if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._r8) then
abs_od (:,i,k) = 0._r8
else
! for each cell interpolate to find weights in g_d_eff grid.
Expand Down Expand Up @@ -659,7 +661,7 @@ subroutine gam_liquid_lw(clwptn, lamc, pgam, abs_od)
type(interp_type) :: mu_wgts
type(interp_type) :: lambda_wgts

if (clwptn < 1.e-80_r8) then
if (clwptn < tiny) then
abs_od = 0._r8
return
endif
Expand Down Expand Up @@ -693,7 +695,7 @@ subroutine gam_liquid_sw(clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f)
type(interp_type) :: mu_wgts
type(interp_type) :: lambda_wgts

if (clwptn < 1.e-80_r8) then
if (clwptn < tiny) then
tau = 0._r8
tau_w = 0._r8
tau_w_g = 0._r8
Expand Down
4 changes: 2 additions & 2 deletions src/physics/cam/cospsimulator_intr.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1107,7 +1107,7 @@ subroutine cospsimulator_intr_init()
flag_xyfill=.true., fill_value=R_UNDEF)
call addfld ('MODIS_fracliq', (/'cosp_scol','lev '/), 'I','1', 'Fraction of tau from liquid water', &
flag_xyfill=.true., fill_value=R_UNDEF)
call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Assymetry parameter (MODIS)', &
call addfld ('MODIS_asym', (/'cosp_scol','lev '/), 'I','1', 'Asymmetry parameter (MODIS)', &
flag_xyfill=.true., fill_value=R_UNDEF)
call addfld ('MODIS_ssa', (/'cosp_scol','lev '/), 'I','1', 'Single-scattering albedo (MODIS)', &
flag_xyfill=.true., fill_value=R_UNDEF)
Expand Down Expand Up @@ -3262,7 +3262,7 @@ subroutine subsample_and_optics(nPoints, nLevels, nColumns, nHydro,overlap,
MODIS_snowSize, cospIN%tau_067, MODIS_opticalThicknessLiq, &
MODIS_opticalThicknessIce, MODIS_opticalThicknessSnow)

! Compute assymetry parameter and single scattering albedo
! Compute asymmetry parameter and single scattering albedo
call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, &
MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, &
MODIS_iceSize*1.0e6_wp, MODIS_opticalThicknessSnow, &
Expand Down
2 changes: 1 addition & 1 deletion src/physics/cam/ebert_curry_ice_optics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ subroutine ec_ice_optics_sw (state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice

real(r8),intent(out) :: ice_tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: ice_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w
real(r8),intent(out) :: ice_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: ice_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w
logical, intent(in) :: oldicewp

Expand Down
2 changes: 1 addition & 1 deletion src/physics/cam/slingo_liq_optics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ subroutine slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, li

real(r8),intent(out) :: liq_tau (nswbands,pcols,pver) ! extinction optical depth
real(r8),intent(out) :: liq_tau_w (nswbands,pcols,pver) ! single scattering albedo * tau
real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! assymetry parameter * tau * w
real(r8),intent(out) :: liq_tau_w_g(nswbands,pcols,pver) ! asymmetry parameter * tau * w
real(r8),intent(out) :: liq_tau_w_f(nswbands,pcols,pver) ! forward scattered fraction * tau * w
logical, intent(in) :: oldliqwp

Expand Down
2 changes: 1 addition & 1 deletion src/physics/camrt/radiation.F90
Original file line number Diff line number Diff line change
Expand Up @@ -877,7 +877,7 @@ subroutine radiation_tend( &
! Aerosol shortwave radiative properties
real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau
real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau

! Aerosol longwave absorption optical depth
Expand Down
6 changes: 3 additions & 3 deletions src/physics/camrt/radsw.F90
Original file line number Diff line number Diff line change
Expand Up @@ -237,7 +237,7 @@ subroutine radcswmx(lchnk ,ncol , &
!
real(r8),intent(in) :: E_aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
real(r8),intent(in) :: E_aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
real(r8),intent(in) :: E_aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau
real(r8),intent(in) :: E_aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau

!
Expand Down Expand Up @@ -288,7 +288,7 @@ subroutine radcswmx(lchnk ,ncol , &
!
real(r8):: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
real(r8):: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
real(r8):: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau
real(r8):: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
real(r8) :: pmid(pcols,pver) ! Level pressure
real(r8) :: pint(pcols,pverp) ! Interface pressure
Expand Down Expand Up @@ -1994,7 +1994,7 @@ subroutine raddedmx(coszrs ,ndayc ,abh2o , &
!
real(r8) trmin ! Minimum total transmission allowed
real(r8) wray ! Rayleigh single scatter albedo
real(r8) gray ! Rayleigh asymetry parameter
real(r8) gray ! Rayleigh asymmetry parameter
real(r8) fray ! Rayleigh forward scattered fraction

parameter (trmin = 1.e-3_r8)
Expand Down
2 changes: 1 addition & 1 deletion src/physics/rrtmg/aer_src/rrtmg_sw_reftra.f90
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ subroutine reftra_sw(nlayers, ncol, lrtchk, pgg, prmuz, ptau, pw, &
! lrtchk = .t. for all layers in clear profile
! lrtchk = .t. for cloudy layers in cloud profile
! = .f. for clear layers in cloud profile
! pgg = assymetry factor
! pgg = asymmetry factor
! prmuz = cosine solar zenith angle
! ptau = optical thickness
! pw = single scattering albedo
Expand Down
14 changes: 7 additions & 7 deletions src/physics/rrtmg/radiation.F90
Original file line number Diff line number Diff line change
Expand Up @@ -806,44 +806,44 @@ subroutine radiation_tend( &
! cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth
real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau
real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w
real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice asymmetry parameter * tau * w
real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w
real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW)

! cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth
real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau
real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w
real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid asymmetry parameter * tau * w
real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w
real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW)

! cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth
real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau
real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau
real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud asymmetry parameter * w * tau
real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau
real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW)

! cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth
real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau
real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w
real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow asymmetry parameter * tau * w
real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w
real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW)

! Add graupel as another snow species.
! cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: grau_tau (nswbands,pcols,pver) ! graupel extinction optical depth
real(r8) :: grau_tau_w (nswbands,pcols,pver) ! graupel single scattering albedo * tau
real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel assymetry parameter * tau * w
real(r8) :: grau_tau_w_g(nswbands,pcols,pver) ! graupel asymmetry parameter * tau * w
real(r8) :: grau_tau_w_f(nswbands,pcols,pver) ! graupel forward scattered fraction * tau * w
real(r8) :: grau_lw_abs (nlwbands,pcols,pver)! graupel absorption optics depth (LW)

! combined cloud radiative parameters are "in cloud" not "in cell"
real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular)
real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth
real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau
real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau
real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud asymmetry parameter * w * tau
real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau
real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW)

Expand All @@ -855,7 +855,7 @@ subroutine radiation_tend( &
! Aerosol radiative properties
real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol asymmetry parameter * w * tau
real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW)

Expand Down
2 changes: 1 addition & 1 deletion src/physics/rrtmg/radsw.F90
Original file line number Diff line number Diff line change
Expand Up @@ -255,7 +255,7 @@ subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , &
! Aerosol radiative property arrays
real(r8) :: tauxar(pcols,0:pver) ! aerosol extinction optical depth
real(r8) :: wa(pcols,0:pver) ! aerosol single scattering albedo
real(r8) :: ga(pcols,0:pver) ! aerosol assymetry parameter
real(r8) :: ga(pcols,0:pver) ! aerosol asymmetry parameter
real(r8) :: fa(pcols,0:pver) ! aerosol forward scattered fraction

! CRM
Expand Down
20 changes: 11 additions & 9 deletions src/physics/rrtmgp/mcica_subcol_gen.F90
Original file line number Diff line number Diff line change
@@ -1,5 +1,14 @@
module mcica_subcol_gen

!----------------------------------------------------------------------------------------
!
! Purpose: Create McICA stochastic arrays for cloud optical properties.
! Input cloud optical properties directly: cloud optical depth, single
! scattering albedo and asymmetry parameter. Output will be stochastic
! arrays of these variables. (longwave scattering is not yet available)
!
! Original code: From RRTMG, with the following copyright notice,
! based on Raisanen et al., QJRMS, 2004:
! --------------------------------------------------------------------------
! | |
! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). |
Expand All @@ -9,15 +18,8 @@ module mcica_subcol_gen
! | (http://www.rtweb.aer.com/) |
! | |
! --------------------------------------------------------------------------

!----------------------------------------------------------------------------------------
!
! Purpose: Create McICA stochastic arrays for cloud optical properties.
! Input cloud optical properties directly: cloud optical depth, single
! scattering albedo and asymmetry parameter. Output will be stochastic
! arrays of these variables. (longwave scattering is not yet available)
!
! Original code: From RRTMG based on Raisanen et al., QJRMS, 2004.
! This code is a refactored version of code originally in the files
! mcica_subcol_gen_lw.F90 and mcica_subcol_gen_sw.F90
!
! Uses the KISS random number generator.
!
Expand Down
4 changes: 2 additions & 2 deletions src/physics/rrtmgp/radconstants.F90
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,8 @@ module radconstants

! Number of bands in SW and LW. These values must match data in the RRTMGP coefficients datasets.
! But they are needed to allocate space in the physics buffer and need to be available before the
! RRTMGP datasets are read. So they are set as parameters here and checked in radiation_init after
! the datasets are read.
! RRTMGP datasets are read. So they are set as parameters here and checked in the
! set_wavenumber_bands subroutine after the datasets are read.
integer, parameter, public :: nswbands = 14
integer, parameter, public :: nlwbands = 16

Expand Down
Loading

0 comments on commit 29da94d

Please sign in to comment.