From d1a6d753a812f2bde390db2730cfa12f22e5949c Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 1 Jul 2025 16:38:39 -0600 Subject: [PATCH 01/16] wip; schemes build but need to update radiation interfaces --- src/physics/rrtmgp/radiation.F90 | 106 ++++++++++++++++++++----------- 1 file changed, 69 insertions(+), 37 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 603a34976d..396f71246c 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -24,7 +24,6 @@ module radiation use radconstants, only: nradgas, gasnamelength, nswbands, nlwbands, & gaslist, radconstants_init -use rad_solar_var, only: rad_solar_var_init, get_variability use cloud_rad_props, only: cloud_rad_props_init @@ -415,6 +414,8 @@ subroutine radiation_init(pbuf2d) use rrtmgp_inputs, only: rrtmgp_inputs_init use rrtmgp_inputs_cam, only: rrtmgp_inputs_cam_init use rrtmgp_lw_cloud_optics, only: rrtmgp_lw_cloud_optics_init + use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_init + use solar_irrad_data, only: do_spctrl_scaling, has_spectrum ! Initialize the radiation and cloud optics. ! Add fields to the history buffer. @@ -483,7 +484,10 @@ subroutine radiation_init(pbuf2d) ! 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) - call rad_solar_var_init(nswbands) + call rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) + if (errflg /= 0) then + call endrun(sub//': '//errmsg) + end if ! initialize output fields for offline driver call rad_data_init(pbuf2d) @@ -821,6 +825,9 @@ subroutine radiation_tend( & use rrtmgp_lw_main, only: rrtmgp_lw_main_run use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run use rrtmgp_post, only: rrtmgp_post_run + use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_run + use rrtmgp_sw_mcica_subcol_gen, only: rrtmgp_sw_mcica_subcol_gen_run + use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & @@ -833,10 +840,12 @@ subroutine radiation_tend( & use radheat, only: radheat_tend use radiation_data, only: rad_data_write + use solar_irrad_data, only: sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling use interpolate_data, only: vertinterp use tropopause, only: tropopause_find_cam, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps + use cam_history_support, only: fillvalue ! Arguments @@ -881,6 +890,12 @@ subroutine radiation_tend( & real(r8) :: cld_lw_abs(nlwbands,state%ncol,pver) ! Cloud absorption optics depth real(r8) :: snow_lw_abs(nlwbands,state%ncol,pver) ! Snow absorption optics depth real(r8) :: grau_lw_abs(nlwbands,state%ncol,pver) ! Graupel absorption optics depth + real(r8) :: cld_tau(nswbands,state%ncol,pver) ! Cloud absorption optics depth (sw) + real(r8) :: snow_tau(nlwbands,state%ncol,pver) ! Snow absorption optics depth (sw) + real(r8) :: grau_tau(nlwbands,state%ncol,pver) ! Graupel absorption optics depth (sw) + real(r8) :: c_cld_tau(nlwbands,state%ncol,pver) + real(r8) :: c_cld_tau_w(nlwbands,state%ncol,pver) + real(r8) :: c_cld_tau_w_g(nlwbands,state%ncol,pver) real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate adjusted by air pressure thickness real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate adjusted by air pressure thickness real(r8) :: qrs_prime(pcols, pver) ! shortwave heating rate @@ -1127,6 +1142,33 @@ subroutine radiation_tend( & else cldfsnow_in => null() end if + ! Grab additional pbuf fields for LW cloud optics + dei_idx = pbuf_get_index('DEI',errcode=err) + mu_idx = pbuf_get_index('MU',errcode=err) + lambda_idx = pbuf_get_index('LAMBDAC',errcode=err) + iciwp_idx = pbuf_get_index('ICIWP',errcode=err) + iclwp_idx = pbuf_get_index('ICLWP',errcode=err) + des_idx = pbuf_get_index('DES',errcode=err) + icswp_idx = pbuf_get_index('ICSWP',errcode=err) + icgrauwp_idx = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 + degrau_idx = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 + call pbuf_get_field(pbuf, lambda_idx, lambda) + call pbuf_get_field(pbuf, mu_idx, mu) + call pbuf_get_field(pbuf, iclwp_idx, iclwp) + call pbuf_get_field(pbuf, iciwp_idx, iciwp) + call pbuf_get_field(pbuf, dei_idx, dei) + call pbuf_get_field(pbuf, icswp_idx, icswp) + call pbuf_get_field(pbuf, des_idx, des) + if (icgrauwp_idx > 0) then + call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp) + end if + if (degrau_idx > 0) then + call pbuf_get_field(pbuf, degrau_idx, degrau) + end if + + do_graupel = ((icgrauwp_idx > 0) .and. (degrau_idx > 0) .and. associated(cldfgrau)) .and. graupel_in_rad + do_snow = associated(cldfsnow) + ! Prepare state variables, daylit columns, albedos for RRTMGP ! Also calculate modified cloud fraction call rrtmgp_inputs_run(dosw, dolw, associated(cldfsnow), associated(cldfgrau), & @@ -1155,13 +1197,26 @@ subroutine radiation_tend( & if (dosw) then ! Set cloud optical properties in cloud_sw object. - call rrtmgp_set_cloud_sw( & - state, pbuf, nlay, nday, idxday, nswgpts, & - nnite, idxnite, pmid_day, cld, cldfsnow, & - cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & - rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, & - rd%ice_icld_vistau, rd%snow_icld_vistau, rd%grau_icld_vistau, & - cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim ) + call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & + fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:ncol,:), & + cldfgrau(:ncol,:), cldfprime(:,:,:), cld_tau(:,:,:), grau_tau(:,:,:), snow_tau(:,:), degrau(:ncol,:), & + dei(:ncol,:), des(:ncol,:), iclwpth, icswpth, icgrauwpth, ext_sw_liq, ssa_sw_liq, & + asm_sw_liq, ext_sw_ice, asm_sw_ice, ssa_sw_ice, g_mu, g_d_eff, g_lambda,& + idx_sw_diag, do_graupel, do_snow, kdist_sw, cloud_sw, c_cld_tau(:,:), & + c_cld_tau_w(:,:), c_cld_tau_w_g(:,:), rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, rd%ice_icld_vistau, & + rd%snow_icld_vistau, rd%grau_icld_vistau, errmsg, errflg) + if (errflg /= 0) then + call endrun(sub//': '//errmsg) + end if + + ! Cloud optics for COSP + cld_tau_cloudsim = cld_tau(idx_sw_cloudsim,:,:) + snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) + grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) + + call rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nday, nlay, & + pver, tiny, idxday, ktopcam, ktoprad, cldfprime, c_cld_tau, & + c_cld_tau_w, c_cld_tau_w_g, cloud_sw, state%pmid(:ncol,:), errmsg, errflg) if (write_output) then call radiation_output_cld(lchnk, rd) @@ -1190,7 +1245,11 @@ subroutine radiation_tend( & !$acc end data ! Scale the solar source - call get_variability(toa_flux, sfac, band2gpt_sw, nswbands) + call rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, & + do_spctrl_scaling, sfac, errmsg, errflg) + if (errflg /= 0) then + call endrun(sub//': '//errmsg) + end if toa_flux = toa_flux * sfac * eccf end if @@ -1251,33 +1310,6 @@ subroutine radiation_tend( & if (dolw) then - ! Grab additional pbuf fields for LW cloud optics - dei_idx = pbuf_get_index('DEI',errcode=err) - mu_idx = pbuf_get_index('MU',errcode=err) - lambda_idx = pbuf_get_index('LAMBDAC',errcode=err) - iciwp_idx = pbuf_get_index('ICIWP',errcode=err) - iclwp_idx = pbuf_get_index('ICLWP',errcode=err) - des_idx = pbuf_get_index('DES',errcode=err) - icswp_idx = pbuf_get_index('ICSWP',errcode=err) - icgrauwp_idx = pbuf_get_index('ICGRAUWP',errcode=err) ! Available when using MG3 - degrau_idx = pbuf_get_index('DEGRAU',errcode=err) ! Available when using MG3 - call pbuf_get_field(pbuf, lambda_idx, lambda) - call pbuf_get_field(pbuf, mu_idx, mu) - call pbuf_get_field(pbuf, iclwp_idx, iclwp) - call pbuf_get_field(pbuf, iciwp_idx, iciwp) - call pbuf_get_field(pbuf, dei_idx, dei) - call pbuf_get_field(pbuf, icswp_idx, icswp) - call pbuf_get_field(pbuf, des_idx, des) - if (icgrauwp_idx > 0) then - call pbuf_get_field(pbuf, icgrauwp_idx, icgrauwp) - end if - if (degrau_idx > 0) then - call pbuf_get_field(pbuf, degrau_idx, degrau) - end if - - do_graupel = ((icgrauwp_idx > 0) .and. (degrau_idx > 0) .and. associated(cldfgrau)) .and. graupel_in_rad - do_snow = associated(cldfsnow) - ! Set cloud optical properties in cloud_lw object. call rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld(:ncol,:), cldfsnow_in, & cldfgrau_in, cldfprime(:ncol,:), kdist_lw, cloud_lw, lambda(:ncol,:), & From 5ac20fcd45357b6a3fab705b88ad048983ae8347 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 8 Jul 2025 16:57:57 -0600 Subject: [PATCH 02/16] working cloud optics and mcica --- .gitmodules | 4 +- src/atmos_phys | 2 +- src/physics/rrtmgp/radiation.F90 | 56 ++--- src/physics/rrtmgp/rrtmgp_inputs_cam.F90 | 284 +---------------------- 4 files changed, 34 insertions(+), 312 deletions(-) diff --git a/.gitmodules b/.gitmodules index 2b0d2485fb..ba6dbbdaf3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -35,8 +35,8 @@ [submodule "atmos_phys"] path = src/atmos_phys - url = https://github.com/ESCOMP/atmospheric_physics - fxtag = atmos_phys0_14_001 + url = https://github.com/peverwhee/atmospheric_physics + fxtag = 6e4e4938126c872a5fde124138a32ad12bb4f9d9 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 9cfcb2eaca..6e4e493812 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 9cfcb2eaca2c63a4a6f00799b226cd9893a38f64 +Subproject commit 6e4e4938126c872a5fde124138a32ad12bb4f9d9 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 8a9cc76c14..f84839459a 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -421,16 +421,16 @@ end function radiation_do !================================================================================================ subroutine radiation_init(pbuf2d) - use rrtmgp_pre, only: rrtmgp_pre_init - use rrtmgp_inputs, only: rrtmgp_inputs_init - use rrtmgp_inputs_cam, only: rrtmgp_inputs_cam_init - use rrtmgp_lw_cloud_optics, only: rrtmgp_lw_cloud_optics_init - use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_init - use solar_irrad_data, only: do_spctrl_scaling, has_spectrum - use cloud_rad_props, only: cloud_rad_props_init - use rad_constituents, only: iceopticsfile, liqopticsfile - use rrtmgp_lw_gas_optics, only: rrtmgp_lw_gas_optics_init - use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_init + 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, only: rrtmgp_sw_solar_var_init + use solar_irrad_data, only: do_spctrl_scaling, has_spectrum + use cloud_rad_props, only: cloud_rad_props_init + use rad_constituents, only: iceopticsfile, liqopticsfile + use rrtmgp_lw_gas_optics, only: rrtmgp_lw_gas_optics_init + use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_init ! Initialize the radiation and cloud optics. ! Add fields to the history buffer. @@ -840,8 +840,7 @@ subroutine radiation_tend( & use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & - rrtmgp_set_gases_sw, rrtmgp_set_cloud_sw, & - rrtmgp_set_aer_sw + rrtmgp_set_gases_sw, rrtmgp_set_aer_sw ! RRTMGP drivers for flux calculations. use mo_rte_lw, only: rte_lw @@ -901,11 +900,11 @@ subroutine radiation_tend( & real(r8) :: snow_lw_abs(nlwbands,state%ncol,pver) ! Snow absorption optics depth real(r8) :: grau_lw_abs(nlwbands,state%ncol,pver) ! Graupel absorption optics depth real(r8) :: cld_tau(nswbands,state%ncol,pver) ! Cloud absorption optics depth (sw) - real(r8) :: snow_tau(nlwbands,state%ncol,pver) ! Snow absorption optics depth (sw) - real(r8) :: grau_tau(nlwbands,state%ncol,pver) ! Graupel absorption optics depth (sw) - real(r8) :: c_cld_tau(nlwbands,state%ncol,pver) - real(r8) :: c_cld_tau_w(nlwbands,state%ncol,pver) - real(r8) :: c_cld_tau_w_g(nlwbands,state%ncol,pver) + real(r8) :: snow_tau(nswbands,state%ncol,pver) ! Snow absorption optics depth (sw) + real(r8) :: grau_tau(nswbands,state%ncol,pver) ! Graupel absorption optics depth (sw) + real(r8) :: c_cld_tau(nswbands,state%ncol,pver) + real(r8) :: c_cld_tau_w(nswbands,state%ncol,pver) + real(r8) :: c_cld_tau_w_g(nswbands,state%ncol,pver) real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate adjusted by air pressure thickness real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate adjusted by air pressure thickness real(r8) :: qrs_prime(pcols, pver) ! shortwave heating rate @@ -1020,7 +1019,7 @@ subroutine radiation_tend( & real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables real(r8), target :: zero_variable(1,1) - character(len=128) :: errmsg + character(len=512) :: errmsg integer :: errflg, err character(len=*), parameter :: sub = 'radiation_tend' !-------------------------------------------------------------------------------------- @@ -1212,25 +1211,26 @@ subroutine radiation_tend( & ! Set cloud optical properties in cloud_sw object. call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & - fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:ncol,:), & - cldfgrau(:ncol,:), cldfprime(:,:,:), cld_tau(:,:,:), grau_tau(:,:,:), snow_tau(:,:), degrau(:ncol,:), & - dei(:ncol,:), des(:ncol,:), iclwpth, icswpth, icgrauwpth, ext_sw_liq, ssa_sw_liq, & + fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:,:), & + cldfgrau(:,:), cldfprime(:ncol,:), cld_tau(:,:ncol,:), grau_tau(:,:ncol,:), snow_tau(:,:ncol,:), degrau(:ncol,:), & + dei(:ncol,:), des(:ncol,:), iclwp(:ncol,:), iciwp(:ncol,:), icswp(:ncol,:), icgrauwp(:ncol,:), tiny, ext_sw_liq, ssa_sw_liq, & asm_sw_liq, ext_sw_ice, asm_sw_ice, ssa_sw_ice, g_mu, g_d_eff, g_lambda,& - idx_sw_diag, do_graupel, do_snow, kdist_sw, cloud_sw, c_cld_tau(:,:), & - c_cld_tau_w(:,:), c_cld_tau_w_g(:,:), rd%tot_cld_vistau, rd%tot_icld_vistau, rd%liq_icld_vistau, rd%ice_icld_vistau, & - rd%snow_icld_vistau, rd%grau_icld_vistau, errmsg, errflg) + idx_sw_diag, do_graupel, do_snow, kdist_sw, c_cld_tau(:,:ncol,:), & + c_cld_tau_w(:,:ncol,:), c_cld_tau_w_g(:,:ncol,:), rd%tot_cld_vistau(:ncol,:), rd%tot_icld_vistau(:ncol,:), & + rd%liq_icld_vistau(:ncol,:), rd%ice_icld_vistau(:ncol,:), & + rd%snow_icld_vistau(:ncol,:), rd%grau_icld_vistau(:ncol,:), errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) end if ! Cloud optics for COSP - cld_tau_cloudsim = cld_tau(idx_sw_cloudsim,:,:) - snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) - grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) + cld_tau_cloudsim(:ncol,:) = cld_tau(idx_sw_cloudsim,:,:) + snow_tau_cloudsim(:ncol,:) = snow_tau(idx_sw_cloudsim,:,:) + grau_tau_cloudsim(:ncol,:) = grau_tau(idx_sw_cloudsim,:,:) call rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nday, nlay, & pver, tiny, idxday, ktopcam, ktoprad, cldfprime, c_cld_tau, & - c_cld_tau_w, c_cld_tau_w_g, cloud_sw, state%pmid(:ncol,:), errmsg, errflg) + c_cld_tau_w, c_cld_tau_w_g, cloud_sw, pmid_day(:ncol,:), errmsg, errflg) if (write_output) then call radiation_output_cld(lchnk, rd) diff --git a/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 b/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 index b104275715..33bef44923 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 @@ -10,6 +10,7 @@ module rrtmgp_inputs_cam use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pcols, pver, pverp +use cam_logfile, only: iulog use physconst, only: stebol, pi @@ -38,6 +39,8 @@ module rrtmgp_inputs_cam use cam_abortutils, only: endrun use error_messages, only: alloc_err use radiation_utils, only: get_sw_spectral_boundaries_ccpp +use spmd_utils, only: masterproc +use spmd_utils, only: iam implicit none private @@ -47,7 +50,6 @@ module rrtmgp_inputs_cam rrtmgp_inputs_cam_init, & rrtmgp_get_gas_mmrs, & rrtmgp_set_gases_sw, & - rrtmgp_set_cloud_sw, & rrtmgp_set_aer_lw, & rrtmgp_set_aer_sw @@ -321,286 +323,6 @@ end subroutine rrtmgp_set_gases_sw !================================================================================================== -subroutine rrtmgp_set_cloud_sw( & - state, pbuf, nlay, nday, idxday, nswgpts, & - nnite, idxnite, pmid, cld, cldfsnow, & - cldfgrau, cldfprime, graupel_in_rad, kdist_sw, cloud_sw, & - tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, & - grau_icld_vistau, cld_tau_cloudsim, snow_tau_cloudsim, grau_tau_cloudsim) - - ! Compute combined cloud optical properties. - ! Create MCICA stochastic arrays for cloud SW optical properties. - ! Initialize optical properties object (cloud_sw) and load with MCICA columns. - - ! arguments - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") - integer, intent(in) :: nday ! number of daylight columns - integer, intent(in) :: idxday(pcols) ! indices of daylight columns in the chunk - integer, intent(in) :: nswgpts ! number of shortwave g-points - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(pcols) ! indices of night columns in the chunk - - real(r8), intent(in) :: pmid(nday,nlay)! pressure at layer midpoints (Pa) used to seed RNG. - - real(r8), pointer :: cld(:,:) ! cloud fraction (liq+ice) - real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" - real(r8), pointer :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" - real(r8), intent(in) :: cldfprime(pcols,pver) ! combined cloud fraction - - logical, intent(in) :: graupel_in_rad ! graupel in radiation code - class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object - type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object - - ! Diagnostic outputs - real(r8), intent(out) :: tot_cld_vistau(pcols,pver) ! gbx total cloud optical depth - real(r8), intent(out) :: tot_icld_vistau(pcols,pver) ! in-cld total cloud optical depth - real(r8), intent(out) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth - real(r8), intent(out) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth - real(r8), intent(out) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth - real(r8), intent(out) :: grau_icld_vistau(pcols,pver) ! Graupel in-cloud visible sw optical depth - real(r8), intent(out) :: cld_tau_cloudsim(pcols,pver) ! in-cloud liq+ice optical depth (for COSP) - real(r8), intent(out) :: snow_tau_cloudsim(pcols,pver)! in-cloud snow optical depth (for COSP) - real(r8), intent(out) :: grau_tau_cloudsim(pcols,pver)! in-cloud Graupel optical depth (for COSP) - - ! Local variables - - integer :: i, k, ncol - integer :: igpt, nver - integer :: istat - integer, parameter :: changeseed = 1 - - ! 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 asymmetry parameter * tau * w - 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 asymmetry parameter * tau * w - 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 asymmetry parameter * w * tau - 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 asymmetry parameter * tau * w - 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 asymmetry parameter * tau * w - 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 asymmetry parameter * w * tau - - ! RRTMGP does not use this property in its 2-stream calculations. - real(r8) :: sw_tau_w_f(nswbands,pcols,pver) ! Forward scattered fraction * tau * w. - - ! Arrays for converting from CAM chunks to RRTMGP inputs. - real(r8), allocatable :: cldf(:,:) - real(r8), allocatable :: tauc(:,:,:) - real(r8), allocatable :: ssac(:,:,:) - real(r8), allocatable :: asmc(:,:,:) - real(r8), allocatable :: taucmcl(:,:,:) - real(r8), allocatable :: ssacmcl(:,:,:) - real(r8), allocatable :: asmcmcl(:,:,:) - real(r8), allocatable :: day_cld_tau(:,:,:) - real(r8), allocatable :: day_cld_tau_w(:,:,:) - real(r8), allocatable :: day_cld_tau_w_g(:,:,:) - - character(len=128) :: errmsg - character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' - !-------------------------------------------------------------------------------- - - ncol = state%ncol - - ! Combine the cloud optical properties. These calculations are done on CAM "chunks". - - ! gammadist liquid optics - call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f) - ! Mitchell ice optics - call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) - - cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:) - cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:) - cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:) - - ! add in snow - if (associated(cldfsnow)) then - call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) - do i = 1, ncol - do k = 1, pver - if (cldfprime(i,k) > 0._r8) then - c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) & - + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k) - c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) & - + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k) - c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) & - + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k) - else - c_cld_tau(:,i,k) = 0._r8 - c_cld_tau_w(:,i,k) = 0._r8 - c_cld_tau_w_g(:,i,k) = 0._r8 - end if - end do - end do - else - c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:) - c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:) - c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:) - end if - - ! add in graupel - if (associated(cldfgrau) .and. graupel_in_rad) then - call get_grau_optics_sw(state, pbuf, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) - do i = 1, ncol - do k = 1, pver - if (cldfprime(i,k) > 0._r8) then - c_cld_tau(:,i,k) = ( cldfgrau(i,k)*grau_tau(:,i,k) & - + cld(i,k)*c_cld_tau(:,i,k) )/cldfprime(i,k) - c_cld_tau_w(:,i,k) = ( cldfgrau(i,k)*grau_tau_w(:,i,k) & - + cld(i,k)*c_cld_tau_w(:,i,k) )/cldfprime(i,k) - c_cld_tau_w_g(:,i,k) = ( cldfgrau(i,k)*grau_tau_w_g(:,i,k) & - + cld(i,k)*c_cld_tau_w_g(:,i,k) )/cldfprime(i,k) - else - c_cld_tau(:,i,k) = 0._r8 - c_cld_tau_w(:,i,k) = 0._r8 - c_cld_tau_w_g(:,i,k) = 0._r8 - end if - end do - end do - end if - - ! cloud optical properties need to be re-ordered from the RRTMG spectral bands - ! (assumed in the optics datasets) to RRTMGP's - ice_tau(:,:ncol,:) = ice_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - liq_tau(:,:ncol,:) = liq_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau(:,:ncol,:) = c_cld_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau_w(:,:ncol,:) = c_cld_tau_w(rrtmg_to_rrtmgp_swbands,:ncol,:) - c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) - if (associated(cldfsnow)) then - snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - end if - if (associated(cldfgrau) .and. graupel_in_rad) then - grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - end if - - ! Set arrays for diagnostic output. - ! cloud optical depth fields for the visible band - tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:) - liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:) - ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) - if (associated(cldfsnow)) then - snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) - endif - if (associated(cldfgrau) .and. graupel_in_rad) then - grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) - endif - - ! multiply by total cloud fraction to get gridbox value - tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:) - - ! overwrite night columns with fillvalue - do i = 1, Nnite - tot_cld_vistau(IdxNite(i),:) = fillvalue - tot_icld_vistau(IdxNite(i),:) = fillvalue - liq_icld_vistau(IdxNite(i),:) = fillvalue - ice_icld_vistau(IdxNite(i),:) = fillvalue - if (associated(cldfsnow)) then - snow_icld_vistau(IdxNite(i),:) = fillvalue - end if - if (associated(cldfgrau) .and. graupel_in_rad) then - grau_icld_vistau(IdxNite(i),:) = fillvalue - end if - end do - - ! Cloud optics for COSP - cld_tau_cloudsim = cld_tau(idx_sw_cloudsim,:,:) - snow_tau_cloudsim = snow_tau(idx_sw_cloudsim,:,:) - grau_tau_cloudsim = grau_tau(idx_sw_cloudsim,:,:) - - ! if no daylight columns the cloud_sw object isn't initialized - if (nday > 0) then - - ! number of CAM's layers in radiation calculation. Does not include the "extra layer". - nver = pver - ktopcam + 1 - - allocate( & - cldf(nday,nver), & - day_cld_tau(nswbands,nday,nver), & - day_cld_tau_w(nswbands,nday,nver), & - day_cld_tau_w_g(nswbands,nday,nver), & - tauc(nswbands,nday,nver), taucmcl(nswgpts,nday,nver), & - ssac(nswbands,nday,nver), ssacmcl(nswgpts,nday,nver), & - asmc(nswbands,nday,nver), asmcmcl(nswgpts,nday,nver), stat=istat) - call alloc_err(istat, sub, 'cldf,..,asmcmcl', 9*nswgpts*nday*nver) - - ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the - ! radiation calculation are used by MCICA to produce subcolumns. - cldf = cldfprime( idxday(1:nday), ktopcam:) - day_cld_tau = c_cld_tau( :, idxday(1:nday), ktopcam:) - day_cld_tau_w = c_cld_tau_w( :, idxday(1:nday), ktopcam:) - day_cld_tau_w_g = c_cld_tau_w_g(:, idxday(1:nday), ktopcam:) - - ! Compute the optical properties needed for the 2-stream calculations. These calculations - ! are the same as the RRTMG version. - - ! set cloud optical depth, clip @ zero - tauc = merge(day_cld_tau, 0.0_r8, day_cld_tau > 0.0_r8) - ! set value of asymmetry - asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_r8, day_cld_tau_w > 0.0_r8) - ! set value of single scattering albedo - ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_r8 , tauc > 0.0_r8) - ! set asymmetry to zero when tauc = 0 - asmc = merge(asmc, 0.0_r8, tauc > 0.0_r8) - - ! MCICA uses spectral data (on bands) to construct subcolumns (one per g-point) - call mcica_subcol_sw( & - kdist_sw%gas_props, nswbands, nswgpts, nday, nlay, & - nver, changeseed, pmid, cldf, tauc, & - ssac, asmc, taucmcl, ssacmcl, asmcmcl) - - ! Initialize object for SW cloud optical properties. - errmsg = cloud_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) - if (len_trim(errmsg) > 0) then - call endrun(trim(sub)//': ERROR: cloud_sw%optical_props%alloc_2str: '//trim(errmsg)) - end if - - ! If there is an extra layer in the radiation then this initialization - ! will provide the optical properties there. - cloud_sw%optical_props%tau = 0.0_r8 - cloud_sw%optical_props%ssa = 1.0_r8 - cloud_sw%optical_props%g = 0.0_r8 - - ! Set the properties on g-points. - do igpt = 1,nswgpts - cloud_sw%optical_props%g (:,ktoprad:,igpt) = asmcmcl(igpt,:,:) - cloud_sw%optical_props%ssa(:,ktoprad:,igpt) = ssacmcl(igpt,:,:) - cloud_sw%optical_props%tau(:,ktoprad:,igpt) = taucmcl(igpt,:,:) - end do - - ! validate checks that: tau > 0, ssa is in range [0,1], and g is in range [-1,1]. - errmsg = cloud_sw%optical_props%validate() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: cloud_sw%optical_props%validate: '//trim(errmsg)) - end if - - ! delta scaling adjusts for forward scattering - errmsg = cloud_sw%optical_props%delta_scale() - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR: cloud_sw%optical_props%delta_scale: '//trim(errmsg)) - end if - - ! All information is in cloud_sw, now deallocate local vars. - deallocate( & - cldf, tauc, ssac, asmc, & - taucmcl, ssacmcl, asmcmcl,& - day_cld_tau, day_cld_tau_w, day_cld_tau_w_g ) - - end if - -end subroutine rrtmgp_set_cloud_sw - -!================================================================================================== - subroutine rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) ! Load LW aerosol optical properties into the RRTMGP object. From fde6a26a9c19a41d987d121f79849442cb261a9a Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 10 Jul 2025 14:15:46 -0600 Subject: [PATCH 03/16] working gas optics run phase --- .gitmodules | 2 +- src/atmos_phys | 2 +- src/physics/rrtmgp/radiation.F90 | 13 +++++++------ 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.gitmodules b/.gitmodules index ba6dbbdaf3..678f65eda7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 6e4e4938126c872a5fde124138a32ad12bb4f9d9 + fxtag = 91358211a4390c05729dc994762f9e6b8641a614 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 6e4e493812..91358211a4 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 6e4e4938126c872a5fde124138a32ad12bb4f9d9 +Subproject commit 91358211a4390c05729dc994762f9e6b8641a614 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index f84839459a..31d78ba4a8 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -838,6 +838,7 @@ subroutine radiation_tend( & use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_run use rrtmgp_sw_mcica_subcol_gen, only: rrtmgp_sw_mcica_subcol_gen_run use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run + use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & rrtmgp_set_gases_sw, rrtmgp_set_aer_sw @@ -1252,19 +1253,19 @@ subroutine radiation_tend( & !$acc data copyin(kdist_sw%gas_props,pmid_day,pint_day,t_day,gas_concs_sw%gas_concs) & !$acc copy(atm_optics_sw%optical_props) & !$acc copyout(toa_flux) - errmsg = kdist_sw%gas_props%gas_optics( & - pmid_day, pint_day, t_day, gas_concs_sw%gas_concs, atm_optics_sw%optical_props, & - toa_flux) - call stop_on_err(errmsg, sub, 'kdist_sw%gas_props%gas_optics') + 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, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, & - do_spctrl_scaling, sfac, errmsg, errflg) + do_spctrl_scaling, sfac, eccf, errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) end if - toa_flux = toa_flux * sfac * eccf end if From c7ef889a969f6ff1c0788dd598842abbd6d40647 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 11 Jul 2025 15:58:29 -0600 Subject: [PATCH 04/16] working gas optics pre --- .gitmodules | 2 +- src/atmos_phys | 2 +- src/physics/rrtmgp/radiation.F90 | 17 ++- src/physics/rrtmgp/rrtmgp_inputs_cam.F90 | 183 ----------------------- 4 files changed, 14 insertions(+), 190 deletions(-) diff --git a/.gitmodules b/.gitmodules index 678f65eda7..78b395e3c8 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 91358211a4390c05729dc994762f9e6b8641a614 + fxtag = 3d5a016dce00ece748ed89b8c1670ff1e0892848 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 91358211a4..3d5a016dce 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 91358211a4390c05729dc994762f9e6b8641a614 +Subproject commit 3d5a016dce00ece748ed89b8c1670ff1e0892848 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 31d78ba4a8..a7fce8eb74 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -838,10 +838,11 @@ subroutine radiation_tend( & use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_run use rrtmgp_sw_mcica_subcol_gen, only: rrtmgp_sw_mcica_subcol_gen_run use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run + use rrtmgp_sw_gas_optics_pre, only: rrtmgp_sw_gas_optics_pre_run use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & - rrtmgp_set_gases_sw, rrtmgp_set_aer_sw + rrtmgp_set_aer_sw ! RRTMGP drivers for flux calculations. use mo_rte_lw, only: rte_lw @@ -1243,10 +1244,16 @@ subroutine radiation_tend( & if (nday > 0) then + ! Grab the gas mass mixing ratios from rad_constituents + gas_mmrs = 0._r8 + call rrtmgp_get_gas_mmrs(icall, state, pbuf, nlay, gas_mmrs) + ! Set gas volume mixing ratios for this call in gas_concs_sw. - call rrtmgp_set_gases_sw( & - icall, state, pbuf, nlay, nday, & - idxday, gas_concs_sw) + call rrtmgp_sw_gas_optics_pre_run(gas_mmrs, state%pmid(:ncol,:), state%pint(:ncol,:), nlay, nday, gaslist, idxday, & + pverp, ktoprad, ktopcam, dosw, nradgas, gas_concs_sw, errmsg, errflg) + if (errflg /= 0) then + call endrun(sub//': '//errmsg) + end if ! Compute the gas optics (stored in atm_optics_sw). ! toa_flux is the reference solar source from RRTMGP data. @@ -1359,7 +1366,7 @@ subroutine radiation_tend( & ! Set gas volume mixing ratios for this call in gas_concs_lw call rrtmgp_lw_gas_optics_pre_run(gas_mmrs, state%pmid(:ncol,:), state%pint(:ncol,:), nlay, ncol, gaslist, & - idxday, pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs_lw, errmsg, errflg) + pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs_lw, errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) end if diff --git a/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 b/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 index 33bef44923..b3686428f5 100644 --- a/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 +++ b/src/physics/rrtmgp/rrtmgp_inputs_cam.F90 @@ -49,7 +49,6 @@ module rrtmgp_inputs_cam public :: & rrtmgp_inputs_cam_init, & rrtmgp_get_gas_mmrs, & - rrtmgp_set_gases_sw, & rrtmgp_set_aer_lw, & rrtmgp_set_aer_sw @@ -115,158 +114,6 @@ end subroutine rrtmgp_inputs_cam_init !========================================================================================= -function get_molar_mass_ratio(gas_name) result(massratio) - - ! return the molar mass ratio of dry air to gas based on gas_name - - character(len=*),intent(in) :: gas_name - real(r8) :: massratio - - ! local variables - real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor - real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide - real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone - real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane - real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide - real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen - real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11 - real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12 - - character(len=*), parameter :: sub='get_molar_mass_ratio' - !---------------------------------------------------------------------------- - - select case (trim(gas_name)) - case ('H2O') - massratio = amdw - case ('CO2') - massratio = amdc - case ('O3') - massratio = amdo - case ('CH4') - massratio = amdm - case ('N2O') - massratio = amdn - case ('O2') - massratio = amdo2 - case ('CFC11') - massratio = amdc1 - case ('CFC12') - massratio = amdc2 - case default - call endrun(sub//": Invalid gas: "//trim(gas_name)) - end select - -end function get_molar_mass_ratio - -!========================================================================================= - -subroutine rad_gas_get_vmr(icall, gas_name, state, pbuf, nlay, numactivecols, gas_concs, idxday) - - ! Set volume mixing ratio in gas_concs object. - ! The gas_concs%set_vmr method copies data into internally allocated storage. - - integer, intent(in) :: icall ! index of climate/diagnostic radiation call - character(len=*), intent(in) :: gas_name - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nlay ! number of layers in radiation calculation - integer, intent(in) :: numactivecols ! number of columns, ncol for LW, nday for SW - - type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs - - integer, optional, intent(in) :: idxday(:) ! indices of daylight columns in a chunk - - ! Local variables - integer :: i, idx(numactivecols) - integer :: istat - real(r8), pointer :: gas_mmr(:,:) - real(r8), allocatable :: gas_vmr(:,:) - real(r8), allocatable :: mmr(:,:) - real(r8) :: massratio - - ! For ozone profile above model - real(r8) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff - - character(len=128) :: errmsg - character(len=*), parameter :: sub = 'rad_gas_get_vmr' - !---------------------------------------------------------------------------- - - ! set the column indices; when idxday is provided (e.g. daylit columns) use them, otherwise just count. - do i = 1, numactivecols - if (present(idxday)) then - idx(i) = idxday(i) - else - idx(i) = i - end if - end do - - ! gas_mmr points to a "chunk" in either the state or pbuf objects. That storage is - ! dimensioned (pcols,pver). - call rad_cnst_get_gas(icall, gas_name, state, pbuf, gas_mmr) - - ! Copy into storage for RRTMGP - allocate(mmr(numactivecols, nlay), stat=istat) - call alloc_err(istat, sub, 'mmr', numactivecols*nlay) - allocate(gas_vmr(numactivecols, nlay), stat=istat) - call alloc_err(istat, sub, 'gas_vmr', numactivecols*nlay) - - do i = 1, numactivecols - mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) - end do - - ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. - if (nlay == pverp) then - mmr(:,1) = mmr(:,2) - end if - - ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): - if (gas_name == 'H2O') then - mmr = mmr / (1._r8 - mmr) - end if - - ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. - massratio = get_molar_mass_ratio(gas_name) - gas_vmr = mmr * massratio - - ! special case: Setting O3 in the extra layer: - ! - ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone - ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at - ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning - ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. - - if ((gas_name == 'O3') .and. (nlay == pverp)) then - P_top = 50.0_r8 - do i = 1, numactivecols - P_int = state%pint(idx(i),1) ! pressure (Pa) at upper interface of CAM - P_mid = state%pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM - alpha = log(P_int/P_top) - beta = log(P_mid/P_int)/log(P_mid/P_top) - - a = ( (1._r8 + alpha) * exp(-alpha) - 1._r8 ) / alpha - b = 1._r8 - exp(-alpha) - - if (alpha .gt. 0) then ! only apply where top level is below 80 km - chi_mid = gas_vmr(i,1) ! molar mixing ratio of O3 at midpoint of top layer - chi_0 = chi_mid / (1._r8 + beta) - chi_eff = chi_0 * (a + b) - gas_vmr(i,1) = chi_eff - end if - end do - end if - - errmsg = gas_concs%gas_concs%set_vmr(gas_name, gas_vmr) - if (len_trim(errmsg) > 0) then - call endrun(sub//': ERROR, gas_concs%set_vmr: '//trim(errmsg)) - end if - - deallocate(gas_vmr) - deallocate(mmr) - -end subroutine rad_gas_get_vmr - -!================================================================================================== - subroutine rrtmgp_get_gas_mmrs(icall, state, pbuf, nlay, gas_mmrs) ! Retrieve mass mixing ratios for radiatively active gases from rad_constituents @@ -293,36 +140,6 @@ end subroutine rrtmgp_get_gas_mmrs !================================================================================================== -subroutine rrtmgp_set_gases_sw( & - icall, state, pbuf, nlay, nday, & - idxday, gas_concs) - - ! Return gas_concs with gas volume mixing ratio on DAYLIT columns. - ! Set all gases in radconstants gaslist. - - ! arguments - integer, intent(in) :: icall ! index of climate/diagnostic radiation call - type(physics_state), target, intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - integer, intent(in) :: nlay - integer, intent(in) :: nday - integer, intent(in) :: idxday(:) - type(ty_gas_concs_ccpp), intent(inout) :: gas_concs - - ! local variables - integer :: i - character(len=*), parameter :: sub = 'rrtmgp_set_gases_sw' - !---------------------------------------------------------------------------- - - ! use the optional argument idxday to specify which columns are sunlit - do i = 1,nradgas - call rad_gas_get_vmr(icall, gaslist(i), state, pbuf, nlay, nday, gas_concs, idxday=idxday) - end do - -end subroutine rrtmgp_set_gases_sw - -!================================================================================================== - subroutine rrtmgp_set_aer_lw(icall, state, pbuf, aer_lw) ! Load LW aerosol optical properties into the RRTMGP object. From 5fbb531e447289563473de4a7d90dfb85fb30bde Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Sun, 13 Jul 2025 12:36:44 -0600 Subject: [PATCH 05/16] new hash; use rrtmgp_sw_main_run --- .gitmodules | 2 +- src/atmos_phys | 2 +- src/physics/rrtmgp/radiation.F90 | 30 +++++++++--------------------- 3 files changed, 11 insertions(+), 23 deletions(-) diff --git a/.gitmodules b/.gitmodules index 78b395e3c8..3a826c99e3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 3d5a016dce00ece748ed89b8c1670ff1e0892848 + fxtag = 1a677317ed64a4016d37f794b795cc12324b03dd fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 3d5a016dce..1a677317ed 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 3d5a016dce00ece748ed89b8c1670ff1e0892848 +Subproject commit 1a677317ed64a4016d37f794b795cc12324b03dd diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index a7fce8eb74..d3b22f9072 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -840,6 +840,7 @@ subroutine radiation_tend( & use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run use rrtmgp_sw_gas_optics_pre, only: rrtmgp_sw_gas_optics_pre_run use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_run + use rrtmgp_sw_main, only: rrtmgp_sw_main_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & rrtmgp_set_aer_sw @@ -1293,24 +1294,11 @@ subroutine radiation_tend( & !$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) - errmsg = aer_sw%optical_props%increment(atm_optics_sw%optical_props) - call stop_on_err(errmsg, sub, 'aer_sw%optical_props%increment') - - ! Compute clear-sky fluxes. - errmsg = rte_sw(& - atm_optics_sw%optical_props, top_at_1, coszrs_day, toa_flux, & - alb_dir, alb_dif, fswc%fluxes) - call stop_on_err(errmsg, sub, 'clear-sky rte_sw') - - ! Increment the aerosol+gas optics (in atm_optics_sw) by the cloud optics in cloud_sw. - errmsg = cloud_sw%optical_props%increment(atm_optics_sw%optical_props) - call stop_on_err(errmsg, sub, 'cloud_sw%optical_props%increment') - - ! Compute all-sky fluxes. - errmsg = rte_sw(& - atm_optics_sw%optical_props, top_at_1, coszrs_day, toa_flux, & - alb_dir, alb_dif, fsw%fluxes) - call stop_on_err(errmsg, sub, 'all-sky rte_sw') + call rrtmgp_sw_main_run(dosw, .true., .true., nday, 1, nday, atm_optics_sw, cloud_sw, top_at_1, & + 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 @@ -1406,9 +1394,9 @@ subroutine radiation_tend( & !$acc flw%fluxes%flux_up, flw%fluxes%flux_dn, & !$acc lw_ds) call rrtmgp_lw_main_run(dolw, dolw, .false., .false., .false., & - 0, ncol, 1, ncol, atm_optics_lw, & - cloud_lw, top_at_1, sources_lw, emis_sfc, kdist_lw, & - aer_lw, fluxlwup_jac, lw_ds, flwc, flw, errmsg, errflg) + 0, atm_optics_lw, cloud_lw, top_at_1, 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 From e6b56bdb94a6bb84e91912b9573667a90abefa11 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 12:06:04 -0600 Subject: [PATCH 06/16] update atmos phys --- .gitmodules | 2 +- src/atmos_phys | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 3a826c99e3..18b0779bb7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 1a677317ed64a4016d37f794b795cc12324b03dd + fxtag = 912bec257dfab3d5c90589e4ecace18a5ce5fe10 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 1a677317ed..912bec257d 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 1a677317ed64a4016d37f794b795cc12324b03dd +Subproject commit 912bec257dfab3d5c90589e4ecace18a5ce5fe10 From 8bd5ea714b8023f5d9bc837e852dd58fc85c8a04 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 14:19:24 -0600 Subject: [PATCH 07/16] move rrtmgp external to atmospheric-physics --- .gitmodules | 9 +-------- bld/configure | 16 ++++++++-------- src/atmos_phys | 2 +- src/physics/rrtmgp/ext | 1 - src/physics/rrtmgp/radiation.F90 | 8 ++++---- 5 files changed, 14 insertions(+), 22 deletions(-) delete mode 160000 src/physics/rrtmgp/ext diff --git a/.gitmodules b/.gitmodules index 18b0779bb7..2e99382b37 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 912bec257dfab3d5c90589e4ecace18a5ce5fe10 + fxtag = e324603cdb8d24cc4781a67c87ea791409e7b4df fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics @@ -75,13 +75,6 @@ fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/HEMCO_CESM.git -[submodule "rte-rrtmgp"] - path = src/physics/rrtmgp/ext - url = https://github.com/earth-system-radiation/rte-rrtmgp.git - fxrequired = AlwaysRequired - fxtag = v1.7 - fxDONOTUSEurl = https://github.com/earth-system-radiation/rte-rrtmgp.git - [submodule "rrtmgp-data"] path = src/physics/rrtmgp/data url = https://github.com/earth-system-radiation/rrtmgp-data.git diff --git a/bld/configure b/bld/configure index 220a80c53c..016810c306 100755 --- a/bld/configure +++ b/bld/configure @@ -2136,16 +2136,16 @@ sub write_filepath } elsif ($rad eq 'rrtmgp') { print $fh "$camsrcdir/src/physics/rrtmgp\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/extensions\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/gas-optics\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-frontend\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-frontend\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/extensions\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/gas-optics\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rrtmgp-frontend\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rte-frontend\n"; if ($use_rrtmgp_gpu) { - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels/accel\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels/accel\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rrtmgp-kernels/accel\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rte-kernels/accel\n"; } - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rrtmgp-kernels\n"; - print $fh "$camsrcdir/src/physics/rrtmgp/ext/rte-kernels\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rrtmgp-kernels\n"; + print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/ext/rte-kernels\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp\n"; print $fh "$camsrcdir/src/atmos_phys/schemes/rrtmgp/objects\n"; } diff --git a/src/atmos_phys b/src/atmos_phys index 912bec257d..e324603cdb 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 912bec257dfab3d5c90589e4ecace18a5ce5fe10 +Subproject commit e324603cdb8d24cc4781a67c87ea791409e7b4df diff --git a/src/physics/rrtmgp/ext b/src/physics/rrtmgp/ext deleted file mode 160000 index 4d8c5df4c6..0000000000 --- a/src/physics/rrtmgp/ext +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 4d8c5df4c63434aaab854afd1b02f5986d41dfb3 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index d3b22f9072..54e08e13b5 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -832,7 +832,7 @@ subroutine radiation_tend( & use rrtmgp_lw_mcica_subcol_gen, only: rrtmgp_lw_mcica_subcol_gen_run use rrtmgp_lw_gas_optics_pre, only: rrtmgp_lw_gas_optics_pre_run use rrtmgp_lw_gas_optics, only: rrtmgp_lw_gas_optics_run - use rrtmgp_lw_main, only: rrtmgp_lw_main_run + use rrtmgp_lw_rte, only: rrtmgp_lw_rte_run use rrtmgp_dry_static_energy_tendency, only: rrtmgp_dry_static_energy_tendency_run use rrtmgp_post, only: rrtmgp_post_run use rrtmgp_sw_solar_var, only: rrtmgp_sw_solar_var_run @@ -840,7 +840,7 @@ subroutine radiation_tend( & use rrtmgp_sw_cloud_optics, only: rrtmgp_sw_cloud_optics_run use rrtmgp_sw_gas_optics_pre, only: rrtmgp_sw_gas_optics_pre_run use rrtmgp_sw_gas_optics, only: rrtmgp_sw_gas_optics_run - use rrtmgp_sw_main, only: rrtmgp_sw_main_run + use rrtmgp_sw_rte, only: rrtmgp_sw_rte_run use rrtmgp_inputs_cam, only: rrtmgp_get_gas_mmrs, rrtmgp_set_aer_lw, & rrtmgp_set_aer_sw @@ -1294,7 +1294,7 @@ subroutine radiation_tend( & !$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_main_run(dosw, .true., .true., nday, 1, nday, atm_optics_sw, cloud_sw, top_at_1, & + call rrtmgp_sw_rte_run(dosw, .true., .true., nday, 1, nday, atm_optics_sw, cloud_sw, top_at_1, & aer_sw, coszrs_day, toa_flux, alb_dir, alb_dif, fswc, fsw, errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) @@ -1393,7 +1393,7 @@ subroutine radiation_tend( & !$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_main_run(dolw, dolw, .false., .false., .false., & + call rrtmgp_lw_rte_run(dolw, dolw, .false., .false., .false., & 0, atm_optics_lw, cloud_lw, top_at_1, sources_lw, & emis_sfc, kdist_lw, aer_lw, fluxlwup_jac, lw_ds, & flwc, flw, errmsg, errflg) From 46e92a0f44d49058ddb464b41d119821e7ff88b0 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 14:27:30 -0600 Subject: [PATCH 08/16] new hash --- .gitmodules | 2 +- src/atmos_phys | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 2e99382b37..62f0670a4f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = e324603cdb8d24cc4781a67c87ea791409e7b4df + fxtag = f18d36a86182b3a0140d30953b5d4153d7bffe46 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index e324603cdb..f18d36a861 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit e324603cdb8d24cc4781a67c87ea791409e7b4df +Subproject commit f18d36a86182b3a0140d30953b5d4153d7bffe46 From 14f5976b7610d6ab277bd1425f69ad3ce8e3a3dd Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 14:40:03 -0600 Subject: [PATCH 09/16] new atmos_phys hash --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 62f0670a4f..e093273b64 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = f18d36a86182b3a0140d30953b5d4153d7bffe46 + fxtag = 37ad42677a3be738161d5bb5b931f4561901b880 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics From 5bb62e208b9eed3d0dfaf77a5abd25fe7fb451fb Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 22 Aug 2025 22:07:26 -0600 Subject: [PATCH 10/16] update sw cloud optics arguments --- .gitmodules | 2 +- src/atmos_phys | 2 +- src/physics/rrtmgp/radiation.F90 | 15 +++++++-------- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/.gitmodules b/.gitmodules index 23a28105fb..1d766a0757 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = 4b494f6f03d0143983df28146f7f0a2f4c96e0f1 + fxtag = ad12f78752c62eadb03f28f68df0d4fb9678e575 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 4b494f6f03..ad12f78752 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 4b494f6f03d0143983df28146f7f0a2f4c96e0f1 +Subproject commit ad12f78752c62eadb03f28f68df0d4fb9678e575 diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 21e1e3c853..1ce5769840 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1202,14 +1202,13 @@ subroutine radiation_tend( & if (dosw) then ! Set cloud optical properties in cloud_sw object. - call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & - fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:,:), & - cldfgrau(:,:), cldfprime(:ncol,:), cld_tau(:,:ncol,:), grau_tau(:,:ncol,:), snow_tau(:,:ncol,:), degrau(:ncol,:), & - dei(:ncol,:), des(:ncol,:), iclwp(:ncol,:), iciwp(:ncol,:), icswp(:ncol,:), icgrauwp(:ncol,:), tiny, ext_sw_liq, ssa_sw_liq, & - asm_sw_liq, ext_sw_ice, asm_sw_ice, ssa_sw_ice, g_mu, g_d_eff, g_lambda,& - idx_sw_diag, do_graupel, do_snow, kdist_sw, c_cld_tau(:,:ncol,:), & - c_cld_tau_w(:,:ncol,:), c_cld_tau_w_g(:,:ncol,:), rd%tot_cld_vistau(:ncol,:), rd%tot_icld_vistau(:ncol,:), & - rd%liq_icld_vistau(:ncol,:), rd%ice_icld_vistau(:ncol,:), & + call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & + fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:,:), & + cldfgrau(:,:), cldfprime(:ncol,:), cld_tau(:,:ncol,:), grau_tau(:,:ncol,:), snow_tau(:,:ncol,:), & + degrau(:ncol,:), dei(:ncol,:), des(:ncol,:), iclwp(:ncol,:), iciwp(:ncol,:), icswp(:ncol,:), & + icgrauwp(:ncol,:), tiny, idx_sw_diag, do_graupel, do_snow, kdist_sw, c_cld_tau(:,:ncol,:), & + c_cld_tau_w(:,:ncol,:), c_cld_tau_w_g(:,:ncol,:), rd%tot_cld_vistau(:ncol,:), & + rd%tot_icld_vistau(:ncol,:), rd%liq_icld_vistau(:ncol,:), rd%ice_icld_vistau(:ncol,:), & rd%snow_icld_vistau(:ncol,:), rd%grau_icld_vistau(:ncol,:), errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) From 0f06715f2af50388bdfbcd713e04b7c356bab0da Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 22 Aug 2025 23:46:10 -0600 Subject: [PATCH 11/16] don't use graupel and snow cldfrac directly from pbuf --- src/physics/rrtmgp/radiation.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/physics/rrtmgp/radiation.F90 b/src/physics/rrtmgp/radiation.F90 index 1ce5769840..d4c2972237 100644 --- a/src/physics/rrtmgp/radiation.F90 +++ b/src/physics/rrtmgp/radiation.F90 @@ -1202,13 +1202,13 @@ subroutine radiation_tend( & if (dosw) then ! Set cloud optical properties in cloud_sw object. - call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & - fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow(:,:), & - cldfgrau(:,:), cldfprime(:ncol,:), cld_tau(:,:ncol,:), grau_tau(:,:ncol,:), snow_tau(:,:ncol,:), & - degrau(:ncol,:), dei(:ncol,:), des(:ncol,:), iclwp(:ncol,:), iciwp(:ncol,:), icswp(:ncol,:), & - icgrauwp(:ncol,:), tiny, idx_sw_diag, do_graupel, do_snow, kdist_sw, c_cld_tau(:,:ncol,:), & - c_cld_tau_w(:,:ncol,:), c_cld_tau_w_g(:,:ncol,:), rd%tot_cld_vistau(:ncol,:), & - rd%tot_icld_vistau(:ncol,:), rd%liq_icld_vistau(:ncol,:), rd%ice_icld_vistau(:ncol,:), & + call rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, & + fillvalue, nswbands, iulog, mu(:ncol,:), lambda(:ncol,:), nnite, idxnite, cld, cldfsnow_in, & + cldfgrau_in, cldfprime(:ncol,:), cld_tau(:,:ncol,:), grau_tau(:,:ncol,:), snow_tau(:,:ncol,:), & + degrau(:ncol,:), dei(:ncol,:), des(:ncol,:), iclwp(:ncol,:), iciwp(:ncol,:), icswp(:ncol,:), & + icgrauwp(:ncol,:), tiny, idx_sw_diag, do_graupel, do_snow, kdist_sw, c_cld_tau(:,:ncol,:), & + c_cld_tau_w(:,:ncol,:), c_cld_tau_w_g(:,:ncol,:), rd%tot_cld_vistau(:ncol,:), & + rd%tot_icld_vistau(:ncol,:), rd%liq_icld_vistau(:ncol,:), rd%ice_icld_vistau(:ncol,:), & rd%snow_icld_vistau(:ncol,:), rd%grau_icld_vistau(:ncol,:), errmsg, errflg) if (errflg /= 0) then call endrun(sub//': '//errmsg) From 3d886ccfdbffc5c802ae894e6065bb41276136bc Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 3 Sep 2025 12:32:50 -0600 Subject: [PATCH 12/16] grab latest atmos phys hash --- .gitmodules | 2 +- src/atmos_phys | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 1d766a0757..f47bbd06a8 100644 --- a/.gitmodules +++ b/.gitmodules @@ -36,7 +36,7 @@ [submodule "atmos_phys"] path = src/atmos_phys url = https://github.com/peverwhee/atmospheric_physics - fxtag = ad12f78752c62eadb03f28f68df0d4fb9678e575 + fxtag = d36b8d9093b09c521401a8bdd1583fbb507549fe fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index ad12f78752..d36b8d9093 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit ad12f78752c62eadb03f28f68df0d4fb9678e575 +Subproject commit d36b8d9093b09c521401a8bdd1583fbb507549fe From f078efb8915708700dea7620be869696e4600062 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 3 Sep 2025 16:01:14 -0600 Subject: [PATCH 13/16] remove unused file - routines CCPPized and moved to atmospheric_phyics --- src/physics/rrtmgp/rad_solar_var.F90 | 156 --------------------------- 1 file changed, 156 deletions(-) delete mode 100644 src/physics/rrtmgp/rad_solar_var.F90 diff --git a/src/physics/rrtmgp/rad_solar_var.F90 b/src/physics/rrtmgp/rad_solar_var.F90 deleted file mode 100644 index bda38e2543..0000000000 --- a/src/physics/rrtmgp/rad_solar_var.F90 +++ /dev/null @@ -1,156 +0,0 @@ -!------------------------------------------------------------------------------- -! This module uses the solar irradiance data -! to provide a spectral scaling factor -! to approximate the spectral distribution of irradiance -! when the radiation scheme might use a different solar source function -!------------------------------------------------------------------------------- -module rad_solar_var - - use shr_kind_mod , only : r8 => shr_kind_r8 - use radiation_utils, only : get_sw_spectral_boundaries_ccpp - use solar_irrad_data, only : sol_irrad, we, nbins, has_spectrum, sol_tsi - use solar_irrad_data, only : do_spctrl_scaling - use cam_abortutils, only : endrun - use error_messages, only : alloc_err - - implicit none - save - - private - public :: rad_solar_var_init - public :: get_variability - - real(r8), allocatable :: irrad(:) ! solar irradiance at model timestep in each band - - real(r8), allocatable :: radbinmax(:) - real(r8), allocatable :: radbinmin(:) - -!------------------------------------------------------------------------------- -contains -!------------------------------------------------------------------------------- - - subroutine rad_solar_var_init(nswbands) - integer, intent(in) :: nswbands - - integer :: ierr, errflg - integer :: radmax_loc - character(len=512) :: errmsg - - if ( do_spctrl_scaling ) then - - if ( .not.has_spectrum ) then - call endrun('rad_solar_var_init: solar input file must have irradiance spectrum') - endif - - allocate (radbinmax(nswbands),stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for radbinmax') - end if - - allocate (radbinmin(nswbands),stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for radbinmin') - end if - - allocate (irrad(nswbands), stat=ierr) - if (ierr /= 0) then - call endrun('rad_solar_var_init: Error allocating space for irrad') - end if - - call get_sw_spectral_boundaries_ccpp(radbinmin, radbinmax, 'nm', errmsg, errflg) - if (errflg /= 0) then - call endrun('rad_solar_var_init: Error during get_sw_spectral_boundaries_ccpp - message: "'//errmsg//'"') - end if - - ! Make sure that the far-IR is included, even if radiation grid does not - ! extend that far down. 10^5 nm corresponds to a wavenumber of - ! 100 cm^-1. - radmax_loc = maxloc(radbinmax,1) - radbinmax(radmax_loc) = max(100000._r8,radbinmax(radmax_loc)) - - endif - - end subroutine rad_solar_var_init - -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- - - subroutine get_variability(toa_flux, sfac, band2gpt_sw, nswbands) - - ! Arguments - real(r8), intent(in) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) - real(r8), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) - integer, intent(in) :: band2gpt_sw(:,:) - integer, intent(in) :: nswbands - - ! Local variables - integer :: i, j, istat, gpt_start, gpt_end, ncols - real(r8), allocatable :: scale(:) - character(len=*), parameter :: sub = 'get_variability' - - if (do_spctrl_scaling) then - - ! Determine target irradiance for each band - call integrate_spectrum(nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) - - ncols = size(toa_flux, 1) - allocate(scale(ncols), stat=istat) - call alloc_err(istat, sub, 'scale', ncols) - - do i = 1, nswbands - gpt_start = band2gpt_sw(1,i) - gpt_end = band2gpt_sw(2,i) - scale = spread(irrad(i), 1, ncols) / sum(toa_flux(:, gpt_start:gpt_end), dim=2) - do j = gpt_start, gpt_end - sfac(:,j) = scale - end do - end do - - else - sfac(:,:) = sol_tsi / spread(sum(toa_flux, 2), 2, size(toa_flux, 2)) - end if - end subroutine get_variability - - -!------------------------------------------------------------------------------- -! private method......... -!------------------------------------------------------------------------------- - - subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) - - use mo_util, only : rebin - - implicit none - - !--------------------------------------------------------------- - ! ... dummy arguments - !--------------------------------------------------------------- - integer, intent(in) :: nsrc ! dimension source array - integer, intent(in) :: ntrg ! dimension target array - real(r8), intent(in) :: src_x(nsrc+1) ! source coordinates - real(r8), intent(in) :: max_trg(ntrg) ! target coordinates - real(r8), intent(in) :: min_trg(ntrg) ! target coordinates - real(r8), intent(in) :: src(nsrc) ! source array - real(r8), intent(out) :: trg(ntrg) ! target array - - !--------------------------------------------------------------- - ! ... local variables - !--------------------------------------------------------------- - real(r8) :: trg_x(2), targ(1) ! target coordinates - integer :: i - - do i = 1, ntrg - - trg_x(1) = min_trg(i) - trg_x(2) = max_trg(i) - - call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) - ! W/m2/nm --> W/m2 - trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) - - enddo - - - end subroutine integrate_spectrum - -end module rad_solar_var From 85655d0380121723f60f089b01e241ebece0752c Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 4 Sep 2025 21:47:46 -0600 Subject: [PATCH 14/16] use official tag instead of hash for testing --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index eb5fbc57dc..f353a3240d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -28,8 +28,8 @@ [submodule "atmos_phys"] path = src/atmos_phys - url = https://github.com/peverwhee/atmospheric_physics - fxtag = d36b8d9093b09c521401a8bdd1583fbb507549fe + url = https://github.com/ESCOMP/atmospheric_physics + fxtag = atmos_phys0_16_001 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics From 9398be6e9770f426de97c05fd02aada4f32fa5b6 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 4 Sep 2025 21:51:26 -0600 Subject: [PATCH 15/16] update submodule --- src/atmos_phys | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/atmos_phys b/src/atmos_phys index d36b8d9093..470f1fee56 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit d36b8d9093b09c521401a8bdd1583fbb507549fe +Subproject commit 470f1fee56af645c44493afab6c042d2d15e9311 From b103a829692571e1dc975014096606b5a3901ee5 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 5 Sep 2025 12:57:52 -0600 Subject: [PATCH 16/16] update atmospheric physics hash --- .gitmodules | 4 ++-- src/atmos_phys | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index f353a3240d..1b3672403f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -28,8 +28,8 @@ [submodule "atmos_phys"] path = src/atmos_phys - url = https://github.com/ESCOMP/atmospheric_physics - fxtag = atmos_phys0_16_001 + url = https://github.com/peverwhee/atmospheric_physics + fxtag = d65ef2ff1dea66dd7c873cf1ccef79d00563e14e fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/ESCOMP/atmospheric_physics diff --git a/src/atmos_phys b/src/atmos_phys index 470f1fee56..d65ef2ff1d 160000 --- a/src/atmos_phys +++ b/src/atmos_phys @@ -1 +1 @@ -Subproject commit 470f1fee56af645c44493afab6c042d2d15e9311 +Subproject commit d65ef2ff1dea66dd7c873cf1ccef79d00563e14e