Skip to content

Commit

Permalink
refactor sw flux calculation
Browse files Browse the repository at this point in the history
  • Loading branch information
@brian-eaton
brian-eaton committed Sep 12, 2023
1 parent f7e2872 commit 79196ad
Show file tree
Hide file tree
Showing 2 changed files with 76 additions and 23 deletions.
6 changes: 6 additions & 0 deletions src/physics/rrtmgp/radconstants.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,9 @@ module radconstants

logical :: wavenumber_boundaries_set = .false.

integer, public, protected :: nswgpts ! # SW gpts
integer, public, protected :: nlwgpts ! # LW gpts

! These are indices to specific bands for diagnostic output and COSP input.
integer, public, protected :: idx_sw_diag = -1 ! band contains 500-nm wave
integer, public, protected :: idx_nir_diag = -1 ! band contains 1000-nm wave
Expand Down Expand Up @@ -88,6 +91,9 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw)
call endrun(sub//': ERROR: '//trim(errmsg))
end if

nswgpts = kdist_sw%get_ngpt()
nlwgpts = kdist_lw%get_ngpt()

! SW band bounds in cm^-1
allocate( values(2,nswbands) )
values = kdist_sw%get_band_lims_wavenumber()
Expand Down
93 changes: 70 additions & 23 deletions src/physics/rrtmgp/radiation.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,10 @@ module radiation

use rrtmgp_inputs, only: rrtmgp_inputs_init

use radconstants, only: nswbands, nlwbands, idx_sw_diag, idx_nir_diag, idx_uv_diag, &
idx_lw_diag, idx_sw_cloudsim, idx_lw_cloudsim, &
nradgas, gasnamelength, gaslist, set_wavenumber_bands
use radconstants, only: nswbands, nlwbands, nswgpts, nlwgpts, idx_sw_diag, &
idx_nir_diag, idx_uv_diag, idx_lw_diag, idx_sw_cloudsim, &
idx_lw_cloudsim, nradgas, gasnamelength, gaslist, &
set_wavenumber_bands

use cloud_rad_props, only: cloud_rad_props_init

Expand Down Expand Up @@ -875,7 +876,11 @@ subroutine radiation_tend( &
use mo_fluxes_byband, only: ty_fluxes_byband

! RRTMGP drivers for flux calculations.
use rrtmgp_driver, only: rte_lw, rte_sw
!++dbg
! use rrtmgp_driver, only: rte_lw, rte_sw
use rrtmgp_driver, only: rte_lw
use mo_rte_sw, only: rte_sw
!--dbg

use radheat, only: radheat_tend

Expand Down Expand Up @@ -1000,13 +1005,17 @@ subroutine radiation_tend( &
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)

! Aerosol radiative properties **N.B.** These are zero-indexed to be on RADIATION GRID (assumes "extra layer" is being added?)
! Aerosol radiative properties **N.B.** These are zero-indexed to accomodate an "extra layer".
! If no extra layer then the 0 index is ignored.
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_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW)

! Set vertical indexing in RRTMGP to be the same as CAM (top to bottom).
logical, parameter :: top_at_1 = .true.

! RRTMGP cloud objects (McICA sampling of cloud optical properties)
type(ty_optical_props_1scl) :: cloud_lw
type(ty_optical_props_2str) :: cloud_sw
Expand All @@ -1017,7 +1026,11 @@ subroutine radiation_tend( &
type(ty_gas_concs) :: gas_concs_lw
type(ty_gas_concs) :: gas_concs_sw

! RRTMGP aerosol objects
! Atmosphere optics. This object contains gas optics, aerosol optics, and cloud optics.
! type(ty_optical_props_1scl) :: gas_optics_lw
type(ty_optical_props_2str) :: atm_optics_sw

! aerosol optics
type(ty_optical_props_1scl) :: aer_lw
type(ty_optical_props_2str) :: aer_sw

Expand All @@ -1031,6 +1044,8 @@ subroutine radiation_tend( &
real(r8) :: fnl(pcols,pverp) ! net longwave flux
real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux

! TOA solar flux computed by RRTMGP (on gpts).
real(r8), allocatable :: toa_flux(:,:)

! for COSP
real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity
Expand Down Expand Up @@ -1172,7 +1187,7 @@ subroutine radiation_tend( &
if (dosw .or. dolw) then

allocate( &
t_sfc(ncol), emis_sfc(nlwbands,ncol), &
t_sfc(ncol), emis_sfc(nlwbands,ncol), toa_flux(nday,nswgpts), &
t_rad(ncol,nlay), pmid_rad(ncol,nlay), pint_rad(ncol,nlay+1), &
t_day(nday,nlay), pmid_day(nday,nlay), pint_day(nday,nlay+1), &
coszrs_day(nday), alb_dir(nswbands,nday), alb_dif(nswbands,nday) )
Expand All @@ -1185,7 +1200,7 @@ subroutine radiation_tend( &
pint_day, coszrs_day, alb_dir, alb_dif)

! Set TSI for RRTMGP to the value from CAM's solar forcing file.
errmsg = kdist_sw%set_tsi(sol_tsi)
errmsg = kdist_sw%set_tsi(sol_tsi*eccf)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR: kdist_sw%set_tsi: '//trim(errmsg))
end if
Expand Down Expand Up @@ -1312,9 +1327,8 @@ subroutine radiation_tend( &
cldfprime, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, c_cld_tau_w_f, &
kdist_sw, cloud_sw)

!
! SHORTWAVE DIAGNOSTICS & OUTPUT
!
! SW cloud diagnostics & output

! cloud optical depth fields for the visible band
rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)
rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:)
Expand Down Expand Up @@ -1353,7 +1367,13 @@ subroutine radiation_tend( &
call endrun(sub//': ERROR: gas_concs_sw%init: '//trim(errmsg))
end if

! Allocate object for aerosol optics.
! Init and allocate arrays in atm optics object.
errmsg = atm_optics_sw%alloc_2str(nday, nlay, kdist_sw)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR: gas_optics_sw%alloc_2str: '//trim(errmsg))
end if

! Init and allocate arrays in aerosol optics object.
errmsg = aer_sw%alloc_2str(nday, nlay, kdist_sw%get_band_lims_wavenumber())
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR: aer_sw%alloc_2str: '//trim(errmsg))
Expand All @@ -1368,8 +1388,15 @@ subroutine radiation_tend( &
icall, state, pbuf, nlay, nday, &
idxday, gas_concs_sw)

! Get aerosol shortwave optical properties. The output optics arrays
! contain an extra top layer set to zero.
! Init atm_optics_sw with gas optics. Also returns TOA solar flux.
errmsg = kdist_sw%gas_optics( &
pmid_day, pint_day, t_day, gas_concs_sw, atm_optics_sw, &
toa_flux)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR: kdist_sw%gas_optics: '//trim(errmsg))
end if

! Get aerosol shortwave optical properties on CAM grid.
call aer_rad_props_sw( &
icall, state, pbuf, nnite, idxnite, &
aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f)
Expand All @@ -1390,17 +1417,37 @@ subroutine radiation_tend( &
!=============================!
! SHORTWAVE flux calculations !
!=============================!

errmsg = rte_sw( &
kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, &
coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, &
fswc, aer_props=aer_sw, tsi_scaling=eccf)

! Aerosols are included in the clear sky calculation.
errmsg = aer_sw%increment(atm_optics_sw)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR in rte_sw: '//trim(errmsg))
call endrun(sub//': ERROR in aer_sw%increment: '//trim(errmsg))
end if

errmsg = rte_sw(&
atm_optics_sw, top_at_1, coszrs_day, toa_flux, &
alb_dir, alb_dif, fswc)

! errmsg = rte_sw( &
! kdist_sw, gas_concs_sw, pmid_day, t_day, pint_day, &
! coszrs_day, alb_dir, alb_dif, cloud_sw, fsw, &
! fswc, aer_props=aer_sw, tsi_scaling=eccf)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR in clear-sky rte_sw: '//trim(errmsg))
end if

! Add cloud optics for all-sky calculation
errmsg = cloud_sw%increment(atm_optics_sw)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR in cloud_sw%increment: '//trim(errmsg))
end if

errmsg = rte_sw(&
atm_optics_sw, top_at_1, coszrs_day, toa_flux, &
alb_dir, alb_dif, fsw)
if (len_trim(errmsg) > 0) then
call endrun(sub//': ERROR in all-sky rte_sw: '//trim(errmsg))
end if
!
! -- shortwave output --
!

! Transform RRTMGP outputs to CAM outputs
! - including fsw (W/m2) -> qrs (J/(kgK))
Expand Down

0 comments on commit 79196ad

Please sign in to comment.