From c8d14085bf17edadfea696c690f776b19e6ddbb1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 6 Mar 2026 23:23:17 -0700 Subject: [PATCH 1/5] add radiation utils tests --- .../rrtmgp_dry_static_energy_tendency.F90 | 4 +- .../rrtmgp_dry_static_energy_tendency.meta | 4 +- test/unit-test/CMakeLists.txt | 14 + test/unit-test/include/interpolate_stub.F90 | 38 ++ test/unit-test/tests/CMakeLists.txt | 1 + test/unit-test/tests/rrtmgp/CMakeLists.txt | 8 + .../rrtmgp/test_calculate_net_heating.pf | 72 +++ .../tests/rrtmgp/test_radiation_tools.pf | 63 +++ .../tests/rrtmgp/test_radiation_utils.pf | 415 ++++++++++++++++++ .../test_rrtmgp_dry_static_energy_tendency.pf | 67 +++ .../rrtmgp/test_rrtmgp_sw_solar_var_setup.pf | 53 +++ 11 files changed, 735 insertions(+), 4 deletions(-) create mode 100644 test/unit-test/include/interpolate_stub.F90 create mode 100644 test/unit-test/tests/rrtmgp/CMakeLists.txt create mode 100644 test/unit-test/tests/rrtmgp/test_calculate_net_heating.pf create mode 100644 test/unit-test/tests/rrtmgp/test_radiation_tools.pf create mode 100644 test/unit-test/tests/rrtmgp/test_radiation_utils.pf create mode 100644 test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf create mode 100644 test/unit-test/tests/rrtmgp/test_rrtmgp_sw_solar_var_setup.pf diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index f2d80ea2..3ab1cfbf 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -37,8 +37,8 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) - real(kind_phys), dimension(:,:), intent(out) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(out) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta index a4b18e5b..2918096c 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta @@ -40,13 +40,13 @@ units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out + intent = inout [ qrl_prime ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out + intent = inout [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/test/unit-test/CMakeLists.txt b/test/unit-test/CMakeLists.txt index c3287718..3bd38a1c 100644 --- a/test/unit-test/CMakeLists.txt +++ b/test/unit-test/CMakeLists.txt @@ -43,6 +43,20 @@ add_library(phys_utils ${PHYS_UTILS_SRC}) target_compile_options(phys_utils PRIVATE -ffree-line-length-none) target_include_directories(phys_utils PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) +set(RRTMGP_SRC + ../../schemes/rrtmgp/utils/radiation_utils.F90 + ../../schemes/rrtmgp/utils/radiation_tools.F90 + ../../schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 + ../../schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 + ../../schemes/rrtmgp/utils/calculate_net_heating.F90 + include/interpolate_stub.F90 + include/ccpp_kinds.F90 +) + +add_library(rrtmgp ${RRTMGP_SRC}) +target_compile_options(rrtmgp PRIVATE -ffree-line-length-none) +target_include_directories(rrtmgp PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) + add_subdirectory(../../schemes/mmm mmm) if(ATMOSPHERIC_PHYSICS_ENABLE_TESTS OR ATMOSPHERIC_PHYSICS_ENABLE_CODE_COVERAGE) diff --git a/test/unit-test/include/interpolate_stub.F90 b/test/unit-test/include/interpolate_stub.F90 new file mode 100644 index 00000000..0ab69362 --- /dev/null +++ b/test/unit-test/include/interpolate_stub.F90 @@ -0,0 +1,38 @@ +module interpolate_data + use ccpp_kinds, only: kind_phys + public :: lininterp_init + public :: lininterp + + integer, public, parameter :: extrap_method_bndry = 1 + public :: interp_type + type interp_type + real(kind_phys), pointer :: wgts(:) + real(kind_phys), pointer :: wgtn(:) + integer, pointer :: jjm(:) + integer, pointer :: jjp(:) + end type interp_type + +contains + subroutine lininterp_init(yin, nin, yout, nout, extrap_method, interp_wgts) + integer, intent(in) :: nin + integer, intent(in) :: nout + real(kind_phys), intent(in) :: yin(:) ! input mesh + real(kind_phys), intent(in) :: yout(:) ! output mesh + integer, intent(in) :: extrap_method ! if 0 set values outside output grid to 0 + ! if 1 set to boundary value + ! if 2 set to cyclic boundaries + type (interp_type), intent(out) :: interp_wgts + + ! routine is a stub + end subroutine lininterp_init + + subroutine lininterp(arrin, nin, arrout, nout, interp_wgts) + integer, intent(in) :: nin, nout + real(kind_phys), intent(in) :: arrin(nin) + real(kind_phys), intent(out) :: arrout(nout) + type (interp_type) :: interp_wgts + + ! routine is a stub + end subroutine lininterp + +end module interpolate_data diff --git a/test/unit-test/tests/CMakeLists.txt b/test/unit-test/tests/CMakeLists.txt index d425a177..fef290f7 100644 --- a/test/unit-test/tests/CMakeLists.txt +++ b/test/unit-test/tests/CMakeLists.txt @@ -1,3 +1,4 @@ add_subdirectory(utilities) add_subdirectory(phys_utils) add_subdirectory(mmm) +add_subdirectory(rrtmgp) diff --git a/test/unit-test/tests/rrtmgp/CMakeLists.txt b/test/unit-test/tests/rrtmgp/CMakeLists.txt new file mode 100644 index 00000000..e8cc21fe --- /dev/null +++ b/test/unit-test/tests/rrtmgp/CMakeLists.txt @@ -0,0 +1,8 @@ +add_pfunit_ctest(rrtmgp_tests + TEST_SOURCES test_radiation_utils.pf + TEST_SOURCES test_radiation_tools.pf + TEST_SOURCES test_rrtmgp_sw_solar_var_setup.pf + TEST_SOURCES test_rrtmgp_dry_static_energy_tendency.pf + TEST_SOURCES test_calculate_net_heating.pf + LINK_LIBRARIES rrtmgp +) diff --git a/test/unit-test/tests/rrtmgp/test_calculate_net_heating.pf b/test/unit-test/tests/rrtmgp/test_calculate_net_heating.pf new file mode 100644 index 00000000..b360190e --- /dev/null +++ b/test/unit-test/tests/rrtmgp/test_calculate_net_heating.pf @@ -0,0 +1,72 @@ +@test +subroutine calculate_net_heating() + use funit + use ccpp_kinds, only: kind_phys + use calculate_net_heating, only: calculate_net_heating_run + + integer :: errflg, ncol + character(len=512) :: errmsg + real(kind_phys) :: qrl(1,2), qrs(1,2) + real(kind_phys) :: qrl_prime(1,2), qrs_prime(1,2) + real(kind_phys) :: fsns(1), fsnt(1), flns(1), flnt(1) + real(kind_phys) :: rad_heat(1,2) + real(kind_phys) :: net_flx(1) + + qrl_prime(1,1) = 10._kind_phys + qrl_prime(1,2) = 20._kind_phys + qrs_prime(1,1) = 30._kind_phys + qrs_prime(1,2) = 40._kind_phys + fsns(1) = 1._kind_phys + fsnt(1) = 2._kind_phys + flns(1) = 3._kind_phys + flnt(1) = 4._kind_phys + ncol = 1 + + call calculate_net_heating_run(ncol, qrl_prime, qrs_prime, & + .false., fsns, fsnt, flns, flnt, rad_heat, & + net_flx, errmsg, errflg) + + @assertEqual('', errmsg) + @assertEqual(0, errflg) + @assertEqual(40._kind_phys, rad_heat(1,1)) + @assertEqual(60._kind_phys, rad_heat(1,2)) + @assertEqual(0._kind_phys, net_flx(1)) + +end subroutine calculate_net_heating + +@test +subroutine calculate_net_heating_offline() + use funit + use ccpp_kinds, only: kind_phys + use calculate_net_heating, only: calculate_net_heating_run + + integer :: errflg, ncol + character(len=512) :: errmsg + real(kind_phys) :: qrl(1,2), qrs(1,2) + real(kind_phys) :: qrl_prime(1,2), qrs_prime(1,2) + real(kind_phys) :: fsns(1), fsnt(1), flns(1), flnt(1) + real(kind_phys) :: rad_heat(1,2) + real(kind_phys) :: net_flx(1) + + qrl_prime(1,1) = 10._kind_phys + qrl_prime(1,2) = 20._kind_phys + qrs_prime(1,1) = 30._kind_phys + qrs_prime(1,2) = 40._kind_phys + fsns(1) = 1._kind_phys + fsnt(1) = 2._kind_phys + flns(1) = 3._kind_phys + flnt(1) = 4._kind_phys + ncol = 1 + rad_heat = 0._kind_phys + + call calculate_net_heating_run(ncol, qrl_prime, qrs_prime, & + .true., fsns, fsnt, flns, flnt, rad_heat, & + net_flx, errmsg, errflg) + + @assertEqual('', errmsg) + @assertEqual(0, errflg) + @assertEqual(0._kind_phys, rad_heat(1,1)) + @assertEqual(0._kind_phys, rad_heat(1,2)) + @assertEqual(0._kind_phys, net_flx(1)) + +end subroutine calculate_net_heating_offline diff --git a/test/unit-test/tests/rrtmgp/test_radiation_tools.pf b/test/unit-test/tests/rrtmgp/test_radiation_tools.pf new file mode 100644 index 00000000..8abff542 --- /dev/null +++ b/test/unit-test/tests/rrtmgp/test_radiation_tools.pf @@ -0,0 +1,63 @@ +@test +subroutine tlev_topat1() + use funit + use ccpp_kinds, only: kind_phys + use radiation_tools, only: cmp_tlev + + integer :: ncol, nlev + real(kind_phys) :: minp + real(kind_phys) :: tsfc(1) + real(kind_phys) :: p_lay(1,2), t_lay(1,2) + real(kind_phys) :: p_lev(1,3), t_lev(1,3) + + ncol = 1 + nlev = 2 + + tsfc = 300._kind_phys + minp = 20._kind_phys + p_lev(1,1) = 10._kind_phys + p_lev(1,2) = 30._kind_phys + p_lev(1,3) = 50._kind_phys + t_lay(1,1) = 280._kind_phys + t_lay(1,2) = 290._kind_phys + p_lay(1,1) = 12._kind_phys + p_lay(1,2) = 35._kind_phys + + call cmp_tlev(ncol,nlev,minp,p_lay,t_lay,p_lev,tsfc,t_lev) + + @assertEqual(280._kind_phys, t_lev(1,1)) + @assertEqual(288.55993351768552_kind_phys, t_lev(1,2)) + @assertEqual(300._kind_phys, t_lev(1,3)) +end subroutine tlev_topat1 + +@test +subroutine tlev_bottomat1() + use funit + use ccpp_kinds, only: kind_phys + use radiation_tools, only: cmp_tlev + + integer :: ncol, nlev + real(kind_phys) :: minp + real(kind_phys) :: tsfc(1) + real(kind_phys) :: p_lay(1,2), t_lay(1,2) + real(kind_phys) :: p_lev(1,3), t_lev(1,3) + + ncol = 1 + nlev = 2 + + tsfc = 300._kind_phys + minp = 20._kind_phys + p_lev(1,3) = 10._kind_phys + p_lev(1,2) = 30._kind_phys + p_lev(1,1) = 50._kind_phys + t_lay(1,2) = 280._kind_phys + t_lay(1,1) = 290._kind_phys + p_lay(1,2) = 12._kind_phys + p_lay(1,1) = 35._kind_phys + + call cmp_tlev(ncol,nlev,minp,p_lay,t_lay,p_lev,tsfc,t_lev) + + @assertEqual(300._kind_phys, t_lev(1,1)) + @assertEqual(288.55993351768552_kind_phys, t_lev(1,2)) + @assertEqual(280._kind_phys, t_lev(1,3)) +end subroutine tlev_bottomat1 diff --git a/test/unit-test/tests/rrtmgp/test_radiation_utils.pf b/test/unit-test/tests/rrtmgp/test_radiation_utils.pf new file mode 100644 index 00000000..35ceac7f --- /dev/null +++ b/test/unit-test/tests/rrtmgp/test_radiation_utils.pf @@ -0,0 +1,415 @@ +@before +subroutine setup_radiation_utils_test() + use radiation_utils, only: radiation_utils_init + use ccpp_kinds, only : kind_phys + integer :: nswbands, nlwbands, errflg + real(kind_phys) :: low_shortwave(2) = (/ 1e-4_kind_phys, 1e-3_kind_phys /) + real(kind_phys) :: high_shortwave(2) = (/ 2e-4_kind_phys, 2e-3_kind_phys /) + real(kind_phys) :: low_longwave(1) = (/ 1e-2_kind_phys /) + real(kind_phys) :: high_longwave(1) = (/ 2e-3_kind_phys /) + character(len=512) :: errmsg + + nswbands = 2 + nlwbands = 1 + + call radiation_utils_init(nswbands, nlwbands, low_shortwave, high_shortwave, & + low_longwave, high_longwave, errmsg, errflg) +end subroutine setup_radiation_utils_test + +@test +subroutine get_sw_boundaries_invcm() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'cm-1', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(1e-4_kind_phys, low_shortwave(1)) + @assertEqual(1e-3_kind_phys, low_shortwave(2)) + @assertEqual(2e-4_kind_phys, high_shortwave(1)) + @assertEqual(2e-3_kind_phys, high_shortwave(2)) + +end subroutine get_sw_boundaries_invcm + +@test +subroutine get_sw_boundaries_m() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'meters', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e1_kind_phys, low_shortwave(1)) + @assertEqual(5._kind_phys, low_shortwave(2)) + @assertEqual(1e2_kind_phys, high_shortwave(1)) + @assertEqual(1e1_kind_phys, high_shortwave(2)) + +end subroutine get_sw_boundaries_m + +@test +subroutine get_sw_boundaries_nm() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'nanometer', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e10_kind_phys, low_shortwave(1)) + @assertEqual(5e9_kind_phys, low_shortwave(2)) + @assertEqual(1e11_kind_phys, high_shortwave(1)) + @assertEqual(1e10_kind_phys, high_shortwave(2)) + +end subroutine get_sw_boundaries_nm + +@test +subroutine get_sw_boundaries_um() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'um', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e7_kind_phys, low_shortwave(1)) + @assertEqual(5e6_kind_phys, low_shortwave(2)) + @assertEqual(1e8_kind_phys, high_shortwave(1)) + @assertEqual(1e7_kind_phys, high_shortwave(2)) + +end subroutine get_sw_boundaries_um + +@test +subroutine get_sw_boundaries_cm() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'centimeters', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e3_kind_phys, low_shortwave(1)) + @assertEqual(5e2_kind_phys, low_shortwave(2)) + @assertEqual(1e4_kind_phys, high_shortwave(1)) + @assertEqual(1e3_kind_phys, high_shortwave(2)) + +end subroutine get_sw_boundaries_cm + +@test +subroutine get_sw_boundaries_invalid_units() + use funit + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_shortwave(2) + real(kind_phys) :: high_shortwave(2) + character(len=512) :: errmsg + + call get_sw_spectral_boundaries_ccpp(low_shortwave, high_shortwave, 'decimeters', errmsg, errflg) + + @assertEqual(1, errflg) + @assertEqual('get_sw_spectral_boundaries_ccpp: ERROR, requested spectral units not recognized: decimeters', trim(errmsg)) + +end subroutine get_sw_boundaries_invalid_units + +@test +subroutine get_lw_boundaries_invcm() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'cm^-1', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(1e-2_kind_phys, low_longwave(1)) + @assertEqual(2e-3_kind_phys, high_longwave(1)) + +end subroutine get_lw_boundaries_invcm + +@test +subroutine get_lw_boundaries_m() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'meters', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5._kind_phys, low_longwave(1)) + @assertEqual(1._kind_phys, high_longwave(1)) + +end subroutine get_lw_boundaries_m + +@test +subroutine get_lw_boundaries_nm() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'nanometer', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e9_kind_phys, low_longwave(1)) + @assertEqual(1e9_kind_phys, high_longwave(1)) + +end subroutine get_lw_boundaries_nm + +@test +subroutine get_lw_boundaries_um() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'um', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e6_kind_phys, low_longwave(1)) + @assertEqual(1e6_kind_phys, high_longwave(1)) + +end subroutine get_lw_boundaries_um + +@test +subroutine get_lw_boundaries_cm() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'centimeters', errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(5e2_kind_phys, low_longwave(1)) + @assertEqual(1e2_kind_phys, high_longwave(1)) + +end subroutine get_lw_boundaries_cm + +@test +subroutine get_lw_boundaries_invalid_units() + use funit + use radiation_utils, only : get_lw_spectral_boundaries_ccpp + use ccpp_kinds, only : kind_phys + + integer :: errflg + real(kind_phys) :: low_longwave(1) + real(kind_phys) :: high_longwave(1) + character(len=512) :: errmsg + + call get_lw_spectral_boundaries_ccpp(low_longwave, high_longwave, 'km', errmsg, errflg) + + @assertEqual(1, errflg) + @assertEqual('get_lw_spectral_boundaries_ccpp: ERROR, requested spectral units not recognized: km', errmsg) + +end subroutine get_lw_boundaries_invalid_units + +@test +subroutine get_molar_mass_ratio_h2o() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('H2O', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(1.607793_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_h2o + +@test +subroutine get_molar_mass_ratio_co2() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('CO2', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.658114_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_co2 + +@test +subroutine get_molar_mass_ratio_o3() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('O3', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.603428_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_o3 + +@test +subroutine get_molar_mass_ratio_ch4() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('CH4', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(1.805423_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_ch4 + +@test +subroutine get_molar_mass_ratio_n2o() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('N2O', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.658090_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_n2o + +@test +subroutine get_molar_mass_ratio_o2() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('O2', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.905140_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_o2 + +@test +subroutine get_molar_mass_ratio_cfc11() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('CFC11', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.210852_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_cfc11 + +@test +subroutine get_molar_mass_ratio_cfc12() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('CFC12', mass_ratio, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0.239546_kind_phys, mass_ratio) +end subroutine get_molar_mass_ratio_cfc12 + +@test +subroutine get_molar_mass_ratio_invalid() + use funit + use radiation_utils, only: get_molar_mass_ratio + use ccpp_kinds, only: kind_phys + + integer :: errflg + real(kind_phys) :: mass_ratio + character(len=512) :: errmsg + + call get_molar_mass_ratio('N2', mass_ratio, errmsg, errflg) + + @assertEqual(1, errflg) + @assertEqual('get_molar_mass_ratio: Invalid gas: N2', errmsg) +end subroutine get_molar_mass_ratio_invalid diff --git a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf new file mode 100644 index 00000000..7d000039 --- /dev/null +++ b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf @@ -0,0 +1,67 @@ +@test +subroutine dry_static_energy_run() + use funit + use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run + use ccpp_kinds, only: kind_phys + + real(kind_phys) :: pdel(2,1) + real(kind_phys) :: qrs(2,1) + real(kind_phys) :: qrl(2,1) + real(kind_phys) :: qrs_prime(2,1) + real(kind_phys) :: qrl_prime(2,1) + integer :: errflg + character(len=512) :: errmsg + + qrs(1,:) = 1._kind_phys + qrs(2,:) = 2._kind_phys + + qrl(1,:) = 2._kind_phys + qrl(2,:) = 1._kind_phys + + pdel = 1e-2_kind_phys + + call rrtmgp_dry_static_energy_tendency_run(pdel, .true., .true., qrs, qrl, & + qrs_prime, qrl_prime, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(100._kind_phys, qrs_prime(1,1)) + @assertEqual(200._kind_phys, qrs_prime(2,1)) + @assertEqual(200._kind_phys, qrl_prime(1,1)) + @assertEqual(100._kind_phys, qrl_prime(2,1)) +end subroutine dry_static_energy_run + +@test +subroutine dry_static_energy_no_sw() + use funit + use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run + use ccpp_kinds, only: kind_phys + + real(kind_phys) :: pdel(2,1) + real(kind_phys) :: qrs(2,1) + real(kind_phys) :: qrl(2,1) + real(kind_phys) :: qrs_prime(2,1) + real(kind_phys) :: qrl_prime(2,1) + integer :: errflg + character(len=512) :: errmsg + + qrs(1,:) = 1._kind_phys + qrs(2,:) = 2._kind_phys + + qrl(1,:) = 2._kind_phys + qrl(2,:) = 1._kind_phys + + pdel = 1e-2_kind_phys + qrs_prime = 0._kind_phys + + call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .true., qrs, qrl, & + qrs_prime, qrl_prime, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(0._kind_phys, qrs_prime(1,1)) + @assertEqual(0._kind_phys, qrs_prime(2,1)) + @assertEqual(200._kind_phys, qrl_prime(1,1)) + @assertEqual(100._kind_phys, qrl_prime(2,1)) + +end subroutine dry_static_energy_no_sw diff --git a/test/unit-test/tests/rrtmgp/test_rrtmgp_sw_solar_var_setup.pf b/test/unit-test/tests/rrtmgp/test_rrtmgp_sw_solar_var_setup.pf new file mode 100644 index 00000000..87f87063 --- /dev/null +++ b/test/unit-test/tests/rrtmgp/test_rrtmgp_sw_solar_var_setup.pf @@ -0,0 +1,53 @@ +@before +subroutine setup_rrtmgp_solar_var_setup_test() + use radiation_utils, only: radiation_utils_init + use ccpp_kinds, only : kind_phys + integer :: nswbands, nlwbands, errflg + real(kind_phys) :: low_shortwave(2) = (/ 1e-4_kind_phys, 1e-3_kind_phys /) + real(kind_phys) :: high_shortwave(2) = (/ 2e-4_kind_phys, 2e-3_kind_phys /) + real(kind_phys) :: low_longwave(1) = (/ 1e-2_kind_phys /) + real(kind_phys) :: high_longwave(1) = (/ 2e-3_kind_phys /) + character(len=512) :: errmsg + + nswbands = 2 + nlwbands = 1 + + call radiation_utils_init(nswbands, nlwbands, low_shortwave, high_shortwave, & + low_longwave, high_longwave, errmsg, errflg) +end subroutine setup_rrtmgp_solar_var_setup_test + +@test +subroutine rrtmgp_sw_solar_var_setup_init_invalid() + use funit + use rrtmgp_sw_solar_var_setup, only: rrtmgp_sw_solar_var_setup_init + use ccpp_kinds, only : kind_phys + integer :: nswbands, errflg + character(len=512) :: errmsg + + nswbands = 2 + + call rrtmgp_sw_solar_var_setup_init(nswbands, .true., .false., errmsg, errflg) + + @assertEqual(1, errflg) + @assertEqual('rrtmgp_sw_solar_var_setup_init: solar input fil must have irradiance spectrum', errmsg) + +end subroutine rrtmgp_sw_solar_var_setup_init_invalid + +@test +subroutine rrtmgp_sw_solar_var_setup_init_valid() + use funit + use rrtmgp_sw_solar_var_setup, only: rrtmgp_sw_solar_var_setup_init + use rrtmgp_sw_solar_var_setup, only: irrad, radbinmax, radbinmin + use ccpp_kinds, only : kind_phys + integer :: nswbands, errflg + character(len=512) :: errmsg + + nswbands = 2 + + call rrtmgp_sw_solar_var_setup_init(nswbands, .true., .true., errmsg, errflg) + @assertEqual(1e11_kind_phys, radbinmax(1)) + @assertEqual(1e10_kind_phys, radbinmax(2)) + @assertEqual(5e10_kind_phys, radbinmin(1)) + @assertEqual(5e9_kind_phys, radbinmin(2)) + +end subroutine rrtmgp_sw_solar_var_setup_init_valid From d34455dfd0fbfaaf10842cae395812e1ea6660df Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 7 Mar 2026 10:36:22 -0700 Subject: [PATCH 2/5] cleanup and add two more tests --- .../rrtmgp_dry_static_energy_tendency.F90 | 4 +- .../test_rrtmgp_dry_static_energy_tendency.pf | 71 +++++++++++++++++++ 2 files changed, 73 insertions(+), 2 deletions(-) diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index 3ab1cfbf..d0a06b8f 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -37,8 +37,8 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf index 7d000039..0a1a6c7e 100644 --- a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf +++ b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf @@ -65,3 +65,74 @@ subroutine dry_static_energy_no_sw() @assertEqual(100._kind_phys, qrl_prime(2,1)) end subroutine dry_static_energy_no_sw + +@test +subroutine dry_static_energy_no_lw() + use funit + use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run + use ccpp_kinds, only: kind_phys + + real(kind_phys) :: pdel(2,1) + real(kind_phys) :: qrs(2,1) + real(kind_phys) :: qrl(2,1) + real(kind_phys) :: qrs_prime(2,1) + real(kind_phys) :: qrl_prime(2,1) + integer :: errflg + character(len=512) :: errmsg + + qrs(1,:) = 1._kind_phys + qrs(2,:) = 2._kind_phys + + qrl(1,:) = 2._kind_phys + qrl(2,:) = 1._kind_phys + + pdel = 1e-2_kind_phys + qrl_prime = 0._kind_phys + + call rrtmgp_dry_static_energy_tendency_run(pdel, .true., .false., qrs, qrl, & + qrs_prime, qrl_prime, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(100._kind_phys, qrs_prime(1,1)) + @assertEqual(200._kind_phys, qrs_prime(2,1)) + @assertEqual(0._kind_phys, qrl_prime(1,1)) + @assertEqual(0._kind_phys, qrl_prime(2,1)) + +end subroutine dry_static_energy_no_lw + +@test +subroutine dry_static_energy_no_sw_or_lw() + use funit + use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run + use ccpp_kinds, only: kind_phys + + real(kind_phys) :: pdel(2,1) + real(kind_phys) :: qrs(2,1) + real(kind_phys) :: qrl(2,1) + real(kind_phys) :: qrs_prime(2,1) + real(kind_phys) :: qrl_prime(2,1) + integer :: errflg + character(len=512) :: errmsg + + qrs(1,:) = 1._kind_phys + qrs(2,:) = 2._kind_phys + + qrl(1,:) = 2._kind_phys + qrl(2,:) = 1._kind_phys + + pdel = 1e-2_kind_phys + qrl_prime = 0._kind_phys + qrs_prime = 1._kind_phys + + call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .false., qrs, qrl, & + qrs_prime, qrl_prime, errmsg, errflg) + + @assertEqual(0, errflg) + @assertEqual('', errmsg) + @assertEqual(1._kind_phys, qrs_prime(1,1)) + @assertEqual(1._kind_phys, qrs_prime(2,1)) + @assertEqual(0._kind_phys, qrl_prime(1,1)) + @assertEqual(0._kind_phys, qrl_prime(2,1)) + +end subroutine dry_static_energy_no_sw_or_lw From d3bbc6f2a293aa70b605bf79bfd35f2b7be7b388 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 9 Mar 2026 09:58:46 -0600 Subject: [PATCH 3/5] initialize dry static energies; update tests accordingly --- .../rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 | 7 +++++-- .../rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta | 4 ++-- .../rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf | 8 ++------ 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index d0a06b8f..239c6662 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -37,8 +37,8 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrl_prime ! longwave heating rate (J kg-1 s-1) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -48,6 +48,9 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea errmsg = '' errflg = 0 + qrs_prime = 0._kind_phys + qrl_prime = 0._kind_phys + if (calc_sw_heat) then qrs_prime(:,:) = qrs(:,:) / pdel(:,:) end if diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta index 2918096c..a4b18e5b 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta @@ -40,13 +40,13 @@ units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = inout + intent = out [ qrl_prime ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = inout + intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf index 0a1a6c7e..a916aa58 100644 --- a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf +++ b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf @@ -52,7 +52,6 @@ subroutine dry_static_energy_no_sw() qrl(2,:) = 1._kind_phys pdel = 1e-2_kind_phys - qrs_prime = 0._kind_phys call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .true., qrs, qrl, & qrs_prime, qrl_prime, errmsg, errflg) @@ -87,7 +86,6 @@ subroutine dry_static_energy_no_lw() qrl(2,:) = 1._kind_phys pdel = 1e-2_kind_phys - qrl_prime = 0._kind_phys call rrtmgp_dry_static_energy_tendency_run(pdel, .true., .false., qrs, qrl, & qrs_prime, qrl_prime, errmsg, errflg) @@ -122,16 +120,14 @@ subroutine dry_static_energy_no_sw_or_lw() qrl(2,:) = 1._kind_phys pdel = 1e-2_kind_phys - qrl_prime = 0._kind_phys - qrs_prime = 1._kind_phys call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .false., qrs, qrl, & qrs_prime, qrl_prime, errmsg, errflg) @assertEqual(0, errflg) @assertEqual('', errmsg) - @assertEqual(1._kind_phys, qrs_prime(1,1)) - @assertEqual(1._kind_phys, qrs_prime(2,1)) + @assertEqual(0._kind_phys, qrs_prime(1,1)) + @assertEqual(0._kind_phys, qrs_prime(2,1)) @assertEqual(0._kind_phys, qrl_prime(1,1)) @assertEqual(0._kind_phys, qrl_prime(2,1)) From 58bcd8de0de48bbbd52b403869186dfd3334ad2a Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 9 Mar 2026 10:54:21 -0600 Subject: [PATCH 4/5] switch back to inout variables instead of overriding to 0 --- .../rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 | 7 ++----- .../rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta | 4 ++-- .../rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf | 9 +++++++-- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index 239c6662..68954f30 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -37,8 +37,8 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) - real(kind_phys), dimension(:,:), intent(out) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(out) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -48,9 +48,6 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea errmsg = '' errflg = 0 - qrs_prime = 0._kind_phys - qrl_prime = 0._kind_phys - if (calc_sw_heat) then qrs_prime(:,:) = qrs(:,:) / pdel(:,:) end if diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta index a4b18e5b..2918096c 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta @@ -40,13 +40,13 @@ units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out + intent = inout [ qrl_prime ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out + intent = inout [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf index a916aa58..d32681ff 100644 --- a/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf +++ b/test/unit-test/tests/rrtmgp/test_rrtmgp_dry_static_energy_tendency.pf @@ -52,6 +52,7 @@ subroutine dry_static_energy_no_sw() qrl(2,:) = 1._kind_phys pdel = 1e-2_kind_phys + qrs_prime = 0._kind_phys call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .true., qrs, qrl, & qrs_prime, qrl_prime, errmsg, errflg) @@ -84,6 +85,7 @@ subroutine dry_static_energy_no_lw() qrl(1,:) = 2._kind_phys qrl(2,:) = 1._kind_phys + qrl_prime = 0._kind_phys pdel = 1e-2_kind_phys @@ -121,6 +123,9 @@ subroutine dry_static_energy_no_sw_or_lw() pdel = 1e-2_kind_phys + qrs_prime = 0._kind_phys + qrl_prime = 1._kind_phys + call rrtmgp_dry_static_energy_tendency_run(pdel, .false., .false., qrs, qrl, & qrs_prime, qrl_prime, errmsg, errflg) @@ -128,7 +133,7 @@ subroutine dry_static_energy_no_sw_or_lw() @assertEqual('', errmsg) @assertEqual(0._kind_phys, qrs_prime(1,1)) @assertEqual(0._kind_phys, qrs_prime(2,1)) - @assertEqual(0._kind_phys, qrl_prime(1,1)) - @assertEqual(0._kind_phys, qrl_prime(2,1)) + @assertEqual(1._kind_phys, qrl_prime(1,1)) + @assertEqual(1._kind_phys, qrl_prime(2,1)) end subroutine dry_static_energy_no_sw_or_lw From a24e0fab49e0fd85ab49eea0292f43d9606f29ec Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 9 Mar 2026 11:06:21 -0600 Subject: [PATCH 5/5] add comments to describe the calculation of dry static energy tendency in rrtmgp --- .../rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index 68954f30..7740049d 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -37,8 +37,8 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrl_prime ! longwave heating rate (J kg-1 s-1) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -48,10 +48,16 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea errmsg = '' errflg = 0 + ! calc_sw_heat is .true. iff dosw is .false. + ! If dosw is true, use that value calculated in rrtmgp_sw_calculate_heating_rate_run + ! If dosw is false, perform this calculation if (calc_sw_heat) then qrs_prime(:,:) = qrs(:,:) / pdel(:,:) end if + ! calc_lw_heat is .true. iff dolw is .false. + ! If dolw is true, use that value calculated in rrtmgp_lw_calculate_heating_rate_run + ! If dolw is false, perform this calculation if (calc_lw_heat) then qrl_prime(:,:) = qrl(:,:) / pdel(:,:) end if