Skip to content

Move GPU directives to atmospheric physics for RRTMGP #1461

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
peverwhee wants to merge 2 commits into
base: cam_development
Choose a base branch
from
Open

Move GPU directives to atmospheric physics for RRTMGP #1461

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
fb6bb4d
bring in atmos phys; remove acc directives from radiation.F90
peverwhee Dec 22, 2025
16e94f3
clean up unused code
peverwhee Dec 22, 2025
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
4 changes: 2 additions & 2 deletions .gitmodules
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,8 +28,8 @@

[submodule "atmos_phys"]
path = src/atmos_phys
url = https://github.com/ESCOMP/atmospheric_physics
fxtag = atmos_phys0_20_000
url = https://github.com/peverwhee/atmospheric_physics
fxtag = 87ba8c1a246d6cc20fe1649c7abaebff824dc78c
fxrequired = AlwaysRequired
fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics

Expand Down
2 changes: 1 addition & 1 deletion src/atmos_phys
Open in desktop
Submodule atmos_phys updated 9 files
+9 −0 schemes/rrtmgp/rrtmgp_lw_gas_optics.F90
+2 −0 schemes/rrtmgp/rrtmgp_lw_gas_optics.meta
+14 −0 schemes/rrtmgp/rrtmgp_lw_rte.F90
+1 −0 schemes/rrtmgp/rrtmgp_lw_rte.meta
+3 −0 schemes/rrtmgp/rrtmgp_sw_gas_optics.F90
+2 −0 schemes/rrtmgp/rrtmgp_sw_gas_optics.meta
+9 −0 schemes/rrtmgp/rrtmgp_sw_rte.F90
+5 −4 schemes/rrtmgp/rrtmgp_sw_rte.meta
+53 −0 test/test_suites/suite_rrtmgp_gpu.xml
43 changes: 2 additions & 41 deletions src/physics/rrtmgp/radiation.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -413,7 +413,6 @@ end function radiation_do
subroutine radiation_init(pbuf2d)
use rrtmgp_pre, only: rrtmgp_pre_init
use rrtmgp_inputs_setup, only: rrtmgp_inputs_setup_init
use rrtmgp_inputs_cam, only: rrtmgp_inputs_cam_init
use rrtmgp_cloud_optics_setup, only: rrtmgp_cloud_optics_setup_init
use rrtmgp_sw_solar_var_setup, only: rrtmgp_sw_solar_var_setup_init
use solar_irrad_data, only: do_spctrl_scaling, has_spectrum
Expand Down Expand Up @@ -484,10 +483,6 @@ subroutine radiation_init(pbuf2d)
call endrun(sub//': '//errmsg)
end if

! Set up CAM-side RRTMGP inputs - will go away once SW radiation is CCPPized
call rrtmgp_inputs_cam_init(ktopcam, ktoprad, idx_sw_diag, idx_nir_diag, idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, &
idx_lw_cloudsim)

! Set radconstants module-level index variables that we're setting in CCPP-ized scheme now
call radconstants_init(idx_sw_diag, idx_nir_diag, idx_uv_diag, idx_lw_diag)

Expand Down Expand Up @@ -1264,14 +1259,11 @@ subroutine radiation_tend( &

! Compute the gas optics (stored in atm_optics_sw).
! toa_flux is the reference solar source from RRTMGP data.
!$acc data copyin(kdist_sw%gas_props,pmid_day,pint_day,t_day,gas_concs_sw%gas_concs,atm_optics_sw%optical_props) &
!$acc copyout(toa_flux)
call rrtmgp_sw_gas_optics_run(dosw, 1, nday, nday, pmid_day, pint_day, t_day, &
gas_concs_sw, atm_optics_sw, kdist_sw, toa_flux, errmsg, errflg)
if (errflg /= 0) then
call endrun(sub//': '//errmsg)
end if
!$acc end data

! Scale the solar source
call rrtmgp_sw_solar_var_run(toa_flux, 2, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, &
Expand All @@ -1285,26 +1277,16 @@ subroutine radiation_tend( &
! Set SW aerosol optical properties in the aer_sw object.
! This call made even when no daylight columns because it does some
! diagnostic aerosol output.
call rrtmgp_set_aer_sw( &
icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw)
call rrtmgp_set_aer_sw(ktopcam, ktoprad, icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw)

if (nday > 0) then

! Increment the gas optics (in atm_optics_sw) by the aerosol optics in aer_sw.
!$acc data copyin(coszrs_day, toa_flux, alb_dir, alb_dif, &
!$acc atm_optics_sw%optical_props, atm_optics_sw%optical_props%tau, atm_optics_sw%optical_props%ssa, &
!$acc atm_optics_sw%optical_props%g, aer_sw%optical_props%tau, &
!$acc aer_sw%optical_props, aer_sw%optical_props%ssa, aer_sw%optical_props%g, &
!$acc cloud_sw%optical_props, cloud_sw%optical_props%tau, cloud_sw%optical_props%ssa, &
!$acc cloud_sw%optical_props%g) &
!$acc copy(fswc%fluxes, fswc%fluxes%flux_net,fswc%fluxes%flux_up,fswc%fluxes%flux_dn, &
!$acc fsw%fluxes, fsw%fluxes%flux_net,fsw%fluxes%flux_up,fsw%fluxes%flux_dn)
call rrtmgp_sw_rte_run(dosw, .true., .true., nday, 1, nday, atm_optics_sw, cloud_sw, &
aer_sw, coszrs_day, toa_flux, alb_dir, alb_dif, fswc, fsw, errmsg, errflg)
if (errflg /= 0) then
call endrun(sub//': '//errmsg)
end if
!$acc end data
end if

! Transform RRTMGP outputs to CAM outputs and compute heating rates.
Expand Down Expand Up @@ -1364,45 +1346,24 @@ subroutine radiation_tend( &
end if

! Compute the gas optics and Planck sources.
!$acc data copyin(kdist_lw%gas_props, pmid_rad, pint_rad, t_rad, &
!$acc t_sfc, gas_concs_lw%gas_concs, atm_optics_lw%optical_props) &
!$acc copy(atm_optics_lw%optical_props%tau, &
!$acc sources_lw%sources, sources_lw%sources%lay_source, &
!$acc sources_lw%sources%sfc_source, &
!$acc sources_lw%sources%lev_source, &
!$acc sources_lw%sources%sfc_source_jac)
call rrtmgp_lw_gas_optics_run(dolw, 1, ncol, ncol, pmid_rad, pint_rad, t_rad, &
t_sfc, gas_concs_lw, atm_optics_lw, sources_lw, t_rad, .false., kdist_lw, errmsg, &
errflg)
if (errflg /= 0) then
call endrun(sub//': '//errmsg)
end if
!$acc end data

! Set LW aerosol optical properties in the aer_lw object.
call rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw)
call rrtmgp_set_aer_lw(ktopcam, ktoprad, icall, state, pbuf, aer_lw)

! Call the main rrtmgp_lw driver
!$acc data copyin(atm_optics_lw%optical_props,atm_optics_lw%optical_props%tau, &
!$acc aer_lw%optical_props,aer_lw%optical_props%tau, &
!$acc cloud_lw%optical_props, cloud_lw%optical_props%tau, &
!$acc sources_lw%sources,sources_lw%sources%lay_source, &
!$acc sources_lw%sources%sfc_source, &
!$acc sources_lw%sources%lev_source, &
!$acc sources_lw%sources%sfc_source_jac, &
!$acc emis_sfc) &
!$acc copy(flwc%fluxes, flwc%fluxes%flux_net, flwc%fluxes%flux_up, &
!$acc flwc%fluxes%flux_dn, flw%fluxes, flw%fluxes%flux_net, &
!$acc flw%fluxes%flux_up, flw%fluxes%flux_dn, &
!$acc lw_ds)
call rrtmgp_lw_rte_run(dolw, dolw, .false., .false., .false., &
0, atm_optics_lw, cloud_lw, sources_lw, emis_sfc, &
kdist_lw, aer_lw, fluxlwup_jac, lw_ds, flwc, flw, &
errmsg, errflg)
if (errflg /= 0) then
call endrun(sub//': '//errmsg)
end if
!$acc end data

! Transform RRTMGP outputs to CAM outputs and compute heating rates.
call set_lw_diags()
Expand Down
55 changes: 6 additions & 49 deletions src/physics/rrtmgp/rrtmgp_inputs_cam.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -53,16 +53,6 @@ module rrtmgp_inputs_cam
! This value is to match the arbitrary small value used in RRTMG to decide
! when a quantity is effectively zero.
real(r8), parameter :: tiny = 1.0e-80_r8
real(r8) :: sw_low_bounds(nswbands)
real(r8) :: sw_high_bounds(nswbands)
integer :: ktopcam
integer :: ktoprad
integer :: idx_sw_diag
integer :: idx_nir_diag
integer :: idx_uv_diag
integer :: idx_sw_cloudsim
integer :: idx_lw_diag
integer :: idx_lw_cloudsim

! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using
! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the
Expand All @@ -74,43 +64,6 @@ module rrtmgp_inputs_cam
contains
!==================================================================================================

!==================================================================================================
subroutine rrtmgp_inputs_cam_init(ktcam, ktrad, idx_sw_diag_in, idx_nir_diag_in, idx_uv_diag_in, &
idx_sw_cloudsim_in, idx_lw_diag_in, idx_lw_cloudsim_in)

! Note that this routine must be called after the calls to set_wavenumber_bands which set
! the sw/lw band boundaries in the radconstants module.

integer, intent(in) :: ktcam
integer, intent(in) :: ktrad
integer, intent(in) :: idx_sw_diag_in
integer, intent(in) :: idx_nir_diag_in
integer, intent(in) :: idx_uv_diag_in
integer, intent(in) :: idx_sw_cloudsim_in
integer, intent(in) :: idx_lw_diag_in
integer, intent(in) :: idx_lw_cloudsim_in
character(len=512) :: errmsg
integer :: errflg

ktopcam = ktcam
ktoprad = ktrad
idx_sw_diag = idx_sw_diag_in
idx_nir_diag = idx_nir_diag_in
idx_uv_diag = idx_uv_diag_in
idx_sw_cloudsim = idx_sw_cloudsim_in
idx_lw_diag = idx_lw_diag_in
idx_lw_cloudsim = idx_lw_cloudsim_in

! Initialize the module data containing the SW band boundaries.
call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg)
if (errflg /= 0) then
call endrun('rrtmgp_inputs_cam_init: error during get_sw_spectral_boundaries_ccpp - message: '//errmsg)
end if

end subroutine rrtmgp_inputs_cam_init

!=========================================================================================

subroutine rrtmgp_get_gas_mmrs(icall, state, pbuf, nlay, gas_mmrs)

! Retrieve mass mixing ratios for radiatively active gases from rad_constituents
Expand All @@ -137,11 +90,13 @@ end subroutine rrtmgp_get_gas_mmrs

!==================================================================================================

subroutine rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw)
subroutine rrtmgp_set_aer_lw(ktopcam, ktoprad, icall, state, pbuf, aer_lw)

! Load LW aerosol optical properties into the RRTMGP object.

! Arguments
integer, intent(in) :: ktopcam
integer, intent(in) :: ktoprad
integer, intent(in) :: icall
type(physics_state), target, intent(in) :: state
type(physics_buffer_desc), pointer :: pbuf(:)
Expand Down Expand Up @@ -178,11 +133,13 @@ end subroutine rrtmgp_set_aer_lw
!==================================================================================================

subroutine rrtmgp_set_aer_sw( &
icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw)
ktopcam, ktoprad, icall, state, pbuf, nday, idxday, nnite, idxnite, aer_sw)

! Load SW aerosol optical properties into the RRTMGP object.

! Arguments
integer, intent(in) :: ktopcam
integer, intent(in) :: ktoprad
integer, intent(in) :: icall
type(physics_state), target, intent(in) :: state
type(physics_buffer_desc), pointer :: pbuf(:)
Expand Down
Loading