Skip to content

WIP: Updates for RRTMGP v1.9.2 #75

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

Draft
mathomp4 wants to merge 4 commits into
base: develop
Choose a base branch
from
Draft

WIP: Updates for RRTMGP v1.9.2 #75

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
f83386a
Updates for RRTMGP v1.9.2
mathomp4 Aug 20, 2025
95ebd28
Merge branch 'feature/sdrabenh/gcm_v12' into feature/merge-latest-main
mathomp4 Dec 11, 2025
506dad9
Merge branch 'develop' into feature/merge-latest-main
mathomp4 Jun 15, 2026
9b6c7f7
Remove unneeded top_at_1
mathomp4 Jun 15, 2026
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
3 changes: 2 additions & 1 deletion GEOS_RadiationShared/RRTMGP_cmake/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,9 @@ esma_set_this (OVERRIDE RRTMGP)

# These are from RRTMGP
set (RRTMGP_SRCS
rte-frontend/mo_rte_kind.F90
rte-frontend/mo_rte_config.F90
rte-frontend/mo_rte_util_array_validation.F90
rte-kernels/mo_rte_kind.F90
rte-kernels/mo_rte_util_array.F90
rte-kernels/mo_rte_solver_kernels.F90
rte-kernels/mo_optical_props_kernels.F90
Expand All @@ -19,6 +19,7 @@ set (RRTMGP_SRCS
gas-optics/mo_gas_concentrations.F90
gas-optics/mo_gas_optics.F90
rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90
rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90
rrtmgp-frontend/mo_gas_optics_rrtmgp.F90
rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90
extensions/mo_compute_bc.F90
Expand Down
43 changes: 18 additions & 25 deletions GEOSirrad_GridComp/GEOS_IrradGridComp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1459,7 +1459,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
use mo_fluxes_byband, only: ty_fluxes_byband
use mo_rte_lw, only: rte_lw
use mo_load_coefficients, only: load_and_init
use mo_load_cloud_coefficients, only: load_cld_lutcoeff, load_cld_padecoeff
use mo_load_cloud_coefficients, only: load_cld_lutcoeff

! used to avoid a reshaped copy of some arrays in RRTMGP blocking
! (Tom Clune's suggestion)
Expand Down Expand Up @@ -1659,7 +1659,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
class(ty_optical_props_arry), allocatable :: clean_optical_props, dirty_optical_props

! RRTMGP locals
logical :: top_at_1, u2s, partial_block, gen_mro, cond_inhomo
logical :: u2s, partial_block, gen_mro, cond_inhomo
logical :: need_dirty_optical_props, need_cloud_optical_props
logical :: export_clrnoa, export_clrsky, export_allnoa, export_allsky
logical :: calc_clrnoa, calc_clrsky, calc_allnoa, calc_allsky
Expand Down Expand Up @@ -2148,7 +2148,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
TEST_(error_msg)

if (associated( CO2_3d)) &
allocate(CO2_R(IM*JM,LM),__STAT__)
allocate(CO2_R(IM*JM,LM),__STAT__)
allocate( Q_R(IM*JM,LM),__STAT__)
allocate( O3_R(IM*JM,LM),__STAT__)
allocate(N2O_R(IM*JM,LM),__STAT__)
Expand Down Expand Up @@ -2260,11 +2260,6 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
p_lev = real(reshape(PLE ,(/ncol,LM+1/)), kind=wp)
cf_wp = real(reshape(FCLD,(/ncol,LM /)), kind=wp)

! RRTMGP's rte_lw takes a vertical ordering flag
! (no need to flip columns as with RRTMG)
top_at_1 = p_lay(1, 1) < p_lay(1, LM)
_ASSERT(top_at_1, 'unexpected vertical ordering')

! layer pressure thicknesses used for cloud water path calculations
! (do before any KLUGE to top pressure so optical paths wont be affected)
! (also better to use these unKLUGED pressure intervals in t_lev calculation)
Expand Down Expand Up @@ -2515,8 +2510,6 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
call MAPL_TimerOn(MAPL,"---RRTMGP_IO_CLOUDS",__RC__)
if (trim(cloud_optics_type)=='LUT') then
call load_cld_lutcoeff (cloud_optics, cloud_optics_file)
elseif (trim(cloud_optics_type)=='PADE') then
call load_cld_padecoeff(cloud_optics, cloud_optics_file)
else
TEST_('unknown cloud_optics_type: '//trim(cloud_optics_file))
end if
Expand Down Expand Up @@ -2663,7 +2656,7 @@ subroutine LW_Driver(IM,JM,LM,LATS,LONS,RC)
call PROCESS_RRTMGP_LW_BLOCK( &
b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga, &
IM, IM_World, iBeg, jBeg, &
top_at_1, u2s, &
u2s, &
seeds(2), seeds(3), &
cwp_fac, &
need_cloud_optical_props, need_dirty_optical_props, &
Expand Down Expand Up @@ -3626,7 +3619,7 @@ end subroutine compute_lw_gas_optics
!-----------------------------------------------------------------------
subroutine compute_lw_rte( &
colS, colE, ncols_block, LM, nmom, &
top_at_1, u2s, nga, &
u2s, nga, &
calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, &
allnoa_to_allsky_band_xfer_needed, any_band_output, &
export_clrsky, export_allsky, &
Expand All @@ -3652,7 +3645,7 @@ subroutine compute_lw_rte( &
#define TEST_(msg) if (msg /= '') then; write(0,*) trim(msg); VERIFY_(STATUS); end if

integer, intent(in) :: colS, colE, ncols_block, LM, nmom
logical, intent(in) :: top_at_1, u2s
logical, intent(in) :: u2s
integer, intent(in) :: nga
logical, intent(in) :: calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky
logical, intent(in) :: allnoa_to_allsky_band_xfer_needed, any_band_output
Expand Down Expand Up @@ -3688,7 +3681,7 @@ subroutine compute_lw_rte( &
fluxes_clrnoa%flux_up_Jac => dfupdts_clrnoa(colS:colE,:)
error_msg = rte_lw( &
clean_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_clrnoa, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
end if
Expand Down Expand Up @@ -3733,7 +3726,7 @@ subroutine compute_lw_rte( &
fluxes_byband_allnoa%bnd_flux_up_Jac => bnd_dfupdts_allnoa(colS:colE,:,:)
error_msg = rte_lw( &
clean_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_byband_allnoa, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
else
Expand All @@ -3743,7 +3736,7 @@ subroutine compute_lw_rte( &
fluxes_allnoa%flux_up_Jac => dfupdts_allnoa(colS:colE,:)
error_msg = rte_lw( &
clean_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_allnoa, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
endif
Expand All @@ -3765,7 +3758,7 @@ subroutine compute_lw_rte( &
fluxes_clrsky%flux_up_Jac => dfupdts_clrsky(colS:colE,:)
error_msg = rte_lw( &
dirty_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_clrsky, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
end if
Expand All @@ -3786,7 +3779,7 @@ subroutine compute_lw_rte( &
fluxes_byband_allsky%bnd_flux_up_Jac => bnd_dfupdts_allsky(colS:colE,:,:)
error_msg = rte_lw( &
dirty_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_byband_allsky, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
else
Expand All @@ -3795,7 +3788,7 @@ subroutine compute_lw_rte( &
fluxes_allsky%flux_up_Jac => dfupdts_allsky(colS:colE,:)
error_msg = rte_lw( &
dirty_optical_props, &
top_at_1, sources, emis_sfc(:,colS:colE), &
sources, emis_sfc(:,colS:colE), &
fluxes_allsky, n_gauss_angles=nga, use_2stream=u2s)
TEST_(error_msg)
end if
Expand Down Expand Up @@ -3840,7 +3833,7 @@ end subroutine compute_lw_rte
subroutine PROCESS_RRTMGP_LW_BLOCK( &
b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga, &
IM, IM_World, iBeg, jBeg, &
top_at_1, u2s, &
u2s, &
seeds_time_key, seeds_ctr_key, &
cwp_fac, &
need_cloud_optical_props, need_dirty_optical_props, &
Expand Down Expand Up @@ -3872,7 +3865,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( &

integer, intent(in) :: b, rrtmgp_blockSize, ncol, LM, nmom, ngpt, nga
integer, intent(in) :: IM, IM_World, iBeg, jBeg
logical, intent(in) :: top_at_1, u2s
logical, intent(in) :: u2s
integer, intent(in) :: seeds_time_key, seeds_ctr_key
real(wp), intent(in) :: cwp_fac
logical, intent(in) :: need_cloud_optical_props, need_dirty_optical_props
Expand Down Expand Up @@ -3995,7 +3988,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( &
if (need_dirty_optical_props .and. need_cloud_optical_props) then
call compute_lw_rte( &
colS, colE, ncols_block, LM, nmom, &
top_at_1, u2s, nga, &
u2s, nga, &
calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, &
allnoa_to_allsky_band_xfer_needed, any_band_output, &
export_clrsky, export_allsky, &
Expand All @@ -4013,7 +4006,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( &
else if (need_dirty_optical_props) then
call compute_lw_rte( &
colS, colE, ncols_block, LM, nmom, &
top_at_1, u2s, nga, &
u2s, nga, &
calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, &
allnoa_to_allsky_band_xfer_needed, any_band_output, &
export_clrsky, export_allsky, &
Expand All @@ -4030,7 +4023,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( &
else if (need_cloud_optical_props) then
call compute_lw_rte( &
colS, colE, ncols_block, LM, nmom, &
top_at_1, u2s, nga, &
u2s, nga, &
calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, &
allnoa_to_allsky_band_xfer_needed, any_band_output, &
export_clrsky, export_allsky, &
Expand All @@ -4047,7 +4040,7 @@ subroutine PROCESS_RRTMGP_LW_BLOCK( &
else
call compute_lw_rte( &
colS, colE, ncols_block, LM, nmom, &
top_at_1, u2s, nga, &
u2s, nga, &
calc_clrnoa, calc_allnoa, calc_clrsky, calc_allsky, &
allnoa_to_allsky_band_xfer_needed, any_band_output, &
export_clrsky, export_allsky, &
Expand Down
Loading
Loading