From 12c79730f280e7c5427743c706255ff2820df64e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 3 Apr 2025 17:04:31 -0600 Subject: [PATCH 001/140] bring in ccppized fortran for rrtmgp --- phys_utils/atmos_phys_string_utils.F90 | 58 ++ schemes/rrtmgp/objects/ccpp_fluxes.F90 | 12 + schemes/rrtmgp/objects/ccpp_fluxes.meta | 7 + schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 | 12 + .../rrtmgp/objects/ccpp_fluxes_byband.meta | 7 + .../objects/ccpp_gas_concentrations.F90 | 11 + .../objects/ccpp_gas_concentrations.meta | 7 + .../rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 | 11 + .../objects/ccpp_gas_optics_rrtmgp.meta | 7 + schemes/rrtmgp/objects/ccpp_optical_props.F90 | 19 + .../rrtmgp/objects/ccpp_optical_props.meta | 15 + .../rrtmgp/objects/ccpp_source_functions.F90 | 11 + .../rrtmgp/objects/ccpp_source_functions.meta | 7 + schemes/rrtmgp/rrtmgp_inputs.F90 | 655 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 463 +++++++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 89 +++ schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 99 +++ schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 180 +++++ schemes/rrtmgp/rrtmgp_lw_main.F90 | 287 ++++++++ schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 195 ++++++ schemes/rrtmgp/rrtmgp_post.F90 | 116 ++++ schemes/rrtmgp/rrtmgp_pre.F90 | 387 +++++++++++ .../rrtmgp/utils/calculate_net_heating.F90 | 69 ++ schemes/rrtmgp/utils/radiation_tools.F90 | 98 +++ schemes/rrtmgp/utils/radiation_utils.F90 | 203 ++++++ .../rrtmgp_dry_static_energy_tendency.F90 | 63 ++ 26 files changed, 3088 insertions(+) create mode 100644 phys_utils/atmos_phys_string_utils.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes.meta create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes_byband.meta create mode 100644 schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_gas_concentrations.meta create mode 100644 schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta create mode 100644 schemes/rrtmgp/objects/ccpp_optical_props.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_optical_props.meta create mode 100644 schemes/rrtmgp/objects/ccpp_source_functions.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_source_functions.meta create mode 100644 schemes/rrtmgp/rrtmgp_inputs.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_main.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 create mode 100644 schemes/rrtmgp/rrtmgp_post.F90 create mode 100644 schemes/rrtmgp/rrtmgp_pre.F90 create mode 100644 schemes/rrtmgp/utils/calculate_net_heating.F90 create mode 100644 schemes/rrtmgp/utils/radiation_tools.F90 create mode 100644 schemes/rrtmgp/utils/radiation_utils.F90 create mode 100644 schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 diff --git a/phys_utils/atmos_phys_string_utils.F90 b/phys_utils/atmos_phys_string_utils.F90 new file mode 100644 index 00000000..13383390 --- /dev/null +++ b/phys_utils/atmos_phys_string_utils.F90 @@ -0,0 +1,58 @@ +module atmos_phys_string_utils + ! String utils + + implicit none + private + + public :: to_lower + public :: to_upper + +contains + + pure function to_lower(input_string) result(lowercase_string) + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: lowercase_string + ! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: upper_to_lower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + upper_to_lower = iachar("a") - iachar("A") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + upper_to_lower) + lowercase_string(i:i) = ctmp + end do + + end function to_lower + +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- + + pure function to_upper(input_string) result(uppercase_string) + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: uppercase_string + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: lower_to_upper ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + lower_to_upper = iachar("A") - iachar("a") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + lower_to_upper) + uppercase_string(i:i) = ctmp + end do + + end function to_upper + +end module atmos_phys_string_utils diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.F90 b/schemes/rrtmgp/objects/ccpp_fluxes.F90 new file mode 100644 index 00000000..d1ab0e3c --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.F90 @@ -0,0 +1,12 @@ +module ccpp_fluxes + ! CCPP wrapper for ty_fluxes DDT from RRTMGP + use mo_fluxes, only: ty_fluxes + use mo_fluxes, only: ty_fluxes_broadband + + !> \section arg_table_ty_fluxes_broadband_ccpp Argument Table + !! \htmlinclude ty_fluxes_broadband_ccpp.html + type, public :: ty_fluxes_broadband_ccpp + type(ty_fluxes_broadband) :: fluxes + end type + +end module ccpp_fluxes diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta new file mode 100644 index 00000000..e2e5b6fc --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -0,0 +1,7 @@ +[ccpp-table-properties] + name = ty_fluxes_broadband_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_fluxes_broadband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 new file mode 100644 index 00000000..6212efbf --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 @@ -0,0 +1,12 @@ +module ccpp_fluxes_byband + ! CCPP wrapper for ty_fluxes_byband DDT from RRTMGP + use mo_fluxes_byband, only: ty_fluxes_byband + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + !> \section arg_table_ty_fluxes_byband_ccpp Argument Table + !! \htmlinclude ty_fluxes_byband_ccpp.html + type, public :: ty_fluxes_byband_ccpp + type(ty_fluxes_byband) :: fluxes + end type + +end module ccpp_fluxes_byband diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta new file mode 100644 index 00000000..6645fc1b --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -0,0 +1,7 @@ +[ccpp-table-properties] + name = ty_fluxes_byband_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_fluxes_byband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 new file mode 100644 index 00000000..3b3dd96e --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_concentrations + ! CCPP wrapper for ty_gas_concs DDT from RRTMGP + use mo_gas_concentrations, only: ty_gas_concs + + !> \section arg_table_ty_gas_concs_ccpp Argument Table + !! \htmlinclude ty_gas_concs_ccpp.html + type, public :: ty_gas_concs_ccpp + type(ty_gas_concs) :: gas_concs + end type + +end module ccpp_gas_concentrations diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta new file mode 100644 index 00000000..1bb7f386 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -0,0 +1,7 @@ +[ccpp-table-properties] + name = ty_gas_concs_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_gas_concs_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 new file mode 100644 index 00000000..158da748 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_optics_rrtmgp + ! CCPP wrapper for ty_gas_optics_rrtmgp DDT from RRTMGP + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + + !> \section arg_table_ty_gas_optics_rrtmgp_ccpp Argument Table + !! \htmlinclude ty_gas_optics_rrtmgp_ccpp.html + type, public :: ty_gas_optics_rrtmgp_ccpp + type(ty_gas_optics_rrtmgp) :: gas_props + end type + +end module ccpp_gas_optics_rrtmgp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta new file mode 100644 index 00000000..66e0f08d --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -0,0 +1,7 @@ +[ccpp-table-properties] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.F90 b/schemes/rrtmgp/objects/ccpp_optical_props.F90 new file mode 100644 index 00000000..94615e13 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.F90 @@ -0,0 +1,19 @@ +module ccpp_optical_props + ! CCPP wrapper for ty_optical_props_* DDTs from RRTMGP + use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str + use mo_optical_props, only: ty_optical_props_arry + + !> \section arg_table_ty_optical_props_1scl_ccpp Argument Table + !! \htmlinclude ty_optical_props_1scl_ccpp.html + type, public :: ty_optical_props_1scl_ccpp + type(ty_optical_props_1scl) :: optical_props + end type + + !> \section arg_table_ty_optical_props_2str_ccpp Argument Table + !! \htmlinclude ty_optical_props_2str_ccpp.html + type, public :: ty_optical_props_2str_ccpp + type(ty_optical_props_2str) :: optical_props + end type + +end module ccpp_optical_props diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta new file mode 100644 index 00000000..564fbc3c --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -0,0 +1,15 @@ +[ccpp-table-properties] + name = ty_optical_props_1scl_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_optical_props_1scl_ccpp + type = ddt + +[ccpp-table-properties] + name = ty_optical_props_2str_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_optical_props_2str_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.F90 b/schemes/rrtmgp/objects/ccpp_source_functions.F90 new file mode 100644 index 00000000..56e65e3d --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.F90 @@ -0,0 +1,11 @@ +module ccpp_source_functions + ! CCPP wrapper for ty_source_func_lw DDT from RRTMGP + use mo_source_functions, only: ty_source_func_lw + + !> \section arg_table_ty_source_func_lw_ccpp Argument Table + !! \htmlinclude ty_source_func_lw_ccpp.html + type, public :: ty_source_func_lw_ccpp + type(ty_source_func_lw) :: sources + end type + +end module ccpp_source_functions diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta new file mode 100644 index 00000000..b0fd2380 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -0,0 +1,7 @@ +[ccpp-table-properties] + name = ty_source_func_lw_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_source_func_lw_ccpp + type = ddt diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 new file mode 100644 index 00000000..d0249735 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -0,0 +1,655 @@ +module rrtmgp_inputs + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use string_utils, only: to_lower + use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp + + implicit none + private + + public :: rrtmgp_inputs_init + public :: rrtmgp_inputs_run + + contains +!> \section arg_table_rrtmgp_inputs_init Argument Table +!! \htmlinclude rrtmgp_inputs_init.html +!! + subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & + pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & + timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & + nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & + nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + + ! Inputs + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nradgas ! Number of radiatively active gases + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). + integer, intent(in) :: timestep_size ! Timestep size (s) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: iulog ! Logging unit + integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries + real(kind_phys), intent(in) :: current_cal_day ! Current calendar day + real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) + logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) + logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation + logical, intent(in) :: is_root ! Flag for whether this is the root task + character(len=*), dimension(:), intent(in) :: gaslist + + ! Outputs + integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay + ! or is 1 less than nlay if "extra layer" is used in the radiation calculations + integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation + integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) + ! Indices to specific bands for diagnostic output and COSP input + integer, intent(out) :: idx_sw_diag ! Index of band containing 500-nm wave + integer, intent(out) :: idx_nir_diag ! Index of band containing 1000-nm wave + integer, intent(out) :: idx_uv_diag ! Index of band containing 400-nm wave + integer, intent(out) :: idx_sw_cloudsim ! Index of band for shortwave cosp diagnostics + integer, intent(out) :: idx_lw_diag ! Index of band containing 1000-cm-1 wave (H2O window) + integer, intent(out) :: idx_lw_cloudsim ! Index of band for longwave cosp diagnostics + + integer, intent(out) :: nswgpts ! Number of shortwave g-points + integer, intent(out) :: nlwgpts ! Number of longwave g-points + integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points + real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed + real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands + real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously + real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle + + ! Local variables + real(kind_phys), target :: wavenumber_low_shortwave(nswbands) + real(kind_phys), target :: wavenumber_high_shortwave(nswbands) + real(kind_phys), target :: wavenumber_low_longwave(nlwbands) + real(kind_phys), target :: wavenumber_high_longwave(nlwbands) + character(len=gasnamelength) :: gaslist_lc(nradgas) + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Number of layers in radiation calculation is capped by the number of + ! pressure interfaces below 1 Pa. When the entire model atmosphere is + ! below 1 Pa then an extra layer is added to the top of the model for + ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._kind_phys ) ! pascals (0.01 mbar) + nlayp = nlay + 1 + + if (nlay == pverp) then + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + if (is_root) then + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp + end if + else + ! nlay < pverp. nlay layers are used in radiation calcs, and they are + ! all CAM layers. + ktopcam = pver - nlay + 1 + ktoprad = 1 + nlaycam = nlay + end if + + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. + call set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + call radiation_utils_init(nswbands, nlwbands, wavenumber_low_shortwave, wavenumber_high_shortwave, & + wavenumber_low_longwave, wavenumber_high_longwave, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Initialize the SW band boundaries + call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) + if (errflg /= 0) then + return + end if + + if (is_first_step) then + qrl = 0._kind_phys + end if + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dt_avg = iradsw*timestep_size + end if + + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run + if (irad_always > 0) then + irad_always = irad_always + nstep + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step) then + nextsw_cday = current_cal_day + end if + + end subroutine rrtmgp_inputs_init + +!> \section arg_table_rrtmgp_inputs_run Argument Table +!! \htmlinclude rrtmgp_inputs_run.html +!! + subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & + pmid, pint, t, nday, idxday, cldfprime, & + coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, pmid_rad, & + pint_rad, t_day, pmid_day, pint_day, coszrs_day, & + alb_dir, alb_dif, lwup, stebol, ncol, ktopcam, ktoprad, & + nswbands, asdir, asdif, sw_low_bounds, sw_high_bounds, & + aldir, aldif, nlay, pverp, pver, cld, cldfsnow, & + cldfgrau, graupel_in_rad, gasnamelength, gaslist, & + gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & + sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, & + errmsg, errflg) + ! Inputs + logical, intent(in) :: graupel_in_rad ! Flag to include graupel in radiation calculation + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: nlay ! Number of vertical layers used in radiation calculation + integer, intent(in) :: nswbands ! Number of shortwave bands + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: gasnamelength ! Length of gases in gas_list + integer, intent(in) :: nday ! Number of daylight columns + logical, intent(in) :: dosw ! Flag for performing the shortwave calculation + logical, intent(in) :: dolw ! Flag for performing the longwave calculation + logical, intent(in) :: snow_associated ! Flag for whether the cloud snow fraction argument should be used + logical, intent(in) :: graupel_associated ! Flag for whether the cloud graupel fraction argument should be used + integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Air pressure at midpoint (Pa) + real(kind_phys), dimension(:,:), intent(in) :: pint ! Air pressure at interface (Pa) + real(kind_phys), dimension(:,:), intent(in) :: t ! Air temperature (K) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq+ice) + real(kind_phys), dimension(:), intent(in) :: sw_low_bounds ! Lower bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: sw_high_bounds ! Upper bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine of solar senith angle (radians) + real(kind_phys), dimension(:), intent(in) :: lwup ! Longwave up flux (W m-2) + real(kind_phys), dimension(:), intent(in) :: asdir ! Shortwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: asdif ! Shortwave diffuse albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldir ! Longwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldif ! Longwave diffuse albedo (fraction) + real(kind_phys), intent(in) :: stebol ! Stefan-Boltzmann constant (W m-2 K-4) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + character(len=*), dimension(:), intent(in) :: gaslist ! Radiatively active gases + ! Outputs + real(kind_phys), dimension(:,:), intent(out) :: t_rad ! Air temperature with radiation indexing (K) + real(kind_phys), dimension(:,:), intent(out) :: pmid_rad ! Midpoint pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pint_rad ! Interface pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: t_day ! Air temperature of daylight columns (K) + real(kind_phys), dimension(:,:), intent(out) :: pint_day ! Interface pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pmid_day ! Midpoint pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: emis_sfc ! Surface emissivity (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dir ! Surface albedo due to UV and VIS direct (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dif ! Surface albedo due to IR diffused (fraction) + real(kind_phys), dimension(:,:), intent(out) :: cldfprime ! modified cloud fraciton + + real(kind_phys), dimension(:), intent(out) :: t_sfc ! Surface temperature (K) + real(kind_phys), dimension(:), intent(out) :: coszrs_day ! Cosine of solar zenith angle for daylight columns (radians) + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_lw ! Gas concentrations object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: atm_optics_lw ! Atmosphere optical properties object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: aer_lw ! Aerosol optical properties object for longwave radiation + type(ty_source_func_lw_ccpp), intent(out) :: sources_lw ! Longwave sources object for longwave radiation + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_sw ! Gas concentrations object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: atm_optics_sw ! Atmosphere optical properties object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: aer_sw ! Aerosol optical properties object for shortwave radiation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys) :: tref_min + real(kind_phys) :: tref_max + integer :: idx, kdx, iband + character(len=gasnamelength) :: gaslist_lc(size(gaslist)) + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw .and. .not. dolw) then + return + end if + + ! RRTMGP set state + t_sfc = sqrt(sqrt(lwup(:ncol)/stebol)) ! Surface temp set based on longwave up flux. + + ! Set surface emissivity to 1.0. + ! The land model *does* have its own surface emissivity, but is not spectrally resolved. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" + ! t_sfc is derived from that flux. We assume, therefore, that the emissivity is unity + ! to be consistent with t_sfc. + emis_sfc(:,:) = 1._kind_phys + + ! Level ordering is the same for both CAM and RRTMGP (top to bottom) + t_rad(:,ktoprad:) = t(:ncol,ktopcam:) + pmid_rad(:,ktoprad:) = pmid(:ncol,ktopcam:) + pint_rad(:,ktoprad:) = pint(:ncol,ktopcam:) + + ! Add extra layer values if needed. + if (nlay == pverp) then + t_rad(:,1) = t(:ncol,1) + ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa + ! Set the top of the extra layer just below that. + pint_rad(:,1) = 1.01_kind_phys + + ! next interface down in LT will always be > 1Pa + ! but in MT we apply adjustment to have it be 1.02 Pa if it was too high + where (pint_rad(:,2) <= pint_rad(:,1)) pint_rad(:,2) = pint_rad(:,1)+0.01_kind_phys + + ! set the highest pmid (in the "extra layer") to the midpoint (guarantees > 1Pa) + pmid_rad(:,1) = pint_rad(:,1) + 0.5_kind_phys * (pint_rad(:,2) - pint_rad(:,1)) + + ! For case of CAM MT, also ensure pint_rad(:,2) > pint_rad(:,1) & pmid_rad(:,2) > max(pmid_rad(:,1), min_pressure) + where (pmid_rad(:,2) <= kdist_sw%gas_props%get_press_min()) pmid_rad(:,2) = pint_rad(:,2) + 0.01_kind_phys + else + ! nlay < pverp, thus the 1 Pa level is within a CAM layer. Assuming the top interface of + ! this layer is at a pressure < 1 Pa, we need to adjust the top of this layer so that it + ! is within the valid pressure range of RRTMGP (otherwise RRTMGP issues an error). Then + ! set the midpoint pressure halfway between the interfaces. + pint_rad(:,1) = 1.01_kind_phys + pmid_rad(:,1) = 0.5_kind_phys * (pint_rad(:,1) + pint_rad(:,2)) + end if + + ! Limit temperatures to be within the limits of RRTMGP validity. + tref_min = kdist_sw%gas_props%get_temp_min() + tref_max = kdist_sw%gas_props%get_temp_max() + t_rad = merge(t_rad, tref_min, t_rad > tref_min) + t_rad = merge(t_rad, tref_max, t_rad < tref_max) + + ! Construct arrays containing only daylight columns + do idx = 1, nday + t_day(idx,:) = t_rad(idxday(idx),:) + pmid_day(idx,:) = pmid_rad(idxday(idx),:) + pint_day(idx,:) = pint_rad(idxday(idx),:) + coszrs_day(idx) = coszrs(idxday(idx)) + end do + ! Assign albedos to the daylight columns (from E3SM implementation) + ! Albedos are imported from the surface models as broadband (visible, and near-IR), + ! and we need to map these to appropriate narrower bands used in RRTMGP. Bands + ! are categorized broadly as "visible/UV" or "infrared" based on wavenumber. + ! Loop over bands, and determine for each band whether it is broadly in the + ! visible or infrared part of the spectrum based on a dividing line of + ! 0.7 micron, or 14286 cm^-1 + do iband = 1,nswbands + if (is_visible(sw_low_bounds(iband)) .and. & + is_visible(sw_high_bounds(iband))) then + + ! Entire band is in the visible + do idx = 1, nday + alb_dir(iband,idx) = asdir(idxday(idx)) + alb_dif(iband,idx) = asdif(idxday(idx)) + end do + + else if (.not.is_visible(sw_low_bounds(iband)) .and. & + .not.is_visible(sw_high_bounds(iband))) then + ! Entire band is in the longwave (near-infrared) + do idx = 1, nday + alb_dir(iband,idx) = aldir(idxday(idx)) + alb_dif(iband,idx) = aldif(idxday(idx)) + end do + else + ! Band straddles the visible to near-infrared transition, so we take + ! the albedo to be the average of the visible and near-infrared + ! broadband albedos + do idx = 1, nday + alb_dir(iband,idx) = 0.5_kind_phys * (aldir(idxday(idx)) + asdir(idxday(idx))) + alb_dif(iband,idx) = 0.5_kind_phys * (aldif(idxday(idx)) + asdif(idxday(idx))) + end do + end if + end do + ! Strictly enforce albedo bounds + where (alb_dir < 0) + alb_dir = 0.0_kind_phys + end where + where (alb_dir > 1) + alb_dir = 1.0_kind_phys + end where + where (alb_dif < 0) + alb_dif = 0.0_kind_phys + end where + where (alb_dif > 1) + alb_dif = 1.0_kind_phys + end where + + ! modified cloud fraction + ! Compute modified cloud fraction, cldfprime. + ! 1. initialize as cld + ! 2. modify for snow. use max(cld, cldfsnow) + ! 3. modify for graupel if graupel_in_rad is true. + ! use max(cldfprime, cldfgrau) + if (snow_associated) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cld(idx,kdx), cldfsnow(idx,kdx)) + end do + end do + else + cldfprime(:ncol,:) = cld(:ncol,:) + end if + + if (graupel_associated .and. graupel_in_rad) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cldfprime(idx,kdx), cldfgrau(idx,kdx)) + end do + end do + end if + + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects + ! work with CAM's uppercase names, but other objects that get input from the gas + ! concs objects don't work. + do idx = 1, size(gaslist) + gaslist_lc(idx) = to_lower(gaslist(idx)) + end do + + ! If no daylight columns, can't create empty RRTMGP objects + if (dosw .and. nday > 0) then + ! Initialize object for gas concentrations. + errmsg = gas_concs_sw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + ! Allocates arrays for properties represented on g-points. + errmsg = atm_optics_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for SW aerosol optics. Allocates arrays + ! for properties represented by band. + errmsg = aer_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + if (dolw) then + ! Initialize object for gas concentrations + errmsg = gas_concs_lw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + errmsg = atm_optics_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for LW aerosol optics. + errmsg = aer_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for Planck sources. + errmsg = sources_lw%sources%alloc(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + end subroutine rrtmgp_inputs_run + +!========================================================================================= +! HELPER FUNCTIONS ! +!========================================================================================= + subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. + + ! Arguments + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + + integer, intent(out) :: idx_sw_diag + integer, intent(out) :: idx_nir_diag + integer, intent(out) :: idx_uv_diag + integer, intent(out) :: idx_sw_cloudsim + integer, intent(out) :: idx_lw_diag + integer, intent(out) :: idx_lw_cloudsim + integer, intent(out) :: nswgpts + integer, intent(out) :: nlwgpts + integer, dimension(:,:), intent(out) :: band2gpt_sw + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: istat + real(kind_phys), allocatable :: values(:,:) + + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%gas_props%get_nband() /= nswbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + errflg = 1 + return + end if + if (kdist_lw%gas_props%get_nband() /= nlwbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + errflg = 1 + return + end if + + nswgpts = kdist_sw%gas_props%get_ngpt() + nlwgpts = kdist_lw%gas_props%get_ngpt() + + ! SW band bounds in cm^-1 + allocate( values(2,nswbands), stat=istat ) + if (istat/=0) then + write(errmsg, '(a,a)') sub, ': ERROR allocating array: values(2,nswbands)' + errflg = 1 + return + end if + values = kdist_sw%gas_props%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + + ! First and last g-point for each SW band: + band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() + + ! Indices into specific bands + call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands), stat=istat ) + if (istat/=0) then + write(errmsg, '(a,a)') sub, ': ERROR allocating array: values(2,nlwbands)' + errflg = 1 + return + end if + values = kdist_lw%gas_props%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine set_wavenumber_bands + +!========================================================================================= + + subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & + wavenumber_high, ans, errmsg, errflg) + + ! Find band index for requested wavelength/wavenumber. + + character(len=*), intent(in) :: swlw ! sw or lw bands + real(kind_phys), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue + integer, intent(in) :: nbnds + real(kind_phys), target, dimension(:), intent(in) :: wavenumber_low + real(kind_phys), target, dimension(:), intent(in) :: wavenumber_high + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(out) :: ans + + ! local + real(kind_phys), pointer, dimension(:) :: lowboundaries, highboundaries + real(kind_phys) :: tgt + integer :: idx + + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + lowboundaries => wavenumber_low + highboundaries => wavenumber_high + if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw + errflg = 1 + return + end if + + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) + case('nm','nanometer','nanometers') + tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) + case('cm','centimeter','centimeters') + tgt = 1._kind_phys/targetvalue + case default + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: units not recognized: ', units + errflg = 1 + end select + + ! now just loop through the array + ans = 0 + do idx = 1,nbnds + if ((tgt > lowboundaries(idx)) .and. (tgt <= highboundaries(idx))) then + ans = idx + exit + end if + end do + + if (ans == 0) then + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + errflg = 1 + end if + + end subroutine get_band_index_by_value + + !========================================================================================= + + pure logical function is_visible(wavenumber) + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + + ! wavenumber in inverse cm (cm^-1) + real(kind_phys), intent(in) :: wavenumber + + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 + real(kind_phys), parameter :: visible_wavenumber_threshold = 14286._kind_phys ! cm^-1 + + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + + end function is_visible + +end module rrtmgp_inputs diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 new file mode 100644 index 00000000..fb70eb65 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,463 @@ +! PEVERWHEE - dependencies = interpolate_data +!> \file rrtmgp_lw_cloud_optics.F90 +!! + +!> This module contains two routines: The first initializes data and functions +!! needed to compute the longwave cloud radiative properteis in RRTMGP. The second routine +!! is a ccpp scheme within the "radiation loop", where the shortwave optical properties +!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL +!! cloud types visible to RRTMGP. +module rrtmgp_lw_cloud_optics + use machine, only: kind_phys + use interpolate_data, only: interp_type, lininterp_init, & + lininterp, extrap_method_bndry, & + lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + + implicit none + public :: rrtmgp_lw_cloud_optics_run + + real(kind_phys), allocatable :: abs_lw_liq(:,:,:) + real(kind_phys), allocatable :: abs_lw_ice(:,:) + real(kind_phys), allocatable :: g_mu(:) + real(kind_phys), allocatable :: g_d_eff(:) + real(kind_phys), allocatable :: g_lambda(:,:) + real(kind_phys) :: tiny + integer :: nmu + integer :: nlambda + integer :: n_g_d + + +contains + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_init Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_init.html +!! + subroutine rrtmgp_lw_cloud_optics_init(nmu_in, nlambda_in, n_g_d_in, & + abs_lw_liq_in, abs_lw_ice_in, nlwbands, g_mu_in, g_lambda_in, & + g_d_eff_in, tiny_in, errmsg, errflg) + ! Inputs + integer, intent(in) :: nmu_in ! Number of mu samples on grid + integer, intent(in) :: nlambda_in ! Number of lambda scale samples on grid + integer, intent(in) :: n_g_d_in ! Number of radiative effective diameter samples on grid + integer, intent(in) :: nlwbands ! Number of longwave bands + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq_in ! Longwave mass specific absorption for in-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice_in ! Longwave mass specific absorption for in-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: g_lambda_in ! lambda scale samples on grid + real(kind_phys), dimension(:), intent(in) :: g_mu_in ! Mu samples on grid + real(kind_phys), dimension(:), intent(in) :: g_d_eff_in ! Radiative effective diameter samples on grid + real(kind_phys), intent(in) :: tiny_in ! Definition of what "tiny" means + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_init' + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Set module-level variables + nmu = nmu_in + nlambda = nlambda_in + n_g_d = n_g_d_in + tiny = tiny_in + ! Allocate module-level-variables + allocate(abs_lw_liq(nmu,nlambda,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq, message: ', alloc_errmsg + return + end if + allocate(abs_lw_ice(n_g_d,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice, message: ', alloc_errmsg + return + end if + allocate(g_mu(nmu), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu, message: ', alloc_errmsg + return + end if + allocate(g_lambda(nmu,nlambda), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda, message: ', alloc_errmsg + return + end if + allocate(g_d_eff(n_g_d), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff, message: ', alloc_errmsg + return + end if + + abs_lw_liq = abs_lw_liq_in + abs_lw_ice = abs_lw_ice_in + g_mu = g_mu_in + g_lambda = g_lambda_in + g_d_eff = g_d_eff_in + + end subroutine rrtmgp_lw_cloud_optics_init + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_run() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_run.html +!! + subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & + cldfprime, graupel_in_rad, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & + dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & + ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + ! Compute combined cloud optical properties + ! Create MCICA stochastic arrays for cloud LW optical properties + ! Initialize optical properties object (cloud_lw) and load with MCICA columns + + ! Inputs + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers in radiation + integer, intent(in) :: nlaycam ! Number of model layers in radiation + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: pver ! Total number of vertical layers + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfprime ! Modified cloud fraction + real(kind_phys), dimension(:,:), intent(in) :: lamc ! Prognosed value of lambda for cloud + real(kind_phys), dimension(:,:), intent(in) :: pgam ! Prognosed value of mu for cloud + real(kind_phys), dimension(:,:), intent(in) :: iclwpth ! In-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: iciwpth ! In-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: icswpth ! In-cloud snow water path + real(kind_phys), dimension(:,:), intent(in) :: icgrauwpth ! In-cloud graupel water path + real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud + real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow + real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel + logical, intent(in) :: graupel_in_rad ! Flag for whether to include graupel in calculation + logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present + logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_lw ! Longwave cloud optics object + real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction + real(kind_phys), dimension(:,:,:), intent(out) :: cld_lw_abs ! Cloud absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: tauc ! Cloud optical depth + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx, kdx + + ! cloud radiative parameters are "in cloud" not "in cell" + real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) + real(kind_phys) :: ice_lw_abs(nlwbands, ncol, pver) ! ice absorption optics depth (LW) + real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) + + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_run' + !-------------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + ! If not doing longwave, no need to proceed + if (.not. dolw) then + return + end if + + ! Combine the cloud optical properties. + + ! gammadist liquid optics + call liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & + abs_lw_liq, liq_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + ! Mitchell ice optics + call ice_cloud_get_rad_props_lw(ncol, pver, nlwbands, iciwpth, dei, n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, & + errmsg, errflg) + if (errflg /= 0) then + return + end if + + cld_lw_abs(:,:,:) = liq_lw_abs(:,:,:) + ice_lw_abs(:,:,:) + + if (do_snow) then + ! add in snow + call snow_cloud_get_rad_props_lw(ncol, pver, nlwbands, icswpth, des, n_g_d, g_d_eff, abs_lw_ice, & + snow_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfsnow(idx,kdx)*snow_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + else + c_cld_lw_abs(:,:,:) = cld_lw_abs(:,:,:) + end if + + ! add in graupel + if (do_graupel .and. graupel_in_rad) then + call grau_cloud_get_rad_props_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, g_d_eff, abs_lw_ice, & + grau_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfgrau(idx,kdx)*grau_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*c_cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + end if + + ! Extract just the layers of CAM where RRTMGP does calculations + + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns + cldf = cldfprime(:, ktopcam:) + tauc = c_cld_lw_abs(:, :, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) + + errmsg =cloud_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end subroutine rrtmgp_lw_cloud_optics_run + +!============================================================================== + + subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, & + g_mu, g_lambda, iclwpth, abs_lw_liq, abs_od, errmsg, errflg) + ! Inputs + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:,:), intent(in) :: lamc + real(kind_phys), dimension(:,:), intent(in) :: pgam + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:), intent(in) :: g_lambda + real(kind_phys), dimension(:,:), intent(in) :: iclwpth + ! Outputs + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer lwband, idx, kdx + + ! Set error variables + errflg = 0 + errmsg = '' + + abs_od = 0._kind_phys + + do kdx = 1,pver + do idx = 1,ncol + if(lamc(idx,kdx) > 0._kind_phys) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(nlwbands, nmu, nlambda, iclwpth(idx,kdx), lamc(idx,kdx), pgam(idx,kdx), abs_lw_liq, & + g_mu, g_lambda, abs_od(1:nlwbands,idx,kdx), errmsg, errflg) + else + abs_od(1:nlwbands,idx,kdx) = 0._kind_phys + endif + enddo + enddo + + end subroutine liquid_cloud_get_rad_props_lw + +!============================================================================== + + subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, abs_od, errmsg, errflg) + ! Inputs + integer, intent(in) :: nlwbands + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:) , intent(in) :: g_lambda + ! Outputs + real(kind_phys), dimension(:), intent(out) :: abs_od + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < tiny) then + abs_od = 0._kind_phys + return + endif + + call get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, mu_wgts, lambda_wgts, errmsg, errflg) + if (errflg /= 0) then + return + end if + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + + end subroutine gam_liquid_lw + +!============================================================================== + + subroutine ice_cloud_get_rad_props_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: n_g_d + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: iciwpth + real(kind_phys), dimension(:,:), intent(in) :: dei + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error variables + errflg = 0 + errmsg = '' + + call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + + end subroutine ice_cloud_get_rad_props_lw + +!============================================================================== + + subroutine snow_cloud_get_rad_props_lw(ncol, pver, nlwbands, icswpth, des, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: n_g_d + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: icswpth + real(kind_phys), dimension(:,:), intent(in) :: des + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errflg = 0 + errmsg = '' + + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + + end subroutine snow_cloud_get_rad_props_lw + +!============================================================================== + + subroutine grau_cloud_get_rad_props_lw(ncol, pver, nlwbands, icgrauwpth, degrau, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: n_g_d + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: icgrauwpth + real(kind_phys), dimension(:,:), intent(in) :: degrau + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! This does the same thing as ice_cloud_get_rad_props_lw, except with a + ! different water path and effective diameter. + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & + g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + + end subroutine grau_cloud_get_rad_props_lw + +!============================================================================== + + subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + + integer, intent(in) :: ncol + integer, intent(in) :: n_g_d + integer, intent(in) :: pver + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: iciwpth + real(kind_phys), dimension(:,:), intent(in) :: dei + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + type(interp_type) :: dei_wgts + + integer :: idx, kdx, lwband + real(kind_phys) :: absor(nlwbands) + + ! Set error variables + errflg = 0 + errmsg = '' + + do kdx = 1,pver + do idx = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(idx,kdx) < tiny .or. dei(idx,kdx) == 0._kind_phys) then + abs_od (:,idx,kdx) = 0._kind_phys + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(idx:idx,kdx), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,idx,kdx) = iciwpth(idx,kdx) * absor + where(abs_od(:,idx,kdx) > 50.0_kind_phys) abs_od(:,idx,kdx) = 50.0_kind_phys + call lininterp_finish(dei_wgts) + endif + enddo + enddo + + end subroutine interpolate_ice_optics_lw + +!============================================================================== + +end module rrtmgp_lw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 new file mode 100644 index 00000000..d91afadb --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,89 @@ +!> \file rrtmgp_lw_gas_optics.F90 +!! + +!> This module contains a run routine to compute gas optics during the radiation subcycle +module rrtmgp_lw_gas_optics + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + + implicit none + + public :: rrtmgp_lw_gas_optics_run +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_run.html +!! + subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & + gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & + errmsg, errflg) + ! Inputs + logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation + logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + real(kind_phys), dimension(:), intent(in) :: tsfg !< Surface skin temperature [K] + real(kind_phys), dimension(:,:), intent(in) :: t_lev !< Air temperature at interfaces [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object + type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + if (include_interface_temp) then + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev(iCol:iCol2,:)) ! IN - Temperature @ layer-interfaces (K) (optional) + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources) ! OUT - RRTMGP DDT: source functions + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + + end subroutine rrtmgp_lw_gas_optics_run + +end module rrtmgp_lw_gas_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 new file mode 100644 index 00000000..3de9f2f9 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -0,0 +1,99 @@ +!> \file rrtmgp_lw_gas_optics_data.F90 +!! + +!> This module contains an init routine to initialize the gas optics object +!> with data read in from file on the host side +module rrtmgp_lw_gas_optics_data + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + + implicit none + + +contains +!> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_data_init.html +!! + subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, & + key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & + temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & + kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & + minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & + scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & + errmsg, errflg) + + ! Inputs + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + character(len=*), dimension(:), intent(in) :: gas_names ! Names of absorbing gases + character(len=*), dimension(:), intent(in) :: gas_minor ! Name of absorbing minor gas + character(len=*), dimension(:), intent(in) :: identifier_minor ! Unique string identifying minor gas + character(len=*), dimension(:), intent(in) :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=*), dimension(:), intent(in) :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), intent(in) :: key_species ! Key species pair for each band + integer, dimension(:,:), intent(in) :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), intent(in) :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical, dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical, dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical, dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical, dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), intent(in) :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), intent(in) :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), intent(in) :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), intent(in) :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), intent(in) :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), intent(in) :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), intent(in) :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), intent(in) :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errflg ! CCPP error code + + ! Initialize error variables + errmsg = '' + errflg = 0 + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit) + + if (len_trim(errmsg) > 0) then + errflg = 1 + end if + call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_lw_gas_optics_data_init + +end module rrtmgp_lw_gas_optics_data diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 new file mode 100644 index 00000000..dcbdaf87 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -0,0 +1,180 @@ +module rrtmgp_lw_gas_optics_pre + use machine, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + + implicit none + + public :: rrtmgp_lw_gas_optics_pre_run +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_pre_run.html +!! + subroutine rrtmgp_lw_gas_optics_pre_run(icall, rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & + pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) + + ! Set gas vmr for the gases in the radconstants module's gaslist. + + integer, intent(in) :: icall ! Subcycle index of climate/diagnostic radiation call + character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + integer, intent(in) :: nlay ! Number of layers in radiation calculation + integer, intent(in) :: ncol ! Total number of columns + integer, intent(in) :: pverp ! Total number of layer interfaces + integer, intent(in) :: idxday(:) ! Indices of daylight columns + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: nradgas ! Number of radiatively active gases + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculaion + real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa] + real(kind_phys), intent(in) :: rad_const_array(:,:,:) ! array of radiatively-active constituent vmrs + ! last index corresponds to index in gaslist + + type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, gas_idx, idx(ncol) + integer :: istat + real(kind_phys) :: gas_mmr(ncol, pverp-1) + real(kind_phys) :: gas_vmr(ncol, nlay) + real(kind_phys) :: mmr(ncol, nlay) + real(kind_phys) :: massratio + character(len=256) :: alloc_errmsg + + ! For ozone profile above model + real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=*), parameter :: sub = 'rrtmgp_lw_gas_optics_pre_run' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + ! set the column indices; just count for longwave + do i = 1, ncol + idx(i) = i + end do + + do gas_idx = 1, nradgas + + ! grab mass mixing ratio of gas + gas_mmr = rad_const_array(:,:,gas_idx) + + do i = 1, ncol + 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 (gaslist(gas_idx) == 'H2O') then + mmr = mmr / (1._kind_phys - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + call get_molar_mass_ratio(gaslist(gas_idx), massratio, errmsg, errflg) + if (errflg /= 0) then + return + end if + 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 ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_kind_phys + do i = 1, ncol + P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = 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._kind_phys + alpha) * exp(-alpha) - 1._kind_phys ) / alpha + b = 1._kind_phys - 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._kind_phys + 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(gaslist(gas_idx), gas_vmr) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end do + + end subroutine rrtmgp_lw_gas_optics_pre_run + +!========================================================================================= + + subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*), intent(in) :: gas_name + real(kind_phys), intent(out) :: massratio + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor + real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide + real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone + real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane + real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide + real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen + real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 + real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + 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 + write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) + errflg = 1 + end select + +end subroutine get_molar_mass_ratio + + +end module rrtmgp_lw_gas_optics_pre diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 new file mode 100644 index 00000000..943efb84 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -0,0 +1,287 @@ +!> \file rrtmgp_lw_main.F90 +!! This file contains the core longwave RRTMGP radiation calcuation + +!> This module contains the call to the RRTMGP-LW radiation routine +module rrtmgp_lw_main + use machine, only: kind_phys + use mo_rte_lw, only: rte_lw + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + implicit none + + public rrtmgp_lw_main_run +contains + +!> \section arg_table_rrtmgp_lw_main_run Argument Table +!! \htmlinclude rrtmgp_lw_main_run.html +!! + subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & + nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & + lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & + aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + + ! Inputs + logical, intent(in) :: doLWrad !< Flag to perform longwave calculation + logical, intent(in) :: doLWclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doGP_lwscat !< Flag to include scattering in clouds + logical, intent(in) :: use_LW_jacobian !< Flag to compute Jacobian + logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles + logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention + + integer, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used + integer, intent(in) :: nCol !< Number of horizontal points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band + class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object + + ! Outputs + real(kind_phys), dimension(:,:), intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clear-sky optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clouds !< Cloud optical properties object + + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object + + real(kind_phys), dimension(:,:), intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Local variables + integer :: iCol, iCol2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nCol) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Increment + errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Call RTE solver + if (doLWclrsky) then + if (nGauss_angles .gt. 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + else + if (use_lw_optimal_angles) then + errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) + call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + lw_Ds = lw_Ds) + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes) ! OUT - Fluxes + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + endif + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP + ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the + ! type to determine physics configuration/pathway/etc... + ! + ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. + ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the + ! rte solver (rte_lw). Rte_lw quieries the type determine if scattering is to be + ! included in the calculation. The increment procedures are called so that the correct + ! optical properties are inherited. + ! + ! ################################################################################### + + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Increment + errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + if (use_LW_jacobian) then + if (nGauss_angles .gt. 1) then + ! Compute LW Jacobians; use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + ! Compute LW Jacobians; don't use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + else + if (nGauss_angles .gt. 1) then + ! Compute LW Jacobians; use Gaussian angles + ! Don't compute LW Jacobians; use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + ! Don't compute LW Jacobians; don't use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + end if + ! No scattering in LW clouds. + else + ! Increment + errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + if (use_LW_jacobian) then + if (nGauss_angles .gt. 1) then + ! Compute LW Jacobians; use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + ! Compute LW Jacobians; don't use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + else + if (nGauss_angles .gt. 1) then + ! Don't compute LW Jacobians; use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + ! Don't compute LW Jacobians; don't use Gaussian angles + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + end if + end if + + end subroutine rrtmgp_lw_main_run +end module rrtmgp_lw_main diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 new file mode 100644 index 00000000..8c216940 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -0,0 +1,195 @@ +module rrtmgp_lw_mcica_subcol_gen +! PEVERWHEE - dependencies = shr_RandNum_mod + +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for lw cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG, with the following copyright notice, +! based on Raisanen et al., QJRMS, 2004: +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! This code is a refactored version of code originally in the files +! rrtmgp_lw_mcica_subcol_gen.F90 and mcica_subcol_gen_sw.F90 +! +! Uses the KISS random number generator. +! +! Overlap assumption: maximum-random. +! +!---------------------------------------------------------------------------------------- + +use machine, only: kind_phys +use shr_RandNum_mod, only: ShrKissRandGen +use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp +use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + +implicit none +private +save + +public :: rrtmgp_lw_mcica_subcol_gen_run + +!======================================================================================== +contains +!======================================================================================== + +!> +!> \section arg_table_rrtmgp_lw_mcica_subcol_gen_run Argument Table +!! \htmlinclude rrtmgp_lw_mcica_subcol_gen_run.html +subroutine rrtmgp_lw_mcica_subcol_gen_run( & + dolw, ktoprad, kdist, nbnd, ngpt, ncol, pver, nver, & + changeseed, pmid, cldfrac, tauc, cloud_lw, & + errmsg, errflg ) + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: nbnd ! Number of spectral bands + integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of model layers + integer, intent(in) :: nver ! Number of layers in radiation calculation + integer, intent(in) :: changeseed ! If the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Layer pressures at midpoints (Pa) + real(kind_phys), dimension(:,:), intent(in) :: cldfrac ! Layer cloud fraction + real(kind_phys), dimension(:,:,:), intent(in) :: tauc ! Cloud optical depth + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + integer :: idx, isubcol, kdx, ndx + + real(kind_phys), parameter :: cldmin = 1.0e-80_kind_phys ! min cloud fraction + real(kind_phys) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) + + real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + real(kind_phys) :: taucmcl(ngpt,ncol,nver) + !------------------------------------------------------------------------------------------ + + ! Set error variables + errflg = 0 + errmsg = '' + + ! If we're not doing longwave this timestep, no need to proceed + if (.not. dolw) then + return + end if + + ! clip cloud fraction + cldf(:,:) = cldfrac(:ncol,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._kind_phys + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do idx = 1, ncol + kiss_seed(idx,1) = (pmid(idx,pver) - int(pmid(idx,pver))) * 1000000000 + kiss_seed(idx,2) = (pmid(idx,pver-1) - int(pmid(idx,pver-1))) * 1000000000 + kiss_seed(idx,3) = (pmid(idx,pver-2) - int(pmid(idx,pver-2))) * 1000000000 + kiss_seed(idx,4) = (pmid(idx,pver-3) - int(pmid(idx,pver-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do idx = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do kdx = 2, nver + do idx = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,idx,kdx-1) > 1._kind_phys - cldf(idx,kdx-1) ) then + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx-1) + else + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx) * (1._kind_phys - cldf(idx,kdx-1)) + end if + end do + end do + end do + + do kdx = 1, nver + iscloudy(:,:,kdx) = (cdf(:,:,kdx) >= 1._kind_phys - spread(cldf(:,kdx), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do kdx = 1,nver + do idx = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,idx,kdx) .and. (cldf(idx,kdx) > 0._kind_phys) ) then + ndx = kdist%gas_props%convert_gpt2band(isubcol) + taucmcl(isubcol,idx,kdx) = tauc(ndx,idx,kdx) + else + taucmcl(isubcol,idx,kdx) = 0._kind_phys + end if + end do + end do + end do + + call kiss_gen%finalize() + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there + cloud_lw%optical_props%tau = 0.0_kind_phys + + ! Set the properties on g-points + do idx = 1, ngpt + cloud_lw%optical_props%tau(:,ktoprad:,idx) = taucmcl(idx,:,:) + end do + + ! validate checks that: tau > 0 + errmsg = cloud_lw%optical_props%validate() + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + +end subroutine rrtmgp_lw_mcica_subcol_gen_run + + +end module rrtmgp_lw_mcica_subcol_gen + diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 new file mode 100644 index 00000000..cb416be8 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -0,0 +1,116 @@ +module rrtmgp_post + + use ccpp_kinds, only: kind_phys + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + public :: rrtmgp_post_run + +contains +!> \section arg_table_rrtmgp_post_run Argument Table +!! \htmlinclude rrtmgp_post_run.html +!! +subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, netsw, errmsg, errflg) + integer, intent(in) :: ncol ! Number of columns + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] + real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] + real(kind_phys), dimension(:,:), intent(inout) :: qrs ! Shortwave heating rate [J kg-1 s-1] + real(kind_phys), dimension(:,:), intent(inout) :: qrl ! Longwave heating rate [J kg-1 s-1] + type(ty_optical_props_2str_ccpp), intent(inout) :: atm_optics_sw ! Atmosphere optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw ! Aerosol optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw ! Aerosol optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! Cloud optical properties object (shortwave) + type(ty_fluxes_broadband_ccpp), intent(inout) :: fswc ! Shortwave clear-sky flux object + type(ty_fluxes_broadband_ccpp), intent(inout) :: flwc ! Longwave clear-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: fsw ! Shortwave all-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: flw ! Longwave all-sky flux object + type(ty_source_func_lw_ccpp), intent(inout) :: sources_lw ! Longwave sources object + real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error varaibles + errflg = 0 + errmsg = '' + ! The radiative heating rates are carried in the physics buffer across timesteps + ! as Q*dp (for energy conservation). + qrs(:ncol,:) = qrs(:ncol,:) * pdel(:ncol,:) + qrl(:ncol,:) = qrl(:ncol,:) * pdel(:ncol,:) + + ! Set the netsw to be sent to the coupler + netsw(:ncol) = fsns(:ncol) + + call free_optics_sw(atm_optics_sw) + call free_optics_sw(cloud_sw) + call free_optics_sw(aer_sw) + call free_fluxes_byband(fsw) + call free_fluxes_broadband(fswc) + + call sources_lw%sources%finalize() + call free_optics_lw(cloud_lw) + call free_optics_lw(aer_lw) + call free_fluxes_byband(flw) + call free_fluxes_broadband(flwc) + +end subroutine rrtmgp_post_run + + !========================================================================================= + +subroutine free_optics_sw(optics) + + type(ty_optical_props_2str_ccpp), intent(inout) :: optics + + if (allocated(optics%optical_props%tau)) deallocate(optics%optical_props%tau) + if (allocated(optics%optical_props%ssa)) deallocate(optics%optical_props%ssa) + if (allocated(optics%optical_props%g)) deallocate(optics%optical_props%g) + call optics%optical_props%finalize() + +end subroutine free_optics_sw + +!========================================================================================= + +subroutine free_optics_lw(optics) + + type(ty_optical_props_1scl_ccpp), intent(inout) :: optics + + if (allocated(optics%optical_props%tau)) deallocate(optics%optical_props%tau) + call optics%optical_props%finalize() + +end subroutine free_optics_lw + +!========================================================================================= + +subroutine free_fluxes_broadband(fluxes) + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + +end subroutine free_fluxes_broadband + +!========================================================================================= + +subroutine free_fluxes_byband(fluxes) + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + + if (associated(fluxes%fluxes%bnd_flux_up)) deallocate(fluxes%fluxes%bnd_flux_up) + if (associated(fluxes%fluxes%bnd_flux_dn)) deallocate(fluxes%fluxes%bnd_flux_dn) + if (associated(fluxes%fluxes%bnd_flux_net)) deallocate(fluxes%fluxes%bnd_flux_net) + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) deallocate(fluxes%fluxes%bnd_flux_dn_dir) + +end subroutine free_fluxes_byband + +end module rrtmgp_post diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 new file mode 100644 index 00000000..448a0ead --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -0,0 +1,387 @@ +module rrtmgp_pre + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use atmos_phys_string_utils, only: to_lower + + public :: rrtmgp_pre_init + public :: rrtmgp_pre_run + public :: radiation_do_ccpp + +CONTAINS + +!> \section arg_table_rrtmgp_pre_init Argument Table +!! \htmlinclude rrtmgp_pre_init.html +!! + subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg, errflg) + integer, intent(in) :: nradgas ! Number of radiatively active gases + character(len=*), intent(in) :: gaslist(:) ! List of radiatively active gases + type(ty_gas_concs_ccpp), intent(inout) :: available_gases ! Gas concentrations object + character(len=*), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects + ! work with CAM's uppercase names, but other objects that get input from the gas + ! concs objects don't work. + do i = 1, nradgas + gaslist_lc(i) = to_lower(gaslist(i)) + end do + + errmsg = available_gases%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_pre_init + +!> \section arg_table_rrtmgp_pre_run Argument Table +!! \htmlinclude rrtmgp_pre_run.html +!! + subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & + nextsw_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & + nswbands, spectralflux, fsw, fswc, flw, flwc, errmsg, errflg) + use time_manager, only: get_curr_calday + ! Inputs + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle + integer, intent(in) :: dtime ! Timestep size [s] + integer, intent(in) :: nstep ! Timestep number + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: iradlw ! Freq. of longwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nswbands ! Number of shortwave bands + logical, intent(in) :: spectralflux ! Flag to calculate fluxes (up and down) per band + ! Outputs + class(ty_fluxes_broadband_ccpp), intent(out) :: fswc ! Clear-sky shortwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object + class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object + integer, intent(out) :: nday ! Number of daylight columns + integer, intent(out) :: nnite ! Number of nighttime columns + real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which radiation calculation will be performed + integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns + logical, intent(out) :: dosw ! Flag to do shortwave calculation + logical, intent(out) :: dolw ! Flag to do longwave calculation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx + integer :: offset + integer :: nstep_next + logical :: dosw_next + real(kind_phys) :: caldayp1 + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Gather night/day column indices. + nday = 0 + nnite = 0 + do idx = 1, ncol + if ( coszrs(idx) > 0.0_kind_phys ) then + nday = nday + 1 + idxday(nday) = idx + else + nnite = nnite + 1 + idxnite(nnite) = idx + end if + end do + + ! Determine if we're going to do longwave and/or shortwave this timestep + call radiation_do_ccpp('sw', nstep, iradsw, irad_always, dosw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call radiation_do_ccpp('lw', nstep, iradlw, irad_always, dolw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Get time of next radiation calculation - albedos will need to be + ! calculated by each surface model at this time + nextsw_cday = -1._kind_phys + dosw_next = .false. + offset = 0 + nstep_next = nstep + do while (.not. dosw_next) + nstep_next = nstep_next + 1 + offset = offset + dtime + call radiation_do_ccpp('sw', nstep_next, iradsw, irad_always, dosw_next, errmsg, errflg) + if (errflg /= 0) then + return + end if + if (dosw_next) then + nextsw_cday = get_curr_calday(offset=offset) + end if + end do + if(nextsw_cday == -1._kind_phys) then + errflg = 1 + errmsg = 'next calendar day with shortwave calculation not found' + return + end if + + ! determine if next radiation time-step not equal to next time-step + if (nstep >= 1) then + caldayp1 = get_curr_calday(offset=int(dtime)) + if (caldayp1 /= nextsw_cday) nextsw_cday = -1._kind_phys + end if + + ! Allocate the flux arrays and init to zero. + call initialize_rrtmgp_fluxes_byband(nday, nlay+1, nswbands, nswbands, spectralflux, fsw, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(nday, nlay+1, nswbands, nswbands, spectralflux, fswc, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_byband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flwc, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine rrtmgp_pre_run + +!================================================================================================ + +subroutine radiation_do_ccpp(op, nstep, irad, irad_always, radiation_do, errmsg, errflg) + + ! Return true if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in) :: nstep + integer, intent(in) :: irad + integer, intent(in) :: irad_always + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + logical, intent(out) :: radiation_do ! return value + + !----------------------------------------------------------------------- + + ! Set error variables + errflg = 0 + errmsg = '' + + select case (op) + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case default + errflg = 1 + errmsg = 'radiation_do_ccpp: unknown operation:'//op + end select + +end subroutine radiation_do_ccpp + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_broadband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Initialize + call reset_fluxes_broadband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_broadband + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_byband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes_byband' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Fluxes by band always needed for SW. Only allocate for LW + ! when spectralflux is true. + if (nbands == nswbands .or. spectralflux) then + allocate(fluxes%fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + end if + + ! Initialize + call reset_fluxes_byband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_byband + +!========================================================================================= + +subroutine reset_fluxes_broadband(fluxes) + + ! Reset flux arrays to zero. + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + +end subroutine reset_fluxes_broadband + +!========================================================================================= + +subroutine reset_fluxes_byband(fluxes) + + ! Reset flux arrays to zero. + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + + ! Reset band-by-band fluxes + if (associated(fluxes%fluxes%bnd_flux_up)) fluxes%fluxes%bnd_flux_up(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn)) fluxes%fluxes%bnd_flux_dn(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_net)) fluxes%fluxes%bnd_flux_net(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) fluxes%fluxes%bnd_flux_dn_dir(:,:,:) = 0._kind_phys + +end subroutine reset_fluxes_byband + +!========================================================================================= + +end module rrtmgp_pre diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 new file mode 100644 index 00000000..7c39882b --- /dev/null +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -0,0 +1,69 @@ +module calculate_net_heating +! PEVERWHEE - this should go in schemes/rrtmgp/utils +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +use ccpp_kinds, only: kind_phys + +implicit none +private +save + +! Public interfaces +public :: calculate_net_heating_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_calculate_net_heating_run Argument Table +!! \htmlinclude calculate_net_heating_run.html +!! +subroutine calculate_net_heating_run(ncol, rad_heat, qrl, qrs, fsns, fsnt, flns, flnt, & + is_offline_dyn, net_flx, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + + ! Arguments + integer, intent(in) :: ncol ! horizontal dimension + real(kind_phys), intent(in) :: qrl(:,:) ! longwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: qrs(:,:) ! shortwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: fsns(:) ! Surface solar absorbed flux [W m-2] + real(kind_phys), intent(in) :: fsnt(:) ! Net column abs solar flux at model top [W m-2] + real(kind_phys), intent(in) :: flns(:) ! Srf longwave cooling (up-down) flux [W m-2] + real(kind_phys), intent(in) :: flnt(:) ! Net outgoing lw flux at model top [W m-2] + logical, intent(in) :: is_offline_dyn ! is offline dycore + real(kind_phys), intent(out) :: rad_heat(:,:) ! radiative heating [J kg-1 s-1] + real(kind_phys), intent(out) :: net_flx(:) ! net boundary flux [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Local variables + integer :: idx + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + if (.not. is_offline_dyn) then + rad_heat(:ncol,:) = (qrs(:ncol,:) + qrl(:ncol,:)) + end if + + do idx = 1, ncol + net_flx(idx) = fsnt(idx) - fsns(idx) - flnt(idx) + flns(idx) + end do + +end subroutine calculate_net_heating_run + +!================================================================================================ +end module calculate_net_heating diff --git a/schemes/rrtmgp/utils/radiation_tools.F90 b/schemes/rrtmgp/utils/radiation_tools.F90 new file mode 100644 index 00000000..e941a346 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_tools.F90 @@ -0,0 +1,98 @@ +!>\file radiation_tools.F90 +!! + +!> This module contains tools for radiation +module radiation_tools + use machine, only: & + kind_phys ! Working type + implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP +contains + +!> + subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) + ! Inputs + integer, intent(in) :: & + nCol,nLev + real(kind_phys),intent(in) :: & + minP + real(kind_phys),dimension(nCol),intent(in) :: & + tsfc + real(kind_phys),dimension(nCol,nLev),intent(in) :: & + p_lay,t_lay + real(kind_phys),dimension(nCol,nLev+1),intent(in) :: & + p_lev + + ! Outputs + real(kind_phys),dimension(nCol,nLev+1),intent(out) :: & + t_lev + + ! Local + integer :: iCol,iLay, iSFC, iTOA + logical :: top_at_1 + real(kind_phys), dimension(nCol,nLev) :: tem2da, tem2db + + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + if (iTOA .eq. 1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(minP, p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) + else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(minP, p_lev(iCol,iTOA)) ) + enddo + + t_lev(1:NCOL,1) = tsfc(1:NCOL) + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) + endif + + end subroutine cmp_tlev + +!> + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg + +end module radiation_tools diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 new file mode 100644 index 00000000..2eeb2ff8 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -0,0 +1,203 @@ +module radiation_utils + ! PEVERWHEE - this should go in schemes/rrtmgp/utils + use ccpp_kinds, only: kind_phys + use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry + + public :: radiation_utils_init + public :: get_sw_spectral_boundaries_ccpp + public :: get_lw_spectral_boundaries_ccpp + public :: get_mu_lambda_weights_ccpp + + real(kind_phys), allocatable :: wavenumber_low_shortwave(:) + real(kind_phys), allocatable :: wavenumber_high_shortwave(:) + real(kind_phys), allocatable :: wavenumber_low_longwave(:) + real(kind_phys), allocatable :: wavenumber_high_longwave(:) + integer :: nswbands + integer :: nlwbands + logical :: wavenumber_boundaries_set = .false. + +contains + + subroutine radiation_utils_init(nswbands_in, nlwbands_in, low_shortwave, high_shortwave, & + low_longwave, high_longwave, errmsg, errflg) + integer, intent(in) :: nswbands_in ! Number of shortwave bands + integer, intent(in) :: nlwbands_in ! Number of longwave bands + real(kind_phys), intent(in) :: low_shortwave(:) ! Low range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: high_shortwave(:) ! High range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: low_longwave(:) ! Low range values for longwave bands (cm-1) + real(kind_phys), intent(in) :: high_longwave(:) ! High range values for longwave bands (cm-1) + integer, intent(out) :: errflg + character(len=*),intent(out) :: errmsg + ! Local variables + character(len=256) :: alloc_errmsg + + errflg = 0 + errmsg = '' + nswbands = nswbands_in + nlwbands = nlwbands_in + allocate(wavenumber_low_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_low_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_longwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_longwave, message: ', & + alloc_errmsg + end if + + wavenumber_low_shortwave = low_shortwave + wavenumber_high_shortwave = high_shortwave + wavenumber_low_longwave = low_longwave + wavenumber_high_longwave = high_longwave + + wavenumber_boundaries_set = .true. + + end subroutine radiation_utils_init + +!========================================================================================= + + subroutine get_sw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each shortwave band in the units requested + + real(kind_phys), dimension(:), intent(out) :: low_boundaries ! low range bounds for shortwave bands in requested units + real(kind_phys), dimension(:), intent(out) :: high_boundaries ! high range bounds for shortwave bands in requested units + character(*), intent(in) :: units ! requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_sw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_shortwave + high_boundaries = wavenumber_high_shortwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_shortwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_shortwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_shortwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_shortwave + high_boundaries = 1._kind_phys/wavenumber_low_shortwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + + end subroutine get_sw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_lw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each longwave band in the units requested + + real(kind_phys), intent(out) :: low_boundaries(nlwbands) ! low range bounds for longwave bands in requested units + real(kind_phys), intent(out) :: high_boundaries(nlwbands) ! high range bounds for longwave bands in requested units + character(*), intent(in) :: units ! requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_lw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_longwave + high_boundaries = 1._kind_phys/wavenumber_low_longwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + +end subroutine get_lw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, & + mu_wgts, lambda_wgts, errmsg, errflg) + ! Get mu and lambda interpolation weights + integer, intent(in) :: nmu ! number of mu values + integer, intent(in) :: nlambda ! number of lambda values + real(kind_phys), intent(in) :: g_mu(:) ! mu values + real(kind_phys), intent(in) :: g_lambda(:,:) ! lambda table + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts ! mu interpolation weights + type(interp_type), intent(out) :: lambda_wgts ! lambda interpolation weights + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: ilambda + real(kind_phys) :: g_lambda_interp(nlambda) + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights_ccpp + +!========================================================================================= + +end module radiation_utils diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 new file mode 100644 index 00000000..c5d7e892 --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -0,0 +1,63 @@ +module rrtmgp_dry_static_energy_tendency +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +use ccpp_kinds, only: kind_phys + +implicit none +private +save + +! Public interfaces +public :: rrtmgp_dry_static_energy_tendency_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_rrtmgp_dry_static_energy_tendency_run Argument Table +!! \htmlinclude rrtmgp_dry_static_energy_tendency_run.html +!! +subroutine rrtmgp_dry_static_energy_tendency_run(ncol, pdel, calc_sw_heat, calc_lw_heat, & + qrs, qrl, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + + ! Arguments + integer, intent(in) :: ncol ! Number of columns + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness + logical, intent(in) :: calc_sw_heat ! Flag to calculate net shortwave heating + logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating + real(kind_phys), dimension(:,:), intent(inout) :: qrs ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(inout) :: qrl ! longwave heating rate (J kg-1 s-1) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + if (calc_sw_heat) then + qrs(:ncol,:) = qrs(:ncol,:) / pdel(:ncol,:) + end if + + if (calc_lw_heat) then + qrl(:ncol,:) = qrl(:ncol,:) / pdel(:ncol,:) + end if + +end subroutine rrtmgp_dry_static_energy_tendency_run + +!================================================================================================ +end module rrtmgp_dry_static_energy_tendency From 4144fc19c9f619028e559a2778d956ea61106cbe Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 4 Apr 2025 09:43:14 -0600 Subject: [PATCH 002/140] wee cleanup --- schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 | 1 - schemes/rrtmgp/objects/ccpp_optical_props.F90 | 1 - schemes/rrtmgp/rrtmgp_lw_main.F90 | 2 +- schemes/rrtmgp/utils/calculate_net_heating.F90 | 1 - schemes/rrtmgp/utils/radiation_utils.F90 | 1 - 5 files changed, 1 insertion(+), 5 deletions(-) diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 index 6212efbf..67c2bddb 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 @@ -1,7 +1,6 @@ module ccpp_fluxes_byband ! CCPP wrapper for ty_fluxes_byband DDT from RRTMGP use mo_fluxes_byband, only: ty_fluxes_byband - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp !> \section arg_table_ty_fluxes_byband_ccpp Argument Table !! \htmlinclude ty_fluxes_byband_ccpp.html diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.F90 b/schemes/rrtmgp/objects/ccpp_optical_props.F90 index 94615e13..2e28c582 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.F90 +++ b/schemes/rrtmgp/objects/ccpp_optical_props.F90 @@ -2,7 +2,6 @@ module ccpp_optical_props ! CCPP wrapper for ty_optical_props_* DDTs from RRTMGP use mo_optical_props, only: ty_optical_props_1scl use mo_optical_props, only: ty_optical_props_2str - use mo_optical_props, only: ty_optical_props_arry !> \section arg_table_ty_optical_props_1scl_ccpp Argument Table !! \htmlinclude ty_optical_props_1scl_ccpp.html diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 943efb84..6f2a9d59 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -1,5 +1,5 @@ !> \file rrtmgp_lw_main.F90 -!! This file contains the core longwave RRTMGP radiation calcuation +!! !> This module contains the call to the RRTMGP-LW radiation routine module rrtmgp_lw_main diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 index 7c39882b..74815baf 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.F90 +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -1,5 +1,4 @@ module calculate_net_heating -! PEVERWHEE - this should go in schemes/rrtmgp/utils !----------------------------------------------------------------------- ! ! Purpose: Provide an interface to convert shortwave and longwave diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 index 2eeb2ff8..6538b108 100644 --- a/schemes/rrtmgp/utils/radiation_utils.F90 +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -1,5 +1,4 @@ module radiation_utils - ! PEVERWHEE - this should go in schemes/rrtmgp/utils use ccpp_kinds, only: kind_phys use interpolate_data, only: interp_type, lininterp_init, lininterp, & extrap_method_bndry From ea93c7474053cc6d2200c2ae059b7d5c5387cf45 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 5 Apr 2025 23:29:17 -0600 Subject: [PATCH 003/140] mods to remove missed time_manager dependency --- schemes/rrtmgp/rrtmgp_pre.F90 | 67 ++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 448a0ead..1ce547d6 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -40,15 +40,46 @@ subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg end subroutine rrtmgp_pre_init +!> \section arg_table_rrtmgp_pre_timestep_init Argument Table +!! \htmlinclude rrtmgp_pre_timestep_init.html +!! + subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: dtime ! Timestep size + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: offset ! Offset for next SW radiation timestep + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + logical :: dosw_next + integer :: nstepsw_next + + ! Get timestep of next radiation calculation + dosw_next = .false. + nstepsw_next = nstep + offset = 0 + do while (.not. dosw_next) + nstepsw_next = nstepsw_next + 1 + offset = offset + dtime + call radiation_do_ccpp('sw', nstepsw_next, iradsw, irad_always, dosw_next, errmsg, errflg) + if (errflg /= 0) then + return + end if + end do + + end subroutine rrtmgp_pre_timestep_init + !> \section arg_table_rrtmgp_pre_run Argument Table !! \htmlinclude rrtmgp_pre_run.html !! subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & - nextsw_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & - nswbands, spectralflux, fsw, fswc, flw, flwc, errmsg, errflg) + next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & + nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) use time_manager, only: get_curr_calday ! Inputs real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle + real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep integer, intent(in) :: dtime ! Timestep size [s] integer, intent(in) :: nstep ! Timestep number integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) @@ -60,13 +91,13 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco integer, intent(in) :: nswbands ! Number of shortwave bands logical, intent(in) :: spectralflux ! Flag to calculate fluxes (up and down) per band ! Outputs + real(kind_phys), intent(inout) :: nextsw_cday ! The next calendar day during which calculation will be performed class(ty_fluxes_broadband_ccpp), intent(out) :: fswc ! Clear-sky shortwave flux object class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object integer, intent(out) :: nday ! Number of daylight columns integer, intent(out) :: nnite ! Number of nighttime columns - real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which radiation calculation will be performed integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns logical, intent(out) :: dosw ! Flag to do shortwave calculation @@ -76,10 +107,6 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco ! Local variables integer :: idx - integer :: offset - integer :: nstep_next - logical :: dosw_next - real(kind_phys) :: caldayp1 ! Set error variables errflg = 0 @@ -108,33 +135,9 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco return end if - ! Get time of next radiation calculation - albedos will need to be - ! calculated by each surface model at this time - nextsw_cday = -1._kind_phys - dosw_next = .false. - offset = 0 - nstep_next = nstep - do while (.not. dosw_next) - nstep_next = nstep_next + 1 - offset = offset + dtime - call radiation_do_ccpp('sw', nstep_next, iradsw, irad_always, dosw_next, errmsg, errflg) - if (errflg /= 0) then - return - end if - if (dosw_next) then - nextsw_cday = get_curr_calday(offset=offset) - end if - end do - if(nextsw_cday == -1._kind_phys) then - errflg = 1 - errmsg = 'next calendar day with shortwave calculation not found' - return - end if - ! determine if next radiation time-step not equal to next time-step if (nstep >= 1) then - caldayp1 = get_curr_calday(offset=int(dtime)) - if (caldayp1 /= nextsw_cday) nextsw_cday = -1._kind_phys + if (next_cday /= nextsw_cday) nextsw_cday = -1._kind_phys end if ! Allocate the flux arrays and init to zero. From 28a3dfde52f862ba16ebb26f5b8218e457f97690 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 5 Apr 2025 23:50:09 -0600 Subject: [PATCH 004/140] remove use statement --- schemes/rrtmgp/rrtmgp_pre.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 1ce547d6..662b1b18 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -76,7 +76,6 @@ end subroutine rrtmgp_pre_timestep_init subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) - use time_manager, only: get_curr_calday ! Inputs real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep From 032a2520b657774b93dc661ccab24aa677bcf16c Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 7 Apr 2025 13:37:30 -0600 Subject: [PATCH 005/140] remove unused variable --- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index dcbdaf87..e784508a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -10,12 +10,11 @@ module rrtmgp_lw_gas_optics_pre !> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table !! \htmlinclude rrtmgp_lw_gas_optics_pre_run.html !! - subroutine rrtmgp_lw_gas_optics_pre_run(icall, rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & + subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) ! Set gas vmr for the gases in the radconstants module's gaslist. - integer, intent(in) :: icall ! Subcycle index of climate/diagnostic radiation call character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: ncol ! Total number of columns From d058a41cadaed9c9993607df2f2e5ede88b671c9 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 8 Apr 2025 10:00:58 -0600 Subject: [PATCH 006/140] move cam_out calculation from diagnostics to post --- schemes/rrtmgp/rrtmgp_post.F90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index cb416be8..5cc55f44 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -5,6 +5,7 @@ module rrtmgp_post use ccpp_source_functions, only: ty_source_func_lw_ccpp use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use cam_logfile, only: iulog public :: rrtmgp_post_run @@ -12,9 +13,11 @@ module rrtmgp_post !> \section arg_table_rrtmgp_post_run Argument Table !! \htmlinclude rrtmgp_post_run.html !! -subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & - fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, netsw, errmsg, errflg) +subroutine rrtmgp_post_run(ncol, nlay, dolw, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, netsw, flwds, errmsg, errflg) integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of layers in radiation calculation + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] real(kind_phys), dimension(:,:), intent(inout) :: qrs ! Shortwave heating rate [J kg-1 s-1] @@ -30,6 +33,7 @@ subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, type(ty_fluxes_byband_ccpp), intent(inout) :: flw ! Longwave all-sky flux object type(ty_source_func_lw_ccpp), intent(inout) :: sources_lw ! Longwave sources object real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] + real(kind_phys), dimension(:), intent(out) :: flwds ! Down longwave flux at surface [W m-2] character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -41,8 +45,11 @@ subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, qrs(:ncol,:) = qrs(:ncol,:) * pdel(:ncol,:) qrl(:ncol,:) = qrl(:ncol,:) * pdel(:ncol,:) - ! Set the netsw to be sent to the coupler + ! Set netsw and flwds to be sent to the coupler netsw(:ncol) = fsns(:ncol) + if (dolw) then + flwds(:ncol) = flw%fluxes%flux_dn(:, nlay+1) + end if call free_optics_sw(atm_optics_sw) call free_optics_sw(cloud_sw) From 8d2d25c93fa8fd1635cfc679ff5127c0c8ca2c3d Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 10 Apr 2025 15:05:28 -0600 Subject: [PATCH 007/140] remove ncol subsetting on ccpp side --- schemes/rrtmgp/rrtmgp_inputs.F90 | 12 ++++++------ schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 2 +- schemes/rrtmgp/rrtmgp_post.F90 | 9 ++++----- schemes/rrtmgp/utils/calculate_net_heating.F90 | 2 +- .../utils/rrtmgp_dry_static_energy_tendency.F90 | 7 +++---- 5 files changed, 15 insertions(+), 17 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index d0249735..4806f911 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -246,7 +246,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & end if ! RRTMGP set state - t_sfc = sqrt(sqrt(lwup(:ncol)/stebol)) ! Surface temp set based on longwave up flux. + t_sfc = sqrt(sqrt(lwup(:)/stebol)) ! Surface temp set based on longwave up flux. ! Set surface emissivity to 1.0. ! The land model *does* have its own surface emissivity, but is not spectrally resolved. @@ -256,13 +256,13 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & emis_sfc(:,:) = 1._kind_phys ! Level ordering is the same for both CAM and RRTMGP (top to bottom) - t_rad(:,ktoprad:) = t(:ncol,ktopcam:) - pmid_rad(:,ktoprad:) = pmid(:ncol,ktopcam:) - pint_rad(:,ktoprad:) = pint(:ncol,ktopcam:) + t_rad(:,ktoprad:) = t(:,ktopcam:) + pmid_rad(:,ktoprad:) = pmid(:,ktopcam:) + pint_rad(:,ktoprad:) = pint(:,ktopcam:) ! Add extra layer values if needed. if (nlay == pverp) then - t_rad(:,1) = t(:ncol,1) + t_rad(:,1) = t(:,1) ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa ! Set the top of the extra layer just below that. pint_rad(:,1) = 1.01_kind_phys @@ -359,7 +359,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & end do end do else - cldfprime(:ncol,:) = cld(:ncol,:) + cldfprime(:,:) = cld(:,:) end if if (graupel_associated .and. graupel_in_rad) then diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 8c216940..30a58295 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -104,7 +104,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & end if ! clip cloud fraction - cldf(:,:) = cldfrac(:ncol,:) + cldf(:,:) = cldfrac(:,:) where (cldf(:,:) < cldmin) cldf(:,:) = 0._kind_phys end where diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index cb416be8..5a2e7e88 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -12,9 +12,8 @@ module rrtmgp_post !> \section arg_table_rrtmgp_post_run Argument Table !! \htmlinclude rrtmgp_post_run.html !! -subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & +subroutine rrtmgp_post_run(qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, netsw, errmsg, errflg) - integer, intent(in) :: ncol ! Number of columns real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] real(kind_phys), dimension(:,:), intent(inout) :: qrs ! Shortwave heating rate [J kg-1 s-1] @@ -38,11 +37,11 @@ subroutine rrtmgp_post_run(ncol, qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, errmsg = '' ! The radiative heating rates are carried in the physics buffer across timesteps ! as Q*dp (for energy conservation). - qrs(:ncol,:) = qrs(:ncol,:) * pdel(:ncol,:) - qrl(:ncol,:) = qrl(:ncol,:) * pdel(:ncol,:) + qrs(:,:) = qrs(:,:) * pdel(:,:) + qrl(:,:) = qrl(:,:) * pdel(:,:) ! Set the netsw to be sent to the coupler - netsw(:ncol) = fsns(:ncol) + netsw(:) = fsns(:) call free_optics_sw(atm_optics_sw) call free_optics_sw(cloud_sw) diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 index 74815baf..1b2f6b9e 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.F90 +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -55,7 +55,7 @@ subroutine calculate_net_heating_run(ncol, rad_heat, qrl, qrs, fsns, fsnt, flns, errmsg = '' errflg = 0 if (.not. is_offline_dyn) then - rad_heat(:ncol,:) = (qrs(:ncol,:) + qrl(:ncol,:)) + rad_heat(:,:) = (qrs(:,:) + qrl(:,:)) end if do idx = 1, ncol diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index c5d7e892..93b57dfb 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -26,7 +26,7 @@ module rrtmgp_dry_static_energy_tendency !> \section arg_table_rrtmgp_dry_static_energy_tendency_run Argument Table !! \htmlinclude rrtmgp_dry_static_energy_tendency_run.html !! -subroutine rrtmgp_dry_static_energy_tendency_run(ncol, pdel, calc_sw_heat, calc_lw_heat, & +subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_heat, & qrs, qrl, errmsg, errflg) !----------------------------------------------------------------------- ! Compute net radiative heating from qrs and qrl, and the associated net @@ -34,7 +34,6 @@ subroutine rrtmgp_dry_static_energy_tendency_run(ncol, pdel, calc_sw_heat, calc_ !----------------------------------------------------------------------- ! Arguments - integer, intent(in) :: ncol ! Number of columns real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness logical, intent(in) :: calc_sw_heat ! Flag to calculate net shortwave heating logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating @@ -50,11 +49,11 @@ subroutine rrtmgp_dry_static_energy_tendency_run(ncol, pdel, calc_sw_heat, calc_ errflg = 0 if (calc_sw_heat) then - qrs(:ncol,:) = qrs(:ncol,:) / pdel(:ncol,:) + qrs(:,:) = qrs(:,:) / pdel(:,:) end if if (calc_lw_heat) then - qrl(:ncol,:) = qrl(:ncol,:) / pdel(:ncol,:) + qrl(:,:) = qrl(:,:) / pdel(:,:) end if end subroutine rrtmgp_dry_static_energy_tendency_run From 0371fd87e363aea6bb8ccfe2870919ae707019dd Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 15 Apr 2025 13:51:55 -0600 Subject: [PATCH 008/140] remove unnecessary use statement --- schemes/rrtmgp/objects/ccpp_fluxes.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.F90 b/schemes/rrtmgp/objects/ccpp_fluxes.F90 index d1ab0e3c..062f55e3 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.F90 +++ b/schemes/rrtmgp/objects/ccpp_fluxes.F90 @@ -1,6 +1,5 @@ module ccpp_fluxes - ! CCPP wrapper for ty_fluxes DDT from RRTMGP - use mo_fluxes, only: ty_fluxes + ! CCPP wrapper for ty_fluxes_broadband DDT from RRTMGP use mo_fluxes, only: ty_fluxes_broadband !> \section arg_table_ty_fluxes_broadband_ccpp Argument Table From 49e6ec240f53dad382602d4b325d9198d8b399fc Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 22 Apr 2025 11:15:07 -0600 Subject: [PATCH 009/140] remove unnecessary argument from lw cloud optics scheme --- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index fb70eb65..874a4bfa 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -112,7 +112,7 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & - cldfprime, graupel_in_rad, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) ! Compute combined cloud optical properties @@ -139,7 +139,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel - logical, intent(in) :: graupel_in_rad ! Flag for whether to include graupel in calculation logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation @@ -214,7 +213,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, end if ! add in graupel - if (do_graupel .and. graupel_in_rad) then + if (do_graupel) then call grau_cloud_get_rad_props_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, g_d_eff, abs_lw_ice, & grau_lw_abs, errmsg, errflg) if (errflg /= 0) then From d3f0abfde66af5425ecbe1d54891f32e3815e594 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Fri, 2 May 2025 16:27:30 -0600 Subject: [PATCH 010/140] preliminary metadata --- schemes/rrtmgp/rrtmgp_inputs.meta | 586 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 275 ++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 106 ++++ schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta | 225 +++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 100 +++ schemes/rrtmgp/rrtmgp_lw_main.meta | 142 +++++ .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 100 +++ schemes/rrtmgp/rrtmgp_post.meta | 136 ++++ schemes/rrtmgp/rrtmgp_pre.meta | 251 ++++++++ .../rrtmgp/utils/calculate_net_heating.meta | 79 +++ .../rrtmgp_dry_static_energy_tendency.meta | 49 ++ 11 files changed, 2049 insertions(+) create mode 100644 schemes/rrtmgp/rrtmgp_inputs.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_main.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta create mode 100644 schemes/rrtmgp/rrtmgp_post.meta create mode 100644 schemes/rrtmgp/rrtmgp_pre.meta create mode 100644 schemes/rrtmgp/utils/calculate_net_heating.meta create mode 100644 schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta new file mode 100644 index 00000000..119c2486 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -0,0 +1,586 @@ +[ccpp-table-properties] + name = rrtmgp_inputs + type = scheme + +[ccpp-arg-table] + name = rrtmgp_inputs_init + type = scheme +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ nlaycam ] + standard_name = enter_standard_name_22 + units = enter_units + type = integer + dimensions = () + intent = out +[ sw_low_bounds ] + standard_name = min_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out +[ sw_high_bounds ] + standard_name = max_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ pref_edge ] + standard_name = reference_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (vertical_interface_dimension) + intent = in +[ nlay ] + standard_name = enter_standard_name_23 + units = enter_units + type = integer + dimensions = () + intent = out +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ kdist_lw ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ qrl ] + standard_name = longwave_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ is_first_step ] + standard_name = is_first_timestep + units = flag + type = logical + dimensions = () + intent = in +[ use_rad_dt_cosz ] + standard_name = use_adjusted_radiation_timestep_for_solar_zenith_angle_calculation + units = flag + type = logical + dimensions = () + intent = in +[ timestep_size ] + standard_name = timestep_for_physics + units = s + type = integer + dimensions = () + intent = in +[ nstep ] + standard_name = current_timestep_number + units = count + type = integer + dimensions = () + intent = in +[ iradsw ] + standard_name = frequency_of_shortwave_radiation_calculation + units = 1 + type = integer + dimensions = () + intent = in +[ dt_avg ] + standard_name = averaging_time_interval_for_solar_zenith_angle_calculation + units = s + type = real | kind = kind_phys + dimensions = () + intent = inout +[ irad_always ] + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + units = count + type = integer + dimensions = () + intent = inout +[ is_first_restart_step ] + standard_name = is_first_restart_timestep + units = flag + type = logical + dimensions = () + intent = in +[ is_root ] + standard_name = flag_for_mpi_root + units = flag + type = logical + dimensions = () + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation + units = number_of_bands_for_longwave_radiation + type = count + dimensions = () + intent = in +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gasnamelength ] + standard_name = character_length_of_list_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ iulog ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in +[ idx_sw_diag ] + standard_name = index_of_shortwave_band + units = index + type = integer + dimensions = () + intent = out +[ idx_nir_diag ] + standard_name = index_of_near_IR_band + units = index + type = integer + dimensions = () + intent = out +[ idx_uv_diag ] + standard_name = index_of_UV_band + units = index + type = integer + dimensions = () + intent = out +[ idx_sw_cloudsim ] + standard_name = index_of_shortwave_band_for_COSP + units = index + type = integer + dimensions = () + intent = out +[ idx_lw_diag ] + standard_name = index_of_longwave_band + units = index + type = integer + dimensions = () + intent = out +[ idx_lw_cloudsim ] + standard_name = index_of_longwave_band_for_COSP + units = index + type = integer + dimensions = () + intent = out +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (number_of_active_gases_for_RRTMGP) + intent = in +[ nswgpts ] + standard_name = number_of_shortwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = out +[ nlwgpts ] + standard_name = number_of_longwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = out +[ nlayp ] + standard_name = enter_standard_name_24 + units = enter_units + type = integer + dimensions = () + intent = out +[ nextsw_cday ] + standard_name = next_calendar_day_to_perform_shortwave_radiation_for_surface_models + units = days + type = real | kind = kind_phys + dimensions = () + intent = out +[ current_cal_day ] + standard_name = current_calendar_day + units = days + type = real | kind = kind_phys + dimensions = () + intent = in +[ band2gpt_sw ] + standard_name = shortwave_start_and_end_gpoint_for_each_band + units = index + type = integer + dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_inputs_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ snow_associated ] + standard_name = include_snow_absorption_optical_depth + units = flag + type = logical + dimensions = () + intent = in +[ graupel_associated ] + standard_name = include_graupel_absorption_optical_depth + units = flag + type = logical + dimensions = () + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ pint ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ t ] + standard_name = air_temperature + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (vertical_layer_dimension) + intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ coszrs ] + standard_name = cosine_of_solar_zenith_angle + units = rad + type = real | kind = kind_phys + dimensions = (vertical_layer_dimension) + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ t_sfc ] + standard_name = ground_temperature_at_surface_for_radiation + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ emis_sfc ] + standard_name = longwave_emissivity_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) + intent = out +[ t_rad ] + standard_name = air_temperature_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ pmid_rad ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ pint_rad ] + standard_name = air_pressure_at_interface_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out +[ t_day ] + standard_name = air_temperature_for_daytime_points_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ pmid_day ] + standard_name = air_pressure_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ pint_day ] + standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out +[ coszrs_day ] + standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep + units = rad + type = real | kind = kind_phys + dimensions = (daytime_points_dimension) + intent = out +[ alb_dir ] + standard_name = albedo_direct_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = out +[ alb_dif ] + standard_name = albedo_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = out +[ lwup ] + standard_name = longwave_upward_radiative_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ stebol ] + standard_name = stefan_boltzmanns_constant + units = W m-2 K-4 + type = real | kind = kind_phys + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_dimension + units = count + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ asdir ] + standard_name = albedo_at_surface_due_to_UV_and_VIS_direct + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ asdif ] + standard_name = albedo_due_to_UV_and_VIS_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ sw_low_bounds ] + standard_name = min_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = in +[ sw_high_bounds ] + standard_name = max_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = in +[ aldir ] + standard_name = albedo_due_to_near_IR_direct_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ aldif ] + standard_name = albedo_due_to_near_IR_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ nlay ] + standard_name = enter_standard_name_46 + units = enter_units + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ cld ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldfsnow ] + standard_name = liquid_plus_snow_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldfgrau ] + standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ graupel_in_rad ] + standard_name = do_calculate_radiative_effect_of_graupel + units = flag + type = logical + dimensions = () + intent = in +[ gasnamelength ] + standard_name = character_length_of_list_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (number_of_active_gases_for_RRTMGP) + intent = in +[ gas_concs_lw ] + standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = out +[ aer_lw ] + standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = out +[ atm_optics_lw ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = out +[ kdist_lw ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ sources_lw ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = out +[ aer_sw ] + standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = out +[ atm_optics_sw ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = out +[ gas_concs_sw ] + standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta new file mode 100644 index 00000000..d8823c6d --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -0,0 +1,275 @@ +[ccpp-table-properties] + name = rrtmgp_lw_cloud_optics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_init + type = scheme +[ nmu_in ] + standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = in +[ nlambda_in ] + standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = in +[ n_g_d_in ] + standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid + units = count + type = integer + dimensions = () + intent = in +[ abs_lw_liq_in ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path + units = enter_units + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) + intent = in +[ abs_lw_ice_in ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_longwave_radiation) + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ g_mu_in ] + standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid + units = index + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + intent = in +[ g_lambda_in ] + standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid + units = m-1 + type = real | kind = kind_phys + dimensions = +((number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + intent = in +[ g_d_eff_in ] + standard_name = radiative_effective_diameter_samples_on_ice_optics_grid + units = microns + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) + intent = in +[ tiny_in ] + standard_name = definition_of_tiny_for_RRTMGP + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_run + type = scheme +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = enter_standard_name_14 + units = enter_units + type = integer + dimensions = () + intent = in +[ nlaycam ] + standard_name = enter_standard_name_15 + units = enter_units + type = integer + dimensions = () + intent = in +[ cld ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldfsnow ] + standard_name = liquid_plus_snow_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldfgrau ] + standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ kdist_lw ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ cloud_lw ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = out +[ lamc ] + standard_name = slope_of_droplet_distribution_for_optics + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ pgam ] + standard_name = size_distribution_shape_parameter_for_microphysics + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ iclwpth ] + standard_name = in_cloud_liquid_water_path_for_radiation + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ iciwpth ] + standard_name = cloud_ice_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ dei ] + standard_name = effective_diameter_of_stratiform_cloud_ice_particle_for_radiation + units = micron + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ icswpth ] + standard_name = cloud_snow_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ des ] + standard_name = effective_diameter_of_stratiform_snow_particle + units = micron + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ icgrauwpth ] + standard_name = stratiform_in_cloud_graupel_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ degrau ] + standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ do_snow ] + standard_name = include_snow_absorption_optical_depth + units = flag + type = logical + dimensions = () + intent = in +[ do_graupel ] + standard_name = include_graupel_absorption_optical_depth + units = flag + type = logical + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ tauc ] + standard_name = cloud_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,<>) + intent = out +[ cldf ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,<>) + intent = out +[ cld_lw_abs ] + standard_name = in_cloud_longwave_liquid_plus_ice_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ snow_lw_abs ] + standard_name = in_cloud_longwave_snow_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ grau_lw_abs ] + standard_name = in_cloud_longwave_graupel_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta new file mode 100644 index 00000000..fff517a0 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -0,0 +1,106 @@ +[ccpp-table-properties] + name = rrtmgp_lw_gas_optics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_run + type = scheme +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = 1 + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ p_lay ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_17:enter_standard_name_18,enter_standard_name_19:enter_standard_name_20) + intent = in +[ p_lev ] + standard_name = air_pressure_at_interface_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_21:enter_standard_name_22,enter_standard_name_23:enter_standard_name_24) + intent = in +[ t_lay ] + standard_name = enter_standard_name_8 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_25:enter_standard_name_26,enter_standard_name_27:enter_standard_name_28) + intent = in +[ tsfg ] + standard_name = ground_temperature_at_surface_for_radiation + units = K + type = real | kind = kind_phys + dimensions = (enter_standard_name_29:enter_standard_name_30) + intent = in +[ gas_concs ] + standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ lw_optical_props_clrsky ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ sources ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = inout +[ t_lev ] + standard_name = enter_standard_name_10 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_31:enter_standard_name_32,enter_standard_name_33:enter_standard_name_34) + intent = in +[ include_interface_temp ] + standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation + units = flag + type = logical + dimensions = () + intent = in +[ lw_gas_props ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta new file mode 100644 index 00000000..850b6536 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta @@ -0,0 +1,225 @@ +[ccpp-table-properties] + name = rrtmgp_lw_gas_optics_data + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_data_init + type = scheme +[ kdist ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ gas_names ] + standard_name = longwave_absorbing_gas_names + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_37:enter_standard_name_38) + intent = in +[ key_species ] + standard_name = longwave_key_species_pair_for_each_band + units = none + type = integer + dimensions = (enter_standard_name_39:enter_standard_name_40,enter_standard_name_41:enter_standard_name_42,enter_standard_name_43:enter_standard_name_44) + intent = in +[ band2gpt ] + standard_name = longwave_start_and_end_gpoint_for_each_band + units = index + type = integer + dimensions = (enter_standard_name_45:enter_standard_name_46,enter_standard_name_47:enter_standard_name_48) + intent = in +[ band_lims_wavenum ] + standard_name = longwave_start_and_end_wavenumber_for_each_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_49:enter_standard_name_50,enter_standard_name_51:enter_standard_name_52) + intent = in +[ press_ref ] + standard_name = longwave_reference_pressure_bins + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_53:enter_standard_name_54) + intent = in +[ press_ref_trop ] + standard_name = longwave_reference_pressure_separating_the_lower_and_upper_atmosphere + units = Pa + type = real | kind = kind_phys + dimensions = () + intent = in +[ temp_ref ] + standard_name = longwave_reference_temperature_bins + units = K + type = real | kind = kind_phys + dimensions = (enter_standard_name_55:enter_standard_name_56) + intent = in +[ temp_ref_p ] + standard_name = longwave_standard_spectroscopic_reference_pressure + units = Pa + type = real | kind = kind_phys + dimensions = () + intent = in +[ temp_ref_t ] + standard_name = longwave_standard_spectroscopic_reference_temperature + units = K + type = real | kind = kind_phys + dimensions = () + intent = in +[ vmr_ref ] + standard_name = longwave_volume_mixing_ratios_for_reference_atmosphere + units = mol mol-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_57:enter_standard_name_58,enter_standard_name_59:enter_standard_name_60,enter_standard_name_61:enter_standard_name_62) + intent = in +[ kmajor ] + standard_name = longwave_absorption_coefficients_due_to_major_absorbing_gases + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_63:enter_standard_name_64,enter_standard_name_65:enter_standard_name_66,enter_standard_name_67:enter_standard_name_68,enter_standard_name_69:enter_standard_name_70) + intent = in +[ kminor_lower ] + standard_name = longwave_absorption_coefficients_due_to_minor_absorbing_gases_in_lower_atmosphere + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_71:enter_standard_name_72,enter_standard_name_73:enter_standard_name_74,enter_standard_name_75:enter_standard_name_76) + intent = in +[ kminor_upper ] + standard_name = longwave_absorption_coefficients_due_to_minor_absorbing_gases_in_upper_atmosphere + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_77:enter_standard_name_78,enter_standard_name_79:enter_standard_name_80,enter_standard_name_81:enter_standard_name_82) + intent = in +[ gas_minor ] + standard_name = longwave_minor_absorbing_gas_names + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_83:enter_standard_name_84) + intent = in +[ identifier_minor ] + standard_name = longwave_unique_string_identifying_minor_gas + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_85:enter_standard_name_86) + intent = in +[ minor_gases_lower ] + standard_name = longwave_minor_absorbing_gas_names_in_lower_atmosphere + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_87:enter_standard_name_88) + intent = in +[ minor_gases_upper ] + standard_name = longwave_minor_absorbing_gas_names_in_upper_atmosphere + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_89:enter_standard_name_90) + intent = in +[ minor_limits_gpt_lower ] + standard_name = longwave_start_and_end_gpoint_for_each_minor_interval_in_lower_atmosphere + units = index + type = integer + dimensions = (enter_standard_name_91:enter_standard_name_92,enter_standard_name_93:enter_standard_name_94) + intent = in +[ minor_limits_gpt_upper ] + standard_name = longwave_start_and_end_gpoint_for_each_minor_interval_in_upper_atmosphere + units = index + type = integer + dimensions = (enter_standard_name_95:enter_standard_name_96,enter_standard_name_97:enter_standard_name_98) + intent = in +[ minor_scales_with_density_lower ] + standard_name = do_longwave_density_scaling_application_to_minor_absorption_coefficients_in_lower_atmosphere + units = flag + type = logical + dimensions = (enter_standard_name_99:enter_standard_name_100) + intent = in +[ minor_scales_with_density_upper ] + standard_name = do_longwave_density_scaling_application_to_minor_absorption_coefficients_in_upper_atmosphere + units = flag + type = logical + dimensions = (enter_standard_name_101:enter_standard_name_102) + intent = in +[ scaling_gas_lower ] + standard_name = longwave_scaling_gas_name_in_lower_atmosphere + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_103:enter_standard_name_104) + intent = in +[ scaling_gas_upper ] + standard_name = longwave_scaling_gas_name_in_upper_atmosphere + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_105:enter_standard_name_106) + intent = in +[ scale_by_complement_lower ] + standard_name = do_longwave_complement_concentration_scaling_in_lower_atmosphere + units = flag + type = logical + dimensions = (enter_standard_name_107:enter_standard_name_108) + intent = in +[ scale_by_complement_upper ] + standard_name = do_longwave_complement_concentration_scaling_in_lower_atmosphere + units = flag + type = logical + dimensions = (enter_standard_name_109:enter_standard_name_110) + intent = in +[ kminor_start_lower ] + standard_name = longwave_start_index_for_contributor_of_minor_absorbing_gas_in_lower_atmosphere + units = index + type = integer + dimensions = (enter_standard_name_111:enter_standard_name_112) + intent = in +[ kminor_start_upper ] + standard_name = longwave_start_index_for_contributor_of_minor_absorbing_gas_in_upper_atmosphere + units = index + type = integer + dimensions = (enter_standard_name_113:enter_standard_name_114) + intent = in +[ totplnk ] + standard_name = longwave_integrated_spectral_radiance_by_band + units = W sr-1 m-2 Hz-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_115:enter_standard_name_116,enter_standard_name_117:enter_standard_name_118) + intent = in +[ planck_frac ] + standard_name = longwave_planck_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (enter_standard_name_119:enter_standard_name_120,enter_standard_name_121:enter_standard_name_122,enter_standard_name_123:enter_standard_name_124,enter_standard_name_125:enter_standard_name_126) + intent = in +[ rayl_lower ] + standard_name = rayleigh_absorption_coefficient_for_lower_atmosphere + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_127:enter_standard_name_128,enter_standard_name_129:enter_standard_name_130,enter_standard_name_131:enter_standard_name_132) + intent = in +[ rayl_upper ] + standard_name = rayleigh_absorption_coefficient_for_upper_atmosphere + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_133:enter_standard_name_134,enter_standard_name_135:enter_standard_name_136,enter_standard_name_137:enter_standard_name_138) + intent = in +[ optimal_angle_fit ] + standard_name = coefficients_for_linear_fit_used_in_longwave_optimal_angle_calculation + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_139:enter_standard_name_140,enter_standard_name_141:enter_standard_name_142) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta new file mode 100644 index 00000000..0d82ed85 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -0,0 +1,100 @@ +[ccpp-table-properties] + name = rrtmgp_lw_gas_optics_pre + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_pre_run + type = scheme +[ rad_const_array ] + standard_name = radiatively_active_gas_mass_mixing_ratios_wrt_dry_air + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19,enter_standard_name_20:enter_standard_name_21) + intent = in +[ pmid ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + intent = in +[ pint ] + standard_name = air_pressure_at_interface_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + intent = in +[ nlay ] + standard_name = enter_standard_name_2 + units = enter_units + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_30:enter_standard_name_31) + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (enter_standard_name_32:enter_standard_name_33) + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gas_concs ] + standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta new file mode 100644 index 00000000..8ed771f7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -0,0 +1,142 @@ +[ccpp-table-properties] + name = rrtmgp_lw_main + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_main_run + type = scheme +[ doLWrad ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ doLWclrsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + units = flag + type = logical + dimensions = () + intent = in +[ doGP_lwscat ] + standard_name = include_longwave_scattering_in_cloud_optics + units = flag + type = logical + dimensions = () + intent = in +[ use_LW_jacobian ] + standard_name = calculate_longwave_jacobian_for_RRTMGP + units = enter_units + type = logical + dimensions = () + intent = in +[ use_LW_optimal_angles ] + standard_name = compute_optimal_angles_for_use_in_RRTMGP_longwave_calculation + units = flag + type = logical + dimensions = () + intent = in +[ nGauss_angles ] + standard_name = number_of_gaussian_quadrature_angles_for_radiation + units = count + type = integer + dimensions = () + intent = in +[ nCol ] + standard_name = enter_standard_name_8 + units = enter_units + type = integer + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = 1 + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ lw_optical_props_clrsky ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ lw_optical_props_clouds ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ top_at_1 ] + standard_name = do_top_at_one_vertical_ordering_in_radiation + units = flag + type = logical + dimensions = () + intent = in +[ sources ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = in +[ sfc_emiss_byband ] + standard_name = longwave_emissivity_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (enter_standard_name_23:enter_standard_name_24,enter_standard_name_25:enter_standard_name_26) + intent = in +[ lw_gas_props ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ aerlw ] + standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ fluxlwUP_jac ] + standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP + units = W m-2 K-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_27:enter_standard_name_28,enter_standard_name_29:enter_standard_name_30) + intent = inout +[ lw_Ds ] + standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_31:enter_standard_name_32,enter_standard_name_33:enter_standard_name_34) + intent = out +[ flux_clrsky ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ flux_allsky ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta new file mode 100644 index 00000000..b6223f25 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -0,0 +1,100 @@ +[ccpp-table-properties] + name = rrtmgp_lw_mcica_subcol_gen + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_mcica_subcol_gen_run + type = scheme +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ kdist ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ nbnd ] + standard_name = number_of_spectral_bands + units = count + type = integer + dimensions = () + intent = in +[ ngpt ] + standard_name = number_of_longwave_g_point_intervals + units = enter_units + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ nver ] + standard_name = enter_standard_name_8 + units = enter_units + type = integer + dimensions = () + intent = in +[ changeseed ] + standard_name = random_number_seed_for_mcica_longwave + units = 1 + type = integer + dimensions = () + intent = in +[ pmid ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19) + intent = in +[ cldfrac ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (enter_standard_name_20:enter_standard_name_21,enter_standard_name_22:enter_standard_name_23) + intent = in +[ tauc ] + standard_name = cloud_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_24:enter_standard_name_25,enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + intent = in +[ cloud_lw ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta new file mode 100644 index 00000000..73eb7276 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -0,0 +1,136 @@ +[ccpp-table-properties] + name = rrtmgp_post + type = scheme + +[ccpp-arg-table] + name = rrtmgp_post_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = enter_standard_name_2 + units = enter_units + type = integer + dimensions = () + intent = in +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ qrs ] + standard_name = shortwave_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + intent = inout +[ qrl ] + standard_name = longwave_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + intent = inout +[ fsns ] + standard_name = shortwave_net_absorbed_solar_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (enter_standard_name_30:enter_standard_name_31) + intent = in +[ pdel ] + standard_name = air_pressure_thickness + units = Pa + type = real | kind = kind_phys + dimensions = (enter_standard_name_32:enter_standard_name_33,enter_standard_name_34:enter_standard_name_35) + intent = in +[ atm_optics_sw ] + standard_name = enter_standard_name_8 + units = enter_units + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ cloud_sw ] + standard_name = enter_standard_name_12 + units = enter_units + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ aer_sw ] + standard_name = enter_standard_name_10 + units = enter_units + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ fsw ] + standard_name = enter_standard_name_15 + units = enter_units + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ fswc ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ sources_lw ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = inout +[ cloud_lw ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ aer_lw ] + standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ flw ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ flwc ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ netsw ] + standard_name = net_shortwave_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (enter_standard_name_36:enter_standard_name_37) + intent = out +[ flwds ] + standard_name = longwave_downward_radiative_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (enter_standard_name_38:enter_standard_name_39) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta new file mode 100644 index 00000000..dd6bec67 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -0,0 +1,251 @@ +[ccpp-table-properties] + name = rrtmgp_pre + type = scheme + +[ccpp-arg-table] + name = rrtmgp_pre_init + type = scheme +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gaslist ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = character | kind = len=* + dimensions = (enter_standard_name_39:enter_standard_name_40) + intent = in +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = inout +[ gaslist_lc ] + standard_name = lowercase_list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (enter_standard_name_41:enter_standard_name_42) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_pre_timestep_init + type = scheme +[ nstep ] + standard_name = current_timestep_number + units = count + type = integer + dimensions = () + intent = in +[ dtime ] + standard_name = timestep_for_physics + units = s + type = integer + dimensions = () + intent = in +[ iradsw ] + standard_name = frequency_of_shortwave_radiation_calculation + units = 1 + type = integer + dimensions = () + intent = in +[ irad_always ] + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + units = count + type = integer + dimensions = () + intent = in +[ offset ] + standard_name = number_of_seconds_until_next_shortwave_radiation_timestep + units = s + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + + +[ccpp-arg-table] + name = rrtmgp_pre_run + type = scheme +[ coszrs ] + standard_name = cosine_of_solar_zenith_angle + units = rad + type = real | kind = kind_phys + dimensions = (enter_standard_name_43:enter_standard_name_44) + intent = in +[ nstep ] + standard_name = current_timestep_number + units = count + type = integer + dimensions = () + intent = in +[ dtime ] + standard_name = timestep_for_physics + units = s + type = integer + dimensions = () + intent = in +[ iradsw ] + standard_name = frequency_of_shortwave_radiation_calculation + units = 1 + type = integer + dimensions = () + intent = in +[ iradlw ] + standard_name = frequency_of_longwave_radiation_calculation + units = 1 + type = integer + dimensions = () + intent = in +[ irad_always ] + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ next_cday ] + standard_name = calendar_day_of_next_timestep + units = days + type = real | kind = kind_phys + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (enter_standard_name_45:enter_standard_name_46) + intent = out +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = out +[ idxnite ] + standard_name = nighttime_points + units = index + type = integer + dimensions = (enter_standard_name_47:enter_standard_name_48) + intent = out +[ nnite ] + standard_name = nighttime_points_dimension + units = count + type = integer + dimensions = () + intent = out +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = out +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = out +[ nlay ] + standard_name = enter_standard_name_22 + units = enter_units + type = integer + dimensions = () + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ spectralflux ] + standard_name = do_up_down_flux_per_band_diagnostic + units = flag + type = logical + dimensions = () + intent = in +[ nextsw_cday ] + standard_name = next_calendar_day_to_perform_shortwave_radiation_for_surface_models + units = days + type = real | kind = kind_phys + dimensions = () + intent = inout +[ fsw ] + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = out +[ fswc ] + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = out +[ flw ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = out +[ flwc ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta new file mode 100644 index 00000000..e03d1ac9 --- /dev/null +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -0,0 +1,79 @@ +[ccpp-table-properties] + name = calculate_net_heating + type = scheme + +[ccpp-arg-table] + name = calculate_net_heating_run + type = scheme +[ ncol ] + standard_name = enter_standard_name_1 + units = enter_units + type = integer + dimensions = () + intent = in +[ rad_heat ] + standard_name = enter_standard_name_9 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_13:enter_standard_name_14,enter_standard_name_15:enter_standard_name_16) + intent = out +[ qrl ] + standard_name = enter_standard_name_2 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_17:enter_standard_name_18,enter_standard_name_19:enter_standard_name_20) + intent = in +[ qrs ] + standard_name = enter_standard_name_3 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_21:enter_standard_name_22,enter_standard_name_23:enter_standard_name_24) + intent = in +[ fsns ] + standard_name = enter_standard_name_4 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_25:enter_standard_name_26) + intent = in +[ fsnt ] + standard_name = enter_standard_name_5 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_27:enter_standard_name_28) + intent = in +[ flns ] + standard_name = enter_standard_name_6 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_29:enter_standard_name_30) + intent = in +[ flnt ] + standard_name = enter_standard_name_7 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_31:enter_standard_name_32) + intent = in +[ is_offline_dyn ] + standard_name = enter_standard_name_8 + units = enter_units + type = logical + dimensions = () + intent = in +[ net_flx ] + standard_name = enter_standard_name_10 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_33:enter_standard_name_34) + intent = out +[ errmsg ] + standard_name = enter_standard_name_11 + units = enter_units + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = enter_standard_name_12 + units = enter_units + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta new file mode 100644 index 00000000..3d1d3b88 --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta @@ -0,0 +1,49 @@ +[ccpp-table-properties] + name = rrtmgp_dry_static_energy_tendency + type = scheme + +[ccpp-arg-table] + name = rrtmgp_dry_static_energy_tendency_run + type = scheme +[ pdel ] + standard_name = enter_standard_name_1 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_8:enter_standard_name_9,enter_standard_name_10:enter_standard_name_11) + intent = in +[ calc_sw_heat ] + standard_name = enter_standard_name_2 + units = enter_units + type = logical + dimensions = () + intent = in +[ calc_lw_heat ] + standard_name = enter_standard_name_3 + units = enter_units + type = logical + dimensions = () + intent = in +[ qrs ] + standard_name = enter_standard_name_4 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_12:enter_standard_name_13,enter_standard_name_14:enter_standard_name_15) + intent = inout +[ qrl ] + standard_name = enter_standard_name_5 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19) + intent = inout +[ errmsg ] + standard_name = enter_standard_name_6 + units = enter_units + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = enter_standard_name_7 + units = enter_units + type = integer + dimensions = () + intent = out From 97ff253ef5af2127c6c11cf3f1b3e04aec7e7e03 Mon Sep 17 00:00:00 2001 From: Cheryl Craig Date: Tue, 6 May 2025 11:32:22 -0600 Subject: [PATCH 011/140] more metadata mods for longwave --- schemes/rrtmgp/rrtmgp_inputs.meta | 16 +++++----- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 10 +++--- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 18 +++++------ schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 14 ++++---- schemes/rrtmgp/rrtmgp_lw_main.meta | 8 ++--- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 13 ++++---- schemes/rrtmgp/rrtmgp_post.meta | 32 +++++++++---------- schemes/rrtmgp/rrtmgp_pre.meta | 14 ++++---- 9 files changed, 64 insertions(+), 63 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 119c2486..fa631e0c 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -18,8 +18,8 @@ dimensions = () intent = out [ nlaycam ] - standard_name = enter_standard_name_22 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels + units = count type = integer dimensions = () intent = out @@ -48,8 +48,8 @@ dimensions = (vertical_interface_dimension) intent = in [ nlay ] - standard_name = enter_standard_name_23 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP + units = count type = integer dimensions = () intent = out @@ -216,8 +216,8 @@ dimensions = () intent = out [ nlayp ] - standard_name = enter_standard_name_24 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + units = count type = integer dimensions = () intent = out @@ -468,8 +468,8 @@ dimensions = (horizontal_loop_extent) intent = in [ nlay ] - standard_name = enter_standard_name_46 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP + units = count type = integer dimensions = () intent = in diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index d8823c6d..c3d20c93 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -25,7 +25,7 @@ intent = in [ abs_lw_liq_in ] standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path - units = enter_units + units = m2 kg-1 type = real | kind = kind_phys dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) intent = in @@ -97,14 +97,14 @@ dimensions = () intent = in [ nlay ] - standard_name = enter_standard_name_14 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + units = count type = integer dimensions = () intent = in [ nlaycam ] - standard_name = enter_standard_name_15 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + units = count type = integer dimensions = () intent = in diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index fff517a0..627222fa 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -33,25 +33,25 @@ standard_name = air_pressure_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_17:enter_standard_name_18,enter_standard_name_19:enter_standard_name_20) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ p_lev ] standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_21:enter_standard_name_22,enter_standard_name_23:enter_standard_name_24) + dimensions = (ihorizontal_loop_extent,vertical_interface_dimension) intent = in [ t_lay ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = air_temperature_for_RRTMGP + units = K type = real | kind = kind_phys - dimensions = (enter_standard_name_25:enter_standard_name_26,enter_standard_name_27:enter_standard_name_28) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ tsfg ] standard_name = ground_temperature_at_surface_for_radiation units = K type = real | kind = kind_phys - dimensions = (enter_standard_name_29:enter_standard_name_30) + dimensions = (horizontal_loop_extent) intent = in [ gas_concs ] standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP @@ -72,10 +72,10 @@ dimensions = () intent = inout [ t_lev ] - standard_name = enter_standard_name_10 - units = enter_units + standard_name = air_temperature_at_interfaces_for_RRTMGP + units = K type = real | kind = kind_phys - dimensions = (enter_standard_name_31:enter_standard_name_32,enter_standard_name_33:enter_standard_name_34) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ include_interface_temp ] standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta index 850b6536..7c65c1b6 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta @@ -27,7 +27,7 @@ standard_name = longwave_key_species_pair_for_each_band units = none type = integer - dimensions = (enter_standard_name_39:enter_standard_name_40,enter_standard_name_41:enter_standard_name_42,enter_standard_name_43:enter_standard_name_44) + dimensions = (ccpp_constant_two,enter_standard_name_41:enter_standard_name_42,enter_standard_name_43:enter_standard_name_44) intent = in [ band2gpt ] standard_name = longwave_start_and_end_gpoint_for_each_band diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index 0d82ed85..05d47ff9 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -9,23 +9,23 @@ standard_name = radiatively_active_gas_mass_mixing_ratios_wrt_dry_air units = kg kg-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19,enter_standard_name_20:enter_standard_name_21) + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_active_gases_for_RRTMGP) intent = in [ pmid ] standard_name = air_pressure_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ pint ] standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + dimensions = (horizontal_loop_extent,vertical_interface_dimension intent = in [ nlay ] - standard_name = enter_standard_name_2 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP + units = count type = integer dimensions = () intent = in @@ -39,13 +39,13 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=* - dimensions = (enter_standard_name_30:enter_standard_name_31) + dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ idxday ] standard_name = daytime_points units = index type = integer - dimensions = (enter_standard_name_32:enter_standard_name_33) + dimensions = (horizontal_loop_extent) intent = in [ pverp ] standard_name = vertical_interface_dimension diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta index 8ed771f7..a2e42e38 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.meta +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -25,7 +25,7 @@ intent = in [ use_LW_jacobian ] standard_name = calculate_longwave_jacobian_for_RRTMGP - units = enter_units + units = flag type = logical dimensions = () intent = in @@ -42,8 +42,8 @@ dimensions = () intent = in [ nCol ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = horizontal_loop_extent + units = count type = integer dimensions = () intent = in @@ -87,7 +87,7 @@ standard_name = longwave_emissivity_at_surface units = fraction type = real | kind = kind_phys - dimensions = (enter_standard_name_23:enter_standard_name_24,enter_standard_name_25:enter_standard_name_26) + dimensions = (enter_standard_name_23:enter_standard_name_24,horizontal_loop_extent) intent = in [ lw_gas_props ] standard_name = longwave_gas_optics_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index b6223f25..5f000abc 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -31,7 +31,7 @@ intent = in [ ngpt ] standard_name = number_of_longwave_g_point_intervals - units = enter_units + units = count type = integer dimensions = () intent = in @@ -48,8 +48,8 @@ dimensions = () intent = in [ nver ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels + units = count type = integer dimensions = () intent = in @@ -63,19 +63,20 @@ standard_name = air_pressure_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfrac ] standard_name = cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (enter_standard_name_20:enter_standard_name_21,enter_standard_name_22:enter_standard_name_23) + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) intent = in [ tauc ] standard_name = cloud_optical_depth units = 1 type = real | kind = kind_phys - dimensions = (enter_standard_name_24:enter_standard_name_25,enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + dimensions = +(enter_standard_name_24:enter_standard_name_25,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) intent = in [ cloud_lw ] standard_name = longwave_cloud_optical_properties_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 73eb7276..1f9fde85 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -12,8 +12,8 @@ dimensions = () intent = in [ nlay ] - standard_name = enter_standard_name_2 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP + units = count type = integer dimensions = () intent = in @@ -27,47 +27,47 @@ standard_name = shortwave_radiative_heating_rate units = K s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = inout [ qrl ] standard_name = longwave_radiative_heating_rate units = K s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_26:enter_standard_name_27,enter_standard_name_28:enter_standard_name_29) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = inout [ fsns ] standard_name = shortwave_net_absorbed_solar_flux_at_surface units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_30:enter_standard_name_31) + dimensions = (horizontal_loop_extent) intent = in [ pdel ] standard_name = air_pressure_thickness units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_32:enter_standard_name_33,enter_standard_name_34:enter_standard_name_35) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ atm_optics_sw ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = 1 type = ty_optical_props_2str_ccpp dimensions = () intent = inout [ cloud_sw ] - standard_name = enter_standard_name_12 - units = enter_units + standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP + units = none type = ty_optical_props_2str_ccpp dimensions = () intent = inout [ aer_sw ] - standard_name = enter_standard_name_10 - units = enter_units + standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP + units = none type = ty_optical_props_2str_ccpp dimensions = () intent = inout [ fsw ] - standard_name = enter_standard_name_15 - units = enter_units + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none type = ty_fluxes_byband_ccpp dimensions = () intent = inout @@ -111,13 +111,13 @@ standard_name = net_shortwave_flux_at_surface units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_36:enter_standard_name_37) + dimensions = (horizontal_loop_extent) intent = out [ flwds ] standard_name = longwave_downward_radiative_flux_at_surface units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_38:enter_standard_name_39) + dimensions = (horizontal_loop_extent) intent = out [ errmsg ] standard_name = ccpp_error_message diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index dd6bec67..a1a607b7 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -15,7 +15,7 @@ standard_name = number_of_active_gases_for_RRTMGP units = count type = character | kind = len=* - dimensions = (enter_standard_name_39:enter_standard_name_40) + dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ available_gases ] standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP @@ -27,7 +27,7 @@ standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none type = character | kind = len=* - dimensions = (enter_standard_name_41:enter_standard_name_42) + dimensions = (number_of_active_gases_for_RRTMGP) intent = out [ errmsg ] standard_name = ccpp_error_message @@ -100,7 +100,7 @@ standard_name = cosine_of_solar_zenith_angle units = rad type = real | kind = kind_phys - dimensions = (enter_standard_name_43:enter_standard_name_44) + dimensions = (horizontal_loop_extent) intent = in [ nstep ] standard_name = current_timestep_number @@ -148,7 +148,7 @@ standard_name = daytime_points units = index type = integer - dimensions = (enter_standard_name_45:enter_standard_name_46) + dimensions = (horizontal_loop_extent) intent = out [ nday ] standard_name = daytime_points_dimension @@ -160,7 +160,7 @@ standard_name = nighttime_points units = index type = integer - dimensions = (enter_standard_name_47:enter_standard_name_48) + dimensions = (horizontal_loop_extent) intent = out [ nnite ] standard_name = nighttime_points_dimension @@ -181,8 +181,8 @@ dimensions = () intent = out [ nlay ] - standard_name = enter_standard_name_22 - units = enter_units + standard_name = number_of_vertical_layers_in_RRTMGP + units = count type = integer dimensions = () intent = in From e07981dc2b9c84f79076594a4a762170b84b31ab Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 12 May 2025 16:50:03 -0600 Subject: [PATCH 012/140] address reviewer comments --- phys_utils/atmos_phys_rad_utils.F90 | 32 ++++++ phys_utils/atmos_phys_string_utils.F90 | 2 + schemes/rrtmgp/objects/ccpp_fluxes.meta | 1 + .../rrtmgp/objects/ccpp_fluxes_byband.meta | 1 + .../objects/ccpp_gas_concentrations.meta | 1 + .../objects/ccpp_gas_optics_rrtmgp.meta | 1 + .../rrtmgp/objects/ccpp_optical_props.meta | 1 + .../rrtmgp/objects/ccpp_source_functions.meta | 1 + schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 104 +++--------------- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 14 ++- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 10 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 7 +- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 9 +- schemes/rrtmgp/rrtmgp_post.F90 | 84 ++++++++++---- schemes/rrtmgp/rrtmgp_pre.F90 | 31 ++++-- .../rrtmgp/utils/calculate_net_heating.F90 | 30 +++-- schemes/rrtmgp/utils/radiation_utils.F90 | 11 +- .../rrtmgp_dry_static_energy_tendency.F90 | 16 +-- test/unit-test/CMakeLists.txt | 2 + .../unit-test/tests/phys_utils/CMakeLists.txt | 2 + .../tests/phys_utils/test_atmos_rad_utils.pf | 41 +++++++ .../phys_utils/test_atmos_string_utils.pf | 103 +++++++++++++++++ 22 files changed, 340 insertions(+), 164 deletions(-) create mode 100644 phys_utils/atmos_phys_rad_utils.F90 create mode 100644 test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf create mode 100644 test/unit-test/tests/phys_utils/test_atmos_string_utils.pf diff --git a/phys_utils/atmos_phys_rad_utils.F90 b/phys_utils/atmos_phys_rad_utils.F90 new file mode 100644 index 00000000..bc82e9f0 --- /dev/null +++ b/phys_utils/atmos_phys_rad_utils.F90 @@ -0,0 +1,32 @@ +module atmos_phys_rad_utils + ! Radiation utility functions + + implicit none + private + + public :: is_visible + +contains + + pure logical function is_visible(wavenumber) + use ccpp_kinds, only: kind_phys + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + + ! wavenumber in inverse cm (cm^-1) + real(kind_phys), intent(in) :: wavenumber + + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 + real(kind_phys), parameter :: visible_wavenumber_threshold = 14286._kind_phys ! cm^-1 + + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + + end function is_visible + +end module atmos_phys_rad_utils diff --git a/phys_utils/atmos_phys_string_utils.F90 b/phys_utils/atmos_phys_string_utils.F90 index 13383390..f7431f87 100644 --- a/phys_utils/atmos_phys_string_utils.F90 +++ b/phys_utils/atmos_phys_string_utils.F90 @@ -10,6 +10,7 @@ module atmos_phys_string_utils contains pure function to_lower(input_string) result(lowercase_string) + ! Return 'input_string' in all lower case character(len=*), intent(in) :: input_string character(len=len(input_string)) :: lowercase_string ! Local variables @@ -35,6 +36,7 @@ end function to_lower !--------------------------------------------------------------------------- pure function to_upper(input_string) result(uppercase_string) + ! Return 'input_string' in all upper case character(len=*), intent(in) :: input_string character(len=len(input_string)) :: uppercase_string diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index e2e5b6fc..9ee8e981 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_broadband_ccpp type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_fluxes.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta index 6645fc1b..43b7ed45 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_byband_ccpp type = ddt +# dependencies = /path/to/ext/extensions/mo_fluxes_byband.F90 [ccpp-arg-table] name = ty_fluxes_byband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta index 1bb7f386..209221c0 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_gas_concs_ccpp type = ddt +# dependencies = /path/to/ext/gas-optics/mo_gas_concentrations.F90 [ccpp-arg-table] name = ty_gas_concs_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta index 66e0f08d..e1e0df46 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_gas_optics_rrtmgp_ccpp type = ddt +# dependencies = /path/to/ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 [ccpp-arg-table] name = ty_gas_optics_rrtmgp_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index 564fbc3c..f14b163a 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_optical_props_1scl_ccpp type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_optical_props.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta index b0fd2380..03a0bbee 100644 --- a/schemes/rrtmgp/objects/ccpp_source_functions.meta +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = ty_source_func_lw_ccpp type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_source_functions.F90 [ccpp-arg-table] name = ty_source_func_lw_ccpp diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 874a4bfa..4d8f220f 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -3,20 +3,16 @@ !! !> This module contains two routines: The first initializes data and functions -!! needed to compute the longwave cloud radiative properteis in RRTMGP. The second routine +!! needed to compute the longwave cloud radiative properties in RRTMGP. The second routine !! is a ccpp scheme within the "radiation loop", where the shortwave optical properties !! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL !! cloud types visible to RRTMGP. module rrtmgp_lw_cloud_optics - use machine, only: kind_phys - use interpolate_data, only: interp_type, lininterp_init, & - lininterp, extrap_method_bndry, & - lininterp_finish - use radiation_utils, only: get_mu_lambda_weights_ccpp - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_kinds, only: kind_phys implicit none + private + public :: rrtmgp_lw_cloud_optics_init public :: rrtmgp_lw_cloud_optics_run real(kind_phys), allocatable :: abs_lw_liq(:,:,:) @@ -115,6 +111,8 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp ! Compute combined cloud optical properties ! Create MCICA stochastic arrays for cloud LW optical properties ! Initialize optical properties object (cloud_lw) and load with MCICA columns @@ -183,18 +181,18 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, return end if ! Mitchell ice optics - call ice_cloud_get_rad_props_lw(ncol, pver, nlwbands, iciwpth, dei, n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, & - errmsg, errflg) + call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if cld_lw_abs(:,:,:) = liq_lw_abs(:,:,:) + ice_lw_abs(:,:,:) + ! add in snow if (do_snow) then - ! add in snow - call snow_cloud_get_rad_props_lw(ncol, pver, nlwbands, icswpth, des, n_g_d, g_d_eff, abs_lw_ice, & - snow_lw_abs, errmsg, errflg) + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & + n_g_d, g_d_eff, abs_lw_ice, snow_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -214,8 +212,8 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in graupel if (do_graupel) then - call grau_cloud_get_rad_props_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, g_d_eff, abs_lw_ice, & - grau_lw_abs, errmsg, errflg) + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & + g_d_eff, abs_lw_ice, grau_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -294,6 +292,8 @@ end subroutine liquid_cloud_get_rad_props_lw !============================================================================== subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp ! Inputs integer, intent(in) :: nlwbands integer, intent(in) :: nmu @@ -336,82 +336,12 @@ subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, end subroutine gam_liquid_lw -!============================================================================== - - subroutine ice_cloud_get_rad_props_lw(ncol, pver, nlwbands, iciwpth, dei, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - integer, intent(in) :: ncol - integer, intent(in) :: pver - integer, intent(in) :: n_g_d - integer, intent(in) :: nlwbands - real(kind_phys), dimension(:), intent(in) :: g_d_eff - real(kind_phys), dimension(:,:), intent(in) :: iciwpth - real(kind_phys), dimension(:,:), intent(in) :: dei - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice - real(kind_phys), dimension(:,:,:), intent(out) :: abs_od - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Set error variables - errflg = 0 - errmsg = '' - - call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - - end subroutine ice_cloud_get_rad_props_lw - -!============================================================================== - - subroutine snow_cloud_get_rad_props_lw(ncol, pver, nlwbands, icswpth, des, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - integer, intent(in) :: ncol - integer, intent(in) :: pver - integer, intent(in) :: n_g_d - integer, intent(in) :: nlwbands - real(kind_phys), dimension(:), intent(in) :: g_d_eff - real(kind_phys), dimension(:,:), intent(in) :: icswpth - real(kind_phys), dimension(:,:), intent(in) :: des - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice - real(kind_phys), dimension(:,:,:), intent(out) :: abs_od - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errflg = 0 - errmsg = '' - - call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - - end subroutine snow_cloud_get_rad_props_lw - -!============================================================================== - - subroutine grau_cloud_get_rad_props_lw(ncol, pver, nlwbands, icgrauwpth, degrau, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - integer, intent(in) :: ncol - integer, intent(in) :: pver - integer, intent(in) :: n_g_d - integer, intent(in) :: nlwbands - real(kind_phys), dimension(:), intent(in) :: g_d_eff - real(kind_phys), dimension(:,:), intent(in) :: icgrauwpth - real(kind_phys), dimension(:,:), intent(in) :: degrau - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice - real(kind_phys), dimension(:,:,:), intent(out) :: abs_od - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This does the same thing as ice_cloud_get_rad_props_lw, except with a - ! different water path and effective diameter. - call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & - g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) - - end subroutine grau_cloud_get_rad_props_lw - !============================================================================== subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_init, & + lininterp_finish, extrap_method_bndry integer, intent(in) :: ncol integer, intent(in) :: n_g_d diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index d91afadb..6812b895 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -3,16 +3,12 @@ !> This module contains a run routine to compute gas optics during the radiation subcycle module rrtmgp_lw_gas_optics - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use radiation_tools, only: check_error_msg implicit none + private public :: rrtmgp_lw_gas_optics_run + contains !> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table @@ -21,6 +17,12 @@ module rrtmgp_lw_gas_optics subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg ! Inputs logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 index 3de9f2f9..2471ca80 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -4,12 +4,10 @@ !> This module contains an init routine to initialize the gas optics object !> with data read in from file on the host side module rrtmgp_lw_gas_optics_data - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg implicit none + private + public :: rrtmgp_lw_gas_optics_data_init contains @@ -26,6 +24,10 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg ! Inputs class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index e784508a..c9796cda 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -1,10 +1,10 @@ module rrtmgp_lw_gas_optics_pre - use machine, only: kind_phys - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp implicit none + private public :: rrtmgp_lw_gas_optics_pre_run + contains !> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table @@ -12,6 +12,8 @@ module rrtmgp_lw_gas_optics_pre !! subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp ! Set gas vmr for the gases in the radconstants module's gaslist. @@ -127,6 +129,7 @@ end subroutine rrtmgp_lw_gas_optics_pre_run !========================================================================================= subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + use ccpp_kinds, only: kind_phys ! return the molar mass ratio of dry air to gas based on gas_name diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 30a58295..0d39ce1f 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -28,11 +28,6 @@ module rrtmgp_lw_mcica_subcol_gen ! !---------------------------------------------------------------------------------------- -use machine, only: kind_phys -use shr_RandNum_mod, only: ShrKissRandGen -use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp -use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - implicit none private save @@ -50,6 +45,10 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & dolw, ktoprad, kdist, nbnd, ngpt, ncol, pver, nver, & changeseed, pmid, cldfrac, tauc, cloud_lw, & errmsg, errflg ) + use ccpp_kinds, only: kind_phys + use shr_RandNum_mod, only: ShrKissRandGen + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp ! Arrays use CAM vertical index convention: index increases from top to bottom. ! This index ordering is assumed in the maximum-random overlap algorithm which starts diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 5a2e7e88..f7794296 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -1,10 +1,7 @@ module rrtmgp_post - use ccpp_kinds, only: kind_phys - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + implicit none + private public :: rrtmgp_post_run @@ -12,12 +9,17 @@ module rrtmgp_post !> \section arg_table_rrtmgp_post_run Argument Table !! \htmlinclude rrtmgp_post_run.html !! -subroutine rrtmgp_post_run(qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & - fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, netsw, errmsg, errflg) +subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] - real(kind_phys), dimension(:,:), intent(inout) :: qrs ! Shortwave heating rate [J kg-1 s-1] - real(kind_phys), dimension(:,:), intent(inout) :: qrl ! Longwave heating rate [J kg-1 s-1] + real(kind_phys), dimension(:,:), intent(in) :: qrs_prime ! Shortwave heating rate [J kg-1 s-1] + real(kind_phys), dimension(:,:), intent(in) :: qrl_prime ! Longwave heating rate [J kg-1 s-1] type(ty_optical_props_2str_ccpp), intent(inout) :: atm_optics_sw ! Atmosphere optical properties object (shortwave) type(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw ! Aerosol optical properties object (longwave) type(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw ! Aerosol optical properties object (shortwave) @@ -28,6 +30,8 @@ subroutine rrtmgp_post_run(qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw type(ty_fluxes_byband_ccpp), intent(inout) :: fsw ! Shortwave all-sky flux object type(ty_fluxes_byband_ccpp), intent(inout) :: flw ! Longwave all-sky flux object type(ty_source_func_lw_ccpp), intent(inout) :: sources_lw ! Longwave sources object + real(kind_phys), dimension(:,:), intent(out) :: qrs ! Shortwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -35,23 +39,38 @@ subroutine rrtmgp_post_run(qrs, qrl, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw ! Set error varaibles errflg = 0 errmsg = '' - ! The radiative heating rates are carried in the physics buffer across timesteps + ! The radiative heating rates are maintained across multiple physics timesteps ! as Q*dp (for energy conservation). - qrs(:,:) = qrs(:,:) * pdel(:,:) - qrl(:,:) = qrl(:,:) * pdel(:,:) + qrs(:,:) = qrs_prime(:,:) * pdel(:,:) + qrl(:,:) = qrl_prime(:,:) * pdel(:,:) ! Set the netsw to be sent to the coupler netsw(:) = fsns(:) - call free_optics_sw(atm_optics_sw) - call free_optics_sw(cloud_sw) - call free_optics_sw(aer_sw) + call free_optics_sw(atm_optics_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(cloud_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(aer_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if call free_fluxes_byband(fsw) call free_fluxes_broadband(fswc) call sources_lw%sources%finalize() - call free_optics_lw(cloud_lw) - call free_optics_lw(aer_lw) + call free_optics_lw(cloud_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_lw(aer_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if call free_fluxes_byband(flw) call free_fluxes_broadband(flwc) @@ -59,24 +78,41 @@ end subroutine rrtmgp_post_run !========================================================================================= -subroutine free_optics_sw(optics) +subroutine free_optics_sw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_2str_ccpp type(ty_optical_props_2str_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + errmsg = optics%optical_props%finalize_2str() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if - if (allocated(optics%optical_props%tau)) deallocate(optics%optical_props%tau) - if (allocated(optics%optical_props%ssa)) deallocate(optics%optical_props%ssa) - if (allocated(optics%optical_props%g)) deallocate(optics%optical_props%g) call optics%optical_props%finalize() end subroutine free_optics_sw !========================================================================================= -subroutine free_optics_lw(optics) +subroutine free_optics_lw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp type(ty_optical_props_1scl_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = optics%optical_props%finalize_1scl() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if - if (allocated(optics%optical_props%tau)) deallocate(optics%optical_props%tau) call optics%optical_props%finalize() end subroutine free_optics_lw @@ -84,6 +120,7 @@ end subroutine free_optics_lw !========================================================================================= subroutine free_fluxes_broadband(fluxes) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes @@ -97,6 +134,7 @@ end subroutine free_fluxes_broadband !========================================================================================= subroutine free_fluxes_byband(fluxes) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 662b1b18..d234691f 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -1,13 +1,12 @@ module rrtmgp_pre - use ccpp_kinds, only: kind_phys - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use atmos_phys_string_utils, only: to_lower + + implicit none + private public :: rrtmgp_pre_init + public :: rrtmgp_pre_timestep_init public :: rrtmgp_pre_run - public :: radiation_do_ccpp + public :: radiation_do_ccpp ! Public because it needs to be accessed elsewhere in CAM CONTAINS @@ -15,6 +14,8 @@ module rrtmgp_pre !! \htmlinclude rrtmgp_pre_init.html !! subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg, errflg) + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use atmos_phys_string_utils, only: to_lower integer, intent(in) :: nradgas ! Number of radiatively active gases character(len=*), intent(in) :: gaslist(:) ! List of radiatively active gases type(ty_gas_concs_ccpp), intent(inout) :: available_gases ! Gas concentrations object @@ -22,6 +23,9 @@ subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables + integer :: idx + ! Set error variables errmsg = '' errflg = 0 @@ -29,8 +33,8 @@ subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. - do i = 1, nradgas - gaslist_lc(i) = to_lower(gaslist(i)) + do idx = 1, nradgas + gaslist_lc(idx) = to_lower(gaslist(idx)) end do errmsg = available_gases%gas_concs%init(gaslist_lc) @@ -76,6 +80,9 @@ end subroutine rrtmgp_pre_timestep_init subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp ! Inputs real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep @@ -198,6 +205,7 @@ end subroutine radiation_do_ccpp !========================================================================================= subroutine initialize_rrtmgp_fluxes_broadband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp ! Allocate flux arrays and set values to zero. @@ -257,13 +265,14 @@ end subroutine initialize_rrtmgp_fluxes_broadband !========================================================================================= subroutine initialize_rrtmgp_fluxes_byband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp ! Allocate flux arrays and set values to zero. ! Arguments integer, intent(in) :: ncol, nlevels, nbands, nswbands logical, intent(in) :: spectralflux - class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes logical, optional, intent(in) :: do_direct character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -347,6 +356,8 @@ end subroutine initialize_rrtmgp_fluxes_byband !========================================================================================= subroutine reset_fluxes_broadband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp ! Reset flux arrays to zero. @@ -364,6 +375,8 @@ end subroutine reset_fluxes_broadband !========================================================================================= subroutine reset_fluxes_byband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp ! Reset flux arrays to zero. diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 index 1b2f6b9e..89f2f26a 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.F90 +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -10,11 +10,8 @@ module calculate_net_heating ! Original version: B.A. Boville !----------------------------------------------------------------------- -use ccpp_kinds, only: kind_phys - implicit none private -save ! Public interfaces public :: calculate_net_heating_run @@ -26,24 +23,25 @@ module calculate_net_heating !> \section arg_table_calculate_net_heating_run Argument Table !! \htmlinclude calculate_net_heating_run.html !! -subroutine calculate_net_heating_run(ncol, rad_heat, qrl, qrs, fsns, fsnt, flns, flnt, & - is_offline_dyn, net_flx, errmsg, errflg) +subroutine calculate_net_heating_run(ncol, rad_heat, qrl_prime, qrs_prime, fsns, fsnt, & + flns, flnt, is_offline_dyn, net_flx, errmsg, errflg) !----------------------------------------------------------------------- ! Compute net radiative heating from qrs and qrl, and the associated net ! boundary flux. !----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys ! Arguments - integer, intent(in) :: ncol ! horizontal dimension - real(kind_phys), intent(in) :: qrl(:,:) ! longwave heating [J kg-1 s-1] - real(kind_phys), intent(in) :: qrs(:,:) ! shortwave heating [J kg-1 s-1] - real(kind_phys), intent(in) :: fsns(:) ! Surface solar absorbed flux [W m-2] - real(kind_phys), intent(in) :: fsnt(:) ! Net column abs solar flux at model top [W m-2] - real(kind_phys), intent(in) :: flns(:) ! Srf longwave cooling (up-down) flux [W m-2] - real(kind_phys), intent(in) :: flnt(:) ! Net outgoing lw flux at model top [W m-2] - logical, intent(in) :: is_offline_dyn ! is offline dycore - real(kind_phys), intent(out) :: rad_heat(:,:) ! radiative heating [J kg-1 s-1] - real(kind_phys), intent(out) :: net_flx(:) ! net boundary flux [W m-2] + integer, intent(in) :: ncol ! horizontal dimension + real(kind_phys), intent(in) :: qrl_prime(:,:) ! longwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: qrs_prime(:,:) ! shortwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: fsns(:) ! Surface solar absorbed flux [W m-2] + real(kind_phys), intent(in) :: fsnt(:) ! Net column abs solar flux at model top [W m-2] + real(kind_phys), intent(in) :: flns(:) ! Srf longwave cooling (up-down) flux [W m-2] + real(kind_phys), intent(in) :: flnt(:) ! Net outgoing lw flux at model top [W m-2] + logical, intent(in) :: is_offline_dyn ! is offline dycore + real(kind_phys), intent(inout) :: rad_heat(:,:) ! radiative heating [J kg-1 s-1] + real(kind_phys), intent(out) :: net_flx(:) ! net boundary flux [W m-2] character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -55,7 +53,7 @@ subroutine calculate_net_heating_run(ncol, rad_heat, qrl, qrs, fsns, fsnt, flns, errmsg = '' errflg = 0 if (.not. is_offline_dyn) then - rad_heat(:,:) = (qrs(:,:) + qrl(:,:)) + rad_heat(:,:) = (qrs_prime(:,:) + qrl_prime(:,:)) end if do idx = 1, ncol diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 index 6538b108..d0e40893 100644 --- a/schemes/rrtmgp/utils/radiation_utils.F90 +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -1,7 +1,8 @@ module radiation_utils use ccpp_kinds, only: kind_phys - use interpolate_data, only: interp_type, lininterp_init, lininterp, & - extrap_method_bndry + + implicit none + private public :: radiation_utils_init public :: get_sw_spectral_boundaries_ccpp @@ -71,9 +72,9 @@ subroutine get_sw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, unit ! provide spectral boundaries of each shortwave band in the units requested + character(len=*), intent(in) :: units ! requested units real(kind_phys), dimension(:), intent(out) :: low_boundaries ! low range bounds for shortwave bands in requested units real(kind_phys), dimension(:), intent(out) :: high_boundaries ! high range bounds for shortwave bands in requested units - character(*), intent(in) :: units ! requested units character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -117,9 +118,9 @@ subroutine get_lw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, unit ! provide spectral boundaries of each longwave band in the units requested + character(len=*), intent(in) :: units ! requested units real(kind_phys), intent(out) :: low_boundaries(nlwbands) ! low range bounds for longwave bands in requested units real(kind_phys), intent(out) :: high_boundaries(nlwbands) ! high range bounds for longwave bands in requested units - character(*), intent(in) :: units ! requested units character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -161,6 +162,8 @@ end subroutine get_lw_spectral_boundaries_ccpp subroutine get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, & mu_wgts, lambda_wgts, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry ! Get mu and lambda interpolation weights integer, intent(in) :: nmu ! number of mu values integer, intent(in) :: nlambda ! number of lambda values diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 index 93b57dfb..f2d80ea2 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -10,11 +10,8 @@ module rrtmgp_dry_static_energy_tendency ! Original version: B.A. Boville !----------------------------------------------------------------------- -use ccpp_kinds, only: kind_phys - implicit none private -save ! Public interfaces public :: rrtmgp_dry_static_energy_tendency_run @@ -27,18 +24,21 @@ module rrtmgp_dry_static_energy_tendency !! \htmlinclude rrtmgp_dry_static_energy_tendency_run.html !! subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_heat, & - qrs, qrl, errmsg, errflg) + qrs, qrl, qrs_prime, qrl_prime, errmsg, errflg) !----------------------------------------------------------------------- ! Compute net radiative heating from qrs and qrl, and the associated net ! boundary flux. !----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys ! Arguments real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness logical, intent(in) :: calc_sw_heat ! Flag to calculate net shortwave heating logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating - real(kind_phys), dimension(:,:), intent(inout) :: qrs ! shortwave heating rate (J kg-1 s-1) - real(kind_phys), dimension(:,:), intent(inout) :: qrl ! longwave heating rate (J kg-1 s-1) + 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) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -49,11 +49,11 @@ subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_hea errflg = 0 if (calc_sw_heat) then - qrs(:,:) = qrs(:,:) / pdel(:,:) + qrs_prime(:,:) = qrs(:,:) / pdel(:,:) end if if (calc_lw_heat) then - qrl(:,:) = qrl(:,:) / pdel(:,:) + qrl_prime(:,:) = qrl(:,:) / pdel(:,:) end if end subroutine rrtmgp_dry_static_energy_tendency_run diff --git a/test/unit-test/CMakeLists.txt b/test/unit-test/CMakeLists.txt index 49d17506..668b8149 100644 --- a/test/unit-test/CMakeLists.txt +++ b/test/unit-test/CMakeLists.txt @@ -34,6 +34,8 @@ target_include_directories(utilities PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) set(PHYS_UTILS_SRC ../../phys_utils/atmos_phys_pbl_utils.F90 + ../../phys_utils/atmos_phys_string_utils.F90 + ../../phys_utils/atmos_phys_rad_utils.F90 include/ccpp_kinds.F90 ) diff --git a/test/unit-test/tests/phys_utils/CMakeLists.txt b/test/unit-test/tests/phys_utils/CMakeLists.txt index 5e3020cc..17499a47 100644 --- a/test/unit-test/tests/phys_utils/CMakeLists.txt +++ b/test/unit-test/tests/phys_utils/CMakeLists.txt @@ -1,4 +1,6 @@ add_pfunit_ctest(phys_utils_tests TEST_SOURCES test_atmos_pbl_utils.pf + TEST_SOURCES test_atmos_string_utils.pf + TEST_SOURCES test_atmos_rad_utils.pf LINK_LIBRARIES phys_utils ) diff --git a/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf new file mode 100644 index 00000000..9d615967 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf @@ -0,0 +1,41 @@ +@test +subroutine wavenumber_is_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 15555._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.true., output_logical) +end subroutine wavenumber_is_visible + +@test +subroutine wavenumber_is_not_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 823._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_not_visible + +@test +subroutine wavenumber_is_on_the_cusp() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 14286._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_on_the_cusp diff --git a/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf new file mode 100644 index 00000000..890d0c64 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf @@ -0,0 +1,103 @@ +@test +subroutine mixed_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('mixed case string', output_string) +end subroutine mixed_case_to_lower_case + +@test +subroutine lower_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_lower(test_string) + + @assertEqual(' lower case string', output_string) +end subroutine lower_case_to_lower_case + +@test +subroutine upper_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('upper case string', output_string) +end subroutine upper_case_to_lower_case + +@test +subroutine non_letters_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('string with 3 non-letters!', output_string) +end subroutine non_letters_to_lower_case + +@test +subroutine mixed_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('MIXED CASE STRING', output_string) +end subroutine mixed_case_to_upper_case + +@test +subroutine lower_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_upper(test_string) + + @assertEqual(' LOWER CASE STRING', output_string) +end subroutine lower_case_to_upper_case + +@test +subroutine upper_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('UPPER CASE STRING', output_string) +end subroutine upper_case_to_upper_case + +@test +subroutine non_letters_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('STRING WITH 3 NON-LETTERS!', output_string) +end subroutine non_letters_to_upper_case From 205ad1ff27d596b7dc248caf5344e853360e0642 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 12 May 2025 16:52:02 -0600 Subject: [PATCH 013/140] add comment to rad utils routine --- phys_utils/atmos_phys_rad_utils.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/phys_utils/atmos_phys_rad_utils.F90 b/phys_utils/atmos_phys_rad_utils.F90 index bc82e9f0..50d2e116 100644 --- a/phys_utils/atmos_phys_rad_utils.F90 +++ b/phys_utils/atmos_phys_rad_utils.F90 @@ -9,6 +9,7 @@ module atmos_phys_rad_utils contains pure logical function is_visible(wavenumber) + ! Returns true if the provided wavenumber is above the visible threshold use ccpp_kinds, only: kind_phys ! Wavenumber is in the visible if it is above the visible threshold From 08bc031143f29199d1e4ce66a7cef7e362952445 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 13 May 2025 13:19:14 -0600 Subject: [PATCH 014/140] simplify rte solver logic --- schemes/rrtmgp/rrtmgp_lw_main.F90 | 221 +++++++++--------------------- 1 file changed, 61 insertions(+), 160 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 6f2a9d59..491570fa 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -33,7 +33,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention - integer, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used + integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used integer, intent(in) :: nCol !< Number of horizontal points integer, intent(in) :: iter_num !< Radiation subcycle iteration number integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once @@ -42,7 +42,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] + real(kind_phys), dimension(:,:), target, intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object @@ -51,12 +51,15 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object - real(kind_phys), dimension(:,:), intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point character(len=*), intent(out) :: errmsg !< CCPP error message integer, intent(out) :: errflg !< CCPP error flag ! Local variables integer :: iCol, iCol2 + integer, pointer :: nGauss_angles_opt + real(kind_phys), dimension(:,:), pointer :: fluxlwUP_jac_opt + real(kind_phys), dimension(:,:), pointer :: lw_Ds_opt ! Initialize CCPP error handling variables errmsg = '' @@ -64,6 +67,22 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, if (.not. doLWrad) return + nullify(nGauss_angles_opt) + nullify(fluxlwUP_jac_opt) + nullify(lw_Ds_opt) + + if (nGauss_angles > 1) then + nGauss_angles_opt => nGauss_angles ! Turn on the use of Gaussian quadrature angles + end if + + if (use_LW_jacobian) then + fluxlwUP_jac_opt => fluxlwUP_jac ! Turn on surface temperature flux Jacobian calculations + end if + + if (use_LW_optimal_angles) then + lw_Ds_opt => lw_Ds ! Compute optimal angles for use in LW RTE solver + end if + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nCol) @@ -82,53 +101,26 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, ! Call RTE solver if (doLWclrsky) then - if (nGauss_angles .gt. 1) then - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (use_lw_optimal_angles) then + errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds_opt) + call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return end if - else - if (use_lw_optimal_angles) then - errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) - call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes, & ! OUT - Fluxes - lw_Ds = lw_Ds) - call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - else - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes) ! OUT - Fluxes - call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - end if - endif + end if + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + lw_Ds = lw_Ds_opt) ! IN - 1/cos of transport angle per column and g-point + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if end if ! ################################################################################### @@ -140,7 +132,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, ! ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the - ! rte solver (rte_lw). Rte_lw quieries the type determine if scattering is to be + ! rte solver (rte_lw). Rte_lw queries the type to determine if scattering is to be ! included in the calculation. The increment procedures are called so that the correct ! optical properties are inherited. ! @@ -156,63 +148,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, return end if - if (use_LW_jacobian) then - if (nGauss_angles .gt. 1) then - ! Compute LW Jacobians; use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - else - ! Compute LW Jacobians; don't use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if - else - if (nGauss_angles .gt. 1) then - ! Compute LW Jacobians; use Gaussian angles - ! Don't compute LW Jacobians; use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - else - ! Don't compute LW Jacobians; don't use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes) ! OUT - Fluxes - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles_opt, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac_opt) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 end if ! No scattering in LW clouds. else @@ -224,62 +170,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, return end if - if (use_LW_jacobian) then - if (nGauss_angles .gt. 1) then - ! Compute LW Jacobians; use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - else - ! Compute LW Jacobians; don't use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if - else - if (nGauss_angles .gt. 1) then - ! Don't compute LW Jacobians; use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - else - ! Don't compute LW Jacobians; don't use Gaussian angles - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - vertical ordering flag - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes) ! OUT - Fluxes - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles_opt, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac_opt) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 end if end if From e247fca2ce249983171cd81592d4f32009daf3a2 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 13 May 2025 13:31:45 -0600 Subject: [PATCH 015/140] main rte solver scheme cleanup --- schemes/rrtmgp/rrtmgp_lw_main.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 491570fa..3627138d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -3,16 +3,8 @@ !> This module contains the call to the RRTMGP-LW radiation routine module rrtmgp_lw_main - use machine, only: kind_phys - use mo_rte_lw, only: rte_lw - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use radiation_tools, only: check_error_msg implicit none + private public rrtmgp_lw_main_run contains @@ -24,6 +16,15 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_lw, only: rte_lw + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg ! Inputs logical, intent(in) :: doLWrad !< Flag to perform longwave calculation From 665793dee483118e86437e301f257f87beb9f8c1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 13 May 2025 13:38:09 -0600 Subject: [PATCH 016/140] address reviewer comments for rrtmgp_inputs --- schemes/rrtmgp/rrtmgp_inputs.F90 | 48 ++++++++++---------------------- 1 file changed, 15 insertions(+), 33 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 4806f911..83a68753 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -1,11 +1,4 @@ module rrtmgp_inputs - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use string_utils, only: to_lower - use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp implicit none private @@ -23,6 +16,9 @@ subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_ nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp ! Inputs integer, intent(in) :: nswbands @@ -173,6 +169,13 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, & errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use atmos_phys_string_utils, only: to_lower + use atmos_phys_rad_utils, only: is_visible ! Inputs logical, intent(in) :: graupel_in_rad ! Flag to include graupel in radiation calculation integer, intent(in) :: ncol ! Number of columns @@ -473,6 +476,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d ! Local variables integer :: istat real(kind_phys), allocatable :: values(:,:) + character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'set_wavenumber_bands' !---------------------------------------------------------------------------- @@ -498,9 +502,9 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d nlwgpts = kdist_lw%gas_props%get_ngpt() ! SW band bounds in cm^-1 - allocate( values(2,nswbands), stat=istat ) + allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) if (istat/=0) then - write(errmsg, '(a,a)') sub, ': ERROR allocating array: values(2,nswbands)' + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg errflg = 1 return end if @@ -536,9 +540,9 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d deallocate(values) ! LW band bounds in cm^-1 - allocate( values(2,nlwbands), stat=istat ) + allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) if (istat/=0) then - write(errmsg, '(a,a)') sub, ': ERROR allocating array: values(2,nlwbands)' + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg errflg = 1 return end if @@ -630,26 +634,4 @@ subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_l end subroutine get_band_index_by_value - !========================================================================================= - - pure logical function is_visible(wavenumber) - - ! Wavenumber is in the visible if it is above the visible threshold - ! wavenumber, and in the infrared if it is below the threshold - ! This function doesn't distinquish between visible and UV. - - ! wavenumber in inverse cm (cm^-1) - real(kind_phys), intent(in) :: wavenumber - - ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 - real(kind_phys), parameter :: visible_wavenumber_threshold = 14286._kind_phys ! cm^-1 - - if (wavenumber > visible_wavenumber_threshold) then - is_visible = .true. - else - is_visible = .false. - end if - - end function is_visible - end module rrtmgp_inputs From 9ba97ef76f59978c9ec02e88d0c3b92957230f2e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 13 May 2025 16:08:16 -0600 Subject: [PATCH 017/140] rrtmgp_inputs cleanup --- schemes/rrtmgp/rrtmgp_inputs.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 83a68753..859c133c 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -445,6 +445,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp ! Set the low and high limits of the wavenumber grid for sw and lw. ! Values come from RRTMGP coefficients datasets, and are stored in the ! kdist objects. @@ -575,14 +576,13 @@ subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_l real(kind_phys), intent(in) :: targetvalue character(len=*), intent(in) :: units ! units of targetvalue integer, intent(in) :: nbnds - real(kind_phys), target, dimension(:), intent(in) :: wavenumber_low - real(kind_phys), target, dimension(:), intent(in) :: wavenumber_high + real(kind_phys), dimension(:), intent(in) :: wavenumber_low + real(kind_phys), dimension(:), intent(in) :: wavenumber_high character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer, intent(out) :: ans ! local - real(kind_phys), pointer, dimension(:) :: lowboundaries, highboundaries real(kind_phys) :: tgt integer :: idx @@ -592,8 +592,6 @@ subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_l ! Initialize error variables errflg = 0 errmsg = '' - lowboundaries => wavenumber_low - highboundaries => wavenumber_high if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw errflg = 1 @@ -621,7 +619,7 @@ subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_l ! now just loop through the array ans = 0 do idx = 1,nbnds - if ((tgt > lowboundaries(idx)) .and. (tgt <= highboundaries(idx))) then + if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then ans = idx exit end if From 43a2f1bc3f761a1158c1de22d97bbb784b355e2b Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 14 May 2025 09:56:31 -0600 Subject: [PATCH 018/140] fix rte_lw logic --- schemes/rrtmgp/rrtmgp_lw_main.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 3627138d..ea788cc7 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -116,6 +116,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, sources%sources, & ! IN - source function sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature lw_Ds = lw_Ds_opt) ! IN - 1/cos of transport angle per column and g-point call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) if (len_trim(errmsg) /= 0) then From 09e64f737ac44fac772db23851ce089959efa218 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 14 May 2025 11:15:52 -0600 Subject: [PATCH 019/140] fix input argument --- schemes/rrtmgp/rrtmgp_lw_main.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index ea788cc7..0470b930 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -116,7 +116,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, sources%sources, & ! IN - source function sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + n_gauss_angles = nGauss_angles_opt, & ! IN - Number of angles in Gaussian quadrature lw_Ds = lw_Ds_opt) ! IN - 1/cos of transport angle per column and g-point call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) if (len_trim(errmsg) /= 0) then From 492cd5bc97b16969502e314ac8f116ab55ad9e83 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 15 May 2025 10:04:18 -0600 Subject: [PATCH 020/140] move io reader to new directory not compiled by CAM --- {phys_utils => ccpp_utils}/ccpp_io_reader.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {phys_utils => ccpp_utils}/ccpp_io_reader.F90 (100%) diff --git a/phys_utils/ccpp_io_reader.F90 b/ccpp_utils/ccpp_io_reader.F90 similarity index 100% rename from phys_utils/ccpp_io_reader.F90 rename to ccpp_utils/ccpp_io_reader.F90 From bdfce0f470fbabe21bb3867187121d7fdd9e22ee Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 15 May 2025 10:30:07 -0600 Subject: [PATCH 021/140] merge up; add initial diag and constituent schemes --- schemes/rrtmgp/rrtmgp_constituents.F90 | 113 ++++++++++ .../rrtmgp/rrtmgp_constituents_namelist.xml | 144 ++++++++++++ schemes/rrtmgp/rrtmgp_pre_namelist.xml | 199 +++++++++++++++++ .../sima_diagnostics/rrtmgp_diagnostics.F90 | 74 ++++++ .../rrtmgp_lw_diagnostics.F90 | 210 ++++++++++++++++++ test/test_suites/suite_rrtmgp.xml | 24 ++ 6 files changed, 764 insertions(+) create mode 100644 schemes/rrtmgp/rrtmgp_constituents.F90 create mode 100644 schemes/rrtmgp/rrtmgp_constituents_namelist.xml create mode 100644 schemes/rrtmgp/rrtmgp_pre_namelist.xml create mode 100644 schemes/sima_diagnostics/rrtmgp_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 create mode 100644 test/test_suites/suite_rrtmgp.xml diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 new file mode 100644 index 00000000..0059591f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -0,0 +1,113 @@ +module rrtmgp_constituents + + public :: rrtmgp_constituents_register + +contains + +!> \section arg_table_rrtmgp_constituents_run Argument Table +!! \htmlinclude rrtmgp_constituents_run.html +!! + subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) + character(len=*), intent(in) :: rad_climate(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! Local variables + character(len=1) :: source + character(len=32) :: long_name + character(len=32) :: stdname + character(len=256) :: tmpstr, alloc_errmsg + integer :: gas_idx, strlen, ipos, ierr + + errmsg = '' + errcode = 0 + + ! Allocate the dynamic constituents array + allocate(rrtmgp_dyn_consts(size(rad_climate)), stat=ierr, errmsg=alloc_errmsg) + if (ierr /= 0) then + write(errmsg, *) 'rrtmgp_constituents_register: Unable to allocate rrtmgp_dyn_consts - message: ', alloc_errmsg + errcode = 1 + return + end if + + ! Parse gases, long names, and sources from rad_climate + parse_loop: do gas_idx = 1, size(rad_climate) + if ( len_trim(rad_climate(gas_idx)) == 0 ) then + exit parse_loop + endif + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(rad_climate(gas_idx)) + do + strlen = len_trim(tmpstr) + ipos = index(tmpstr, ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + end do + + ! Locate the ':' separating source from long name. + idx = index(tmpstr, ':') + source = tmpstr(:jdx-1) + tmpstr = tmpstr(jdx+1:) + + ! locate the ':' separating long name from rad gas ("standard") name + idx = scan(tmpstr, ':') + + long_name = tmpstr(:jdx-1) + stdname = tmpstr(jdx+1:) + + ! Register the constituent based on the source + if (source == 'A') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + advected = .true., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errcode, & + errmsg = errmsg) + else if (source == 'N') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + advected = .false., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errcode, & + errmsg = errmsg) + else if (source == 'Z') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + default_value = 0.0_kind_phys, & + advected = .false., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errcode, & + errmsg = errmsg) + else + write(errmsg,*) 'rrtmgp_constituent_register: invalid gas source "', source, '" for radiation', & + ' constituent "', stdname, '"' + errcode = 1 + return + end if + + end do parse_loop + + end subroutine rrtmgp_constituents_register + + + +end module rrtmgp_constituents diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml new file mode 100644 index 00000000..ce430d74 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -0,0 +1,144 @@ + + + + + + + + + char*256 + rrtmgp + radconst + sources_of_radiatively_active_gases_for_climate_calcluation + none + + List of radiatively active gases and whether they are advected or not for the climate + calculation in RRTMGP. + + + 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'N:ozone:O3', 'A:N2O:N2O', 'A:CH4:CH4', 'N:CFC11STAR:CFC11', 'A:CFC12:CFC12' + + + + char*256 + rrtmgp + radconst + filepath_for_ice_optics_file + none + + filepath and name for ice optics data for rrtmgp + + + /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/iceoptics_c080917.nc + + + + char*256 + rrtmgp + radconst + filepath_for_liquid_optics_file + none + + filepath and name for liquid optics data for rrtmgp + + + /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + + + + char*32 + rrtmgp + radconst + ice_cloud_optics_type + none + + ice cloud optics type; either mitchell or ebertcurry + + + mitchell + + + + char*32 + rrtmgp + radconst + liquid_cloud_optics_type + none + + liquid cloud optics type; either slingo or gammadist + + + gammadist + + + diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml new file mode 100644 index 00000000..b0d4d045 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -0,0 +1,199 @@ + + + + + + + + + char*512 + rrtmgp + rrtmgp + filename_of_rrtmgp_longwave_coefficients_file + none + + The filename of the longwave coefficients file for RRTMGP + + + src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-lw-g128.nc + + + + integer + rrtmgp + rrtmgp + frequency_of_shortwave_radiation_calculation + none + + The frequency at which shortwave calculation is performed. + positive: time steps; negative: hours + + + -1 + + + + integer + rrtmgp + rrtmgp + frequency_of_longwave_radiation_calculation + none + + The frequency at which longwave calculation is performed. + positive: time steps; negative: hours + + + -1 + + + + integer + rrtmgp + rrtmgp + continuous_time_for_radiation_calculation_after_startup + none + + The amount of time that radiation (both SW and LW) is run continuously from the start of an initial or restart run + positive: time steps; negative: hours + + + -1 + + + + logical + rrtmgp + rrtmgp + use_radiation_timestep_size_for_solar_zenith_angle_calculation + flag + + If true, use the radiation timestep size for the solar zenith angle calculation + + + .false. + + + + logical + rrtmgp + rrtmgp + do_calculate_up_and_down_fluxes_per_band + flag + + If true, calculate the up and down fluxes per band; used by CARMA + + + .false. + + + + logical + rrtmgp + rrtmgp + use_radiation_uniform_angle_in_solar_zenith_angle_calculation + flag + + If true, use the namelist-defined radiation uniform angle in the solar zenith angle calculation + + + .false. + + + + real + kind_phys + rrtmgp + rrtmgp + radiation_uniform_angle_for_solar_zenith_angle_calculation + radians + + The radiation timestep size for the solar zenith angle calculation + + + -99 + + + + flag + rrtmgp + rrtmgp + use_grapel_cloud_fraction_in_radiation_calculation + radians + + Flag to use graupel cloud fraction in radiation + + + .false. + + + diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 new file mode 100644 index 00000000..9a04ffa7 --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 @@ -0,0 +1,74 @@ +module rrtmgp_diagnostics + + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rrtmgp_diagnostics_init ! init routine + public :: rrtmgp_diagnostics_run ! main routine + +CONTAINS + + !> \section arg_table_rrtmgp_diagnostics_init Argument Table + !! \htmlinclude rrtmgp_diagnostics_init.html + subroutine rrtmgp_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Heating rate needed for d(theta)/dt computation + call history_add_field('HR', 'Heating rate needed for d(theat)/dt computation', 'lev', 'avg', 'K s-1') + + end subroutine rrtmgp_diagnostics_init + + !> \section arg_table_rrtmgp_diagnostics_run Argument Table + !! \htmlinclude rrtmgp_diagnostics_run.html + subroutine rrtmgp_diagnostics_run(write_output, ncol, pver, cappa, cpair, pmid, qrs, qrl, errmsg, errflg) + + use cam_history, only: history_out_field + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + logical, intent(in) :: write_output ! Flag to write output for radiation + integer, intent(in) :: ncol ! Number of horizontal points + integer, intent(in) :: pver ! Number of vertical layers + real(kind_phys), intent(in) :: cappa ! Ratio of dry air gas constant to specific heat of dry air at constant pressure + real(kind_phys), intent(in) :: cpair ! Specific heat of dry air [J kg-1 K-1] + real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at layer midpoints [Pa] + real(kind_phys), intent(in) :: qrs(:,:) ! Shortwave heating rate [J kg-1 s-1] + real(kind_phys), intent(in) :: qrl(:,:) ! Longwave heating rate [J kg-1 s-1] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx, kdx + real(kind_phys) :: ftem(ncol, pver) + + errmsg = '' + errflg = 0 + + ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output + if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + return + end if + + ! Compute heating rate for dtheta/dt + do kdx = 1, pver + do idx = 1, ncol + ftem(idx,kdx) = (qrs(idx,kdx) + qrl(idx,kdx))/cpair * (1.e5_kind_phys/pmid(idx,kdx))**cappa + end do + end do + + call history_out_field('HR', ftem) + + end subroutine rrtmgp_diagnostics_run + +end module rrtmgp_diagnostics diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 new file mode 100644 index 00000000..f982f67b --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -0,0 +1,210 @@ +module rrtmgp_lw_diagnostics +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! THIS IS A TEMPLATE +! 1. copy this file to a new file with the correct name +! (rrtmgp_lw_diagnostics.F90) +! 2. do a search and replace for "rrtmgp_lw" in this file and +! replace with your scheme name +! 3. Add desired history_add_field calls to the init phase +! 4. Add all fields that are being output as inputs to the run phase +! 5. Add desired history_out_field calls to the run phase +! 6. Run $ccpp_framework/scripts/ccpp_fortran_to_metadata.py on this .F90 +! file to generate the metadata +! 7. Complete the metadata (fill out standard names, units, dimensions) +! 8. Add this scheme to the SDF file for your suite (likely will be at end) +! 9. Delete this header section +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rrtmgp_lw_diagnostics_init ! init routine + public :: rrtmgp_lw_diagnostics_run ! main routine + + character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +CONTAINS + + !> \section arg_table_rrtmgp_lw_diagnostics_init Argument Table + !! \htmlinclude rrtmgp_lw_diagnostics_init.html + subroutine rrtmgp_lw_diagnostics_init(num_diag_subcycles, active_calls, errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + integer, intent(in) :: num_diag_subcycles ! Number of diagnostic subcycles + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + integer :: icall + + errmsg = '' + errflg = 0 + + ! Loop over number of diagnostics subcycles + ! and add the relevant fields for each cycle if it's active + do icall = 1, num_diag_subcycles + if (active_calls(icall)) then + call history_add_field('QRL'//diag(icall-1), 'Longwave heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('QRLC'//diag(icall-1), 'Clearsky longwave heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('FLNT'//diag(icall-1), 'Net longwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FLNTC'//diag(icall-1), 'Clearky net longwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FLUT'//diag(icall-1), 'Upwelling longwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FLUTC'//diag(icall-1), 'Clearsky upwelling longwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('LWCF'//diag(icall-1), 'Longwave cloud forcing', horiz_only, 'avg', 'W m-2') + call history_add_field('FLN200'//diag(icall-1), 'Net longwave flux at 200 mb', horiz_only, 'avg', 'W m-2') + call history_add_field('FLN200C'//diag(icall-1), 'Clearsky net longwave flux at 200 mb', horiz_only, 'avg', 'W m-2') + call history_add_field('FLNR'//diag(icall-1), 'Net longwave flux at tropopause', horiz_only, 'avg', 'W m-2') + call history_add_field('FLNS'//diag(icall-1), 'Net longwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FLNSC'//diag(icall-1), 'Clearsky net longwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FLDS'//diag(icall-1), 'Downwelling longwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FLDSC'//diag(icall-1), 'Clearky Downwelling longwave flux at surface', horiz_only, 'avg', 'W m-2') + + ! Fluxes on CAM grid + call history_add_field('FUL'//diag(icall-1), 'Longwave upward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FDL'//diag(icall-1), 'Longwave downward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FULC'//diag(icall-1), 'Longwave clear-sky upward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FDLC'//diag(icall-1), 'Longwave clear-sky downward flux', 'ilev', 'inst', 'W m-2') + end if + end do + + call history_add_field('EMIS', 'Cloud longwave emissivity', 'lev', 'avg', '1') + + ! Heating rate needed for d(theta)/dt computation + call history_add_field('HR', 'Heating rate needed for d(theat)/dt computation', 'lev', 'avg', 'K s-1') + + end subroutine rrtmgp_lw_diagnostics_init + + !> \section arg_table_rrtmgp_lw_diagnostics_run Argument Table + !! \htmlinclude rrtmgp_lw_diagnostics_run.html + subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, flw, flwc, rpdel, ncol, & + nlay, pver, pverp, pint, gravit, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) + + use cam_history, only: history_out_field + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use interpolate_data, only: vertinterp + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles + integer, intent(in) :: icall ! Current diagnostic subcycle + integer, intent(in) :: ncol ! Number of horizontal points + integer, intent(in) :: nlay ! Number of vertical layers used in radiation calcluation + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: pverp ! Number of vertical layer interfaces + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + logical, intent(in) :: write_output ! Flag to write output for radiation + real(kind_phys), intent(in) :: gravit ! Standard gravitiational acceleration + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at layer interfaces [Pa] + real(kind_phys), intent(in) :: p_trop(:) ! Tropopause air pressure [Pa] + real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of layer thickness [Pa-1] + type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object + type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: diag_index, idx + real(kind_phys) :: fnl(ncol, pverp) + real(kind_phys) :: fcnl(ncol, pverp) + real(kind_phys) :: qrl(ncol, pver) + real(kind_phys) :: qrlc(ncol, pver) + real(kind_phys) :: fln200(ncol) + real(kind_phys) :: fln200c(ncol) + real(kind_phys) :: flnr(ncol) + + errmsg = '' + errflg = 0 + + ! Diagnostic indices are reversed + diag_index = num_diag_subcycles - icall + + ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output + if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + return + end if + + fnl = 0.0_kind_phys + fcnl = 0.0_kind_phys + + ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! + fnl( :,ktopcam:) = -1._kind_phys * flw%fluxes%flux_net( :, ktoprad:) + fcnl(:,ktopcam:) = -1._kind_phys * flwc%fluxes%flux_net( :, ktoprad:) + + call heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) + call heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) + + ! History out field calls + call history_out_field('QRL'//diag(icall), qrl(:ncol,:)/cpair) + call history_out_field('QRLC'//diag(icall), qrlc(:ncol,:)/cpair) + + call history_out_field('FLNT'//diag(icall), fnl(:,ktopcam)) + call history_out_field('FLNTC'//diag(icall), fcnl(:,ktopcam)) + + call history_out_field('FLUT'//diag(icall), flw%fluxes%flux_up(:, ktoprad)) + call history_out_field('FLUTC'//diag(icall), flwc%fluxes%flux_up(:, ktoprad)) + + ftem(:) = flwc%fluxes%flux_up(:, ktoprad) - flw%fluxes%flux_up(:, ktoprad) + call history_out_field('LWCF'//diag(icall), ftem) + + ! Output fluxes at 200 mb + call vertinterp(ncol, ncol, pverp, pint, 20000._r8, fnl, fln200) + call vertinterp(ncol, ncol, pverp, pint, 20000._r8, fcnl, fln200c) + call history_out_field('FLN200'//diag(icall), fln200) + call history_out_field('FLN200C'//diag(icall), fln200c) + + do idx = 1,ncol + call vertinterp(1, 1, pverp, pint(idx,:), p_trop(idx), fnl(idx,:), flnr(idx)) + end do + call history_out_field('FLNR'//diag(icall), flnr) + + call history_out_field('FLNS'//diag(icall), fnl(:,pverp)) + call history_out_field('FLNSC'//diag(icall), fcnl(:,pverp)) + + call history_out_field('FLDS'//diag(icall), flw%fluxes%flux_dn(:, nlay+1)) + call history_out_field('FLDSC'//diag(icall), flwc%fluxes%flux_dn(:, nlay+1)) + + ! Fluxes on the CAM grid + call history_out_field('FDL'//diag(icall), flw%fluxes%flux_dn( :, ktoprad:)) + call history_out_field('FDLC'//diag(icall), flwc%fluxes%flux_dn(:, ktoprad:)) + call history_out_field('FUL'//diag(icall), flw%fluxes%flux_up( :, ktoprad:)) + call history_out_field('FULC'//diag(icall), flwc%fluxes%flux_up(:, ktoprad:)) + + end subroutine rrtmgp_lw_diagnostics_run + + !======================================================================= + + subroutine lw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) + ! Compute heating rate as a dry static energy tendency + + ! arguments + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: flux_net(:,:) ! W m-2 + real(kind_phys), intent(in) :: gravit ! m s-2 + real(kind_phys), intent(in) :: rpdel(:,:) ! Pa + real(kind_phys), intent(out) :: hrate(:,:) ! J kg-1 s-1 + + ! local vars + integer :: kdx + + do kdx = ktopcam, pver + ! (flux divergence as bottom-MINUS-top) * g/dp + hrate(:,kdx) = (flux_net(:,kdx+1) - flux_net(:,kdx)) * & + gravit * state%rpdel(:,kdx) + end do + end subroutine lw_heating_rate + +end module rrtmgp_lw_diagnostics diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml new file mode 100644 index 00000000..c07748e7 --- /dev/null +++ b/test/test_suites/suite_rrtmgp.xml @@ -0,0 +1,24 @@ + + + + + rrtmgp_lw_gas_optics_data + rrtmgp_pre + + tropopause_find + rrtmgp_inputs + rrtmgp_lw_cloud_optics + rrtmgp_lw_mcica_subcol_gen + + + rrtmgp_lw_gas_optics_pre + rrtmgp_lw_gas_optics + rrtmgp_lw_main + rrtmgp_lw_diagnostics + + rrtmgp_dry_static_energy_tendency + calculate_net_heating + rrtmgp_post + + + From 6c470fdc75afd70c151dd51783f4cb9d058102af Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 15 May 2025 17:41:18 -0600 Subject: [PATCH 022/140] some metadata fixes and adding more namelist entries --- .../rrtmgp/rrtmgp_cloud_optics_namelist.xml | 130 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_constituents.F90 | 19 ++- schemes/rrtmgp/rrtmgp_constituents.meta | 53 +++++++ .../rrtmgp/rrtmgp_constituents_namelist.xml | 56 +------- schemes/rrtmgp/rrtmgp_inputs.F90 | 4 +- schemes/rrtmgp/rrtmgp_inputs.meta | 4 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 6 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 15 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta | 2 +- .../rrtmgp/rrtmgp_lw_gas_optics_namelist.xml | 91 ++++++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_main.F90 | 4 +- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 2 +- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 5 +- schemes/rrtmgp/rrtmgp_post.F90 | 4 +- schemes/rrtmgp/rrtmgp_post.meta | 36 +++-- schemes/rrtmgp/rrtmgp_pre.F90 | 16 +-- schemes/rrtmgp/rrtmgp_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 52 +++++++ .../rrtmgp/utils/calculate_net_heating.meta | 70 +++++----- .../rrtmgp_dry_static_energy_tendency.meta | 50 ++++--- test/test_suites/suite_rrtmgp.xml | 6 +- 25 files changed, 470 insertions(+), 165 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml create mode 100644 schemes/rrtmgp/rrtmgp_constituents.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml diff --git a/schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml new file mode 100644 index 00000000..257d84ab --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml @@ -0,0 +1,130 @@ + + + + + + + + + char*256 + rrtmgp_cloud_optics + radconst + filepath_for_ice_optics_file + none + + filepath and name for ice optics data for rrtmgp + + + /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/iceoptics_c080917.nc + + + + char*256 + rrtmgp_cloud_optics + radconst + filepath_for_liquid_optics_file + none + + filepath and name for liquid optics data for rrtmgp + + + /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + + + + char*32 + rrtmgp_cloud_optics + radconst + ice_cloud_optics_type + none + + ice cloud optics type; either mitchell or ebertcurry + + + mitchell + + + + char*32 + rrtmgp_cloud_optics + radconst + liquid_cloud_optics_type + none + + liquid cloud optics type; either slingo or gammadist + + + gammadist + + + diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 0059591f..12c36b20 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -4,13 +4,13 @@ module rrtmgp_constituents contains -!> \section arg_table_rrtmgp_constituents_run Argument Table -!! \htmlinclude rrtmgp_constituents_run.html +!> \section arg_table_rrtmgp_constituents_register Argument Table +!! \htmlinclude rrtmgp_constituents_register.html !! subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) - character(len=*), intent(in) :: rad_climate(:) + character(len=256), intent(in) :: rad_climate(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -108,6 +108,19 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, end subroutine rrtmgp_constituents_register +!> \section arg_table_rrtmgp_constituents_init Argument Table +!! \htmlinclude rrtmgp_constituents_init.html +!! + subroutine rrtmgp_constituents_init(gaslist, errmsg, errcode) + character(len=5), intent(out) :: gaslist(:) + integer, intent(out) :: errcode + character(len=512), intent(out) :: errmsg + + errcode = 0 + errmsg = '' + + gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + end subroutine rrtmgp_constituents_init end module rrtmgp_constituents diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta new file mode 100644 index 00000000..ec7c31f7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -0,0 +1,53 @@ +[ccpp-table-properties] + name = rrtmgp_constituents + type = scheme + +[ccpp-arg-table] + name = rrtmgp_constituents_register + type = scheme +[ rad_climate ] + standard_name = sources_of_radiatively_active_gases_for_climate_calcluation + units = none + type = character | kind = len=256 + dimensions = (number_of_active_gases_for_RRTMGP) + intent = in +[ rrtmgp_dyn_consts ] + standard_name = rrtmgp_constituents_dyn_consts + units = none + type = ccpp_constituent_properties_t + allocatable = True + dimensions = (:) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out +[ccpp-arg-table] + name = rrtmgp_constituents_init + type = scheme +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=5 + dimensions = (number_of_active_gases_for_RRTMGP) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml index ce430d74..7413da82 100644 --- a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -77,8 +77,8 @@ --> char*256 - rrtmgp - radconst + rrtmgp_constituents + rrtmgp_constituents sources_of_radiatively_active_gases_for_climate_calcluation none @@ -89,56 +89,4 @@ 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'N:ozone:O3', 'A:N2O:N2O', 'A:CH4:CH4', 'N:CFC11STAR:CFC11', 'A:CFC12:CFC12' - - char*256 - rrtmgp - radconst - filepath_for_ice_optics_file - none - - filepath and name for ice optics data for rrtmgp - - - /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/iceoptics_c080917.nc - - - - char*256 - rrtmgp - radconst - filepath_for_liquid_optics_file - none - - filepath and name for liquid optics data for rrtmgp - - - /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc - - - - char*32 - rrtmgp - radconst - ice_cloud_optics_type - none - - ice cloud optics type; either mitchell or ebertcurry - - - mitchell - - - - char*32 - rrtmgp - radconst - liquid_cloud_optics_type - none - - liquid cloud optics type; either slingo or gammadist - - - gammadist - - diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 859c133c..49ccbfc6 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -63,7 +63,7 @@ subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_ real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle @@ -231,7 +231,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & type(ty_gas_concs_ccpp), intent(out) :: gas_concs_sw ! Gas concentrations object for shortwave radiation type(ty_optical_props_2str_ccpp), intent(out) :: atm_optics_sw ! Atmosphere optical properties object for shortwave radiation type(ty_optical_props_2str_ccpp), intent(out) :: aer_sw ! Aerosol optical properties object for shortwave radiation - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index fa631e0c..26bfdf34 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -139,8 +139,8 @@ intent = in [ nlwbands ] standard_name = number_of_bands_for_longwave_radiation - units = number_of_bands_for_longwave_radiation - type = count + units = count + type = integer dimensions = () intent = in [ nradgas ] diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 4d8f220f..5fe52e58 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -50,8 +50,8 @@ subroutine rrtmgp_lw_cloud_optics_init(nmu_in, nlambda_in, n_g_d_in, & real(kind_phys), intent(in) :: tiny_in ! Definition of what "tiny" means ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables character(len=256) :: alloc_errmsg @@ -149,7 +149,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: tauc ! Cloud optical depth - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index c3d20c93..fa27173a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -12,7 +12,7 @@ dimensions = () intent = in [ nlambda_in ] - standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid + standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid units = count type = integer dimensions = () @@ -51,8 +51,7 @@ standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid units = m-1 type = real | kind = kind_phys - dimensions = -((number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) intent = in [ g_d_eff_in ] standard_name = radiative_effective_diameter_samples_on_ice_optics_grid @@ -97,13 +96,13 @@ dimensions = () intent = in [ nlay ] - standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + standard_name = number_of_vertical_layers_in_RRTMGP units = count type = integer dimensions = () intent = in [ nlaycam ] - standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels units = count type = integer dimensions = () @@ -232,13 +231,13 @@ standard_name = cloud_optical_depth units = 1 type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,<>) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) intent = out [ cldf ] - standard_name = cloud_area_fraction + standard_name = cloud_area_fraction_on_RRTMGP_layers units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,<>) + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) intent = out [ cld_lw_abs ] standard_name = in_cloud_longwave_liquid_plus_ice_optical_depth diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 6812b895..7fceeacb 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -40,7 +40,7 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 index 2471ca80..393adda3 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -66,7 +66,7 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message + character(len=512), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errflg ! CCPP error code ! Initialize error variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta index 7c65c1b6..9c226748 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta @@ -162,7 +162,7 @@ dimensions = (enter_standard_name_107:enter_standard_name_108) intent = in [ scale_by_complement_upper ] - standard_name = do_longwave_complement_concentration_scaling_in_lower_atmosphere + standard_name = do_longwave_complement_concentration_scaling_in_upper_atmosphere units = flag type = logical dimensions = (enter_standard_name_109:enter_standard_name_110) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml new file mode 100644 index 00000000..9cc0ed8f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml @@ -0,0 +1,91 @@ + + + + + + + + + char*512 + rrtmgp_lw_gas_optics + rrtmgp_lw_gas_optics + filename_of_rrtmgp_longwave_coefficients_file + none + + The filename of the longwave coefficients file for RRTMGP + + + src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-lw-g128.nc + + + diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index c9796cda..06415d89 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -32,7 +32,7 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, ! last index corresponds to index in gaslist type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index 05d47ff9..169a31de 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -21,7 +21,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_interface_dimension + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ nlay ] standard_name = number_of_vertical_layers_in_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 0470b930..60e33823 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -53,8 +53,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point - character(len=*), intent(out) :: errmsg !< CCPP error message - integer, intent(out) :: errflg !< CCPP error flag + character(len=512), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag ! Local variables integer :: iCol, iCol2 diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 0d39ce1f..2c62d814 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -73,7 +73,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & real(kind_phys), dimension(:,:), intent(in) :: cldfrac ! Layer cloud fraction real(kind_phys), dimension(:,:,:), intent(in) :: tauc ! Cloud optical depth type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 5f000abc..6243e22e 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -66,7 +66,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfrac ] - standard_name = cloud_area_fraction + standard_name = cloud_area_fraction_on_RRTMGP_layers units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) @@ -75,8 +75,7 @@ standard_name = cloud_optical_depth units = 1 type = real | kind = kind_phys - dimensions = -(enter_standard_name_24:enter_standard_name_25,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) intent = in [ cloud_lw ] standard_name = longwave_cloud_optical_properties_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 67bf4fb2..09bc301c 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -10,7 +10,7 @@ module rrtmgp_post !! \htmlinclude rrtmgp_post_run.html !! subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & - fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, errmsg, errflg) + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, flwds, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp use ccpp_source_functions, only: ty_source_func_lw_ccpp @@ -36,7 +36,7 @@ subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_opt real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] real(kind_phys), dimension(:), intent(out) :: flwds ! Down longwave flux at surface [W m-2] - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Set error varaibles diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 1f9fde85..85a21f21 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -5,12 +5,6 @@ [ccpp-arg-table] name = rrtmgp_post_run type = scheme -[ ncol ] - standard_name = horizontal_loop_extent - units = count - type = integer - dimensions = () - intent = in [ nlay ] standard_name = number_of_vertical_layers_in_RRTMGP units = count @@ -23,18 +17,18 @@ type = logical dimensions = () intent = in -[ qrs ] - standard_name = shortwave_radiative_heating_rate - units = K s-1 +[ qrs_prime ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) - intent = inout -[ qrl ] - standard_name = longwave_radiative_heating_rate - units = K s-1 + intent = in +[ 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 = in [ fsns ] standard_name = shortwave_net_absorbed_solar_flux_at_surface units = W m-2 @@ -72,7 +66,7 @@ dimensions = () intent = inout [ fswc ] - standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP units = none type = ty_fluxes_broadband_ccpp dimensions = () @@ -107,6 +101,18 @@ type = ty_fluxes_broadband_ccpp dimensions = () intent = inout +[ qrs ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness + units = J Pa kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ qrl ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness + units = J Pa kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out [ netsw ] standard_name = net_shortwave_flux_at_surface units = W m-2 diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index d234691f..35d7ef92 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -48,13 +48,13 @@ end subroutine rrtmgp_pre_init !! \htmlinclude rrtmgp_pre_timestep_init.html !! subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) - integer, intent(in) :: nstep ! Current timestep number - integer, intent(in) :: dtime ! Timestep size - integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) - integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously - integer, intent(out) :: offset ! Offset for next SW radiation timestep - integer, intent(out) :: errflg - character(len=*), intent(out) :: errmsg + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: dtime ! Timestep size + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: offset ! Offset for next SW radiation timestep + integer, intent(out) :: errflg + character(len=512), intent(out) :: errmsg logical :: dosw_next integer :: nstepsw_next @@ -108,7 +108,7 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns logical, intent(out) :: dosw ! Flag to do shortwave calculation logical, intent(out) :: dolw ! Flag to do longwave calculation - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index a1a607b7..0ed2d0fa 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -12,7 +12,7 @@ dimensions = () intent = in [ gaslist ] - standard_name = number_of_active_gases_for_RRTMGP + standard_name = list_of_active_gases_for_RRTMGP units = count type = character | kind = len=* dimensions = (number_of_active_gases_for_RRTMGP) diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index b0d4d045..0af06002 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -196,4 +196,56 @@ .false. + + count + rrtmgp + rrtmgp + number_of_bands_for_shortwave_radiation + count + + Number of shortwave bands + + + 14 + + + + count + rrtmgp + rrtmgp + number_of_bands_for_longwave_radiation + count + + Number of longwave bands + + + 16 + + + + integer + rrtmgp + rrtmgp + number_of_active_gases_for_RRTMGP + count + + Dimension of the list of radiatively active gases. + + + 8 + + + + integer + rrtmgp + rrtmgp + character_length_of_list_of_active_gases_for_RRTMGP + count + + Character length for each element of the list of radiatively active gases. + + + 5 + + diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta index e03d1ac9..f151df0c 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.meta +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -6,74 +6,74 @@ name = calculate_net_heating_run type = scheme [ ncol ] - standard_name = enter_standard_name_1 - units = enter_units + standard_name = horizontal_loop_extent + units = count type = integer dimensions = () intent = in [ rad_heat ] - standard_name = enter_standard_name_9 - units = enter_units + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = K s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_13:enter_standard_name_14,enter_standard_name_15:enter_standard_name_16) - intent = out -[ qrl ] - standard_name = enter_standard_name_2 - units = enter_units + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + 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 = (enter_standard_name_17:enter_standard_name_18,enter_standard_name_19:enter_standard_name_20) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in -[ qrs ] - standard_name = enter_standard_name_3 - units = enter_units +[ qrs_prime ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_21:enter_standard_name_22,enter_standard_name_23:enter_standard_name_24) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ fsns ] - standard_name = enter_standard_name_4 - units = enter_units + standard_name = shortwave_net_absorbed_solar_flux_at_surface + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_25:enter_standard_name_26) + dimensions = (horizontal_loop_extent) intent = in [ fsnt ] - standard_name = enter_standard_name_5 - units = enter_units + standard_name = shortwave_net_column_absorbed_solar_flux_at_model_top + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_27:enter_standard_name_28) + dimensions = (horizontal_loop_extent) intent = in [ flns ] - standard_name = enter_standard_name_6 - units = enter_units + standard_name = longwave_net_upward_flux_at_surface + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_29:enter_standard_name_30) + dimensions = (horizontal_loop_extent) intent = in [ flnt ] - standard_name = enter_standard_name_7 - units = enter_units + standard_name = longwave_net_outgoing_flux_at_model_top + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_31:enter_standard_name_32) + dimensions = (horizontal_loop_extent) intent = in [ is_offline_dyn ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = is_offline_dynamical_core + units = flag type = logical dimensions = () intent = in [ net_flx ] - standard_name = enter_standard_name_10 - units = enter_units + standard_name = total_column_radiative_flux + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_33:enter_standard_name_34) + dimensions = (horizontal_loop_extent) intent = out [ errmsg ] - standard_name = enter_standard_name_11 - units = enter_units + standard_name = ccpp_error_message + units = none type = character | kind = len=* dimensions = () intent = out [ errflg ] - standard_name = enter_standard_name_12 - units = enter_units + standard_name = ccpp_error_code + units = 1 type = integer dimensions = () intent = out diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta index 3d1d3b88..a4b18e5b 100644 --- a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.meta @@ -6,44 +6,56 @@ name = rrtmgp_dry_static_energy_tendency_run type = scheme [ pdel ] - standard_name = enter_standard_name_1 - units = enter_units + standard_name = air_pressure_thickness + units = Pa type = real | kind = kind_phys - dimensions = (enter_standard_name_8:enter_standard_name_9,enter_standard_name_10:enter_standard_name_11) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ calc_sw_heat ] - standard_name = enter_standard_name_2 - units = enter_units + standard_name = calculate_net_shortwave_heating + units = flag type = logical dimensions = () intent = in [ calc_lw_heat ] - standard_name = enter_standard_name_3 - units = enter_units + standard_name = calculate_net_longwave_heating + units = flag type = logical dimensions = () intent = in [ qrs ] - standard_name = enter_standard_name_4 - units = enter_units + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness + units = J Pa kg-1 s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_12:enter_standard_name_13,enter_standard_name_14:enter_standard_name_15) - intent = inout + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in [ qrl ] - standard_name = enter_standard_name_5 - units = enter_units + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness + units = J Pa kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ qrs_prime ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_16:enter_standard_name_17,enter_standard_name_18:enter_standard_name_19) - intent = inout + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + 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 = out [ errmsg ] - standard_name = enter_standard_name_6 - units = enter_units + standard_name = ccpp_error_message + units = none type = character | kind = len=* dimensions = () intent = out [ errflg ] - standard_name = enter_standard_name_7 - units = enter_units + standard_name = ccpp_error_code + units = 1 type = integer dimensions = () intent = out diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index c07748e7..c098d95a 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -2,8 +2,9 @@ + rrtmgp_constituents rrtmgp_lw_gas_optics_data - rrtmgp_pre + rrtmgp_pre tropopause_find rrtmgp_inputs @@ -16,9 +17,10 @@ rrtmgp_lw_main rrtmgp_lw_diagnostics + rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post - + From 6712a83a70fb60725c1b1e721b85a88f2d252830 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 16 May 2025 14:01:58 -0600 Subject: [PATCH 023/140] move io reader back --- {ccpp_utils => phys_utils}/ccpp_io_reader.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {ccpp_utils => phys_utils}/ccpp_io_reader.F90 (100%) diff --git a/ccpp_utils/ccpp_io_reader.F90 b/phys_utils/ccpp_io_reader.F90 similarity index 100% rename from ccpp_utils/ccpp_io_reader.F90 rename to phys_utils/ccpp_io_reader.F90 From f229d39846264adae082391c4ddbf40cf0e692ea Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 17 May 2025 21:20:45 -0600 Subject: [PATCH 024/140] update gas optics code to use file io reader --- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 288 ++++++++++++++++--- 1 file changed, 247 insertions(+), 41 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 index 2471ca80..8556b0f2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -14,65 +14,271 @@ module rrtmgp_lw_gas_optics_data !> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table !! \htmlinclude rrtmgp_lw_gas_optics_data_init.html !! - subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, & - key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & - temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & - kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & - minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & - scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & + subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & errmsg, errflg) + !available_gases, gas_names, & + ! key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & + ! temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & + ! kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & + ! minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + ! minor_scales_with_density_lower, minor_scales_with_density_upper, & + ! scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & + ! scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & + ! totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & + ! errmsg, errflg) use machine, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg + use pio_reader, only: pio_reader_t ! Inputs + character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - character(len=*), dimension(:), intent(in) :: gas_names ! Names of absorbing gases - character(len=*), dimension(:), intent(in) :: gas_minor ! Name of absorbing minor gas - character(len=*), dimension(:), intent(in) :: identifier_minor ! Unique string identifying minor gas - character(len=*), dimension(:), intent(in) :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=*), dimension(:), intent(in) :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=*), dimension(:), intent(in) :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=*), dimension(:), intent(in) :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), intent(in) :: key_species ! Key species pair for each band - integer, dimension(:,:), intent(in) :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), intent(in) :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical, dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical, dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical, dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical, dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), intent(in) :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), intent(in) :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), intent(in) :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), intent(in) :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), intent(in) :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), intent(in) :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), intent(in) :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), intent(in) :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), intent(in) :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), intent(in) :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object character(len=*), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errflg ! CCPP error code + ! Local variables + type(pio_reader_t) :: pio_reader + character(len=32), dimension(:), allocatable :: gas_names ! Names of absorbing gases + character(len=32), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas + character(len=32), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas + character(len=32), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=32), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=32), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=32), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band + integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical, dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical, dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical, dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical, dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), allocatable :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), allocatable :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), allocatable :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + character(len=256) :: alloc_errmsg + integer :: idx + ! Initialize error variables errmsg = '' errflg = 0 + ! Open the longwave coefficients file + pio_reader%open_file(lw_filename, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Read the coefficients from the file + pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('key_species', key_species, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('totplnk', totplnk, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Close the longwave coefficients file + pio_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + ! Initialize the gas optics object with data. errmsg = kdist%gas_props%load( & available_gases%gas_concs, gas_names, key_species, & From 4e628d799238600cc0385d724e6d639f3e9dd9c3 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 19 May 2025 10:30:49 -0600 Subject: [PATCH 025/140] add sw gas optics --- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 177 +++++----- schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 | 330 +++++++++++++++++++ 2 files changed, 420 insertions(+), 87 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 index 8556b0f2..046dc2cb 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -1,7 +1,7 @@ !> \file rrtmgp_lw_gas_optics_data.F90 !! -!> This module contains an init routine to initialize the gas optics object +!> This module contains an init routine to initialize the longwave gas optics object !> with data read in from file on the host side module rrtmgp_lw_gas_optics_data @@ -15,22 +15,13 @@ module rrtmgp_lw_gas_optics_data !! \htmlinclude rrtmgp_lw_gas_optics_data_init.html !! subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & - errmsg, errflg) - !available_gases, gas_names, & - ! key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & - ! temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & - ! kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & - ! minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & - ! minor_scales_with_density_lower, minor_scales_with_density_upper, & - ! scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & - ! scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & - ! totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & - ! errmsg, errflg) + errmsg, errcode) use machine, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg - use pio_reader, only: pio_reader_t +! use pio_reader, only: pio_reader_t + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Inputs character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file @@ -39,156 +30,168 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errflg ! CCPP error code + integer, intent(out) :: errcode ! CCPP error code ! Local variables - type(pio_reader_t) :: pio_reader - character(len=32), dimension(:), allocatable :: gas_names ! Names of absorbing gases - character(len=32), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas - character(len=32), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas - character(len=32), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=32), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=32), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=32), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band - integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical, dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical, dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical, dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical, dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), allocatable :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), allocatable :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), allocatable :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. - character(len=256) :: alloc_errmsg - integer :: idx + class(abstract_netcdf_reader_t), allocatable :: pio_reader + character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band + integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical, dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical, dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical, dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical, dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable + character(len=256) :: alloc_errmsg + integer :: idx ! Initialize error variables errmsg = '' - errflg = 0 + errcode = 0 + + pio_reader = create_netcdf_reader_t() ! Open the longwave coefficients file - pio_reader%open_file(lw_filename, errmsg, errcode) + call pio_reader%open_file(lw_filename, errmsg, errcode) if (errcode /= 0) then return end if ! Read the coefficients from the file - pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('key_species', key_species, errmsg, errcode) + call pio_reader%get_var('key_species', key_species, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) + call pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) + call pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('totplnk', totplnk, errmsg, errcode) + call pio_reader%get_var('totplnk', totplnk, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) + call pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) + call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) ! OK if variable is not on file if (errcode /= 0 .and. errcode /= 3) then return end if - pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + if (errcode /= 3) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) ! OK if variable is not on file if (errcode /= 0 .and. errcode /= 3) then return end if - pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + if (errcode /= 3) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -205,7 +208,7 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -222,7 +225,7 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -239,7 +242,7 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -256,25 +259,25 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) if (errcode /= 0) then return end if - pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) if (errcode /= 0) then return end if ! Close the longwave coefficients file - pio_reader%close_file(errmsg, errcode) + call pio_reader%close_file(errmsg, errcode) if (errcode /= 0) then return end if @@ -294,11 +297,11 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & scaling_gas_lower, scaling_gas_upper, & scale_by_complement_lower, scale_by_complement_upper, & kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower, rayl_upper, & + totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & optimal_angle_fit) if (len_trim(errmsg) > 0) then - errflg = 1 + errcode = 1 end if call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 new file mode 100644 index 00000000..c87a434e --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 @@ -0,0 +1,330 @@ +!> \file rrtmgp_sw_gas_optics_data.F90 +!! + +!> This module contains an init routine to initialize the shortwave gas optics object +!> with data read in from file on the host side +module rrtmgp_sw_gas_optics_data + + implicit none + private + public :: rrtmgp_sw_gas_optics_data_init + + +contains +!> \section arg_table_rrtmgp_sw_gas_optics_data_init Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_data_init.html +!! + subroutine rrtmgp_sw_gas_optics_data_init(kdist, sw_filename, available_gases, & + errmsg, errcode) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + + ! Inputs + character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errcode ! CCPP error code + + ! Local variables + class(abstract_netcdf_reader_t), allocatable :: pio_reader + character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band + integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical, dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical, dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical, dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical, dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] + real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] + real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] + real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + character(len=256) :: alloc_errmsg + integer :: idx + + ! Initialize error variables + errmsg = '' + errcode = 0 + + pio_reader = create_netcdf_reader_t() + + ! Open the longwave coefficients file + call pio_reader%open_file(sw_filename, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Read the coefficients from the file + call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('key_species', key_species, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('tsi_default', tsi_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('mg_default', mg_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('sb_default', sb_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Close the longwave coefficients file + call pio_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + solar_src_quiet, solar_src_facular, solar_src_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower_allocatable, rayl_upper_allocatable) + + if (len_trim(errmsg) > 0) then + errcode = 1 + end if + call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_sw_gas_optics_data_init + +end module rrtmgp_sw_gas_optics_data From 787d876557a3f5ae5ac763ad11a752e034b32456 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 20 May 2025 13:45:16 -0600 Subject: [PATCH 026/140] update gas optics scheme to use logical kind --- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 index 2471ca80..46097c67 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -28,6 +28,7 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg + use mo_rte_kind, only: wl ! Inputs class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object @@ -44,10 +45,10 @@ subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical, dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical, dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical, dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical, dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array From cf0f66c9661581de92f5528a329692a2bba2bdcc Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 29 May 2025 13:37:13 -0600 Subject: [PATCH 027/140] use file io reader for cloud optics --- schemes/rrtmgp/rrtmgp_inputs.F90 | 342 ----------------- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 351 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 121 ++---- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 297 +++++++++++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 326 ++++++++++++++++ .../utils/rrtmgp_cloud_optics_setup.F90 | 219 +++++++++++ 6 files changed, 1216 insertions(+), 440 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_inputs_setup.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 create mode 100644 schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 859c133c..1baa7219 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -3,157 +3,9 @@ module rrtmgp_inputs implicit none private - public :: rrtmgp_inputs_init public :: rrtmgp_inputs_run contains -!> \section arg_table_rrtmgp_inputs_init Argument Table -!! \htmlinclude rrtmgp_inputs_init.html -!! - subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & - pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & - timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & - nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & - nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) - use ccpp_kinds, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp - - ! Inputs - integer, intent(in) :: nswbands - integer, intent(in) :: nlwbands ! Number of longwave bands - integer, intent(in) :: nradgas ! Number of radiatively active gases - integer, intent(in) :: pverp ! Number of vertical interfaces - integer, intent(in) :: pver ! Number of vertical layers - integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). - integer, intent(in) :: timestep_size ! Timestep size (s) - integer, intent(in) :: nstep ! Current timestep number - integer, intent(in) :: iulog ! Logging unit - integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries - real(kind_phys), intent(in) :: current_cal_day ! Current calendar day - real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object - logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) - logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) - logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation - logical, intent(in) :: is_root ! Flag for whether this is the root task - character(len=*), dimension(:), intent(in) :: gaslist - - ! Outputs - integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay - ! or is 1 less than nlay if "extra layer" is used in the radiation calculations - integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation - integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) - ! Indices to specific bands for diagnostic output and COSP input - integer, intent(out) :: idx_sw_diag ! Index of band containing 500-nm wave - integer, intent(out) :: idx_nir_diag ! Index of band containing 1000-nm wave - integer, intent(out) :: idx_uv_diag ! Index of band containing 400-nm wave - integer, intent(out) :: idx_sw_cloudsim ! Index of band for shortwave cosp diagnostics - integer, intent(out) :: idx_lw_diag ! Index of band containing 1000-cm-1 wave (H2O window) - integer, intent(out) :: idx_lw_cloudsim ! Index of band for longwave cosp diagnostics - - integer, intent(out) :: nswgpts ! Number of shortwave g-points - integer, intent(out) :: nlwgpts ! Number of longwave g-points - integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points - real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed - real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands - real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands - real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously - real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle - - ! Local variables - real(kind_phys), target :: wavenumber_low_shortwave(nswbands) - real(kind_phys), target :: wavenumber_high_shortwave(nswbands) - real(kind_phys), target :: wavenumber_low_longwave(nlwbands) - real(kind_phys), target :: wavenumber_high_longwave(nlwbands) - character(len=gasnamelength) :: gaslist_lc(nradgas) - - ! Set error variables - errflg = 0 - errmsg = '' - - ! Number of layers in radiation calculation is capped by the number of - ! pressure interfaces below 1 Pa. When the entire model atmosphere is - ! below 1 Pa then an extra layer is added to the top of the model for - ! the purpose of the radiation calculation. - nlay = count( pref_edge(:) > 1._kind_phys ) ! pascals (0.01 mbar) - nlayp = nlay + 1 - - if (nlay == pverp) then - ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus - ! 1 extra layer between model top and 1 Pa. - ktopcam = 1 - ktoprad = 2 - nlaycam = pver - else if (nlay == (pverp-1)) then - ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. - ktopcam = 1 - ktoprad = 2 - nlaycam = pver - nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp - if (is_root) then - write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' - write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp - end if - else - ! nlay < pverp. nlay layers are used in radiation calcs, and they are - ! all CAM layers. - ktopcam = pver - nlay + 1 - ktoprad = 1 - nlaycam = nlay - end if - - ! Set the sw/lw band boundaries in radconstants. Also sets - ! indicies of specific bands for diagnostic output and COSP input. - call set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & - idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & - wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & - wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) - if (errflg /= 0) then - return - end if - - call radiation_utils_init(nswbands, nlwbands, wavenumber_low_shortwave, wavenumber_high_shortwave, & - wavenumber_low_longwave, wavenumber_high_longwave, errmsg, errflg) - if (errflg /= 0) then - return - end if - - ! Initialize the SW band boundaries - call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) - if (errflg /= 0) then - return - end if - - if (is_first_step) then - qrl = 0._kind_phys - end if - - ! Set the radiation timestep for cosz calculations if requested using - ! the adjusted iradsw value from radiation - if (use_rad_dt_cosz) then - dt_avg = iradsw*timestep_size - end if - - ! "irad_always" is number of time steps to execute radiation continuously from - ! start of initial OR restart run - if (irad_always > 0) then - irad_always = irad_always + nstep - end if - - ! Surface components to get radiation computed today - if (.not. is_first_restart_step) then - nextsw_cday = current_cal_day - end if - - end subroutine rrtmgp_inputs_init !> \section arg_table_rrtmgp_inputs_run Argument Table !! \htmlinclude rrtmgp_inputs_run.html @@ -438,198 +290,4 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & end subroutine rrtmgp_inputs_run -!========================================================================================= -! HELPER FUNCTIONS ! -!========================================================================================= - subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & - idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & - wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & - wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - ! Set the low and high limits of the wavenumber grid for sw and lw. - ! Values come from RRTMGP coefficients datasets, and are stored in the - ! kdist objects. - ! - ! Set band indices for bands containing specific wavelengths. - - ! Arguments - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw - integer, intent(in) :: nswbands - integer, intent(in) :: nlwbands - - integer, intent(out) :: idx_sw_diag - integer, intent(out) :: idx_nir_diag - integer, intent(out) :: idx_uv_diag - integer, intent(out) :: idx_sw_cloudsim - integer, intent(out) :: idx_lw_diag - integer, intent(out) :: idx_lw_cloudsim - integer, intent(out) :: nswgpts - integer, intent(out) :: nlwgpts - integer, dimension(:,:), intent(out) :: band2gpt_sw - real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: istat - real(kind_phys), allocatable :: values(:,:) - character(len=256) :: alloc_errmsg - - character(len=*), parameter :: sub = 'set_wavenumber_bands' - !---------------------------------------------------------------------------- - - ! Initialize error variables - errflg = 0 - errmsg = '' - ! Check that number of sw/lw bands in gas optics files matches the parameters. - if (kdist_sw%gas_props%get_nband() /= nswbands) then - write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & - ", doesn't match parameter nswbands= ", nswbands - errflg = 1 - return - end if - if (kdist_lw%gas_props%get_nband() /= nlwbands) then - write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & - ", doesn't match parameter nlwbands= ", nlwbands - errflg = 1 - return - end if - - nswgpts = kdist_sw%gas_props%get_ngpt() - nlwgpts = kdist_lw%gas_props%get_ngpt() - - ! SW band bounds in cm^-1 - allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) - if (istat/=0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg - errflg = 1 - return - end if - values = kdist_sw%gas_props%get_band_lims_wavenumber() - wavenumber_low_shortwave = values(1,:) - wavenumber_high_shortwave = values(2,:) - - ! First and last g-point for each SW band: - band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() - - ! Indices into specific bands - call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) - if (errflg /= 0) then - return - end if - - deallocate(values) - - ! LW band bounds in cm^-1 - allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) - if (istat/=0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg - errflg = 1 - return - end if - values = kdist_lw%gas_props%get_band_lims_wavenumber() - wavenumber_low_longwave = values(1,:) - wavenumber_high_longwave = values(2,:) - - ! Indices into specific bands - call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & - wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & - wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) - if (errflg /= 0) then - return - end if - - end subroutine set_wavenumber_bands - -!========================================================================================= - - subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & - wavenumber_high, ans, errmsg, errflg) - - ! Find band index for requested wavelength/wavenumber. - - character(len=*), intent(in) :: swlw ! sw or lw bands - real(kind_phys), intent(in) :: targetvalue - character(len=*), intent(in) :: units ! units of targetvalue - integer, intent(in) :: nbnds - real(kind_phys), dimension(:), intent(in) :: wavenumber_low - real(kind_phys), dimension(:), intent(in) :: wavenumber_high - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(out) :: ans - - ! local - real(kind_phys) :: tgt - integer :: idx - - character(len=*), parameter :: sub = 'get_band_index_by_value' - !---------------------------------------------------------------------------- - - ! Initialize error variables - errflg = 0 - errmsg = '' - if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then - write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw - errflg = 1 - return - end if - - ! band info is in cm^-1 but target value may be other units, - ! so convert targetvalue to cm^-1 - select case (units) - case ('inv_cm','cm^-1','cm-1') - tgt = targetvalue - case('m','meter','meters') - tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) - case('nm','nanometer','nanometers') - tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) - case('um','micrometer','micrometers','micron','microns') - tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) - case('cm','centimeter','centimeters') - tgt = 1._kind_phys/targetvalue - case default - write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: units not recognized: ', units - errflg = 1 - end select - - ! now just loop through the array - ans = 0 - do idx = 1,nbnds - if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then - ans = idx - exit - end if - end do - - if (ans == 0) then - write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) - errflg = 1 - end if - - end subroutine get_band_index_by_value - end module rrtmgp_inputs diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 new file mode 100644 index 00000000..2ffd8ea0 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -0,0 +1,351 @@ +module rrtmgp_inputs_setup + + implicit none + private + + public :: rrtmgp_inputs_setup_init + + contains +!> \section arg_table_rrtmgp_inputs_setup_init Argument Table +!! \htmlinclude rrtmgp_inputs_setup_init.html +!! + subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & + pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & + timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & + nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & + nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp + + ! Inputs + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nradgas ! Number of radiatively active gases + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). + integer, intent(in) :: timestep_size ! Timestep size (s) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: iulog ! Logging unit + integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries + real(kind_phys), intent(in) :: current_cal_day ! Current calendar day + real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) + logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) + logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation + logical, intent(in) :: is_root ! Flag for whether this is the root task + character(len=*), dimension(:), intent(in) :: gaslist + + ! Outputs + integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay + ! or is 1 less than nlay if "extra layer" is used in the radiation calculations + integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation + integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) + ! Indices to specific bands for diagnostic output and COSP input + integer, intent(out) :: idx_sw_diag ! Index of band containing 500-nm wave + integer, intent(out) :: idx_nir_diag ! Index of band containing 1000-nm wave + integer, intent(out) :: idx_uv_diag ! Index of band containing 400-nm wave + integer, intent(out) :: idx_sw_cloudsim ! Index of band for shortwave cosp diagnostics + integer, intent(out) :: idx_lw_diag ! Index of band containing 1000-cm-1 wave (H2O window) + integer, intent(out) :: idx_lw_cloudsim ! Index of band for longwave cosp diagnostics + + integer, intent(out) :: nswgpts ! Number of shortwave g-points + integer, intent(out) :: nlwgpts ! Number of longwave g-points + integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points + real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed + real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands + real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously + real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle + + ! Local variables + real(kind_phys), target :: wavenumber_low_shortwave(nswbands) + real(kind_phys), target :: wavenumber_high_shortwave(nswbands) + real(kind_phys), target :: wavenumber_low_longwave(nlwbands) + real(kind_phys), target :: wavenumber_high_longwave(nlwbands) + character(len=gasnamelength) :: gaslist_lc(nradgas) + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Number of layers in radiation calculation is capped by the number of + ! pressure interfaces below 1 Pa. When the entire model atmosphere is + ! below 1 Pa then an extra layer is added to the top of the model for + ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._kind_phys ) ! pascals (0.01 mbar) + nlayp = nlay + 1 + + if (nlay == pverp) then + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + if (is_root) then + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp + end if + else + ! nlay < pverp. nlay layers are used in radiation calcs, and they are + ! all CAM layers. + ktopcam = pver - nlay + 1 + ktoprad = 1 + nlaycam = nlay + end if + + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. + call set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + call radiation_utils_init(nswbands, nlwbands, wavenumber_low_shortwave, wavenumber_high_shortwave, & + wavenumber_low_longwave, wavenumber_high_longwave, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Initialize the SW band boundaries + call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) + if (errflg /= 0) then + return + end if + + if (is_first_step) then + qrl = 0._kind_phys + end if + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dt_avg = iradsw*timestep_size + end if + + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run + if (irad_always > 0) then + irad_always = irad_always + nstep + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step) then + nextsw_cday = current_cal_day + end if + + end subroutine rrtmgp_inputs_setup_init + +!========================================================================================= +! HELPER FUNCTIONS ! +!========================================================================================= + subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. + + ! Arguments + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + + integer, intent(out) :: idx_sw_diag + integer, intent(out) :: idx_nir_diag + integer, intent(out) :: idx_uv_diag + integer, intent(out) :: idx_sw_cloudsim + integer, intent(out) :: idx_lw_diag + integer, intent(out) :: idx_lw_cloudsim + integer, intent(out) :: nswgpts + integer, intent(out) :: nlwgpts + integer, dimension(:,:), intent(out) :: band2gpt_sw + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: istat + real(kind_phys), allocatable :: values(:,:) + character(len=256) :: alloc_errmsg + + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%gas_props%get_nband() /= nswbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + errflg = 1 + return + end if + if (kdist_lw%gas_props%get_nband() /= nlwbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + errflg = 1 + return + end if + + nswgpts = kdist_sw%gas_props%get_ngpt() + nlwgpts = kdist_lw%gas_props%get_ngpt() + + ! SW band bounds in cm^-1 + allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_sw%gas_props%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + + ! First and last g-point for each SW band: + band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() + + ! Indices into specific bands + call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_lw%gas_props%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine set_wavenumber_bands + +!========================================================================================= + + subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & + wavenumber_high, ans, errmsg, errflg) + + ! Find band index for requested wavelength/wavenumber. + + character(len=*), intent(in) :: swlw ! sw or lw bands + real(kind_phys), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue + integer, intent(in) :: nbnds + real(kind_phys), dimension(:), intent(in) :: wavenumber_low + real(kind_phys), dimension(:), intent(in) :: wavenumber_high + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(out) :: ans + + ! local + real(kind_phys) :: tgt + integer :: idx + + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then + write(errmsg,'(a,a)') 'rrtmgp_inputs_setup: get_band_index_by_value: type of bands not recognized: ', swlw + errflg = 1 + return + end if + + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) + case('nm','nanometer','nanometers') + tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) + case('cm','centimeter','centimeters') + tgt = 1._kind_phys/targetvalue + case default + write(errmsg,'(a,a)') 'rrtmgp_inputs_setup: get_band_index_by_value: units not recognized: ', units + errflg = 1 + end select + + ! now just loop through the array + ans = 0 + do idx = 1,nbnds + if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then + ans = idx + exit + end if + end do + + if (ans == 0) then + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + errflg = 1 + end if + + end subroutine get_band_index_by_value + +end module rrtmgp_inputs_setup diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 4d8f220f..5dd08ed2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -12,95 +12,10 @@ module rrtmgp_lw_cloud_optics implicit none private - public :: rrtmgp_lw_cloud_optics_init public :: rrtmgp_lw_cloud_optics_run - real(kind_phys), allocatable :: abs_lw_liq(:,:,:) - real(kind_phys), allocatable :: abs_lw_ice(:,:) - real(kind_phys), allocatable :: g_mu(:) - real(kind_phys), allocatable :: g_d_eff(:) - real(kind_phys), allocatable :: g_lambda(:,:) - real(kind_phys) :: tiny - integer :: nmu - integer :: nlambda - integer :: n_g_d - - contains - ! ###################################################################################### - ! SUBROUTINE rrtmgp_lw_cloud_optics_init() - ! ###################################################################################### -!> \section arg_table_rrtmgp_lw_cloud_optics_init Argument Table -!! \htmlinclude rrtmgp_lw_cloud_optics_init.html -!! - subroutine rrtmgp_lw_cloud_optics_init(nmu_in, nlambda_in, n_g_d_in, & - abs_lw_liq_in, abs_lw_ice_in, nlwbands, g_mu_in, g_lambda_in, & - g_d_eff_in, tiny_in, errmsg, errflg) - ! Inputs - integer, intent(in) :: nmu_in ! Number of mu samples on grid - integer, intent(in) :: nlambda_in ! Number of lambda scale samples on grid - integer, intent(in) :: n_g_d_in ! Number of radiative effective diameter samples on grid - integer, intent(in) :: nlwbands ! Number of longwave bands - real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq_in ! Longwave mass specific absorption for in-cloud liquid water path - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice_in ! Longwave mass specific absorption for in-cloud ice water path - real(kind_phys), dimension(:,:), intent(in) :: g_lambda_in ! lambda scale samples on grid - real(kind_phys), dimension(:), intent(in) :: g_mu_in ! Mu samples on grid - real(kind_phys), dimension(:), intent(in) :: g_d_eff_in ! Radiative effective diameter samples on grid - real(kind_phys), intent(in) :: tiny_in ! Definition of what "tiny" means - - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - character(len=256) :: alloc_errmsg - character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_init' - - ! Set error variables - errmsg = '' - errflg = 0 - - ! Set module-level variables - nmu = nmu_in - nlambda = nlambda_in - n_g_d = n_g_d_in - tiny = tiny_in - ! Allocate module-level-variables - allocate(abs_lw_liq(nmu,nlambda,nlwbands), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq, message: ', alloc_errmsg - return - end if - allocate(abs_lw_ice(n_g_d,nlwbands), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice, message: ', alloc_errmsg - return - end if - allocate(g_mu(nmu), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu, message: ', alloc_errmsg - return - end if - allocate(g_lambda(nmu,nlambda), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda, message: ', alloc_errmsg - return - end if - allocate(g_d_eff(n_g_d), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff, message: ', alloc_errmsg - return - end if - - abs_lw_liq = abs_lw_liq_in - abs_lw_ice = abs_lw_ice_in - g_mu = g_mu_in - g_lambda = g_lambda_in - g_d_eff = g_d_eff_in - - end subroutine rrtmgp_lw_cloud_optics_init - ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_run() ! ###################################################################################### @@ -108,9 +23,10 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & - cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & - dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & - ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, abs_lw_liq, abs_lw_ice, & + g_mu, g_lambda, g_d_eff, tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & + do_snow, do_graupel, pver, ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, & + errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp ! Compute combined cloud optical properties @@ -137,6 +53,12 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:), intent(in) :: g_lambda + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), intent(in) :: tiny_in logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation @@ -175,14 +97,14 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Combine the cloud optical properties. ! gammadist liquid optics - call liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & - abs_lw_liq, liq_lw_abs, errmsg, errflg) + call liquid_cloud_get_rad_props_lw(ncol, pver, size(g_mu), size(g_lambda,2), nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & + abs_lw_liq, tiny_in, liq_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if ! Mitchell ice optics call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & - n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, errmsg, errflg) + size(g_d_eff), g_d_eff, abs_lw_ice, tiny_in, ice_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -192,7 +114,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in snow if (do_snow) then call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & - n_g_d, g_d_eff, abs_lw_ice, snow_lw_abs, errmsg, errflg) + size(g_d_eff), g_d_eff, abs_lw_ice, tiny_in, snow_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -212,8 +134,8 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in graupel if (do_graupel) then - call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & - g_d_eff, abs_lw_ice, grau_lw_abs, errmsg, errflg) + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, size(g_d_eff), & + g_d_eff, abs_lw_ice, tiny_in, grau_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -250,7 +172,7 @@ end subroutine rrtmgp_lw_cloud_optics_run !============================================================================== subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, & - g_mu, g_lambda, iclwpth, abs_lw_liq, abs_od, errmsg, errflg) + g_mu, g_lambda, iclwpth, abs_lw_liq, tiny, abs_od, errmsg, errflg) ! Inputs integer, intent(in) :: ncol integer, intent(in) :: pver @@ -263,6 +185,7 @@ subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lam real(kind_phys), dimension(:), intent(in) :: g_mu real(kind_phys), dimension(:,:), intent(in) :: g_lambda real(kind_phys), dimension(:,:), intent(in) :: iclwpth + real(kind_phys), intent(in) :: tiny ! Outputs real(kind_phys), dimension(:,:,:), intent(out) :: abs_od character(len=*), intent(out) :: errmsg @@ -280,7 +203,7 @@ subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lam do idx = 1,ncol if(lamc(idx,kdx) > 0._kind_phys) then ! This seems to be the clue for no cloud from microphysics formulation call gam_liquid_lw(nlwbands, nmu, nlambda, iclwpth(idx,kdx), lamc(idx,kdx), pgam(idx,kdx), abs_lw_liq, & - g_mu, g_lambda, abs_od(1:nlwbands,idx,kdx), errmsg, errflg) + g_mu, g_lambda, tiny, abs_od(1:nlwbands,idx,kdx), errmsg, errflg) else abs_od(1:nlwbands,idx,kdx) = 0._kind_phys endif @@ -291,7 +214,7 @@ end subroutine liquid_cloud_get_rad_props_lw !============================================================================== - subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, abs_od, errmsg, errflg) + subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, tiny, abs_od, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_finish use radiation_utils, only: get_mu_lambda_weights_ccpp ! Inputs @@ -304,6 +227,7 @@ subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq real(kind_phys), dimension(:), intent(in) :: g_mu real(kind_phys), dimension(:,:) , intent(in) :: g_lambda + real(kind_phys), intent(in) :: tiny ! Outputs real(kind_phys), dimension(:), intent(out) :: abs_od integer, intent(out) :: errflg @@ -339,7 +263,7 @@ end subroutine gam_liquid_lw !============================================================================== subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & - n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + n_g_d, g_d_eff, abs_lw_ice, tiny, abs_od, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_init, & lininterp_finish, extrap_method_bndry @@ -351,6 +275,7 @@ subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & real(kind_phys), dimension(:,:), intent(in) :: iciwpth real(kind_phys), dimension(:,:), intent(in) :: dei real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), intent(in) :: tiny real(kind_phys), dimension(:,:,:), intent(out) :: abs_od character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 6812b895..f49b9dcf 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -7,10 +7,307 @@ module rrtmgp_lw_gas_optics implicit none private + public :: rrtmgp_lw_gas_optics_init public :: rrtmgp_lw_gas_optics_run contains +!> \section arg_table_rrtmgp_lw_gas_optics_init Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_init.html +!! + subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & + errmsg, errcode) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + use mo_rte_kind, only: wl + + ! Inputs + character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errcode ! CCPP error code + + ! Local variables + class(abstract_netcdf_reader_t), allocatable :: pio_reader + character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band + integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable + character(len=256) :: alloc_errmsg + integer :: idx + + ! Initialize error variables + errmsg = '' + errcode = 0 + + pio_reader = create_netcdf_reader_t() + + ! Open the longwave coefficients file + call pio_reader%open_file(lw_filename, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Read the coefficients from the file + call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('key_species', key_species, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('totplnk', totplnk, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Close the longwave coefficients file + call pio_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & + optimal_angle_fit) + + if (len_trim(errmsg) > 0) then + errcode = 1 + end if + call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_lw_gas_optics_init + !> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 new file mode 100644 index 00000000..d525915f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -0,0 +1,326 @@ +!> \file rrtmgp_sw_gas_optics.F90 +!! + +!> This module contains an init routine to initialize the shortwave gas optics object +!> with data read in from file on the host side +module rrtmgp_sw_gas_optics + + implicit none + private + public :: rrtmgp_sw_gas_optics_init + + +contains +!> \section arg_table_rrtmgp_sw_gas_optics_init Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_init.html +!! + subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & + errmsg, errcode) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + use mo_rte_kind, only: wl + + ! Inputs + character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errcode ! CCPP error code + + ! Local variables + class(abstract_netcdf_reader_t), allocatable :: pio_reader + character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band + integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] + real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] + real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] + real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + character(len=256) :: alloc_errmsg + integer :: idx + + ! Initialize error variables + errmsg = '' + errcode = 0 + + pio_reader = create_netcdf_reader_t() + + ! Open the longwave coefficients file + call pio_reader%open_file(sw_filename, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Read the coefficients from the file + call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('key_species', key_species, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('tsi_default', tsi_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('mg_default', mg_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('sb_default', sb_default, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + ! OK if variable is not on file + if (errcode /= 0 .and. errcode /= 3) then + return + end if + if (errcode /= 3) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + if (errcode /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) + if (errcode /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) .eq. 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + if (errcode /= 0) then + return + end if + call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Close the longwave coefficients file + call pio_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + solar_src_quiet, solar_src_facular, solar_src_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower_allocatable, rayl_upper_allocatable) + + if (len_trim(errmsg) > 0) then + errcode = 1 + end if + call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_sw_gas_optics_init + +end module rrtmgp_sw_gas_optics diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 new file mode 100644 index 00000000..865ce94e --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -0,0 +1,219 @@ + +!> This module contains two routines: The first initializes data and functions +!! needed to compute the longwave cloud radiative properties in RRTMGP. The second routine +!! is a ccpp scheme within the "radiation loop", where the shortwave optical properties +!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL +!! cloud types visible to RRTMGP. +module rrtmgp_cloud_optics_setup + use ccpp_kinds, only: kind_phys + + implicit none + private + public :: rrtmgp_cloud_optics_setup_init + +contains + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_cloud_optics_setup_init() + ! ###################################################################################### +!> \section arg_table_rrtmgp_cloud_optics_setup_init Argument Table +!! \htmlinclude rrtmgp_cloud_optics_setup_init.html +!! +! subroutine rrtmgp_cloud_optics_setup_init(liq_filename, abs_lw_liq_out, & +! ext_sw_liq_out, ssa_sw_liq_out, asm_sw_liq_out, g_lambda_out, g_mu_out, errmsg, errflg) + subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq_out, abs_lw_ice_out, & + ext_sw_liq_out, ext_sw_ice_out, ssa_sw_liq_out, ssa_sw_ice_out, asm_sw_liq_out, & + asm_sw_ice_out, g_lambda_out, g_mu_out, g_d_eff_out, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + ! Inputs + character(len=*), intent(in) :: liq_filename ! Full file path for liquid optics file + character(len=*), intent(in) :: ice_filename ! Full file path for ice optics file + ! Outputs + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq_out ! Longwave mass specific absorption for in-cloud liquid water path + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq_out + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq_out + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: asm_sw_liq_out + real(kind_phys), dimension(:,:), allocatable, intent(out) :: abs_lw_ice_out ! Longwave mass specific absorption for in-cloud ice water path + real(kind_phys), dimension(:,:), allocatable, intent(out) :: ext_sw_ice_out + real(kind_phys), dimension(:,:), allocatable, intent(out) :: ssa_sw_ice_out + real(kind_phys), dimension(:,:), allocatable, intent(out) :: asm_sw_ice_out + real(kind_phys), dimension(:,:), allocatable, intent(out) :: g_lambda_out ! lambda scale samples on grid + real(kind_phys), dimension(:), allocatable, intent(out) :: g_mu_out ! Mu samples on grid + real(kind_phys), dimension(:), allocatable, intent(out) :: g_d_eff_out ! Radiative effective diameter samples on grid + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + class(abstract_netcdf_reader_t), allocatable :: pio_reader + real(kind_phys), dimension(:), pointer :: g_mu + real(kind_phys), dimension(:), pointer :: g_d_eff + real(kind_phys), dimension(:,:), pointer :: g_lambda + real(kind_phys), dimension(:,:), pointer :: ext_sw_ice + real(kind_phys), dimension(:,:), pointer :: ssa_sw_ice + real(kind_phys), dimension(:,:), pointer :: asm_sw_ice + real(kind_phys), dimension(:,:), pointer :: abs_lw_ice + real(kind_phys), dimension(:,:,:), pointer :: ext_sw_liq + real(kind_phys), dimension(:,:,:), pointer :: ssa_sw_liq + real(kind_phys), dimension(:,:,:), pointer :: asm_sw_liq + real(kind_phys), dimension(:,:,:), pointer :: abs_lw_liq + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'rrtmgp_cloud_optics_setup_init' + + ! Set error variables + errmsg = '' + errflg = 0 + + pio_reader = create_netcdf_reader_t() + + ! Open liquid optics file + call pio_reader%open_file(liq_filename, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Read in variables + call pio_reader%get_var('mu', g_mu, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('lambda', g_lambda, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('k_ext_sw', ext_sw_liq, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('ssa_sw', ssa_sw_liq, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('asm_sw', asm_sw_liq, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('k_abs_lw', abs_lw_liq, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Close the liquid optics file + call pio_reader%close_file(errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Convert kext from m^2/Volume to m^2/Kg + ext_sw_liq = ext_sw_liq / 0.9970449e3_kind_phys + abs_lw_liq = abs_lw_liq / 0.9970449e3_kind_phys + + ! Open the ice optics file + call pio_reader%open_file(ice_filename, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Read in variables + call pio_reader%get_var('d_eff', g_d_eff, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('sw_ext', ext_sw_ice, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('sw_ssa', ssa_sw_ice, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('sw_asm', asm_sw_ice, errmsg, errflg) + if (errflg /= 0) then + return + end if + call pio_reader%get_var('lw_abs', abs_lw_ice, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Close the ice optics file + call pio_reader%close_file(errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Allocate output variables + allocate(g_mu_out(size(g_mu)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu_out, message: ', alloc_errmsg + return + end if + allocate(g_lambda_out(size(g_lambda,1), size(g_lambda,2)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda_out, message: ', alloc_errmsg + return + end if + allocate(g_d_eff_out(size(g_d_eff)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff_out, message: ', alloc_errmsg + return + end if + allocate(ext_sw_liq_out(size(ext_sw_liq,1),size(ext_sw_liq,2),size(ext_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_liq_out, message: ', alloc_errmsg + return + end if + allocate(ext_sw_ice_out(size(ext_sw_ice,1),size(ext_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_ice_out, message: ', alloc_errmsg + return + end if + allocate(asm_sw_liq_out(size(asm_sw_liq,1),size(asm_sw_liq,2),size(asm_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_liq_out, message: ', alloc_errmsg + return + end if + allocate(asm_sw_ice_out(size(asm_sw_ice,1),size(asm_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_ice_out, message: ', alloc_errmsg + return + end if + allocate(ssa_sw_liq_out(size(ssa_sw_liq,1),size(ssa_sw_liq,2),size(ssa_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_liq_out, message: ', alloc_errmsg + return + end if + allocate(ssa_sw_ice_out(size(ssa_sw_ice,1),size(ssa_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_ice_out, message: ', alloc_errmsg + return + end if + allocate(abs_lw_liq_out(size(abs_lw_liq,1),size(abs_lw_liq,2),size(abs_lw_liq,3)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq_out, message: ', alloc_errmsg + return + end if + allocate(abs_lw_ice_out(size(abs_lw_ice,1),size(abs_lw_ice,2)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice_out, message: ', alloc_errmsg + return + end if + + ext_sw_liq_out = ext_sw_liq + ext_sw_ice_out = ext_sw_ice + ssa_sw_liq_out = ssa_sw_liq + ssa_sw_ice_out = ssa_sw_ice + asm_sw_liq_out = asm_sw_liq + asm_sw_ice_out = asm_sw_ice + abs_lw_liq_out = abs_lw_liq + abs_lw_ice_out = abs_lw_ice + g_mu_out = g_mu + g_lambda_out = g_lambda + g_d_eff_out = g_d_eff + + end subroutine rrtmgp_cloud_optics_setup_init + +!============================================================================== + +end module rrtmgp_cloud_optics_setup From 35d186f66d4bddb01e10b4babb2546f41319d6bf Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 29 May 2025 13:52:52 -0600 Subject: [PATCH 028/140] remove unused file --- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 310 ------------------- 1 file changed, 310 deletions(-) delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 deleted file mode 100644 index 046dc2cb..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ /dev/null @@ -1,310 +0,0 @@ -!> \file rrtmgp_lw_gas_optics_data.F90 -!! - -!> This module contains an init routine to initialize the longwave gas optics object -!> with data read in from file on the host side -module rrtmgp_lw_gas_optics_data - - implicit none - private - public :: rrtmgp_lw_gas_optics_data_init - - -contains -!> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table -!! \htmlinclude rrtmgp_lw_gas_optics_data_init.html -!! - subroutine rrtmgp_lw_gas_optics_data_init(kdist, lw_filename, available_gases, & - errmsg, errcode) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg -! use pio_reader, only: pio_reader_t - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - - ! Inputs - character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - - ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code - - ! Local variables - class(abstract_netcdf_reader_t), allocatable :: pio_reader - character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band - integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical, dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical, dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical, dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical, dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable - character(len=256) :: alloc_errmsg - integer :: idx - - ! Initialize error variables - errmsg = '' - errcode = 0 - - pio_reader = create_netcdf_reader_t() - - ! Open the longwave coefficients file - call pio_reader%open_file(lw_filename, errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Read the coefficients from the file - call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('key_species', key_species, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('totplnk', totplnk, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) - ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then - return - end if - if (errcode /= 3) then - allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) - rayl_lower_allocatable = rayl_lower - end if - call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) - ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then - return - end if - if (errcode /= 3) then - allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) - rayl_upper_allocatable = rayl_upper - end if - call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - minor_scales_with_density_lower(idx) = .false. - else - minor_scales_with_density_lower(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - scale_by_complement_lower(idx) = .false. - else - scale_by_complement_lower(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - minor_scales_with_density_upper(idx) = .false. - else - minor_scales_with_density_upper(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - scale_by_complement_upper(idx) = .false. - else - scale_by_complement_upper(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Close the longwave coefficients file - call pio_reader%close_file(errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Initialize the gas optics object with data. - errmsg = kdist%gas_props%load( & - available_gases%gas_concs, gas_names, key_species, & - band2gpt, band_lims_wavenum, & - press_ref, press_ref_trop, temp_ref, & - temp_ref_p, temp_ref_t, vmr_ref, & - kmajor, kminor_lower, kminor_upper, & - gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, & - minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, & - scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & - optimal_angle_fit) - - if (len_trim(errmsg) > 0) then - errcode = 1 - end if - call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) - - end subroutine rrtmgp_lw_gas_optics_data_init - -end module rrtmgp_lw_gas_optics_data From 9c4d2e60d2d283e1b180553bc0ec52e409d89a1a Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 29 May 2025 16:22:45 -0600 Subject: [PATCH 029/140] update metadata; create interstitial to make rad_const_array --- schemes/rrtmgp/rrtmgp_constituents.F90 | 34 +++ schemes/rrtmgp/rrtmgp_constituents.meta | 32 +++ schemes/rrtmgp/rrtmgp_inputs.meta | 252 ----------------- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 255 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 114 +++----- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 35 ++- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta | 225 ---------------- .../rrtmgp/rrtmgp_lw_gas_optics_namelist.xml | 2 +- .../utils/rrtmgp_cloud_optics_setup.meta | 108 ++++++++ .../rrtmgp_cloud_optics_setup_namelist.xml} | 4 +- test/test_suites/suite_rrtmgp.xml | 10 +- 12 files changed, 508 insertions(+), 565 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_inputs_setup.meta delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta create mode 100644 schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta rename schemes/rrtmgp/{rrtmgp_cloud_optics_namelist.xml => utils/rrtmgp_cloud_optics_setup_namelist.xml} (96%) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 12c36b20..63fe8988 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -123,4 +123,38 @@ subroutine rrtmgp_constituents_init(gaslist, errmsg, errcode) end subroutine rrtmgp_constituents_init +!> \section arg_table_rrtmgp_constituents_run Argument Table +!! \htmlinclude rrtmgp_constituents_run.html +!! + subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg, errcode) + use ccpp_constituent_prop_mod, only: int_unassigned + use ccpp_scheme_utils, only: ccpp_constituent_index + character(len=5), intent(in) :: gaslist(:) + real(kind_phys), intent(in) :: const_array(:,:,:) + real(kind_phys), intent(out) :: rad_const_array(:,:,:) + integer, intent(out) :: errcode + character(len=512), intent(out) :: errmsg + + ! Local variables + integer :: gas_idx + integer :: const_idx + + errcode = 0 + errmsg = '' + + rad_const_array = 0._kind_phys + + do gas_idx = 1, size(gaslist) + ! Find the index of the current gas in the constituents array + call ccpp_constituent_index(trim(gaslist(gas_idx)), const_idx, errcode, errmsg) + if (errcode /= 0) then + return + end if + if (const_idx /= int_unassigned) then + rad_const_array(:,:,gas_idx) = const_array(:,:,const_idx) + end if + end do + + end subroutine rrtmgp_constituents_run + end module rrtmgp_constituents diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index ec7c31f7..1c7ca4a3 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -51,3 +51,35 @@ type = integer dimensions = () intent = out +[ccpp-arg-table] + name = rrtmgp_constituents_run + type = scheme +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=5 + dimensions = (number_of_active_gases_for_RRTMGP) + intent = out +[ const_array ] + standard_name = ccpp_constituents + units = none + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_ccpp_constituents) + intent = in +[ rad_const_array ] + standard_name = radiatively_active_gas_mass_mixing_ratios_wrt_dry_air + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_active_gases_for_RRTMGP) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 26bfdf34..c04ca119 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -2,258 +2,6 @@ name = rrtmgp_inputs type = scheme -[ccpp-arg-table] - name = rrtmgp_inputs_init - type = scheme -[ ktopcam ] - standard_name = vertical_index_at_top_level_where_RRTMGP_is_active - units = index - type = integer - dimensions = () - intent = out -[ ktoprad ] - standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active - units = index - type = integer - dimensions = () - intent = out -[ nlaycam ] - standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels - units = count - type = integer - dimensions = () - intent = out -[ sw_low_bounds ] - standard_name = min_shortwave_wavenumber_per_band - units = cm-1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation) - intent = out -[ sw_high_bounds ] - standard_name = max_shortwave_wavenumber_per_band - units = cm-1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation) - intent = out -[ nswbands ] - standard_name = number_of_bands_for_shortwave_radiation - units = count - type = integer - dimensions = () - intent = in -[ pref_edge ] - standard_name = reference_pressure_at_interface - units = Pa - type = real | kind = kind_phys - dimensions = (vertical_interface_dimension) - intent = in -[ nlay ] - standard_name = number_of_vertical_layers_in_RRTMGP - units = count - type = integer - dimensions = () - intent = out -[ pver ] - standard_name = vertical_layer_dimension - units = count - type = integer - dimensions = () - intent = in -[ pverp ] - standard_name = vertical_interface_dimension - units = count - type = integer - dimensions = () - intent = in -[ kdist_sw ] - standard_name = shortwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = in -[ kdist_lw ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = in -[ qrl ] - standard_name = longwave_radiative_heating_rate - units = K s-1 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out -[ is_first_step ] - standard_name = is_first_timestep - units = flag - type = logical - dimensions = () - intent = in -[ use_rad_dt_cosz ] - standard_name = use_adjusted_radiation_timestep_for_solar_zenith_angle_calculation - units = flag - type = logical - dimensions = () - intent = in -[ timestep_size ] - standard_name = timestep_for_physics - units = s - type = integer - dimensions = () - intent = in -[ nstep ] - standard_name = current_timestep_number - units = count - type = integer - dimensions = () - intent = in -[ iradsw ] - standard_name = frequency_of_shortwave_radiation_calculation - units = 1 - type = integer - dimensions = () - intent = in -[ dt_avg ] - standard_name = averaging_time_interval_for_solar_zenith_angle_calculation - units = s - type = real | kind = kind_phys - dimensions = () - intent = inout -[ irad_always ] - standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization - units = count - type = integer - dimensions = () - intent = inout -[ is_first_restart_step ] - standard_name = is_first_restart_timestep - units = flag - type = logical - dimensions = () - intent = in -[ is_root ] - standard_name = flag_for_mpi_root - units = flag - type = logical - dimensions = () - intent = in -[ nlwbands ] - standard_name = number_of_bands_for_longwave_radiation - units = count - type = integer - dimensions = () - intent = in -[ nradgas ] - standard_name = number_of_active_gases_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in -[ gasnamelength ] - standard_name = character_length_of_list_of_active_gases_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in -[ iulog ] - standard_name = log_output_unit - units = 1 - type = integer - dimensions = () - intent = in -[ idx_sw_diag ] - standard_name = index_of_shortwave_band - units = index - type = integer - dimensions = () - intent = out -[ idx_nir_diag ] - standard_name = index_of_near_IR_band - units = index - type = integer - dimensions = () - intent = out -[ idx_uv_diag ] - standard_name = index_of_UV_band - units = index - type = integer - dimensions = () - intent = out -[ idx_sw_cloudsim ] - standard_name = index_of_shortwave_band_for_COSP - units = index - type = integer - dimensions = () - intent = out -[ idx_lw_diag ] - standard_name = index_of_longwave_band - units = index - type = integer - dimensions = () - intent = out -[ idx_lw_cloudsim ] - standard_name = index_of_longwave_band_for_COSP - units = index - type = integer - dimensions = () - intent = out -[ gaslist ] - standard_name = list_of_active_gases_for_RRTMGP - units = none - type = character | kind = len=* - dimensions = (number_of_active_gases_for_RRTMGP) - intent = in -[ nswgpts ] - standard_name = number_of_shortwave_g_point_intervals - units = count - type = integer - dimensions = () - intent = out -[ nlwgpts ] - standard_name = number_of_longwave_g_point_intervals - units = count - type = integer - dimensions = () - intent = out -[ nlayp ] - standard_name = number_of_vertical_layers_in_RRTMGP_plus_one - units = count - type = integer - dimensions = () - intent = out -[ nextsw_cday ] - standard_name = next_calendar_day_to_perform_shortwave_radiation_for_surface_models - units = days - type = real | kind = kind_phys - dimensions = () - intent = out -[ current_cal_day ] - standard_name = current_calendar_day - units = days - type = real | kind = kind_phys - dimensions = () - intent = in -[ band2gpt_sw ] - standard_name = shortwave_start_and_end_gpoint_for_each_band - units = index - type = integer - dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) - intent = out -[ errmsg ] - standard_name = ccpp_error_message - long_name = Error message for error handling in CCPP - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - long_name = Error flag for error handling in CCPP - units = 1 - type = integer - dimensions = () - intent = out - [ccpp-arg-table] name = rrtmgp_inputs_run type = scheme diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta new file mode 100644 index 00000000..08cb1a05 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -0,0 +1,255 @@ +[ccpp-table-properties] + name = rrtmgp_inputs_setup + type = scheme + +[ccpp-arg-table] + name = rrtmgp_inputs_setup_init + type = scheme +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ nlaycam ] + standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels + units = count + type = integer + dimensions = () + intent = out +[ sw_low_bounds ] + standard_name = min_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out +[ sw_high_bounds ] + standard_name = max_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ pref_edge ] + standard_name = reference_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (vertical_interface_dimension) + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ kdist_lw ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ qrl ] + standard_name = longwave_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ is_first_step ] + standard_name = is_first_timestep + units = flag + type = logical + dimensions = () + intent = in +[ use_rad_dt_cosz ] + standard_name = use_adjusted_radiation_timestep_for_solar_zenith_angle_calculation + units = flag + type = logical + dimensions = () + intent = in +[ timestep_size ] + standard_name = timestep_for_physics + units = s + type = integer + dimensions = () + intent = in +[ nstep ] + standard_name = current_timestep_number + units = count + type = integer + dimensions = () + intent = in +[ iradsw ] + standard_name = frequency_of_shortwave_radiation_calculation + units = 1 + type = integer + dimensions = () + intent = in +[ dt_avg ] + standard_name = averaging_time_interval_for_solar_zenith_angle_calculation + units = s + type = real | kind = kind_phys + dimensions = () + intent = inout +[ irad_always ] + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + units = count + type = integer + dimensions = () + intent = inout +[ is_first_restart_step ] + standard_name = is_first_restart_timestep + units = flag + type = logical + dimensions = () + intent = in +[ is_root ] + standard_name = flag_for_mpi_root + units = flag + type = logical + dimensions = () + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gasnamelength ] + standard_name = character_length_of_list_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ iulog ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in +[ idx_sw_diag ] + standard_name = index_of_shortwave_band + units = index + type = integer + dimensions = () + intent = out +[ idx_nir_diag ] + standard_name = index_of_near_IR_band + units = index + type = integer + dimensions = () + intent = out +[ idx_uv_diag ] + standard_name = index_of_UV_band + units = index + type = integer + dimensions = () + intent = out +[ idx_sw_cloudsim ] + standard_name = index_of_shortwave_band_for_COSP + units = index + type = integer + dimensions = () + intent = out +[ idx_lw_diag ] + standard_name = index_of_longwave_band + units = index + type = integer + dimensions = () + intent = out +[ idx_lw_cloudsim ] + standard_name = index_of_longwave_band_for_COSP + units = index + type = integer + dimensions = () + intent = out +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (number_of_active_gases_for_RRTMGP) + intent = in +[ nswgpts ] + standard_name = number_of_shortwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = out +[ nlwgpts ] + standard_name = number_of_longwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = out +[ nlayp ] + standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + units = count + type = integer + dimensions = () + intent = out +[ nextsw_cday ] + standard_name = next_calendar_day_to_perform_shortwave_radiation_for_surface_models + units = days + type = real | kind = kind_phys + dimensions = () + intent = out +[ current_cal_day ] + standard_name = current_calendar_day + units = days + type = real | kind = kind_phys + dimensions = () + intent = in +[ band2gpt_sw ] + standard_name = shortwave_start_and_end_gpoint_for_each_band + units = index + type = integer + dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index fa27173a..daef250c 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -2,84 +2,6 @@ name = rrtmgp_lw_cloud_optics type = scheme -[ccpp-arg-table] - name = rrtmgp_lw_cloud_optics_init - type = scheme -[ nmu_in ] - standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = in -[ nlambda_in ] - standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = in -[ n_g_d_in ] - standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid - units = count - type = integer - dimensions = () - intent = in -[ abs_lw_liq_in ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) - intent = in -[ abs_lw_ice_in ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_longwave_radiation) - intent = in -[ nlwbands ] - standard_name = number_of_bands_for_longwave_radiation - units = count - type = integer - dimensions = () - intent = in -[ g_mu_in ] - standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid - units = index - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - intent = in -[ g_lambda_in ] - standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid - units = m-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - intent = in -[ g_d_eff_in ] - standard_name = radiative_effective_diameter_samples_on_ice_optics_grid - units = microns - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) - intent = in -[ tiny_in ] - standard_name = definition_of_tiny_for_RRTMGP - units = 1 - type = real | kind = kind_phys - dimensions = () - intent = in -[ errmsg ] - standard_name = ccpp_error_message - long_name = Error message for error handling in CCPP - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - long_name = Error flag for error handling in CCPP - units = 1 - type = integer - dimensions = () - intent = out - [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run type = scheme @@ -167,6 +89,42 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in +[ abs_lw_liq ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) + intent = in +[ abs_lw_ice ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid, number_of_bands_for_longwave_radiation) + intent = in +[ g_mu ] + standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + intent = in +[ g_lambda ] + standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid + units = m-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + intent = in +[ g_d_eff ] + standard_name = radiative_effective_diameter_samples_on_ice_optics_grid + units = microns + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) + intent = in +[ tiny_in ] + standard_name = definition_of_tiny_for_RRTMGP + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in [ dei ] standard_name = effective_diameter_of_stratiform_cloud_ice_particle_for_radiation units = micron diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index e36ba29d..b58df0d0 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -30,7 +30,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message + character(len=512), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errcode ! CCPP error code ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 627222fa..6ba22407 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -2,6 +2,40 @@ name = rrtmgp_lw_gas_optics type = scheme +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_init + type = scheme +[ kdist ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ lw_filename ] + standard_name = filename_of_rrtmgp_longwave_k_distribution + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + [ccpp-arg-table] name = rrtmgp_lw_gas_optics_run type = scheme @@ -103,4 +137,3 @@ type = integer dimensions = () intent = out - diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta deleted file mode 100644 index 9c226748..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.meta +++ /dev/null @@ -1,225 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_gas_optics_data - type = scheme - -[ccpp-arg-table] - name = rrtmgp_lw_gas_optics_data_init - type = scheme -[ kdist ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = inout -[ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP - units = none - type = ty_gas_concs_ccpp - dimensions = () - intent = in -[ gas_names ] - standard_name = longwave_absorbing_gas_names - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_37:enter_standard_name_38) - intent = in -[ key_species ] - standard_name = longwave_key_species_pair_for_each_band - units = none - type = integer - dimensions = (ccpp_constant_two,enter_standard_name_41:enter_standard_name_42,enter_standard_name_43:enter_standard_name_44) - intent = in -[ band2gpt ] - standard_name = longwave_start_and_end_gpoint_for_each_band - units = index - type = integer - dimensions = (enter_standard_name_45:enter_standard_name_46,enter_standard_name_47:enter_standard_name_48) - intent = in -[ band_lims_wavenum ] - standard_name = longwave_start_and_end_wavenumber_for_each_band - units = cm-1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_49:enter_standard_name_50,enter_standard_name_51:enter_standard_name_52) - intent = in -[ press_ref ] - standard_name = longwave_reference_pressure_bins - units = Pa - type = real | kind = kind_phys - dimensions = (enter_standard_name_53:enter_standard_name_54) - intent = in -[ press_ref_trop ] - standard_name = longwave_reference_pressure_separating_the_lower_and_upper_atmosphere - units = Pa - type = real | kind = kind_phys - dimensions = () - intent = in -[ temp_ref ] - standard_name = longwave_reference_temperature_bins - units = K - type = real | kind = kind_phys - dimensions = (enter_standard_name_55:enter_standard_name_56) - intent = in -[ temp_ref_p ] - standard_name = longwave_standard_spectroscopic_reference_pressure - units = Pa - type = real | kind = kind_phys - dimensions = () - intent = in -[ temp_ref_t ] - standard_name = longwave_standard_spectroscopic_reference_temperature - units = K - type = real | kind = kind_phys - dimensions = () - intent = in -[ vmr_ref ] - standard_name = longwave_volume_mixing_ratios_for_reference_atmosphere - units = mol mol-1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_57:enter_standard_name_58,enter_standard_name_59:enter_standard_name_60,enter_standard_name_61:enter_standard_name_62) - intent = in -[ kmajor ] - standard_name = longwave_absorption_coefficients_due_to_major_absorbing_gases - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_63:enter_standard_name_64,enter_standard_name_65:enter_standard_name_66,enter_standard_name_67:enter_standard_name_68,enter_standard_name_69:enter_standard_name_70) - intent = in -[ kminor_lower ] - standard_name = longwave_absorption_coefficients_due_to_minor_absorbing_gases_in_lower_atmosphere - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_71:enter_standard_name_72,enter_standard_name_73:enter_standard_name_74,enter_standard_name_75:enter_standard_name_76) - intent = in -[ kminor_upper ] - standard_name = longwave_absorption_coefficients_due_to_minor_absorbing_gases_in_upper_atmosphere - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_77:enter_standard_name_78,enter_standard_name_79:enter_standard_name_80,enter_standard_name_81:enter_standard_name_82) - intent = in -[ gas_minor ] - standard_name = longwave_minor_absorbing_gas_names - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_83:enter_standard_name_84) - intent = in -[ identifier_minor ] - standard_name = longwave_unique_string_identifying_minor_gas - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_85:enter_standard_name_86) - intent = in -[ minor_gases_lower ] - standard_name = longwave_minor_absorbing_gas_names_in_lower_atmosphere - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_87:enter_standard_name_88) - intent = in -[ minor_gases_upper ] - standard_name = longwave_minor_absorbing_gas_names_in_upper_atmosphere - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_89:enter_standard_name_90) - intent = in -[ minor_limits_gpt_lower ] - standard_name = longwave_start_and_end_gpoint_for_each_minor_interval_in_lower_atmosphere - units = index - type = integer - dimensions = (enter_standard_name_91:enter_standard_name_92,enter_standard_name_93:enter_standard_name_94) - intent = in -[ minor_limits_gpt_upper ] - standard_name = longwave_start_and_end_gpoint_for_each_minor_interval_in_upper_atmosphere - units = index - type = integer - dimensions = (enter_standard_name_95:enter_standard_name_96,enter_standard_name_97:enter_standard_name_98) - intent = in -[ minor_scales_with_density_lower ] - standard_name = do_longwave_density_scaling_application_to_minor_absorption_coefficients_in_lower_atmosphere - units = flag - type = logical - dimensions = (enter_standard_name_99:enter_standard_name_100) - intent = in -[ minor_scales_with_density_upper ] - standard_name = do_longwave_density_scaling_application_to_minor_absorption_coefficients_in_upper_atmosphere - units = flag - type = logical - dimensions = (enter_standard_name_101:enter_standard_name_102) - intent = in -[ scaling_gas_lower ] - standard_name = longwave_scaling_gas_name_in_lower_atmosphere - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_103:enter_standard_name_104) - intent = in -[ scaling_gas_upper ] - standard_name = longwave_scaling_gas_name_in_upper_atmosphere - units = none - type = character | kind = len=* - dimensions = (enter_standard_name_105:enter_standard_name_106) - intent = in -[ scale_by_complement_lower ] - standard_name = do_longwave_complement_concentration_scaling_in_lower_atmosphere - units = flag - type = logical - dimensions = (enter_standard_name_107:enter_standard_name_108) - intent = in -[ scale_by_complement_upper ] - standard_name = do_longwave_complement_concentration_scaling_in_upper_atmosphere - units = flag - type = logical - dimensions = (enter_standard_name_109:enter_standard_name_110) - intent = in -[ kminor_start_lower ] - standard_name = longwave_start_index_for_contributor_of_minor_absorbing_gas_in_lower_atmosphere - units = index - type = integer - dimensions = (enter_standard_name_111:enter_standard_name_112) - intent = in -[ kminor_start_upper ] - standard_name = longwave_start_index_for_contributor_of_minor_absorbing_gas_in_upper_atmosphere - units = index - type = integer - dimensions = (enter_standard_name_113:enter_standard_name_114) - intent = in -[ totplnk ] - standard_name = longwave_integrated_spectral_radiance_by_band - units = W sr-1 m-2 Hz-1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_115:enter_standard_name_116,enter_standard_name_117:enter_standard_name_118) - intent = in -[ planck_frac ] - standard_name = longwave_planck_fraction - units = fraction - type = real | kind = kind_phys - dimensions = (enter_standard_name_119:enter_standard_name_120,enter_standard_name_121:enter_standard_name_122,enter_standard_name_123:enter_standard_name_124,enter_standard_name_125:enter_standard_name_126) - intent = in -[ rayl_lower ] - standard_name = rayleigh_absorption_coefficient_for_lower_atmosphere - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_127:enter_standard_name_128,enter_standard_name_129:enter_standard_name_130,enter_standard_name_131:enter_standard_name_132) - intent = in -[ rayl_upper ] - standard_name = rayleigh_absorption_coefficient_for_upper_atmosphere - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_133:enter_standard_name_134,enter_standard_name_135:enter_standard_name_136,enter_standard_name_137:enter_standard_name_138) - intent = in -[ optimal_angle_fit ] - standard_name = coefficients_for_linear_fit_used_in_longwave_optimal_angle_calculation - units = 1 - type = real | kind = kind_phys - dimensions = (enter_standard_name_139:enter_standard_name_140,enter_standard_name_141:enter_standard_name_142) - intent = in -[ errmsg ] - standard_name = ccpp_error_message - long_name = Error message for error handling in CCPP - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - long_name = Error flag for error handling in CCPP - units = 1 - type = integer - dimensions = () - intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml index 9cc0ed8f..933ce455 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml @@ -79,7 +79,7 @@ char*512 rrtmgp_lw_gas_optics rrtmgp_lw_gas_optics - filename_of_rrtmgp_longwave_coefficients_file + filename_of_rrtmgp_longwave_k_distribution none The filename of the longwave coefficients file for RRTMGP diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta new file mode 100644 index 00000000..7a05d9cf --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta @@ -0,0 +1,108 @@ +[ccpp-table-properties] + name = rrtmgp_cloud_optics_setup + type = scheme + +[ccpp-arg-table] + name = rrtmgp_cloud_optics_setup_init + type = scheme +[ liq_filename ] + standard_name = filename_of_rrtmgp_liquid_cloud_optics_coefficients + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ ice_filename ] + standard_name = filename_of_rrtmgp_ice_cloud_optics_coefficients + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ abs_lw_liq_out ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) + allocatable = True + intent = out +[ abs_lw_ice_out ] + standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_longwave_radiation) + allocatable = True + intent = out +[ ext_sw_liq_out ] + standard_name = shortwave_liquid_extinction + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ ext_sw_ice_out ] + standard_name = shortwave_ice_extinction + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ ssa_sw_liq_out ] + standard_name = shortwave_liquid_single_scattering_albedo + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ ssa_sw_ice_out ] + standard_name = shortwave_ice_single_scattering_albedo + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ asm_sw_liq_out ] + standard_name = shortwave_liquid_asymmetry_parameter + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ asm_sw_ice_out ] + standard_name = shortwave_ice_asymmetry_parameter + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + allocatable = True + intent = out +[ g_lambda_out ] + standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid + units = m-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + allocatable = True + intent = out +[ g_mu_out ] + standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid + units = index + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + allocatable = True + intent = out +[ g_d_eff_out ] + standard_name = radiative_effective_diameter_samples_on_ice_optics_grid + units = microns + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) + allocatable = True + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml similarity index 96% rename from schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml rename to schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml index 257d84ab..f593062f 100644 --- a/schemes/rrtmgp/rrtmgp_cloud_optics_namelist.xml +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml @@ -79,7 +79,7 @@ char*256 rrtmgp_cloud_optics radconst - filepath_for_ice_optics_file + filename_of_rrtmgp_liquid_cloud_optics_coefficients none filepath and name for ice optics data for rrtmgp @@ -92,7 +92,7 @@ char*256 rrtmgp_cloud_optics radconst - filepath_for_liquid_optics_file + filename_of_rrtmgp_ice_cloud_optics_coefficients none filepath and name for liquid optics data for rrtmgp diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index c098d95a..690bf292 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -2,25 +2,25 @@ - rrtmgp_constituents - rrtmgp_lw_gas_optics_data - rrtmgp_pre - + rrtmgp_pre + rrtmgp_cloud_optics_setup tropopause_find rrtmgp_inputs rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen + rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics rrtmgp_lw_main rrtmgp_lw_diagnostics + rrtmgp_inputs_setup rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post - + From d38980dda17139c9f25b1fe3615eb8802e9f7192 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 30 May 2025 12:41:07 -0600 Subject: [PATCH 030/140] add missing use statements --- schemes/rrtmgp/rrtmgp_inputs.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 859c133c..5526239e 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -446,6 +446,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_kinds, only: kind_phys ! Set the low and high limits of the wavenumber grid for sw and lw. ! Values come from RRTMGP coefficients datasets, and are stored in the ! kdist objects. @@ -569,6 +570,7 @@ end subroutine set_wavenumber_bands subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & wavenumber_high, ans, errmsg, errflg) + use ccpp_kinds, only: kind_phys ! Find band index for requested wavelength/wavenumber. From 757f70c58018723348a359e409331895662e926e Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 5 Jun 2025 15:27:30 -0600 Subject: [PATCH 031/140] initial round of fixes to get sima to build --- schemes/rrtmgp/rrtmgp_constituents.F90 | 40 +++-- schemes/rrtmgp/rrtmgp_constituents.meta | 81 +++++++++- .../rrtmgp/rrtmgp_constituents_namelist.xml | 13 ++ schemes/rrtmgp/rrtmgp_inputs.F90 | 1 + schemes/rrtmgp/rrtmgp_inputs.meta | 18 +-- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 16 +- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 20 ++- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 25 +-- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 24 ++- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 10 +- schemes/rrtmgp/rrtmgp_lw_main.F90 | 5 +- schemes/rrtmgp/rrtmgp_lw_main.meta | 15 +- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 20 ++- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 32 ++-- schemes/rrtmgp/rrtmgp_pre.F90 | 21 ++- schemes/rrtmgp/rrtmgp_pre.meta | 35 +++-- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 102 ++++++------- schemes/rrtmgp/rrtmgp_subcycle.F90 | 21 +++ schemes/rrtmgp/rrtmgp_subcycle.meta | 25 +++ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 6 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 37 +++++ .../rrtmgp/rrtmgp_sw_gas_optics_namelist.xml | 91 +++++++++++ schemes/rrtmgp/rrtmgp_variables.F90 | 60 ++++++++ schemes/rrtmgp/rrtmgp_variables.meta | 79 ++++++++++ .../utils/rrtmgp_cloud_optics_setup.F90 | 9 +- .../utils/rrtmgp_cloud_optics_setup.meta | 22 ++- .../check_energy_fix_diagnostics.meta | 2 +- .../sima_diagnostics/rrtmgp_diagnostics.meta | 83 ++++++++++ .../rrtmgp_lw_diagnostics.meta | 143 ++++++++++++++++++ schemes/tropopause_find/tropopause_find.meta | 2 +- test/test_suites/suite_rrtmgp.xml | 2 + 32 files changed, 894 insertions(+), 168 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_subcycle.F90 create mode 100644 schemes/rrtmgp/rrtmgp_subcycle.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml create mode 100644 schemes/rrtmgp/rrtmgp_variables.F90 create mode 100644 schemes/rrtmgp/rrtmgp_variables.meta create mode 100644 schemes/sima_diagnostics/rrtmgp_diagnostics.meta create mode 100644 schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 63fe8988..b94ef42a 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -7,10 +7,11 @@ module rrtmgp_constituents !> \section arg_table_rrtmgp_constituents_register Argument Table !! \htmlinclude rrtmgp_constituents_register.html !! - subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode) + subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + integer, intent(in) :: nradgas type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) - character(len=256), intent(in) :: rad_climate(:) + character(len=256), intent(in) :: rad_climate character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -25,7 +26,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode = 0 ! Allocate the dynamic constituents array - allocate(rrtmgp_dyn_consts(size(rad_climate)), stat=ierr, errmsg=alloc_errmsg) + allocate(rrtmgp_dyn_consts(nradgas), stat=ierr, errmsg=alloc_errmsg) if (ierr /= 0) then write(errmsg, *) 'rrtmgp_constituents_register: Unable to allocate rrtmgp_dyn_consts - message: ', alloc_errmsg errcode = 1 @@ -109,20 +110,39 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, end subroutine rrtmgp_constituents_register !> \section arg_table_rrtmgp_constituents_init Argument Table -!! \htmlinclude rrtmgp_constituents_init.html +!! \htmlinclude rrtmgp_constituents_int.html !! - subroutine rrtmgp_constituents_init(gaslist, errmsg, errcode) - character(len=5), intent(out) :: gaslist(:) - integer, intent(out) :: errcode + subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_call_array, & + rrtmgp_phys_blksz, tlev, fluxlwup_Jac, is_first_restart_step, use_tlev, top_at_one, errmsg, errcode) + integer, intent(in) :: ndiag + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: unset_real + integer, intent(out) :: diag_cur + logical, intent(out) :: active_call_array(:) + integer, intent(out) :: rrtmgp_phys_blksz + real(kind_phys), intent(out) :: tlev(:,:) + real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) + logical, intent(out) :: is_first_restart_step + logical, intent(out) :: use_tlev + logical, intent(out) :: top_at_one character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode - errcode = 0 + errcode = 1 errmsg = '' - gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + active_call_array = .true. + is_first_restart_step = .false. + top_at_one = .true. - end subroutine rrtmgp_constituents_init + diag_cur = 1 + rrtmgp_phys_blksz = ncol + ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA + use_tlev = .false. + tlev = unset_real + fluxlwup_Jac = unset_real + end subroutine rrtmgp_constituents_init !> \section arg_table_rrtmgp_constituents_run Argument Table !! \htmlinclude rrtmgp_constituents_run.html !! diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 1c7ca4a3..6c2317b4 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -5,11 +5,17 @@ [ccpp-arg-table] name = rrtmgp_constituents_register type = scheme +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in [ rad_climate ] standard_name = sources_of_radiatively_active_gases_for_climate_calcluation units = none type = character | kind = len=256 - dimensions = (number_of_active_gases_for_RRTMGP) + dimensions = () intent = in [ rrtmgp_dyn_consts ] standard_name = rrtmgp_constituents_dyn_consts @@ -33,11 +39,71 @@ [ccpp-arg-table] name = rrtmgp_constituents_init type = scheme -[ gaslist ] - standard_name = list_of_active_gases_for_RRTMGP - units = none - type = character | kind = len=5 - dimensions = (number_of_active_gases_for_RRTMGP) +[ ndiag ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_dimension + units = count + type = integer + dimensions = () + intent = in +[ unset_real ] + standard_name = definition_of_unset_for_real_variables + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ diag_cur ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = out +[ active_call_array ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = out +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ tlev ] + standard_name = air_temperature_at_interface_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_dimension,vertical_interface_dimension) + intent = out +[ fluxlwup_Jac ] + standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP + units = W m-2 K-1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension,vertical_interface_dimension) + intent = out +[ is_first_restart_step ] + standard_name = is_first_restart_timestep + units = flag + type = logical + dimensions = () + intent = out +[ use_tlev ] + standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation + units = flag + type = logical + dimensions = () + intent = out +[ top_at_one ] + standard_name = do_top_at_one_vertical_ordering_in_radiation + units = flag + type = logical + dimensions = () intent = out [ errmsg ] standard_name = ccpp_error_message @@ -59,7 +125,7 @@ units = none type = character | kind = len=5 dimensions = (number_of_active_gases_for_RRTMGP) - intent = out + intent = in [ const_array ] standard_name = ccpp_constituents units = none @@ -83,3 +149,4 @@ units = 1 type = integer dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml index 7413da82..6c49d153 100644 --- a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -89,4 +89,17 @@ 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'N:ozone:O3', 'A:N2O:N2O', 'A:CH4:CH4', 'N:CFC11STAR:CFC11', 'A:CFC12:CFC12' + + integer + rrtmgp_constituents + rrtmgp_constituents + number_of_diagnostic_subcycles + count + + Number of diagnostic subcycle iterations to perform for radiation. + + + 1 + + diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index a95bd65d..1edc96d1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -6,6 +6,7 @@ module rrtmgp_inputs public :: rrtmgp_inputs_run contains + !> \section arg_table_rrtmgp_inputs_run Argument Table !! \htmlinclude rrtmgp_inputs_run.html !! diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index c04ca119..4d880b0b 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -18,13 +18,13 @@ dimensions = () intent = in [ snow_associated ] - standard_name = include_snow_absorption_optical_depth + standard_name = include_snow_in_radiation_calculation units = flag type = logical dimensions = () intent = in [ graupel_associated ] - standard_name = include_graupel_absorption_optical_depth + standard_name = include_graupel_in_radiation_calculation units = flag type = logical dimensions = () @@ -66,10 +66,10 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ coszrs ] - standard_name = cosine_of_solar_zenith_angle + standard_name = cosine_of_solar_zenith_angle_for_radiation units = rad type = real | kind = kind_phys - dimensions = (vertical_layer_dimension) + dimensions = (horizontal_loop_extent) intent = in [ kdist_sw ] standard_name = shortwave_gas_optics_object_for_RRTMGP @@ -144,7 +144,7 @@ dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) intent = out [ lwup ] - standard_name = longwave_upward_radiative_flux_at_surface + standard_name = longwave_upward_radiative_flux_at_surface_from_coupler units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) @@ -180,13 +180,13 @@ dimensions = () intent = in [ asdir ] - standard_name = albedo_at_surface_due_to_UV_and_VIS_direct + standard_name = surface_albedo_due_to_uv_and_vis_direct_from_coupler units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in [ asdif ] - standard_name = albedo_due_to_UV_and_VIS_diffused_at_surface + standard_name = surface_albedo_due_to_uv_and_vis_diffuse_from_coupler units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent) @@ -204,13 +204,13 @@ dimensions = (number_of_bands_for_shortwave_radiation) intent = in [ aldir ] - standard_name = albedo_due_to_near_IR_direct_at_surface + standard_name = surface_albedo_due_to_near_ir_direct_from_coupler units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in [ aldif ] - standard_name = albedo_due_to_near_IR_diffused_at_surface + standard_name = surface_albedo_due_to_near_ir_diffuse_from_coupler units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index a0876598..982a1981 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -13,8 +13,8 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & - nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, changeseed, & + nlayp, nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp @@ -44,7 +44,8 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay - ! or is 1 less than nlay if "extra layer" is used in the radiation calculations + ! or is 1 less than nlay if "extra layer" is used in the + ! radiation calculations integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) ! Indices to specific bands for diagnostic output and COSP input @@ -57,6 +58,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw integer, intent(out) :: nswgpts ! Number of shortwave g-points integer, intent(out) :: nlwgpts ! Number of longwave g-points + integer, intent(out) :: changeseed ! Random number seed for mcica longwave integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands @@ -65,7 +67,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously - real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle + real(kind_phys), intent(out) :: dt_avg ! averaging time interval for zenith angle ! Local variables real(kind_phys), target :: wavenumber_low_shortwave(nswbands) @@ -139,6 +141,8 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw ! the adjusted iradsw value from radiation if (use_rad_dt_cosz) then dt_avg = iradsw*timestep_size + else + dt_avg = 0._kind_phys end if ! "irad_always" is number of time steps to execute radiation continuously from @@ -152,6 +156,8 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw nextsw_cday = current_cal_day end if + changeseed = nlwgpts + end subroutine rrtmgp_inputs_setup_init !========================================================================================= @@ -162,6 +168,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_kinds, only: kind_phys ! Set the low and high limits of the wavenumber grid for sw and lw. ! Values come from RRTMGP coefficients datasets, and are stored in the ! kdist objects. @@ -285,6 +292,7 @@ end subroutine set_wavenumber_bands subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & wavenumber_high, ans, errmsg, errflg) + use ccpp_kinds, only: kind_phys ! Find band index for requested wavelength/wavenumber. diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index 08cb1a05..195f2317 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -78,10 +78,10 @@ dimensions = () intent = in [ qrl ] - standard_name = longwave_radiative_heating_rate - units = K s-1 + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness + units = J Pa kg-1 s-1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_dimension, vertical_layer_dimension) intent = out [ is_first_step ] standard_name = is_first_timestep @@ -118,7 +118,7 @@ units = s type = real | kind = kind_phys dimensions = () - intent = inout + intent = out [ irad_always ] standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization units = count @@ -215,6 +215,12 @@ type = integer dimensions = () intent = out +[ changeseed ] + standard_name = random_number_seed_for_mcica_longwave + units = 1 + type = integer + dimensions = () + intent = out [ nlayp ] standard_name = number_of_vertical_layers_in_RRTMGP_plus_one units = count @@ -228,8 +234,8 @@ dimensions = () intent = out [ current_cal_day ] - standard_name = current_calendar_day - units = days + standard_name = fractional_calendar_days_on_end_of_current_timestep + units = 1 type = real | kind = kind_phys dimensions = () intent = in @@ -237,7 +243,7 @@ standard_name = shortwave_start_and_end_gpoint_for_each_band units = index type = integer - dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) + dimensions = (2,number_of_bands_for_shortwave_radiation) intent = out [ errmsg ] standard_name = ccpp_error_message diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 373c628a..149dcced 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -24,8 +24,8 @@ module rrtmgp_lw_cloud_optics subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, abs_lw_liq, abs_lw_ice, & g_mu, g_lambda, g_d_eff, tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & - do_snow, do_graupel, pver, ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, & - errmsg, errflg) + do_snow, do_graupel, pver, ktopcam, cld_lw_abs, snow_lw_abs, grau_lw_abs, & + c_cld_lw_abs, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp ! Compute combined cloud optical properties @@ -65,11 +65,12 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Outputs type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_lw ! Longwave cloud optics object - real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction + !real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction real(kind_phys), dimension(:,:,:), intent(out) :: cld_lw_abs ! Cloud absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) - real(kind_phys), dimension(:,:,:), intent(out) :: tauc ! Cloud optical depth +! real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: tauc ! Cloud optical depth + real(kind_phys), dimension(:,:,:), intent(out) :: c_cld_lw_abs character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -79,7 +80,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! cloud radiative parameters are "in cloud" not "in cell" real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) real(kind_phys) :: ice_lw_abs(nlwbands, ncol, pver) ! ice absorption optics depth (LW) - real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) + !real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_run' !-------------------------------------------------------------------------------- @@ -154,11 +155,17 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Subset "chunk" data so just the number of CAM layers in the ! radiation calculation are used by MCICA to produce subcolumns - cldf = cldfprime(:, ktopcam:) - tauc = c_cld_lw_abs(:, :, ktopcam:) +! cldf = cldfprime(:, ktopcam:) - ! Enforce tauc >= 0. - tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) + ! Allocate tauc variable +! if (allocated(tauc)) then +! deallocate(tauc) +! end if +! allocate(tauc(nlwbands,ncol,nlaycam), stat=errflg) +! tauc = c_cld_lw_abs(:, :, ktopcam:) + +! ! Enforce tauc >= 0. +! tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) errmsg =cloud_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) if (len_trim(errmsg) > 0) then diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index daef250c..57016fa9 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -138,7 +138,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ des ] - standard_name = effective_diameter_of_stratiform_snow_particle + standard_name = effective_diameter_of_stratiform_snow_particle_for_radiation units = micron type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -162,13 +162,13 @@ dimensions = () intent = in [ do_snow ] - standard_name = include_snow_absorption_optical_depth + standard_name = include_snow_in_radiation_calculation units = flag type = logical dimensions = () intent = in [ do_graupel ] - standard_name = include_graupel_absorption_optical_depth + standard_name = include_graupel_in_radiation_calculation units = flag type = logical dimensions = () @@ -185,18 +185,6 @@ type = integer dimensions = () intent = in -[ tauc ] - standard_name = cloud_optical_depth - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) - intent = out -[ cldf ] - standard_name = cloud_area_fraction_on_RRTMGP_layers - units = fraction - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) - intent = out [ cld_lw_abs ] standard_name = in_cloud_longwave_liquid_plus_ice_optical_depth units = 1 @@ -215,6 +203,12 @@ type = real | kind = kind_phys dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) intent = out +[ c_cld_lw_abs ] + standard_name = combined_longwave_cloud_absorption_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out [ errmsg ] standard_name = ccpp_error_message long_name = Error message for error handling in CCPP diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index b58df0d0..a09ce4d3 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -29,7 +29,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object character(len=512), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errcode ! CCPP error code diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 6ba22407..42491423 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -10,7 +10,7 @@ units = none type = ty_gas_optics_rrtmgp_ccpp dimensions = () - intent = inout + intent = out [ lw_filename ] standard_name = filename_of_rrtmgp_longwave_k_distribution units = none @@ -47,7 +47,7 @@ intent = in [ iter_num ] standard_name = iteration_number_for_radiation_subcycle - units = 1 + units = count type = integer dimensions = () intent = in @@ -73,7 +73,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (ihorizontal_loop_extent,vertical_interface_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ t_lay ] standard_name = air_temperature_for_RRTMGP @@ -106,10 +106,10 @@ dimensions = () intent = inout [ t_lev ] - standard_name = air_temperature_at_interfaces_for_RRTMGP + standard_name = air_temperature_at_interface_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ include_interface_temp ] standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index 60e33823..6f1cfc64 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -15,7 +15,7 @@ module rrtmgp_lw_main subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & - aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + aerlw, fluxlwUP_jac, nlwgpts, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) use machine, only: kind_phys use mo_rte_lw, only: rte_lw use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -38,6 +38,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, integer, intent(in) :: nCol !< Number of horizontal points integer, intent(in) :: iter_num !< Radiation subcycle iteration number integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + integer, intent(in) :: nlwgpts real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object @@ -52,7 +53,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object - real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + real(kind_phys), dimension(:,:), allocatable, target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point character(len=512), intent(out) :: errmsg !< CCPP error message integer, intent(out) :: errflg !< CCPP error flag diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta index a2e42e38..a0a6384a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.meta +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -49,7 +49,7 @@ intent = in [ iter_num ] standard_name = iteration_number_for_radiation_subcycle - units = 1 + units = count type = integer dimensions = () intent = in @@ -87,7 +87,7 @@ standard_name = longwave_emissivity_at_surface units = fraction type = real | kind = kind_phys - dimensions = (enter_standard_name_23:enter_standard_name_24,horizontal_loop_extent) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) intent = in [ lw_gas_props ] standard_name = longwave_gas_optics_object_for_RRTMGP @@ -105,13 +105,20 @@ standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP units = W m-2 K-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_27:enter_standard_name_28,enter_standard_name_29:enter_standard_name_30) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = inout +[ nlwgpts ] + standard_name = number_of_longwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = in [ lw_Ds ] standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point units = 1 type = real | kind = kind_phys - dimensions = (enter_standard_name_31:enter_standard_name_32,enter_standard_name_33:enter_standard_name_34) + dimensions = (horizontal_loop_extent,number_of_longwave_g_point_intervals) + allocatable = True intent = out [ flux_clrsky ] standard_name = longwave_clear_sky_flux_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 2c62d814..ec735ea1 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -42,8 +42,8 @@ module rrtmgp_lw_mcica_subcol_gen !> \section arg_table_rrtmgp_lw_mcica_subcol_gen_run Argument Table !! \htmlinclude rrtmgp_lw_mcica_subcol_gen_run.html subroutine rrtmgp_lw_mcica_subcol_gen_run( & - dolw, ktoprad, kdist, nbnd, ngpt, ncol, pver, nver, & - changeseed, pmid, cldfrac, tauc, cloud_lw, & + dolw, ktoprad, ktopcam, kdist, nbnd, ngpt, ncol, pver, nver, & + cldfprime, c_cld_lw_abs, changeseed, pmid, cloud_lw, & errmsg, errflg ) use ccpp_kinds, only: kind_phys use shr_RandNum_mod, only: ShrKissRandGen @@ -62,6 +62,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam integer, intent(in) :: nbnd ! Number of spectral bands integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) integer, intent(in) :: ncol ! Number of columns @@ -70,8 +71,8 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & integer, intent(in) :: changeseed ! If the subcolumn generator is called multiple times, ! permute the seed between each call. real(kind_phys), dimension(:,:), intent(in) :: pmid ! Layer pressures at midpoints (Pa) - real(kind_phys), dimension(:,:), intent(in) :: cldfrac ! Layer cloud fraction - real(kind_phys), dimension(:,:,:), intent(in) :: tauc ! Cloud optical depth + real(kind_phys), dimension(:,:), intent(in) :: cldfprime + real(kind_phys), dimension(:,:,:), intent(in) :: c_cld_lw_abs type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -88,8 +89,10 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) + real(kind_phys) :: cldf(ncol,nver) real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + real(kind_phys) :: tauc(nlwbands,ncol,nver) real(kind_phys) :: taucmcl(ngpt,ncol,nver) !------------------------------------------------------------------------------------------ @@ -102,6 +105,15 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & return end if + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns + cldf = cldfprime(:, ktopcam:) + + tauc = c_cld_lw_abs(:, :, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) + ! clip cloud fraction cldf(:,:) = cldfrac(:,:) where (cldf(:,:) < cldmin) diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 6243e22e..8eb0629e 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -17,6 +17,12 @@ type = integer dimensions = () intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in [ kdist ] standard_name = longwave_gas_optics_object_for_RRTMGP units = none @@ -24,7 +30,7 @@ dimensions = () intent = in [ nbnd ] - standard_name = number_of_spectral_bands + standard_name = number_of_bands_for_longwave_radiation units = count type = integer dimensions = () @@ -53,6 +59,18 @@ type = integer dimensions = () intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ c_cld_lw_abs ] + standard_name = combined_longwave_cloud_absorption_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = in [ changeseed ] standard_name = random_number_seed_for_mcica_longwave units = 1 @@ -65,18 +83,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in -[ cldfrac ] - standard_name = cloud_area_fraction_on_RRTMGP_layers - units = fraction - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) - intent = in -[ tauc ] - standard_name = cloud_optical_depth - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels) - intent = in [ cloud_lw ] standard_name = longwave_cloud_optical_properties_object_for_RRTMGP units = none diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 35d7ef92..b77dcb73 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -13,13 +13,13 @@ module rrtmgp_pre !> \section arg_table_rrtmgp_pre_init Argument Table !! \htmlinclude rrtmgp_pre_init.html !! - subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg, errflg) + subroutine rrtmgp_pre_init(nradgas, available_gases, gaslist, gaslist_lc, errmsg, errflg) use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use atmos_phys_string_utils, only: to_lower integer, intent(in) :: nradgas ! Number of radiatively active gases - character(len=*), intent(in) :: gaslist(:) ! List of radiatively active gases - type(ty_gas_concs_ccpp), intent(inout) :: available_gases ! Gas concentrations object - character(len=*), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list + type(ty_gas_concs_ccpp), intent(out) :: available_gases ! Gas concentrations object + character(len=5), intent(out) :: gaslist(:) ! Radiatively active gas list + character(len=5), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -30,6 +30,9 @@ subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg errmsg = '' errflg = 0 + ! Initialize gas list + gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. @@ -78,8 +81,9 @@ end subroutine rrtmgp_pre_timestep_init !! \htmlinclude rrtmgp_pre_run.html !! subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & - next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & - nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) + next_cday, idxday, nday, idxnite, nnite, dosw, dolw, dosw_heat, dolw_heat, & + nlay, nlwbands, nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, & + errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -108,6 +112,8 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns logical, intent(out) :: dosw ! Flag to do shortwave calculation logical, intent(out) :: dolw ! Flag to do longwave calculation + logical, intent(out) :: dosw_heat ! Flag to calculate net shortwave heating + logical, intent(out) :: dolw_heat ! Flag to calculate net longwave heating character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -141,6 +147,9 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco return end if + dosw_heat = (.not. dosw) + dolw_heat = (.not. dolw) + ! determine if next radiation time-step not equal to next time-step if (nstep >= 1) then if (next_cday /= nextsw_cday) nextsw_cday = -1._kind_phys diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 0ed2d0fa..5566aa4f 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_pre type = scheme + dependencies = ./objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_pre_init @@ -11,22 +12,22 @@ type = integer dimensions = () intent = in -[ gaslist ] - standard_name = list_of_active_gases_for_RRTMGP - units = count - type = character | kind = len=* - dimensions = (number_of_active_gases_for_RRTMGP) - intent = in [ available_gases ] standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP units = none type = ty_gas_concs_ccpp dimensions = () - intent = inout + intent = out +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=5 + dimensions = (number_of_active_gases_for_rrtmgp) + intent = out [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=* + type = character | kind = len=5 dimensions = (number_of_active_gases_for_RRTMGP) intent = out [ errmsg ] @@ -97,7 +98,7 @@ name = rrtmgp_pre_run type = scheme [ coszrs ] - standard_name = cosine_of_solar_zenith_angle + standard_name = cosine_of_solar_zenith_angle_for_radiation units = rad type = real | kind = kind_phys dimensions = (horizontal_loop_extent) @@ -139,8 +140,8 @@ dimensions = () intent = in [ next_cday ] - standard_name = calendar_day_of_next_timestep - units = days + standard_name = fractional_calendar_days_on_end_of_next_timestep + units = 1 type = real | kind = kind_phys dimensions = () intent = in @@ -180,6 +181,18 @@ type = logical dimensions = () intent = out +[ dosw_heat ] + standard_name = calculate_net_shortwave_heating + units = flag + type = logical + dimensions = () + intent = out +[ dolw_heat ] + standard_name = calculate_net_longwave_heating + units = flag + type = logical + dimensions = () + intent = out [ nlay ] standard_name = number_of_vertical_layers_in_RRTMGP units = count diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 0af06002..d24d63ef 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -75,120 +75,116 @@ units This is the CCPP unit specification of the variable (e.g., m s-1). --> - - char*512 + + logical rrtmgp rrtmgp - filename_of_rrtmgp_longwave_coefficients_file - none + use_adjusted_radiation_timestep_for_solar_zenith_angle_calculation + flag - The filename of the longwave coefficients file for RRTMGP + If true, use the radiation timestep size for the solar zenith angle calculation - src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-lw-g128.nc + .false. - - integer + + logical rrtmgp rrtmgp - frequency_of_shortwave_radiation_calculation - none + do_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + flag - The frequency at which shortwave calculation is performed. - positive: time steps; negative: hours + If true, use compute the clear sky tendency of air temperature for LW heating. - -1 + .true. - - integer + + logical rrtmgp rrtmgp - frequency_of_longwave_radiation_calculation - none + include_longwave_scattering_in_cloud_optics + flag - The frequency at which longwave calculation is performed. - positive: time steps; negative: hours + If true, include longwave scattering in cloud optics - -1 + .false. - - integer + + logical rrtmgp rrtmgp - continuous_time_for_radiation_calculation_after_startup - none + calculate_longwave_jacobian_for_RRTMGP + flag - The amount of time that radiation (both SW and LW) is run continuously from the start of an initial or restart run - positive: time steps; negative: hours + If true, calculate the jacobian for RRTMGP longwave - -1 + .false. - + logical rrtmgp rrtmgp - use_radiation_timestep_size_for_solar_zenith_angle_calculation + compute_optimal_angles_for_use_in_RRTMGP_longwave_calculation flag - If true, use the radiation timestep size for the solar zenith angle calculation + If true, use compute and use optimal angles for RRTMGP longwave .false. - - logical + + integer rrtmgp rrtmgp - do_calculate_up_and_down_fluxes_per_band - flag + number_of_gaussian_quadrature_angles_for_radiation + count - If true, calculate the up and down fluxes per band; used by CARMA + The number of Gaussian quadrature angles for use in radiation - if less than zero, unused - .false. + -1 - + logical rrtmgp rrtmgp - use_radiation_uniform_angle_in_solar_zenith_angle_calculation + write_rrtmgp_diagnostics flag - If true, use the namelist-defined radiation uniform angle in the solar zenith angle calculation + If true, write out the RRTMGP diagnostics - .false. + .true. - - real - kind_phys + + logical rrtmgp rrtmgp - radiation_uniform_angle_for_solar_zenith_angle_calculation - radians + do_up_down_flux_per_band_diagnostic + flag - The radiation timestep size for the solar zenith angle calculation + If true, calculate the up and down fluxes per band; used by CARMA - -99 + .false. - flag + logical rrtmgp rrtmgp - use_grapel_cloud_fraction_in_radiation_calculation - radians + do_calculate_radiative_effect_of_graupel + flag Flag to use graupel cloud fraction in radiation @@ -197,7 +193,7 @@ - count + integer rrtmgp rrtmgp number_of_bands_for_shortwave_radiation @@ -210,7 +206,7 @@ - count + integer rrtmgp rrtmgp number_of_bands_for_longwave_radiation @@ -229,7 +225,7 @@ number_of_active_gases_for_RRTMGP count - Dimension of the list of radiatively active gases. + Number of radiatively active gases for RRTMGP 8 diff --git a/schemes/rrtmgp/rrtmgp_subcycle.F90 b/schemes/rrtmgp/rrtmgp_subcycle.F90 new file mode 100644 index 00000000..d5af0d79 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_subcycle.F90 @@ -0,0 +1,21 @@ +!> This module contains the control (timestep init and timestep final) +!! for the subcycle iteration +module rrtmgp_subcycle + implicit none + private + + public rrtmgp_subcycle_run +contains + +!> \section arg_table_rrtmgp_subcycle_run Argument Table +!! \htmlinclude rrtmgp_subcycle_run.html +!! + subroutine rrtmgp_subcycle_run(diag_cur, errmsg, errcode) + integer, intent(inout) :: diag_cur + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + diag_cur = diag_cur + 1 + + end subroutine rrtmgp_subcycle_run +end module rrtmgp_subcycle diff --git a/schemes/rrtmgp/rrtmgp_subcycle.meta b/schemes/rrtmgp/rrtmgp_subcycle.meta new file mode 100644 index 00000000..d107e934 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_subcycle.meta @@ -0,0 +1,25 @@ +[ccpp-table-properties] + name = rrtmgp_subcycle + type = scheme + +[ccpp-arg-table] + name = rrtmgp_subcycle_run + type = scheme +[ diag_cur ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index d525915f..4c28d10c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -28,9 +28,9 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object + character(len=512), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errcode ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), allocatable :: pio_reader diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta new file mode 100644 index 00000000..efe4cdc9 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -0,0 +1,37 @@ +[ccpp-table-properties] + name = rrtmgp_sw_gas_optics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_init + type = scheme +[ kdist ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = out +[ sw_filename ] + standard_name = filename_of_rrtmgp_shortwave_k_distribution + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml new file mode 100644 index 00000000..1df56e6e --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml @@ -0,0 +1,91 @@ + + + + + + + + + char*512 + rrtmgp_sw_gas_optics + rrtmgp_sw_gas_optics + filename_of_rrtmgp_shortwave_k_distribution + none + + The filename of the shortwave coefficients file for RRTMGP + + + src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-sw-g128.nc + + + diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 new file mode 100644 index 00000000..dba6babf --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -0,0 +1,60 @@ +module rrtmgp_variables + + implicit none + private + + public :: rrtmgp_variables_run + +CONTAINS + +!> \section arg_table_rrtmgp_variables_run Argument Table +!! \htmlinclude rrtmgp_variables_run.html +!! + subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & + do_grau, grau_associated, tiny_rad, errmsg, errflg) + use ccpp_kinds, only: kind_phys + ! Inputs + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau + real(kind_phys), dimension(:,:), intent(in) :: degrau + real(kind_phys), dimension(:,:), intent(in) :: icgrauwp + real(kind_phys), intent(in) :: unset_real + logical, intent(in) :: graupel_in_rad + + ! Outputs + logical, intent(out) :: do_snow + logical, intent(out) :: do_grau + logical, intent(out) :: grau_associated + real(kind_phys), intent(out) :: tiny_rad + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Set definition of tiny for radiation + tiny_rad = 1.e-80_kind_phys + + ! Initialize flags + do_snow = .false. + do_grau = .false. + grau_associated = .false. + + ! Determine if the snow cloud fraction variable is set to something + if (cldfsnow /= unset_real) then + do_snow = .true. + end if + + ! Determine if the graupel cloud fraction variable is set to something + if (cldfgrau /= unset_real) then + grau_associated = .true. + end if + + ! Determine if we should include graupel in the radiation calculation + if (graupel_in_rad .and. ((cldfgrau /= unset_real) .and. (degrau /= unset_real) .and. (icgrauwp /= unset_real)) then + do_graup = .true. + end if + + + end subroutine rrtmgp_variables_run diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta new file mode 100644 index 00000000..6008aec2 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -0,0 +1,79 @@ +[ccpp-table-properties] + name = rrtmgp_variables + type = scheme + +[ccpp-arg-table] + name = rrtmgp_variables_run + type = scheme +[ cldfsnow ] + standard_name = liquid_plus_snow_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ cldfgrau ] + standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ degrau ] + standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ icgrauwp ] + standard_name = stratiform_in_cloud_graupel_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ unset_real ] + standard_name = definition_of_unset_for_real_variables + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ graupel_in_rad ] + standard_name = do_calculate_radiative_effect_of_graupel + units = flag + type = logical + dimensions = () + intent = in +[ do_snow ] + standard_name = include_snow_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = out +[ do_grau ] + standard_name = include_graupel_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = out +[ grau_associated ] + standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction + units = flag + type = logical + dimensions = () + intent = out +[ tiny_rad ] + standard_name = definition_of_tiny_for_rrtmgp + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index 865ce94e..9c46e0fd 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -21,7 +21,7 @@ module rrtmgp_cloud_optics_setup !! ! subroutine rrtmgp_cloud_optics_setup_init(liq_filename, abs_lw_liq_out, & ! ext_sw_liq_out, ssa_sw_liq_out, asm_sw_liq_out, g_lambda_out, g_mu_out, errmsg, errflg) - subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq_out, abs_lw_ice_out, & + subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, nmu, nlambda, n_g_d, abs_lw_liq_out, abs_lw_ice_out, & ext_sw_liq_out, ext_sw_ice_out, ssa_sw_liq_out, ssa_sw_ice_out, asm_sw_liq_out, & asm_sw_ice_out, g_lambda_out, g_mu_out, g_d_eff_out, errmsg, errflg) use ccpp_kinds, only: kind_phys @@ -30,6 +30,9 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq character(len=*), intent(in) :: liq_filename ! Full file path for liquid optics file character(len=*), intent(in) :: ice_filename ! Full file path for ice optics file ! Outputs + integer, intent(out) :: nmu + integer, intent(out) :: nlambda + integer, intent(out) :: n_g_d real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq_out ! Longwave mass specific absorption for in-cloud liquid water path real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq_out real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq_out @@ -200,6 +203,10 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq return end if + nmu = size(abs_lw_liq_out,1) + nlambda = size(abs_lw_liq_out,2) + n_g_d = size(abs_lw_ice_out,1) + ext_sw_liq_out = ext_sw_liq ext_sw_ice_out = ext_sw_ice ssa_sw_liq_out = ssa_sw_liq diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta index 7a05d9cf..9615c5bb 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta @@ -17,11 +17,29 @@ type = character | kind = len=* dimensions = () intent = in +[ nmu ] + standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = out +[ nlambda ] + standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = out +[ n_g_d ] + standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid + units = count + type = integer + dimensions = () + intent = out [ abs_lw_liq_out ] standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path units = m2 kg-1 type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) allocatable = True intent = out [ abs_lw_ice_out ] @@ -82,7 +100,7 @@ intent = out [ g_mu_out ] standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid - units = index + units = 1 type = real | kind = kind_phys dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) allocatable = True diff --git a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta index c5811a27..1288ee9b 100644 --- a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta +++ b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta @@ -25,7 +25,7 @@ standard_name = vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep units = J m-2 type = real | kind = kind_phys - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) intent = in [ te_cur_dyn ] standard_name = vertically_integrated_total_energy_using_dycore_energy_formula diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_diagnostics.meta new file mode 100644 index 00000000..2c84b068 --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.meta @@ -0,0 +1,83 @@ +[ccpp-table-properties] + name = rrtmgp_diagnostics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_diagnostics_run + type = scheme +[ write_output ] + standard_name = write_RRTMGP_diagnostics + units = flag + type = logical + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ cappa ] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ cpair ] + standard_name = specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ qrs ] + standard_name = shortwave_diagnostic_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ qrl ] + standard_name = longwave_diagnostic_radiative_heating_rate + units = K s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta new file mode 100644 index 00000000..08a4e56c --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta @@ -0,0 +1,143 @@ +[ccpp-table-properties] + name = rrtmgp_lw_diagnostics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_diagnostics_init + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_lw_diagnostics_run + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ icall ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ flw ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = in +[ flwc ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = in +[ rpdel ] + standard_name = reciprocal_of_air_pressure_thickness + units = Pa-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ pint ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ p_trop ] + standard_name = tropopause_air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ write_output ] + standard_name = write_RRTMGP_diagnostics + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/tropopause_find/tropopause_find.meta b/schemes/tropopause_find/tropopause_find.meta index bc0978e1..a34f9df0 100644 --- a/schemes/tropopause_find/tropopause_find.meta +++ b/schemes/tropopause_find/tropopause_find.meta @@ -115,7 +115,7 @@ standard_name = tropopause_air_pressure_from_tropopause_climatology_dataset units = Pa type = real | kind = kind_phys - dimensions = (horizontal_dimension, number_of_time_slices_in_tropopause_climatology_dataset) + dimensions = (horizontal_loop_extent, number_of_time_slices_in_tropopause_climatology_dataset) intent = in [ tropp_days ] standard_name = tropopause_calendar_days_from_tropopause_climatology diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 690bf292..71ee3d5b 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -5,9 +5,11 @@ rrtmgp_pre rrtmgp_cloud_optics_setup tropopause_find + rrtmgp_variables rrtmgp_inputs rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen + rrtmgp_sw_gas_optics rrtmgp_constituents From 9ac4b56108619dab5b673a79a39ea846f5c543f1 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 5 Jun 2025 22:26:40 -0600 Subject: [PATCH 032/140] framework successfully generates caps --- schemes/rrtmgp/rrtmgp_constituents.F90 | 11 +- schemes/rrtmgp/rrtmgp_constituents.meta | 18 ++ schemes/rrtmgp/rrtmgp_inputs.F90 | 197 ------------------ schemes/rrtmgp/rrtmgp_inputs_setup.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 73 +++++++ .../rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 91 ++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 25 +-- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 20 +- schemes/rrtmgp/rrtmgp_post.meta | 2 +- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 13 ++ schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 62 ++++++ schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 49 +++++ test/test_suites/suite_rrtmgp.xml | 2 + 13 files changed, 344 insertions(+), 221 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index b94ef42a..1af4aa19 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -113,7 +113,8 @@ end subroutine rrtmgp_constituents_register !! \htmlinclude rrtmgp_constituents_int.html !! subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_call_array, & - rrtmgp_phys_blksz, tlev, fluxlwup_Jac, is_first_restart_step, use_tlev, top_at_one, errmsg, errcode) + rrtmgp_phys_blksz, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & + use_tlev, top_at_one, errmsg, errcode) integer, intent(in) :: ndiag integer, intent(in) :: ncol real(kind_phys), intent(in) :: unset_real @@ -122,6 +123,9 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_ca integer, intent(out) :: rrtmgp_phys_blksz real(kind_phys), intent(out) :: tlev(:,:) real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) + real(kind_phys), intent(out) :: rad_heat(:,:) + real(kind_phys), intent(out) :: fsnt(:) + real(kind_phys), intent(out) :: fsns(:) logical, intent(out) :: is_first_restart_step logical, intent(out) :: use_tlev logical, intent(out) :: top_at_one @@ -141,6 +145,11 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_ca use_tlev = .false. tlev = unset_real fluxlwup_Jac = unset_real + rad_heat = unset_real + + ! PEVERWHEE - remove when shortwave is done + fsnt = 0.0_kind_phys + fsns = 0.0_kind_phys end subroutine rrtmgp_constituents_init !> \section arg_table_rrtmgp_constituents_run Argument Table diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 6c2317b4..0bd0813d 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -87,6 +87,24 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension,vertical_interface_dimension) intent = out +[ rad_heat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = K s-1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension,vertical_interface_dimension) + intent = out +[ fsnt ] + standard_name = shortwave_net_column_absorbed_solar_flux_at_model_top + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ fsns ] + standard_name = shortwave_net_absorbed_solar_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out [ is_first_restart_step ] standard_name = is_first_restart_timestep units = flag diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index b527b4b3..1edc96d1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -290,201 +290,4 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & end subroutine rrtmgp_inputs_run -!========================================================================================= -! HELPER FUNCTIONS ! -!========================================================================================= - subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & - idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & - wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & - wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_kinds, only: kind_phys - ! Set the low and high limits of the wavenumber grid for sw and lw. - ! Values come from RRTMGP coefficients datasets, and are stored in the - ! kdist objects. - ! - ! Set band indices for bands containing specific wavelengths. - - ! Arguments - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw - type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw - integer, intent(in) :: nswbands - integer, intent(in) :: nlwbands - - integer, intent(out) :: idx_sw_diag - integer, intent(out) :: idx_nir_diag - integer, intent(out) :: idx_uv_diag - integer, intent(out) :: idx_sw_cloudsim - integer, intent(out) :: idx_lw_diag - integer, intent(out) :: idx_lw_cloudsim - integer, intent(out) :: nswgpts - integer, intent(out) :: nlwgpts - integer, dimension(:,:), intent(out) :: band2gpt_sw - real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave - real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: istat - real(kind_phys), allocatable :: values(:,:) - character(len=256) :: alloc_errmsg - - character(len=*), parameter :: sub = 'set_wavenumber_bands' - !---------------------------------------------------------------------------- - - ! Initialize error variables - errflg = 0 - errmsg = '' - ! Check that number of sw/lw bands in gas optics files matches the parameters. - if (kdist_sw%gas_props%get_nband() /= nswbands) then - write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & - ", doesn't match parameter nswbands= ", nswbands - errflg = 1 - return - end if - if (kdist_lw%gas_props%get_nband() /= nlwbands) then - write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & - ", doesn't match parameter nlwbands= ", nlwbands - errflg = 1 - return - end if - - nswgpts = kdist_sw%gas_props%get_ngpt() - nlwgpts = kdist_lw%gas_props%get_ngpt() - - ! SW band bounds in cm^-1 - allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) - if (istat/=0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg - errflg = 1 - return - end if - values = kdist_sw%gas_props%get_band_lims_wavenumber() - wavenumber_low_shortwave = values(1,:) - wavenumber_high_shortwave = values(2,:) - - ! First and last g-point for each SW band: - band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() - - ! Indices into specific bands - call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & - wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) - if (errflg /= 0) then - return - end if - - deallocate(values) - - ! LW band bounds in cm^-1 - allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) - if (istat/=0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg - errflg = 1 - return - end if - values = kdist_lw%gas_props%get_band_lims_wavenumber() - wavenumber_low_longwave = values(1,:) - wavenumber_high_longwave = values(2,:) - - ! Indices into specific bands - call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & - wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) - if (errflg /= 0) then - return - end if - call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & - wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) - if (errflg /= 0) then - return - end if - - end subroutine set_wavenumber_bands - -!========================================================================================= - - subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & - wavenumber_high, ans, errmsg, errflg) - use ccpp_kinds, only: kind_phys - - ! Find band index for requested wavelength/wavenumber. - - character(len=*), intent(in) :: swlw ! sw or lw bands - real(kind_phys), intent(in) :: targetvalue - character(len=*), intent(in) :: units ! units of targetvalue - integer, intent(in) :: nbnds - real(kind_phys), dimension(:), intent(in) :: wavenumber_low - real(kind_phys), dimension(:), intent(in) :: wavenumber_high - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - integer, intent(out) :: ans - - ! local - real(kind_phys) :: tgt - integer :: idx - - character(len=*), parameter :: sub = 'get_band_index_by_value' - !---------------------------------------------------------------------------- - - ! Initialize error variables - errflg = 0 - errmsg = '' - if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then - write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw - errflg = 1 - return - end if - - ! band info is in cm^-1 but target value may be other units, - ! so convert targetvalue to cm^-1 - select case (units) - case ('inv_cm','cm^-1','cm-1') - tgt = targetvalue - case('m','meter','meters') - tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) - case('nm','nanometer','nanometers') - tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) - case('um','micrometer','micrometers','micron','microns') - tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) - case('cm','centimeter','centimeters') - tgt = 1._kind_phys/targetvalue - case default - write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: units not recognized: ', units - errflg = 1 - end select - - ! now just loop through the array - ans = 0 - do idx = 1,nbnds - if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then - ans = idx - exit - end if - end do - - if (ans == 0) then - write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) - errflg = 1 - end if - - end subroutine get_band_index_by_value - ->>>>>>> origin/rrtmgp-lw end module rrtmgp_inputs diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index 195f2317..176cf069 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -243,7 +243,7 @@ standard_name = shortwave_start_and_end_gpoint_for_each_band units = index type = integer - dimensions = (2,number_of_bands_for_shortwave_radiation) + dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) intent = out [ errmsg ] standard_name = ccpp_error_message diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 new file mode 100644 index 00000000..7319ded0 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -0,0 +1,73 @@ +module rrtmgp_lw_calculate_fluxes + + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rrtmgp_lw_calculate_fluxes_run ! main routine + + character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +CONTAINS + + !> \section arg_table_rrtmgp_lw_calculate_fluxes_run Argument Table + !! \htmlinclude rrtmgp_lw_calculate_fluxes_run.html + subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, pverp, nlay, ktopcam, ktoprad, & + active_calls, flw, flwc, flns, flnt, flwds, errmsg, errflg) + + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles + integer, intent(in) :: icall ! Current diagnostic subcycle + integer, intent(in) :: pverp ! Number of vertical layer interfaces + integer, intent(in) :: nlay + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object + type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object + ! Output variables + real(kind_phys), intent(out) :: flns(:) + real(kind_phys), intent(out) :: flnt(:) + real(kind_phys), intent(out) :: flwds(:) + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: diag_index, idx + real(kind_phys) :: fnl(ncol, pverp) + real(kind_phys) :: fcnl(ncol, pverp) + + errmsg = '' + errflg = 0 + + diag_index = num_diag_subcycles - icall + + ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output + if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + return + end if + + fnl = 0.0_kind_phys + fcnl = 0.0_kind_phys + + ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! + fnl( :,ktopcam:) = -1._kind_phys * flw%fluxes%flux_net( :, ktoprad:) + fcnl(:,ktopcam:) = -1._kind_phys * flwc%fluxes%flux_net( :, ktoprad:) + + flns(:ncol) = fnl(:ncol, pverp) + flnt(:ncol) = fnl(:ncol, ktopcam) + cam_out%flwds(:ncol) = flw%fluxes%flux_dn(:, nlay+1) + + end subroutine rrtmgp_lw_calculate_fluxes_run + +end module rrtmgp_lw_calculate_fluxes diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta new file mode 100644 index 00000000..2175b2f6 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -0,0 +1,91 @@ +[ccpp-table-properties] + name = rrtmgp_lw_calculate_fluxes + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_calculate_fluxes_run + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ icall ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ flw ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = in +[ flwc ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = in +[ flns ] + standard_name = longwave_net_upward_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ flnt ] + standard_name = longwave_net_outgoing_flux_at_model_top + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ flwds ] + standard_name = longwave_downward_radiative_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_flag + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 149dcced..e7641b4d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -24,8 +24,8 @@ module rrtmgp_lw_cloud_optics subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, abs_lw_liq, abs_lw_ice, & g_mu, g_lambda, g_d_eff, tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & - do_snow, do_graupel, pver, ktopcam, cld_lw_abs, snow_lw_abs, grau_lw_abs, & - c_cld_lw_abs, errmsg, errflg) + nmu, nlambda, n_g_d, do_snow, do_graupel, pver, ktopcam, cld_lw_abs, snow_lw_abs, & + grau_lw_abs, c_cld_lw_abs, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp ! Compute combined cloud optical properties @@ -37,6 +37,9 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, integer, intent(in) :: nlay ! Number of vertical layers in radiation integer, intent(in) :: nlaycam ! Number of model layers in radiation integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nlambda + integer, intent(in) :: n_g_d + integer, intent(in) :: nmu integer, intent(in) :: pver ! Total number of vertical layers integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) @@ -65,11 +68,9 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Outputs type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_lw ! Longwave cloud optics object - !real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction real(kind_phys), dimension(:,:,:), intent(out) :: cld_lw_abs ! Cloud absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) -! real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: tauc ! Cloud optical depth real(kind_phys), dimension(:,:,:), intent(out) :: c_cld_lw_abs character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -151,22 +152,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, end do end if - ! Extract just the layers of CAM where RRTMGP does calculations - - ! Subset "chunk" data so just the number of CAM layers in the - ! radiation calculation are used by MCICA to produce subcolumns -! cldf = cldfprime(:, ktopcam:) - - ! Allocate tauc variable -! if (allocated(tauc)) then -! deallocate(tauc) -! end if -! allocate(tauc(nlwbands,ncol,nlaycam), stat=errflg) -! tauc = c_cld_lw_abs(:, :, ktopcam:) - -! ! Enforce tauc >= 0. -! tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) - errmsg =cloud_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) if (len_trim(errmsg) > 0) then errflg = 1 diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index 57016fa9..7924247a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -93,7 +93,7 @@ standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path units = m2 kg-1 type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) intent = in [ abs_lw_ice ] standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path @@ -161,6 +161,24 @@ type = integer dimensions = () intent = in +[ nmu ] + standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = in +[ nlambda ] + standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid + units = count + type = integer + dimensions = () + intent = in +[ n_g_d ] + standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid + units = count + type = integer + dimensions = () + intent = in [ do_snow ] standard_name = include_snow_in_radiation_calculation units = flag diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 85a21f21..6fd465a2 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -43,7 +43,7 @@ intent = in [ atm_optics_sw ] standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP - units = 1 + units = none type = ty_optical_props_2str_ccpp dimensions = () intent = inout diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index d24d63ef..368483c2 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -166,6 +166,19 @@ .true. + + logical + rrtmgp + rrtmgp + is_offline_dynamical_core + flag + + If true, we are using the offline dynamical core / specified dynamics + + + .false. + + logical rrtmgp diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 new file mode 100644 index 00000000..4cfcdfc1 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -0,0 +1,62 @@ +! PEVERWHEE - dependencies = interpolate_data +!> \file rrtmgp_sw_cloud_optics.F90 +!! + +!> This module contains two routines: The first initializes data and functions +!! needed to compute the longwave cloud radiative properties in RRTMGP. The second routine +!! is a ccpp scheme within the "radiation loop", where the shortwave optical properties +!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL +!! cloud types visible to RRTMGP. +module rrtmgp_sw_cloud_optics + use ccpp_kinds, only: kind_phys + + implicit none + private + public :: rrtmgp_sw_cloud_optics_run + +contains + + ! SUBROUTINE rrtmgp_sw_cloud_optics_run() + ! ###################################################################################### +!> \section arg_table_rrtmgp_sw_cloud_optics_run Argument Table +!! \htmlinclude rrtmgp_sw_cloud_optics_run.html +!! + subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, nlay, kdist_sw, cloud_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + ! 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 + + ! Inputs + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers in radiation + logical, intent(in) :: dosw ! Flag for whether to perform longwave calculation + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Longwave gas optics object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_sw ! Longwave cloud optics object + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'rrtmgp_sw_cloud_optics_run' + !-------------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + ! If not doing longwave, no need to proceed + if (.not. dosw) then + return + end if + + errmsg =cloud_sw%optical_props%alloc_1scl(ncol, nlay, kdist_sw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end subroutine rrtmgp_sw_cloud_optics_run + +end module rrtmgp_sw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta new file mode 100644 index 00000000..d8238ec1 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -0,0 +1,49 @@ +[ccpp-table-properties] + name = rrtmgp_sw_cloud_optics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ cloud_sw ] + standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 71ee3d5b..d36408ba 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,12 +10,14 @@ rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen rrtmgp_sw_gas_optics + rrtmgp_sw_cloud_optics rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics rrtmgp_lw_main + rrtmgp_lw_calculate_fluxes rrtmgp_lw_diagnostics From cce8c990d83610d6a9327108e2b4fd063f079ec4 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 5 Jun 2025 22:32:11 -0600 Subject: [PATCH 033/140] add temporary gitmodules file --- .gitmodules | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 .gitmodules diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..fcc23e10 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "ccpp-physics"] + path = schemes/rrtmgp/ext + url = https://github.com/earth-system-radiation/rte-rrtmgp.git + fxtag = v1.7 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/earth-system-radiation/rte-rrtmgp.git From 952f5b7488c857ea4e2efb6ff9c8d0aca822aff0 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 10:34:42 -0600 Subject: [PATCH 034/140] update dependencies, initial submodule --- schemes/.ccpp_physics_sparse_checkout | 3 +++ schemes/rrtmgp/objects/ccpp_fluxes.meta | 2 +- schemes/rrtmgp/objects/ccpp_fluxes_byband.meta | 2 +- schemes/rrtmgp/objects/ccpp_gas_concentrations.meta | 2 +- schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta | 4 +++- schemes/rrtmgp/objects/ccpp_optical_props.meta | 2 +- schemes/rrtmgp/objects/ccpp_source_functions.meta | 2 +- schemes/rrtmgp/rrtmgp_constituents.F90 | 3 +++ schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 9 ++++----- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 6 ++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 1 + schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 1 + schemes/rrtmgp/rrtmgp_lw_main.meta | 6 ++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 1 + schemes/rrtmgp/rrtmgp_variables.F90 | 9 +++++---- 15 files changed, 38 insertions(+), 15 deletions(-) create mode 100644 schemes/.ccpp_physics_sparse_checkout diff --git a/schemes/.ccpp_physics_sparse_checkout b/schemes/.ccpp_physics_sparse_checkout new file mode 100644 index 00000000..1730647d --- /dev/null +++ b/schemes/.ccpp_physics_sparse_checkout @@ -0,0 +1,3 @@ +.gitmodules +physics/tools +physics/Radiation/RRTMGP/rte-rrtmgp diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index 9ee8e981..557fb9a5 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_broadband_ccpp type = ddt -# dependencies = /path/to/ext/rte-frontend/mo_fluxes.F90 + dependencies = ../ext/rte-frontend/mo_fluxes.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta index 43b7ed45..5b1048df 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_byband_ccpp type = ddt -# dependencies = /path/to/ext/extensions/mo_fluxes_byband.F90 + dependencies = ../ext/extensions/mo_fluxes_byband.F90 [ccpp-arg-table] name = ty_fluxes_byband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta index 209221c0..4c35c631 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ty_gas_concs_ccpp type = ddt -# dependencies = /path/to/ext/gas-optics/mo_gas_concentrations.F90 + dependencies = ../ext/gas-optics/mo_gas_concentrations.F90 [ccpp-arg-table] name = ty_gas_concs_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta index e1e0df46..f14c9463 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -1,7 +1,9 @@ [ccpp-table-properties] name = ty_gas_optics_rrtmgp_ccpp type = ddt -# dependencies = /path/to/ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 + dependencies = ../ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,../ext/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 + dependencies = ../ext/gas-optics/mo_gas_optics_constants.F90,../ext/gas-optics/mo_gas_optics_util_string.F90 + dependencies = ../ext/gas-optics/mo_gas_optics.F90 [ccpp-arg-table] name = ty_gas_optics_rrtmgp_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index f14b163a..0253c486 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ty_optical_props_1scl_ccpp type = ddt -# dependencies = /path/to/ext/rte-frontend/mo_optical_props.F90 + dependencies = ../ext/rte-frontend/mo_optical_props.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta index 03a0bbee..8de926eb 100644 --- a/schemes/rrtmgp/objects/ccpp_source_functions.meta +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = ty_source_func_lw_ccpp type = ddt -# dependencies = /path/to/ext/rte-frontend/mo_source_functions.F90 + dependencies = ../ext/rte-frontend/mo_source_functions.F90 [ccpp-arg-table] name = ty_source_func_lw_ccpp diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 1af4aa19..af8a8a0e 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -9,6 +9,7 @@ module rrtmgp_constituents !! subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use ccpp_kinds, only: kind_phys integer, intent(in) :: nradgas type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) character(len=256), intent(in) :: rad_climate @@ -115,6 +116,7 @@ end subroutine rrtmgp_constituents_register subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_call_array, & rrtmgp_phys_blksz, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & use_tlev, top_at_one, errmsg, errcode) + use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag integer, intent(in) :: ncol real(kind_phys), intent(in) :: unset_real @@ -158,6 +160,7 @@ end subroutine rrtmgp_constituents_init subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg, errcode) use ccpp_constituent_prop_mod, only: int_unassigned use ccpp_scheme_utils, only: ccpp_constituent_index + use ccpp_kinds, only: kind_phys character(len=5), intent(in) :: gaslist(:) real(kind_phys), intent(in) :: const_array(:,:,:) real(kind_phys), intent(out) :: rad_const_array(:,:,:) diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index 7319ded0..50a6f83b 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -8,14 +8,12 @@ module rrtmgp_lw_calculate_fluxes public :: rrtmgp_lw_calculate_fluxes_run ! main routine - character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& - '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) CONTAINS !> \section arg_table_rrtmgp_lw_calculate_fluxes_run Argument Table !! \htmlinclude rrtmgp_lw_calculate_fluxes_run.html - subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, pverp, nlay, ktopcam, ktoprad, & + subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp, nlay, ktopcam, ktoprad, & active_calls, flw, flwc, flns, flnt, flwds, errmsg, errflg) use ccpp_fluxes, only: ty_fluxes_broadband_ccpp @@ -26,6 +24,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, pverp, nlay integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles integer, intent(in) :: icall ! Current diagnostic subcycle integer, intent(in) :: pverp ! Number of vertical layer interfaces + integer, intent(in) :: ncol integer, intent(in) :: nlay integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays @@ -53,7 +52,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, pverp, nlay diag_index = num_diag_subcycles - icall ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output - if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + if (.not. active_calls(diag_index)) then return end if @@ -66,7 +65,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, pverp, nlay flns(:ncol) = fnl(:ncol, pverp) flnt(:ncol) = fnl(:ncol, ktopcam) - cam_out%flwds(:ncol) = flw%fluxes%flux_dn(:, nlay+1) + flwds(:ncol) = flw%fluxes%flux_dn(:, nlay+1) end subroutine rrtmgp_lw_calculate_fluxes_run diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta index 2175b2f6..7a8247fd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -17,6 +17,12 @@ type = integer dimensions = () intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in [ pverp ] standard_name = vertical_interface_dimension units = count diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index 7924247a..3d22d439 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_optics type = scheme + dependencies = ext/rte-kernels/mo_optical_props_kernels.F90 [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 42491423..ac4220f9 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_gas_optics type = scheme + dependencies = ext/rte-frontend/mo_rte_kind.F90,objects/ccpp_gas_concentrations.F90 [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta index a0a6384a..ed9474f5 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.meta +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -1,6 +1,12 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme + dependencies = ext/rte-frontend/mo_rte_lw.F90,ext/rte-frontend/mo_rte_config.F90 + dependencies = ext/rte-kernels/mo_rte_util_array.F90,ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = objects/ccpp_source_functions.F90,objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = objects/ccpp_optical_props.F90,ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = objects/ccpp_fluxes.F90,objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_lw_main_run diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index efe4cdc9..1715c118 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_gas_optics type = scheme + dependencies = ext/rte-frontend/mo_rte_kind.F90 [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index dba6babf..7f4c8e9d 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -42,19 +42,20 @@ subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real grau_associated = .false. ! Determine if the snow cloud fraction variable is set to something - if (cldfsnow /= unset_real) then + if (cldfsnow(1,1) /= unset_real) then do_snow = .true. end if ! Determine if the graupel cloud fraction variable is set to something - if (cldfgrau /= unset_real) then + if (cldfgrau(1,1) /= unset_real) then grau_associated = .true. end if ! Determine if we should include graupel in the radiation calculation - if (graupel_in_rad .and. ((cldfgrau /= unset_real) .and. (degrau /= unset_real) .and. (icgrauwp /= unset_real)) then - do_graup = .true. + if (graupel_in_rad .and. ((cldfgrau(1,1) /= unset_real) .and. (degrau(1,1) /= unset_real) .and. (icgrauwp(1,1) /= unset_real))) then + do_grau = .true. end if end subroutine rrtmgp_variables_run +end module rrtmgp_variables From 4d4f244dd86054178630ad6f34ec8360181281b1 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 10:40:04 -0600 Subject: [PATCH 035/140] update gitmodules --- .gitmodules | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index fcc23e10..c52827fc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,7 @@ [submodule "ccpp-physics"] - path = schemes/rrtmgp/ext - url = https://github.com/earth-system-radiation/rte-rrtmgp.git - fxtag = v1.7 + path = schemes/ccpp-physics + url = https://github.com/peverwhee/ccpp-physics + fxsparse = ../.ccpp_physics_sparse_checkout + fxtag = 6d02eea1115c8319127d9f1eacba34c4ad40166b fxrequired = AlwaysRequired - fxDONOTUSEurl = https://github.com/earth-system-radiation/rte-rrtmgp.git + fxDONOTUSEurl = https://github.com/NCAR/ccpp-physics From 61aea3a46db719b0dbfad31ecf47978f8df64e6b Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 11:05:59 -0600 Subject: [PATCH 036/140] fix sparse checkout file --- schemes/.ccpp_physics_sparse_checkout | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/.ccpp_physics_sparse_checkout b/schemes/.ccpp_physics_sparse_checkout index 1730647d..513d0bd1 100644 --- a/schemes/.ccpp_physics_sparse_checkout +++ b/schemes/.ccpp_physics_sparse_checkout @@ -1,3 +1,3 @@ .gitmodules physics/tools -physics/Radiation/RRTMGP/rte-rrtmgp +physics/Radiation/RRTMGP From b50b702bbd190c9ea78de7ecb3c0df640ac9fba6 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 12:03:15 -0600 Subject: [PATCH 037/140] add hooks --- schemes/.ccpp_physics_sparse_checkout | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/.ccpp_physics_sparse_checkout b/schemes/.ccpp_physics_sparse_checkout index 513d0bd1..117b4add 100644 --- a/schemes/.ccpp_physics_sparse_checkout +++ b/schemes/.ccpp_physics_sparse_checkout @@ -1,3 +1,4 @@ .gitmodules physics/tools +physics/hooks physics/Radiation/RRTMGP From 04bb4ca3bbe4dcf44c302b9ee33570fb6e5d9117 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 12:04:06 -0600 Subject: [PATCH 038/140] update the relative path to rrtmgp external --- schemes/rrtmgp/objects/ccpp_fluxes.meta | 3 ++- schemes/rrtmgp/objects/ccpp_fluxes_byband.meta | 3 ++- .../rrtmgp/objects/ccpp_gas_concentrations.meta | 3 ++- schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta | 7 ++++--- schemes/rrtmgp/objects/ccpp_optical_props.meta | 3 ++- schemes/rrtmgp/objects/ccpp_source_functions.meta | 3 ++- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 3 ++- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 3 ++- schemes/rrtmgp/rrtmgp_lw_main.meta | 14 ++++++++------ schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 3 ++- 10 files changed, 28 insertions(+), 17 deletions(-) diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index 557fb9a5..d32a31bd 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = ty_fluxes_broadband_ccpp type = ddt - dependencies = ../ext/rte-frontend/mo_fluxes.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = ext/rte-frontend/mo_fluxes.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta index 5b1048df..22bdbe2c 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = ty_fluxes_byband_ccpp type = ddt - dependencies = ../ext/extensions/mo_fluxes_byband.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = extensions/mo_fluxes_byband.F90 [ccpp-arg-table] name = ty_fluxes_byband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta index 4c35c631..449f78b3 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = ty_gas_concs_ccpp type = ddt - dependencies = ../ext/gas-optics/mo_gas_concentrations.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = gas-optics/mo_gas_concentrations.F90 [ccpp-arg-table] name = ty_gas_concs_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta index f14c9463..b15959c5 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -1,9 +1,10 @@ [ccpp-table-properties] name = ty_gas_optics_rrtmgp_ccpp type = ddt - dependencies = ../ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,../ext/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 - dependencies = ../ext/gas-optics/mo_gas_optics_constants.F90,../ext/gas-optics/mo_gas_optics_util_string.F90 - dependencies = ../ext/gas-optics/mo_gas_optics.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 + dependencies = gas-optics/mo_gas_optics_constants.F90,gas-optics/mo_gas_optics_util_string.F90 + dependencies = gas-optics/mo_gas_optics.F90 [ccpp-arg-table] name = ty_gas_optics_rrtmgp_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index 0253c486..d252c7ad 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = ty_optical_props_1scl_ccpp type = ddt - dependencies = ../ext/rte-frontend/mo_optical_props.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = ext/rte-frontend/mo_optical_props.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta index 8de926eb..dc407aa5 100644 --- a/schemes/rrtmgp/objects/ccpp_source_functions.meta +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = ty_source_func_lw_ccpp type = ddt - dependencies = ../ext/rte-frontend/mo_source_functions.F90 + relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = ext/rte-frontend/mo_source_functions.F90 [ccpp-arg-table] name = ty_source_func_lw_ccpp diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index 3d22d439..ebc72ae1 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_optics type = scheme - dependencies = ext/rte-kernels/mo_optical_props_kernels.F90 + relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = rte-kernels/mo_optical_props_kernels.F90 [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index ac4220f9..4ada5690 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = rrtmgp_lw_gas_optics type = scheme - dependencies = ext/rte-frontend/mo_rte_kind.F90,objects/ccpp_gas_concentrations.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 + dependencies = objects/ccpp_gas_concentrations [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta index ed9474f5..7cf26e9d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.meta +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -1,12 +1,14 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme - dependencies = ext/rte-frontend/mo_rte_lw.F90,ext/rte-frontend/mo_rte_config.F90 - dependencies = ext/rte-kernels/mo_rte_util_array.F90,ext/rte-frontend/mo_rte_util_array_validation.F90 - dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 - dependencies = objects/ccpp_source_functions.F90,objects/ccpp_gas_optics_rrtmgp.F90 - dependencies = objects/ccpp_optical_props.F90,ext/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = objects/ccpp_fluxes.F90,objects/ccpp_fluxes_byband.F90 + relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = rte-frontend/mo_rte_lw.F90,rte-frontend/mo_rte_config.F90 + dependencies = rte-kernels/mo_rte_util_array.F90,rte-frontend/mo_rte_util_array_validation.F90 + dependencies = rte-kernels/mo_rte_solver_kernels.F90,rte-kernels/mo_fluxes_broadband_kernels.F90 + relative_path = ./objects + dependencies = ccpp_source_functions.F90,ccpp_gas_optics_rrtmgp.F90 + dependencies = ccpp_optical_props.F90 + dependencies = ccpp_fluxes.F90,ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_lw_main_run diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index 1715c118..ba9793ef 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = rrtmgp_sw_gas_optics type = scheme - dependencies = ext/rte-frontend/mo_rte_kind.F90 + relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp + dependencies = rte-frontend/mo_rte_kind.F90 [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init From 1a05947243b74b88b5cd669e233071d30ec1024b Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 16:17:57 -0600 Subject: [PATCH 039/140] disable sparse checkout for testing git-fleximod --- .gitmodules | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index c52827fc..e7240c8d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,6 @@ [submodule "ccpp-physics"] path = schemes/ccpp-physics url = https://github.com/peverwhee/ccpp-physics - fxsparse = ../.ccpp_physics_sparse_checkout fxtag = 6d02eea1115c8319127d9f1eacba34c4ad40166b fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/NCAR/ccpp-physics From b70cea45be1f3d4a9317443baecf41598bda64d1 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 6 Jun 2025 16:25:54 -0600 Subject: [PATCH 040/140] add sparse checkout back --- .gitmodules | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitmodules b/.gitmodules index e7240c8d..c52827fc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,7 @@ [submodule "ccpp-physics"] path = schemes/ccpp-physics url = https://github.com/peverwhee/ccpp-physics + fxsparse = ../.ccpp_physics_sparse_checkout fxtag = 6d02eea1115c8319127d9f1eacba34c4ad40166b fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/NCAR/ccpp-physics From a22d70ffa886510ed3e254942cf9e61c1ec91413 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 9 Jun 2025 10:02:17 -0600 Subject: [PATCH 041/140] rrtmgp-lw physics builds --- schemes/.ccpp_physics_sparse_checkout | 1 - schemes/rrtmgp/objects/ccpp_fluxes.meta | 2 +- .../rrtmgp/objects/ccpp_optical_props.meta | 2 +- .../rrtmgp/objects/ccpp_source_functions.meta | 2 +- schemes/rrtmgp/rrtmgp_constituents.F90 | 2 +- schemes/rrtmgp/rrtmgp_constituents.meta | 2 +- .../rrtmgp/rrtmgp_constituents_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 1 + schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_main.meta | 19 +++++++++++-------- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 2 -- 11 files changed, 19 insertions(+), 18 deletions(-) diff --git a/schemes/.ccpp_physics_sparse_checkout b/schemes/.ccpp_physics_sparse_checkout index 117b4add..8b582487 100644 --- a/schemes/.ccpp_physics_sparse_checkout +++ b/schemes/.ccpp_physics_sparse_checkout @@ -1,4 +1,3 @@ .gitmodules physics/tools physics/hooks -physics/Radiation/RRTMGP diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index d32a31bd..06eb6545 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -2,7 +2,7 @@ name = ty_fluxes_broadband_ccpp type = ddt relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = ext/rte-frontend/mo_fluxes.F90 + dependencies = rte-frontend/mo_fluxes.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index d252c7ad..6ba2183b 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -2,7 +2,7 @@ name = ty_optical_props_1scl_ccpp type = ddt relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = ext/rte-frontend/mo_optical_props.F90 + dependencies = rte-frontend/mo_optical_props.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta index dc407aa5..6cf2efb8 100644 --- a/schemes/rrtmgp/objects/ccpp_source_functions.meta +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -2,7 +2,7 @@ name = ty_source_func_lw_ccpp type = ddt relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = ext/rte-frontend/mo_source_functions.F90 + dependencies = rte-frontend/mo_source_functions.F90 [ccpp-arg-table] name = ty_source_func_lw_ccpp diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index af8a8a0e..7ab4de0e 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -12,7 +12,7 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, use ccpp_kinds, only: kind_phys integer, intent(in) :: nradgas type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) - character(len=256), intent(in) :: rad_climate + character(len=256), intent(in) :: rad_climate(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 0bd0813d..43eea7db 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -15,7 +15,7 @@ standard_name = sources_of_radiatively_active_gases_for_climate_calcluation units = none type = character | kind = len=256 - dimensions = () + dimensions = (cam_nl_autogen1_dimension) intent = in [ rrtmgp_dyn_consts ] standard_name = rrtmgp_constituents_dyn_consts diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml index 6c49d153..7c35d01a 100644 --- a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -76,7 +76,7 @@ This is the CCPP unit specification of the variable (e.g., m s-1). --> - char*256 + char*256(8) rrtmgp_constituents rrtmgp_constituents sources_of_radiatively_active_gases_for_climate_calcluation diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index 176cf069..5b812dbc 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_inputs_setup type = scheme + dependencies = ./utils/radiation_utils.F90 [ccpp-arg-table] name = rrtmgp_inputs_setup_init diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 4ada5690..ab4c9cb5 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -2,7 +2,7 @@ name = rrtmgp_lw_gas_optics type = scheme dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 - dependencies = objects/ccpp_gas_concentrations + dependencies = objects/ccpp_gas_concentrations.F90 [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_lw_main.meta b/schemes/rrtmgp/rrtmgp_lw_main.meta index 7cf26e9d..caef2ea2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.meta +++ b/schemes/rrtmgp/rrtmgp_lw_main.meta @@ -1,14 +1,17 @@ [ccpp-table-properties] name = rrtmgp_lw_main type = scheme - relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-frontend/mo_rte_lw.F90,rte-frontend/mo_rte_config.F90 - dependencies = rte-kernels/mo_rte_util_array.F90,rte-frontend/mo_rte_util_array_validation.F90 - dependencies = rte-kernels/mo_rte_solver_kernels.F90,rte-kernels/mo_fluxes_broadband_kernels.F90 - relative_path = ./objects - dependencies = ccpp_source_functions.F90,ccpp_gas_optics_rrtmgp.F90 - dependencies = ccpp_optical_props.F90 - dependencies = ccpp_fluxes.F90,ccpp_fluxes_byband.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_lw.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_config.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_util_array.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ../ccpp-physics/physics/hooks/machine.F + dependencies = ./utils/radiation_tools.F90 + dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = ./objects/ccpp_optical_props.F90 + dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_lw_main_run diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index ec735ea1..a6142cfd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -89,7 +89,6 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) - real(kind_phys) :: cldf(ncol,nver) real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy real(kind_phys) :: tauc(nlwbands,ncol,nver) @@ -115,7 +114,6 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) ! clip cloud fraction - cldf(:,:) = cldfrac(:,:) where (cldf(:,:) < cldmin) cldf(:,:) = 0._kind_phys end where From ae847e63af987c1b42e0905ed53caeb67ebdfd60 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 23 Jun 2025 16:43:54 -0600 Subject: [PATCH 042/140] fix memory leak --- schemes/rrtmgp/rrtmgp_post.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index f7794296..46d5f252 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -9,7 +9,7 @@ module rrtmgp_post !> \section arg_table_rrtmgp_post_run Argument Table !! \htmlinclude rrtmgp_post_run.html !! -subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & +subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, atm_optics_lw, cloud_sw, aer_sw, & fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp @@ -20,6 +20,7 @@ subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, clou real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] real(kind_phys), dimension(:,:), intent(in) :: qrs_prime ! Shortwave heating rate [J kg-1 s-1] real(kind_phys), dimension(:,:), intent(in) :: qrl_prime ! Longwave heating rate [J kg-1 s-1] + type(ty_optical_props_1scl_ccpp), intent(inout) :: atm_optics_lw ! Atmosphere optical properties object (longwave) type(ty_optical_props_2str_ccpp), intent(inout) :: atm_optics_sw ! Atmosphere optical properties object (shortwave) type(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw ! Aerosol optical properties object (longwave) type(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw ! Aerosol optical properties object (shortwave) @@ -62,6 +63,11 @@ subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, clou call free_fluxes_byband(fsw) call free_fluxes_broadband(fswc) + call free_optics_lw(atm_optics_lw) + if (errflg /= 0) then + return + end if + call sources_lw%sources%finalize() call free_optics_lw(cloud_lw, errmsg, errflg) if (errflg /= 0) then From db86454412d4de70d51cca55f80c81cded398daf Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 30 Jun 2025 09:55:26 -0600 Subject: [PATCH 043/140] fix calling list --- schemes/rrtmgp/rrtmgp_post.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 46d5f252..56f549f6 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -63,7 +63,7 @@ subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, atm_ call free_fluxes_byband(fsw) call free_fluxes_broadband(fswc) - call free_optics_lw(atm_optics_lw) + call free_optics_lw(atm_optics_lw, errmsg, errflg) if (errflg /= 0) then return end if From e504efbd115b4b8da2037fa058139e221b0ae834 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 30 Jun 2025 14:01:14 -0600 Subject: [PATCH 044/140] add logical kind --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 102 ------ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 | 330 ------------------- 4 files changed, 2 insertions(+), 434 deletions(-) delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index f49b9dcf..593c5dac 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -31,7 +31,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code + integer, intent(out) :: errcode ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), allocatable :: pio_reader diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 deleted file mode 100644 index 46097c67..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 +++ /dev/null @@ -1,102 +0,0 @@ -!> \file rrtmgp_lw_gas_optics_data.F90 -!! - -!> This module contains an init routine to initialize the gas optics object -!> with data read in from file on the host side -module rrtmgp_lw_gas_optics_data - - implicit none - private - public :: rrtmgp_lw_gas_optics_data_init - - -contains -!> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table -!! \htmlinclude rrtmgp_lw_gas_optics_data_init.html -!! - subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, & - key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & - temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & - kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & - minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & - scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & - errmsg, errflg) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg - use mo_rte_kind, only: wl - - ! Inputs - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - character(len=*), dimension(:), intent(in) :: gas_names ! Names of absorbing gases - character(len=*), dimension(:), intent(in) :: gas_minor ! Name of absorbing minor gas - character(len=*), dimension(:), intent(in) :: identifier_minor ! Unique string identifying minor gas - character(len=*), dimension(:), intent(in) :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=*), dimension(:), intent(in) :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=*), dimension(:), intent(in) :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=*), dimension(:), intent(in) :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), intent(in) :: key_species ! Key species pair for each band - integer, dimension(:,:), intent(in) :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), intent(in) :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), intent(in) :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), intent(in) :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), intent(in) :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), intent(in) :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), intent(in) :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), intent(in) :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), intent(in) :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), intent(in) :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), intent(in) :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), intent(in) :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - - ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errflg ! CCPP error code - - ! Initialize error variables - errmsg = '' - errflg = 0 - - ! Initialize the gas optics object with data. - errmsg = kdist%gas_props%load( & - available_gases%gas_concs, gas_names, key_species, & - band2gpt, band_lims_wavenum, & - press_ref, press_ref_trop, temp_ref, & - temp_ref_p, temp_ref_t, vmr_ref, & - kmajor, kminor_lower, kminor_upper, & - gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, & - minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, & - scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower, rayl_upper, & - optimal_angle_fit) - - if (len_trim(errmsg) > 0) then - errflg = 1 - end if - call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) - - end subroutine rrtmgp_lw_gas_optics_data_init - -end module rrtmgp_lw_gas_optics_data diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index d525915f..a2a3bef3 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -21,7 +21,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - use mo_rte_kind, only: wl + use mo_rte_kind, only: wl ! Inputs character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 deleted file mode 100644 index c87a434e..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_data.F90 +++ /dev/null @@ -1,330 +0,0 @@ -!> \file rrtmgp_sw_gas_optics_data.F90 -!! - -!> This module contains an init routine to initialize the shortwave gas optics object -!> with data read in from file on the host side -module rrtmgp_sw_gas_optics_data - - implicit none - private - public :: rrtmgp_sw_gas_optics_data_init - - -contains -!> \section arg_table_rrtmgp_sw_gas_optics_data_init Argument Table -!! \htmlinclude rrtmgp_sw_gas_optics_data_init.html -!! - subroutine rrtmgp_sw_gas_optics_data_init(kdist, sw_filename, available_gases, & - errmsg, errcode) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - - ! Inputs - character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - - ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code - - ! Local variables - class(abstract_netcdf_reader_t), allocatable :: pio_reader - character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band - integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical, dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical, dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical, dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical, dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] - real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] - real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] - real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. - character(len=256) :: alloc_errmsg - integer :: idx - - ! Initialize error variables - errmsg = '' - errcode = 0 - - pio_reader = create_netcdf_reader_t() - - ! Open the longwave coefficients file - call pio_reader%open_file(sw_filename, errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Read the coefficients from the file - call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('key_species', key_species, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('band2gpt', band2gpt, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('band_lims_wavenum', band_lims_wavenum, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('tsi_default', tsi_default, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('mg_default', mg_default, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('sb_default', sb_default, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) - ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then - return - end if - if (errcode /= 3) then - allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) - rayl_lower_allocatable = rayl_lower - end if - call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) - ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then - return - end if - if (errcode /= 3) then - allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) - rayl_upper_allocatable = rayl_upper - end if - call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - minor_scales_with_density_lower(idx) = .false. - else - minor_scales_with_density_lower(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - scale_by_complement_lower(idx) = .false. - else - scale_by_complement_lower(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - minor_scales_with_density_upper(idx) = .false. - else - minor_scales_with_density_upper(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) - if (errcode /= 0) then - return - end if - allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then - scale_by_complement_upper(idx) = .false. - else - scale_by_complement_upper(idx) = .true. - end if - end do - deallocate(int2log) - call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) - if (errcode /= 0) then - return - end if - call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Close the longwave coefficients file - call pio_reader%close_file(errmsg, errcode) - if (errcode /= 0) then - return - end if - - ! Initialize the gas optics object with data. - errmsg = kdist%gas_props%load( & - available_gases%gas_concs, gas_names, key_species, & - band2gpt, band_lims_wavenum, & - press_ref, press_ref_trop, temp_ref, & - temp_ref_p, temp_ref_t, vmr_ref, & - kmajor, kminor_lower, kminor_upper, & - gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, & - minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, & - scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, & - solar_src_quiet, solar_src_facular, solar_src_sunspot, & - tsi_default, mg_default, sb_default, & - rayl_lower_allocatable, rayl_upper_allocatable) - - if (len_trim(errmsg) > 0) then - errcode = 1 - end if - call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) - - end subroutine rrtmgp_sw_gas_optics_data_init - -end module rrtmgp_sw_gas_optics_data From 9cfcb2eaca2c63a4a6f00799b226cd9893a38f64 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 30 Jun 2025 16:33:18 -0600 Subject: [PATCH 045/140] add missing use statements --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 2ffd8ea0..75b6c94a 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -162,6 +162,7 @@ subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_d wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_kinds, only: kind_phys ! Set the low and high limits of the wavenumber grid for sw and lw. ! Values come from RRTMGP coefficients datasets, and are stored in the ! kdist objects. @@ -285,6 +286,7 @@ end subroutine set_wavenumber_bands subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & wavenumber_high, ans, errmsg, errflg) + use ccpp_kinds, only: kind_phys ! Find band index for requested wavelength/wavenumber. From 6d6b5d1e936df18270dda528dbab09519f13a4d2 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 30 Jun 2025 16:40:36 -0600 Subject: [PATCH 046/140] remove duplicate free_optics_lw call --- schemes/rrtmgp/rrtmgp_post.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 6bea0130..b36f526e 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -64,11 +64,6 @@ subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, clou call free_fluxes_byband(fsw) call free_fluxes_broadband(fswc) - call free_optics_lw(atm_optics_lw, errmsg, errflg) - if (errflg /= 0) then - return - end if - call sources_lw%sources%finalize() call free_optics_lw(atm_optics_lw, errmsg, errflg) if (errflg /= 0) then From a753b2ff331faa3a721293b5b9ae2bd635510344 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 30 Jun 2025 16:52:19 -0600 Subject: [PATCH 047/140] remove unused gaslist argument left over from merge --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 75b6c94a..3c7c4e01 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -13,7 +13,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, gaslist, nswgpts, nlwgpts, nlayp, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, nlayp, & nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp @@ -38,7 +38,6 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation logical, intent(in) :: is_root ! Flag for whether this is the root task - character(len=*), dimension(:), intent(in) :: gaslist ! Outputs integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active @@ -72,7 +71,6 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw real(kind_phys), target :: wavenumber_high_shortwave(nswbands) real(kind_phys), target :: wavenumber_low_longwave(nlwbands) real(kind_phys), target :: wavenumber_high_longwave(nlwbands) - character(len=gasnamelength) :: gaslist_lc(nradgas) ! Set error variables errflg = 0 From 6d34fb77afbf89fada68b27eb1ef75bb932f9930 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 1 Jul 2025 17:01:44 -0600 Subject: [PATCH 048/140] add shortwave modules --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 483 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 149 ++++++ schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 178 +++++++ 3 files changed, 810 insertions(+) create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_solar_var.F90 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 new file mode 100644 index 00000000..4a404ab2 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -0,0 +1,483 @@ +module rrtmgp_sw_cloud_optics +use ccpp_kinds, only: kind_phys + +!-------------------------------------------------------------------------------- +! Transform data for inputs from CAM's data structures to those used by +! RRTMGP. Subset the number of model levels if CAM's top exceeds RRTMGP's +! valid domain. Add an extra layer if CAM's top is below 1 Pa. +! The vertical indexing increases from top to bottom of atmosphere in both +! CAM and RRTMGP arrays. +!-------------------------------------------------------------------------------- + +implicit none +private +save + +public :: rrtmgp_sw_cloud_optics_run + +! Mapping from RRTMG shortwave bands to RRTMGP. Currently needed to continue using +! the SW optics datasets from RRTMG (even thought there is a slight mismatch in the +! band boundaries of the 2 bands that overlap with the LW bands). +integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & + [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] + +real(kind_phys) :: tiny + +!================================================================================================== +contains +!================================================================================================== + +subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & + nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & + snow_tau, degrau, dei, des, iclwpth, icswpth, icgrauwpth, tiny_in, 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, & + tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + + ! 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 + 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(:) ! indices of daylight columns in the chunk + integer, intent(in) :: nswgpts + integer, intent(in) :: pver + integer, intent(in) :: ktopcam + integer, intent(in) :: ktoprad + integer, intent(in) :: nswbands + integer, intent(in) :: nnite ! number of night columns + integer, intent(in) :: idxnite(:) ! indices of night columns in the chunk + integer, intent(in) :: iulog + integer, intent(in) :: idx_sw_diag + + logical, intent(in) :: do_snow + logical, intent(in) :: do_graupel + logical, intent(in) :: dosw + + real(kind_phys), intent(in) :: fillvalue + real(kind_phys), intent(in) :: tiny_in + + real(kind_phys), intent(in) :: g_mu(:) + real(kind_phys), intent(in) :: g_d_eff(:) + real(kind_phys), intent(in) :: g_lambda(:,:) + real(kind_phys), intent(in) :: lamc(:,:) + real(kind_phys), intent(in) :: pgam(:,:) + real(kind_phys), intent(in) :: dei(:,:) + real(kind_phys), intent(in) :: des(:,:) + real(kind_phys), intent(in) :: degrau(:,:) + real(kind_phys), intent(in) :: iclwpth(:,:) + real(kind_phys), intent(in) :: icswpth(:,:) + real(kind_phys), intent(in) :: icgrauwpth(:,:) + real(kind_phys), intent(in) :: cld(:,:) ! cloud fraction (liq+ice) + real(kind_phys), intent(in) :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" + real(kind_phys), intent(in) :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" + real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ext_sw_ice(:,:) + real(kind_phys), intent(in) :: asm_sw_ice(:,:) + real(kind_phys), intent(in) :: ssa_sw_ice(:,:) + + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object + real(kind_phys), intent(out) :: cld_tau(:,:,:) ! snow extinction optical depth + real(kind_phys), intent(out) :: snow_tau(:,:,:) ! snow extinction optical depth + real(kind_phys), intent(out) :: grau_tau(:,:,:) ! snow extinction optical depth + real(kind_phys), intent(out) :: c_cld_tau(:,:,:) ! combined cloud extinction optical depth + real(kind_phys), intent(out) :: c_cld_tau_w (:,:,:) ! combined cloud single scattering albedo * tau + real(kind_phys), intent(out) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau + type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object + + ! Diagnostic outputs + real(kind_phys), intent(out) :: tot_cld_vistau(:,:) ! gbx total cloud optical depth + real(kind_phys), intent(out) :: tot_icld_vistau(:,:) ! in-cld total cloud optical depth + real(kind_phys), intent(out) :: liq_icld_vistau(:,:) ! in-cld liq cloud optical depth + real(kind_phys), intent(out) :: ice_icld_vistau(:,:) ! in-cld ice cloud optical depth + real(kind_phys), intent(out) :: snow_icld_vistau(:,:) ! snow in-cloud visible sw optical depth + real(kind_phys), intent(out) :: grau_icld_vistau(:,:) ! Graupel in-cloud visible sw optical depth + + ! Error variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! 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(kind_phys) :: ice_tau (nswbands,ncol,pver) ! ice extinction optical depth + real(kind_phys) :: ice_tau_w (nswbands,ncol,pver) ! ice single scattering albedo * tau + real(kind_phys) :: ice_tau_w_g(nswbands,ncol,pver) ! ice asymmetry parameter * tau * w + real(kind_phys) :: snow_tau_w (nswbands,ncol,pver) ! snow single scattering albedo * tau + real(kind_phys) :: snow_tau_w_g(nswbands,ncol,pver) ! snow asymmetry parameter * tau * w + real(kind_phys) :: liq_tau (nswbands,ncol,pver) ! liquid optical depth + real(kind_phys) :: liq_tau_w (nswbands,ncol,pver) ! liquid single scattering albedo * tau + real(kind_phys) :: liq_tau_w_g(nswbands,ncol,pver) ! liquid asymmetry parameter * tau * w + real(kind_phys) :: cld_tau_w (nswbands,ncol,pver) ! cloud single scattering albedo * tau + real(kind_phys) :: cld_tau_w_g(nswbands,ncol,pver) ! cloud asymmetry parameter * w * tau + real(kind_phys) :: grau_tau_w (nswbands,ncol,pver) ! graupel single scattering albedo * tau + real(kind_phys) :: grau_tau_w_g(nswbands,ncol,pver) ! graupel asymmetry parameter * tau * w + + ! RRTMGP does not use this property in its 2-stream calculations. + real(kind_phys) :: sw_tau_w_f(nswbands,ncol,pver) ! Forward scattered fraction * tau * w. + + ! Arrays for converting from CAM chunks to RRTMGP inputs. + real(kind_phys), allocatable :: cldf(:,:) + real(kind_phys), allocatable :: tauc(:,:,:) + real(kind_phys), allocatable :: ssac(:,:,:) + real(kind_phys), allocatable :: asmc(:,:,:) + real(kind_phys), allocatable :: taucmcl(:,:,:) + real(kind_phys), allocatable :: ssacmcl(:,:,:) + real(kind_phys), allocatable :: asmcmcl(:,:,:) + real(kind_phys), allocatable :: day_cld_tau(:,:,:) + real(kind_phys), allocatable :: day_cld_tau_w(:,:,:) + real(kind_phys), allocatable :: day_cld_tau_w_g(:,:,:) + + character(len=*), parameter :: sub = 'rrtmgp_set_cloud_sw' + !-------------------------------------------------------------------------------- + + if (.not. dosw) then + return + end if + + tiny = tiny_in + + ! Combine the cloud optical properties. + + ! gammadist liquid optics + call get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, g_mu, iclwpth, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, errmsg, errflg) + if (errflg /= 0) then + return + end if + ! Mitchell ice optics + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, dei, g_d_eff, 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 (do_snow) then + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, des, g_d_eff, 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._kind_phys) 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._kind_phys + c_cld_tau_w(:,i,k) = 0._kind_phys + c_cld_tau_w_g(:,i,k) = 0._kind_phys + 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 (do_graupel) then + call get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, 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._kind_phys) 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._kind_phys + c_cld_tau_w(:,i,k) = 0._kind_phys + c_cld_tau_w_g(:,i,k) = 0._kind_phys + 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 (do_snow) then + snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + end if + if (do_graupel) 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 (do_snow) then + snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + endif + if (do_graupel) 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 (do_snow) then + snow_icld_vistau(idxnite(i),:) = fillvalue + end if + if (do_graupel) then + grau_icld_vistau(idxnite(i),:) = fillvalue + end if + end do + + ! 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 + + ! 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 + + end if + +end subroutine rrtmgp_sw_cloud_optics_run + +!============================================================================== + +subroutine get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) + + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nswbands + integer, intent(in) :: iulog + integer, intent(in) :: idx_sw_diag + real(kind_phys), intent(in) :: ext_sw_ice(:,:) + real(kind_phys), intent(in) :: asm_sw_ice(:,:) + real(kind_phys), intent(in) :: ssa_sw_ice(:,:) + real(kind_phys), intent(in) :: degrau(:,:) + real(kind_phys), intent(in) :: g_d_eff(:) + real(kind_phys), intent(in) :: icgrauwpth(:,:) + + real(kind_phys),intent(out) :: tau (:,:,:) ! extinction optical depth + real(kind_phys),intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau + real(kind_phys),intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w + real(kind_phys),intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w + + integer :: i,k + + ! This does the same thing as get_ice_optics_sw, except with a different + ! water path and effective diameter. + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icgrauwpth, degrau, g_d_eff, tau, tau_w, & + tau_w_g, tau_w_f) + do i = 1, ncol + do k = 1, pver + if (tau(idx_sw_diag,i,k).gt.100._kind_phys) then + write(iulog,*) 'WARNING: SW Graupel Tau > 100 (i,k,icgrauwpth,degrau,tau):' + write(iulog,*) i,k,icgrauwpth(i,k), degrau(i,k), tau(idx_sw_diag,i,k) + end if + enddo + enddo + +end subroutine get_grau_optics_sw + +!============================================================================== + +subroutine get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & + g_mu, iclwpth, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nswbands + real(kind_phys),intent(in) :: g_lambda(:,:) + real(kind_phys),intent(in) :: g_mu(:) + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) + real(kind_phys),intent(in) :: iclwpth(:,:) + real(kind_phys),intent(in) :: lamc(:,:) + real(kind_phys),intent(in) :: pgam(:,:) + + real(kind_phys),intent(out) :: tau (:,:,:) ! extinction optical depth + real(kind_phys),intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau + real(kind_phys),intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w + real(kind_phys),intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind_phys), dimension(ncol,pver) :: kext + integer i,k,swband + + do k = 1,pver + do i = 1,ncol + if(g_lambda(i,k) > 0._kind_phys) then ! This seems to be clue from microphysics of no cloud + call gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), & + tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k), errmsg, errflg) + else + tau(1:nswbands,i,k) = 0._kind_phys + tau_w(1:nswbands,i,k) = 0._kind_phys + tau_w_g(1:nswbands,i,k) = 0._kind_phys + tau_w_f(1:nswbands,i,k) = 0._kind_phys + endif + enddo + enddo + +end subroutine get_liquid_optics_sw + +!============================================================================== + +subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & + iciwpth, dei, g_d_eff, tau, tau_w, tau_w_g, tau_w_f) + use interpolate_data, only: interp_type, lininterp, lininterp_finish, extrap_method_bndry + + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nswbands + real(kind_phys), intent(in) :: iciwpth(:,:) + real(kind_phys), intent(in) :: dei(:,:) + real(kind_phys), intent(in) :: g_d_eff(:) + real(kind_phys), intent(in) :: ext_sw_ice(:,:) + real(kind_phys), intent(in) :: asm_sw_ice(:,:) + real(kind_phys), intent(in) :: ssa_sw_ice(:,:) + + real(kind_phys),intent(out) :: tau (:,:,:) ! extinction optical depth + real(kind_phys),intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau + real(kind_phys),intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w + real(kind_phys),intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w + + type(interp_type) :: dei_wgts + + integer :: i, k, swband + integer :: n_g_d + real(kind_phys) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + n_g_d = size(g_d_eff) + + do k = 1,pver + do i = 1,ncol + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._kind_phys) then + ! if ice water path is too small, OD := 0 + tau (:,i,k) = 0._kind_phys + tau_w (:,i,k) = 0._kind_phys + tau_w_g(:,i,k) = 0._kind_phys + tau_w_f(:,i,k) = 0._kind_phys + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(i:i,k), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do swband = 1, nswbands + call lininterp(ext_sw_ice(:,swband), n_g_d, & + ext(swband:swband), 1, dei_wgts) + call lininterp(ssa_sw_ice(:,swband), n_g_d, & + ssa(swband:swband), 1, dei_wgts) + call lininterp(asm_sw_ice(:,swband), n_g_d, & + asm(swband:swband), 1, dei_wgts) + end do + tau (:,i,k) = iciwpth(i,k) * ext + tau_w (:,i,k) = tau(:,i,k) * ssa + tau_w_g(:,i,k) = tau_w(:,i,k) * asm + tau_w_f(:,i,k) = tau_w_g(:,i,k) * asm + call lininterp_finish(dei_wgts) + endif + enddo + enddo + +end subroutine interpolate_ice_optics_sw + +!============================================================================== + +subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp + + integer, intent(in) :: nswbands + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) + real(kind_phys), intent(in) :: g_mu(:) + real(kind_phys), intent(in) :: g_lambda(:,:) + real(kind_phys), intent(in) :: lamc + real(kind_phys), intent(in) :: pgam + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(kind_phys), intent(out) :: tau(:), tau_w(:), tau_w_f(:), tau_w_g(:) + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: swband ! sw band index + + real(kind_phys) :: ext(nswbands), ssa(nswbands), asm(nswbands) + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + integer :: nmu, nlambda + + nmu = size(g_mu) + nlambda = size(g_lambda,2) + + ! Set error variables + errmsg = '' + errflg = 0 + + if (clwptn < tiny) then + tau = 0._kind_phys + tau_w = 0._kind_phys + tau_w_g = 0._kind_phys + tau_w_f = 0._kind_phys + return + endif + + call get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, & + mu_wgts, lambda_wgts, errmsg, errflg) + if (errflg /= 0) then + return + end if + + do swband = 1, nswbands + call lininterp(ext_sw_liq(:,:,swband), nmu, nlambda, & + ext(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(ssa_sw_liq(:,:,swband), nmu, nlambda, & + ssa(swband:swband), 1, mu_wgts, lambda_wgts) + call lininterp(asm_sw_liq(:,:,swband), nmu, nlambda, & + asm(swband:swband), 1, mu_wgts, lambda_wgts) + enddo + + ! compute radiative properties + tau = clwptn * ext + tau_w = tau * ssa + tau_w_g = tau_w * asm + tau_w_f = tau_w_g * asm + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + +end subroutine gam_liquid_sw + +!============================================================================== + +end module rrtmgp_sw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 new file mode 100644 index 00000000..28908270 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -0,0 +1,149 @@ +module rrtmgp_sw_mcica_subcol_gen + +implicit none +private +save + +public :: rrtmgp_sw_mcica_subcol_gen_run + +!================================================================================================== +contains +!================================================================================================== + +subroutine 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, pmid, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + + ! 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 + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object + integer, intent(in) :: nswbands + integer, intent(in) :: nswgpts + 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) :: pver + integer, intent(in) :: ktopcam + integer, intent(in) :: ktoprad + integer, intent(in) :: idxday(:) ! indices of daylight columns in the chunk + real(kind_phys), intent(in) :: tiny + real(kind_phys), intent(in) :: c_cld_tau(:,:,:) + real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) + real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) + real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction + real(kind_phys), intent(in) :: pmid(:,:) + logical, intent(in) :: dosw + + type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! SW cloud optical properties object + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + integer :: i, k, ncol + integer :: igpt, nver + integer :: istat + integer, parameter :: changeseed = 1 + character(len=256) :: alloc_errmsg + + ! Arrays for converting from CAM chunks to RRTMGP inputs. + real(kind_phys), allocatable :: cldf(:,:) + real(kind_phys), allocatable :: tauc(:,:,:) + real(kind_phys), allocatable :: ssac(:,:,:) + real(kind_phys), allocatable :: asmc(:,:,:) + real(kind_phys), allocatable :: taucmcl(:,:,:) + real(kind_phys), allocatable :: ssacmcl(:,:,:) + real(kind_phys), allocatable :: asmcmcl(:,:,:) + real(kind_phys), allocatable :: day_cld_tau(:,:,:) + real(kind_phys), allocatable :: day_cld_tau_w(:,:,:) + real(kind_phys), allocatable :: day_cld_tau_w_g(:,:,:) + !-------------------------------------------------------------------------------- + + ! if no daylight columns the cloud_sw object isn't initialized + if (nday > 0 .and. dosw) 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, errmsg=alloc_errmsg) + if (istat /= 0) then + errflg = 1 + write(errmsg,*) 'rrtmgp_sw_mcica_subcol_gen_run: failed to allocate variable(s) - message: ', alloc_errmsg + end if + + ! 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_kind_phys, day_cld_tau > 0.0_kind_phys) + ! set value of asymmetry + asmc = merge(day_cld_tau_w_g / max(day_cld_tau_w, tiny), 0.0_kind_phys, day_cld_tau_w > 0.0_kind_phys) + ! set value of single scattering albedo + ssac = merge(max(day_cld_tau_w, tiny) / max(tauc, tiny), 1.0_kind_phys , tauc > 0.0_kind_phys) + ! set asymmetry to zero when tauc = 0 + asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) + + ! 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) + + ! 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_kind_phys + cloud_sw%optical_props%ssa = 1.0_kind_phys + cloud_sw%optical_props%g = 0.0_kind_phys + + ! 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 + errflg = 1 + return + end if + + ! delta scaling adjusts for forward scattering + errmsg = cloud_sw%optical_props%delta_scale() + if (len_trim(errmsg) > 0) then + errflg = 1 + return + 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_sw_mcica_subcol_gen_run + +end module rrtmgp_sw_mcica_subcol_gen diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 new file mode 100644 index 00000000..2cecd8d2 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -0,0 +1,178 @@ +!------------------------------------------------------------------------------- +! 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 +!------------------------------------------------------------------------------- +! peverwhee - dependencies = radiation_utils, mo_util +module rrtmgp_sw_solar_var + + use ccpp_kinds, only : kind_phys + + implicit none + save + + private + public :: rrtmgp_sw_solar_var_init + public :: rrtmgp_sw_solar_var_run + + real(kind_phys), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + + real(kind_phys), allocatable :: radbinmax(:) + real(kind_phys), allocatable :: radbinmin(:) + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + + subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + integer, intent(in) :: nswbands + logical, intent(in) :: do_spctrl_scaling + logical, intent(in) :: has_spectrum + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: radmax_loc + character(len=256) :: alloc_errmsg + + if ( do_spctrl_scaling ) then + + if ( .not.has_spectrum ) then + write(errmsg, *) 'rrtmgp_sw_solar_var_init: solar input fil must have irradiance spectrum' + errflg = 1 + return + endif + + allocate (radbinmax(nswbands),stat=errflg,errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for radbinmax - message: ', alloc_errmsg + return + end if + + allocate (radbinmin(nswbands),stat=errflg,errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for radbinmin - message: ', alloc_errmsg + return + end if + + allocate (irrad(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for irrad - message: ', alloc_errmsg + return + end if + + call get_sw_spectral_boundaries_ccpp(radbinmin, radbinmax, 'nm', errmsg, errflg) + if (errflg /= 0) then + return + 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._kind_phys,radbinmax(radmax_loc)) + + endif + + end subroutine rrtmgp_sw_solar_var_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & + sfac, errmsg, errflg) + + ! Arguments + real(kind_phys), intent(in) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) + real(kind_phys), intent(in) :: sol_tsi + real(kind_phys), intent(in) :: sol_irrad(:) + real(kind_phys), intent(in) :: we(:) + integer, intent(in) :: nbins + integer, intent(in) :: band2gpt_sw(:,:) + integer, intent(in) :: nswbands + logical, intent(in) :: do_spctrl_scaling + real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, j, gpt_start, gpt_end, ncols + real(kind_phys), allocatable :: scale(:) + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'rrtmgp_sw_solar_var_run' + + ! Initialize error variables + errflg = 0 + errmsg = '' + + 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=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) sub, ': Error allocating "scale", message - ', alloc_errmsg + errflg = 1 + return + end if + + 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 rrtmgp_sw_solar_var_run + + +!------------------------------------------------------------------------------- +! 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(kind_phys), intent(in) :: src_x(nsrc+1) ! source coordinates + real(kind_phys), intent(in) :: max_trg(ntrg) ! target coordinates + real(kind_phys), intent(in) :: min_trg(ntrg) ! target coordinates + real(kind_phys), intent(in) :: src(nsrc) ! source array + real(kind_phys), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + real(kind_phys) :: 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 rrtmgp_sw_solar_var From 6e4e4938126c872a5fde124138a32ad12bb4f9d9 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 8 Jul 2025 16:55:36 -0600 Subject: [PATCH 049/140] working cloud optics and mcica subcol gen modules --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 40 ++----- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 104 ++++++++++++++++-- 2 files changed, 108 insertions(+), 36 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 4a404ab2..deedf4ac 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -28,16 +28,14 @@ module rrtmgp_sw_cloud_optics !================================================================================================== subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & - nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & - snow_tau, degrau, dei, des, iclwpth, icswpth, icgrauwpth, tiny_in, 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, & + nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & + snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, 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, c_cld_tau_w, c_cld_tau_w_g, & tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp ! 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 integer, intent(in) :: nlay ! number of layers in radiation calculation (may include "extra layer") @@ -69,6 +67,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, real(kind_phys), intent(in) :: des(:,:) real(kind_phys), intent(in) :: degrau(:,:) real(kind_phys), intent(in) :: iclwpth(:,:) + real(kind_phys), intent(in) :: iciwpth(:,:) real(kind_phys), intent(in) :: icswpth(:,:) real(kind_phys), intent(in) :: icgrauwpth(:,:) real(kind_phys), intent(in) :: cld(:,:) ! cloud fraction (liq+ice) @@ -83,13 +82,12 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, real(kind_phys), intent(in) :: ssa_sw_ice(:,:) class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object - real(kind_phys), intent(out) :: cld_tau(:,:,:) ! snow extinction optical depth + real(kind_phys), intent(out) :: cld_tau(:,:,:) ! real(kind_phys), intent(out) :: snow_tau(:,:,:) ! snow extinction optical depth - real(kind_phys), intent(out) :: grau_tau(:,:,:) ! snow extinction optical depth + real(kind_phys), intent(out) :: grau_tau(:,:,:) ! real(kind_phys), intent(out) :: c_cld_tau(:,:,:) ! combined cloud extinction optical depth real(kind_phys), intent(out) :: c_cld_tau_w (:,:,:) ! combined cloud single scattering albedo * tau real(kind_phys), intent(out) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau - type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object ! Diagnostic outputs real(kind_phys), intent(out) :: tot_cld_vistau(:,:) ! gbx total cloud optical depth @@ -111,14 +109,14 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, integer, parameter :: changeseed = 1 ! cloud radiative parameters are "in cloud" not "in cell" + real(kind_phys) :: liq_tau (nswbands,ncol,pver) ! liquid extinction optical depth + real(kind_phys) :: liq_tau_w (nswbands,ncol,pver) ! liquid single scattering albedo * tau + real(kind_phys) :: liq_tau_w_g(nswbands,ncol,pver) ! liquid asymmetry parameter * tau * w real(kind_phys) :: ice_tau (nswbands,ncol,pver) ! ice extinction optical depth real(kind_phys) :: ice_tau_w (nswbands,ncol,pver) ! ice single scattering albedo * tau real(kind_phys) :: ice_tau_w_g(nswbands,ncol,pver) ! ice asymmetry parameter * tau * w real(kind_phys) :: snow_tau_w (nswbands,ncol,pver) ! snow single scattering albedo * tau real(kind_phys) :: snow_tau_w_g(nswbands,ncol,pver) ! snow asymmetry parameter * tau * w - real(kind_phys) :: liq_tau (nswbands,ncol,pver) ! liquid optical depth - real(kind_phys) :: liq_tau_w (nswbands,ncol,pver) ! liquid single scattering albedo * tau - real(kind_phys) :: liq_tau_w_g(nswbands,ncol,pver) ! liquid asymmetry parameter * tau * w real(kind_phys) :: cld_tau_w (nswbands,ncol,pver) ! cloud single scattering albedo * tau real(kind_phys) :: cld_tau_w_g(nswbands,ncol,pver) ! cloud asymmetry parameter * w * tau real(kind_phys) :: grau_tau_w (nswbands,ncol,pver) ! graupel single scattering albedo * tau @@ -156,7 +154,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, return end if ! Mitchell ice optics - call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, dei, g_d_eff, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iciwpth, dei, g_d_eff, 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,:) @@ -251,20 +249,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, end if end do - ! 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 - - ! 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 - - end if - end subroutine rrtmgp_sw_cloud_optics_run !============================================================================== @@ -333,7 +317,7 @@ subroutine get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ss do k = 1,pver do i = 1,ncol - if(g_lambda(i,k) > 0._kind_phys) then ! This seems to be clue from microphysics of no cloud + if(lamc(i,k) > 0._kind_phys) then ! This seems to be clue from microphysics of no cloud call gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), & tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k), errmsg, errflg) else @@ -351,7 +335,7 @@ end subroutine get_liquid_optics_sw subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & iciwpth, dei, g_d_eff, tau, tau_w, tau_w_g, tau_w_f) - use interpolate_data, only: interp_type, lininterp, lininterp_finish, extrap_method_bndry + use interpolate_data, only: interp_type, lininterp, lininterp_init, lininterp_finish, extrap_method_bndry integer, intent(in) :: ncol integer, intent(in) :: pver diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 28908270..27f0b8d9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -1,4 +1,5 @@ module rrtmgp_sw_mcica_subcol_gen +use cam_logfile, only: iulog implicit none private @@ -17,6 +18,8 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use shr_RandNum_mod, only: ShrKissRandGen + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! Compute combined cloud optical properties. ! Create MCICA stochastic arrays for cloud SW optical properties. @@ -46,11 +49,19 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! Local variables - integer :: i, k, ncol - integer :: igpt, nver + integer :: i, k, n + integer :: igpt, nver, isubcol integer :: istat integer, parameter :: changeseed = 1 character(len=256) :: alloc_errmsg + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(nday,4) + real(kind_phys) :: rand_num_1d(nday,1) ! random number (kissvec) + real(kind_phys) :: rand_num(nday,pver-ktopcam+1) ! random number (kissvec) + logical :: iscloudy(nswgpts,nday,pver-ktopcam+1) ! flag that says whether a gridbox is cloudy + real(kind_phys), parameter :: cldmin = 1.0e-80_kind_phys ! min cloud fraction + real(kind_phys) :: cdf(nswgpts,nday,pver-ktopcam+1) + real(kind_phys) :: cldfrac(nday,pver-ktopcam+1) ! Cloud fraction clipped to cldmin ! Arrays for converting from CAM chunks to RRTMGP inputs. real(kind_phys), allocatable :: cldf(:,:) @@ -68,6 +79,12 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! if no daylight columns the cloud_sw object isn't initialized if (nday > 0 .and. dosw) then + ! 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 + errflg = 1 + end if + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". nver = pver - ktopcam + 1 @@ -82,6 +99,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda if (istat /= 0) then errflg = 1 write(errmsg,*) 'rrtmgp_sw_mcica_subcol_gen_run: failed to allocate variable(s) - message: ', alloc_errmsg + return end if ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the @@ -103,12 +121,82 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) - ! 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) - + ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + nver = pver - ktopcam + 1 + + ! clip cloud fraction + cldfrac(:,:) = cldf(:nday,:) + where (cldfrac(:,:) < cldmin) + cldfrac(:,:) = 0._kind_phys + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do i = 1, nday + kiss_seed(i,1) = (pmid(i,nlay) - int(pmid(i,nlay))) * 1000000000 + kiss_seed(i,2) = (pmid(i,nlay-1) - int(pmid(i,nlay-1))) * 1000000000 + kiss_seed(i,3) = (pmid(i,nlay-2) - int(pmid(i,nlay-2))) * 1000000000 + kiss_seed(i,4) = (pmid(i,nlay-3) - int(pmid(i,nlay-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do i = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,nswgpts + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do k = 2, nver + do i = 1, nday + do isubcol = 1, nswgpts + if (cdf(isubcol,i,k-1) > 1._kind_phys - cldfrac(i,k-1) ) then + cdf(isubcol,i,k) = cdf(isubcol,i,k-1) + else + cdf(isubcol,i,k) = cdf(isubcol,i,k) * (1._kind_phys - cldfrac(i,k-1)) + end if + end do + end do + end do + + do k = 1, nver + iscloudy(:,:,k) = (cdf(:,:,k) >= 1._kind_phys - spread(cldfrac(:,k), dim=1, nCopies=nswgpts) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do k = 1,nver + do i = 1,nday + do isubcol = 1,nswgpts + if (iscloudy(isubcol,i,k) .and. (cldfrac(i,k) > 0._kind_phys) ) then + n = kdist_sw%gas_props%convert_gpt2band(isubcol) + taucmcl(isubcol,i,k) = tauc(n,i,k) + ssacmcl(isubcol,i,k) = ssac(n,i,k) + asmcmcl(isubcol,i,k) = asmc(n,i,k) + else + taucmcl(isubcol,i,k) = 0._kind_phys + ssacmcl(isubcol,i,k) = 1._kind_phys + asmcmcl(isubcol,i,k) = 0._kind_phys + end if + end do + end do + end do + + call kiss_gen%finalize() + ! 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_kind_phys From 91358211a4390c05729dc994762f9e6b8641a614 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 10 Jul 2025 14:09:16 -0600 Subject: [PATCH 050/140] working gas optics run and modified solar var --- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 57 +++++++++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 28 ++++++------ 2 files changed, 73 insertions(+), 12 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index a2a3bef3..a0a075b7 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -8,6 +8,7 @@ module rrtmgp_sw_gas_optics implicit none private public :: rrtmgp_sw_gas_optics_init + public :: rrtmgp_sw_gas_optics_run contains @@ -323,4 +324,60 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end subroutine rrtmgp_sw_gas_optics_init +!> \section arg_table_rrtmgp_sw_gas_optics_run Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_run.html +!! + subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, & + gas_concs, sw_optical_props, sw_gas_props, toa_src_sw, errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use radiation_tools, only: check_error_msg + ! Inputs + logical, intent(in) :: dosw !< Flag for whether to perform longwave calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object + real(kind_phys), intent(out) :: toa_src_sw(:,:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + errmsg = sw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props%optical_props, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw) ! OUT - TOA incident shortwave radiation (spectral) + + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_sw_gas_optics_run + end module rrtmgp_sw_gas_optics diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 2cecd8d2..a6802b70 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -81,20 +81,21 @@ end subroutine rrtmgp_sw_solar_var_init !------------------------------------------------------------------------------- subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & - sfac, errmsg, errflg) + sfac, eccf, errmsg, errflg) ! Arguments - real(kind_phys), intent(in) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) - real(kind_phys), intent(in) :: sol_tsi - real(kind_phys), intent(in) :: sol_irrad(:) - real(kind_phys), intent(in) :: we(:) - integer, intent(in) :: nbins - integer, intent(in) :: band2gpt_sw(:,:) - integer, intent(in) :: nswbands - logical, intent(in) :: do_spctrl_scaling - real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg + real(kind_phys), intent(inout) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) + real(kind_phys), intent(in) :: sol_tsi + real(kind_phys), intent(in) :: sol_irrad(:) + real(kind_phys), intent(in) :: we(:) + integer, intent(in) :: nbins + integer, intent(in) :: band2gpt_sw(:,:) + integer, intent(in) :: nswbands + logical, intent(in) :: do_spctrl_scaling + real(kind_phys), intent(in) :: eccf + real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables integer :: i, j, gpt_start, gpt_end, ncols @@ -131,6 +132,9 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, w else sfac(:,:) = sol_tsi / spread(sum(toa_flux, 2), 2, size(toa_flux, 2)) end if + + toa_flux = toa_flux * sfac * eccf + end subroutine rrtmgp_sw_solar_var_run From 74c16d2905c6945ba210103494971fc48aca34f2 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 11 Jul 2025 12:31:21 -0600 Subject: [PATCH 051/140] address reviewer comments --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 10 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 131 ++++++++++----- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 150 ++++++++++++------ .../utils/rrtmgp_cloud_optics_setup.F90 | 49 ++++-- 4 files changed, 230 insertions(+), 110 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 3c7c4e01..160fd55a 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -37,7 +37,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation - logical, intent(in) :: is_root ! Flag for whether this is the root task + logical, intent(in) :: is_root ! Flag for whether this is the root MPI task ! Outputs integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active @@ -96,8 +96,8 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw nlaycam = pver nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp if (is_root) then - write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' - write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp + write(iulog,*) 'RADIATION: rrtmgp_inputs_setup_init: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION: rrtmgp_inputs_setup_init: nlay = ',nlay, ' same as pverp: ',nlay==pverp end if else ! nlay < pverp. nlay layers are used in radiation calcs, and they are @@ -124,7 +124,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw end if ! Initialize the SW band boundaries - call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) + call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm-1', errmsg, errflg) if (errflg /= 0) then return end if @@ -342,7 +342,7 @@ subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_l end do if (ans == 0) then - write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + write(errmsg,'(a,f10.3,a,a)') 'rrtmgp_inputs_setup: get_band_index_by_value: no index found for wavelength ', targetvalue, ' ', trim(units) errflg = 1 end if diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 593c5dac..8f2572cf 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -34,7 +34,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), allocatable :: pio_reader + class(abstract_netcdf_reader_t), allocatable :: file_reader character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas @@ -70,6 +70,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable + integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg integer :: idx @@ -77,122 +78,122 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & errmsg = '' errcode = 0 - pio_reader = create_netcdf_reader_t() + file_reader = create_netcdf_reader_t() ! Open the longwave coefficients file - call pio_reader%open_file(lw_filename, errmsg, errcode) + call file_reader%open_file(lw_filename, errmsg, errcode) if (errcode /= 0) then return end if ! Read the coefficients from the file - call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + call file_reader%get_var('gas_names', gas_names, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('key_species', key_species, errmsg, errcode) + call file_reader%get_var('key_species', key_species, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + call file_reader%get_var('press_ref', press_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + call file_reader%get_var('temp_ref', temp_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + call file_reader%get_var('kmajor', kmajor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('totplnk', totplnk, errmsg, errcode) + call file_reader%get_var('totplnk', totplnk, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) + call file_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) + call file_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) ! OK if variable is not on file if (errcode /= 0 .and. errcode /= 3) then return end if - if (errcode /= 3) then + if (errcode /= missing_variable_error_code) then allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) rayl_lower_allocatable = rayl_lower end if - call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then + if (errcode /= 0 .and. errcode /= missing_variable_error_code) then return end if - if (errcode /= 3) then + if (errcode /= missing_variable_error_code) then allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) rayl_upper_allocatable = rayl_upper end if - call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + call file_reader%get_var('gas_minor', gas_minor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -202,14 +203,15 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then minor_scales_with_density_lower(idx) = .false. else minor_scales_with_density_lower(idx) = .true. end if end do deallocate(int2log) - call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -226,7 +228,8 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -243,7 +246,8 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -260,25 +264,26 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) if (errcode /= 0) then return end if ! Close the longwave coefficients file - call pio_reader%close_file(errmsg, errcode) + call file_reader%close_file(errmsg, errcode) if (errcode /= 0) then return end if @@ -306,6 +311,52 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) + ! Deallocate pointer variables + deallocate(gas_names, gas_minor, identifier_minor, minor_gases_lower, minor_gases_upper, & + scaling_gas_lower, scaling_gas_upper, key_species, band2gpt, minor_limits_gpt_lower, & + minor_limits_gpt_upper, kminor_start_lower, kminor_start_upper, minor_scales_with_density_lower, & + minor_scales_with_density_upper, scale_by_complement_lower, scale_by_complement_upper, & + kmajor, planck_frac, kminor_lower, kminor_upper, vmr_ref, band_lims_wavenum, totplnk, & + optimal_angle_fit, press_ref, temp_ref, press_ref_trop, temp_ref_p, temp_ref_t) + nullify(gas_names) + nullify(gas_minor) + nullify(identifier_minor) + nullify(minor_gases_lower) + nullify(minor_gases_upper) + nullify(scaling_gas_lower) + nullify(scaling_gas_upper) + nullify(key_species) + nullify(band2gpt) + nullify(minor_limits_gpt_lower) + nullify(minor_limits_gpt_upper) + nullify(kminor_start_lower) + nullify(kminor_start_upper) + nullify(minor_scales_with_density_lower) + nullify(minor_scales_with_density_upper) + nullify(scale_by_complement_lower) + nullify(scale_by_complement_upper) + nullify(kmajor) + nullify(planck_frac) + nullify(kminor_lower) + nullify(kminor_upper) + nullify(vmr_ref) + nullify(band_lims_wavenum) + nullify(totplnk) + nullify(optimal_angle_fit) + nullify(press_ref) + nullify(temp_ref) + nullify(press_ref_trop) + nullify(temp_ref_p) + nullify(temp_ref_t) + if (associated(rayl_lower)) then + deallocate(rayl_lower) + nullify(rayl_lower) + end if + if (associated(rayl_upper)) then + deallocate(rayl_upper) + nullify(rayl_upper) + end if + end subroutine rrtmgp_lw_gas_optics_init !> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index a2a3bef3..17f8f6bc 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -9,7 +9,6 @@ module rrtmgp_sw_gas_optics private public :: rrtmgp_sw_gas_optics_init - contains !> \section arg_table_rrtmgp_sw_gas_optics_init Argument Table !! \htmlinclude rrtmgp_sw_gas_optics_init.html @@ -24,7 +23,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & use mo_rte_kind, only: wl ! Inputs - character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file + character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP shortwave coefficients file class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs @@ -33,7 +32,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), allocatable :: pio_reader + class(abstract_netcdf_reader_t), allocatable :: file_reader character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas @@ -72,6 +71,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg integer :: idx @@ -79,134 +79,134 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & errmsg = '' errcode = 0 - pio_reader = create_netcdf_reader_t() + file_reader = create_netcdf_reader_t() - ! Open the longwave coefficients file - call pio_reader%open_file(sw_filename, errmsg, errcode) + ! Open the shortwave coefficients file + call file_reader%open_file(sw_filename, errmsg, errcode) if (errcode /= 0) then return end if ! Read the coefficients from the file - call pio_reader%get_var('gas_names', gas_names, errmsg, errcode) + call file_reader%get_var('gas_names', gas_names, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('key_species', key_species, errmsg, errcode) + call file_reader%get_var('key_species', key_species, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('press_ref', press_ref, errmsg, errcode) + call file_reader%get_var('press_ref', press_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('temp_ref', temp_ref, errmsg, errcode) + call file_reader%get_var('temp_ref', temp_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kmajor', kmajor, errmsg, errcode) + call file_reader%get_var('kmajor', kmajor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) + call file_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) + call file_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) + call file_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('tsi_default', tsi_default, errmsg, errcode) + call file_reader%get_var('tsi_default', tsi_default, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('mg_default', mg_default, errmsg, errcode) + call file_reader%get_var('mg_default', mg_default, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('sb_default', sb_default, errmsg, errcode) + call file_reader%get_var('sb_default', sb_default, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then + if (errcode /= 0 .and. errcode /= missing_variable_error_code) then return end if - if (errcode /= 3) then + if (errcode /= missing_variable_error_code) then allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) rayl_lower_allocatable = rayl_lower end if - call pio_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then + if (errcode /= 0 .and. errcode /= missing_variable_error_code) then return end if - if (errcode /= 3) then + if (errcode /= missing_variable_error_code) then allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) rayl_upper_allocatable = rayl_upper end if - call pio_reader%get_var('gas_minor', gas_minor, errmsg, errcode) + call file_reader%get_var('gas_minor', gas_minor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -216,14 +216,15 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then minor_scales_with_density_lower(idx) = .false. else minor_scales_with_density_lower(idx) = .true. end if end do deallocate(int2log) - call pio_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -240,7 +241,8 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -257,7 +259,8 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) if (errcode /= 0) then return end if @@ -274,25 +277,26 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call pio_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) + nullify(int2log) + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) if (errcode /= 0) then return end if - call pio_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) if (errcode /= 0) then return end if - ! Close the longwave coefficients file - call pio_reader%close_file(errmsg, errcode) + ! Close the shortwave coefficients file + call file_reader%close_file(errmsg, errcode) if (errcode /= 0) then return end if @@ -321,6 +325,56 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) + ! Deallocate pointer variables + deallocate(gas_names, gas_minor, identifier_minor, minor_gases_lower, minor_gases_upper, & + scaling_gas_lower, scaling_gas_upper, key_species, band2gpt, minor_limits_gpt_lower, & + minor_limits_gpt_upper, kminor_start_lower, kminor_start_upper, minor_scales_with_density_lower, & + minor_scales_with_density_upper, scale_by_complement_lower, scale_by_complement_upper, & + kmajor, kminor_lower, kminor_upper, vmr_ref, band_lims_wavenum, solar_src_quiet, & + solar_src_facular, solar_src_sunspot, mg_default, sb_default, tsi_default, press_ref, temp_ref, & + press_ref_trop, temp_ref_p, temp_ref_t) + nullify(gas_names) + nullify(gas_minor) + nullify(identifier_minor) + nullify(minor_gases_lower) + nullify(minor_gases_upper) + nullify(scaling_gas_lower) + nullify(scaling_gas_upper) + nullify(key_species) + nullify(band2gpt) + nullify(minor_limits_gpt_lower) + nullify(minor_limits_gpt_upper) + nullify(kminor_start_lower) + nullify(kminor_start_upper) + nullify(minor_scales_with_density_lower) + nullify(minor_scales_with_density_upper) + nullify(scale_by_complement_lower) + nullify(scale_by_complement_upper) + nullify(kmajor) + nullify(solar_src_quiet) + nullify(solar_src_facular) + nullify(solar_src_sunspot) + nullify(mg_default) + nullify(sb_default) + nullify(tsi_default) + nullify(kminor_lower) + nullify(kminor_upper) + nullify(vmr_ref) + nullify(band_lims_wavenum) + nullify(press_ref) + nullify(temp_ref) + nullify(press_ref_trop) + nullify(temp_ref_p) + nullify(temp_ref_t) + if (associated(rayl_lower)) then + deallocate(rayl_lower) + nullify(rayl_lower) + end if + if (associated(rayl_upper)) then + deallocate(rayl_upper) + nullify(rayl_upper) + end if + end subroutine rrtmgp_sw_gas_optics_init end module rrtmgp_sw_gas_optics diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index 865ce94e..b5b8c517 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -46,7 +46,7 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq integer, intent(out) :: errflg ! Local variables - class(abstract_netcdf_reader_t), allocatable :: pio_reader + class(abstract_netcdf_reader_t), allocatable :: file_reader real(kind_phys), dimension(:), pointer :: g_mu real(kind_phys), dimension(:), pointer :: g_d_eff real(kind_phys), dimension(:,:), pointer :: g_lambda @@ -65,42 +65,42 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq errmsg = '' errflg = 0 - pio_reader = create_netcdf_reader_t() + file_reader = create_netcdf_reader_t() ! Open liquid optics file - call pio_reader%open_file(liq_filename, errmsg, errflg) + call file_reader%open_file(liq_filename, errmsg, errflg) if (errflg /= 0) then return end if ! Read in variables - call pio_reader%get_var('mu', g_mu, errmsg, errflg) + call file_reader%get_var('mu', g_mu, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('lambda', g_lambda, errmsg, errflg) + call file_reader%get_var('lambda', g_lambda, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('k_ext_sw', ext_sw_liq, errmsg, errflg) + call file_reader%get_var('k_ext_sw', ext_sw_liq, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('ssa_sw', ssa_sw_liq, errmsg, errflg) + call file_reader%get_var('ssa_sw', ssa_sw_liq, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('asm_sw', asm_sw_liq, errmsg, errflg) + call file_reader%get_var('asm_sw', asm_sw_liq, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('k_abs_lw', abs_lw_liq, errmsg, errflg) + call file_reader%get_var('k_abs_lw', abs_lw_liq, errmsg, errflg) if (errflg /= 0) then return end if ! Close the liquid optics file - call pio_reader%close_file(errmsg, errflg) + call file_reader%close_file(errmsg, errflg) if (errflg /= 0) then return end if @@ -110,35 +110,35 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq abs_lw_liq = abs_lw_liq / 0.9970449e3_kind_phys ! Open the ice optics file - call pio_reader%open_file(ice_filename, errmsg, errflg) + call file_reader%open_file(ice_filename, errmsg, errflg) if (errflg /= 0) then return end if ! Read in variables - call pio_reader%get_var('d_eff', g_d_eff, errmsg, errflg) + call file_reader%get_var('d_eff', g_d_eff, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('sw_ext', ext_sw_ice, errmsg, errflg) + call file_reader%get_var('sw_ext', ext_sw_ice, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('sw_ssa', ssa_sw_ice, errmsg, errflg) + call file_reader%get_var('sw_ssa', ssa_sw_ice, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('sw_asm', asm_sw_ice, errmsg, errflg) + call file_reader%get_var('sw_asm', asm_sw_ice, errmsg, errflg) if (errflg /= 0) then return end if - call pio_reader%get_var('lw_abs', abs_lw_ice, errmsg, errflg) + call file_reader%get_var('lw_abs', abs_lw_ice, errmsg, errflg) if (errflg /= 0) then return end if ! Close the ice optics file - call pio_reader%close_file(errmsg, errflg) + call file_reader%close_file(errmsg, errflg) if (errflg /= 0) then return end if @@ -212,6 +212,21 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq g_lambda_out = g_lambda g_d_eff_out = g_d_eff + ! Deallocate pointer variables + deallocate(g_mu, g_d_eff, g_lambda, ext_sw_ice, ssa_sw_ice, asm_sw_ice, abs_lw_ice, ext_sw_liq, & + ssa_sw_liq, asm_sw_liq, abs_lw_liq) + nullify(g_mu) + nullify(g_d_eff) + nullify(g_lambda) + nullify(ext_sw_ice) + nullify(ssa_sw_ice) + nullify(asm_sw_ice) + nullify(abs_lw_ice) + nullify(ext_sw_liq) + nullify(ssa_sw_liq) + nullify(asm_sw_liq) + nullify(abs_lw_liq) + end subroutine rrtmgp_cloud_optics_setup_init !============================================================================== From 67617d391f0597226e69d8d6c6a044cab005e9d1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 11 Jul 2025 12:36:41 -0600 Subject: [PATCH 052/140] change remaining .eq. references --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 6 +++--- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 8f2572cf..93d29bc0 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -221,7 +221,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then scale_by_complement_lower(idx) = .false. else scale_by_complement_lower(idx) = .true. @@ -239,7 +239,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then minor_scales_with_density_upper(idx) = .false. else minor_scales_with_density_upper(idx) = .true. @@ -257,7 +257,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then scale_by_complement_upper(idx) = .false. else scale_by_complement_upper(idx) = .true. diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 17f8f6bc..d6b2292c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -234,7 +234,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then scale_by_complement_lower(idx) = .false. else scale_by_complement_lower(idx) = .true. @@ -252,7 +252,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then minor_scales_with_density_upper(idx) = .false. else minor_scales_with_density_upper(idx) = .true. @@ -270,7 +270,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & return end if do idx = 1, size(int2log) - if (int2log(idx) .eq. 0) then + if (int2log(idx) == 0) then scale_by_complement_upper(idx) = .false. else scale_by_complement_upper(idx) = .true. From 90efd1e61774cf2ae981fea67da8c4acc3dc1afe Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 11 Jul 2025 12:38:52 -0600 Subject: [PATCH 053/140] missing parameter reference --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 93d29bc0..51c4ba48 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -153,7 +153,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= 3) then + if (errcode /= 0 .and. errcode /= missing_variable_error_code) then return end if if (errcode /= missing_variable_error_code) then From 3d5a016dce00ece748ed89b8c1670ff1e0892848 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 11 Jul 2025 15:56:25 -0600 Subject: [PATCH 054/140] working shortwave gas optics pre --- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 3 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 185 ++++++++++++++++++++ 2 files changed, 186 insertions(+), 2 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index c9796cda..e9101648 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -10,7 +10,7 @@ module rrtmgp_lw_gas_optics_pre !> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table !! \htmlinclude rrtmgp_lw_gas_optics_pre_run.html !! - subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & + subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, & pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_concentrations, only: ty_gas_concs_ccpp @@ -21,7 +21,6 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: pverp ! Total number of layer interfaces - integer, intent(in) :: idxday(:) ! Indices of daylight columns integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: nradgas ! Number of radiatively active gases diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 new file mode 100644 index 00000000..ae60e084 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -0,0 +1,185 @@ +module rrtmgp_sw_gas_optics_pre + + implicit none + private + + public :: rrtmgp_sw_gas_optics_pre_run + +contains + +!> \section arg_table_rrtmgp_sw_gas_optics_pre_run Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_pre_run.html +!! + subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, gaslist, idxday, & + pverp, ktoprad, ktopcam, dosw, nradgas, gas_concs, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + + ! Set gas vmr for the gases in the radconstants module's gaslist. + + character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + integer, intent(in) :: nlay ! Number of layers in radiation calculation + integer, intent(in) :: nday ! Total number of daylight columns + integer, intent(in) :: pverp ! Total number of layer interfaces + integer, intent(in) :: idxday(:) ! Indices of daylight columns + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: nradgas ! Number of radiatively active gases + logical, intent(in) :: dosw ! Flag for whether to perform longwave calculaion + real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa] + real(kind_phys), intent(in) :: rad_const_array(:,:,:) ! array of radiatively-active constituent vmrs + ! last index corresponds to index in gaslist + + type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, gas_idx, idx(nday) + integer :: istat + real(kind_phys), allocatable :: gas_mmr(:,:) + real(kind_phys), allocatable :: gas_vmr(:,:) + real(kind_phys) :: mmr(nday, nlay) + real(kind_phys) :: massratio + character(len=256) :: alloc_errmsg + + ! For ozone profile above model + real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=*), parameter :: sub = 'rrtmgp_sw_gas_optics_pre_run' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw) then + return + end if + + allocate(gas_mmr(nday, pverp-1)) + allocate(gas_vmr(nday, nlay)) + ! Check allocate + + ! set the column indices + do i = 1, nday + idx(i) = idxday(i) + end do + + do gas_idx = 1, nradgas + + ! grab mass mixing ratio of gas + gas_mmr = rad_const_array(:,:,gas_idx) + + do i = 1, nday + 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 (gaslist(gas_idx) == 'H2O') then + mmr = mmr / (1._kind_phys - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + call get_molar_mass_ratio(gaslist(gas_idx), massratio, errmsg, errflg) + if (errflg /= 0) then + return + end if + 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 ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_kind_phys + do i = 1, nday + P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = 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._kind_phys + alpha) * exp(-alpha) - 1._kind_phys ) / alpha + b = 1._kind_phys - 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._kind_phys + 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(gaslist(gas_idx), gas_vmr) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end do + + end subroutine rrtmgp_sw_gas_optics_pre_run + +!========================================================================================= + + subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*), intent(in) :: gas_name + real(kind_phys), intent(out) :: massratio + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor + real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide + real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone + real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane + real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide + real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen + real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 + real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + 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 + write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) + errflg = 1 + end select + +end subroutine get_molar_mass_ratio + +end module rrtmgp_sw_gas_optics_pre From 1a677317ed64a4016d37f794b795cc12324b03dd Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Sun, 13 Jul 2025 12:34:39 -0600 Subject: [PATCH 055/140] working sw main rte --- schemes/rrtmgp/rrtmgp_lw_main.F90 | 16 +--- schemes/rrtmgp/rrtmgp_sw_main.F90 | 121 ++++++++++++++++++++++++++++++ 2 files changed, 124 insertions(+), 13 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_main.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 index cadbc7f7..dbf2f749 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -13,14 +13,13 @@ module rrtmgp_lw_main !! \htmlinclude rrtmgp_lw_main_run.html !! subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & - nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & - lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & - aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + nGauss_angles, lw_optical_props_clrsky, lw_optical_props_clouds, top_at_1, & + sources, sfc_emiss_byband, lw_gas_props, aerlw, fluxlwUP_jac, lw_Ds, & + flux_clrsky, flux_allsky, errmsg, errflg) use machine, only: kind_phys use mo_rte_lw, only: rte_lw use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_source_functions, only: ty_source_func_lw_ccpp @@ -35,9 +34,6 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used - integer, intent(in) :: nCol !< Number of horizontal points - integer, intent(in) :: iter_num !< Radiation subcycle iteration number - integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object @@ -56,18 +52,12 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, character(len=*), intent(out) :: errmsg !< CCPP error message integer, intent(out) :: errflg !< CCPP error flag - ! Local variables - integer :: iCol, iCol2 - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. doLWrad) return - iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 - iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nCol) - ! ################################################################################### ! ! Compute clear-sky fluxes (gaseous+aerosol) (optional) diff --git a/schemes/rrtmgp/rrtmgp_sw_main.F90 b/schemes/rrtmgp/rrtmgp_sw_main.F90 new file mode 100644 index 00000000..3bfc39ba --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_main.F90 @@ -0,0 +1,121 @@ +!> \file rrtmgp_sw_main.F90 +!! + +!> This module contains the call to the RRTMGP-sw radiation routine +module rrtmgp_sw_main + implicit none + private + + public rrtmgp_sw_main_run +contains + +!> \section arg_table_rrtmgp_sw_main_run Argument Table +!! \htmlinclude rrtmgp_sw_main_run.html +!! + subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & + sw_optical_props_clouds, top_at_1, aersw, coszen, toa_src_sw, & + sfc_alb_dir, sfc_alb_dif, flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_sw, only: rte_sw + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use radiation_tools, only: check_error_msg + + ! Inputs + logical, intent(in) :: doswrad !< Flag to perform longwave calculation + logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes + logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention + + integer, intent(in) :: nday !< Number of horizontal daylight points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif + real(kind_phys), dimension(:), intent(in) :: coszen + + ! Outputs + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_2str_ccpp), intent(inout) :: aersw !< Aerosol optical properties object + class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clear-sky optical properties object + class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props_clouds !< Cloud optical properties object + + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Local variables + integer :: iCol, iCol2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doswrad) return + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nday) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) + ! + ! ################################################################################### + ! Increment optics (always) + errmsg = aersw%optical_props%increment(sw_optical_props%optical_props) + call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Optionally compute clear-sky fluxes + if (doswclrsky) then + call check_error_msg('rrtmgp_sw_main_rte_sw_clrsky',rte_sw( & + sw_optical_props%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + + if (doswallsky) then + ! Delta scale + !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) + + ! Increment + call check_error_msg('rrtmgp_sw_main_increment_clouds_to_clrsky', & + sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props)) + + ! Compute fluxes + call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & + sw_optical_props%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + + end subroutine rrtmgp_sw_main_run +end module rrtmgp_sw_main From 912bec257dfab3d5c90589e4ecace18a5ce5fe10 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 12:03:45 -0600 Subject: [PATCH 056/140] update comments --- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 12 +-- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 54 +--------- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 99 ++++++++++--------- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 52 +++++----- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 53 +--------- schemes/rrtmgp/rrtmgp_sw_main.F90 | 26 ++--- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 27 +++-- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 26 ++--- schemes/rrtmgp/utils/radiation_utils.F90 | 51 ++++++++++ 9 files changed, 174 insertions(+), 226 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index baa56fe4..163afb76 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -52,12 +52,12 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel - real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice - real(kind_phys), dimension(:,:), intent(in) :: g_lambda - real(kind_phys), dimension(:), intent(in) :: g_mu - real(kind_phys), dimension(:), intent(in) :: g_d_eff - real(kind_phys), intent(in) :: tiny_in + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq ! Longwave mass specific absorption for in cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice ! Longwave mass specific absorption for in cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: g_lambda ! Gamma distribution slope parameter on liquid optics grid + real(kind_phys), dimension(:), intent(in) :: g_mu ! Gamma distribution shape parameter on liquid optics grid + real(kind_phys), dimension(:), intent(in) :: g_d_eff ! Radiative effective diameter samples on ice optics grid + real(kind_phys), intent(in) :: tiny_in ! Definition of tiny for RRTMGP logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index e9101648..808a1eae 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -14,6 +14,7 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_utils, only: get_molar_mass_ratio ! Set gas vmr for the gases in the radconstants module's gaslist. @@ -125,57 +126,4 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, end subroutine rrtmgp_lw_gas_optics_pre_run -!========================================================================================= - - subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) - use ccpp_kinds, only: kind_phys - - ! return the molar mass ratio of dry air to gas based on gas_name - - character(len=*), intent(in) :: gas_name - real(kind_phys), intent(out) :: massratio - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! local variables - real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor - real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide - real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone - real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane - real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide - real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen - real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 - real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 - - character(len=*), parameter :: sub='get_molar_mass_ratio' - !---------------------------------------------------------------------------- - ! Set error variables - errmsg = '' - errflg = 0 - - 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 - write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) - errflg = 1 - end select - -end subroutine get_molar_mass_ratio - - end module rrtmgp_lw_gas_optics_pre diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index deedf4ac..61a38787 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -30,61 +30,62 @@ module rrtmgp_sw_cloud_optics subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, 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, c_cld_tau_w, c_cld_tau_w_g, & - tot_cld_vistau, tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) + 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, c_cld_tau_w, c_cld_tau_w_g, tot_cld_vistau, tot_icld_vistau, & + liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp ! Compute combined cloud optical properties. ! arguments - 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(:) ! indices of daylight columns in the chunk - integer, intent(in) :: nswgpts - integer, intent(in) :: pver - integer, intent(in) :: ktopcam - integer, intent(in) :: ktoprad - integer, intent(in) :: nswbands - integer, intent(in) :: nnite ! number of night columns - integer, intent(in) :: idxnite(:) ! indices of night columns in the chunk - integer, intent(in) :: iulog - integer, intent(in) :: idx_sw_diag - - logical, intent(in) :: do_snow - logical, intent(in) :: do_graupel - logical, intent(in) :: dosw - - real(kind_phys), intent(in) :: fillvalue - real(kind_phys), intent(in) :: tiny_in - - real(kind_phys), intent(in) :: g_mu(:) - real(kind_phys), intent(in) :: g_d_eff(:) - real(kind_phys), intent(in) :: g_lambda(:,:) - real(kind_phys), intent(in) :: lamc(:,:) - real(kind_phys), intent(in) :: pgam(:,:) - real(kind_phys), intent(in) :: dei(:,:) - real(kind_phys), intent(in) :: des(:,:) - real(kind_phys), intent(in) :: degrau(:,:) - real(kind_phys), intent(in) :: iclwpth(:,:) - real(kind_phys), intent(in) :: iciwpth(:,:) - real(kind_phys), intent(in) :: icswpth(:,:) - real(kind_phys), intent(in) :: icgrauwpth(:,:) - real(kind_phys), intent(in) :: cld(:,:) ! cloud fraction (liq+ice) - real(kind_phys), intent(in) :: cldfsnow(:,:) ! cloud fraction of just "snow clouds" - real(kind_phys), intent(in) :: cldfgrau(:,:) ! cloud fraction of just "graupel clouds" - real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction - real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) - real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) - real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) - real(kind_phys), intent(in) :: ext_sw_ice(:,:) - real(kind_phys), intent(in) :: asm_sw_ice(:,:) - real(kind_phys), intent(in) :: ssa_sw_ice(:,:) - - class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object - real(kind_phys), intent(out) :: cld_tau(:,:,:) ! - real(kind_phys), intent(out) :: snow_tau(:,:,:) ! snow extinction optical depth - real(kind_phys), intent(out) :: grau_tau(:,:,:) ! + 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(:) ! Indices of daylight columns + integer, intent(in) :: nswgpts ! Number of shortwave g-points + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: nswbands ! Number of shortwve bands + integer, intent(in) :: nnite ! Number of night columns + integer, intent(in) :: idxnite(:) ! Indices of night columns in the chunk + integer, intent(in) :: iulog ! Logging unit + integer, intent(in) :: idx_sw_diag ! Index for band that contains 500-nm wave + + logical, intent(in) :: do_snow ! Flag to include snow in radiation calculation + logical, intent(in) :: do_graupel ! Flag to include graupel in radiation calculation + logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep + + real(kind_phys), intent(in) :: fillvalue ! Fill value for night columns + real(kind_phys), intent(in) :: tiny_in ! Definition of tiny for RRTMGP + + real(kind_phys), intent(in) :: g_mu(:) ! Gamma distribution shape parameter on liquid optics grid [unitless] + real(kind_phys), intent(in) :: g_d_eff(:) ! Radiative effective diameter samples on ice optics grid [microns] + real(kind_phys), intent(in) :: g_lambda(:,:) ! Gamma distribution slope parameter on liquid optics grid [m-1] + real(kind_phys), intent(in) :: lamc(:,:) ! Prognosed value of lambda for cloud [unitless] + real(kind_phys), intent(in) :: pgam(:,:) ! Prognosed value of mu for cloud [unitless] + real(kind_phys), intent(in) :: dei(:,:) ! Mean effective radius for ice cloud [micron] + real(kind_phys), intent(in) :: des(:,:) ! Mean effective radius for snow [micron] + real(kind_phys), intent(in) :: degrau(:,:) ! Mean effective radius for graupel [micron] + real(kind_phys), intent(in) :: iclwpth(:,:) ! In-cloud liquid water path [kg m-2] + real(kind_phys), intent(in) :: iciwpth(:,:) ! In-cloud ice water path [kg m-2] + real(kind_phys), intent(in) :: icswpth(:,:) ! In-cloud snow water path [kg m-2] + real(kind_phys), intent(in) :: icgrauwpth(:,:) ! In-cloud graupel water path [kg m-2] + real(kind_phys), intent(in) :: cld(:,:) ! Cloud fraction (liq+ice) [fraction] + real(kind_phys), intent(in) :: cldfsnow(:,:) ! Cloud fraction of just "snow clouds" [fraction] + real(kind_phys), intent(in) :: cldfgrau(:,:) ! Cloud fraction of just "graupel clouds" [fraction] + real(kind_phys), intent(in) :: cldfprime(:,:) ! Combined cloud fraction [fraction] + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) ! Shortwave liquid extinction [m2 kg-1] + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) ! Shortwave liquid asymmetry parameter [fraction] + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) ! Shortwave liquid single scattering albedo [fraction] + real(kind_phys), intent(in) :: ext_sw_ice(:,:) ! Shortwave ice extinction [m2 kg-1] + real(kind_phys), intent(in) :: asm_sw_ice(:,:) ! Shortwave ice asymmetry parameter [fraction] + real(kind_phys), intent(in) :: ssa_sw_ice(:,:) ! Shortwave ice single scattering albedo [fraction] + + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object + real(kind_phys), intent(out) :: cld_tau(:,:,:) ! liquid + ice optical depth + real(kind_phys), intent(out) :: snow_tau(:,:,:) ! snow optical depth + real(kind_phys), intent(out) :: grau_tau(:,:,:) ! graupel optical depth real(kind_phys), intent(out) :: c_cld_tau(:,:,:) ! combined cloud extinction optical depth real(kind_phys), intent(out) :: c_cld_tau_w (:,:,:) ! combined cloud single scattering albedo * tau real(kind_phys), intent(out) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index a0a075b7..d11a5488 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -25,13 +25,13 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & use mo_rte_kind, only: wl ! Inputs - character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP longwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errcode ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), allocatable :: pio_reader @@ -52,27 +52,27 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] - real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] - real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] - real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] + real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] + real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] + real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. character(len=256) :: alloc_errmsg integer :: idx diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index ae60e084..b49f33c9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -14,6 +14,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, pverp, ktoprad, ktopcam, dosw, nradgas, gas_concs, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_utils, only: get_molar_mass_ratio ! Set gas vmr for the gases in the radconstants module's gaslist. @@ -130,56 +131,4 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, end subroutine rrtmgp_sw_gas_optics_pre_run -!========================================================================================= - - subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) - use ccpp_kinds, only: kind_phys - - ! return the molar mass ratio of dry air to gas based on gas_name - - character(len=*), intent(in) :: gas_name - real(kind_phys), intent(out) :: massratio - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! local variables - real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor - real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide - real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone - real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane - real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide - real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen - real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 - real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 - - character(len=*), parameter :: sub='get_molar_mass_ratio' - !---------------------------------------------------------------------------- - ! Set error variables - errmsg = '' - errflg = 0 - - 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 - write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) - errflg = 1 - end select - -end subroutine get_molar_mass_ratio - end module rrtmgp_sw_gas_optics_pre diff --git a/schemes/rrtmgp/rrtmgp_sw_main.F90 b/schemes/rrtmgp/rrtmgp_sw_main.F90 index 3bfc39ba..fdf7ce52 100644 --- a/schemes/rrtmgp/rrtmgp_sw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_main.F90 @@ -23,19 +23,19 @@ subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, r use radiation_tools, only: check_error_msg ! Inputs - logical, intent(in) :: doswrad !< Flag to perform longwave calculation - logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes - logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes - logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention - - integer, intent(in) :: nday !< Number of horizontal daylight points - integer, intent(in) :: iter_num !< Radiation subcycle iteration number - integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once - - real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw - real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir - real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif - real(kind_phys), dimension(:), intent(in) :: coszen + logical, intent(in) :: doswrad !< Flag to perform shortwave calculation + logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes + logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention + + integer, intent(in) :: nday !< Number of horizontal daylight points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw !< Top-of-atmosphere flux on g-points [W m-2] + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir !< Albedo direct at surface [fraction] + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif !< Albedo diffuse at surface [fraction] + real(kind_phys), dimension(:), intent(in) :: coszen !< Cosine of solar zenith angle for daytime points ! Outputs class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 27f0b8d9..32fbd955 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -1,5 +1,4 @@ module rrtmgp_sw_mcica_subcol_gen -use cam_logfile, only: iulog implicit none private @@ -27,23 +26,23 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! arguments class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object - integer, intent(in) :: nswbands - integer, intent(in) :: nswgpts + integer, intent(in) :: nswbands ! number of shortwave bands + integer, intent(in) :: nswgpts ! number of shortwave g-points 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) :: pver - integer, intent(in) :: ktopcam - integer, intent(in) :: ktoprad + integer, intent(in) :: pver ! total number of vertical layers + integer, intent(in) :: ktopcam ! index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! index in RRTMGP array corresponding to top layer or interface of CAM arrays integer, intent(in) :: idxday(:) ! indices of daylight columns in the chunk - real(kind_phys), intent(in) :: tiny - real(kind_phys), intent(in) :: c_cld_tau(:,:,:) - real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) - real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) + real(kind_phys), intent(in) :: tiny ! definition of tiny in RRTMGP + real(kind_phys), intent(in) :: c_cld_tau(:,:,:) ! combined cloud extinction optical depth + real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) ! combined cloud single scattering albedo * tau + real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction - real(kind_phys), intent(in) :: pmid(:,:) - logical, intent(in) :: dosw + real(kind_phys), intent(in) :: pmid(:,:) ! air ressure at mid-points [Pa] + logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep - type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! SW cloud optical properties object + type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! SW cloud optical properties object character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -121,7 +120,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) - ! number of CAM's layers in radiation calculation. Does not include the "extra layer". + m number of CAM's layers in radiation calculation. Does not include the "extra layer". nver = pver - ktopcam + 1 ! clip cloud fraction diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index a6802b70..6b1bba64 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -27,9 +27,9 @@ module rrtmgp_sw_solar_var subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) use radiation_utils, only : get_sw_spectral_boundaries_ccpp - integer, intent(in) :: nswbands - logical, intent(in) :: do_spctrl_scaling - logical, intent(in) :: has_spectrum + integer, intent(in) :: nswbands ! number of shortwave bands + logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -84,16 +84,16 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, w sfac, eccf, errmsg, errflg) ! Arguments - real(kind_phys), intent(inout) :: toa_flux(:,:) ! TOA flux to be scaled (columns,gpts) - real(kind_phys), intent(in) :: sol_tsi - real(kind_phys), intent(in) :: sol_irrad(:) - real(kind_phys), intent(in) :: we(:) - integer, intent(in) :: nbins - integer, intent(in) :: band2gpt_sw(:,:) - integer, intent(in) :: nswbands - logical, intent(in) :: do_spctrl_scaling - real(kind_phys), intent(in) :: eccf - real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) + real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance + real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance + real(kind_phys), intent(in) :: we(:) ! wavelength endpoints + integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points + integer, intent(in) :: nswbands ! number of shortwave bands + logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + real(kind_phys), intent(in) :: eccf ! eccentricity factor + real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 index d0e40893..09cadb33 100644 --- a/schemes/rrtmgp/utils/radiation_utils.F90 +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -8,6 +8,7 @@ module radiation_utils public :: get_sw_spectral_boundaries_ccpp public :: get_lw_spectral_boundaries_ccpp public :: get_mu_lambda_weights_ccpp + public :: get_molar_mass_ratio real(kind_phys), allocatable :: wavenumber_low_shortwave(:) real(kind_phys), allocatable :: wavenumber_high_shortwave(:) @@ -202,4 +203,54 @@ end subroutine get_mu_lambda_weights_ccpp !========================================================================================= +subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*), intent(in) :: gas_name + real(kind_phys), intent(out) :: massratio + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor + real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide + real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone + real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane + real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide + real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen + real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 + real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + 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 + write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) + errflg = 1 + end select + +end subroutine get_molar_mass_ratio + end module radiation_utils From e324603cdb8d24cc4781a67c87ea791409e7b4df Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 13:36:25 -0600 Subject: [PATCH 057/140] rename main to rte and add git modules file --- .gitmodules | 6 ++++ .../{rrtmgp_lw_main.F90 => rrtmgp_lw_rte.F90} | 28 +++++++++---------- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 1 - .../{rrtmgp_sw_main.F90 => rrtmgp_sw_rte.F90} | 26 ++++++++--------- 4 files changed, 33 insertions(+), 28 deletions(-) rename schemes/rrtmgp/{rrtmgp_lw_main.F90 => rrtmgp_lw_rte.F90} (94%) rename schemes/rrtmgp/{rrtmgp_sw_main.F90 => rrtmgp_sw_rte.F90} (87%) diff --git a/.gitmodules b/.gitmodules index aa99bf1b..67012472 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,9 @@ fxtag = 20240626-MPASv8.2 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/NCAR/MMM-physics.git +[submodule "rte-rrtmgp"] + path = schemes/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 diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 similarity index 94% rename from schemes/rrtmgp/rrtmgp_lw_main.F90 rename to schemes/rrtmgp/rrtmgp_lw_rte.F90 index dbf2f749..1b6e1672 100644 --- a/schemes/rrtmgp/rrtmgp_lw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -1,18 +1,18 @@ -!> \file rrtmgp_lw_main.F90 +!> \file rrtmgp_lw_rte.F90 !! !> This module contains the call to the RRTMGP-LW radiation routine -module rrtmgp_lw_main +module rrtmgp_lw_rte implicit none private - public rrtmgp_lw_main_run + public rrtmgp_lw_rte_run contains -!> \section arg_table_rrtmgp_lw_main_run Argument Table -!! \htmlinclude rrtmgp_lw_main_run.html +!> \section arg_table_rrtmgp_lw_rte_run Argument Table +!! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & nGauss_angles, lw_optical_props_clrsky, lw_optical_props_clouds, top_at_1, & sources, sfc_emiss_byband, lw_gas_props, aerlw, fluxlwUP_jac, lw_Ds, & flux_clrsky, flux_allsky, errmsg, errflg) @@ -65,7 +65,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, ! ################################################################################### ! Increment errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) - call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky', errmsg) + call check_error_msg('rrtmgp_lw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -75,7 +75,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, if (doLWclrsky) then if (use_lw_optimal_angles) then errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) - call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) + call check_error_msg('rrtmgp_lw_rte_opt_angle', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -116,7 +116,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_clrsky%fluxes) ! OUT - Fluxes end if end if - call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + call check_error_msg('rrtmgp_lw_rte_lw_rte_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -142,7 +142,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, if (doGP_lwscat) then ! Increment errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) - call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds', errmsg) + call check_error_msg('rrtmgp_lw_rte_increment_clrsky_to_clouds', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -188,7 +188,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, else ! Increment errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) - call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', errmsg) + call check_error_msg('rrtmgp_lw_rte_increment_clouds_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -232,10 +232,10 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, end if end if end if - call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + call check_error_msg('rrtmgp_lw_rte_lw_rte_allsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 end if - end subroutine rrtmgp_lw_main_run -end module rrtmgp_lw_main + end subroutine rrtmgp_lw_rte_run +end module rrtmgp_lw_rte diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 32fbd955..183f955e 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -120,7 +120,6 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) - m number of CAM's layers in radiation calculation. Does not include the "extra layer". nver = pver - ktopcam + 1 ! clip cloud fraction diff --git a/schemes/rrtmgp/rrtmgp_sw_main.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 similarity index 87% rename from schemes/rrtmgp/rrtmgp_sw_main.F90 rename to schemes/rrtmgp/rrtmgp_sw_rte.F90 index fdf7ce52..19a291d1 100644 --- a/schemes/rrtmgp/rrtmgp_sw_main.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -1,18 +1,18 @@ -!> \file rrtmgp_sw_main.F90 +!> \file rrtmgp_sw_rte.F90 !! !> This module contains the call to the RRTMGP-sw radiation routine -module rrtmgp_sw_main +module rrtmgp_sw_rte implicit none private - public rrtmgp_sw_main_run + public rrtmgp_sw_rte_run contains -!> \section arg_table_rrtmgp_sw_main_run Argument Table -!! \htmlinclude rrtmgp_sw_main_run.html +!> \section arg_table_rrtmgp_sw_rte_run Argument Table +!! \htmlinclude rrtmgp_sw_rte_run.html !! - subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & + subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & sw_optical_props_clouds, top_at_1, aersw, coszen, toa_src_sw, & sfc_alb_dir, sfc_alb_dif, flux_clrsky, flux_allsky, errmsg, errflg) use machine, only: kind_phys @@ -66,7 +66,7 @@ subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, r ! ################################################################################### ! Increment optics (always) errmsg = aersw%optical_props%increment(sw_optical_props%optical_props) - call check_error_msg('rrtmgp_sw_main_increment_aerosol_to_clrsky', errmsg) + call check_error_msg('rrtmgp_sw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -74,7 +74,7 @@ subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, r ! Optionally compute clear-sky fluxes if (doswclrsky) then - call check_error_msg('rrtmgp_sw_main_rte_sw_clrsky',rte_sw( & + call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky',rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle @@ -96,14 +96,14 @@ subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, r if (doswallsky) then ! Delta scale - !call check_error_msg('rrtmgp_sw_main_delta_scale',sw_optical_props_clouds%delta_scale()) + !call check_error_msg('rrtmgp_sw_rte_delta_scale',sw_optical_props_clouds%delta_scale()) ! Increment - call check_error_msg('rrtmgp_sw_main_increment_clouds_to_clrsky', & + call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', & sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props)) ! Compute fluxes - call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & + call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky',rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle @@ -117,5 +117,5 @@ subroutine rrtmgp_sw_main_run(doswrad, doswclrsky, doswallsky, nday, iter_num, r end if end if - end subroutine rrtmgp_sw_main_run -end module rrtmgp_sw_main + end subroutine rrtmgp_sw_rte_run +end module rrtmgp_sw_rte From 37ad42677a3be738161d5bb5b931f4561901b880 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 14 Jul 2025 14:38:39 -0600 Subject: [PATCH 058/140] cleanup and units --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 66 +++++++++++------------ schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 6 +-- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 2 +- 3 files changed, 37 insertions(+), 37 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 51c4ba48..6fbf52fc 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -35,39 +35,39 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Local variables class(abstract_netcdf_reader_t), allocatable :: file_reader - character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band - integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band + integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere [mol mol-1] + real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable integer, parameter :: missing_variable_error_code = 3 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 61a38787..b6b7e850 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -59,11 +59,11 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, real(kind_phys), intent(in) :: fillvalue ! Fill value for night columns real(kind_phys), intent(in) :: tiny_in ! Definition of tiny for RRTMGP - real(kind_phys), intent(in) :: g_mu(:) ! Gamma distribution shape parameter on liquid optics grid [unitless] + real(kind_phys), intent(in) :: g_mu(:) ! Gamma distribution shape parameter on liquid optics grid [1] real(kind_phys), intent(in) :: g_d_eff(:) ! Radiative effective diameter samples on ice optics grid [microns] real(kind_phys), intent(in) :: g_lambda(:,:) ! Gamma distribution slope parameter on liquid optics grid [m-1] - real(kind_phys), intent(in) :: lamc(:,:) ! Prognosed value of lambda for cloud [unitless] - real(kind_phys), intent(in) :: pgam(:,:) ! Prognosed value of mu for cloud [unitless] + real(kind_phys), intent(in) :: lamc(:,:) ! Prognosed value of lambda for cloud [1] + real(kind_phys), intent(in) :: pgam(:,:) ! Prognosed value of mu for cloud [1] real(kind_phys), intent(in) :: dei(:,:) ! Mean effective radius for ice cloud [micron] real(kind_phys), intent(in) :: des(:,:) ! Mean effective radius for snow [micron] real(kind_phys), intent(in) :: degrau(:,:) ! Mean effective radius for graupel [micron] diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 2aa8a3b9..fa91a72d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -54,7 +54,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere [mol mol-1] real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] From b41241ae5aef898f27684c8ea3815db9c8e207f0 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 15 Jul 2025 10:22:46 -0600 Subject: [PATCH 059/140] standard name fix --- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index 5b812dbc..ba53a653 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -79,7 +79,7 @@ dimensions = () intent = in [ qrl ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation_adjusted_by_air_pressure_thickness units = J Pa kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_dimension, vertical_layer_dimension) From e750700803250bb0a380f5a23edb4082934c7f0f Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 15 Jul 2025 13:22:43 -0600 Subject: [PATCH 060/140] add missing argument declaration --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index b6b7e850..8df06264 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -40,6 +40,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! arguments integer, intent(in) :: nlay ! Number of layers in radiation calculation (may include "extra layer") + integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: nday ! Number of daylight columns integer, intent(in) :: idxday(:) ! Indices of daylight columns integer, intent(in) :: nswgpts ! Number of shortwave g-points From c5363d2983deb8c21e038ac4268c430e3b9eeabd Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 15 Jul 2025 13:23:11 -0600 Subject: [PATCH 061/140] remove duplicate ncol declaration --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 8df06264..c9374d38 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -105,7 +105,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! Local variables - integer :: i, k, ncol + integer :: i, k integer :: igpt, nver integer :: istat integer, parameter :: changeseed = 1 From 403130ec1bb3e245255182a3c3167aba3a84d4f3 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 17 Jul 2025 11:23:38 -0600 Subject: [PATCH 062/140] address review comments; remove deallocation statements in anticipation of new file io interfaces --- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 12 +- .../utils/rrtmgp_cloud_optics_setup.F90 | 130 +++--------------- 2 files changed, 25 insertions(+), 117 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index baa56fe4..9975f8d7 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -75,6 +75,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Local variables integer :: idx, kdx + integer :: ngd, nlambda, nmu ! cloud radiative parameters are "in cloud" not "in cell" real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) @@ -95,18 +96,21 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldf = 0._kind_phys tauc = 0._kind_phys + nmu = size(g_mu) + nlambda = size(g_lambda, 2) + ngd = size(g_d_eff) ! Combine the cloud optical properties. ! gammadist liquid optics - call liquid_cloud_get_rad_props_lw(ncol, pver, size(g_mu), size(g_lambda,2), nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & + call liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & abs_lw_liq, tiny_in, liq_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if ! Mitchell ice optics call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & - size(g_d_eff), g_d_eff, abs_lw_ice, tiny_in, ice_lw_abs, errmsg, errflg) + ngd, g_d_eff, abs_lw_ice, tiny_in, ice_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -116,7 +120,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in snow if (do_snow) then call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & - size(g_d_eff), g_d_eff, abs_lw_ice, tiny_in, snow_lw_abs, errmsg, errflg) + ngd, g_d_eff, abs_lw_ice, tiny_in, snow_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -136,7 +140,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in graupel if (do_graupel) then - call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, size(g_d_eff), & + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, ngd, & g_d_eff, abs_lw_ice, tiny_in, grau_lw_abs, errmsg, errflg) if (errflg /= 0) then return diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index b5b8c517..37a8501e 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -19,45 +19,33 @@ module rrtmgp_cloud_optics_setup !> \section arg_table_rrtmgp_cloud_optics_setup_init Argument Table !! \htmlinclude rrtmgp_cloud_optics_setup_init.html !! -! subroutine rrtmgp_cloud_optics_setup_init(liq_filename, abs_lw_liq_out, & -! ext_sw_liq_out, ssa_sw_liq_out, asm_sw_liq_out, g_lambda_out, g_mu_out, errmsg, errflg) - subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq_out, abs_lw_ice_out, & - ext_sw_liq_out, ext_sw_ice_out, ssa_sw_liq_out, ssa_sw_ice_out, asm_sw_liq_out, & - asm_sw_ice_out, g_lambda_out, g_mu_out, g_d_eff_out, errmsg, errflg) + subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq, abs_lw_ice, & + ext_sw_liq, ext_sw_ice, ssa_sw_liq, ssa_sw_ice, asm_sw_liq, asm_sw_ice, g_lambda, & + g_mu, g_d_eff, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Inputs character(len=*), intent(in) :: liq_filename ! Full file path for liquid optics file character(len=*), intent(in) :: ice_filename ! Full file path for ice optics file ! Outputs - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq_out ! Longwave mass specific absorption for in-cloud liquid water path - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq_out - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq_out - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: asm_sw_liq_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: abs_lw_ice_out ! Longwave mass specific absorption for in-cloud ice water path - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ext_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ssa_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: asm_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: g_lambda_out ! lambda scale samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_mu_out ! Mu samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_d_eff_out ! Radiative effective diameter samples on grid + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq ! Longwave mass specific absorption for in-cloud liquid water path + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq + real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: asm_sw_liq + real(kind_phys), dimension(:,:), allocatable, intent(out) :: abs_lw_ice ! Longwave mass specific absorption for in-cloud ice water path + real(kind_phys), dimension(:,:), allocatable, intent(out) :: ext_sw_ice + real(kind_phys), dimension(:,:), allocatable, intent(out) :: ssa_sw_ice + real(kind_phys), dimension(:,:), allocatable, intent(out) :: asm_sw_ice + real(kind_phys), dimension(:,:), allocatable, intent(out) :: g_lambda ! lambda scale samples on grid + real(kind_phys), dimension(:), allocatable, intent(out) :: g_mu ! Mu samples on grid + real(kind_phys), dimension(:), allocatable, intent(out) :: g_d_eff ! Radiative effective diameter samples on grid character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables + real(kind_phys), parameter :: liquid_water_density = 0.9970449e3_kind_phys class(abstract_netcdf_reader_t), allocatable :: file_reader - real(kind_phys), dimension(:), pointer :: g_mu - real(kind_phys), dimension(:), pointer :: g_d_eff - real(kind_phys), dimension(:,:), pointer :: g_lambda - real(kind_phys), dimension(:,:), pointer :: ext_sw_ice - real(kind_phys), dimension(:,:), pointer :: ssa_sw_ice - real(kind_phys), dimension(:,:), pointer :: asm_sw_ice - real(kind_phys), dimension(:,:), pointer :: abs_lw_ice - real(kind_phys), dimension(:,:,:), pointer :: ext_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: ssa_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: asm_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: abs_lw_liq character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'rrtmgp_cloud_optics_setup_init' @@ -106,8 +94,8 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq end if ! Convert kext from m^2/Volume to m^2/Kg - ext_sw_liq = ext_sw_liq / 0.9970449e3_kind_phys - abs_lw_liq = abs_lw_liq / 0.9970449e3_kind_phys + ext_sw_liq = ext_sw_liq / liquid_water_density + abs_lw_liq = abs_lw_liq / liquid_water_density ! Open the ice optics file call file_reader%open_file(ice_filename, errmsg, errflg) @@ -143,90 +131,6 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq return end if - ! Allocate output variables - allocate(g_mu_out(size(g_mu)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu_out, message: ', alloc_errmsg - return - end if - allocate(g_lambda_out(size(g_lambda,1), size(g_lambda,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda_out, message: ', alloc_errmsg - return - end if - allocate(g_d_eff_out(size(g_d_eff)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff_out, message: ', alloc_errmsg - return - end if - allocate(ext_sw_liq_out(size(ext_sw_liq,1),size(ext_sw_liq,2),size(ext_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(ext_sw_ice_out(size(ext_sw_ice,1),size(ext_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(asm_sw_liq_out(size(asm_sw_liq,1),size(asm_sw_liq,2),size(asm_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(asm_sw_ice_out(size(asm_sw_ice,1),size(asm_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(ssa_sw_liq_out(size(ssa_sw_liq,1),size(ssa_sw_liq,2),size(ssa_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(ssa_sw_ice_out(size(ssa_sw_ice,1),size(ssa_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(abs_lw_liq_out(size(abs_lw_liq,1),size(abs_lw_liq,2),size(abs_lw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq_out, message: ', alloc_errmsg - return - end if - allocate(abs_lw_ice_out(size(abs_lw_ice,1),size(abs_lw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice_out, message: ', alloc_errmsg - return - end if - - ext_sw_liq_out = ext_sw_liq - ext_sw_ice_out = ext_sw_ice - ssa_sw_liq_out = ssa_sw_liq - ssa_sw_ice_out = ssa_sw_ice - asm_sw_liq_out = asm_sw_liq - asm_sw_ice_out = asm_sw_ice - abs_lw_liq_out = abs_lw_liq - abs_lw_ice_out = abs_lw_ice - g_mu_out = g_mu - g_lambda_out = g_lambda - g_d_eff_out = g_d_eff - - ! Deallocate pointer variables - deallocate(g_mu, g_d_eff, g_lambda, ext_sw_ice, ssa_sw_ice, asm_sw_ice, abs_lw_ice, ext_sw_liq, & - ssa_sw_liq, asm_sw_liq, abs_lw_liq) - nullify(g_mu) - nullify(g_d_eff) - nullify(g_lambda) - nullify(ext_sw_ice) - nullify(ssa_sw_ice) - nullify(asm_sw_ice) - nullify(abs_lw_ice) - nullify(ext_sw_liq) - nullify(ssa_sw_liq) - nullify(asm_sw_liq) - nullify(abs_lw_liq) - end subroutine rrtmgp_cloud_optics_setup_init !============================================================================== From a2cc351378711a402f844e31f9ed3731a0aedf19 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 22 Jul 2025 16:23:52 -0600 Subject: [PATCH 063/140] use cloud optics variables instead of passing them around --- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 21 +++++----- .../utils/rrtmgp_cloud_optics_setup.F90 | 40 ++++++++++--------- 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 9975f8d7..794d324e 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -8,7 +8,6 @@ !! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL !! cloud types visible to RRTMGP. module rrtmgp_lw_cloud_optics - use ccpp_kinds, only: kind_phys implicit none private @@ -21,13 +20,15 @@ module rrtmgp_lw_cloud_optics !> \section arg_table_rrtmgp_lw_cloud_optics_run Argument Table !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! - subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & - cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, abs_lw_liq, abs_lw_ice, & - g_mu, g_lambda, g_d_eff, tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & - do_snow, do_graupel, pver, ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, & - errmsg, errflg) - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, tiny_in, dei, icswpth, & + des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, ktopcam, tauc, cldf, & + cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_kinds, only: kind_phys + use rrtmgp_cloud_optics_setup, only: g_mu, g_lambda, nmu, nlambda, g_d_eff, n_g_d + use rrtmgp_cloud_optics_setup, only: abs_lw_liq, abs_lw_ice ! Compute combined cloud optical properties ! Create MCICA stochastic arrays for cloud LW optical properties ! Initialize optical properties object (cloud_lw) and load with MCICA columns @@ -75,7 +76,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Local variables integer :: idx, kdx - integer :: ngd, nlambda, nmu ! cloud radiative parameters are "in cloud" not "in cell" real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) @@ -96,9 +96,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldf = 0._kind_phys tauc = 0._kind_phys - nmu = size(g_mu) - nlambda = size(g_lambda, 2) - ngd = size(g_d_eff) ! Combine the cloud optical properties. diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index 37a8501e..1cdd01e7 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -11,6 +11,20 @@ module rrtmgp_cloud_optics_setup private public :: rrtmgp_cloud_optics_setup_init + integer, public :: nmu, nlambda + real(kind_phys), public, pointer :: g_mu(:) + real(kind_phys), public, pointer :: g_lambda(:,:) + real(kind_phys), public, pointer :: abs_lw_liq(:,:,:) + real(kind_phys), public, pointer :: ext_sw_liq(:,:,:) + real(kind_phys), public, pointer :: asm_sw_liq(:,:,:) + real(kind_phys), public, pointer :: ssa_sw_liq(:,:,:) + integer, public :: n_g_d + real(kind_phys), public, pointer :: g_d_eff(:) + real(kind_phys), public, pointer :: abs_lw_ice(:,:) + real(kind_phys), public, pointer :: ext_sw_ice(:,:) + real(kind_phys), public, pointer :: asm_sw_ice(:,:) + real(kind_phys), public, pointer :: ssa_sw_ice(:,:) + contains ! ###################################################################################### @@ -19,29 +33,14 @@ module rrtmgp_cloud_optics_setup !> \section arg_table_rrtmgp_cloud_optics_setup_init Argument Table !! \htmlinclude rrtmgp_cloud_optics_setup_init.html !! - subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq, abs_lw_ice, & - ext_sw_liq, ext_sw_ice, ssa_sw_liq, ssa_sw_ice, asm_sw_liq, asm_sw_ice, g_lambda, & - g_mu, g_d_eff, errmsg, errflg) - use ccpp_kinds, only: kind_phys + subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Inputs character(len=*), intent(in) :: liq_filename ! Full file path for liquid optics file character(len=*), intent(in) :: ice_filename ! Full file path for ice optics file ! Outputs - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq ! Longwave mass specific absorption for in-cloud liquid water path - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: asm_sw_liq - real(kind_phys), dimension(:,:), allocatable, intent(out) :: abs_lw_ice ! Longwave mass specific absorption for in-cloud ice water path - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ext_sw_ice - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ssa_sw_ice - real(kind_phys), dimension(:,:), allocatable, intent(out) :: asm_sw_ice - real(kind_phys), dimension(:,:), allocatable, intent(out) :: g_lambda ! lambda scale samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_mu ! Mu samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_d_eff ! Radiative effective diameter samples on grid - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables real(kind_phys), parameter :: liquid_water_density = 0.9970449e3_kind_phys @@ -131,6 +130,11 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, abs_lw_liq return end if + ! Set size module variables + nmu = size(g_mu) + nlambda = size(g_lambda, 2) + n_g_d = size(g_d_eff) + end subroutine rrtmgp_cloud_optics_setup_init !============================================================================== From 86fc6f9542b949af4e667c1be6d364a08102485b Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 24 Jul 2025 11:02:18 -0600 Subject: [PATCH 064/140] cleanup, fixes to get use statements to work --- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 794d324e..cd36b4f6 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -53,11 +53,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel - real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice - real(kind_phys), dimension(:,:), intent(in) :: g_lambda - real(kind_phys), dimension(:), intent(in) :: g_mu - real(kind_phys), dimension(:), intent(in) :: g_d_eff real(kind_phys), intent(in) :: tiny_in logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present @@ -107,7 +102,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, end if ! Mitchell ice optics call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & - ngd, g_d_eff, abs_lw_ice, tiny_in, ice_lw_abs, errmsg, errflg) + n_g_d, g_d_eff, abs_lw_ice, tiny_in, ice_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -117,7 +112,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in snow if (do_snow) then call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & - ngd, g_d_eff, abs_lw_ice, tiny_in, snow_lw_abs, errmsg, errflg) + n_g_d, g_d_eff, abs_lw_ice, tiny_in, snow_lw_abs, errmsg, errflg) if (errflg /= 0) then return end if @@ -137,7 +132,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! add in graupel if (do_graupel) then - call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, ngd, & + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & g_d_eff, abs_lw_ice, tiny_in, grau_lw_abs, errmsg, errflg) if (errflg /= 0) then return @@ -176,6 +171,7 @@ end subroutine rrtmgp_lw_cloud_optics_run subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, & g_mu, g_lambda, iclwpth, abs_lw_liq, tiny, abs_od, errmsg, errflg) + use ccpp_kinds, only: kind_phys ! Inputs integer, intent(in) :: ncol integer, intent(in) :: pver @@ -220,6 +216,7 @@ end subroutine liquid_cloud_get_rad_props_lw subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, tiny, abs_od, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_finish use radiation_utils, only: get_mu_lambda_weights_ccpp + use ccpp_kinds, only: kind_phys ! Inputs integer, intent(in) :: nlwbands integer, intent(in) :: nmu @@ -269,6 +266,7 @@ subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & n_g_d, g_d_eff, abs_lw_ice, tiny, abs_od, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_init, & lininterp_finish, extrap_method_bndry + use ccpp_kinds, only: kind_phys integer, intent(in) :: ncol integer, intent(in) :: n_g_d From 4af207399a63c4d0db7d8cd31306376a1dd9810d Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 24 Jul 2025 16:12:19 -0600 Subject: [PATCH 065/140] change allocatable file io object to pointer --- phys_utils/ccpp_io_reader.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 6 ++++-- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 7 +++++-- schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 | 6 ++++-- 4 files changed, 14 insertions(+), 7 deletions(-) diff --git a/phys_utils/ccpp_io_reader.F90 b/phys_utils/ccpp_io_reader.F90 index 6f206736..8fb4e7ed 100644 --- a/phys_utils/ccpp_io_reader.F90 +++ b/phys_utils/ccpp_io_reader.F90 @@ -35,7 +35,7 @@ module ccpp_io_reader interface module function create_netcdf_reader_t() result(r) - class(abstract_netcdf_reader_t), allocatable :: r + class(abstract_netcdf_reader_t), pointer :: r end function create_netcdf_reader_t subroutine open_file(this, file_path, errmsg, errcode) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 51c4ba48..521638f5 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -34,7 +34,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), allocatable :: file_reader + class(abstract_netcdf_reader_t), pointer :: file_reader character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas @@ -78,7 +78,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & errmsg = '' errcode = 0 - file_reader = create_netcdf_reader_t() + file_reader => create_netcdf_reader_t() ! Open the longwave coefficients file call file_reader%open_file(lw_filename, errmsg, errcode) @@ -287,6 +287,8 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & if (errcode /= 0) then return end if + deallocate(file_reader) + nullify(file_reader) ! Initialize the gas optics object with data. errmsg = kdist%gas_props%load( & diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index d6b2292c..8e849e09 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -32,7 +32,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), allocatable :: file_reader + class(abstract_netcdf_reader_t), pointer :: file_reader character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas @@ -79,7 +79,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & errmsg = '' errcode = 0 - file_reader = create_netcdf_reader_t() + file_reader => create_netcdf_reader_t() ! Open the shortwave coefficients file call file_reader%open_file(sw_filename, errmsg, errcode) @@ -301,6 +301,9 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & return end if + deallocate(file_reader) + nullify(file_reader) + ! Initialize the gas optics object with data. errmsg = kdist%gas_props%load( & available_gases%gas_concs, gas_names, key_species, & diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index 1cdd01e7..f62d9bf0 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -44,7 +44,7 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, errmsg, er ! Local variables real(kind_phys), parameter :: liquid_water_density = 0.9970449e3_kind_phys - class(abstract_netcdf_reader_t), allocatable :: file_reader + class(abstract_netcdf_reader_t), pointer :: file_reader character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'rrtmgp_cloud_optics_setup_init' @@ -52,7 +52,7 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, errmsg, er errmsg = '' errflg = 0 - file_reader = create_netcdf_reader_t() + file_reader => create_netcdf_reader_t() ! Open liquid optics file call file_reader%open_file(liq_filename, errmsg, errflg) @@ -129,6 +129,8 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, errmsg, er if (errflg /= 0) then return end if + deallocate(file_reader) + nullify(file_reader) ! Set size module variables nmu = size(g_mu) From 98470f5c959d6c6f2765420cc8ea8f7d667766b1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 25 Jul 2025 13:04:15 -0600 Subject: [PATCH 066/140] updates to get sima to build; will merge in new file-io updates --- schemes/rrtmgp/objects/ccpp_fluxes.meta | 3 +- .../rrtmgp/objects/ccpp_fluxes_byband.meta | 3 +- .../objects/ccpp_gas_concentrations.meta | 3 +- .../objects/ccpp_gas_optics_rrtmgp.meta | 7 +- .../rrtmgp/objects/ccpp_optical_props.meta | 3 +- .../rrtmgp/objects/ccpp_source_functions.meta | 3 +- schemes/rrtmgp/rrtmgp_constituents.F90 | 14 +- schemes/rrtmgp/rrtmgp_inputs.F90 | 2 + schemes/rrtmgp/rrtmgp_inputs.meta | 12 +- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 13 +- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 20 +- .../rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 21 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 51 +-- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 4 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 2 +- .../rrtmgp/rrtmgp_lw_gas_optics_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 6 - schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 4 +- schemes/rrtmgp/rrtmgp_lw_rte.meta | 20 +- schemes/rrtmgp/rrtmgp_post.F90 | 2 +- schemes/rrtmgp/rrtmgp_post.meta | 18 +- schemes/rrtmgp/rrtmgp_pre.F90 | 8 +- schemes/rrtmgp/rrtmgp_pre.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 13 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 337 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 | 38 ++ schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta | 49 +++ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 6 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 84 ++++- .../rrtmgp/rrtmgp_sw_gas_optics_namelist.xml | 2 +- .../utils/rrtmgp_cloud_optics_setup.F90 | 138 +------ .../utils/rrtmgp_cloud_optics_setup.meta | 95 ----- .../rrtmgp_cloud_optics_setup_namelist.xml | 4 +- .../rrtmgp_lw_diagnostics.F90 | 5 +- test/test_suites/suite_rrtmgp.xml | 8 +- 37 files changed, 634 insertions(+), 374 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index 06eb6545..557fb9a5 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_broadband_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-frontend/mo_fluxes.F90 + dependencies = ../ext/rte-frontend/mo_fluxes.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta index 22bdbe2c..5b1048df 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = ty_fluxes_byband_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = extensions/mo_fluxes_byband.F90 + dependencies = ../ext/extensions/mo_fluxes_byband.F90 [ccpp-arg-table] name = ty_fluxes_byband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta index 449f78b3..4c35c631 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = ty_gas_concs_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = gas-optics/mo_gas_concentrations.F90 + dependencies = ../ext/gas-optics/mo_gas_concentrations.F90 [ccpp-arg-table] name = ty_gas_concs_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta index b15959c5..f14c9463 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -1,10 +1,9 @@ [ccpp-table-properties] name = ty_gas_optics_rrtmgp_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 - dependencies = gas-optics/mo_gas_optics_constants.F90,gas-optics/mo_gas_optics_util_string.F90 - dependencies = gas-optics/mo_gas_optics.F90 + dependencies = ../ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,../ext/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 + dependencies = ../ext/gas-optics/mo_gas_optics_constants.F90,../ext/gas-optics/mo_gas_optics_util_string.F90 + dependencies = ../ext/gas-optics/mo_gas_optics.F90 [ccpp-arg-table] name = ty_gas_optics_rrtmgp_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index 6ba2183b..0253c486 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = ty_optical_props_1scl_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-frontend/mo_optical_props.F90 + dependencies = ../ext/rte-frontend/mo_optical_props.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta index 6cf2efb8..8de926eb 100644 --- a/schemes/rrtmgp/objects/ccpp_source_functions.meta +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = ty_source_func_lw_ccpp type = ddt - relative_path = ../../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-frontend/mo_source_functions.F90 + dependencies = ../ext/rte-frontend/mo_source_functions.F90 [ccpp-arg-table] name = ty_source_func_lw_ccpp diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 7ab4de0e..4d61026a 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -1,4 +1,5 @@ module rrtmgp_constituents + use cam_logfile, only: iulog public :: rrtmgp_constituents_register @@ -21,7 +22,7 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, character(len=32) :: long_name character(len=32) :: stdname character(len=256) :: tmpstr, alloc_errmsg - integer :: gas_idx, strlen, ipos, ierr + integer :: gas_idx, strlen, ipos, ierr, idx errmsg = '' errcode = 0 @@ -52,14 +53,14 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, ! Locate the ':' separating source from long name. idx = index(tmpstr, ':') - source = tmpstr(:jdx-1) - tmpstr = tmpstr(jdx+1:) + source = tmpstr(:idx-1) + tmpstr = tmpstr(idx+1:) ! locate the ':' separating long name from rad gas ("standard") name idx = scan(tmpstr, ':') - long_name = tmpstr(:jdx-1) - stdname = tmpstr(jdx+1:) + long_name = tmpstr(:idx-1) + stdname = tmpstr(idx+1:) ! Register the constituent based on the source if (source == 'A') then @@ -134,7 +135,8 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_ca character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - errcode = 1 + ! Initialize error variables + errcode = 0 errmsg = '' active_call_array = .true. diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 1a3059ba..0e4551e1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -270,6 +270,8 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & errflg = 1 return end if + ! PEVERWHEE - ZERO AEROSOLS FOR TESTING! + aer_lw%optical_props%tau = 0.0_kind_phys ! Initialize object for Planck sources. errmsg = sources_lw%sources%alloc(ncol, nlay, kdist_lw%gas_props) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 4d880b0b..abf2215a 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -93,19 +93,19 @@ standard_name = air_temperature_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) intent = out [ pmid_rad ] standard_name = air_pressure_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) intent = out [ pint_rad ] standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_interface_dimension) + dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP_plus_one) intent = out [ t_day ] standard_name = air_temperature_for_daytime_points_for_RRTMGP @@ -156,7 +156,7 @@ dimensions = () intent = in [ ncol ] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent units = count type = integer dimensions = () @@ -263,8 +263,8 @@ type = integer dimensions = () intent = in -[ gaslist ] - standard_name = list_of_active_gases_for_RRTMGP +[ gaslist_lc ] + standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none type = character | kind = len=* dimensions = (number_of_active_gases_for_RRTMGP) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 5c948581..19efc0f1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -14,7 +14,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, changeseed, & - nlayp, nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + nlayp, nextsw_cday, current_cal_day, band2gpt_sw, irad_always_out, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp @@ -26,10 +26,11 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw integer, intent(in) :: pverp ! Number of vertical interfaces integer, intent(in) :: pver ! Number of vertical layers integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). - integer, intent(in) :: timestep_size ! Timestep size (s) + real(kind_phys), intent(in) :: timestep_size ! Timestep size (s) integer, intent(in) :: nstep ! Current timestep number integer, intent(in) :: iulog ! Logging unit integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously real(kind_phys), intent(in) :: current_cal_day ! Current calendar day real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object @@ -62,11 +63,11 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands - real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating + real(kind_phys), dimension(:,:), intent(inout) :: qrl ! Longwave radiative heating character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg - integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously - real(kind_phys), intent(out) :: dt_avg ! averaging time interval for zenith angle + integer, intent(out) :: irad_always_out ! Number of time steps to execute radiation continuously + real(kind_phys), intent(out) :: dt_avg ! averaging time interval for zenith angle ! Local variables real(kind_phys), target :: wavenumber_low_shortwave(nswbands) @@ -146,7 +147,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw ! "irad_always" is number of time steps to execute radiation continuously from ! start of initial OR restart run if (irad_always > 0) then - irad_always = irad_always + nstep + irad_always_out = irad_always + nstep end if ! Surface components to get radiation computed today diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index ba53a653..10cb6278 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -83,7 +83,7 @@ units = J Pa kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_dimension, vertical_layer_dimension) - intent = out + intent = inout [ is_first_step ] standard_name = is_first_timestep units = flag @@ -99,7 +99,7 @@ [ timestep_size ] standard_name = timestep_for_physics units = s - type = integer + type = real | kind = kind_phys dimensions = () intent = in [ nstep ] @@ -121,11 +121,11 @@ dimensions = () intent = out [ irad_always ] - standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization_namelist_parameter units = count type = integer dimensions = () - intent = inout + intent = in [ is_first_restart_step ] standard_name = is_first_restart_timestep units = flag @@ -198,12 +198,6 @@ type = integer dimensions = () intent = out -[ gaslist ] - standard_name = list_of_active_gases_for_RRTMGP - units = none - type = character | kind = len=* - dimensions = (number_of_active_gases_for_RRTMGP) - intent = in [ nswgpts ] standard_name = number_of_shortwave_g_point_intervals units = count @@ -246,6 +240,12 @@ type = integer dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) intent = out +[ irad_always_out ] + standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization + units = count + type = integer + dimensions = () + intent = out [ errmsg ] standard_name = ccpp_error_message long_name = Error message for error handling in CCPP diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta index 7a8247fd..cb56c8c5 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -90,7 +90,7 @@ dimensions = () intent = out [ errflg ] - standard_name = ccpp_error_flag + standard_name = ccpp_error_code units = 1 type = integer dimensions = () diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 4de2000f..c89602f8 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -9,6 +9,9 @@ !! cloud types visible to RRTMGP. module rrtmgp_lw_cloud_optics use ccpp_kinds, only: kind_phys + use rrtmgp_cloud_optics_setup, only: abs_lw_liq, abs_lw_ice + use rrtmgp_cloud_optics_setup, only: g_lambda, g_mu, nmu, nlambda + use rrtmgp_cloud_optics_setup, only: g_d_eff, n_g_d implicit none private @@ -22,9 +25,9 @@ module rrtmgp_lw_cloud_optics !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & - cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, abs_lw_liq, abs_lw_ice, & - g_mu, g_lambda, g_d_eff, tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & - nmu, nlambda, n_g_d, do_snow, do_graupel, pver, ktopcam, cld_lw_abs, snow_lw_abs, & + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & + tiny_in, dei, icswpth, des, icgrauwpth, degrau, nlwbands, & + do_snow, do_graupel, pver, ktopcam, cld_lw_abs, snow_lw_abs, & grau_lw_abs, c_cld_lw_abs, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp @@ -37,9 +40,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, integer, intent(in) :: nlay ! Number of vertical layers in radiation integer, intent(in) :: nlaycam ! Number of model layers in radiation integer, intent(in) :: nlwbands ! Number of longwave bands - integer, intent(in) :: nlambda - integer, intent(in) :: n_g_d - integer, intent(in) :: nmu integer, intent(in) :: pver ! Total number of vertical layers integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) @@ -55,11 +55,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel - real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq ! Longwave mass specific absorption for in cloud liquid water path - real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice ! Longwave mass specific absorption for in cloud ice water path - real(kind_phys), dimension(:,:), intent(in) :: g_lambda ! Gamma distribution slope parameter on liquid optics grid - real(kind_phys), dimension(:), intent(in) :: g_mu ! Gamma distribution shape parameter on liquid optics grid - real(kind_phys), dimension(:), intent(in) :: g_d_eff ! Radiative effective diameter samples on ice optics grid real(kind_phys), intent(in) :: tiny_in ! Definition of tiny for RRTMGP logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present @@ -95,8 +90,8 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, return end if - cldf = 0._kind_phys - tauc = 0._kind_phys +! cldf = 0._kind_phys +! tauc = 0._kind_phys ! Combine the cloud optical properties. diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index ebc72ae1..473b2ae6 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -1,8 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_optics type = scheme - relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-kernels/mo_optical_props_kernels.F90 + dependencies = ext/rte-kernels/mo_optical_props_kernels.F90 [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run @@ -91,36 +90,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in -[ abs_lw_liq ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) - intent = in -[ abs_lw_ice ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid, number_of_bands_for_longwave_radiation) - intent = in -[ g_mu ] - standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - intent = in -[ g_lambda ] - standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid - units = m-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - intent = in -[ g_d_eff ] - standard_name = radiative_effective_diameter_samples_on_ice_optics_grid - units = microns - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) - intent = in [ tiny_in ] standard_name = definition_of_tiny_for_RRTMGP units = 1 @@ -163,24 +132,6 @@ type = integer dimensions = () intent = in -[ nmu ] - standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = in -[ nlambda ] - standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = in -[ n_g_d ] - standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid - units = count - type = integer - dimensions = () - intent = in [ do_snow ] standard_name = include_snow_in_radiation_calculation units = flag diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 447229ab..946bd739 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -29,8 +29,8 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object + character(len=512), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errcode ! CCPP error code ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index ab4c9cb5..665b7352 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_gas_optics type = scheme - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 + dependencies = ext/rte-frontend/mo_rte_kind.F90 dependencies = objects/ccpp_gas_concentrations.F90 [ccpp-arg-table] diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml index 933ce455..4473a504 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml @@ -85,7 +85,7 @@ The filename of the longwave coefficients file for RRTMGP - src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-lw-g128.nc + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-lw-g128.nc diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index 169a31de..2d4e7a78 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -41,12 +41,6 @@ type = character | kind = len=* dimensions = (number_of_active_gases_for_RRTMGP) intent = in -[ idxday ] - standard_name = daytime_points - units = index - type = integer - dimensions = (horizontal_loop_extent) - intent = in [ pverp ] standard_name = vertical_interface_dimension units = count diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index a6142cfd..435dbdb7 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -91,7 +91,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy - real(kind_phys) :: tauc(nlwbands,ncol,nver) + real(kind_phys) :: tauc(nbnd,ncol,nver) real(kind_phys) :: taucmcl(ngpt,ncol,nver) !------------------------------------------------------------------------------------------ diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index 1b6e1672..73cbfa52 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -49,8 +49,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point - character(len=*), intent(out) :: errmsg !< CCPP error message - integer, intent(out) :: errflg !< CCPP error flag + character(len=512),intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag ! Initialize CCPP error handling variables errmsg = '' diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index 2e61910d..b82d00d8 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -1,13 +1,13 @@ [ccpp-table-properties] name = rrtmgp_lw_rte type = scheme - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_lw.F90 - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_config.F90 - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_util_array.F90 - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_util_array_validation.F90 - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_solver_kernels.F90 - dependencies = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = ../ccpp-physics/physics/hooks/machine.F + dependencies = ext/rte-frontend/mo_rte_lw.F90 + dependencies = ext/rte-frontend/mo_rte_config.F90 + dependencies = ext/rte-kernels/mo_rte_util_array.F90 + dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ../../../../utils/machine.F90 dependencies = ./utils/radiation_tools.F90 dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 dependencies = ./objects/ccpp_optical_props.F90 @@ -100,12 +100,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = inout -[ nlwgpts ] - standard_name = number_of_longwave_g_point_intervals - units = count - type = integer - dimensions = () - intent = in [ lw_Ds ] standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point units = 1 diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index a6fca0cc..6e2be888 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -10,7 +10,7 @@ module rrtmgp_post !! \htmlinclude rrtmgp_post_run.html !! subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & - fsw, fswc, atm_optics_lw, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, & + fsw, fswc, atm_optics_lw, sources_lw, cloud_lw, aer_lw, flw, flwc, flwds, qrs, qrl, & netsw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 6fd465a2..6902db00 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -71,6 +71,12 @@ type = ty_fluxes_broadband_ccpp dimensions = () intent = inout +[ atm_optics_lw ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout [ sources_lw ] standard_name = longwave_planck_sources_object_for_RRTMGP units = none @@ -101,6 +107,12 @@ type = ty_fluxes_broadband_ccpp dimensions = () intent = inout +[ flwds ] + standard_name = longwave_downward_radiative_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out [ qrs ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness units = J Pa kg-1 s-1 @@ -119,12 +131,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = out -[ flwds ] - standard_name = longwave_downward_radiative_flux_at_surface - units = W m-2 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) - intent = out [ errmsg ] standard_name = ccpp_error_message long_name = Error message for error handling in CCPP diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 13bea2d3..9c2fd3b2 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -51,8 +51,9 @@ end subroutine rrtmgp_pre_init !! \htmlinclude rrtmgp_pre_timestep_init.html !! subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) + use ccpp_kinds, only: kind_phys integer, intent(in) :: nstep ! Current timestep number - integer, intent(in) :: dtime ! Timestep size + real(kind_phys), intent(in) :: dtime ! Timestep size integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously integer, intent(out) :: offset ! Offset for next SW radiation timestep @@ -90,7 +91,7 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco ! Inputs real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep - integer, intent(in) :: dtime ! Timestep size [s] + real(kind_phys), intent(in) :: dtime ! Timestep size [s] integer, intent(in) :: nstep ! Timestep number integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) integer, intent(in) :: iradlw ! Freq. of longwave radiation calc in time steps (positive) or hours (negative) @@ -147,6 +148,9 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco return end if + ! PEVERWHEE - TEMPORARILY OVERRIDE TO FALSE + dosw = .false. + dosw_heat = (.not. dosw) dolw_heat = (.not. dolw) diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 5566aa4f..778cef68 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -57,7 +57,7 @@ [ dtime ] standard_name = timestep_for_physics units = s - type = integer + type = real | kind = kind_phys dimensions = () intent = in [ iradsw ] @@ -112,7 +112,7 @@ [ dtime ] standard_name = timestep_for_physics units = s - type = integer + type = real | kind = kind_phys dimensions = () intent = in [ iradsw ] diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 263a87b8..fc7eb5db 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -2,7 +2,12 @@ !> \file rrtmgp_sw_cloud_optics.F90 !! module rrtmgp_sw_cloud_optics -use ccpp_kinds, only: kind_phys + use ccpp_kinds, only: kind_phys + use rrtmgp_cloud_optics_setup, only: g_lambda, g_mu, nmu, nlambda + use rrtmgp_cloud_optics_setup, only: g_d_eff, n_g_d + use rrtmgp_cloud_optics_setup, only: ext_sw_liq, ext_sw_ice + use rrtmgp_cloud_optics_setup, only: asm_sw_liq, asm_sw_ice + use rrtmgp_cloud_optics_setup, only: ssa_sw_liq, ssa_sw_ice !-------------------------------------------------------------------------------- ! Transform data for inputs from CAM's data structures to those used by @@ -30,6 +35,9 @@ module rrtmgp_sw_cloud_optics contains !================================================================================================== +!> \section arg_table_rrtmgp_sw_cloud_optics_run Argument Table +!! \htmlinclude rrtmgp_sw_cloud_optics_run.html +!! subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, ext_sw_liq, ssa_sw_liq, & @@ -44,6 +52,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! arguments 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) :: ncol ! Total number of columns integer, intent(in) :: idxday(:) ! Indices of daylight columns integer, intent(in) :: nswgpts ! Number of shortwave g-points integer, intent(in) :: pver ! Number of vertical layers @@ -107,7 +116,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! Local variables - integer :: i, k, ncol + integer :: i, k integer :: igpt, nver integer :: istat integer, parameter :: changeseed = 1 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta new file mode 100644 index 00000000..d10da171 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -0,0 +1,337 @@ +[ccpp-table-properties] + name = rrtmgp_sw_cloud_optics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ nswgpts ] + standard_name = number_of_shortwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (daytime_points_dimension) + intent = in +[ fillvalue ] + standard_name = fill_value_for_diagnostic_output + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ iulog ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in +[ pgam ] + standard_name = size_distribution_shape_parameter_for_microphysics + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ lamc ] + standard_name = slope_of_droplet_distribution_for_optics + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ nnite ] + standard_name = nighttime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ idxnite ] + standard_name = nighttime_points + units = index + type = integer + dimensions = (nighttime_points_dimension) + intent = in +[ cld ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ cldfsnow ] + standard_name = liquid_plus_snow_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ cldfgrau ] + standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real | kind = kind_phys + intent = in +[ cld_tau ] + standard_name = liquid_plus_ice_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ grau_tau ] + standard_name = graupel_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ snow_tau ] + standard_name = snow_optical_depth + units = enter_units + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ degrau ] + standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ dei ] + standard_name = effective_diameter_of_stratiform_cloud_ice_particle_for_radiation + units = micron + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ des ] + standard_name = effective_diameter_of_stratiform_snow_particle_for_radiation + units = micron + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ iclwpth ] + standard_name = in_cloud_liquid_water_path_for_radiation + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ iciwpth ] + standard_name = cloud_ice_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ icswpth ] + standard_name = cloud_snow_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ icgrauwpth ] + standard_name = stratiform_in_cloud_graupel_water_path + units = kg m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ tiny_in ] + standard_name = definition_of_tiny_for_RRTMGP + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ ext_sw_liq ] + standard_name = shortwave_liquid_extinction + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ ssa_sw_liq ] + standard_name = shortwave_liquid_single_scattering_albedo + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ asm_sw_liq ] + standard_name = shortwave_liquid_asymmetry_parameter + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ ext_sw_ice ] + standard_name = shortwave_ice_extinction + units = m2 kg-1 + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ asm_sw_ice ] + standard_name = shortwave_ice_asymmetry_parameter + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ ssa_sw_ice ] + standard_name = shortwave_ice_single_scattering_albedo + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) + intent = in +[ g_mu ] + standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) + intent = in +[ g_d_eff ] + standard_name = radiative_effective_diameter_samples_on_ice_optics_grid + units = microns + type = real | kind = kind_phys + dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) + intent = in +[ g_lambda ] + standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid + units = m-1 + type = real | kind = kind_phys + dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid) + intent = in +[ idx_sw_diag ] + standard_name = index_of_shortwave_band + units = index + type = integer + dimensions = () + intent = in +[ do_graupel ] + standard_name = include_graupel_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ do_snow ] + standard_name = include_snow_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ c_cld_tau ] + standard_name = combined_cloud_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ c_cld_tau_w ] + standard_name = combined_cloud_single_scattering_albedo_times_tau + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ c_cld_tau_w_g ] + standard_name = combined_cloud_asymmetry_parameter_times_w_times_tau + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ tot_cld_vistau ] + standard_name = total_cloud_optical_depth_for_visible_band_times_cloud_fraction + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ tot_icld_vistau ] + standard_name = total_cloud_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ liq_icld_vistau ] + standard_name = cloud_liquid_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ ice_icld_vistau ] + standard_name = cloud_ice_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ snow_icld_vistau ] + standard_name = snow_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ grau_icld_vistau ] + standard_name = graupel_optical_depth_for_visible_band + units = enter_units + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 new file mode 100644 index 00000000..76109ca1 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 @@ -0,0 +1,38 @@ +module rrtmgp_sw_cloud_temp + + public :: rrtmgp_sw_cloud_temp_run + +CONTAINS + !> \section arg_table_rrtmgp_sw_cloud_temp_run Argument Table + !! \htmlinclude rrtmgp_sw_cloud_temp_run.html + subroutine rrtmgp_sw_cloud_temp_run(dosw, ncol, nlay, kdist_sw, cloud_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + ! Inputs + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers in radiation + logical, intent(in) :: dosw ! Flag for whether to perform longwave calculation + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Longwave gas optics object + + ! Outputs + type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! Longwave cloud optics object + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Set error variables + errmsg = '' + errflg = 0 + + ! If not doing shortwave, no need to proceed + if (.not. dosw) then + return + end if + + errmsg =cloud_sw%optical_props%alloc_2str(ncol, nlay, kdist_sw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end subroutine rrtmgp_sw_cloud_temp_run + +end module rrtmgp_sw_cloud_temp diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta new file mode 100644 index 00000000..614e5563 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta @@ -0,0 +1,49 @@ +[ccpp-table-properties] + name = rrtmgp_sw_cloud_temp + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_cloud_temp_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ cloud_sw ] + standard_name = shortwave_cloud_optical_properties_object_for_rrtmgp + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index fa91a72d..ac24a053 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -28,8 +28,8 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object - character(len=*), intent(out) :: errmsg ! CCPP error message + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object + character(len=512), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errcode ! CCPP error code ! Local variables @@ -402,7 +402,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object real(kind_phys), intent(out) :: toa_src_sw(:,:) - character(len=*), intent(out) :: errmsg + character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index ba9793ef..b20b0c57 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -1,8 +1,6 @@ [ccpp-table-properties] name = rrtmgp_sw_gas_optics type = scheme - relative_path = ../ccpp-physics/physics/Radiation/RRTMGP/rte-rrtmgp - dependencies = rte-frontend/mo_rte_kind.F90 [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init @@ -37,3 +35,85 @@ type = integer dimensions = () intent = out + +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ p_lay ] + standard_name = air_pressure_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_points_dimensions, vertical_layer_dimension) + intent = in +[ p_lev ] + standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_points_dimensions, vertical_interface_dimension) + intent = in +[ t_lay ] + standard_name = air_temperature_for_daytime_points_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (daytime_points_dimensions, vertical_layer_dimension) + intent = in +[ gas_concs ] + standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ sw_optical_props ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ sw_gas_props ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ toa_src_sw ] + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 + type = real | kind = kind_phys + dimensions = (daytime_points_dimension, number_of_shortwave_g_point_intervals) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml index 1df56e6e..3747fd28 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml @@ -85,7 +85,7 @@ The filename of the shortwave coefficients file for RRTMGP - src/physics/ncar_ccpp/schemes/rrtmgp/data/rrtmgp-gas-sw-g128.nc + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index 36f2937e..ef573e60 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -5,12 +5,27 @@ !! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL !! cloud types visible to RRTMGP. module rrtmgp_cloud_optics_setup - use ccpp_kinds, only: kind_phys + use ccpp_kinds, only: kind_phys implicit none private public :: rrtmgp_cloud_optics_setup_init + integer, public :: nmu, nlambda + real(kind_phys), public, pointer :: abs_lw_liq(:,:,:) + real(kind_phys), public, pointer :: ext_sw_liq(:,:,:) + real(kind_phys), public, pointer :: ssa_sw_liq(:,:,:) + real(kind_phys), public, pointer :: asm_sw_liq(:,:,:) + real(kind_phys), public, pointer :: g_mu(:) + real(kind_phys), public, pointer :: g_lambda(:,:) + + integer, public :: n_g_d + real(kind_phys), public, pointer :: abs_lw_ice(:,:) + real(kind_phys), public, pointer :: ext_sw_ice(:,:) + real(kind_phys), public, pointer :: ssa_sw_ice(:,:) + real(kind_phys), public, pointer :: asm_sw_ice(:,:) + real(kind_phys), public, pointer :: g_d_eff(:) + contains ! ###################################################################################### @@ -19,48 +34,17 @@ module rrtmgp_cloud_optics_setup !> \section arg_table_rrtmgp_cloud_optics_setup_init Argument Table !! \htmlinclude rrtmgp_cloud_optics_setup_init.html !! -! subroutine rrtmgp_cloud_optics_setup_init(liq_filename, abs_lw_liq_out, & -! ext_sw_liq_out, ssa_sw_liq_out, asm_sw_liq_out, g_lambda_out, g_mu_out, errmsg, errflg) - subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, nmu, nlambda, n_g_d, abs_lw_liq_out, abs_lw_ice_out, & - ext_sw_liq_out, ext_sw_ice_out, ssa_sw_liq_out, ssa_sw_ice_out, asm_sw_liq_out, & - asm_sw_ice_out, g_lambda_out, g_mu_out, g_d_eff_out, errmsg, errflg) - use ccpp_kinds, only: kind_phys + subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Inputs character(len=*), intent(in) :: liq_filename ! Full file path for liquid optics file character(len=*), intent(in) :: ice_filename ! Full file path for ice optics file ! Outputs - integer, intent(out) :: nmu - integer, intent(out) :: nlambda - integer, intent(out) :: n_g_d - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: abs_lw_liq_out ! Longwave mass specific absorption for in-cloud liquid water path - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ext_sw_liq_out - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: ssa_sw_liq_out - real(kind_phys), dimension(:,:,:), allocatable, intent(out) :: asm_sw_liq_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: abs_lw_ice_out ! Longwave mass specific absorption for in-cloud ice water path - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ext_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: ssa_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: asm_sw_ice_out - real(kind_phys), dimension(:,:), allocatable, intent(out) :: g_lambda_out ! lambda scale samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_mu_out ! Mu samples on grid - real(kind_phys), dimension(:), allocatable, intent(out) :: g_d_eff_out ! Radiative effective diameter samples on grid - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables class(abstract_netcdf_reader_t), allocatable :: file_reader - real(kind_phys), dimension(:), pointer :: g_mu - real(kind_phys), dimension(:), pointer :: g_d_eff - real(kind_phys), dimension(:,:), pointer :: g_lambda - real(kind_phys), dimension(:,:), pointer :: ext_sw_ice - real(kind_phys), dimension(:,:), pointer :: ssa_sw_ice - real(kind_phys), dimension(:,:), pointer :: asm_sw_ice - real(kind_phys), dimension(:,:), pointer :: abs_lw_ice - real(kind_phys), dimension(:,:,:), pointer :: ext_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: ssa_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: asm_sw_liq - real(kind_phys), dimension(:,:,:), pointer :: abs_lw_liq character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'rrtmgp_cloud_optics_setup_init' @@ -146,94 +130,6 @@ subroutine rrtmgp_cloud_optics_setup_init(liq_filename, ice_filename, nmu, nlamb return end if - ! Allocate output variables - allocate(g_mu_out(size(g_mu)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu_out, message: ', alloc_errmsg - return - end if - allocate(g_lambda_out(size(g_lambda,1), size(g_lambda,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda_out, message: ', alloc_errmsg - return - end if - allocate(g_d_eff_out(size(g_d_eff)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff_out, message: ', alloc_errmsg - return - end if - allocate(ext_sw_liq_out(size(ext_sw_liq,1),size(ext_sw_liq,2),size(ext_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(ext_sw_ice_out(size(ext_sw_ice,1),size(ext_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ext_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(asm_sw_liq_out(size(asm_sw_liq,1),size(asm_sw_liq,2),size(asm_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(asm_sw_ice_out(size(asm_sw_ice,1),size(asm_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating asm_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(ssa_sw_liq_out(size(ssa_sw_liq,1),size(ssa_sw_liq,2),size(ssa_sw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_liq_out, message: ', alloc_errmsg - return - end if - allocate(ssa_sw_ice_out(size(ssa_sw_ice,1),size(ssa_sw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating ssa_sw_ice_out, message: ', alloc_errmsg - return - end if - allocate(abs_lw_liq_out(size(abs_lw_liq,1),size(abs_lw_liq,2),size(abs_lw_liq,3)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq_out, message: ', alloc_errmsg - return - end if - allocate(abs_lw_ice_out(size(abs_lw_ice,1),size(abs_lw_ice,2)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice_out, message: ', alloc_errmsg - return - end if - - nmu = size(abs_lw_liq_out,1) - nlambda = size(abs_lw_liq_out,2) - n_g_d = size(abs_lw_ice_out,1) - - ext_sw_liq_out = ext_sw_liq - ext_sw_ice_out = ext_sw_ice - ssa_sw_liq_out = ssa_sw_liq - ssa_sw_ice_out = ssa_sw_ice - asm_sw_liq_out = asm_sw_liq - asm_sw_ice_out = asm_sw_ice - abs_lw_liq_out = abs_lw_liq - abs_lw_ice_out = abs_lw_ice - g_mu_out = g_mu - g_lambda_out = g_lambda - g_d_eff_out = g_d_eff - - ! Deallocate pointer variables - deallocate(g_mu, g_d_eff, g_lambda, ext_sw_ice, ssa_sw_ice, asm_sw_ice, abs_lw_ice, ext_sw_liq, & - ssa_sw_liq, asm_sw_liq, abs_lw_liq) - nullify(g_mu) - nullify(g_d_eff) - nullify(g_lambda) - nullify(ext_sw_ice) - nullify(ssa_sw_ice) - nullify(asm_sw_ice) - nullify(abs_lw_ice) - nullify(ext_sw_liq) - nullify(ssa_sw_liq) - nullify(asm_sw_liq) - nullify(abs_lw_liq) - end subroutine rrtmgp_cloud_optics_setup_init !============================================================================== diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta index 9615c5bb..6ec9b0c0 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.meta @@ -17,101 +17,6 @@ type = character | kind = len=* dimensions = () intent = in -[ nmu ] - standard_name = number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = out -[ nlambda ] - standard_name = number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid - units = count - type = integer - dimensions = () - intent = out -[ n_g_d ] - standard_name = number_of_radiative_effective_diameter_samples_on_ice_optics_grid - units = count - type = integer - dimensions = () - intent = out -[ abs_lw_liq_out ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_liquid_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid, number_of_bands_for_longwave_radiation) - allocatable = True - intent = out -[ abs_lw_ice_out ] - standard_name = longwave_mass_specific_absorption_for_in_cloud_ice_water_path - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_longwave_radiation) - allocatable = True - intent = out -[ ext_sw_liq_out ] - standard_name = shortwave_liquid_extinction - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ ext_sw_ice_out ] - standard_name = shortwave_ice_extinction - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ ssa_sw_liq_out ] - standard_name = shortwave_liquid_single_scattering_albedo - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ ssa_sw_ice_out ] - standard_name = shortwave_ice_single_scattering_albedo - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ asm_sw_liq_out ] - standard_name = shortwave_liquid_asymmetry_parameter - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid, number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ asm_sw_ice_out ] - standard_name = shortwave_ice_asymmetry_parameter - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - allocatable = True - intent = out -[ g_lambda_out ] - standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid - units = m-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - allocatable = True - intent = out -[ g_mu_out ] - standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - allocatable = True - intent = out -[ g_d_eff_out ] - standard_name = radiative_effective_diameter_samples_on_ice_optics_grid - units = microns - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) - allocatable = True - intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml index f593062f..57827af3 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml @@ -79,7 +79,7 @@ char*256 rrtmgp_cloud_optics radconst - filename_of_rrtmgp_liquid_cloud_optics_coefficients + filename_of_rrtmgp_ice_cloud_optics_coefficients none filepath and name for ice optics data for rrtmgp @@ -92,7 +92,7 @@ char*256 rrtmgp_cloud_optics radconst - filename_of_rrtmgp_ice_cloud_optics_coefficients + filename_of_rrtmgp_liquid_cloud_optics_coefficients none filepath and name for liquid optics data for rrtmgp diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 index f982f67b..178ef54c 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -26,6 +26,7 @@ module rrtmgp_lw_diagnostics public :: rrtmgp_lw_diagnostics_init ! init routine public :: rrtmgp_lw_diagnostics_run ! main routine + integer, parameter :: N_DIAG=10 character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) @@ -161,8 +162,8 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl call history_out_field('LWCF'//diag(icall), ftem) ! Output fluxes at 200 mb - call vertinterp(ncol, ncol, pverp, pint, 20000._r8, fnl, fln200) - call vertinterp(ncol, ncol, pverp, pint, 20000._r8, fcnl, fln200c) + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fnl, fln200) + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fcnl, fln200c) call history_out_field('FLN200'//diag(icall), fln200) call history_out_field('FLN200C'//diag(icall), fln200c) diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index d36408ba..c917ecfe 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,21 +10,23 @@ rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen rrtmgp_sw_gas_optics - rrtmgp_sw_cloud_optics + + rrtmgp_sw_cloud_temp rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics - rrtmgp_lw_main + rrtmgp_lw_rte rrtmgp_lw_calculate_fluxes - rrtmgp_lw_diagnostics + rrtmgp_inputs_setup rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post + geopotential_temp From 46f5a66a61b6f1afa427ddc4b9c07a631f1c50ec Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 1 Aug 2025 15:01:50 -0600 Subject: [PATCH 067/140] modify file i/o interface to match --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 128 +++++------------ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 134 ++++++------------ .../utils/rrtmgp_cloud_optics_setup.F90 | 26 ++-- 3 files changed, 92 insertions(+), 196 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 521638f5..29de2978 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -34,45 +34,45 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), pointer :: file_reader - character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band - integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), pointer :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), pointer :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), pointer :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable - integer, parameter :: missing_variable_error_code = 3 - character(len=256) :: alloc_errmsg - integer :: idx + class(abstract_netcdf_reader_t), pointer :: file_reader + character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band + integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), allocatable :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), allocatable :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), allocatable :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable + integer, parameter :: missing_variable_error_code = 3 + character(len=256) :: alloc_errmsg + integer :: idx ! Initialize error variables errmsg = '' @@ -210,7 +210,6 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -228,7 +227,6 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -246,7 +244,6 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -264,7 +261,6 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) if (errcode /= 0) then return @@ -313,52 +309,6 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) - ! Deallocate pointer variables - deallocate(gas_names, gas_minor, identifier_minor, minor_gases_lower, minor_gases_upper, & - scaling_gas_lower, scaling_gas_upper, key_species, band2gpt, minor_limits_gpt_lower, & - minor_limits_gpt_upper, kminor_start_lower, kminor_start_upper, minor_scales_with_density_lower, & - minor_scales_with_density_upper, scale_by_complement_lower, scale_by_complement_upper, & - kmajor, planck_frac, kminor_lower, kminor_upper, vmr_ref, band_lims_wavenum, totplnk, & - optimal_angle_fit, press_ref, temp_ref, press_ref_trop, temp_ref_p, temp_ref_t) - nullify(gas_names) - nullify(gas_minor) - nullify(identifier_minor) - nullify(minor_gases_lower) - nullify(minor_gases_upper) - nullify(scaling_gas_lower) - nullify(scaling_gas_upper) - nullify(key_species) - nullify(band2gpt) - nullify(minor_limits_gpt_lower) - nullify(minor_limits_gpt_upper) - nullify(kminor_start_lower) - nullify(kminor_start_upper) - nullify(minor_scales_with_density_lower) - nullify(minor_scales_with_density_upper) - nullify(scale_by_complement_lower) - nullify(scale_by_complement_upper) - nullify(kmajor) - nullify(planck_frac) - nullify(kminor_lower) - nullify(kminor_upper) - nullify(vmr_ref) - nullify(band_lims_wavenum) - nullify(totplnk) - nullify(optimal_angle_fit) - nullify(press_ref) - nullify(temp_ref) - nullify(press_ref_trop) - nullify(temp_ref_p) - nullify(temp_ref_t) - if (associated(rayl_lower)) then - deallocate(rayl_lower) - nullify(rayl_lower) - end if - if (associated(rayl_upper)) then - deallocate(rayl_upper) - nullify(rayl_upper) - end if - end subroutine rrtmgp_lw_gas_optics_init !> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 8e849e09..577ab382 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -32,48 +32,48 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & integer, intent(out) :: errcode ! CCPP error code ! Local variables - class(abstract_netcdf_reader_t), pointer :: file_reader - character(len=:), dimension(:), pointer :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), pointer :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), pointer :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), pointer :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), pointer :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), pointer :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), pointer :: key_species ! Key species pair for each band - integer, dimension(:,:), pointer :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), pointer :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), pointer :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), pointer :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), pointer :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), pointer :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), pointer :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), pointer :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), pointer :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:), pointer :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), pointer :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), pointer :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:), pointer :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), pointer :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), dimension(:), pointer :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), pointer :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] - real(kind_phys), pointer :: mg_default ! Mean value of Mg2 solar activity index [1] - real(kind_phys), pointer :: sb_default ! Mean value of sunspot index [1] - real(kind_phys), pointer :: tsi_default ! Default total solar irradiance [W m-2] - real(kind_phys), pointer :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), pointer :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), pointer :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), pointer :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), pointer :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + class(abstract_netcdf_reader_t), pointer :: file_reader + character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band + integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), dimension(:), allocatable :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), allocatable :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), allocatable :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] + real(kind_phys), allocatable :: mg_default ! Mean value of Mg2 solar activity index [1] + real(kind_phys), allocatable :: sb_default ! Mean value of sunspot index [1] + real(kind_phys), allocatable :: tsi_default ! Default total solar irradiance [W m-2] + real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. - integer, parameter :: missing_variable_error_code = 3 - character(len=256) :: alloc_errmsg - integer :: idx + integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + integer, parameter :: missing_variable_error_code = 3 + character(len=256) :: alloc_errmsg + integer :: idx ! Initialize error variables errmsg = '' @@ -223,7 +223,6 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -241,7 +240,6 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -259,7 +257,6 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) if (errcode /= 0) then return @@ -277,7 +274,6 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - nullify(int2log) call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) if (errcode /= 0) then return @@ -328,56 +324,6 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) - ! Deallocate pointer variables - deallocate(gas_names, gas_minor, identifier_minor, minor_gases_lower, minor_gases_upper, & - scaling_gas_lower, scaling_gas_upper, key_species, band2gpt, minor_limits_gpt_lower, & - minor_limits_gpt_upper, kminor_start_lower, kminor_start_upper, minor_scales_with_density_lower, & - minor_scales_with_density_upper, scale_by_complement_lower, scale_by_complement_upper, & - kmajor, kminor_lower, kminor_upper, vmr_ref, band_lims_wavenum, solar_src_quiet, & - solar_src_facular, solar_src_sunspot, mg_default, sb_default, tsi_default, press_ref, temp_ref, & - press_ref_trop, temp_ref_p, temp_ref_t) - nullify(gas_names) - nullify(gas_minor) - nullify(identifier_minor) - nullify(minor_gases_lower) - nullify(minor_gases_upper) - nullify(scaling_gas_lower) - nullify(scaling_gas_upper) - nullify(key_species) - nullify(band2gpt) - nullify(minor_limits_gpt_lower) - nullify(minor_limits_gpt_upper) - nullify(kminor_start_lower) - nullify(kminor_start_upper) - nullify(minor_scales_with_density_lower) - nullify(minor_scales_with_density_upper) - nullify(scale_by_complement_lower) - nullify(scale_by_complement_upper) - nullify(kmajor) - nullify(solar_src_quiet) - nullify(solar_src_facular) - nullify(solar_src_sunspot) - nullify(mg_default) - nullify(sb_default) - nullify(tsi_default) - nullify(kminor_lower) - nullify(kminor_upper) - nullify(vmr_ref) - nullify(band_lims_wavenum) - nullify(press_ref) - nullify(temp_ref) - nullify(press_ref_trop) - nullify(temp_ref_p) - nullify(temp_ref_t) - if (associated(rayl_lower)) then - deallocate(rayl_lower) - nullify(rayl_lower) - end if - if (associated(rayl_upper)) then - deallocate(rayl_upper) - nullify(rayl_upper) - end if - end subroutine rrtmgp_sw_gas_optics_init end module rrtmgp_sw_gas_optics diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 index f62d9bf0..3fc82d7d 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup.F90 @@ -11,19 +11,19 @@ module rrtmgp_cloud_optics_setup private public :: rrtmgp_cloud_optics_setup_init - integer, public :: nmu, nlambda - real(kind_phys), public, pointer :: g_mu(:) - real(kind_phys), public, pointer :: g_lambda(:,:) - real(kind_phys), public, pointer :: abs_lw_liq(:,:,:) - real(kind_phys), public, pointer :: ext_sw_liq(:,:,:) - real(kind_phys), public, pointer :: asm_sw_liq(:,:,:) - real(kind_phys), public, pointer :: ssa_sw_liq(:,:,:) - integer, public :: n_g_d - real(kind_phys), public, pointer :: g_d_eff(:) - real(kind_phys), public, pointer :: abs_lw_ice(:,:) - real(kind_phys), public, pointer :: ext_sw_ice(:,:) - real(kind_phys), public, pointer :: asm_sw_ice(:,:) - real(kind_phys), public, pointer :: ssa_sw_ice(:,:) + integer, public :: nmu, nlambda + real(kind_phys), public, allocatable :: g_mu(:) + real(kind_phys), public, allocatable :: g_lambda(:,:) + real(kind_phys), public, allocatable :: abs_lw_liq(:,:,:) + real(kind_phys), public, allocatable :: ext_sw_liq(:,:,:) + real(kind_phys), public, allocatable :: asm_sw_liq(:,:,:) + real(kind_phys), public, allocatable :: ssa_sw_liq(:,:,:) + integer, public :: n_g_d + real(kind_phys), public, allocatable :: g_d_eff(:) + real(kind_phys), public, allocatable :: abs_lw_ice(:,:) + real(kind_phys), public, allocatable :: ext_sw_ice(:,:) + real(kind_phys), public, allocatable :: asm_sw_ice(:,:) + real(kind_phys), public, allocatable :: ssa_sw_ice(:,:) contains From 8f302beb73f13e5ca61460e717346e1a535622c0 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 5 Aug 2025 09:31:44 -0600 Subject: [PATCH 068/140] fix int2log type --- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 577ab382..adcf8e32 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -70,7 +70,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), pointer :: int2log ! use this to convert integer-to-logical. + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg integer :: idx From 67b812d629350f76ecafbc41c7adce04d7b41abb Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 7 Aug 2025 13:26:48 -0600 Subject: [PATCH 069/140] lw answers match for 2 timesteps running radiation --- schemes/rrtmgp/rrtmgp_constituents.F90 | 6 +- schemes/rrtmgp/rrtmgp_constituents.meta | 4 +- schemes/rrtmgp/rrtmgp_inputs.meta | 8 +-- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 7 +-- .../rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 6 ++ .../rrtmgp_lw_calculate_heating_rate.F90 | 32 +++++++++++ .../rrtmgp_lw_calculate_heating_rate.meta | 55 +++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 6 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 4 +- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 2 +- schemes/rrtmgp/rrtmgp_post.F90 | 2 +- schemes/rrtmgp/rrtmgp_post.meta | 2 +- schemes/rrtmgp/rrtmgp_pre.F90 | 47 +++++++++------- schemes/rrtmgp/rrtmgp_pre.meta | 47 ++++++++++++++-- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 4 +- .../rrtmgp/utils/calculate_net_heating.meta | 2 +- test/test_suites/suite_rrtmgp.xml | 6 +- 18 files changed, 192 insertions(+), 50 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 4d61026a..cc57334b 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -180,7 +180,11 @@ subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg do gas_idx = 1, size(gaslist) ! Find the index of the current gas in the constituents array - call ccpp_constituent_index(trim(gaslist(gas_idx)), const_idx, errcode, errmsg) + if (trim(gaslist(gas_idx)) == 'H2O') then + call ccpp_constituent_index('water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', const_idx, errcode, errmsg) + else + call ccpp_constituent_index(trim(gaslist(gas_idx)), const_idx, errcode, errmsg) + end if if (errcode /= 0) then return end if diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 43eea7db..353ab173 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -89,9 +89,9 @@ intent = out [ rad_heat ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = K s-1 + units = J kg-1 s-1 type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_interface_dimension) + dimensions = (horizontal_dimension,vertical_layer_dimension) intent = out [ fsnt ] standard_name = shortwave_net_column_absorbed_solar_flux_at_model_top diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index abf2215a..9dce200d 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -57,7 +57,7 @@ standard_name = daytime_points units = index type = integer - dimensions = (vertical_layer_dimension) + dimensions = (horizontal_loop_extent) intent = in [ cldfprime ] standard_name = modified_cloud_area_fraction_for_RRTMGP @@ -111,19 +111,19 @@ standard_name = air_temperature_for_daytime_points_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (daytime_points_dimension, vertical_layer_dimension) intent = out [ pmid_day ] standard_name = air_pressure_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (daytime_points_dimension, vertical_layer_dimension) intent = out [ pint_day ] standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_interface_dimension) + dimensions = (daytime_points_dimension, vertical_interface_dimension) intent = out [ coszrs_day ] standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index 50a6f83b..ae7e05b2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -1,7 +1,6 @@ module rrtmgp_lw_calculate_fluxes use ccpp_kinds, only: kind_phys - implicit none private save @@ -14,7 +13,7 @@ module rrtmgp_lw_calculate_fluxes !> \section arg_table_rrtmgp_lw_calculate_fluxes_run Argument Table !! \htmlinclude rrtmgp_lw_calculate_fluxes_run.html subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp, nlay, ktopcam, ktoprad, & - active_calls, flw, flwc, flns, flnt, flwds, errmsg, errflg) + active_calls, flw, flwc, flns, flnt, flwds, fnl, errmsg, errflg) use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -32,6 +31,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object ! Output variables + real(kind_phys), intent(out) :: fnl(:,:) real(kind_phys), intent(out) :: flns(:) real(kind_phys), intent(out) :: flnt(:) real(kind_phys), intent(out) :: flwds(:) @@ -43,13 +43,12 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! Local variables integer :: diag_index, idx - real(kind_phys) :: fnl(ncol, pverp) real(kind_phys) :: fcnl(ncol, pverp) errmsg = '' errflg = 0 - diag_index = num_diag_subcycles - icall + diag_index = num_diag_subcycles - icall + 1 ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output if (.not. active_calls(diag_index)) then diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta index cb56c8c5..af46b1fa 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -83,6 +83,12 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = out +[ fnl ] + standard_name = longwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 new file mode 100644 index 00000000..4d9da03b --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -0,0 +1,32 @@ +module rrtmgp_lw_calculate_heating_rate + public :: rrtmgp_lw_calculate_heating_rate_run + +CONTAINS + !> \section arg_table_rrtmgp_lw_calculate_heating_rate_run Argument Table + !! \htmlinclude rrtmgp_lw_calculate_heating_rate_run.html + subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, hrate, errmsg, errflg) + use ccpp_kinds, only: kind_phys + integer, intent(in) :: ktopcam + integer, intent(in) :: pver + real(kind_phys), intent(in) :: gravit + real(kind_phys), intent(in) :: rpdel(:,:) + real(kind_phys), intent(in) :: flux_net(:,:) + real(kind_phys), intent(out) :: hrate(:,:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error variables + errmsg = '' + errflg = 0 + + hrate = 0.0_kind_phys + + do k = ktopcam, pver + ! (flux divergence as bottom-MINUS-top) * g/dp + hrate(:,k) = (flux_net(:,k+1) - flux_net(:,k)) * & + gravit * rpdel(:,k) + end do + + end subroutine rrtmgp_lw_calculate_heating_rate_run + +end module rrtmgp_lw_calculate_heating_rate diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta new file mode 100644 index 00000000..b6786471 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta @@ -0,0 +1,55 @@ +[ccpp-table-properties] + name = rrtmgp_lw_calculate_heating_rate + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_calculate_heating_rate_run + type = scheme +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rpdel ] + standard_name = reciprocal_of_air_pressure_thickness + units = Pa-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ flux_net ] + standard_name = longwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ hrate ] + 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 +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 665b7352..19ed7047 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -69,19 +69,19 @@ standard_name = air_pressure_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) intent = in [ p_lev ] standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_interface_dimension) + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_plus_one) intent = in [ t_lay ] standard_name = air_temperature_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) intent = in [ tsfg ] standard_name = ground_temperature_at_surface_for_radiation diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index 2d4e7a78..e0c2aeeb 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -12,13 +12,13 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_active_gases_for_RRTMGP) intent = in [ pmid ] - standard_name = air_pressure_for_RRTMGP + standard_name = air_pressure units = Pa type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ pint ] - standard_name = air_pressure_at_interface_for_RRTMGP + standard_name = air_pressure_at_interface units = Pa type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_interface_dimension) diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 8eb0629e..9eca0136 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -78,7 +78,7 @@ dimensions = () intent = in [ pmid ] - standard_name = air_pressure_for_RRTMGP + standard_name = air_pressure units = Pa type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 6e2be888..17e35a3c 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -37,7 +37,7 @@ subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_opt real(kind_phys), dimension(:,:), intent(out) :: qrs ! Shortwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] - real(kind_phys), dimension(:), intent(out) :: flwds ! Down longwave flux at surface [W m-2] + real(kind_phys), dimension(:), intent(inout) :: flwds ! Down longwave flux at surface [W m-2] character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 6902db00..9e7d458e 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -112,7 +112,7 @@ units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) - intent = out + intent = inout [ qrs ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation_adjusted_by_air_pressure_thickness units = J Pa kg-1 s-1 diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 9c2fd3b2..bd519852 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -1,5 +1,4 @@ module rrtmgp_pre - implicit none private @@ -50,18 +49,25 @@ end subroutine rrtmgp_pre_init !> \section arg_table_rrtmgp_pre_timestep_init Argument Table !! \htmlinclude rrtmgp_pre_timestep_init.html !! - subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) + subroutine rrtmgp_pre_timestep_init(ncol, coszrs, nstep, dtime, iradsw, irad_always, offset, & + idxday, nday, idxnite, nnite, errmsg, errflg) use ccpp_kinds, only: kind_phys + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: ncol ! Number of horizontal columns real(kind_phys), intent(in) :: dtime ! Timestep size integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: nday ! Number of daylight columns + integer, intent(out) :: nnite ! Number of nighttime columns + integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns integer, intent(out) :: offset ! Offset for next SW radiation timestep integer, intent(out) :: errflg character(len=512), intent(out) :: errmsg logical :: dosw_next - integer :: nstepsw_next + integer :: nstepsw_next, idx ! Get timestep of next radiation calculation dosw_next = .false. @@ -75,6 +81,20 @@ subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, e return end if end do + ! Gather night/day column indices. + nday = 0 + nnite = 0 + idxday = 0 + idxnite = 0 + do idx = 1, ncol + if ( coszrs(idx) > 0.0_kind_phys ) then + nday = nday + 1 + idxday(nday) = idx + else + nnite = nnite + 1 + idxnite(nnite) = idx + end if + end do end subroutine rrtmgp_pre_timestep_init @@ -107,10 +127,10 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object - integer, intent(out) :: nday ! Number of daylight columns - integer, intent(out) :: nnite ! Number of nighttime columns - integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns - integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns + integer, intent(in) :: nday ! Number of daylight columns + integer, intent(in) :: nnite ! Number of nighttime columns + integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(in) :: idxnite ! Indices of nighttime columns logical, intent(out) :: dosw ! Flag to do shortwave calculation logical, intent(out) :: dolw ! Flag to do longwave calculation logical, intent(out) :: dosw_heat ! Flag to calculate net shortwave heating @@ -125,19 +145,6 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco errflg = 0 errmsg = '' - ! Gather night/day column indices. - nday = 0 - nnite = 0 - do idx = 1, ncol - if ( coszrs(idx) > 0.0_kind_phys ) then - nday = nday + 1 - idxday(nday) = idx - else - nnite = nnite + 1 - idxnite(nnite) = idx - end if - end do - ! Determine if we're going to do longwave and/or shortwave this timestep call radiation_do_ccpp('sw', nstep, iradsw, irad_always, dosw, errmsg, errflg) if (errflg /= 0) then diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 778cef68..94c01c45 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -22,7 +22,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (number_of_active_gases_for_rrtmgp) + dimensions = (number_of_active_gases_for_RRTMGP) intent = out [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP @@ -48,6 +48,18 @@ [ccpp-arg-table] name = rrtmgp_pre_timestep_init type = scheme +[ ncol ] + standard_name = horizontal_dimension + units = count + type = integer + dimensions = () + intent = in +[ coszrs ] + standard_name = cosine_of_solar_zenith_angle_for_radiation + units = rad + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = in [ nstep ] standard_name = current_timestep_number units = count @@ -78,6 +90,31 @@ type = integer dimensions = () intent = out +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (horizontal_dimension) + intent = out +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = out +[ idxnite ] + standard_name = nighttime_points + units = index + type = integer + dimensions = (horizontal_dimension) + intent = out +[ nnite ] + standard_name = nighttime_points_dimension + units = count + type = integer + dimensions = () + intent = out + dimensions = () [ errmsg ] standard_name = ccpp_error_message long_name = Error message for error handling in CCPP @@ -150,25 +187,25 @@ units = index type = integer dimensions = (horizontal_loop_extent) - intent = out + intent = in [ nday ] standard_name = daytime_points_dimension units = count type = integer dimensions = () - intent = out + intent = in [ idxnite ] standard_name = nighttime_points units = index type = integer dimensions = (horizontal_loop_extent) - intent = out + intent = in [ nnite ] standard_name = nighttime_points_dimension units = count type = integer dimensions = () - intent = out + intent = in [ dosw ] standard_name = do_shortwave_radiation units = flag diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 368483c2..c65e5a82 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -150,7 +150,7 @@ The number of Gaussian quadrature angles for use in radiation - if less than zero, unused - -1 + 0 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index d10da171..03a4aaaf 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -57,7 +57,7 @@ standard_name = daytime_points units = index type = integer - dimensions = (daytime_points_dimension) + dimensions = (horizontal_loop_extent) intent = in [ fillvalue ] standard_name = fill_value_for_diagnostic_output @@ -99,7 +99,7 @@ standard_name = nighttime_points units = index type = integer - dimensions = (nighttime_points_dimension) + dimensions = (horizontal_loop_extent) intent = in [ cld ] standard_name = cloud_area_fraction diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta index f151df0c..5c7eac08 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.meta +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -13,7 +13,7 @@ intent = in [ rad_heat ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = K s-1 + units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index c917ecfe..95261b1a 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -4,7 +4,7 @@ rrtmgp_pre rrtmgp_cloud_optics_setup - tropopause_find + rrtmgp_variables rrtmgp_inputs rrtmgp_lw_cloud_optics @@ -19,6 +19,7 @@ rrtmgp_lw_gas_optics rrtmgp_lw_rte rrtmgp_lw_calculate_fluxes + rrtmgp_lw_calculate_heating_rate @@ -26,7 +27,8 @@ rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post + + apply_heating_rate geopotential_temp - From bb33f139dcb1bb2babf189013d2a9408e6d66ac8 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 8 Aug 2025 23:18:13 -0600 Subject: [PATCH 070/140] add initialize_constituents scheme to rrtmgp sdf --- test/test_suites/suite_rrtmgp.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 95261b1a..0dd3edc4 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -2,6 +2,7 @@ + initialize_constituents rrtmgp_pre rrtmgp_cloud_optics_setup From 18ee2e110b2d970a12b6d67ad37874ad985d10c1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 9 Aug 2025 00:29:38 -0600 Subject: [PATCH 071/140] add/update diagnostic schemes --- .../sima_diagnostics/rrtmgp_diagnostics.F90 | 11 +++- .../sima_diagnostics/rrtmgp_diagnostics.meta | 28 ++++++++-- .../rrtmgp_lw_diagnostics.F90 | 55 +++++++++---------- .../rrtmgp_lw_diagnostics.meta | 8 ++- test/test_suites/suite_rrtmgp.xml | 5 +- 5 files changed, 69 insertions(+), 38 deletions(-) diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 index 9a04ffa7..035075f5 100644 --- a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 @@ -29,13 +29,16 @@ end subroutine rrtmgp_diagnostics_init !> \section arg_table_rrtmgp_diagnostics_run Argument Table !! \htmlinclude rrtmgp_diagnostics_run.html - subroutine rrtmgp_diagnostics_run(write_output, ncol, pver, cappa, cpair, pmid, qrs, qrl, errmsg, errflg) + subroutine rrtmgp_diagnostics_run(write_output, active_calls, num_diag_subcycles, icall, ncol, pver, cappa, cpair, pmid, qrs, qrl, errmsg, errflg) use cam_history, only: history_out_field !------------------------------------------------ ! Input / output parameters !------------------------------------------------ logical, intent(in) :: write_output ! Flag to write output for radiation + logical, intent(in) :: active_calls(:) + integer, intent(in) :: icall + integer, intent(in) :: num_diag_subcycles integer, intent(in) :: ncol ! Number of horizontal points integer, intent(in) :: pver ! Number of vertical layers real(kind_phys), intent(in) :: cappa ! Ratio of dry air gas constant to specific heat of dry air at constant pressure @@ -50,13 +53,17 @@ subroutine rrtmgp_diagnostics_run(write_output, ncol, pver, cappa, cpair, pmid, ! Local variables integer :: idx, kdx + integer :: diag_index real(kind_phys) :: ftem(ncol, pver) errmsg = '' errflg = 0 + ! Diagnostic indices are reversed + diag_index = num_diag_subcycles - icall + ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output - if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + if ((.not. active_calls(diag_index+1)) .or. (.not. write_output)) then return end if diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_diagnostics.meta index 2c84b068..b0dea8d5 100644 --- a/schemes/sima_diagnostics/rrtmgp_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.meta @@ -27,6 +27,24 @@ type = logical dimensions = () intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ icall ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in [ ncol ] standard_name = horizontal_loop_extent units = count @@ -40,7 +58,7 @@ dimensions = () intent = in [ cappa ] - standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + standard_name = ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure units = 1 type = real | kind = kind_phys dimensions = () @@ -58,14 +76,14 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ qrs ] - standard_name = shortwave_diagnostic_radiative_heating_rate - units = K s-1 + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ qrl ] - standard_name = longwave_diagnostic_radiative_heating_rate - units = K s-1 + 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 = in diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 index 178ef54c..7ca427d1 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -77,17 +77,12 @@ subroutine rrtmgp_lw_diagnostics_init(num_diag_subcycles, active_calls, errmsg, end if end do - call history_add_field('EMIS', 'Cloud longwave emissivity', 'lev', 'avg', '1') - - ! Heating rate needed for d(theta)/dt computation - call history_add_field('HR', 'Heating rate needed for d(theat)/dt computation', 'lev', 'avg', 'K s-1') - end subroutine rrtmgp_lw_diagnostics_init !> \section arg_table_rrtmgp_lw_diagnostics_run Argument Table !! \htmlinclude rrtmgp_lw_diagnostics_run.html subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, flw, flwc, rpdel, ncol, & - nlay, pver, pverp, pint, gravit, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) + nlay, pver, pverp, pint, gravit, cpair, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) use cam_history, only: history_out_field use ccpp_fluxes, only: ty_fluxes_broadband_ccpp @@ -107,6 +102,7 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active logical, intent(in) :: write_output ! Flag to write output for radiation real(kind_phys), intent(in) :: gravit ! Standard gravitiational acceleration + real(kind_phys), intent(in) :: cpair real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at layer interfaces [Pa] real(kind_phys), intent(in) :: p_trop(:) ! Tropopause air pressure [Pa] real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of layer thickness [Pa-1] @@ -126,6 +122,7 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl real(kind_phys) :: fln200(ncol) real(kind_phys) :: fln200c(ncol) real(kind_phys) :: flnr(ncol) + real(kind_phys) :: ftem(ncol) errmsg = '' errflg = 0 @@ -134,7 +131,7 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl diag_index = num_diag_subcycles - icall ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output - if ((.not. active_calls(diag_index)) .or. (.not. write_output)) then + if ((.not. active_calls(diag_index+1)) .or. (.not. write_output)) then return end if @@ -145,44 +142,44 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl fnl( :,ktopcam:) = -1._kind_phys * flw%fluxes%flux_net( :, ktoprad:) fcnl(:,ktopcam:) = -1._kind_phys * flwc%fluxes%flux_net( :, ktoprad:) - call heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) - call heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) + call lw_heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) + call lw_heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) ! History out field calls - call history_out_field('QRL'//diag(icall), qrl(:ncol,:)/cpair) - call history_out_field('QRLC'//diag(icall), qrlc(:ncol,:)/cpair) + call history_out_field('QRL'//diag(diag_index), qrl(:,:)/cpair) + call history_out_field('QRLC'//diag(diag_index), qrlc(:,:)/cpair) - call history_out_field('FLNT'//diag(icall), fnl(:,ktopcam)) - call history_out_field('FLNTC'//diag(icall), fcnl(:,ktopcam)) + call history_out_field('FLNT'//diag(diag_index), fnl(:,ktopcam)) + call history_out_field('FLNTC'//diag(diag_index), fcnl(:,ktopcam)) - call history_out_field('FLUT'//diag(icall), flw%fluxes%flux_up(:, ktoprad)) - call history_out_field('FLUTC'//diag(icall), flwc%fluxes%flux_up(:, ktoprad)) + call history_out_field('FLUT'//diag(diag_index), flw%fluxes%flux_up(:, ktoprad)) + call history_out_field('FLUTC'//diag(diag_index), flwc%fluxes%flux_up(:, ktoprad)) ftem(:) = flwc%fluxes%flux_up(:, ktoprad) - flw%fluxes%flux_up(:, ktoprad) - call history_out_field('LWCF'//diag(icall), ftem) + call history_out_field('LWCF'//diag(diag_index), ftem) ! Output fluxes at 200 mb call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fnl, fln200) call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fcnl, fln200c) - call history_out_field('FLN200'//diag(icall), fln200) - call history_out_field('FLN200C'//diag(icall), fln200c) + call history_out_field('FLN200'//diag(diag_index), fln200) + call history_out_field('FLN200C'//diag(diag_index), fln200c) do idx = 1,ncol call vertinterp(1, 1, pverp, pint(idx,:), p_trop(idx), fnl(idx,:), flnr(idx)) end do - call history_out_field('FLNR'//diag(icall), flnr) + call history_out_field('FLNR'//diag(diag_index), flnr) - call history_out_field('FLNS'//diag(icall), fnl(:,pverp)) - call history_out_field('FLNSC'//diag(icall), fcnl(:,pverp)) + call history_out_field('FLNS'//diag(diag_index), fnl(:,pverp)) + call history_out_field('FLNSC'//diag(diag_index), fcnl(:,pverp)) - call history_out_field('FLDS'//diag(icall), flw%fluxes%flux_dn(:, nlay+1)) - call history_out_field('FLDSC'//diag(icall), flwc%fluxes%flux_dn(:, nlay+1)) + call history_out_field('FLDS'//diag(diag_index), flw%fluxes%flux_dn(:, nlay+1)) + call history_out_field('FLDSC'//diag(diag_index), flwc%fluxes%flux_dn(:, nlay+1)) ! Fluxes on the CAM grid - call history_out_field('FDL'//diag(icall), flw%fluxes%flux_dn( :, ktoprad:)) - call history_out_field('FDLC'//diag(icall), flwc%fluxes%flux_dn(:, ktoprad:)) - call history_out_field('FUL'//diag(icall), flw%fluxes%flux_up( :, ktoprad:)) - call history_out_field('FULC'//diag(icall), flwc%fluxes%flux_up(:, ktoprad:)) + call history_out_field('FDL'//diag(diag_index), flw%fluxes%flux_dn( :, ktoprad:)) + call history_out_field('FDLC'//diag(diag_index), flwc%fluxes%flux_dn(:, ktoprad:)) + call history_out_field('FUL'//diag(diag_index), flw%fluxes%flux_up( :, ktoprad:)) + call history_out_field('FULC'//diag(diag_index), flwc%fluxes%flux_up(:, ktoprad:)) end subroutine rrtmgp_lw_diagnostics_run @@ -193,6 +190,8 @@ subroutine lw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) ! arguments integer, intent(in) :: ncol + integer, intent(in) :: ktopcam + integer, intent(in) :: pver real(kind_phys), intent(in) :: flux_net(:,:) ! W m-2 real(kind_phys), intent(in) :: gravit ! m s-2 real(kind_phys), intent(in) :: rpdel(:,:) ! Pa @@ -204,7 +203,7 @@ subroutine lw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) do kdx = ktopcam, pver ! (flux divergence as bottom-MINUS-top) * g/dp hrate(:,kdx) = (flux_net(:,kdx+1) - flux_net(:,kdx)) * & - gravit * state%rpdel(:,kdx) + gravit * rpdel(:,kdx) end do end subroutine lw_heating_rate diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta index 08a4e56c..731bc585 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta @@ -105,8 +105,14 @@ type = real | kind = kind_phys dimensions = () intent = in +[ cpair ] + standard_name = specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in [ p_trop ] - standard_name = tropopause_air_pressure + standard_name = tropopause_air_pressure_from_hybrid_stobie_linoz_with_climatological_backup_method units = Pa type = real | kind = kind_phys dimensions = (horizontal_loop_extent) diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 0dd3edc4..2358c78f 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -5,7 +5,7 @@ initialize_constituents rrtmgp_pre rrtmgp_cloud_optics_setup - + tropopause_find rrtmgp_variables rrtmgp_inputs rrtmgp_lw_cloud_optics @@ -21,13 +21,14 @@ rrtmgp_lw_rte rrtmgp_lw_calculate_fluxes rrtmgp_lw_calculate_heating_rate - + rrtmgp_lw_diagnostics rrtmgp_inputs_setup rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post + rrtmgp_diagnostics apply_heating_rate geopotential_temp From d0fce42bc0217d68aeaa74f2613437fe358e0319 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 11 Aug 2025 16:51:45 -0600 Subject: [PATCH 072/140] initial metadata commit --- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 97 ++++++++++++++ schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 3 + .../rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta | 121 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_rte.meta | 115 +++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 6 + schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 113 ++++++++++++++++ 6 files changed, 455 insertions(+) create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_rte.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_solar_var.meta diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta new file mode 100644 index 00000000..f6e3dbe0 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -0,0 +1,97 @@ +[ccpp-table-properties] + name = rrtmgp_sw_gas_optics_pre + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_pre_run + type = scheme +[ rad_const_array ] + standard_name = radiatively_active_gas_mass_mixing_ratios_wrt_dry_air + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_active_gases_for_RRTMGP) + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ pint ] + standard_name = air_pressure_at_interface + units = enter_units + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ gaslist ] + standard_name = list_of_active_gases_for_RRTMGP + units = none + type = character | kind = len=* + dimensions = (number_of_active_gases_for_RRTMGP) + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (horizontal_loop_extent) + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ nradgas ] + standard_name = number_of_active_gases_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ gas_concs ] + standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 183f955e..94f387de 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -10,6 +10,9 @@ module rrtmgp_sw_mcica_subcol_gen contains !================================================================================================== +!> +!> \section arg_table_rrtmgp_sw_mcica_subcol_gen_run Argument Table +!! \htmlinclude rrtmgp_sw_mcica_subcol_gen_run.html subroutine 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, pmid, errmsg, errflg) diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta new file mode 100644 index 00000000..ccca8259 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta @@ -0,0 +1,121 @@ +[ccpp-table-properties] + name = rrtmgp_sw_mcica_subcol_gen + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_mcica_subcol_gen_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ kdist_sw ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ nswgpts ] + standard_name = number_of_shortwave_g_point_intervals + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ tiny ] + standard_name = definition_of_tiny_for_RRTMGP + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (horizontal_loop_extent) + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ c_cld_tau ] + standard_name = combined_shortwave_cloud_extinction_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ c_cld_tau_w ] + standard_name = combined_shortwave_cloud_single_scattering_albedo + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ c_cld_tau_w_g ] + standard_name = combined_shortwave_cloud_asymmetry_parameter + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ cloud_sw ] + standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta new file mode 100644 index 00000000..b90575cf --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -0,0 +1,115 @@ +[ccpp-table-properties] + name = rrtmgp_sw_rte + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_rte_run + type = scheme +[ doswrad ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ doswclrsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky + units = flag + type = logical + dimensions = () + intent = in +[ doswallsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_all_sky + units = flag + type = logical + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ sw_optical_props ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ sw_optical_props_clouds ] + standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ top_at_1 ] + standard_name = do_top_at_one_vertical_ordering_in_radiation + units = flag + type = logical + dimensions = () + intent = in +[ aersw ] + standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ coszen ] + standard_name = cosine_of_solar_zenith_angle_for_radiation + units = rad + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ toa_src_sw ] + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 + type = real | kind = kind_phys + dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) + intent = in +[ sfc_alb_dir ] + standard_name = albedo_direct_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = in +[ sfc_alb_dif ] + standard_name = albedo_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = in +[ flux_clrsky ] + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ flux_allsky ] + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 6b1bba64..cfa7c08d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -25,6 +25,9 @@ module rrtmgp_sw_solar_var contains !------------------------------------------------------------------------------- +!> \section arg_table_rrtmgp_sw_solar_var_init Argument Table +!! \htmlinclude rrtmgp_sw_solar_var_init.html +!! subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) use radiation_utils, only : get_sw_spectral_boundaries_ccpp integer, intent(in) :: nswbands ! number of shortwave bands @@ -80,6 +83,9 @@ end subroutine rrtmgp_sw_solar_var_init !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- +!> \section arg_table_rrtmgp_sw_solar_var_run Argument Table +!! \htmlinclude rrtmgp_sw_solar_var_run.html +!! subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & sfac, eccf, errmsg, errflg) diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta new file mode 100644 index 00000000..7dde8186 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -0,0 +1,113 @@ +[ccpp-table-properties] + name = rrtmgp_sw_solar_var + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_solar_var_init + type = scheme +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ do_spctrl_scaling ] + standard_name = do_spectral_scaling + units = flag + type = logical + dimensions = () + intent = in +[ has_spectrum ] + standard_name = solar_irradiance_file_has_spectrum_information + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_sw_solar_var_run + type = scheme +[ toa_flux ] + standard_name = enter_standard_name_6 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_18:enter_standard_name_19,enter_standard_name_20:enter_standard_name_21) + intent = inout +[ band2gpt_sw ] + standard_name = enter_standard_name_11 + units = enter_units + type = integer + dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + intent = in +[ nswbands ] + standard_name = enter_standard_name_12 + units = enter_units + type = integer + dimensions = () + intent = in +[ sol_irrad ] + standard_name = enter_standard_name_8 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_26:enter_standard_name_27) + intent = in +[ we ] + standard_name = enter_standard_name_9 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_28:enter_standard_name_29) + intent = in +[ nbins ] + standard_name = enter_standard_name_10 + units = enter_units + type = integer + dimensions = () + intent = in +[ sol_tsi ] + standard_name = enter_standard_name_7 + units = enter_units + type = real | kind = kind_phys + dimensions = () + intent = in +[ do_spctrl_scaling ] + standard_name = enter_standard_name_13 + units = enter_units + type = logical + dimensions = () + intent = in +[ sfac ] + standard_name = enter_standard_name_15 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_30:enter_standard_name_31,enter_standard_name_32:enter_standard_name_33) + intent = out +[ eccf ] + standard_name = enter_standard_name_14 + units = enter_units + type = real | kind = kind_phys + dimensions = () + intent = in +[ errmsg ] + standard_name = enter_standard_name_16 + units = enter_units + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = enter_standard_name_17 + units = enter_units + type = integer + dimensions = () + intent = out From d491b84429f6726db517df498cf39402bb584569 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 12 Aug 2025 15:48:24 -0600 Subject: [PATCH 073/140] perhaps don't redundantly calculate things --- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 4 +- .../rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 6 +++ .../rrtmgp_lw_calculate_heating_rate.F90 | 10 ++++- .../rrtmgp_lw_calculate_heating_rate.meta | 14 +++++- schemes/rrtmgp/rrtmgp_lw_rte.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 4 +- .../rrtmgp_lw_diagnostics.F90 | 45 +++---------------- .../rrtmgp_lw_diagnostics.meta | 24 ++++++++++ 8 files changed, 63 insertions(+), 46 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index ae7e05b2..ad2f8729 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -13,7 +13,7 @@ module rrtmgp_lw_calculate_fluxes !> \section arg_table_rrtmgp_lw_calculate_fluxes_run Argument Table !! \htmlinclude rrtmgp_lw_calculate_fluxes_run.html subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp, nlay, ktopcam, ktoprad, & - active_calls, flw, flwc, flns, flnt, flwds, fnl, errmsg, errflg) + active_calls, flw, flwc, flns, flnt, flwds, fnl, fcnl, errmsg, errflg) use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -32,6 +32,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object ! Output variables real(kind_phys), intent(out) :: fnl(:,:) + real(kind_phys), intent(out) :: fcnl(:,:) real(kind_phys), intent(out) :: flns(:) real(kind_phys), intent(out) :: flnt(:) real(kind_phys), intent(out) :: flwds(:) @@ -43,7 +44,6 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! Local variables integer :: diag_index, idx - real(kind_phys) :: fcnl(ncol, pverp) errmsg = '' errflg = 0 diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta index af46b1fa..4bd967a3 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -89,6 +89,12 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out +[ fcnl ] + standard_name = longwave_net_radiative_clear_sky_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 index 4d9da03b..e389f51d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -4,27 +4,35 @@ module rrtmgp_lw_calculate_heating_rate CONTAINS !> \section arg_table_rrtmgp_lw_calculate_heating_rate_run Argument Table !! \htmlinclude rrtmgp_lw_calculate_heating_rate_run.html - subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, hrate, errmsg, errflg) + subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, & + flux_net_clrsky, hrate, hrate_clrsky, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ktopcam integer, intent(in) :: pver real(kind_phys), intent(in) :: gravit real(kind_phys), intent(in) :: rpdel(:,:) real(kind_phys), intent(in) :: flux_net(:,:) + real(kind_phys), intent(in) :: flux_net_clrsky(:,:) real(kind_phys), intent(out) :: hrate(:,:) + real(kind_phys), intent(out) :: hrate_clrsky(:,:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: k + ! Set error variables errmsg = '' errflg = 0 hrate = 0.0_kind_phys + hrate_clrsky = 0.0_kind_phys do k = ktopcam, pver ! (flux divergence as bottom-MINUS-top) * g/dp hrate(:,k) = (flux_net(:,k+1) - flux_net(:,k)) * & gravit * rpdel(:,k) + hrate_clrsky(:,k) = (flux_net_clrsky(:,k+1) - flux_net_clrsky(:,k)) * & + gravit * rpdel(:,k) end do end subroutine rrtmgp_lw_calculate_heating_rate_run diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta index b6786471..0209a089 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta @@ -35,8 +35,20 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = in +[ flux_net_clrsky ] + standard_name = longwave_net_radiative_clear_sky_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in [ hrate ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation + 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 +[ hrate_clrsky ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_clear_sky_longwave_radiation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index b82d00d8..717d08f5 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -98,7 +98,7 @@ standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP units = W m-2 K-1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = inout [ lw_Ds ] standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index b20b0c57..7583cd40 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -67,7 +67,7 @@ standard_name = air_pressure_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimensions, vertical_layer_dimension) + dimensions = (daytime_points_dimension, vertical_layer_dimension) intent = in [ p_lev ] standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP @@ -79,7 +79,7 @@ standard_name = air_temperature_for_daytime_points_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (daytime_points_dimensions, vertical_layer_dimension) + dimensions = (daytime_points_dimension, vertical_layer_dimension) intent = in [ gas_concs ] standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 index 7ca427d1..08647bf6 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -82,7 +82,8 @@ end subroutine rrtmgp_lw_diagnostics_init !> \section arg_table_rrtmgp_lw_diagnostics_run Argument Table !! \htmlinclude rrtmgp_lw_diagnostics_run.html subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, flw, flwc, rpdel, ncol, & - nlay, pver, pverp, pint, gravit, cpair, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) + nlay, pver, pverp, pint, gravit, cpair, p_trop, fnl, fcnl, qrl, qrlc, ktopcam, ktoprad, & + write_output, errmsg, errflg) use cam_history, only: history_out_field use ccpp_fluxes, only: ty_fluxes_broadband_ccpp @@ -106,6 +107,10 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at layer interfaces [Pa] real(kind_phys), intent(in) :: p_trop(:) ! Tropopause air pressure [Pa] real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of layer thickness [Pa-1] + real(kind_phys), intent(in) :: fnl(:,:) ! Net allsky longwave flux [W m-2] + real(kind_phys), intent(in) :: fcnl(:,:) ! Net clearsky longwave flux [W m-2] + real(kind_phys), intent(in) :: qrl(:,:) ! Heating rate (longwave, all-sky) [J kg-1 s-1] + real(kind_phys), intent(in) :: qrlc(:,:) ! Heating rate (longwave, clear-sky) [J kg-2 s-1] type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object @@ -115,10 +120,6 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl ! Local variables integer :: diag_index, idx - real(kind_phys) :: fnl(ncol, pverp) - real(kind_phys) :: fcnl(ncol, pverp) - real(kind_phys) :: qrl(ncol, pver) - real(kind_phys) :: qrlc(ncol, pver) real(kind_phys) :: fln200(ncol) real(kind_phys) :: fln200c(ncol) real(kind_phys) :: flnr(ncol) @@ -135,16 +136,6 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl return end if - fnl = 0.0_kind_phys - fcnl = 0.0_kind_phys - - ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! - fnl( :,ktopcam:) = -1._kind_phys * flw%fluxes%flux_net( :, ktoprad:) - fcnl(:,ktopcam:) = -1._kind_phys * flwc%fluxes%flux_net( :, ktoprad:) - - call lw_heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) - call lw_heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) - ! History out field calls call history_out_field('QRL'//diag(diag_index), qrl(:,:)/cpair) call history_out_field('QRLC'//diag(diag_index), qrlc(:,:)/cpair) @@ -183,28 +174,4 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl end subroutine rrtmgp_lw_diagnostics_run - !======================================================================= - - subroutine lw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) - ! Compute heating rate as a dry static energy tendency - - ! arguments - integer, intent(in) :: ncol - integer, intent(in) :: ktopcam - integer, intent(in) :: pver - real(kind_phys), intent(in) :: flux_net(:,:) ! W m-2 - real(kind_phys), intent(in) :: gravit ! m s-2 - real(kind_phys), intent(in) :: rpdel(:,:) ! Pa - real(kind_phys), intent(out) :: hrate(:,:) ! J kg-1 s-1 - - ! local vars - integer :: kdx - - do kdx = ktopcam, pver - ! (flux divergence as bottom-MINUS-top) * g/dp - hrate(:,kdx) = (flux_net(:,kdx+1) - flux_net(:,kdx)) * & - gravit * rpdel(:,kdx) - end do - end subroutine lw_heating_rate - end module rrtmgp_lw_diagnostics diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta index 731bc585..b6f364a6 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta @@ -117,6 +117,30 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in +[ fnl ] + standard_name = longwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ fcnl ] + standard_name = longwave_net_radiative_clear_sky_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ qrl ] + 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 = in +[ qrlc ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_clear_sky_longwave_radiation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in [ ktopcam ] standard_name = vertical_index_at_top_level_where_RRTMGP_is_active units = index From 2605f3f54791651c34f1ff6110010a296ae87e00 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 12 Aug 2025 15:49:52 -0600 Subject: [PATCH 074/140] more sw metadata --- schemes/rrtmgp/rrtmgp_constituents.F90 | 4 +- schemes/rrtmgp/rrtmgp_constituents.meta | 6 - schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 2 +- .../rrtmgp_lw_calculate_heating_rate.F90 | 2 + schemes/rrtmgp/rrtmgp_subcycle.F90 | 21 +- schemes/rrtmgp/rrtmgp_subcycle.meta | 27 +++ schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 | 112 ++++++++++ .../rrtmgp/rrtmgp_sw_calculate_fluxes.meta | 145 ++++++++++++ .../rrtmgp_sw_calculate_heating_rate.F90 | 34 +++ .../rrtmgp_sw_calculate_heating_rate.meta | 55 +++++ schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 56 ++--- .../rrtmgp_sw_diagnostics.F90 | 210 ++++++++++++++++++ test/test_suites/suite_rrtmgp.xml | 17 +- 13 files changed, 651 insertions(+), 40 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta create mode 100644 schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index cc57334b..27493d40 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -114,14 +114,13 @@ end subroutine rrtmgp_constituents_register !> \section arg_table_rrtmgp_constituents_init Argument Table !! \htmlinclude rrtmgp_constituents_int.html !! - subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_call_array, & + subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, & rrtmgp_phys_blksz, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & use_tlev, top_at_one, errmsg, errcode) use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag integer, intent(in) :: ncol real(kind_phys), intent(in) :: unset_real - integer, intent(out) :: diag_cur logical, intent(out) :: active_call_array(:) integer, intent(out) :: rrtmgp_phys_blksz real(kind_phys), intent(out) :: tlev(:,:) @@ -143,7 +142,6 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, diag_cur, active_ca is_first_restart_step = .false. top_at_one = .true. - diag_cur = 1 rrtmgp_phys_blksz = ncol ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA use_tlev = .false. diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 353ab173..72e3aa33 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -57,12 +57,6 @@ type = real | kind = kind_phys dimensions = () intent = in -[ diag_cur ] - standard_name = iteration_number_for_radiation_subcycle - units = count - type = integer - dimensions = () - intent = out [ active_call_array ] standard_name = is_active_diagnostic_call_array units = flag diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index ae7e05b2..de44b47e 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -50,7 +50,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp diag_index = num_diag_subcycles - icall + 1 - ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output + ! Don't do anything if this subcycle is inactive if (.not. active_calls(diag_index)) then return end if diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 index 4d9da03b..50e6d940 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -15,6 +15,8 @@ subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, fl character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: k + ! Set error variables errmsg = '' errflg = 0 diff --git a/schemes/rrtmgp/rrtmgp_subcycle.F90 b/schemes/rrtmgp/rrtmgp_subcycle.F90 index d5af0d79..61102e36 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.F90 +++ b/schemes/rrtmgp/rrtmgp_subcycle.F90 @@ -7,15 +7,34 @@ module rrtmgp_subcycle public rrtmgp_subcycle_run contains +!> \section arg_table_rrtmgp_subcycle_init Argument Table +!! \htmlinclude rrtmgp_subcycle_init +!! + subroutine rrtmgp_subcycle_init(diag_cur, errmsg, errcode) + integer, intent(out) :: diag_cur + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + errmsg = '' + errflg = 0 + diag_cur = 1 + end subroutine rrtmgp_subcycle_init + !> \section arg_table_rrtmgp_subcycle_run Argument Table !! \htmlinclude rrtmgp_subcycle_run.html !! - subroutine rrtmgp_subcycle_run(diag_cur, errmsg, errcode) + subroutine rrtmgp_subcycle_run(diag_cur, num_diag_cycles, errmsg, errcode) + integer, intent(in) :: num_diag_cycles integer, intent(inout) :: diag_cur character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + errmsg = '' + errflg = 0 diag_cur = diag_cur + 1 + if (diag_cur > num_diag_cycles) then + diag_cur = 1 + end if end subroutine rrtmgp_subcycle_run end module rrtmgp_subcycle diff --git a/schemes/rrtmgp/rrtmgp_subcycle.meta b/schemes/rrtmgp/rrtmgp_subcycle.meta index d107e934..8531fe27 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.meta +++ b/schemes/rrtmgp/rrtmgp_subcycle.meta @@ -2,6 +2,27 @@ name = rrtmgp_subcycle type = scheme +[ccpp-arg-table] + name = rrtmgp_subcycle_init + type = scheme +[ diag_cur ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out [ccpp-arg-table] name = rrtmgp_subcycle_run type = scheme @@ -11,6 +32,12 @@ type = integer dimensions = () intent = inout +[ num_diag_cycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 new file mode 100644 index 00000000..2c039cfb --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 @@ -0,0 +1,112 @@ +module rrtmgp_sw_calculate_fluxes + + use ccpp_kinds, only: kind_phys + implicit none + private + save + + public :: rrtmgp_sw_calculate_fluxes_run ! main routine + + +CONTAINS + + !> \section arg_table_rrtmgp_sw_calculate_fluxes_run Argument Table + !! \htmlinclude rrtmgp_sw_calculate_fluxes_run.html + subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp, nlay, nday, idxday, ktopcam, ktoprad, & + active_calls, fsw, fswc, fns, fcns, fsds, fsns, fsnt, soll, sols, solld, solsd, errmsg, errflg) + + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles + integer, intent(in) :: icall ! Current diagnostic subcycle + integer, intent(in) :: pverp ! Number of vertical layer interfaces + integer, intent(in) :: ncol + integer, intent(in) :: nlay + integer, intent(in) :: nday + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: idxday(:) + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + type(ty_fluxes_byband_ccpp), intent(in) :: fsw ! Shortwave all-sky flux object + type(ty_fluxes_broadband_ccpp), intent(in) :: fswc ! Shortwave clear-sky flux object + ! Output variables + real(kind_phys), intent(out) :: fns(:,:) + real(kind_phys), intent(out) :: fcns(:,:) + real(kind_phys), intent(out) :: fsds(:) + real(kind_phys), intent(out) :: fsns(:) + real(kind_phys), intent(out) :: fsnt(:) + real(kind_phys), intent(out) :: soll(:) + real(kind_phys), intent(out) :: sols(:) + real(kind_phys), intent(out) :: solld(:) + real(kind_phys), intent(out) :: solsd(:) + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: diag_index, idx + real(kind_phys), dimension(size(fsw%fluxes%bnd_flux_dn,1), & + size(fsw%fluxes%bnd_flux_dn,2), & + size(fsw%fluxes%bnd_flux_dn,3)) :: flux_dn_diffuse + + errmsg = '' + errflg = 0 + + diag_index = num_diag_subcycles - icall + 1 + + ! Don't do anything if this subcycle is inactive + if (.not. active_calls(diag_index)) then + return + end if + + ! Initialize to provide 0.0 values for night columns. + fns = 0.0_kind_phys + fcns = 0.0_kind_phys + fsds = 0.0_kind_phys + fsns = 0.0_kind_phys + fsnt = 0.0_kind_phys + soll = 0.0_kind_phys + sols = 0.0_kind_phys + solld = 0.0_kind_phys + solsd = 0.0_kind_phys + + do idx = 1, nday + fns(idxday(idx), ktopcam:) = fsw%fluxes%flux_net(idx, ktoprad:) + fcns(idxday(idx), ktopcam:) = fswc%fluxes%flux_net(idx, ktoprad:) + fsds(idxday(idx)) = fsw%fluxes%flux_dn(idx, nlay+1) + end do + + fsns(:) = fns(:, pverp) + fsnt(:) = fns(:, ktopcam) + + ! Export surface fluxes + ! sols(pcols) Direct solar rad on surface (< 0.7) + ! soll(pcols) Direct solar rad on surface (>= 0.7) + ! RRTMGP: Near-IR bands (1-10), 820-16000 cm-1, 0.625-12.195 microns + ! Put half of band 10 in each of the UV/visible and near-IR values, + ! since this band straddles 0.7 microns: + ! UV/visible bands 10-13, 16000-50000 cm-1, 0.200-0.625 micron + ! Calculate diffuse flux from total and direct + flux_dn_diffuse = fsw%fluxes%bnd_flux_dn - fsw%fluxes%bnd_flux_dn_dir + + do idx = 1, nday + soll(idxday(idx)) = sum(fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,1:9)) & + + 0.5_kind_phys * fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,10) + + sols(idxday(idx)) = 0.5_kind_phys * fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,10) & + + sum(fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,11:14)) + + solld(idxday(idx)) = sum(flux_dn_diffuse(idx,nlay+1,1:9)) & + + 0.5_kind_phys * flux_dn_diffuse(idx,nlay+1,10) + + solsd(idxday(idx)) = 0.5_kind_phys * flux_dn_diffuse(idx, nlay+1, 10) & + + sum(flux_dn_diffuse(idx,nlay+1,11:14)) + end do + end subroutine rrtmgp_sw_calculate_fluxes_run + +end module rrtmgp_sw_calculate_fluxes diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta new file mode 100644 index 00000000..a8b9805a --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta @@ -0,0 +1,145 @@ +[ccpp-table-properties] + name = rrtmgp_sw_calculate_fluxes + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_calculate_fluxes_run + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ icall ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (horizontal_loop_extent) + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ fsw ] + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = in +[ fswc ] + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = in +[ fns ] + standard_name = shortwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out +[ fcns ] + standard_name = shortwave_net_clear_sky_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = out +[ fsds ] + standard_name = shortwave_downward_solar_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ fsns ] + standard_name = shortwave_net_upward_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ fsnt ] + standard_name = shortwave_net_outgoing_flux_at_model_top + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ soll ] + standard_name = direct_solar_radiative_flux_at_surface_ge_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ sols ] + standard_name = direct_solar_radative_flux_at_surface_lt_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ solld ] + standard_name = diffuse_solar_radiative_flux_at_surface_ge_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ solsd ] + standard_name = diffuse_solar_radative_flux_at_surface_lt_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 new file mode 100644 index 00000000..c5952e5a --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 @@ -0,0 +1,34 @@ +module rrtmgp_sw_calculate_heating_rate + public :: rrtmgp_sw_calculate_heating_rate_run + +CONTAINS + !> \section arg_table_rrtmgp_sw_calculate_heating_rate_run Argument Table + !! \htmlinclude rrtmgp_sw_calculate_heating_rate_run.html + subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, hrate, errmsg, errflg) + use ccpp_kinds, only: kind_phys + integer, intent(in) :: ktopcam + integer, intent(in) :: pver + real(kind_phys), intent(in) :: gravit + real(kind_phys), intent(in) :: rpdel(:,:) + real(kind_phys), intent(in) :: flux_net(:,:) + real(kind_phys), intent(out) :: hrate(:,:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: k + + ! Set error variables + errmsg = '' + errflg = 0 + + hrate = 0.0_kind_phys + + do k = ktopcam, pver + ! top - bottom + hrate(:,k) = (flux_net(:,k) - flux_net(:,k+1)) * & + gravit * rpdel(:,k) + end do + + end subroutine rrtmgp_sw_calculate_heating_rate_run + +end module rrtmgp_sw_calculate_heating_rate diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta new file mode 100644 index 00000000..586b1eb9 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta @@ -0,0 +1,55 @@ +[ccpp-table-properties] + name = rrtmgp_sw_calculate_heating_rate + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_calculate_heating_rate_run + type = scheme +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rpdel ] + standard_name = reciprocal_of_air_pressure_thickness + units = Pa-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ flux_net ] + standard_name = shortwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ hrate ] + standard_namei = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index 7dde8186..08be508c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -40,74 +40,74 @@ name = rrtmgp_sw_solar_var_run type = scheme [ toa_flux ] - standard_name = enter_standard_name_6 - units = enter_units + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 type = real | kind = kind_phys - dimensions = (enter_standard_name_18:enter_standard_name_19,enter_standard_name_20:enter_standard_name_21) + dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) intent = inout [ band2gpt_sw ] - standard_name = enter_standard_name_11 + standard_name = shortwave_start_and_end_gpoint_for_each_band units = enter_units type = integer - dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) intent = in [ nswbands ] - standard_name = enter_standard_name_12 - units = enter_units + standard_name = number_of_bands_for_shortwave_radiation + units = count type = integer dimensions = () intent = in [ sol_irrad ] - standard_name = enter_standard_name_8 - units = enter_units + standard_name = solar_irradiance + units = W m-2 nm-1 type = real | kind = kind_phys - dimensions = (enter_standard_name_26:enter_standard_name_27) + dimensions = (number_of_wavelength_samples_of_spectrum) intent = in [ we ] - standard_name = enter_standard_name_9 - units = enter_units + standard_name = wavelength_endpoints + units = 1 type = real | kind = kind_phys - dimensions = (enter_standard_name_28:enter_standard_name_29) + dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) intent = in [ nbins ] - standard_name = enter_standard_name_10 - units = enter_units + standard_name = number_of_wavelength_samples_of_spectrum + units = count type = integer dimensions = () intent = in [ sol_tsi ] - standard_name = enter_standard_name_7 - units = enter_units + standard_name = total_solar_irradiance + units = W m-2 type = real | kind = kind_phys dimensions = () intent = in [ do_spctrl_scaling ] - standard_name = enter_standard_name_13 - units = enter_units + standard_name = do_spectral_scaling + units = flag type = logical dimensions = () intent = in [ sfac ] - standard_name = enter_standard_name_15 - units = enter_units + standard_name = scaling_factors_for_top_of_atmosphere_solar_radiation_flux + units = 1 type = real | kind = kind_phys - dimensions = (enter_standard_name_30:enter_standard_name_31,enter_standard_name_32:enter_standard_name_33) + dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) intent = out [ eccf ] - standard_name = enter_standard_name_14 - units = enter_units + standard_name = planet_orbital_eccentricity_factor + units = 1 type = real | kind = kind_phys dimensions = () intent = in [ errmsg ] - standard_name = enter_standard_name_16 - units = enter_units + standard_name = ccpp_error_message + units = none type = character | kind = len=512 dimensions = () intent = out [ errflg ] - standard_name = enter_standard_name_17 - units = enter_units + standard_name = ccpp_error_code + units = 1 type = integer dimensions = () intent = out diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 new file mode 100644 index 00000000..b947824e --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -0,0 +1,210 @@ +module rrtmgp_sw_diagnostics +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! THIS IS A TEMPLATE +! 1. copy this file to a new file with the correct name +! (rrtmgp_sw_diagnostics.F90) +! 2. do a search and replace for "rrtmgp_sw" in this file and +! replace with your scheme name +! 3. Add desired history_add_field calls to the init phase +! 4. Add all fields that are being output as inputs to the run phase +! 5. Add desired history_out_field calls to the run phase +! 6. Run $ccpp_framework/scripts/ccpp_fortran_to_metadata.py on this .F90 +! file to generate the metadata +! 7. Complete the metadata (fill out standard names, units, dimensions) +! 8. Add this scheme to the SDF file for your suite (likely will be at end) +! 9. Delete this header section +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rrtmgp_sw_diagnostics_init ! init routine + public :: rrtmgp_sw_diagnostics_run ! main routine + + integer, parameter :: N_DIAG=10 + character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ',& + '_d6 ','_d7 ','_d8 ','_d9 ','_d10'/) + +CONTAINS + + !> \section arg_table_rrtmgp_sw_diagnostics_init Argument Table + !! \htmlinclude rrtmgp_sw_diagnostics_init.html + subroutine rrtmgp_sw_diagnostics_init(num_diag_subcycles, active_calls, errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + integer, intent(in) :: num_diag_subcycles ! Number of diagnostic subcycles + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + integer :: icall + + errmsg = '' + errflg = 0 + + ! Loop over number of diagnostics subcycles + ! and add the relevant fields for each cycle if it's active + do icall = 1, num_diag_subcycles + if (active_calls(icall)) then + call history_add_field('QRS'//diag(icall-1), 'Shortwave heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('QRSC'//diag(icall-1), 'Clearsky shortwave heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('FSNT'//diag(icall-1), 'Net shortwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNTC'//diag(icall-1), 'Clearky net shortwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FSUT'//diag(icall-1), 'Upwelling shortwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FSUTC'//diag(icall-1), 'Clearsky upwelling shortwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('SWCF'//diag(icall-1), 'Shortwave cloud forcing', horiz_only, 'avg', 'W m-2') + call history_add_field('FSN200'//diag(icall-1), 'Net shortwave flux at 200 mb', horiz_only, 'avg', 'W m-2') + call history_add_field('FSN200C'//diag(icall-1), 'Clearsky net shortwave flux at 200 mb', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNR'//diag(icall-1), 'Net shortwave flux at tropopause', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNS'//diag(icall-1), 'Net shortwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNSC'//diag(icall-1), 'Clearsky net shortwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSDS'//diag(icall-1), 'Downwelling shortwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSDSC'//diag(icall-1), 'Clearky Downwelling shortwave flux at surface', horiz_only, 'avg', 'W m-2') + + ! Fluxes on CAM grid + call history_add_field('FUS'//diag(icall-1), 'Shortwave upward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FDS'//diag(icall-1), 'Shortwave downward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FUSC'//diag(icall-1), 'Shortwave clear-sky upward flux', 'ilev', 'inst', 'W m-2') + call history_add_field('FDSC'//diag(icall-1), 'Shortwave clear-sky downward flux', 'ilev', 'inst', 'W m-2') + end if + end do + + end subroutine rrtmgp_sw_diagnostics_init + + !> \section arg_table_rrtmgp_sw_diagnostics_run Argument Table + !! \htmlinclude rrtmgp_sw_diagnostics_run.html + subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fsw, fswc, rpdel, ncol, & + nlay, pver, pverp, pint, gravit, cpair, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) + + use cam_history, only: history_out_field + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use interpolate_data, only: vertinterp + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles + integer, intent(in) :: icall ! Current diagnostic subcycle + integer, intent(in) :: ncol ! Number of horizontal points + integer, intent(in) :: nlay ! Number of vertical layers used in radiation calcluation + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: pverp ! Number of vertical layer interfaces + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active + logical, intent(in) :: write_output ! Flag to write output for radiation + real(kind_phys), intent(in) :: gravit ! Standard gravitiational acceleration + real(kind_phys), intent(in) :: cpair + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at layer interfaces [Pa] + real(kind_phys), intent(in) :: p_trop(:) ! Tropopause air pressure [Pa] + real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of layer thickness [Pa-1] + type(ty_fluxes_byband_ccpp), intent(in) :: fsw ! Shortwave all-sky flux object + type(ty_fluxes_broadband_ccpp), intent(in) :: fswc ! Shortwave clear-sky flux object + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: diag_index, idx + real(kind_phys) :: fnl(ncol, pverp) + real(kind_phys) :: fcnl(ncol, pverp) + real(kind_phys) :: qrl(ncol, pver) + real(kind_phys) :: qrlc(ncol, pver) + real(kind_phys) :: fln200(ncol) + real(kind_phys) :: fln200c(ncol) + real(kind_phys) :: flnr(ncol) + real(kind_phys) :: ftem(ncol) + + errmsg = '' + errflg = 0 + + ! Diagnostic indices are reversed + diag_index = num_diag_subcycles - icall + + ! Don't do anything if this subcycle is inactive or we're not configured to write radiation output + if ((.not. active_calls(diag_index+1)) .or. (.not. write_output)) then + return + end if + + fnl = 0.0_kind_phys + fcnl = 0.0_kind_phys + + ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! + fnl( :,ktopcam:) = -1._kind_phys * fsw%fluxes%flux_net( :, ktoprad:) + fcnl(:,ktopcam:) = -1._kind_phys * fswc%fluxes%flux_net( :, ktoprad:) + + call sw_heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) + call sw_heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) + + ! History out field calls + call history_out_field('QRS'//diag(diag_index), qrl(:,:)/cpair) + call history_out_field('QRSC'//diag(diag_index), qrlc(:,:)/cpair) + + call history_out_field('FSNT'//diag(diag_index), fnl(:,ktopcam)) + call history_out_field('FSNTC'//diag(diag_index), fcnl(:,ktopcam)) + + call history_out_field('FSUT'//diag(diag_index), fsw%fluxes%flux_up(:, ktoprad)) + call history_out_field('FSUTC'//diag(diag_index), fswc%fluxes%flux_up(:, ktoprad)) + + ftem(:) = fswc%fluxes%flux_up(:, ktoprad) - fsw%fluxes%flux_up(:, ktoprad) + call history_out_field('SWCF'//diag(diag_index), ftem) + + ! Output fluxes at 200 mb + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fnl, fln200) + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fcnl, fln200c) + call history_out_field('FSN200'//diag(diag_index), fln200) + call history_out_field('FSN200C'//diag(diag_index), fln200c) + + do idx = 1,ncol + call vertinterp(1, 1, pverp, pint(idx,:), p_trop(idx), fnl(idx,:), flnr(idx)) + end do + call history_out_field('FSNR'//diag(diag_index), flnr) + + call history_out_field('FSNS'//diag(diag_index), fnl(:,pverp)) + call history_out_field('FSNSC'//diag(diag_index), fcnl(:,pverp)) + + call history_out_field('FSDS'//diag(diag_index), fsw%fluxes%flux_dn(:, nlay+1)) + call history_out_field('FSDSC'//diag(diag_index), fswc%fluxes%flux_dn(:, nlay+1)) + + ! Fluxes on the CAM grid + call history_out_field('FDS'//diag(diag_index), fsw%fluxes%flux_dn( :, ktoprad:)) + call history_out_field('FDSC'//diag(diag_index), fswc%fluxes%flux_dn(:, ktoprad:)) + call history_out_field('FUS'//diag(diag_index), fsw%fluxes%flux_up( :, ktoprad:)) + call history_out_field('FUSC'//diag(diag_index), fswc%fluxes%flux_up(:, ktoprad:)) + + end subroutine rrtmgp_sw_diagnostics_run + + !======================================================================= + + subroutine sw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) + ! Compute heating rate as a dry static energy tendency + + ! arguments + integer, intent(in) :: ncol + integer, intent(in) :: ktopcam + integer, intent(in) :: pver + real(kind_phys), intent(in) :: flux_net(:,:) ! W m-2 + real(kind_phys), intent(in) :: gravit ! m s-2 + real(kind_phys), intent(in) :: rpdel(:,:) ! Pa + real(kind_phys), intent(out) :: hrate(:,:) ! J kg-1 s-1 + + ! local vars + integer :: kdx + + do kdx = ktopcam, pver + ! (flux divergence as bottom-MINUS-top) * g/dp + hrate(:,kdx) = (flux_net(:,kdx+1) - flux_net(:,kdx)) * & + gravit * rpdel(:,kdx) + end do + end subroutine sw_heating_rate + +end module rrtmgp_sw_diagnostics diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 2358c78f..e3598ed8 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -13,15 +13,30 @@ rrtmgp_sw_gas_optics rrtmgp_sw_cloud_temp - + + + rrtmgp_constituents + rrtmgp_sw_gas_optics_pre + rrtmgp_sw_gas_optics + rrtmgp_sw_solar_var + + rrtmgp_sw_rte + rrtmgp_sw_calculate_fluxes + rrtmgp_sw_calculate_heating_rate + rrtmgp_sw_diagnostics + rrtmgp_subcycle + + rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics + rrtmgp_lw_rte rrtmgp_lw_calculate_fluxes rrtmgp_lw_calculate_heating_rate rrtmgp_lw_diagnostics + rrtmgp_subcycle rrtmgp_inputs_setup From c5c15ea7b97b91b47409dd0dcae3913db2182b13 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 12 Aug 2025 16:53:28 -0600 Subject: [PATCH 075/140] sw diagnostic calculations --- schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 | 5 +- .../rrtmgp/rrtmgp_sw_calculate_fluxes.meta | 6 - .../rrtmgp_sw_calculate_heating_rate.F90 | 7 +- .../rrtmgp_sw_calculate_heating_rate.meta | 12 ++ .../rrtmgp_sw_diagnostics.F90 | 176 ++++++++++-------- 5 files changed, 120 insertions(+), 86 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 index 2c039cfb..0f71eb8c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 @@ -13,7 +13,7 @@ module rrtmgp_sw_calculate_fluxes !> \section arg_table_rrtmgp_sw_calculate_fluxes_run Argument Table !! \htmlinclude rrtmgp_sw_calculate_fluxes_run.html subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp, nlay, nday, idxday, ktopcam, ktoprad, & - active_calls, fsw, fswc, fns, fcns, fsds, fsns, fsnt, soll, sols, solld, solsd, errmsg, errflg) + active_calls, fsw, fswc, fns, fcns, fsns, fsnt, soll, sols, solld, solsd, errmsg, errflg) use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -35,7 +35,6 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! Output variables real(kind_phys), intent(out) :: fns(:,:) real(kind_phys), intent(out) :: fcns(:,:) - real(kind_phys), intent(out) :: fsds(:) real(kind_phys), intent(out) :: fsns(:) real(kind_phys), intent(out) :: fsnt(:) real(kind_phys), intent(out) :: soll(:) @@ -67,7 +66,6 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! Initialize to provide 0.0 values for night columns. fns = 0.0_kind_phys fcns = 0.0_kind_phys - fsds = 0.0_kind_phys fsns = 0.0_kind_phys fsnt = 0.0_kind_phys soll = 0.0_kind_phys @@ -78,7 +76,6 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp do idx = 1, nday fns(idxday(idx), ktopcam:) = fsw%fluxes%flux_net(idx, ktoprad:) fcns(idxday(idx), ktopcam:) = fswc%fluxes%flux_net(idx, ktoprad:) - fsds(idxday(idx)) = fsw%fluxes%flux_dn(idx, nlay+1) end do fsns(:) = fns(:, pverp) diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta index a8b9805a..7d9701aa 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta @@ -89,12 +89,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out -[ fsds ] - standard_name = shortwave_downward_solar_flux_at_surface - units = W m-2 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) - intent = out [ fsns ] standard_name = shortwave_net_upward_flux_at_surface units = W m-2 diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 index c5952e5a..d46d28fb 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 @@ -4,14 +4,17 @@ module rrtmgp_sw_calculate_heating_rate CONTAINS !> \section arg_table_rrtmgp_sw_calculate_heating_rate_run Argument Table !! \htmlinclude rrtmgp_sw_calculate_heating_rate_run.html - subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, hrate, errmsg, errflg) + subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, flux_net_clrsky, & + hrate, hrate_clrsky, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ktopcam integer, intent(in) :: pver real(kind_phys), intent(in) :: gravit real(kind_phys), intent(in) :: rpdel(:,:) real(kind_phys), intent(in) :: flux_net(:,:) + real(kind_phys), intent(in) :: flux_net_clrsky(:,:) real(kind_phys), intent(out) :: hrate(:,:) + real(kind_phys), intent(out) :: hrate_clrsky(:,:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -27,6 +30,8 @@ subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, fl ! top - bottom hrate(:,k) = (flux_net(:,k) - flux_net(:,k+1)) * & gravit * rpdel(:,k) + hrate_clrsky(:,k) = (flux_net_clrsky(:,k) - flux_net_clrsky(:,k+1)) * & + gravit * rpdel(:,k) end do end subroutine rrtmgp_sw_calculate_heating_rate_run diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta index 586b1eb9..0588a11b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta @@ -35,12 +35,24 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in +[ flux_net_clrsky ] + standard_name = shortwave_net_clear_sky_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in [ hrate ] standard_namei = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = out +[ hrate_clrsky ] + standard_namei = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_clear_sky_shortwave_radiation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index b947824e..602b4723 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -54,20 +54,29 @@ subroutine rrtmgp_sw_diagnostics_init(num_diag_subcycles, active_calls, errmsg, ! and add the relevant fields for each cycle if it's active do icall = 1, num_diag_subcycles if (active_calls(icall)) then - call history_add_field('QRS'//diag(icall-1), 'Shortwave heating rate', 'lev', 'avg', 'K s-1') - call history_add_field('QRSC'//diag(icall-1), 'Clearsky shortwave heating rate', 'lev', 'avg', 'K s-1') - call history_add_field('FSNT'//diag(icall-1), 'Net shortwave flux at top of model', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNTC'//diag(icall-1), 'Clearky net shortwave flux at top of model', horiz_only, 'avg', 'W m-2') - call history_add_field('FSUT'//diag(icall-1), 'Upwelling shortwave flux at top of model', horiz_only, 'avg', 'W m-2') - call history_add_field('FSUTC'//diag(icall-1), 'Clearsky upwelling shortwave flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('SOLIN'//diag(icall-1), 'Solar isolation', horiz_only, 'avg', 'W m-2') + call history_add_field('QRS'//diag(icall-1), 'Solar heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('QRSC'//diag(icall-1), 'Clearsky solar heating rate', 'lev', 'avg', 'K s-1') + call history_add_field('FSNT'//diag(icall-1), 'Net solar flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNTC'//diag(icall-1), 'Clearky net solar flux at top of model', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNTOA'//diag(icall-1), 'Net solar flux at top of atmosphere', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNTOAC'//diag(icall-1), 'Clearsky net solar flux at top of atmosphere', horiz_only, 'avg', 'W m-2') call history_add_field('SWCF'//diag(icall-1), 'Shortwave cloud forcing', horiz_only, 'avg', 'W m-2') + call history_add_field('FSUTOA'//diag(icall-1), 'Upwelling solar flux at top of atmospehre', horiz_only, 'avg', 'W m-2') call history_add_field('FSN200'//diag(icall-1), 'Net shortwave flux at 200 mb', horiz_only, 'avg', 'W m-2') call history_add_field('FSN200C'//diag(icall-1), 'Clearsky net shortwave flux at 200 mb', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNR'//diag(icall-1), 'Net shortwave flux at tropopause', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNS'//diag(icall-1), 'Net shortwave flux at surface', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNSC'//diag(icall-1), 'Clearsky net shortwave flux at surface', horiz_only, 'avg', 'W m-2') - call history_add_field('FSDS'//diag(icall-1), 'Downwelling shortwave flux at surface', horiz_only, 'avg', 'W m-2') - call history_add_field('FSDSC'//diag(icall-1), 'Clearky Downwelling shortwave flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNR'//diag(icall-1), 'Net solar flux at tropopause', horiz_only, 'avg', 'W m-2') + call history_add_field('SOLL'//diag(icall-1), 'Solar downward near infrared direct to surface', horiz_only, 'avg', 'W m-2') + call history_add_field('SOLS'//diag(icall-1), 'Solar downward visible direct to surface', horiz_only, 'avg', 'W m-2') + call history_add_field('SOLLD'//diag(icall-1), 'Solar downward near infrared diffuse to surface', horiz_only, 'avg', 'W m-2') + call history_add_field('SOLSD'//diag(icall-1), 'Solar downward visible diffuse to surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNS'//diag(icall-1), 'Net solar flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNSC'//diag(icall-1), 'Clearsky net solar flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSDS'//diag(icall-1), 'Downwelling solar flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSDSC'//diag(icall-1), 'Clearky downwelling solar flux at surface', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNIRTOA'//diag(icall-1),'Net near-infrared flux (Nimbus-7 WFOV at top of atmosphere', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNRTOAC'//diag(icall-1),'Clearsky net near-infrared flux (Nimbus-7 WFOV at top of atmosphere', horiz_only, 'avg', 'W m-2') + call history_add_field('FSNRTOAS'//diag(icall-1),'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', horiz_only, 'avg', 'W m-2') ! Fluxes on CAM grid call history_add_field('FUS'//diag(icall-1), 'Shortwave upward flux', 'ilev', 'inst', 'W m-2') @@ -81,8 +90,9 @@ end subroutine rrtmgp_sw_diagnostics_init !> \section arg_table_rrtmgp_sw_diagnostics_run Argument Table !! \htmlinclude rrtmgp_sw_diagnostics_run.html - subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fsw, fswc, rpdel, ncol, & - nlay, pver, pverp, pint, gravit, cpair, p_trop, ktopcam, ktoprad, write_output, errmsg, errflg) + subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fsw, fswc, rpdel, ncol, nday, idxday, & + nlay, pver, pverp, pint, gravit, cpair, p_trop, fns, fcns, qrs, qrsc, fsnt, fsns, sols, soll, solsd, & + solld, ktopcam, ktoprad, write_output, errmsg, errflg) use cam_history, only: history_out_field use ccpp_fluxes, only: ty_fluxes_broadband_ccpp @@ -94,6 +104,8 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles integer, intent(in) :: icall ! Current diagnostic subcycle integer, intent(in) :: ncol ! Number of horizontal points + integer, intent(in) :: nday ! Number of daytime points + integer, intent(in) :: idxday ! Daytime points integer, intent(in) :: nlay ! Number of vertical layers used in radiation calcluation integer, intent(in) :: pver ! Number of vertical layers integer, intent(in) :: pverp ! Number of vertical layer interfaces @@ -106,6 +118,16 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at layer interfaces [Pa] real(kind_phys), intent(in) :: p_trop(:) ! Tropopause air pressure [Pa] real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of layer thickness [Pa-1] + real(kind_phys), intent(in) :: fns(:,:) ! Net shortwave all-sky flux [W m-2] + real(kind_phys), intent(in) :: fcns(:,:) ! Net shortwave clear-sky flux [W m-2] + real(kind_phys), intent(in) :: qrs(:,:) ! Heating rate (all-sky, shortwave) [J kg-1 s-1] + real(kind_phys), intent(in) :: qrsc(:,:) ! Heating rate (clear-sky, shortwave) [J kg-1 s-1] + real(kind_phys), intent(in) :: fsnt(:) ! Shortwave outgoing flux at model top [W m-2] + real(kind_phys), intent(in) :: fsns(:) ! Shortwave upward flux at surface [W m-2] + real(kind_phys), intent(in) :: sols(:) + real(kind_phys), intent(in) :: soll(:) + real(kind_phys), intent(in) :: solsd(:) + real(kind_phys), intent(in) :: solld(:) type(ty_fluxes_byband_ccpp), intent(in) :: fsw ! Shortwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: fswc ! Shortwave clear-sky flux object @@ -115,14 +137,18 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs ! Local variables integer :: diag_index, idx - real(kind_phys) :: fnl(ncol, pverp) - real(kind_phys) :: fcnl(ncol, pverp) - real(kind_phys) :: qrl(ncol, pver) - real(kind_phys) :: qrlc(ncol, pver) - real(kind_phys) :: fln200(ncol) - real(kind_phys) :: fln200c(ncol) - real(kind_phys) :: flnr(ncol) - real(kind_phys) :: ftem(ncol) + real(kind_phys) :: solin(ncol) + real(kind_phys) :: fcns(ncol) + real(kind_phys) :: fsntoa(ncol) + real(kind_phys) :: fsntoac(ncol) + real(kind_phys) :: fsutoa(ncol) + real(kind_phys) :: fsdsc(ncol) + real(kind_phys) :: flux_sw_up(ncol,pver) + real(kind_phys) :: flux_sw_dn(ncol,pver) + real(kind_phys) :: flux_sw_clr_up(ncol,pver) + real(kind_phys) :: flux_sw_clr_dn(ncol,pver) + real(kind_phys) :: fsntc(ncol) + real(kind_phys) :: fsnsc(ncol) errmsg = '' errflg = 0 @@ -135,76 +161,76 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs return end if - fnl = 0.0_kind_phys - fcnl = 0.0_kind_phys - - ! RTE-RRTMGP convention for net is (down - up) **CAM assumes (up - down) !! - fnl( :,ktopcam:) = -1._kind_phys * fsw%fluxes%flux_net( :, ktoprad:) - fcnl(:,ktopcam:) = -1._kind_phys * fswc%fluxes%flux_net( :, ktoprad:) + ! Initialize to provide 0.0 values for night columns. + solin = 0.0_kind_phys + fcns = 0.0_kind_phys + fsntoa = 0.0_kind_phys + fsntoac = 0.0_kind_phys + fsutoa = 0.0_kind_phys + fsdsc = 0.0_kind_phys + flux_sw_up = 0.0_kind_phys + flux_sw_dn = 0.0_kind_phys + flux_sw_clr_up = 0.0_kind_phys + flux_sw_clr_dn = 0.0_kind_phys + + ! Load up diagnostic arrays + do idx = 1, nday + solin(idxday(idx) = fswc%fluxes%flux_dn(idx, 1) + fsntoa(idxday(idx)) = fsw%fluxes%flux_net(idx, 1) + fsntoac(idxday(idx)) = fswc%fluxes%flux_net(idx, 1) + fsutoa(idxday(idx)) = fsw%fluxes%flux_up(idx, 1) + fsdsc(idxday(idx)) = fswc%fluxes%flux_dn(idx, nlay+1) + flux_sw_up(idxday(idx),ktopcam:) = fsw%fluxes%flux_up(idx,ktoprad:) + flux_sw_dn(idxday(idx),ktopcam:) = fsw%fluxes%flux_dn(idx,ktoprad:) + flux_sw_clr_up(idxday(idx),ktopcam:) = fswc%fluxes%flux_up(idx,ktoprad:) + flux_sw_clr_dn(idxday(idx),ktopcam:) = fswc%fluxes%flux_dn(idx,ktoprad:) + end do - call sw_heating_rate(ncol, ktopcam, pver, fnl, gravit, rpdel, qrl) - call sw_heating_rate(ncol, ktopcam, pver, fcnl, gravit, rpdel, qrlc) + fsntc(:) = fcns(:, pverp) ! net sw clearsky flux at top + fsnsc(:) = fcns(:, pverp) ! net sw clearsky flux at surface ! History out field calls - call history_out_field('QRS'//diag(diag_index), qrl(:,:)/cpair) - call history_out_field('QRSC'//diag(diag_index), qrlc(:,:)/cpair) + call history_out_field('SOLIN'//diag(diag_index), solin) + call history_out_field('QRS'//diag(diag_index), qrs(:,:)/cpair) + call history_out_field('QRSC'//diag(diag_index), qrsc(:,:)/cpair) - call history_out_field('FSNT'//diag(diag_index), fnl(:,ktopcam)) - call history_out_field('FSNTC'//diag(diag_index), fcnl(:,ktopcam)) + call history_out_field('FSNT'//diag(diag_index), fsnt) + call history_out_field('FSNTC'//diag(diag_index), fsntc) + call history_out_field('FSNTOA'//diag(diag_index), fsntoa) + call history_out_field('FSNTOAC'//diag(diag_index), fsntoac) - call history_out_field('FSUT'//diag(diag_index), fsw%fluxes%flux_up(:, ktoprad)) - call history_out_field('FSUTC'//diag(diag_index), fswc%fluxes%flux_up(:, ktoprad)) + call history_out_field('SWCF'//diag(diag_index), fsntoa - fsntoac) - ftem(:) = fswc%fluxes%flux_up(:, ktoprad) - fsw%fluxes%flux_up(:, ktoprad) - call history_out_field('SWCF'//diag(diag_index), ftem) + call history_out_field('FSUTOA'//diag(diag_index), fsutoa) ! Output fluxes at 200 mb - call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fnl, fln200) - call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fcnl, fln200c) - call history_out_field('FSN200'//diag(diag_index), fln200) - call history_out_field('FSN200C'//diag(diag_index), fln200c) + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fns, fsn200) + call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fcns, fsn200c) + call history_out_field('FSN200'//diag(diag_index), fsn200) + call history_out_field('FSN200C'//diag(diag_index), fsn200c) do idx = 1,ncol - call vertinterp(1, 1, pverp, pint(idx,:), p_trop(idx), fnl(idx,:), flnr(idx)) + call vertinterp(1, 1, pverp, pint(idx,:), p_trop(idx), fns(idx,:), fsnr(idx)) end do - call history_out_field('FSNR'//diag(diag_index), flnr) + call history_out_field('FSNR'//diag(diag_index), fsnr) + + call history_out_field('SOLS'//diag(diag_index), sols) + call history_out_field('SOLL'//diag(diag_index), soll) + call history_out_field('SOLSD'//diag(diag_index), solsd) + call history_out_field('SOLLD'//diag(diag_index), solld) - call history_out_field('FSNS'//diag(diag_index), fnl(:,pverp)) - call history_out_field('FSNSC'//diag(diag_index), fcnl(:,pverp)) + call history_out_field('FSNS'//diag(diag_index), fsns) + call history_out_field('FSNSC'//diag(diag_index), fsnsc) - call history_out_field('FSDS'//diag(diag_index), fsw%fluxes%flux_dn(:, nlay+1)) - call history_out_field('FSDSC'//diag(diag_index), fswc%fluxes%flux_dn(:, nlay+1)) + call history_out_field('FSDS'//diag(diag_index), fsds) + call history_out_field('FSDSC'//diag(diag_index), fsdsc) ! Fluxes on the CAM grid - call history_out_field('FDS'//diag(diag_index), fsw%fluxes%flux_dn( :, ktoprad:)) - call history_out_field('FDSC'//diag(diag_index), fswc%fluxes%flux_dn(:, ktoprad:)) - call history_out_field('FUS'//diag(diag_index), fsw%fluxes%flux_up( :, ktoprad:)) - call history_out_field('FUSC'//diag(diag_index), fswc%fluxes%flux_up(:, ktoprad:)) + call history_out_field('FDS'//diag(diag_index), flux_sw_dn) + call history_out_field('FDSC'//diag(diag_index), flux_sw_clr_dn) + call history_out_field('FUS'//diag(diag_index), flux_sw_up) + call history_out_field('FUSC'//diag(diag_index), flux_sw_clr_up) end subroutine rrtmgp_sw_diagnostics_run - !======================================================================= - - subroutine sw_heating_rate(ncol, ktopcam, pver, flux_net, gravit, rpdel, hrate) - ! Compute heating rate as a dry static energy tendency - - ! arguments - integer, intent(in) :: ncol - integer, intent(in) :: ktopcam - integer, intent(in) :: pver - real(kind_phys), intent(in) :: flux_net(:,:) ! W m-2 - real(kind_phys), intent(in) :: gravit ! m s-2 - real(kind_phys), intent(in) :: rpdel(:,:) ! Pa - real(kind_phys), intent(out) :: hrate(:,:) ! J kg-1 s-1 - - ! local vars - integer :: kdx - - do kdx = ktopcam, pver - ! (flux divergence as bottom-MINUS-top) * g/dp - hrate(:,kdx) = (flux_net(:,kdx+1) - flux_net(:,kdx)) * & - gravit * rpdel(:,kdx) - end do - end subroutine sw_heating_rate - end module rrtmgp_sw_diagnostics From 3343e88b6107aecd06891c5b33581eebafd8896e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 22 Aug 2025 09:31:00 -0600 Subject: [PATCH 076/140] remove unused sparse checkout file --- schemes/.ccpp_physics_sparse_checkout | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 schemes/.ccpp_physics_sparse_checkout diff --git a/schemes/.ccpp_physics_sparse_checkout b/schemes/.ccpp_physics_sparse_checkout deleted file mode 100644 index 8b582487..00000000 --- a/schemes/.ccpp_physics_sparse_checkout +++ /dev/null @@ -1,3 +0,0 @@ -.gitmodules -physics/tools -physics/hooks From c08451be3324260fb6cb351f3fe3f0953c95881c Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 22 Aug 2025 15:26:02 -0600 Subject: [PATCH 077/140] remove unused argument --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 24aa1e3f..c065ab64 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -9,12 +9,12 @@ module rrtmgp_inputs_setup !> \section arg_table_rrtmgp_inputs_setup_init Argument Table !! \htmlinclude rrtmgp_inputs_setup_init.html !! - subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & - pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & - timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, p_top_for_rrtmgp, & - nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, nlayp, & - nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & + pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & + timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, & + p_top_for_rrtmgp, nlwbands, nradgas, gasnamelength, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, nlayp, nextsw_cday, & + current_cal_day, band2gpt_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp From ad12f78752c62eadb03f28f68df0d4fb9678e575 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 22 Aug 2025 22:02:54 -0600 Subject: [PATCH 078/140] update sw cloud optics to use setup variables --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 25 +++++++---------------- 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index c9374d38..a4095609 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -29,12 +29,14 @@ module rrtmgp_sw_cloud_optics subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & - snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, 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, & + snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, idx_sw_diag, do_graupel, & do_snow, kdist_sw, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, tot_cld_vistau, tot_icld_vistau, & liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use rrtmgp_cloud_optics_setup, only: g_mu, g_lambda, nmu, nlambda, g_d_eff, n_g_d + use rrtmgp_cloud_optics_setup, only: ext_sw_liq, asm_sw_liq, ssa_sw_liq + use rrtmgp_cloud_optics_setup, only: ext_sw_ice, asm_sw_ice, ssa_sw_ice ! Compute combined cloud optical properties. @@ -60,9 +62,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, real(kind_phys), intent(in) :: fillvalue ! Fill value for night columns real(kind_phys), intent(in) :: tiny_in ! Definition of tiny for RRTMGP - real(kind_phys), intent(in) :: g_mu(:) ! Gamma distribution shape parameter on liquid optics grid [1] - real(kind_phys), intent(in) :: g_d_eff(:) ! Radiative effective diameter samples on ice optics grid [microns] - real(kind_phys), intent(in) :: g_lambda(:,:) ! Gamma distribution slope parameter on liquid optics grid [m-1] real(kind_phys), intent(in) :: lamc(:,:) ! Prognosed value of lambda for cloud [1] real(kind_phys), intent(in) :: pgam(:,:) ! Prognosed value of mu for cloud [1] real(kind_phys), intent(in) :: dei(:,:) ! Mean effective radius for ice cloud [micron] @@ -76,12 +75,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, real(kind_phys), intent(in) :: cldfsnow(:,:) ! Cloud fraction of just "snow clouds" [fraction] real(kind_phys), intent(in) :: cldfgrau(:,:) ! Cloud fraction of just "graupel clouds" [fraction] real(kind_phys), intent(in) :: cldfprime(:,:) ! Combined cloud fraction [fraction] - real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) ! Shortwave liquid extinction [m2 kg-1] - real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) ! Shortwave liquid asymmetry parameter [fraction] - real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) ! Shortwave liquid single scattering albedo [fraction] - real(kind_phys), intent(in) :: ext_sw_ice(:,:) ! Shortwave ice extinction [m2 kg-1] - real(kind_phys), intent(in) :: asm_sw_ice(:,:) ! Shortwave ice asymmetry parameter [fraction] - real(kind_phys), intent(in) :: ssa_sw_ice(:,:) ! Shortwave ice single scattering albedo [fraction] class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! shortwave gas optics object real(kind_phys), intent(out) :: cld_tau(:,:,:) ! liquid + ice optical depth @@ -399,6 +392,7 @@ end subroutine interpolate_ice_optics_sw subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_finish use radiation_utils, only: get_mu_lambda_weights_ccpp + use rrtmgp_cloud_optics_setup, only: nmu, nlambda integer, intent(in) :: nswbands real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) @@ -421,11 +415,6 @@ subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_s type(interp_type) :: mu_wgts type(interp_type) :: lambda_wgts - integer :: nmu, nlambda - - nmu = size(g_mu) - nlambda = size(g_lambda,2) - ! Set error variables errmsg = '' errflg = 0 From 6cd02e831eec7136aff56615d24620d394f23c7e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 25 Aug 2025 11:39:10 -0600 Subject: [PATCH 079/140] add NL; appease metadata comparator --- .../radiation_utils/solar_irradiance_data.F90 | 103 ++++++++++++++++ schemes/rrtmgp/rrtmgp_inputs_setup.meta | 14 +-- schemes/rrtmgp/rrtmgp_pre.F90 | 3 - schemes/rrtmgp/rrtmgp_pre_namelist.xml | 16 +++ schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 1 - schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 54 --------- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 6 + schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 113 ++++++++++++++++++ .../rrtmgp/utils/calculate_net_heating.meta | 12 +- 9 files changed, 248 insertions(+), 74 deletions(-) create mode 100644 schemes/radiation_utils/solar_irradiance_data.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_solar_var.meta diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 new file mode 100644 index 00000000..c24c019d --- /dev/null +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -0,0 +1,103 @@ +!------------------------------------------------------------------------------- +! 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 +!------------------------------------------------------------------------------- +! peverwhee - dependencies = radiation_utils, mo_util +module solar_irradiance_data + + use ccpp_kinds, only : kind_phys + + implicit none + save + + private + public :: solar_irradiance_data_init + public :: solar_irradiance_data_run + + real(kind_phys), allocatable :: irrad(:) ! solar irradiance at model timestep in each band + + real(kind_phys), allocatable :: radbinmax(:) + real(kind_phys), allocatable :: radbinmin(:) + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + + subroutine solar_irradiance_data_init(irrad_file_path, nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + integer, intent(in) :: nswbands ! number of shortwave bands + logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: radmax_loc + character(len=256) :: alloc_errmsg + + + + end subroutine solar_irradiance_data_init + +!------------------------------------------------------------------------------- +!------------------------------------------------------------------------------- + + subroutine solar_irradiance_data_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & + sfac, eccf, errmsg, errflg) + + ! Arguments + real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) + real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance + real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance + real(kind_phys), intent(in) :: we(:) ! wavelength endpoints + integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points + integer, intent(in) :: nswbands ! number of shortwave bands + logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + real(kind_phys), intent(in) :: eccf ! eccentricity factor + real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, j, gpt_start, gpt_end, ncols + real(kind_phys), allocatable :: scale(:) + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'solar_irradiance_data_run' + + ! Initialize error variables + errflg = 0 + errmsg = '' + + 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=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) sub, ': Error allocating "scale", message - ', alloc_errmsg + errflg = 1 + return + end if + + 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 + + toa_flux = toa_flux * sfac * eccf + + end subroutine solar_irradiance_data_run + +end module solar_irradiance_data diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index 10cb6278..a0d16d55 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -132,10 +132,10 @@ type = logical dimensions = () intent = in -[ is_root ] - standard_name = flag_for_mpi_root - units = flag - type = logical +[ p_top_for_rrtmgp ] + standard_name = air_pressure_cutoff_for_rrtmgp + units = Pa + type = real | kind = kind_phys dimensions = () intent = in [ nlwbands ] @@ -156,12 +156,6 @@ type = integer dimensions = () intent = in -[ iulog ] - standard_name = log_output_unit - units = 1 - type = integer - dimensions = () - intent = in [ idx_sw_diag ] standard_name = index_of_shortwave_band units = index diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index bd519852..05a9d4a4 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -155,9 +155,6 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco return end if - ! PEVERWHEE - TEMPORARILY OVERRIDE TO FALSE - dosw = .false. - dosw_heat = (.not. dosw) dolw_heat = (.not. dolw) diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index c65e5a82..01f887b8 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -257,4 +257,20 @@ 5 + + real + kind_phys + rrtmgp + rrtmgp + air_pressure_cutoff_for_rrtmgp + Pa + + Top pressure level for RRTMGP + Default: 1.0 for WACCM/WACCMX + 10. for all other CAM runs + + + 10.0D0 + + diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 38852a63..a5822cf9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -55,7 +55,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, integer, intent(in) :: nlay ! Number of layers in radiation calculation (may include "extra layer") integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: nday ! Number of daylight columns - integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: idxday(:) ! Indices of daylight columns integer, intent(in) :: nswgpts ! Number of shortwave g-points integer, intent(in) :: pver ! Number of vertical layers diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index 03a4aaaf..516afc7b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -191,60 +191,6 @@ type = real | kind = kind_phys dimensions = () intent = in -[ ext_sw_liq ] - standard_name = shortwave_liquid_extinction - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ ssa_sw_liq ] - standard_name = shortwave_liquid_single_scattering_albedo - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ asm_sw_liq ] - standard_name = shortwave_liquid_asymmetry_parameter - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ ext_sw_ice ] - standard_name = shortwave_ice_extinction - units = m2 kg-1 - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ asm_sw_ice ] - standard_name = shortwave_ice_asymmetry_parameter - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ ssa_sw_ice ] - standard_name = shortwave_ice_single_scattering_albedo - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid,number_of_bands_for_shortwave_radiation) - intent = in -[ g_mu ] - standard_name = gamma_distribution_shape_parameter_on_liquid_optics_grid - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid) - intent = in -[ g_d_eff ] - standard_name = radiative_effective_diameter_samples_on_ice_optics_grid - units = microns - type = real | kind = kind_phys - dimensions = (number_of_radiative_effective_diameter_samples_on_ice_optics_grid) - intent = in -[ g_lambda ] - standard_name = gamma_distribution_slope_parameter_on_liquid_optics_grid - units = m-1 - type = real | kind = kind_phys - dimensions = (number_of_gamma_distribution_shape_parameters_on_liquid_optics_grid,number_of_gamma_distribution_slope_parameters_on_liquid_optics_grid) - intent = in [ idx_sw_diag ] standard_name = index_of_shortwave_band units = index diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 6b1bba64..cfa7c08d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -25,6 +25,9 @@ module rrtmgp_sw_solar_var contains !------------------------------------------------------------------------------- +!> \section arg_table_rrtmgp_sw_solar_var_init Argument Table +!! \htmlinclude rrtmgp_sw_solar_var_init.html +!! subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) use radiation_utils, only : get_sw_spectral_boundaries_ccpp integer, intent(in) :: nswbands ! number of shortwave bands @@ -80,6 +83,9 @@ end subroutine rrtmgp_sw_solar_var_init !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- +!> \section arg_table_rrtmgp_sw_solar_var_run Argument Table +!! \htmlinclude rrtmgp_sw_solar_var_run.html +!! subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & sfac, eccf, errmsg, errflg) diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta new file mode 100644 index 00000000..454f50ee --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -0,0 +1,113 @@ +[ccpp-table-properties] + name = rrtmgp_sw_solar_var + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_solar_var_init + type = scheme +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ do_spctrl_scaling ] + standard_name = do_spectral_scaling_of_solar_irradiance_data + units = flag + type = logical + dimensions = () + intent = in +[ has_spectrum ] + standard_name = solar_irradiance_data_has_spectrum_information + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_sw_solar_var_run + type = scheme +[ toa_flux ] + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 + type = real | kind = kind_phys + dimensions = (enter_standard_name_18:enter_standard_name_19,enter_standard_name_20:enter_standard_name_21) + intent = inout +[ band2gpt_sw ] + standard_name = enter_standard_name_11 + units = enter_units + type = integer + dimensions = (enter_standard_name_22:enter_standard_name_23,enter_standard_name_24:enter_standard_name_25) + intent = in +[ nswbands ] + standard_name = enter_standard_name_12 + units = enter_units + type = integer + dimensions = () + intent = in +[ sol_irrad ] + standard_name = enter_standard_name_8 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_26:enter_standard_name_27) + intent = in +[ we ] + standard_name = enter_standard_name_9 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_28:enter_standard_name_29) + intent = in +[ nbins ] + standard_name = enter_standard_name_10 + units = enter_units + type = integer + dimensions = () + intent = in +[ sol_tsi ] + standard_name = enter_standard_name_7 + units = enter_units + type = real | kind = kind_phys + dimensions = () + intent = in +[ do_spctrl_scaling ] + standard_name = enter_standard_name_13 + units = enter_units + type = logical + dimensions = () + intent = in +[ sfac ] + standard_name = enter_standard_name_15 + units = enter_units + type = real | kind = kind_phys + dimensions = (enter_standard_name_30:enter_standard_name_31,enter_standard_name_32:enter_standard_name_33) + intent = out +[ eccf ] + standard_name = enter_standard_name_14 + units = enter_units + type = real | kind = kind_phys + dimensions = () + intent = in +[ errmsg ] + standard_name = enter_standard_name_16 + units = enter_units + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = enter_standard_name_17 + units = enter_units + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta index 5c7eac08..ab607d95 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.meta +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -29,6 +29,12 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in +[ is_offline_dyn ] + standard_name = is_offline_dynamical_core + units = flag + type = logical + dimensions = () + intent = in [ fsns ] standard_name = shortwave_net_absorbed_solar_flux_at_surface units = W m-2 @@ -53,12 +59,6 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in -[ is_offline_dyn ] - standard_name = is_offline_dynamical_core - units = flag - type = logical - dimensions = () - intent = in [ net_flx ] standard_name = total_column_radiative_flux units = W m-2 From 6da0e2d2b263665df0333d41e6c37951cdef4da4 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 26 Aug 2025 16:13:23 -0600 Subject: [PATCH 080/140] add rrtmgp submodule --- schemes/rrtmgp/ext | 1 + 1 file changed, 1 insertion(+) create mode 160000 schemes/rrtmgp/ext diff --git a/schemes/rrtmgp/ext b/schemes/rrtmgp/ext new file mode 160000 index 00000000..4d8c5df4 --- /dev/null +++ b/schemes/rrtmgp/ext @@ -0,0 +1 @@ +Subproject commit 4d8c5df4c63434aaab854afd1b02f5986d41dfb3 From 493db339ac9acfd73125d48e96a6cf8f138a0589 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 26 Aug 2025 17:25:32 -0600 Subject: [PATCH 081/140] continuing solar irrad mods --- .../radiation_utils/solar_irradiance_data.F90 | 315 +++++++++++++++--- .../solar_irradiance_data.meta | 161 +++++++++ .../solar_irradiance_data_namelist.xml | 157 +++++++++ schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 2 +- .../rrtmgp_cloud_optics_setup_namelist.xml | 4 +- .../rrtmgp_sw_diagnostics.F90 | 2 +- .../rrtmgp_sw_diagnostics.meta | 221 ++++++++++++ 7 files changed, 811 insertions(+), 51 deletions(-) create mode 100644 schemes/radiation_utils/solar_irradiance_data.meta create mode 100644 schemes/radiation_utils/solar_irradiance_data_namelist.xml create mode 100644 schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index c24c019d..9ac319b4 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -4,10 +4,10 @@ ! to approximate the spectral distribution of irradiance ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- -! peverwhee - dependencies = radiation_utils, mo_util +! peverwhee - dependencies = time_coordinate module solar_irradiance_data - - use ccpp_kinds, only : kind_phys + use cam_time_coord, only: time_coordinate + use ccpp_kinds, only: kind_phys implicit none save @@ -16,88 +16,309 @@ module solar_irradiance_data public :: solar_irradiance_data_init public :: solar_irradiance_data_run - real(kind_phys), allocatable :: irrad(:) ! solar irradiance at model timestep in each band - - real(kind_phys), allocatable :: radbinmax(:) - real(kind_phys), allocatable :: radbinmin(:) + type(time_coordinate) :: time_coord + real(kind_phys) :: ref_tsi + real(kind_phys), public, protected, allocatable :: sol_etf(:) + real(kind_phys), public, protected, allocatable :: ssi_ref(:) ! a reference spectrum constructed from 3 solar cycles of data + real(kind_phys), allocatable :: irradi(:,:) + real(kind_phys), allocatable :: irrad_fac(:) + real(kind_phys), allocatable :: etf_fac(:) + logical, protected :: has_ref_spectrum = .false. + logical, protected :: has_tsi = .false. + logical, protected :: initialized = .false. + logical, protected :: fixed_scon = .false. !------------------------------------------------------------------------------- contains !------------------------------------------------------------------------------- - subroutine solar_irradiance_data_init(irrad_file_path, nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) - use radiation_utils, only : get_sw_spectral_boundaries_ccpp - integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling - logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum +!> \section arg_table_solar_irradiance_data_init Argument Table +!! \htmlinclude solar_irradiance_data_init.html +!! + subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_data_ymd, solar_data_tod, solar_const, & + solar_heating_spectral_scl, speed_of_light, planck_const, do_spectral_scaling, has_spectrum, sol_tsi, & + we, nbins, nbinsp, errmsg, errflg) + use infnan, only: nan, assignment(=) + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + ! Arguments + character(len=*), intent(in) :: irrad_file_path + character(len=*), intent(in) :: solar_data_type + integer, intent(in) :: solar_data_ymd + integer, intent(in) :: solar_data_tod + real(kind_phys), intent(in) :: solar_const + logical, intent(in) :: solar_heating_spectral_scl + real(kind_phys), intent(in) :: speed_of_light + real(kind_phys), intent(in) :: planck_const + logical, intent(out) :: do_spectral_scaling ! flag to do spectral scaling + logical, intent(out) :: has_spectrum ! flag for whether solar input file has irradiance spectrum + real(kind_phys), intent(out) :: sol_tsi + real(kind_phys), allocatable, intent(out) :: we(:) + integer, intent(out) :: nbins + integer, intent(out) :: nbinsp character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg - integer :: radmax_loc + ! Local variables + logical :: fixed + real(kind_phys), allocatable :: ssi(:,:) + real(kind_phys), allocatable :: ssi_ref(:) + real(kind_phys), allocatable :: tsi(:) + real(kind_phys), allocatable :: lambda(:) + real(kind_phys), allocatable :: dellam(:) + integer, allocatable :: wvl_vid + class(abstract_netcdf_reader_t), pointer :: file_reader + integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg + real(kind_phys), parameter :: fac = 1._kind_phys/(planck_const*speed_of_light) + + ! Set error variables + errmsg = '' + errflg = 0 + + sol_tsi = -1.0_kind_phys + ref_tsi = nan + + has_spectrum = .false. + + if (irrad_file_path /= 'NONE') then + fixed_scon = .false. + else + fixed_scon = .true. + end if + + if (const_tsi>0._kind_phys) then + sol_tsi = const_tsi + end if + + if ( fixed_scon ) return + + fixed = trim(solar_data_type) == 'FIXED' + + call time_coord%initialize(irrad_file_path, fixed=fixed, fixed_ymd=solar_data_ymd, fixed_tod=solar_data_tod, & + force_time_interp=.true., try_dates=.true.) + + file_reader => create_netcdf_reader_t() + + ! Open the solar irradiance data file + call file_reader%open_file(irrad_file_path, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Check what the file contains + call file_reader%get_var('ssi', ssi, errmsg, errflg) + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + else if (errflg /= missing_variable_error_code) then + has_spectrum = .true. + end if + + call file_reader%get_var('tsi', tsi, errmsg, errflg) + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + else if (errflg /= missing_variable_error_code .and. const_tsi < 0._kind_phys) then + has_tsi = .true. + end if + + call file_reader%get_var('ssi_ref', ssi_ref, errmsg, errflg) + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + else if (errflg /= missing_variable_error_code) then + has_ref_spectrum = .true. + end if + + if (has_ref_spectrum) then + call file_reader%get_var('tsi_ref', ref_tsi, errmsg, errflg) + if (errflg /= 0) then + return + end if + end if + + do_spectral_scaling = has_spectrum .and. solar_heating_spectral_scl + + ! Read in data + if (has_spectrum) then + call file_reader%get_var('wavelength', lambda, errmsg, errflg) + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + else if (errflg == missing_variable_error_code) then + ! Check old name (for backward compatibility + call file_reader%get_var('wvl', lambda, errmsg, errflg) + if (errflg /= 0) then + return + end if + end if + call file_reader%get_var('band_width', dellam, errmsg, errflg) + if (errflg /= 0) then + return + end if + end if + + ! Close the solar irradiance file + call file_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + deallocate(file_reader) + nullify(file_reader) + + nbins = size(lambda) + nbinsp = nbins + 1 + allocate(irrad_fac(nbins), stat=errflg, errmsg=alloc_errmsg) + if( errflg /= 0 ) then + write(errmsg,*) 'solar_data_init: failed to allocate irrad_fac; error = ', alloc_errmsg + return + end if + allocate(etf_fac(nbins), stat=errflg, errmsg=alloc_errmsg) + if( errflg /= 0 ) then + write(errmsg,*) 'solar_data_init: failed to allocate etf_fac; error = ', alloc_errmsg + return + end if + ! Calculate wavelength ends and convert units + if ( has_spectrum ) then + allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) + if( errflg /= 0 ) then + write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg + return + end if + allocate(sol_etf(nbins), stat=errflg, errmsg=alloc_errmsg) + if( errflg /= 0 ) then + write(errmsg,*) 'solar_data_init: failed to allocate sol_etf; error = ', alloc_errmsg + return + end if + allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) + if( errflg /= 0 ) then + write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg + return + end if + + we(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) + we(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) + do i = 1,nbins + irrad_fac(i) = 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm + etf_fac(i) = 1.e-16_kind_phys*lambda(i)*fac ! mW/m2/nm --> photons/cm2/sec/nm + enddo + if(has_ref_spectrum) then + ssi_ref = ssi_ref * 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm + endif + endif + + deallocate(lambda) + deallocate(dellam) + + ! need to force data loading when the model starts at a time =/ 00:00:00.000 + ! -- may occur in restarts also + call solar_irradiance_data_run(irrad_file_path, errmsg, errflg) + if (errflg /= 0) then + return + end if + initialized = .true. end subroutine solar_irradiance_data_init !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- - subroutine solar_irradiance_data_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & - sfac, eccf, errmsg, errflg) - +!> \section arg_table_solar_irradiance_data_run Argument Table +!! \htmlinclude solar_irradiance_data_run.html +!! + subroutine solar_irradiance_data_run(irrad_file_path, nbins, has_spectrum, do_spectral_scaling, & + sol_irrad, we, sol_tsi, errmsg, errflg) + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Arguments - real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) - real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance - real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance + character(len=*), intent(in) :: irrad_file_path real(kind_phys), intent(in) :: we(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins - integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points - integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling - real(kind_phys), intent(in) :: eccf ! eccentricity factor - real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) + logical, intent(in) :: has_spectrum + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling + real(kind_phys), intent(out) :: sol_tsi ! total solar irradiance + real(kind_phys), intent(out) :: sol_irrad(:) ! solar irradiance character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, gpt_start, gpt_end, ncols - real(kind_phys), allocatable :: scale(:) - character(len=256) :: alloc_errmsg - character(len=*), parameter :: sub = 'solar_irradiance_data_run' + integer :: idx, index, nt + integer :: offset(2), count(2) + integer, allocatable :: itsi(:) + logical :: read_data + real(r8) :: data(nbins) + integer :: ierr + real(r8) :: delt + class(abstract_netcdf_reader_t), pointer :: file_reader ! Initialize error variables errflg = 0 errmsg = '' - - if (do_spctrl_scaling) then - ! Determine target irradiance for each band - call integrate_spectrum(nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) + if ( fixed_scon ) return + if ( time_coord%fixed .and. initialized ) return - ncols = size(toa_flux, 1) - allocate(scale(ncols), stat=errflg, errmsg=alloc_errmsg) + index = -1 + + read_data = time_coord%read_more() .or. .not.initialized + call time_coord%advance() + + if ( read_data ) then + file_reader => create_netcdf_reader_t() + + ! Open the solar irradiance data file + call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then - write(errmsg,*) sub, ': Error allocating "scale", message - ', alloc_errmsg - errflg = 1 return end if + nt = 2 + index = time_coord%indxs(1) - 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 + ! get the surrounding time slices + offset = (/ 1, index /) + count = (/ nbins, nt /) - else - sfac(:,:) = sol_tsi / spread(sum(toa_flux, 2), 2, size(toa_flux, 2)) + if (has_spectrum) then + call file_reader%get_var('ssi', irradi, errmsg, errflg, offset, count) + if (errflg /= 0) then + return + end if + end if + if (has_tsi .and. (.not. do_spectral_scaling)) then + call file_reader%get_var('tsi', itsi, errmsg, errflg, (/index/), (/nt/)) + if (errflg /= 0) then + return + end if + if ( any(itsi(:nt) < 0._r8) ) then + write(errmsg,*) 'solar_data_advance: invalid or missing tsi data' + errflg = 1 + return + end if + end if + ! Close the solar irradiance file + call file_reader%close_file(errmsg, errcode) + if (errcode /= 0) then + return + end if + deallocate(file_reader) + nullify(file_reader) end if - toa_flux = toa_flux * sfac * eccf + delt = time_coord%wghts(2) + + if (has_spectrum) then + data(:) = irradi(:,1) + delt*( irradi(:,2) - irradi(:,1) ) + + do idx = 1,nbins + sol_irrad(idx) = data(i)*irrad_fac(idx) ! W/m2/nm + sol_etf(idx) = data(i)*etf_fac(idx) ! photons/cm2/sec/nm + end do + end if + if (has_tsi .and. (.not.do_spectral_scaling)) then + sol_tsi = itsi(1) + delt*( itsi(2) - itsi(1) ) + end if + if (has_spectrum) then + deallocate(irradi) + end if + end subroutine solar_irradiance_data_run end module solar_irradiance_data diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta new file mode 100644 index 00000000..efd2ad76 --- /dev/null +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -0,0 +1,161 @@ +[ccpp-table-properties] + name = solar_irradiance_data + type = scheme + +[ccpp-arg-table] + name = solar_irradiance_data_init + type = scheme +[ irrad_file_path ] + standard_name = filename_of_solar_irradiance_data + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ solar_data_type ] + standard_name = type_of_solar_irradiance_data + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ solar_data_ymd ] + standard_name = year_month_date_for_solar_irradiance_data + units = 1 + type = integer + dimensions = () + intent = in +[ solar_data_tod ] + standard_name = seconds_of_day_for_solar_irradiance_data + units = s + type = integer + dimensions = () + intent = in +[ solar_const ] + standard_name = constant_total_solar_irradiance + units = W m-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ solar_heating_spectral_scl ] + standard_name = do_radiation_heating_spectral_scaling + units = flag + type = logical + dimensions = () + intent = in +[ speed_of_light ] + standard_name = speed_of_light_in_vacuum + units = m s-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ planck_const ] + standard_name = plancks_constant + units = J s + type = real | kind = kind_phys + dimensions = () + intent = in +[ do_spectral_scaling ] + standard_name = do_spectral_scaling_of_solar_irradiance_data + units = flag + type = logical + dimensions = () + intent = out +[ has_spectrum ] + standard_name = solar_irradiance_file_has_spectrum_information + units = flag + type = logical + dimensions = () + intent = out +[ sol_tsi ] + standard_name = total_solar_irradiance + units = W m-2 + type = real | kind = kind_phys + dimensions = () + intent = out +[ we ] + standard_name = wavelength_endpoints + units = nm + type = real | kind = kind_phys + dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) + intent = out +[ nbins ] + standard_name = number_of_wavelength_samples_of_spectrum + units = count + type = integer + dimensions = () + intent = out +[ nbinsp ] + standard_name = number_of_wavelength_samples_of_spectrum_plus_one + units = count + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_messag + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = solar_irradiance_data_run + type = scheme +[ irrad_file_path ] + standard_name = filename_of_solar_irradiance_data + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ nbins ] + standard_name = number_of_wavelength_samples_of_spectrum + units = count + type = integer + dimensions = () + intent = in +[ has_spectrum ] + standard_name = solar_irradiance_file_has_spectrum_information + units = flag + type = logical + dimensions = () + intent = in +[ do_spectral_scaling ] + standard_name = do_spectral_scaling_of_solar_irradiance_data + units = flag + type = logical + dimensions = () + intent = in +[ sol_irrad ] + standard_name = solar_irradiance + units = W m-2 nm-1 + type = real | kind = kind_phys + dimensions = (number_of_wavelength_samples_of_spectrum) + intent = out +[ we ] + standard_name = wavelength_endpoints + units = nm + type = real | kind = kind_phys + dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) + intent = in +[ sol_tsi ] + standard_name = total_solar_irradiance + units = W m-2 + type = real | kind = kind_phys + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/radiation_utils/solar_irradiance_data_namelist.xml b/schemes/radiation_utils/solar_irradiance_data_namelist.xml new file mode 100644 index 00000000..7358379e --- /dev/null +++ b/schemes/radiation_utils/solar_irradiance_data_namelist.xml @@ -0,0 +1,157 @@ + + + + + + + + + char*512 + solar_data + solar_data + filename_of_solar_irradiance_data + none + + The filename of the solar irradiance data. + + + ${DIN_LOC_ROOT}/atm/cam/solar/SolarForcing1995-2005avg_c160929.nc + + + + char*8 + solar_data + solar_data + type_of_solar_irradiance_data + none + + The type of solar irradiance data. + + + FIXED + + + + logical + solar_data + solar_data + do_radiation_heating_spectral_scaling + flag + + Flag for whether to do radiation heating spectral scaling + + + .true. + + + + integer + solar_data + solar_data + year_month_date_for_solar_irradiance_data + 1 + + YMD for start of fixed solar irradiance data + + + 20000101 + + + + integer + solar_data + solar_data + seconds_of_day_for_solar_irradiance_data + s + + TOD for start of fixed solar irradiance data + + + 0 + + + + real + kind_phys + solar_data + solar_data + constant_total_solar_irradiance + W m-2 + + Constant total solar irradiance (read from file if less than 0) + + + -9999D0 + + + diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index c82f3b8f..d0ebbd3d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -65,7 +65,7 @@ intent = in [ we ] standard_name = wavelength_endpoints - units = 1 + units = nm type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) intent = in diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml index 57827af3..d62110bf 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml @@ -85,7 +85,7 @@ filepath and name for ice optics data for rrtmgp - /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/iceoptics_c080917.nc + ${DIN_LOC_ROOT}/atm/cam/physprops/iceoptics_c080917.nc @@ -98,7 +98,7 @@ filepath and name for liquid optics data for rrtmgp - /glade/campaign/cesm/cesmdata/inputdata/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc + ${DIN_LOC_ROOT}/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index 602b4723..df8d6a67 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -105,7 +105,7 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs integer, intent(in) :: icall ! Current diagnostic subcycle integer, intent(in) :: ncol ! Number of horizontal points integer, intent(in) :: nday ! Number of daytime points - integer, intent(in) :: idxday ! Daytime points + integer, intent(in) :: idxday(:) ! Daytime points integer, intent(in) :: nlay ! Number of vertical layers used in radiation calcluation integer, intent(in) :: pver ! Number of vertical layers integer, intent(in) :: pverp ! Number of vertical layer interfaces diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta new file mode 100644 index 00000000..90e597c4 --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta @@ -0,0 +1,221 @@ +[ccpp-table-properties] + name = rrtmgp_sw_diagnostics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_diagnostics_init + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_cde + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_sw_diagnostics_run + type = scheme +[ num_diag_subcycles ] + standard_name = number_of_diagnostic_subcycles + units = count + type = integer + dimensions = () + intent = in +[ icall ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ active_calls ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = in +[ fsw ] + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = in +[ fswc ] + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = in +[ rpdel ] + standard_name = reciprocal_of_air_pressure_thickness + units = Pa-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ idxday ] + standard_name = daytime_points + units = index + type = integer + dimensions = (horizontal_loop_extent) + intent = in +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ pverp ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ pint ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ cpair ] + standard_name = specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ p_trop ] + standard_name = tropopause_air_pressure_from_hybrid_stobie_linoz_with_climatological_backup_method + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ fns ] + standard_name = shortwave_net_radiative_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ fcns ] + standard_name = shortwave_net_radiative_clear_sky_flux + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ qrs ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ qrsc ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_clear_sky_shortwave_radiation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ fsnt ] + standard_name = shortwave_net_outgoing_flux_at_model_top + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ fsns ] + standard_name = shortwave_net_upward_flux_at_surface + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ sols ] + standard_name = direct_solar_radative_flux_at_surface_lt_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ soll ] + standard_name = direct_solar_radiative_flux_at_surface_ge_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ solsd ] + standard_name = diffuse_solar_radative_flux_at_surface_lt_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ solld ] + standard_name = diffuse_solar_radiative_flux_at_surface_ge_700nm_to_coupler + units = W m-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = in +[ write_output ] + standard_name = write_RRTMGP_diagnostics + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out From 2459e5539576ca98cac3606a4461f588d14402b3 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 2 Sep 2025 14:33:08 -0600 Subject: [PATCH 082/140] address reviewer requests --- .gitmodules | 12 +-- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 80 ++++++++++--------- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 4 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 25 +++--- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 9 +-- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 22 ++--- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 13 ++- 7 files changed, 88 insertions(+), 77 deletions(-) diff --git a/.gitmodules b/.gitmodules index 16d4d479..2e4af354 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,15 +4,15 @@ fxtag = 20240626-MPASv8.2 fxrequired = AlwaysRequired fxDONOTUSEurl = https://github.com/NCAR/MMM-physics.git -[submodule "rte-rrtmgp"] - path = schemes/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 "pumas"] path = schemes/pumas/pumas url = https://github.com/ESCOMP/PUMAS fxrequired = AlwaysRequired fxtag = pumas_cam-release_v1.39 fxDONOTUSEurl = https://github.com/ESCOMP/PUMAS +[submodule "rte-rrtmgp"] + path = schemes/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 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index a4095609..16c38390 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -21,8 +21,6 @@ module rrtmgp_sw_cloud_optics integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] -real(kind_phys) :: tiny - !================================================================================================== contains !================================================================================================== @@ -139,8 +137,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, return end if - tiny = tiny_in - ! Combine the cloud optical properties. ! gammadist liquid optics @@ -149,7 +145,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, return end if ! Mitchell ice optics - call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iciwpth, dei, g_d_eff, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) + call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iciwpth, dei, g_d_eff, 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,:) @@ -157,7 +153,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! add in snow if (do_snow) then - call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, des, g_d_eff, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) + call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, des, g_d_eff, 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._kind_phys) then @@ -182,7 +178,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! add in graupel if (do_graupel) then - call get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) + call get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, 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._kind_phys) then @@ -210,9 +206,13 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) if (do_snow) then snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + else + snow_tau(:,:ncol,:) = 0._kind_phys end if if (do_graupel) then grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) + else + grau_tau(:,:ncol,:) = 0._kind_phys end if ! Set arrays for diagnostic output. @@ -222,9 +222,13 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) if (do_snow) then snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) + else + snow_icld_vistau(:ncol,:) = 0._kind_phys endif if (do_graupel) then grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) + else + grau_icld_vistau(:ncol,:) = 0._kind_phys endif ! multiply by total cloud fraction to get gridbox value @@ -236,25 +240,23 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, tot_icld_vistau(idxnite(i),:) = fillvalue liq_icld_vistau(idxnite(i),:) = fillvalue ice_icld_vistau(idxnite(i),:) = fillvalue - if (do_snow) then - snow_icld_vistau(idxnite(i),:) = fillvalue - end if - if (do_graupel) then - grau_icld_vistau(idxnite(i),:) = fillvalue - end if + snow_icld_vistau(idxnite(i),:) = fillvalue + grau_icld_vistau(idxnite(i),:) = fillvalue end do end subroutine rrtmgp_sw_cloud_optics_run !============================================================================== -subroutine get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) +subroutine get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & + iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands integer, intent(in) :: iulog integer, intent(in) :: idx_sw_diag + real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: ext_sw_ice(:,:) real(kind_phys), intent(in) :: asm_sw_ice(:,:) real(kind_phys), intent(in) :: ssa_sw_ice(:,:) @@ -271,7 +273,7 @@ subroutine get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ ! This does the same thing as get_ice_optics_sw, except with a different ! water path and effective diameter. - call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icgrauwpth, degrau, g_d_eff, tau, tau_w, & + call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icgrauwpth, degrau, g_d_eff, tau, tau_w, & tau_w_g, tau_w_f) do i = 1, ncol do k = 1, pver @@ -286,24 +288,25 @@ end subroutine get_grau_optics_sw !============================================================================== -subroutine get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & +subroutine get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & g_mu, iclwpth, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands - real(kind_phys),intent(in) :: g_lambda(:,:) - real(kind_phys),intent(in) :: g_mu(:) - real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) - real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) - real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) - real(kind_phys),intent(in) :: iclwpth(:,:) - real(kind_phys),intent(in) :: lamc(:,:) - real(kind_phys),intent(in) :: pgam(:,:) - - real(kind_phys),intent(out) :: tau (:,:,:) ! extinction optical depth - real(kind_phys),intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau - real(kind_phys),intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w - real(kind_phys),intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w + real(kind_phys), intent(in) :: tiny_in + real(kind_phys), intent(in) :: g_lambda(:,:) + real(kind_phys), intent(in) :: g_mu(:) + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) + real(kind_phys), intent(in) :: iclwpth(:,:) + real(kind_phys), intent(in) :: lamc(:,:) + real(kind_phys), intent(in) :: pgam(:,:) + + real(kind_phys), intent(out) :: tau (:,:,:) ! extinction optical depth + real(kind_phys), intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau + real(kind_phys), intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w + real(kind_phys), intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -313,8 +316,9 @@ subroutine get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ss do k = 1,pver do i = 1,ncol if(lamc(i,k) > 0._kind_phys) then ! This seems to be clue from microphysics of no cloud - call gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), & - tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k), errmsg, errflg) + call gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), & + lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), & + tau_w_f(1:nswbands,i,k), errmsg, errflg) else tau(1:nswbands,i,k) = 0._kind_phys tau_w(1:nswbands,i,k) = 0._kind_phys @@ -328,13 +332,15 @@ end subroutine get_liquid_optics_sw !============================================================================== -subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & +subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & iciwpth, dei, g_d_eff, tau, tau_w, tau_w_g, tau_w_f) + ! SIMA-specific interpolation routines use interpolate_data, only: interp_type, lininterp, lininterp_init, lininterp_finish, extrap_method_bndry integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands + real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: iciwpth(:,:) real(kind_phys), intent(in) :: dei(:,:) real(kind_phys), intent(in) :: g_d_eff(:) @@ -357,7 +363,7 @@ subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ic do k = 1,pver do i = 1,ncol - if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._kind_phys) then + if( iciwpth(i,k) < tiny_in .or. dei(i,k) == 0._kind_phys) then ! if ice water path is too small, OD := 0 tau (:,i,k) = 0._kind_phys tau_w (:,i,k) = 0._kind_phys @@ -389,12 +395,14 @@ end subroutine interpolate_ice_optics_sw !============================================================================== -subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) +subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) + ! SIMA-specific interpolation routines use interpolate_data, only: interp_type, lininterp, lininterp_finish use radiation_utils, only: get_mu_lambda_weights_ccpp use rrtmgp_cloud_optics_setup, only: nmu, nlambda integer, intent(in) :: nswbands + real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) @@ -402,7 +410,7 @@ subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_s real(kind_phys), intent(in) :: g_lambda(:,:) real(kind_phys), intent(in) :: lamc real(kind_phys), intent(in) :: pgam - real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) [kg m-2] real(kind_phys), intent(out) :: tau(:), tau_w(:), tau_w_f(:), tau_w_g(:) character(len=512), intent(out) :: errmsg @@ -419,7 +427,7 @@ subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_s errmsg = '' errflg = 0 - if (clwptn < tiny) then + if (clwptn < tiny_in) then tau = 0._kind_phys tau_w = 0._kind_phys tau_w_g = 0._kind_phys diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 7f113a18..a4bcc7b8 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -338,7 +338,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l use ccpp_optical_props, only: ty_optical_props_2str_ccpp use radiation_tools, only: check_error_msg ! Inputs - logical, intent(in) :: dosw !< Flag for whether to perform longwave calculation + logical, intent(in) :: dosw !< Flag for whether to perform shortwave calculation integer, intent(in) :: iter_num !< Subcycle iteration number integer, intent(in) :: ncol !< Total number of columns integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once @@ -372,7 +372,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios sw_optical_props%optical_props, & ! OUT - RRTMGP DDT: Shortwave optical properties, by ! spectral point (tau,ssa,g) toa_src_sw) ! OUT - TOA incident shortwave radiation (spectral) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index b49f33c9..f7bc333d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -37,7 +37,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, integer, intent(out) :: errflg ! Local variables - integer :: i, gas_idx, idx(nday) + integer :: i, gas_idx integer :: istat real(kind_phys), allocatable :: gas_mmr(:,:) real(kind_phys), allocatable :: gas_vmr(:,:) @@ -47,6 +47,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, ! For ozone profile above model real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'rrtmgp_sw_gas_optics_pre_run' !---------------------------------------------------------------------------- @@ -59,22 +60,24 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, return end if - allocate(gas_mmr(nday, pverp-1)) - allocate(gas_vmr(nday, nlay)) + allocate(gas_mmr(nday, pverp-1), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) sub//": failed to allocate 'gas_mmr' - message: "//alloc_errmsg + return + allocate(gas_vmr(nday, nlay), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) sub//": failed to allocate 'gas_vmr' - message: "//alloc_errmsg + return + end if ! Check allocate - ! set the column indices - do i = 1, nday - idx(i) = idxday(i) - end do - do gas_idx = 1, nradgas ! grab mass mixing ratio of gas gas_mmr = rad_const_array(:,:,gas_idx) do i = 1, nday - mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) + mmr(i,ktoprad:) = gas_mmr(idxday(i),ktopcam:) end do ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. @@ -104,8 +107,8 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, if ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then P_top = 50.0_kind_phys do i = 1, nday - P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM - P_mid = pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + P_int = pint(idxday(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = pmid(idxday(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) diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 183f955e..e1e495c9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -17,7 +17,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp - use shr_RandNum_mod, only: ShrKissRandGen + use shr_RandNum_mod, only: ShrKissRandGen ! SIMA-specific randum number generator use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! Compute combined cloud optical properties. @@ -39,7 +39,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) ! combined cloud single scattering albedo * tau real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction - real(kind_phys), intent(in) :: pmid(:,:) ! air ressure at mid-points [Pa] + real(kind_phys), intent(in) :: pmid(:,:) ! air pressure at mid-points [Pa] logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! SW cloud optical properties object @@ -82,6 +82,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda errmsg = cloud_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) if (len_trim(errmsg) > 0) then errflg = 1 + return end if ! number of CAM's layers in radiation calculation. Does not include the "extra layer". @@ -101,7 +102,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda return end if - ! Subset "chunk" data so just the daylight columns, and the number of CAM layers in the + ! Subset 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:) @@ -120,8 +121,6 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) - nver = pver - ktopcam + 1 - ! clip cloud fraction cldfrac(:,:) = cldf(:nday,:) where (cldfrac(:,:) < cldmin) diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 19a291d1..2d8e9c08 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -74,14 +74,15 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Optionally compute clear-sky fluxes if (doswclrsky) then - call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky',rte_sw( & + errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + flux_clrsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -95,23 +96,24 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! ################################################################################### if (doswallsky) then - ! Delta scale - !call check_error_msg('rrtmgp_sw_rte_delta_scale',sw_optical_props_clouds%delta_scale()) - ! Increment - call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', & - sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props)) + errmsg = sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props) + call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if ! Compute fluxes - call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky',rte_sw( & + errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) - + flux_allsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + call check_error_msg('rrtmgp_sw_rte_rte_sw_allskky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 end if diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 6b1bba64..e9b2fd3f 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -39,7 +39,7 @@ subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, e if ( do_spctrl_scaling ) then if ( .not.has_spectrum ) then - write(errmsg, *) 'rrtmgp_sw_solar_var_init: solar input fil must have irradiance spectrum' + write(errmsg, *) 'rrtmgp_sw_solar_var_init: solar input file must have irradiance spectrum' errflg = 1 return endif @@ -80,14 +80,14 @@ end subroutine rrtmgp_sw_solar_var_init !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- - subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spctrl_scaling, & + subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, do_spctrl_scaling, & sfac, eccf, errmsg, errflg) ! Arguments real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance - real(kind_phys), intent(in) :: we(:) ! wavelength endpoints + real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands @@ -110,7 +110,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, w if (do_spctrl_scaling) then ! Determine target irradiance for each band - call integrate_spectrum(nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) + call integrate_spectrum(nbins, nswbands, wave_end, radbinmin, radbinmax, sol_irrad, irrad) ncols = size(toa_flux, 1) allocate(scale(ncols), stat=errflg, errmsg=alloc_errmsg) @@ -171,11 +171,10 @@ subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) trg_x(2) = max_trg(i) call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) - ! W/m2/nm --> W/m2 + ! W m-2 nm-1 --> W m-2 trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) - enddo - + end do end subroutine integrate_spectrum From 598993f793ba15bff790a38d1e748912c6bcfb26 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 2 Sep 2025 14:43:25 -0600 Subject: [PATCH 083/140] remove duplicate var --- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index f7bc333d..dc654555 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -47,7 +47,6 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, ! For ozone profile above model real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff - character(len=256) :: alloc_errmsg character(len=*), parameter :: sub = 'rrtmgp_sw_gas_optics_pre_run' !---------------------------------------------------------------------------- From 3a5424da67e60e63d65b9c2d42a6ea0ecdeddabb Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 2 Sep 2025 15:59:38 -0600 Subject: [PATCH 084/140] add missing end if --- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index dc654555..71fb2659 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -63,6 +63,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, if (errflg /= 0) then write(errmsg,*) sub//": failed to allocate 'gas_mmr' - message: "//alloc_errmsg return + end if allocate(gas_vmr(nday, nlay), stat=errflg, errmsg=alloc_errmsg) if (errflg /= 0) then write(errmsg,*) sub//": failed to allocate 'gas_vmr' - message: "//alloc_errmsg From 5458be34e686c54471bbf671cdfc18d861cd9a47 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 2 Sep 2025 16:44:11 -0600 Subject: [PATCH 085/140] add missing argument --- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 16c38390..ea2ec2ea 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -140,7 +140,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! Combine the cloud optical properties. ! gammadist liquid optics - call get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, g_mu, iclwpth, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, errmsg, errflg) + call get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, g_mu, iclwpth, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, errmsg, errflg) if (errflg /= 0) then return end if From 8bf9bbd43b3b833050f998301046b2f08cde37c1 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 2 Sep 2025 17:13:02 -0600 Subject: [PATCH 086/140] working on getting rrtmgp to build with sw schemes --- schemes/radiation_utils/mo_util.F90 | 81 ++++++++ .../radiation_utils/solar_irradiance_data.F90 | 135 ++++++++++---- .../solar_irradiance_data.meta | 76 ++++++-- schemes/rrtmgp/rrtmgp_constituents.F90 | 42 +++-- schemes/rrtmgp/rrtmgp_constituents.meta | 14 +- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 3 +- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 6 + schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 164 ++++++++-------- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 2 +- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 28 ++- schemes/rrtmgp/rrtmgp_subcycle.F90 | 9 +- schemes/rrtmgp/rrtmgp_subcycle.meta | 4 +- .../rrtmgp/rrtmgp_sw_calculate_fluxes.meta | 2 +- .../rrtmgp_sw_calculate_heating_rate.meta | 6 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 176 +++++++++--------- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_rte.meta | 11 ++ schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 14 +- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 17 +- .../rrtmgp_lw_diagnostics.meta | 4 +- .../rrtmgp_sw_diagnostics.F90 | 9 +- .../rrtmgp_sw_diagnostics.meta | 6 +- 24 files changed, 530 insertions(+), 289 deletions(-) create mode 100644 schemes/radiation_utils/mo_util.F90 diff --git a/schemes/radiation_utils/mo_util.F90 b/schemes/radiation_utils/mo_util.F90 new file mode 100644 index 00000000..42ea6f40 --- /dev/null +++ b/schemes/radiation_utils/mo_util.F90 @@ -0,0 +1,81 @@ +module mo_util + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + private + public :: rebin + +contains + + subroutine rebin( nsrc, ntrg, src_x, trg_x, src, trg ) + !--------------------------------------------------------------- + ! ... rebin src to trg + !--------------------------------------------------------------- + + 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) :: trg_x(ntrg+1) ! target coordinates + real(r8), intent(in) :: src(nsrc) ! source array + real(r8), intent(out) :: trg(ntrg) ! target array + + !--------------------------------------------------------------- + ! ... local variables + !--------------------------------------------------------------- + integer :: i, l + integer :: si, si1 + integer :: sil, siu + real(r8) :: y + real(r8) :: sl, su + real(r8) :: tl, tu + + !--------------------------------------------------------------- + ! ... check interval overlap + !--------------------------------------------------------------- + ! if( trg_x(1) < src_x(1) .or. trg_x(ntrg+1) > src_x(nsrc+1) ) then + ! write(iulog,*) 'rebin: target grid is outside source grid' + ! write(iulog,*) ' target grid from ',trg_x(1),' to ',trg_x(ntrg+1) + ! write(iulog,*) ' source grid from ',src_x(1),' to ',src_x(nsrc+1) + ! call endrun + ! end if + + do i = 1,ntrg + tl = trg_x(i) + if( tl < src_x(nsrc+1) ) then + do sil = 1,nsrc+1 + if( tl <= src_x(sil) ) then + exit + end if + end do + tu = trg_x(i+1) + do siu = 1,nsrc+1 + if( tu <= src_x(siu) ) then + exit + end if + end do + y = 0._r8 + sil = max( sil,2 ) + siu = min( siu,nsrc+1 ) + do si = sil,siu + si1 = si - 1 + sl = max( tl,src_x(si1) ) + su = min( tu,src_x(si) ) + y = y + (su - sl)*src(si1) + end do + trg(i) = y/(trg_x(i+1) - trg_x(i)) + else + trg(i) = 0._r8 + end if + end do + + end subroutine rebin + + +end module mo_util diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 9ac319b4..251bbd4e 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -13,11 +13,12 @@ module solar_irradiance_data save private + public :: solar_irradiance_data_register public :: solar_irradiance_data_init public :: solar_irradiance_data_run type(time_coordinate) :: time_coord - real(kind_phys) :: ref_tsi + real(kind_phys), allocatable :: ref_tsi real(kind_phys), public, protected, allocatable :: sol_etf(:) real(kind_phys), public, protected, allocatable :: ssi_ref(:) ! a reference spectrum constructed from 3 solar cycles of data real(kind_phys), allocatable :: irradi(:,:) @@ -32,13 +33,72 @@ module solar_irradiance_data contains !------------------------------------------------------------------------------- +!> \section arg_table_solar_irradiance_data_register Argument Table +!! \htmlinclude solar_irradiance_data_register.html +!! + subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg, errflg) + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + ! Arguments + character(len=*), intent(in) :: irrad_file_path + integer, intent(out) :: nbins + integer, intent(out) :: nbinsp + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys), allocatable :: lambda(:) + class(abstract_netcdf_reader_t), pointer :: file_reader + integer, parameter :: missing_variable_error_code = 3 + + ! Set error variables + errmsg = '' + errflg = 0 + + nbins = 0 + nbinsp = 0 + + file_reader => create_netcdf_reader_t() + + ! Open the solar irradiance data file + call file_reader%open_file(irrad_file_path, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Read the wavelengths variable + call file_reader%get_var('wavelength', lambda, errmsg, errflg) + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + else if (errflg == missing_variable_error_code) then + ! Check old name (for backward compatibility + call file_reader%get_var('wvl', lambda, errmsg, errflg) + end if + + ! Close the solar irradiance file + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then + return + end if + deallocate(file_reader) + nullify(file_reader) + + if (errflg /= 0) then + ! Override the errflg, it's ok if there is no wavelength info on file in some scenarios + errflg = 0 + return + end if + + ! Set output variables (dimensions) + nbins = size(lambda) + nbinsp = nbins + 1 + + end subroutine solar_irradiance_data_register !> \section arg_table_solar_irradiance_data_init Argument Table !! \htmlinclude solar_irradiance_data_init.html !! subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_data_ymd, solar_data_tod, solar_const, & - solar_heating_spectral_scl, speed_of_light, planck_const, do_spectral_scaling, has_spectrum, sol_tsi, & - we, nbins, nbinsp, errmsg, errflg) - use infnan, only: nan, assignment(=) + solar_heating_spectral_scl, speed_of_light, planck_const, nbins, nbinsp, do_spectral_scaling, has_spectrum, sol_tsi, & + wave_end, sol_irrad, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path @@ -52,14 +112,16 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da logical, intent(out) :: do_spectral_scaling ! flag to do spectral scaling logical, intent(out) :: has_spectrum ! flag for whether solar input file has irradiance spectrum real(kind_phys), intent(out) :: sol_tsi - real(kind_phys), allocatable, intent(out) :: we(:) - integer, intent(out) :: nbins - integer, intent(out) :: nbinsp + real(kind_phys), allocatable, intent(out) :: wave_end(:) + real(kind_phys), allocatable, intent(out) :: sol_irrad(:) + integer, intent(in) :: nbins + integer, intent(in) :: nbinsp character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables logical :: fixed + integer :: idx real(kind_phys), allocatable :: ssi(:,:) real(kind_phys), allocatable :: ssi_ref(:) real(kind_phys), allocatable :: tsi(:) @@ -69,14 +131,14 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da class(abstract_netcdf_reader_t), pointer :: file_reader integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg - real(kind_phys), parameter :: fac = 1._kind_phys/(planck_const*speed_of_light) + real(kind_phys) :: fac ! Set error variables errmsg = '' errflg = 0 sol_tsi = -1.0_kind_phys - ref_tsi = nan + fac = 1._kind_phys/(planck_const*speed_of_light) has_spectrum = .false. @@ -86,8 +148,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da fixed_scon = .true. end if - if (const_tsi>0._kind_phys) then - sol_tsi = const_tsi + if (solar_const>0._kind_phys) then + sol_tsi = solar_const end if if ( fixed_scon ) return @@ -116,7 +178,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da call file_reader%get_var('tsi', tsi, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then return - else if (errflg /= missing_variable_error_code .and. const_tsi < 0._kind_phys) then + else if (errflg /= missing_variable_error_code .and. solar_const < 0._kind_phys) then has_tsi = .true. end if @@ -155,16 +217,13 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da end if ! Close the solar irradiance file - call file_reader%close_file(errmsg, errcode) - if (errcode /= 0) then + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then return end if deallocate(file_reader) nullify(file_reader) - nbins = size(lambda) - nbinsp = nbins + 1 - allocate(irrad_fac(nbins), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then write(errmsg,*) 'solar_data_init: failed to allocate irrad_fac; error = ', alloc_errmsg @@ -178,9 +237,9 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Calculate wavelength ends and convert units if ( has_spectrum ) then - allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) + allocate(wave_end(nbins+1), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg + write(errmsg,*) 'solar_data_init: failed to allocate wave_end; error = ', alloc_errmsg return end if allocate(sol_etf(nbins), stat=errflg, errmsg=alloc_errmsg) @@ -188,17 +247,12 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da write(errmsg,*) 'solar_data_init: failed to allocate sol_etf; error = ', alloc_errmsg return end if - allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) - if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg - return - end if - we(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) - we(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) - do i = 1,nbins - irrad_fac(i) = 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm - etf_fac(i) = 1.e-16_kind_phys*lambda(i)*fac ! mW/m2/nm --> photons/cm2/sec/nm + wave_end(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) + wave_end(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) + do idx = 1,nbins + irrad_fac(idx) = 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm + etf_fac(idx) = 1.e-16_kind_phys*lambda(idx)*fac ! mW/m2/nm --> photons/cm2/sec/nm enddo if(has_ref_spectrum) then ssi_ref = ssi_ref * 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm @@ -210,7 +264,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! need to force data loading when the model starts at a time =/ 00:00:00.000 ! -- may occur in restarts also - call solar_irradiance_data_run(irrad_file_path, errmsg, errflg) + call solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & + sol_irrad, wave_end, sol_tsi, errmsg, errflg) if (errflg /= 0) then return end if @@ -224,13 +279,13 @@ end subroutine solar_irradiance_data_init !> \section arg_table_solar_irradiance_data_run Argument Table !! \htmlinclude solar_irradiance_data_run.html !! - subroutine solar_irradiance_data_run(irrad_file_path, nbins, has_spectrum, do_spectral_scaling, & - sol_irrad, we, sol_tsi, errmsg, errflg) + subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & + sol_irrad, sol_tsi, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path - real(kind_phys), intent(in) :: we(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: nbinsp ! number of bins plus one logical, intent(in) :: has_spectrum logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling real(kind_phys), intent(out) :: sol_tsi ! total solar irradiance @@ -243,9 +298,9 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, has_spectrum, do_sp integer :: offset(2), count(2) integer, allocatable :: itsi(:) logical :: read_data - real(r8) :: data(nbins) + real(kind_phys) :: data(nbins) integer :: ierr - real(r8) :: delt + real(kind_phys) :: delt class(abstract_netcdf_reader_t), pointer :: file_reader ! Initialize error variables @@ -286,15 +341,15 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, has_spectrum, do_sp if (errflg /= 0) then return end if - if ( any(itsi(:nt) < 0._r8) ) then + if ( any(itsi(:nt) < 0._kind_phys) ) then write(errmsg,*) 'solar_data_advance: invalid or missing tsi data' errflg = 1 return end if end if ! Close the solar irradiance file - call file_reader%close_file(errmsg, errcode) - if (errcode /= 0) then + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then return end if deallocate(file_reader) @@ -307,8 +362,8 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, has_spectrum, do_sp data(:) = irradi(:,1) + delt*( irradi(:,2) - irradi(:,1) ) do idx = 1,nbins - sol_irrad(idx) = data(i)*irrad_fac(idx) ! W/m2/nm - sol_etf(idx) = data(i)*etf_fac(idx) ! photons/cm2/sec/nm + sol_irrad(idx) = data(idx)*irrad_fac(idx) ! W/m2/nm + sol_etf(idx) = data(idx)*etf_fac(idx) ! photons/cm2/sec/nm end do end if if (has_tsi .and. (.not.do_spectral_scaling)) then diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta index efd2ad76..d525aaaa 100644 --- a/schemes/radiation_utils/solar_irradiance_data.meta +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -2,6 +2,40 @@ name = solar_irradiance_data type = scheme +[ccpp-arg-table] + name = solar_irradiance_data_register + type = scheme +[ irrad_file_path ] + standard_name = filename_of_solar_irradiance_data + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ nbins ] + standard_name = number_of_wavelength_samples_of_spectrum + units = count + type = integer + dimensions = () + intent = out +[ nbinsp ] + standard_name = number_of_wavelength_samples_of_spectrum_plus_one + units = count + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_messag + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + [ccpp-arg-table] name = solar_irradiance_data_init type = scheme @@ -53,6 +87,18 @@ type = real | kind = kind_phys dimensions = () intent = in +[ nbins ] + standard_name = number_of_wavelength_samples_of_spectrum + units = count + type = integer + dimensions = () + intent = in +[ nbinsp ] + standard_name = number_of_wavelength_samples_of_spectrum_plus_one + units = count + type = integer + dimensions = () + intent = in [ do_spectral_scaling ] standard_name = do_spectral_scaling_of_solar_irradiance_data units = flag @@ -71,23 +117,17 @@ type = real | kind = kind_phys dimensions = () intent = out -[ we ] +[ wave_end ] standard_name = wavelength_endpoints units = nm type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) intent = out -[ nbins ] - standard_name = number_of_wavelength_samples_of_spectrum - units = count - type = integer - dimensions = () - intent = out -[ nbinsp ] - standard_name = number_of_wavelength_samples_of_spectrum_plus_one - units = count - type = integer - dimensions = () +[ sol_irrad ] + standard_name = solar_irradiance + units = W m-2 nm-1 + type = real | kind = kind_phys + dimensions = (number_of_wavelength_samples_of_spectrum) intent = out [ errmsg ] standard_name = ccpp_error_messag @@ -117,6 +157,12 @@ type = integer dimensions = () intent = in +[ nbinsp ] + standard_name = number_of_wavelength_samples_of_spectrum_plus_one + units = count + type = integer + dimensions = () + intent = in [ has_spectrum ] standard_name = solar_irradiance_file_has_spectrum_information units = flag @@ -135,12 +181,6 @@ type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum) intent = out -[ we ] - standard_name = wavelength_endpoints - units = nm - type = real | kind = kind_phys - dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) - intent = in [ sol_tsi ] standard_name = total_solar_irradiance units = W m-2 diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 27493d40..33f0b2ca 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -8,14 +8,14 @@ module rrtmgp_constituents !> \section arg_table_rrtmgp_constituents_register Argument Table !! \htmlinclude rrtmgp_constituents_register.html !! - subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errcode) + subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errflg) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys integer, intent(in) :: nradgas type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) character(len=256), intent(in) :: rad_climate(:) character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + integer, intent(out) :: errflg ! Local variables character(len=1) :: source @@ -25,13 +25,13 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, integer :: gas_idx, strlen, ipos, ierr, idx errmsg = '' - errcode = 0 + errflg = 0 ! Allocate the dynamic constituents array allocate(rrtmgp_dyn_consts(nradgas), stat=ierr, errmsg=alloc_errmsg) if (ierr /= 0) then write(errmsg, *) 'rrtmgp_constituents_register: Unable to allocate rrtmgp_dyn_consts - message: ', alloc_errmsg - errcode = 1 + errflg = 1 return end if @@ -73,7 +73,7 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, advected = .true., & water_species = .false., & mixing_ratio_type = 'dry', & - errcode = errcode, & + errcode = errflg, & errmsg = errmsg) else if (source == 'N') then call rrtmgp_dyn_consts(gas_idx)%instantiate( & @@ -85,7 +85,7 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, advected = .false., & water_species = .false., & mixing_ratio_type = 'dry', & - errcode = errcode, & + errcode = errflg, & errmsg = errmsg) else if (source == 'Z') then call rrtmgp_dyn_consts(gas_idx)%instantiate( & @@ -98,12 +98,12 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, advected = .false., & water_species = .false., & mixing_ratio_type = 'dry', & - errcode = errcode, & + errcode = errflg, & errmsg = errmsg) else write(errmsg,*) 'rrtmgp_constituent_register: invalid gas source "', source, '" for radiation', & ' constituent "', stdname, '"' - errcode = 1 + errflg = 1 return end if @@ -115,14 +115,15 @@ end subroutine rrtmgp_constituents_register !! \htmlinclude rrtmgp_constituents_int.html !! subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, & - rrtmgp_phys_blksz, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & - use_tlev, top_at_one, errmsg, errcode) + rrtmgp_phys_blksz_lw, rrtmgp_phys_blksz_sw, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & + use_tlev, top_at_one, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag integer, intent(in) :: ncol real(kind_phys), intent(in) :: unset_real logical, intent(out) :: active_call_array(:) - integer, intent(out) :: rrtmgp_phys_blksz + integer, intent(out) :: rrtmgp_phys_blksz_lw + integer, intent(out) :: rrtmgp_phys_blksz_sw real(kind_phys), intent(out) :: tlev(:,:) real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) real(kind_phys), intent(out) :: rad_heat(:,:) @@ -132,17 +133,18 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, logical, intent(out) :: use_tlev logical, intent(out) :: top_at_one character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + integer, intent(out) :: errflg ! Initialize error variables - errcode = 0 + errflg = 0 errmsg = '' active_call_array = .true. is_first_restart_step = .false. top_at_one = .true. - rrtmgp_phys_blksz = ncol + rrtmgp_phys_blksz_lw = ncol + rrtmgp_phys_blksz_sw = ncol ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA use_tlev = .false. tlev = unset_real @@ -157,21 +159,21 @@ end subroutine rrtmgp_constituents_init !> \section arg_table_rrtmgp_constituents_run Argument Table !! \htmlinclude rrtmgp_constituents_run.html !! - subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg, errcode) + subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg, errflg) use ccpp_constituent_prop_mod, only: int_unassigned use ccpp_scheme_utils, only: ccpp_constituent_index use ccpp_kinds, only: kind_phys character(len=5), intent(in) :: gaslist(:) real(kind_phys), intent(in) :: const_array(:,:,:) real(kind_phys), intent(out) :: rad_const_array(:,:,:) - integer, intent(out) :: errcode + integer, intent(out) :: errflg character(len=512), intent(out) :: errmsg ! Local variables integer :: gas_idx integer :: const_idx - errcode = 0 + errflg = 0 errmsg = '' rad_const_array = 0._kind_phys @@ -179,11 +181,11 @@ subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg do gas_idx = 1, size(gaslist) ! Find the index of the current gas in the constituents array if (trim(gaslist(gas_idx)) == 'H2O') then - call ccpp_constituent_index('water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', const_idx, errcode, errmsg) + call ccpp_constituent_index('water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water', const_idx, errflg, errmsg) else - call ccpp_constituent_index(trim(gaslist(gas_idx)), const_idx, errcode, errmsg) + call ccpp_constituent_index(trim(gaslist(gas_idx)), const_idx, errflg, errmsg) end if - if (errcode /= 0) then + if (errflg /= 0) then return end if if (const_idx /= int_unassigned) then diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 72e3aa33..0303e060 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -30,7 +30,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer @@ -63,12 +63,18 @@ type = logical dimensions = (number_of_diagnostic_subcycles) intent = out -[ rrtmgp_phys_blksz ] +[ rrtmgp_phys_blksz_lw ] standard_name = number_of_columns_per_longwave_block_for_RRTMGP units = count type = integer dimensions = () intent = out +[ rrtmgp_phys_blksz_sw ] + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out [ tlev ] standard_name = air_temperature_at_interface_for_RRTMGP units = K @@ -123,7 +129,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer @@ -156,7 +162,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index fceaabba..6a099554 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -14,7 +14,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, & p_top_for_rrtmgp, nlwbands, nradgas, gasnamelength, idx_sw_diag, idx_nir_diag, idx_uv_diag, & idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, changeseed, nlayp, & - nextsw_cday, current_cal_day, band2gpt_sw, irad_always_out, errmsg, errflg) + nextsw_cday, current_cal_day, ccpp_constant_two, band2gpt_sw, irad_always_out, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp @@ -29,6 +29,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw integer, intent(in) :: nstep ! Current timestep number integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(in) :: ccpp_constant_two real(kind_phys), intent(in) :: timestep_size ! Timestep size (s) real(kind_phys), intent(in) :: current_cal_day ! Current calendar day real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index a0d16d55..2f6d814d 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -228,6 +228,12 @@ type = real | kind = kind_phys dimensions = () intent = in +[ ccpp_constant_two ] + standard_name = ccpp_constant_two + units = count + type = integer + dimensions = () + intent = in [ band2gpt_sw ] standard_name = shortwave_start_and_end_gpoint_for_each_band units = index diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index e48c5e52..c1c88272 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -16,7 +16,7 @@ module rrtmgp_lw_gas_optics !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & - errmsg, errcode) + errmsg, errflg) use machine, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp @@ -31,7 +31,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object character(len=512), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code + integer, intent(out) :: errflg ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), pointer :: file_reader @@ -76,129 +76,129 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Initialize error variables errmsg = '' - errcode = 0 + errflg = 0 file_reader => create_netcdf_reader_t() ! Open the longwave coefficients file - call file_reader%open_file(lw_filename, errmsg, errcode) - if (errcode /= 0) then + call file_reader%open_file(lw_filename, errmsg, errflg) + if (errflg /= 0) then return end if ! Read the coefficients from the file - call file_reader%get_var('gas_names', gas_names, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('gas_names', gas_names, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('key_species', key_species, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('key_species', key_species, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('press_ref', press_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('press_ref', press_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('temp_ref', temp_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kmajor', kmajor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kmajor', kmajor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('totplnk', totplnk, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('totplnk', totplnk, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('plank_fraction', planck_frac, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('plank_fraction', planck_frac, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= missing_variable_error_code) then + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then return end if - if (errcode /= missing_variable_error_code) then + if (errflg /= missing_variable_error_code) then allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) rayl_lower_allocatable = rayl_lower end if - call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= missing_variable_error_code) then + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then return end if - if (errcode /= missing_variable_error_code) then + if (errflg /= missing_variable_error_code) then allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) rayl_upper_allocatable = rayl_upper end if - call file_reader%get_var('gas_minor', gas_minor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg return end if @@ -210,12 +210,12 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg return end if @@ -227,12 +227,12 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg return end if @@ -244,12 +244,12 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg return end if @@ -261,26 +261,26 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) + if (errflg /= 0) then return end if ! Close the longwave coefficients file - call file_reader%close_file(errmsg, errcode) - if (errcode /= 0) then + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then return end if deallocate(file_reader) @@ -305,7 +305,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & optimal_angle_fit) if (len_trim(errmsg) > 0) then - errcode = 1 + errflg = 1 end if call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 19ed7047..e4d1a23e 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -31,7 +31,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 01f887b8..d55b6aec 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -95,7 +95,33 @@ do_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky flag - If true, use compute the clear sky tendency of air temperature for LW heating. + If true, compute the clear sky tendency of air temperature for LW heating. + + + .true. + + + + logical + rrtmgp + rrtmgp + do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky + flag + + If true, compute the clear sky tendency of air temperature for SW heating. + + + .true. + + + + logical + rrtmgp + rrtmgp + do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_all_sky + flag + + If true, compute the all sky tendency of air temperature for SW heating. .true. diff --git a/schemes/rrtmgp/rrtmgp_subcycle.F90 b/schemes/rrtmgp/rrtmgp_subcycle.F90 index 61102e36..e785db08 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.F90 +++ b/schemes/rrtmgp/rrtmgp_subcycle.F90 @@ -4,16 +4,17 @@ module rrtmgp_subcycle implicit none private + public rrtmgp_subcycle_init public rrtmgp_subcycle_run contains !> \section arg_table_rrtmgp_subcycle_init Argument Table !! \htmlinclude rrtmgp_subcycle_init !! - subroutine rrtmgp_subcycle_init(diag_cur, errmsg, errcode) + subroutine rrtmgp_subcycle_init(diag_cur, errmsg, errflg) integer, intent(out) :: diag_cur character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + integer, intent(out) :: errflg errmsg = '' errflg = 0 @@ -23,11 +24,11 @@ end subroutine rrtmgp_subcycle_init !> \section arg_table_rrtmgp_subcycle_run Argument Table !! \htmlinclude rrtmgp_subcycle_run.html !! - subroutine rrtmgp_subcycle_run(diag_cur, num_diag_cycles, errmsg, errcode) + subroutine rrtmgp_subcycle_run(diag_cur, num_diag_cycles, errmsg, errflg) integer, intent(in) :: num_diag_cycles integer, intent(inout) :: diag_cur character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + integer, intent(out) :: errflg errmsg = '' errflg = 0 diff --git a/schemes/rrtmgp/rrtmgp_subcycle.meta b/schemes/rrtmgp/rrtmgp_subcycle.meta index 8531fe27..5427d08d 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.meta +++ b/schemes/rrtmgp/rrtmgp_subcycle.meta @@ -17,7 +17,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer @@ -44,7 +44,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta index 7d9701aa..d8494bdc 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta @@ -84,7 +84,7 @@ dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out [ fcns ] - standard_name = shortwave_net_clear_sky_radiative_flux + standard_name = shortwave_net_radiative_clear_sky_flux units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta index 95871a69..e4c21d78 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta @@ -33,13 +33,13 @@ standard_name = shortwave_net_radiative_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ flux_net_clrsky ] - standard_name = shortwave_net_clear_sky_radiative_flux + standard_name = shortwave_net_radiative_clear_sky_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ hrate ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index 516afc7b..4426054f 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -139,7 +139,7 @@ intent = out [ snow_tau ] standard_name = snow_optical_depth - units = enter_units + units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out @@ -265,7 +265,7 @@ intent = out [ grau_icld_vistau ] standard_name = graupel_optical_depth_for_visible_band - units = enter_units + units = 1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 3ab717a6..7c9bd86c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -15,7 +15,7 @@ module rrtmgp_sw_gas_optics !! \htmlinclude rrtmgp_sw_gas_optics_init.html !! subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & - errmsg, errcode) + errmsg, errflg) use machine, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp @@ -30,7 +30,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object character(len=512), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errcode ! CCPP error code + integer, intent(out) :: errflg ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), pointer :: file_reader @@ -78,141 +78,141 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & ! Initialize error variables errmsg = '' - errcode = 0 + errflg = 0 file_reader => create_netcdf_reader_t() ! Open the shortwave coefficients file - call file_reader%open_file(sw_filename, errmsg, errcode) - if (errcode /= 0) then + call file_reader%open_file(sw_filename, errmsg, errflg) + if (errflg /= 0) then return end if ! Read the coefficients from the file - call file_reader%get_var('gas_names', gas_names, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('gas_names', gas_names, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('key_species', key_species, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('key_species', key_species, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('press_ref', press_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('press_ref', press_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('temp_ref', temp_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kmajor', kmajor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kmajor', kmajor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('tsi_default', tsi_default, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('tsi_default', tsi_default, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('mg_default', mg_default, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('mg_default', mg_default, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('sb_default', sb_default, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('sb_default', sb_default, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errcode) + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= missing_variable_error_code) then + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then return end if - if (errcode /= missing_variable_error_code) then + if (errflg /= missing_variable_error_code) then allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) rayl_lower_allocatable = rayl_lower end if - call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errcode) + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) ! OK if variable is not on file - if (errcode /= 0 .and. errcode /= missing_variable_error_code) then + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then return end if - if (errcode /= missing_variable_error_code) then + if (errflg /= missing_variable_error_code) then allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) rayl_upper_allocatable = rayl_upper end if - call file_reader%get_var('gas_minor', gas_minor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg return end if @@ -224,12 +224,12 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(scale_by_complement_lower(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg return end if @@ -241,12 +241,12 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg return end if @@ -258,12 +258,12 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) + if (errflg /= 0) then return end if - allocate(scale_by_complement_upper(size(int2log)), stat=errcode, errmsg=alloc_errmsg) - if (errcode /= 0) then + allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg return end if @@ -275,26 +275,26 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & end if end do deallocate(int2log) - call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) + if (errflg /= 0) then return end if - call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errcode) - if (errcode /= 0) then + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) + if (errflg /= 0) then return end if ! Close the shortwave coefficients file - call file_reader%close_file(errmsg, errcode) - if (errcode /= 0) then + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then return end if @@ -321,7 +321,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & rayl_lower_allocatable, rayl_upper_allocatable) if (len_trim(errmsg) > 0) then - errcode = 1 + errflg = 1 end if call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index 7583cd40..f9ac2626 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -29,7 +29,7 @@ type = character | kind = len=512 dimensions = () intent = out -[ errcode ] +[ errflg ] standard_name = ccpp_error_code units = 1 type = integer @@ -73,7 +73,7 @@ standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimensions, vertical_interface_dimension) + dimensions = (daytime_points_dimension, vertical_interface_dimension) intent = in [ t_lay ] standard_name = air_temperature_for_daytime_points_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta index f6e3dbe0..4608ca79 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -19,7 +19,7 @@ intent = in [ pint ] standard_name = air_pressure_at_interface - units = enter_units + units = Pa type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta index b90575cf..a2bd71be 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -1,6 +1,17 @@ [ccpp-table-properties] name = rrtmgp_sw_rte type = scheme + dependencies = ext/rte-frontend/mo_rte_sw.F90 + dependencies = ext/rte-frontend/mo_rte_config.F90 + dependencies = ext/rte-kernels/mo_rte_util_array.F90 + dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ../../../../utils/machine.F90 + dependencies = ./utils/radiation_tools.F90 + dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = ./objects/ccpp_optical_props.F90 + dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_sw_rte_run diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 728f4c25..41feaf61 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -28,10 +28,10 @@ module rrtmgp_sw_solar_var !> \section arg_table_rrtmgp_sw_solar_var_init Argument Table !! \htmlinclude rrtmgp_sw_solar_var_init.html !! - subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, errmsg, errflg) + subroutine rrtmgp_sw_solar_var_init(nswbands, do_spectral_scaling, has_spectrum, errmsg, errflg) use radiation_utils, only : get_sw_spectral_boundaries_ccpp integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -39,7 +39,7 @@ subroutine rrtmgp_sw_solar_var_init(nswbands, do_spctrl_scaling, has_spectrum, e integer :: radmax_loc character(len=256) :: alloc_errmsg - if ( do_spctrl_scaling ) then + if ( do_spectral_scaling ) then if ( .not.has_spectrum ) then write(errmsg, *) 'rrtmgp_sw_solar_var_init: solar input file must have irradiance spectrum' @@ -86,7 +86,7 @@ end subroutine rrtmgp_sw_solar_var_init !> \section arg_table_rrtmgp_sw_solar_var_run Argument Table !! \htmlinclude rrtmgp_sw_solar_var_run.html !! - subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, do_spctrl_scaling, & + subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, do_spectral_scaling, & sfac, eccf, errmsg, errflg) ! Arguments @@ -95,9 +95,10 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, w real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: ccpp_constant_two integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spctrl_scaling ! flag to do spectral scaling + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling real(kind_phys), intent(in) :: eccf ! eccentricity factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg @@ -113,7 +114,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, band2gpt_sw, nswbands, sol_irrad, w errflg = 0 errmsg = '' - if (do_spctrl_scaling) then + if (do_spectral_scaling) then ! Determine target irradiance for each band call integrate_spectrum(nbins, nswbands, wave_end, radbinmin, radbinmax, sol_irrad, irrad) @@ -182,6 +183,7 @@ subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) end do + end subroutine integrate_spectrum end module rrtmgp_sw_solar_var diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index 2eaa5abe..e8b4d200 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_solar_var type = scheme + dependencies = ../radiation_utils/mo_util.F90 [ccpp-arg-table] name = rrtmgp_sw_solar_var_init @@ -11,7 +12,7 @@ type = integer dimensions = () intent = in -[ do_spctrl_scaling ] +[ do_spectral_scaling ] standard_name = do_spectral_scaling_of_solar_irradiance_data units = flag type = logical @@ -45,9 +46,15 @@ type = real | kind = kind_phys dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) intent = inout +[ ccpp_constant_two ] + standard_name = ccpp_constant_two + units = count + type = integer + dimensions = () + intent = in [ band2gpt_sw ] standard_name = shortwave_start_and_end_gpoint_for_each_band - units = enter_units + units = index type = integer dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) intent = in @@ -63,7 +70,7 @@ type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum) intent = in -[ wave_end ] +[ we ] standard_name = wavelength_endpoints units = nm type = real | kind = kind_phys @@ -81,8 +88,8 @@ type = real | kind = kind_phys dimensions = () intent = in -[ do_spctrl_scaling ] - standard_name = do_spectral_scaling +[ do_spectral_scaling ] + standard_name = do_spectral_scaling_of_solar_irradiance_data units = flag type = logical dimensions = () diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta index b6f364a6..fad4b6be 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.meta @@ -121,13 +121,13 @@ standard_name = longwave_net_radiative_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ fcnl ] standard_name = longwave_net_radiative_clear_sky_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ qrl ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index df8d6a67..208925c8 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -137,8 +137,8 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs ! Local variables integer :: diag_index, idx + real(kind_phys) :: fsds(ncol) real(kind_phys) :: solin(ncol) - real(kind_phys) :: fcns(ncol) real(kind_phys) :: fsntoa(ncol) real(kind_phys) :: fsntoac(ncol) real(kind_phys) :: fsutoa(ncol) @@ -149,6 +149,9 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs real(kind_phys) :: flux_sw_clr_dn(ncol,pver) real(kind_phys) :: fsntc(ncol) real(kind_phys) :: fsnsc(ncol) + real(kind_phys) :: fsn200(ncol) + real(kind_phys) :: fsn200c(ncol) + real(kind_phys) :: fsnr(ncol) errmsg = '' errflg = 0 @@ -163,7 +166,6 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs ! Initialize to provide 0.0 values for night columns. solin = 0.0_kind_phys - fcns = 0.0_kind_phys fsntoa = 0.0_kind_phys fsntoac = 0.0_kind_phys fsutoa = 0.0_kind_phys @@ -175,7 +177,8 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs ! Load up diagnostic arrays do idx = 1, nday - solin(idxday(idx) = fswc%fluxes%flux_dn(idx, 1) + fsds(idxday(idx)) = fsw%fluxes%flux_dn(idx, nlay+1) + solin(idxday(idx)) = fswc%fluxes%flux_dn(idx, 1) fsntoa(idxday(idx)) = fsw%fluxes%flux_net(idx, 1) fsntoac(idxday(idx)) = fswc%fluxes%flux_net(idx, 1) fsutoa(idxday(idx)) = fsw%fluxes%flux_up(idx, 1) diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta index 90e597c4..2ab80f89 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta @@ -24,7 +24,7 @@ dimensions = () intent = out [ errflg ] - standard_name = ccpp_error_cde + standard_name = ccpp_error_code units = 1 type = integer dimensions = () @@ -133,13 +133,13 @@ standard_name = shortwave_net_radiative_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ fcns ] standard_name = shortwave_net_radiative_clear_sky_flux units = W m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) intent = in [ qrs ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_shortwave_radiation From d36b8d9093b09c521401a8bdd1583fbb507549fe Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 3 Sep 2025 12:30:16 -0600 Subject: [PATCH 087/140] fix comment --- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 2d8e9c08..ead7f683 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -112,7 +112,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + flux_allsky%fluxes) ! OUT - Fluxes, all-sky, 3D (1,nLay,nBand) call check_error_msg('rrtmgp_sw_rte_rte_sw_allskky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 From 8d8771cada0bc8aa7914989b68e21ec65625349d Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 3 Sep 2025 16:35:39 -0600 Subject: [PATCH 088/140] remove unnecessary comment --- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index e9b2fd3f..84dd85af 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -4,7 +4,6 @@ ! to approximate the spectral distribution of irradiance ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- -! peverwhee - dependencies = radiation_utils, mo_util module rrtmgp_sw_solar_var use ccpp_kinds, only : kind_phys From d65ef2ff1dea66dd7c873cf1ccef79d00563e14e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 5 Sep 2025 12:53:42 -0600 Subject: [PATCH 089/140] update rrtmgp submodule --- schemes/rrtmgp/ext | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/ext b/schemes/rrtmgp/ext index 4d8c5df4..77ff83cc 160000 --- a/schemes/rrtmgp/ext +++ b/schemes/rrtmgp/ext @@ -1 +1 @@ -Subproject commit 4d8c5df4c63434aaab854afd1b02f5986d41dfb3 +Subproject commit 77ff83ccf645e5bc404c138ca4e7a6e3abf5d963 From 3f9deba76f7a60367e5eb4dad4e94bfac1d1ef88 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 8 Sep 2025 10:31:15 -0600 Subject: [PATCH 090/140] remove top_at_1 from sw interface to reflect updated RRTMGP --- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index ead7f683..a3e85a80 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -13,8 +13,8 @@ module rrtmgp_sw_rte !! \htmlinclude rrtmgp_sw_rte_run.html !! subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & - sw_optical_props_clouds, top_at_1, aersw, coszen, toa_src_sw, & - sfc_alb_dir, sfc_alb_dif, flux_clrsky, flux_allsky, errmsg, errflg) + sw_optical_props_clouds, aersw, coszen, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & + flux_clrsky, flux_allsky, errmsg, errflg) use machine, only: kind_phys use mo_rte_sw, only: rte_sw use ccpp_optical_props, only: ty_optical_props_2str_ccpp @@ -26,7 +26,6 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr logical, intent(in) :: doswrad !< Flag to perform shortwave calculation logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes - logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention integer, intent(in) :: nday !< Number of horizontal daylight points integer, intent(in) :: iter_num !< Radiation subcycle iteration number @@ -76,7 +75,6 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr if (doswclrsky) then errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) @@ -107,7 +105,6 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Compute fluxes errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) From efe3b350c2bdbf18a1550f2cd7c29822efd4f9ee Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 11 Sep 2025 11:09:13 -0600 Subject: [PATCH 091/140] sima builds and runs --- .../radiation_utils/solar_irradiance_data.F90 | 21 +++-- .../solar_irradiance_data.meta | 8 +- .../solar_irradiance_data_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_constituents.meta | 2 +- .../rrtmgp/rrtmgp_constituents_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_inputs.F90 | 6 +- schemes/rrtmgp/rrtmgp_inputs.meta | 8 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 3 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 6 -- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 22 ++--- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 2 +- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 85 +++++++++---------- schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 12 +-- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 7 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 8 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 34 ++++---- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 11 +-- .../rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 22 +++-- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 79 ++--------------- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 34 -------- schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 | 82 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta | 37 ++++++++ test/test_suites/suite_rrtmgp.xml | 14 +-- 28 files changed, 268 insertions(+), 249 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 251bbd4e..d8e11c71 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -8,6 +8,7 @@ module solar_irradiance_data use cam_time_coord, only: time_coordinate use ccpp_kinds, only: kind_phys + use cam_logfile, only: iulog implicit none save @@ -98,7 +99,7 @@ end subroutine solar_irradiance_data_register !! subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_data_ymd, solar_data_tod, solar_const, & solar_heating_spectral_scl, speed_of_light, planck_const, nbins, nbinsp, do_spectral_scaling, has_spectrum, sol_tsi, & - wave_end, sol_irrad, errmsg, errflg) + we, sol_irrad, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path @@ -112,8 +113,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da logical, intent(out) :: do_spectral_scaling ! flag to do spectral scaling logical, intent(out) :: has_spectrum ! flag for whether solar input file has irradiance spectrum real(kind_phys), intent(out) :: sol_tsi - real(kind_phys), allocatable, intent(out) :: wave_end(:) - real(kind_phys), allocatable, intent(out) :: sol_irrad(:) + real(kind_phys), allocatable, intent(out) :: we(:) + real(kind_phys), intent(out) :: sol_irrad(:) integer, intent(in) :: nbins integer, intent(in) :: nbinsp character(len=512), intent(out) :: errmsg @@ -237,9 +238,9 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Calculate wavelength ends and convert units if ( has_spectrum ) then - allocate(wave_end(nbins+1), stat=errflg, errmsg=alloc_errmsg) + allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate wave_end; error = ', alloc_errmsg + write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg return end if allocate(sol_etf(nbins), stat=errflg, errmsg=alloc_errmsg) @@ -248,8 +249,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da return end if - wave_end(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) - wave_end(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) + we(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) + we(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) do idx = 1,nbins irrad_fac(idx) = 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm etf_fac(idx) = 1.e-16_kind_phys*lambda(idx)*fac ! mW/m2/nm --> photons/cm2/sec/nm @@ -265,7 +266,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! need to force data loading when the model starts at a time =/ 00:00:00.000 ! -- may occur in restarts also call solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & - sol_irrad, wave_end, sol_tsi, errmsg, errflg) + sol_irrad, we, sol_tsi, errmsg, errflg) if (errflg /= 0) then return end if @@ -280,10 +281,11 @@ end subroutine solar_irradiance_data_init !! \htmlinclude solar_irradiance_data_run.html !! subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & - sol_irrad, sol_tsi, errmsg, errflg) + sol_irrad, we, sol_tsi, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path + real(kind_phys), intent(in) :: we(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins integer, intent(in) :: nbinsp ! number of bins plus one logical, intent(in) :: has_spectrum @@ -360,6 +362,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru if (has_spectrum) then data(:) = irradi(:,1) + delt*( irradi(:,2) - irradi(:,1) ) + sol_irrad(1) = 0.0_kind_phys do idx = 1,nbins sol_irrad(idx) = data(idx)*irrad_fac(idx) ! W/m2/nm diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta index d525aaaa..a541f45f 100644 --- a/schemes/radiation_utils/solar_irradiance_data.meta +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -117,7 +117,7 @@ type = real | kind = kind_phys dimensions = () intent = out -[ wave_end ] +[ we ] standard_name = wavelength_endpoints units = nm type = real | kind = kind_phys @@ -181,6 +181,12 @@ type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum) intent = out +[ we ] + standard_name = wavelength_endpoints + units = nm + type = real | kind = kind_phys + dimensions = (number_of_wavelength_samples_of_spectrum_plus_one) + intent = in [ sol_tsi ] standard_name = total_solar_irradiance units = W m-2 diff --git a/schemes/radiation_utils/solar_irradiance_data_namelist.xml b/schemes/radiation_utils/solar_irradiance_data_namelist.xml index 7358379e..391241ce 100644 --- a/schemes/radiation_utils/solar_irradiance_data_namelist.xml +++ b/schemes/radiation_utils/solar_irradiance_data_namelist.xml @@ -85,7 +85,7 @@ The filename of the solar irradiance data. - ${DIN_LOC_ROOT}/atm/cam/solar/SolarForcing1995-2005avg_c160929.nc + ${DIN_LOC_ROOT}/atm/cam/solar/SolarForcingCMIP7piControl_c20250103.nc diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 0303e060..7cbcd953 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -12,7 +12,7 @@ dimensions = () intent = in [ rad_climate ] - standard_name = sources_of_radiatively_active_gases_for_climate_calcluation + standard_name = sources_of_radiatively_active_gases_for_climate_calculation units = none type = character | kind = len=256 dimensions = (cam_nl_autogen1_dimension) diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml index 7c35d01a..ad60e637 100644 --- a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -79,7 +79,7 @@ char*256(8) rrtmgp_constituents rrtmgp_constituents - sources_of_radiatively_active_gases_for_climate_calcluation + sources_of_radiatively_active_gases_for_climate_calculation none List of radiatively active gases and whether they are advected or not for the climate diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 094c925a..77b916af 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -1,4 +1,5 @@ module rrtmgp_inputs + use cam_logfile, only: iulog implicit none private @@ -60,7 +61,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & real(kind_phys), intent(in) :: stebol ! Stefan-Boltzmann constant (W m-2 K-4) type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object - character(len=*), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases + character(len=5), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases ! Outputs real(kind_phys), dimension(:,:), intent(out) :: t_rad ! Air temperature with radiation indexing (K) real(kind_phys), dimension(:,:), intent(out) :: pmid_rad ! Midpoint pressure with radiation indexing (Pa) @@ -248,6 +249,9 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & return end if + write(iulog,*) 'peverwhee - nlay before alloc' + write(iulog,*) nlay + ! Initialize object for combined gas + aerosol + cloud optics. ! Allocates arrays for properties represented on g-points. errmsg = atm_optics_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 9dce200d..fa570b60 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -111,19 +111,19 @@ standard_name = air_temperature_for_daytime_points_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_layer_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) intent = out [ pmid_day ] standard_name = air_pressure_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_layer_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) intent = out [ pint_day ] standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_interface_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) intent = out [ coszrs_day ] standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep @@ -266,7 +266,7 @@ [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=* + type = character | kind = len=5 dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ gas_concs_lw ] diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index cf1dd290..45a9014c 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -20,7 +20,7 @@ module rrtmgp_lw_cloud_optics !> \section arg_table_rrtmgp_lw_cloud_optics_run Argument Table !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! - subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & + subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, cld, cldfsnow, cldfgrau, & cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, tiny_in, dei, icswpth, & des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, ktopcam, cld_lw_abs, & snow_lw_abs, grau_lw_abs, c_cld_lw_abs, errmsg, errflg) @@ -36,7 +36,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, ! Inputs integer, intent(in) :: ncol ! Number of columns integer, intent(in) :: nlay ! Number of vertical layers in radiation - integer, intent(in) :: nlaycam ! Number of model layers in radiation integer, intent(in) :: nlwbands ! Number of longwave bands integer, intent(in) :: pver ! Total number of vertical layers integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index 473b2ae6..c5c7e267 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -24,12 +24,6 @@ type = integer dimensions = () intent = in -[ nlaycam ] - standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels - units = count - type = integer - dimensions = () - intent = in [ cld ] standard_name = cloud_area_fraction units = fraction diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index 570a806a..18261f4b 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -18,7 +18,7 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, ! Set gas vmr for the gases in the radconstants module's gaslist. - character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + character(len=5), intent(in) :: gaslist(:) ! Radiatively active gases integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: pverp ! Total number of layer interfaces diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index e0c2aeeb..f928f7f6 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -38,7 +38,7 @@ [ gaslist ] standard_name = list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=* + type = character | kind = len=5 dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ pverp ] diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 435dbdb7..c5034465 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -42,7 +42,7 @@ module rrtmgp_lw_mcica_subcol_gen !> \section arg_table_rrtmgp_lw_mcica_subcol_gen_run Argument Table !! \htmlinclude rrtmgp_lw_mcica_subcol_gen_run.html subroutine rrtmgp_lw_mcica_subcol_gen_run( & - dolw, ktoprad, ktopcam, kdist, nbnd, ngpt, ncol, pver, nver, & + dolw, ktoprad, ktopcam, kdist, nbnd, ngpt, ncol, pver, nlay, & cldfprime, c_cld_lw_abs, changeseed, pmid, cloud_lw, & errmsg, errflg ) use ccpp_kinds, only: kind_phys @@ -67,7 +67,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) integer, intent(in) :: ncol ! Number of columns integer, intent(in) :: pver ! Number of model layers - integer, intent(in) :: nver ! Number of layers in radiation calculation + integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: changeseed ! If the subcolumn generator is called multiple times, ! permute the seed between each call. real(kind_phys), dimension(:,:), intent(in) :: pmid ! Layer pressures at midpoints (Pa) @@ -82,17 +82,17 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & integer :: idx, isubcol, kdx, ndx real(kind_phys), parameter :: cldmin = 1.0e-80_kind_phys ! min cloud fraction - real(kind_phys) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + real(kind_phys) :: cldf(ncol,nlay) ! cloud fraction clipped to cldmin type(ShrKissRandGen) :: kiss_gen ! KISS RNG object integer :: kiss_seed(ncol,4) real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) - real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) + real(kind_phys) :: rand_num(ncol,nlay) ! random number (kissvec) - real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers - logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy - real(kind_phys) :: tauc(nbnd,ncol,nver) - real(kind_phys) :: taucmcl(ngpt,ncol,nver) + real(kind_phys) :: cdf(ngpt,ncol,nlay) ! random numbers + logical :: iscloudy(ngpt,ncol,nlay) ! flag that says whether a gridbox is cloudy + real(kind_phys) :: tauc(nbnd,ncol,nlay) + real(kind_phys) :: taucmcl(ngpt,ncol,nlay) !------------------------------------------------------------------------------------------ ! Set error variables @@ -147,7 +147,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & ! - if the layer above is cloudy, use the same random number as in the layer above ! - if the layer above is clear, use a new random number - do kdx = 2, nver + do kdx = 2, nlay do idx = 1, ncol do isubcol = 1, ngpt if (cdf(isubcol,idx,kdx-1) > 1._kind_phys - cldf(idx,kdx-1) ) then @@ -159,14 +159,14 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & end do end do - do kdx = 1, nver + do kdx = 1, nlay iscloudy(:,:,kdx) = (cdf(:,:,kdx) >= 1._kind_phys - spread(cldf(:,kdx), dim=1, nCopies=ngpt) ) end do ! -- generate subcolumns for homogeneous clouds ----- ! where there is a cloud, set the subcolumn cloud properties; ! incoming tauc should be in-cloud quantites and not grid-averaged quantities - do kdx = 1,nver + do kdx = 1,nlay do idx = 1,ncol do isubcol = 1,ngpt if (iscloudy(isubcol,idx,kdx) .and. (cldf(idx,kdx) > 0._kind_phys) ) then diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 9eca0136..47bd4177 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -53,7 +53,7 @@ type = integer dimensions = () intent = in -[ nver ] +[ nlay ] standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels units = count type = integer diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index d55b6aec..84ee1501 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -296,7 +296,7 @@ 10. for all other CAM runs - 10.0D0 + 2.0D0 diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index aaf4e73f..077e5b5d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -29,6 +29,8 @@ module rrtmgp_sw_cloud_optics integer, parameter, dimension(14) :: rrtmg_to_rrtmgp_swbands = & [ 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ] +real(kind_phys) :: tiny + !================================================================================================== contains !================================================================================================== @@ -36,7 +38,7 @@ module rrtmgp_sw_cloud_optics !> \section arg_table_rrtmgp_sw_cloud_optics_run Argument Table !! \htmlinclude rrtmgp_sw_cloud_optics_run.html !! -subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, nswgpts, nday, idxday, fillvalue, & +subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nswgpts, nday, idxday, fillvalue, & nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, idx_sw_diag, do_graupel, & do_snow, kdist_sw, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, tot_cld_vistau, tot_icld_vistau, & @@ -50,7 +52,6 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! Compute combined cloud optical properties. ! arguments - integer, intent(in) :: nlay ! Number of layers in radiation calculation (may include "extra layer") integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: nday ! Number of daylight columns integer, intent(in) :: idxday(:) ! Indices of daylight columns @@ -148,15 +149,17 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, return end if + tiny = tiny_in + ! Combine the cloud optical properties. ! gammadist liquid optics - call get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, g_mu, iclwpth, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, errmsg, errflg) + call get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, g_mu, iclwpth, liq_tau, liq_tau_w, liq_tau_w_g, sw_tau_w_f, errmsg, errflg) if (errflg /= 0) then return end if ! Mitchell ice optics - call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iciwpth, dei, g_d_eff, ice_tau, ice_tau_w, ice_tau_w_g, sw_tau_w_f) + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iciwpth, dei, g_d_eff, 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,:) @@ -164,7 +167,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! add in snow if (do_snow) then - call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, des, g_d_eff, snow_tau, snow_tau_w, snow_tau_w_g, sw_tau_w_f) + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icswpth, des, g_d_eff, 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._kind_phys) then @@ -189,7 +192,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ! add in graupel if (do_graupel) then - call get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, grau_tau, grau_tau_w, grau_tau_w_g, sw_tau_w_f) + call get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, 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._kind_phys) then @@ -217,13 +220,9 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, c_cld_tau_w_g(:,:ncol,:) = c_cld_tau_w_g(rrtmg_to_rrtmgp_swbands,:ncol,:) if (do_snow) then snow_tau(:,:ncol,:) = snow_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - else - snow_tau(:,:ncol,:) = 0._kind_phys end if if (do_graupel) then grau_tau(:,:ncol,:) = grau_tau(rrtmg_to_rrtmgp_swbands,:ncol,:) - else - grau_tau(:,:ncol,:) = 0._kind_phys end if ! Set arrays for diagnostic output. @@ -233,13 +232,9 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:) if (do_snow) then snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:) - else - snow_icld_vistau(:ncol,:) = 0._kind_phys endif if (do_graupel) then grau_icld_vistau(:ncol,:) = grau_tau(idx_sw_diag,:ncol,:) - else - grau_icld_vistau(:ncol,:) = 0._kind_phys endif ! multiply by total cloud fraction to get gridbox value @@ -251,23 +246,25 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nlay, tot_icld_vistau(idxnite(i),:) = fillvalue liq_icld_vistau(idxnite(i),:) = fillvalue ice_icld_vistau(idxnite(i),:) = fillvalue - snow_icld_vistau(idxnite(i),:) = fillvalue - grau_icld_vistau(idxnite(i),:) = fillvalue + if (do_snow) then + snow_icld_vistau(idxnite(i),:) = fillvalue + end if + if (do_graupel) then + grau_icld_vistau(idxnite(i),:) = fillvalue + end if end do end subroutine rrtmgp_sw_cloud_optics_run !============================================================================== -subroutine get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & - iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) +subroutine get_grau_optics_sw(ncol, pver, nswbands, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands integer, intent(in) :: iulog integer, intent(in) :: idx_sw_diag - real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: ext_sw_ice(:,:) real(kind_phys), intent(in) :: asm_sw_ice(:,:) real(kind_phys), intent(in) :: ssa_sw_ice(:,:) @@ -284,7 +281,7 @@ subroutine get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice ! This does the same thing as get_ice_optics_sw, except with a different ! water path and effective diameter. - call interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icgrauwpth, degrau, g_d_eff, tau, tau_w, & + call interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, icgrauwpth, degrau, g_d_eff, tau, tau_w, & tau_w_g, tau_w_f) do i = 1, ncol do k = 1, pver @@ -299,25 +296,24 @@ end subroutine get_grau_optics_sw !============================================================================== -subroutine get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & +subroutine get_liquid_optics_sw(ncol, pver, nswbands, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & g_mu, iclwpth, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands - real(kind_phys), intent(in) :: tiny_in - real(kind_phys), intent(in) :: g_lambda(:,:) - real(kind_phys), intent(in) :: g_mu(:) - real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) - real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) - real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) - real(kind_phys), intent(in) :: iclwpth(:,:) - real(kind_phys), intent(in) :: lamc(:,:) - real(kind_phys), intent(in) :: pgam(:,:) - - real(kind_phys), intent(out) :: tau (:,:,:) ! extinction optical depth - real(kind_phys), intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau - real(kind_phys), intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w - real(kind_phys), intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w + real(kind_phys),intent(in) :: g_lambda(:,:) + real(kind_phys),intent(in) :: g_mu(:) + real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) + real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) + real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) + real(kind_phys),intent(in) :: iclwpth(:,:) + real(kind_phys),intent(in) :: lamc(:,:) + real(kind_phys),intent(in) :: pgam(:,:) + + real(kind_phys),intent(out) :: tau (:,:,:) ! extinction optical depth + real(kind_phys),intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau + real(kind_phys),intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w + real(kind_phys),intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -327,9 +323,8 @@ subroutine get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_s do k = 1,pver do i = 1,ncol if(lamc(i,k) > 0._kind_phys) then ! This seems to be clue from microphysics of no cloud - call gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), & - lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), & - tau_w_f(1:nswbands,i,k), errmsg, errflg) + call gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, iclwpth(i,k), lamc(i,k), pgam(i,k), tau(1:nswbands,i,k), & + tau_w(1:nswbands,i,k), tau_w_g(1:nswbands,i,k), tau_w_f(1:nswbands,i,k), errmsg, errflg) else tau(1:nswbands,i,k) = 0._kind_phys tau_w(1:nswbands,i,k) = 0._kind_phys @@ -343,15 +338,13 @@ end subroutine get_liquid_optics_sw !============================================================================== -subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & +subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & iciwpth, dei, g_d_eff, tau, tau_w, tau_w_g, tau_w_f) - ! SIMA-specific interpolation routines use interpolate_data, only: interp_type, lininterp, lininterp_init, lininterp_finish, extrap_method_bndry integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands - real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: iciwpth(:,:) real(kind_phys), intent(in) :: dei(:,:) real(kind_phys), intent(in) :: g_d_eff(:) @@ -374,7 +367,7 @@ subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, do k = 1,pver do i = 1,ncol - if( iciwpth(i,k) < tiny_in .or. dei(i,k) == 0._kind_phys) then + if( iciwpth(i,k) < tiny .or. dei(i,k) == 0._kind_phys) then ! if ice water path is too small, OD := 0 tau (:,i,k) = 0._kind_phys tau_w (:,i,k) = 0._kind_phys @@ -406,14 +399,12 @@ end subroutine interpolate_ice_optics_sw !============================================================================== -subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) - ! SIMA-specific interpolation routines +subroutine gam_liquid_sw(nswbands, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) use interpolate_data, only: interp_type, lininterp, lininterp_finish use radiation_utils, only: get_mu_lambda_weights_ccpp use rrtmgp_cloud_optics_setup, only: nmu, nlambda integer, intent(in) :: nswbands - real(kind_phys), intent(in) :: tiny_in real(kind_phys), intent(in) :: ext_sw_liq(:,:,:) real(kind_phys), intent(in) :: asm_sw_liq(:,:,:) real(kind_phys), intent(in) :: ssa_sw_liq(:,:,:) @@ -421,7 +412,7 @@ subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_l real(kind_phys), intent(in) :: g_lambda(:,:) real(kind_phys), intent(in) :: lamc real(kind_phys), intent(in) :: pgam - real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) [kg m-2] + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? real(kind_phys), intent(out) :: tau(:), tau_w(:), tau_w_f(:), tau_w_g(:) character(len=512), intent(out) :: errmsg @@ -438,7 +429,7 @@ subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_l errmsg = '' errflg = 0 - if (clwptn < tiny_in) then + if (clwptn < tiny) then tau = 0._kind_phys tau_w = 0._kind_phys tau_w_g = 0._kind_phys diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index 4426054f..4f905858 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -35,12 +35,6 @@ type = integer dimensions = () intent = in -[ nlay ] - standard_name = number_of_vertical_layers_in_RRTMGP - units = count - type = integer - dimensions = () - intent = in [ nswgpts ] standard_name = number_of_shortwave_g_point_intervals units = count @@ -216,19 +210,19 @@ dimensions = () intent = in [ c_cld_tau ] - standard_name = combined_cloud_optical_depth + standard_name = combined_shortwave_cloud_extinction_optical_depth units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ c_cld_tau_w ] - standard_name = combined_cloud_single_scattering_albedo_times_tau + standard_name = combined_shortwave_cloud_single_scattering_albedo units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ c_cld_tau_w_g ] - standard_name = combined_cloud_asymmetry_parameter_times_w_times_tau + standard_name = combined_shortwave_cloud_asymmetry_parameter units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 7c9bd86c..f38ff5b1 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -4,6 +4,7 @@ !> This module contains an init routine to initialize the shortwave gas optics object !> with data read in from file on the host side module rrtmgp_sw_gas_optics + use cam_logfile, only: iulog implicit none private @@ -338,7 +339,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l use ccpp_optical_props, only: ty_optical_props_2str_ccpp use radiation_tools, only: check_error_msg ! Inputs - logical, intent(in) :: dosw !< Flag for whether to perform shortwave calculation + logical, intent(in) :: dosw !< Flag for whether to perform longwave calculation integer, intent(in) :: iter_num !< Subcycle iteration number integer, intent(in) :: ncol !< Total number of columns integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once @@ -365,6 +366,8 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l return end if + write(iulog,*) 'peverwhee - in sw gas optics' + write(iulog,*) size(p_lay,2) iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) @@ -372,7 +375,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios sw_optical_props%optical_props, & ! OUT - RRTMGP DDT: Shortwave optical properties, by ! spectral point (tau,ssa,g) toa_src_sw) ! OUT - TOA incident shortwave radiation (spectral) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index f9ac2626..a4ac2a90 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -52,7 +52,7 @@ dimensions = () intent = in [ ncol ] - standard_name = horizontal_loop_extent + standard_name = daytime_points_dimension units = count type = integer dimensions = () @@ -67,19 +67,19 @@ standard_name = air_pressure_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_layer_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) intent = in [ p_lev ] standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_interface_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) intent = in [ t_lay ] standard_name = air_temperature_for_daytime_points_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (daytime_points_dimension, vertical_layer_dimension) + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) intent = in [ gas_concs ] standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index 71fb2659..bdc888f4 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -1,4 +1,5 @@ module rrtmgp_sw_gas_optics_pre + use cam_logfile, only: iulog implicit none private @@ -18,7 +19,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, ! Set gas vmr for the gases in the radconstants module's gaslist. - character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + character(len=5), intent(in) :: gaslist(:) ! Radiatively active gases integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: nday ! Total number of daylight columns integer, intent(in) :: pverp ! Total number of layer interfaces @@ -37,7 +38,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, integer, intent(out) :: errflg ! Local variables - integer :: i, gas_idx + integer :: i, gas_idx, idx(nday) integer :: istat real(kind_phys), allocatable :: gas_mmr(:,:) real(kind_phys), allocatable :: gas_vmr(:,:) @@ -51,6 +52,9 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, character(len=*), parameter :: sub = 'rrtmgp_sw_gas_optics_pre_run' !---------------------------------------------------------------------------- + write(iulog,*) 'peverwhee - nradgas' + write(iulog,*) nradgas + ! Set error variables errmsg = '' errflg = 0 @@ -59,25 +63,22 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, return end if - allocate(gas_mmr(nday, pverp-1), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg,*) sub//": failed to allocate 'gas_mmr' - message: "//alloc_errmsg - return - end if - allocate(gas_vmr(nday, nlay), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg,*) sub//": failed to allocate 'gas_vmr' - message: "//alloc_errmsg - return - end if + allocate(gas_mmr(nday, pverp-1)) + allocate(gas_vmr(nday, nlay)) ! Check allocate + ! set the column indices + do i = 1, nday + idx(i) = idxday(i) + end do + do gas_idx = 1, nradgas ! grab mass mixing ratio of gas gas_mmr = rad_const_array(:,:,gas_idx) do i = 1, nday - mmr(i,ktoprad:) = gas_mmr(idxday(i),ktopcam:) + 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. @@ -107,8 +108,8 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, if ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then P_top = 50.0_kind_phys do i = 1, nday - P_int = pint(idxday(i),1) ! pressure (Pa) at upper interface of CAM - P_mid = pmid(idxday(i),1) ! pressure (Pa) at midpoint of top layer of CAM + P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = 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) @@ -124,6 +125,9 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, end do end if + write(iulog,*) 'peverwhee - setting concs for gas' + write(iulog,*) gaslist(gas_idx) + errmsg = gas_concs%gas_concs%set_vmr(gaslist(gas_idx), gas_vmr) if (len_trim(errmsg) > 0) then errflg = 1 diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta index 4608ca79..ee4ad9c3 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -38,7 +38,7 @@ [ gaslist ] standard_name = list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=* + type = character | kind = len=5 dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ idxday ] diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 03ac8be5..fafeddea 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -20,7 +20,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp - use shr_RandNum_mod, only: ShrKissRandGen ! SIMA-specific randum number generator + use shr_RandNum_mod, only: ShrKissRandGen use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! Compute combined cloud optical properties. @@ -42,10 +42,10 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) ! combined cloud single scattering albedo * tau real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction - real(kind_phys), intent(in) :: pmid(:,:) ! air pressure at mid-points [Pa] + real(kind_phys), intent(in) :: pmid(:,:) ! air ressure at mid-points [Pa] logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep - type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! SW cloud optical properties object + type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -85,7 +85,6 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda errmsg = cloud_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) if (len_trim(errmsg) > 0) then errflg = 1 - return end if ! number of CAM's layers in radiation calculation. Does not include the "extra layer". @@ -105,7 +104,7 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda return end if - ! Subset data so just the daylight columns, and the number of CAM layers in the + ! 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:) @@ -124,6 +123,8 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda ! set asymmetry to zero when tauc = 0 asmc = merge(asmc, 0.0_kind_phys, tauc > 0.0_kind_phys) + nver = pver - ktopcam + 1 + ! clip cloud fraction cldfrac(:,:) = cldf(:nday,:) where (cldfrac(:,:) < cldmin) diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta index ccca8259..87b82555 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta @@ -100,7 +100,7 @@ units = none type = ty_optical_props_2str_ccpp dimensions = () - intent = inout + intent = out [ pmid ] standard_name = air_pressure units = Pa diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 2d8e9c08..19a291d1 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -74,15 +74,14 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Optionally compute clear-sky fluxes if (doswclrsky) then - errmsg = rte_sw( & + call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky',rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) - call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky', errmsg) + flux_clrsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) if (len_trim(errmsg) /= 0) then errflg = 1 return @@ -96,24 +95,23 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! ################################################################################### if (doswallsky) then + ! Delta scale + !call check_error_msg('rrtmgp_sw_rte_delta_scale',sw_optical_props_clouds%delta_scale()) + ! Increment - errmsg = sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props) - call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if + call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', & + sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props)) ! Compute fluxes - errmsg = rte_sw( & + call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky',rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties top_at_1, & ! IN - veritcal ordering flag coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) - call check_error_msg('rrtmgp_sw_rte_rte_sw_allskky', errmsg) + flux_allsky%fluxes)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + if (len_trim(errmsg) /= 0) then errflg = 1 end if diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 41feaf61..43af006b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -13,92 +13,29 @@ module rrtmgp_sw_solar_var save private - public :: rrtmgp_sw_solar_var_init public :: rrtmgp_sw_solar_var_run - real(kind_phys), allocatable :: irrad(:) ! solar irradiance at model timestep in each band - - real(kind_phys), allocatable :: radbinmax(:) - real(kind_phys), allocatable :: radbinmin(:) - !------------------------------------------------------------------------------- contains !------------------------------------------------------------------------------- -!> \section arg_table_rrtmgp_sw_solar_var_init Argument Table -!! \htmlinclude rrtmgp_sw_solar_var_init.html -!! - subroutine rrtmgp_sw_solar_var_init(nswbands, do_spectral_scaling, has_spectrum, errmsg, errflg) - use radiation_utils, only : get_sw_spectral_boundaries_ccpp - integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling - logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: radmax_loc - character(len=256) :: alloc_errmsg - - if ( do_spectral_scaling ) then - - if ( .not.has_spectrum ) then - write(errmsg, *) 'rrtmgp_sw_solar_var_init: solar input file must have irradiance spectrum' - errflg = 1 - return - endif - - allocate (radbinmax(nswbands),stat=errflg,errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for radbinmax - message: ', alloc_errmsg - return - end if - - allocate (radbinmin(nswbands),stat=errflg,errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for radbinmin - message: ', alloc_errmsg - return - end if - - allocate (irrad(nswbands), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg,*) 'rrtmgp_sw_solar_var_init: Error allocating space for irrad - message: ', alloc_errmsg - return - end if - - call get_sw_spectral_boundaries_ccpp(radbinmin, radbinmax, 'nm', errmsg, errflg) - if (errflg /= 0) then - return - 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._kind_phys,radbinmax(radmax_loc)) - - endif - - end subroutine rrtmgp_sw_solar_var_init - -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- - !> \section arg_table_rrtmgp_sw_solar_var_run Argument Table !! \htmlinclude rrtmgp_sw_solar_var_run.html !! - subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, do_spectral_scaling, & + subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, we, nbins, sol_tsi, do_spectral_scaling, & sfac, eccf, errmsg, errflg) + use rrtmgp_sw_solar_var_setup, only: irrad, radbinmax, radbinmin ! Arguments real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance - real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints + real(kind_phys), intent(in) :: we(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins integer, intent(in) :: ccpp_constant_two integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands - logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling real(kind_phys), intent(in) :: eccf ! eccentricity factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg @@ -114,10 +51,10 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw errflg = 0 errmsg = '' - if (do_spectral_scaling) then + if (do_spectral_scaling) then ! Determine target irradiance for each band - call integrate_spectrum(nbins, nswbands, wave_end, radbinmin, radbinmax, sol_irrad, irrad) + call integrate_spectrum(nbins, nswbands, we, radbinmin, radbinmax, sol_irrad, irrad) ncols = size(toa_flux, 1) allocate(scale(ncols), stat=errflg, errmsg=alloc_errmsg) @@ -178,10 +115,10 @@ subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) trg_x(2) = max_trg(i) call rebin( nsrc, 1, src_x, trg_x, src(1:nsrc), targ(:) ) - ! W m-2 nm-1 --> W m-2 + ! W/m2/nm --> W/m2 trg( i ) = targ(1)*(trg_x(2)-trg_x(1)) - end do + enddo end subroutine integrate_spectrum diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index e8b4d200..cf5387ce 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -3,40 +3,6 @@ type = scheme dependencies = ../radiation_utils/mo_util.F90 -[ccpp-arg-table] - name = rrtmgp_sw_solar_var_init - type = scheme -[ nswbands ] - standard_name = number_of_bands_for_shortwave_radiation - units = count - type = integer - dimensions = () - intent = in -[ do_spectral_scaling ] - standard_name = do_spectral_scaling_of_solar_irradiance_data - units = flag - type = logical - dimensions = () - intent = in -[ has_spectrum ] - standard_name = solar_irradiance_file_has_spectrum_information - units = flag - type = logical - dimensions = () - intent = in -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out - [ccpp-arg-table] name = rrtmgp_sw_solar_var_run type = scheme diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 new file mode 100644 index 00000000..3925d092 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 @@ -0,0 +1,82 @@ +!------------------------------------------------------------------------------- +! 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 +!------------------------------------------------------------------------------- +! peverwhee - dependencies = radiation_utils, mo_util +module rrtmgp_sw_solar_var_setup + + use ccpp_kinds, only : kind_phys + + implicit none + save + + private + public :: rrtmgp_sw_solar_var_setup_init + + real(kind_phys), public, allocatable :: irrad(:) ! solar irradiance at model timestep in each band + + real(kind_phys), public, allocatable :: radbinmax(:) + real(kind_phys), public, allocatable :: radbinmin(:) + +!------------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------------- + +!> \section arg_table_rrtmgp_sw_solar_var_setup_init Argument Table +!! \htmlinclude rrtmgp_sw_solar_var_setup_init.html +!! + subroutine rrtmgp_sw_solar_var_setup_init(nswbands, do_spectral_scaling, has_spectrum, errmsg, errflg) + use radiation_utils, only : get_sw_spectral_boundaries_ccpp + integer, intent(in) :: nswbands ! number of shortwave bands + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling + logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: radmax_loc + character(len=256) :: alloc_errmsg + + if ( do_spectral_scaling ) then + + if ( .not.has_spectrum ) then + write(errmsg, *) 'rrtmgp_sw_solar_var_setup_init: solar input fil must have irradiance spectrum' + errflg = 1 + return + endif + + allocate (radbinmax(nswbands),stat=errflg,errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_setup_init: Error allocating space for radbinmax - message: ', alloc_errmsg + return + end if + + allocate (radbinmin(nswbands),stat=errflg,errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_setup_init: Error allocating space for radbinmin - message: ', alloc_errmsg + return + end if + + allocate (irrad(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,*) 'rrtmgp_sw_solar_var_setup_init: Error allocating space for irrad - message: ', alloc_errmsg + return + end if + + call get_sw_spectral_boundaries_ccpp(radbinmin, radbinmax, 'nm', errmsg, errflg) + if (errflg /= 0) then + return + 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._kind_phys,radbinmax(radmax_loc)) + + endif + + end subroutine rrtmgp_sw_solar_var_setup_init + +end module rrtmgp_sw_solar_var_setup diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta new file mode 100644 index 00000000..c54c605b --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta @@ -0,0 +1,37 @@ +[ccpp-table-properties] + name = rrtmgp_sw_solar_var_setup + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_solar_var_setup_init + type = scheme +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation + units = count + type = integer + dimensions = () + intent = in +[ do_spectral_scaling ] + standard_name = do_spectral_scaling_of_solar_irradiance_data + units = flag + type = logical + dimensions = () + intent = in +[ has_spectrum ] + standard_name = solar_irradiance_file_has_spectrum_information + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index d99be309..6a978da8 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,15 +10,14 @@ rrtmgp_inputs rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen - rrtmgp_sw_gas_optics - - rrtmgp_sw_cloud_temp + rrtmgp_sw_cloud_optics + rrtmgp_sw_mcica_subcol_gen - + rrtmgp_constituents rrtmgp_sw_gas_optics_pre rrtmgp_sw_gas_optics - solar_irradiance_data + solar_irradiance_data rrtmgp_sw_solar_var rrtmgp_sw_rte @@ -28,7 +27,7 @@ rrtmgp_subcycle - + rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics @@ -40,7 +39,8 @@ rrtmgp_subcycle - rrtmgp_inputs_setup + rrtmgp_inputs_setup + rrtmgp_sw_solar_var_setup rrtmgp_dry_static_energy_tendency calculate_net_heating rrtmgp_post From a5af76a7accd90eeda69de9b5d83333e0257214f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 22 Sep 2025 15:48:40 -0600 Subject: [PATCH 092/140] zero out sw aerosols --- schemes/rrtmgp/rrtmgp_inputs.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index c6e62b62..c2be5e5a 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -311,6 +311,10 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & errflg = 1 return end if + ! PEVERWHEE - ZERO AEROSOLS FOR TESTING + aer_sw%optical_props%tau = 0.0_kind_phys + aer_sw%optical_props%g = 0.0_kind_phys + aer_sw%optical_props%ssa = 0.0_kind_phys end if if (dolw) then From b62a6ed14f5952fe0c1438ea9cfd49ba20c3d206 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 22 Sep 2025 15:59:26 -0600 Subject: [PATCH 093/140] fix metadata to match mods --- schemes/rrtmgp/rrtmgp_constituents.F90 | 6 +++--- schemes/rrtmgp/rrtmgp_constituents.meta | 4 ++-- schemes/rrtmgp/rrtmgp_inputs.meta | 18 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_rte.meta | 6 ------ schemes/rrtmgp/rrtmgp_sw_rte.meta | 6 ------ 5 files changed, 23 insertions(+), 17 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 33f0b2ca..619d363f 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -116,7 +116,7 @@ end subroutine rrtmgp_constituents_register !! subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, & rrtmgp_phys_blksz_lw, rrtmgp_phys_blksz_sw, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & - use_tlev, top_at_one, errmsg, errflg) + use_tlev, is_mpas, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag integer, intent(in) :: ncol @@ -131,7 +131,7 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, real(kind_phys), intent(out) :: fsns(:) logical, intent(out) :: is_first_restart_step logical, intent(out) :: use_tlev - logical, intent(out) :: top_at_one + logical, intent(out) :: is_mpas character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -141,7 +141,7 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, active_call_array = .true. is_first_restart_step = .false. - top_at_one = .true. + is_mpas = .false. rrtmgp_phys_blksz_lw = ncol rrtmgp_phys_blksz_sw = ncol diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 7cbcd953..c1ed9ba5 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -117,8 +117,8 @@ type = logical dimensions = () intent = out -[ top_at_one ] - standard_name = do_top_at_one_vertical_ordering_in_radiation +[ is_mpas ] + standard_name = is_mpas_dynamical_core units = flag type = logical dimensions = () diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index fa570b60..f59adf02 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -29,6 +29,24 @@ type = logical dimensions = () intent = in +[ is_root ] + standard_name = flag_for_mpi_root + units = flag + type = logical + dimensions = () + intent = in +[ iulog ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in +[ is_mpas ] + standard_name = is_mpas_dynamical_core + units = flag + type = logical + dimensions = () + intent = in [ pmid ] standard_name = air_pressure units = Pa diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index 717d08f5..f4b57c63 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -64,12 +64,6 @@ type = ty_optical_props_1scl_ccpp dimensions = () intent = inout -[ top_at_1 ] - standard_name = do_top_at_one_vertical_ordering_in_radiation - units = flag - type = logical - dimensions = () - intent = in [ sources ] standard_name = longwave_planck_sources_object_for_RRTMGP units = none diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta index a2bd71be..669c7da2 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -64,12 +64,6 @@ type = ty_optical_props_2str_ccpp dimensions = () intent = inout -[ top_at_1 ] - standard_name = do_top_at_one_vertical_ordering_in_radiation - units = flag - type = logical - dimensions = () - intent = in [ aersw ] standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP units = none From 770ccaf9c20fce2721579c10bebeeb4fecb5b0b6 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 22 Sep 2025 16:06:35 -0600 Subject: [PATCH 094/140] update default single scattering albedo --- schemes/rrtmgp/rrtmgp_inputs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index c2be5e5a..9bfd2d33 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -314,7 +314,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & ! PEVERWHEE - ZERO AEROSOLS FOR TESTING aer_sw%optical_props%tau = 0.0_kind_phys aer_sw%optical_props%g = 0.0_kind_phys - aer_sw%optical_props%ssa = 0.0_kind_phys + aer_sw%optical_props%ssa = 1.0_kind_phys end if if (dolw) then From 4dc0b4cfa3136af462d17e2630f5c26355b06710 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 23 Sep 2025 16:37:32 -0600 Subject: [PATCH 095/140] some dimensions fixes; standrad name updates --- schemes/rrtmgp/rrtmgp_constituents.F90 | 41 +++++++---- schemes/rrtmgp/rrtmgp_constituents.meta | 69 +++++++++++-------- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 2 +- schemes/rrtmgp/rrtmgp_post.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 13 ++-- schemes/rrtmgp/rrtmgp_sw_rte.meta | 6 +- .../rrtmgp/utils/calculate_net_heating.meta | 4 +- 7 files changed, 82 insertions(+), 55 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 619d363f..3203361d 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -2,6 +2,9 @@ module rrtmgp_constituents use cam_logfile, only: iulog public :: rrtmgp_constituents_register + public :: rrtmgp_constituents_init + public :: rrtmgp_constituents_timestep_init + public :: rrtmgp_constituents_run contains @@ -112,23 +115,18 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, end subroutine rrtmgp_constituents_register !> \section arg_table_rrtmgp_constituents_init Argument Table -!! \htmlinclude rrtmgp_constituents_int.html +!! \htmlinclude rrtmgp_constituents_init.html !! - subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, & - rrtmgp_phys_blksz_lw, rrtmgp_phys_blksz_sw, tlev, fluxlwup_Jac, rad_heat, fsnt, fsns, is_first_restart_step, & + subroutine rrtmgp_constituents_init(ndiag, unset_real, active_call_array, & + tlev, fluxlwup_Jac, rad_heat, is_first_restart_step, & use_tlev, is_mpas, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag - integer, intent(in) :: ncol real(kind_phys), intent(in) :: unset_real logical, intent(out) :: active_call_array(:) - integer, intent(out) :: rrtmgp_phys_blksz_lw - integer, intent(out) :: rrtmgp_phys_blksz_sw real(kind_phys), intent(out) :: tlev(:,:) real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) real(kind_phys), intent(out) :: rad_heat(:,:) - real(kind_phys), intent(out) :: fsnt(:) - real(kind_phys), intent(out) :: fsns(:) logical, intent(out) :: is_first_restart_step logical, intent(out) :: use_tlev logical, intent(out) :: is_mpas @@ -143,19 +141,34 @@ subroutine rrtmgp_constituents_init(ndiag, ncol, unset_real, active_call_array, is_first_restart_step = .false. is_mpas = .false. - rrtmgp_phys_blksz_lw = ncol - rrtmgp_phys_blksz_sw = ncol ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA use_tlev = .false. tlev = unset_real fluxlwup_Jac = unset_real rad_heat = unset_real - ! PEVERWHEE - remove when shortwave is done - fsnt = 0.0_kind_phys - fsns = 0.0_kind_phys - end subroutine rrtmgp_constituents_init + +!> \section arg_table_rrtmgp_constituents_timestep_init Argument Table +!! \htmlinclude rrtmgp_constituents_timestep_init.html +!! + subroutine rrtmgp_constituents_timestep_init(ncol, nday, rrtmgp_phys_blksz_lw, & + rrtmgp_phys_blksz_sw, errmsg, errflg) + integer, intent(in) :: nday + integer, intent(in) :: ncol + integer, intent(out) :: rrtmgp_phys_blksz_lw + integer, intent(out) :: rrtmgp_phys_blksz_sw + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errflg = 0 + errmsg = '' + + rrtmgp_phys_blksz_lw = ncol + rrtmgp_phys_blksz_sw = nday + + end subroutine rrtmgp_constituents_timestep_init + !> \section arg_table_rrtmgp_constituents_run Argument Table !! \htmlinclude rrtmgp_constituents_run.html !! diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index c1ed9ba5..241c4506 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -45,12 +45,6 @@ type = integer dimensions = () intent = in -[ ncol ] - standard_name = horizontal_dimension - units = count - type = integer - dimensions = () - intent = in [ unset_real ] standard_name = definition_of_unset_for_real_variables units = 1 @@ -63,18 +57,6 @@ type = logical dimensions = (number_of_diagnostic_subcycles) intent = out -[ rrtmgp_phys_blksz_lw ] - standard_name = number_of_columns_per_longwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = out -[ rrtmgp_phys_blksz_sw ] - standard_name = number_of_columns_per_shortwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = out [ tlev ] standard_name = air_temperature_at_interface_for_RRTMGP units = K @@ -93,18 +75,6 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension,vertical_layer_dimension) intent = out -[ fsnt ] - standard_name = shortwave_net_column_absorbed_solar_flux_at_model_top - units = W m-2 - type = real | kind = kind_phys - dimensions = (horizontal_dimension) - intent = out -[ fsns ] - standard_name = shortwave_net_absorbed_solar_flux_at_surface - units = W m-2 - type = real | kind = kind_phys - dimensions = (horizontal_dimension) - intent = out [ is_first_restart_step ] standard_name = is_first_restart_timestep units = flag @@ -135,6 +105,45 @@ type = integer dimensions = () intent = out +[ccpp-arg-table] + name = rrtmgp_constituents_timestep_init + type = scheme +[ ncol ] + standard_name = horizontal_dimension + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz_lw ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ rrtmgp_phys_blksz_sw ] + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out [ccpp-arg-table] name = rrtmgp_constituents_run type = scheme diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index e4d1a23e..162f26cd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_gas_optics type = scheme - dependencies = ext/rte-frontend/mo_rte_kind.F90 + dependencies = ext/rte-kernels/mo_rte_kind.F90 dependencies = objects/ccpp_gas_concentrations.F90 [ccpp-arg-table] diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 9e7d458e..24003894 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -30,7 +30,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ fsns ] - standard_name = shortwave_net_absorbed_solar_flux_at_surface + standard_name = shortwave_net_upward_flux_at_surface units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index a3e85a80..e6cc0599 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -3,6 +3,7 @@ !> This module contains the call to the RRTMGP-sw radiation routine module rrtmgp_sw_rte + use cam_logfile, only: iulog implicit none private @@ -13,7 +14,7 @@ module rrtmgp_sw_rte !! \htmlinclude rrtmgp_sw_rte_run.html !! subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & - sw_optical_props_clouds, aersw, coszen, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & + sw_optical_props_clouds, aersw, coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & flux_clrsky, flux_allsky, errmsg, errflg) use machine, only: kind_phys use mo_rte_sw, only: rte_sw @@ -34,7 +35,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw !< Top-of-atmosphere flux on g-points [W m-2] real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir !< Albedo direct at surface [fraction] real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif !< Albedo diffuse at surface [fraction] - real(kind_phys), dimension(:), intent(in) :: coszen !< Cosine of solar zenith angle for daytime points + real(kind_phys), dimension(:), intent(in) :: coszen_day !< Cosine of solar zenith angle for daytime points ! Outputs class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] @@ -52,6 +53,10 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + write(iulog,*) 'peverwhee - rte-sw' + write(iulog,*) coszen_day + + ! ################################################################################### if (.not. doswrad) return @@ -75,7 +80,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr if (doswclrsky) then errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties - coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle + coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) @@ -105,7 +110,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Compute fluxes errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties - coszen(iCol:iCol2), & ! IN - Cosine of solar zenith angle + coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle toa_src_sw, & ! IN - incident solar flux at TOA sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta index 669c7da2..966b685c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -70,11 +70,11 @@ type = ty_optical_props_2str_ccpp dimensions = () intent = inout -[ coszen ] - standard_name = cosine_of_solar_zenith_angle_for_radiation +[ coszen_day ] + standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep units = rad type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) + dimensions = (daytime_points_dimension) intent = in [ toa_src_sw ] standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta index ab607d95..a5494962 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.meta +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -36,13 +36,13 @@ dimensions = () intent = in [ fsns ] - standard_name = shortwave_net_absorbed_solar_flux_at_surface + standard_name = shortwave_net_upward_flux_at_surface units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in [ fsnt ] - standard_name = shortwave_net_column_absorbed_solar_flux_at_model_top + standard_name = shortwave_net_outgoing_flux_at_model_top units = W m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) From f85612de78bd147ce6191d37514d80446c2a7b50 Mon Sep 17 00:00:00 2001 From: cacraigucar Date: Fri, 4 Apr 2025 12:46:50 -0600 Subject: [PATCH 096/140] Create tag for dme_adjust (#227) Tag name (The PR title should also include the tag name): Originator(s): List all `development` PR numbers included in this PR and the title of each: - update instantaneous history flag to be 'inst' instead of 'lst' (#218) - CCPPize dme_adjust (#211) - Fix broken github action tests (#228) List all automated tests that failed, as well as an explanation for why they weren't fixed: none --------- Co-authored-by: Courtney Peverley --- suites/suite_cam4.xml | 4 +--- suites/suite_cam7.xml | 4 +--- suites/suite_kessler.xml | 1 - suites/suite_tj2016.xml | 2 -- test/test_suites/suite_dme_adjust.xml | 1 - 5 files changed, 2 insertions(+), 10 deletions(-) diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml index a92bf774..4da8ffc3 100644 --- a/suites/suite_cam4.xml +++ b/suites/suite_cam4.xml @@ -322,9 +322,7 @@ check_energy_save_teout - - - + dme_adjust - - - + dme_adjust - - thermo_water_update - - dme_adjust + + + - dme_adjust + + + + + thermo_water_update + @@ -26,6 +24,8 @@ rrtmgp_sw_diagnostics rrtmgp_subcycle + rrtmgp_lw_cloud_optics + rrtmgp_lw_mcica_subcol_gen rrtmgp_constituents From b20fc8fe9850e257648a907b5f8db419f099bc7a Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sat, 11 Oct 2025 00:53:33 -0600 Subject: [PATCH 100/140] mods to get answers to match --- .../radiation_utils/solar_irradiance_data.F90 | 1 - schemes/rrtmgp/rrtmgp_constituents.F90 | 5 +-- schemes/rrtmgp/rrtmgp_constituents.meta | 6 --- schemes/rrtmgp/rrtmgp_inputs.F90 | 13 ++----- schemes/rrtmgp/rrtmgp_inputs.meta | 4 +- schemes/rrtmgp/rrtmgp_lw_aerosols.F90 | 37 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_aerosols.meta | 31 +++++++++++++++ schemes/rrtmgp/rrtmgp_pre_namelist.xml | 14 +++++++ schemes/rrtmgp/rrtmgp_sw_aerosols.F90 | 39 +++++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_aerosols.meta | 31 +++++++++++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 1 - schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 3 +- schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 | 1 - schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta | 1 + test/test_suites/suite_rrtmgp.xml | 6 +-- 15 files changed, 163 insertions(+), 30 deletions(-) create mode 100644 schemes/rrtmgp/rrtmgp_lw_aerosols.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_aerosols.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_aerosols.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_aerosols.meta diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index d8e11c71..edb10163 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -8,7 +8,6 @@ module solar_irradiance_data use cam_time_coord, only: time_coordinate use ccpp_kinds, only: kind_phys - use cam_logfile, only: iulog implicit none save diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 3203361d..e8d29b27 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -1,5 +1,4 @@ module rrtmgp_constituents - use cam_logfile, only: iulog public :: rrtmgp_constituents_register public :: rrtmgp_constituents_init @@ -119,7 +118,7 @@ end subroutine rrtmgp_constituents_register !! subroutine rrtmgp_constituents_init(ndiag, unset_real, active_call_array, & tlev, fluxlwup_Jac, rad_heat, is_first_restart_step, & - use_tlev, is_mpas, errmsg, errflg) + use_tlev, errmsg, errflg) use ccpp_kinds, only: kind_phys integer, intent(in) :: ndiag real(kind_phys), intent(in) :: unset_real @@ -129,7 +128,6 @@ subroutine rrtmgp_constituents_init(ndiag, unset_real, active_call_array, & real(kind_phys), intent(out) :: rad_heat(:,:) logical, intent(out) :: is_first_restart_step logical, intent(out) :: use_tlev - logical, intent(out) :: is_mpas character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -139,7 +137,6 @@ subroutine rrtmgp_constituents_init(ndiag, unset_real, active_call_array, & active_call_array = .true. is_first_restart_step = .false. - is_mpas = .false. ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA use_tlev = .false. diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 241c4506..d632daa9 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -87,12 +87,6 @@ type = logical dimensions = () intent = out -[ is_mpas ] - standard_name = is_mpas_dynamical_core - units = flag - type = logical - dimensions = () - intent = out [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index c999d6b4..0fc14599 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -1,5 +1,4 @@ module rrtmgp_inputs - implicit none private @@ -11,7 +10,7 @@ module rrtmgp_inputs !! \htmlinclude rrtmgp_inputs_run.html !! subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & - is_mpas, pmid, pint, t, nday, idxday, & + trick_rrtmgp, pmid, pint, t, nday, idxday, & cldfprime, coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, & pmid_rad, pint_rad, t_day, pmid_day, pint_day, coszrs_day, & alb_dir, alb_dif, lwup, stebol, ncol, ktopcam, ktoprad, & @@ -43,7 +42,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & logical, intent(in) :: dolw ! Flag for performing the longwave calculation logical, intent(in) :: snow_associated ! Flag for whether the cloud snow fraction argument should be used logical, intent(in) :: graupel_associated ! Flag for whether the cloud graupel fraction argument should be used - logical, intent(in) :: is_mpas + logical, intent(in) :: trick_rrtmgp ! Flag for whether to trick RRTMGP levels integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns real(kind_phys), dimension(:,:), intent(in) :: pmid ! Air pressure at midpoint (Pa) real(kind_phys), dimension(:,:), intent(in) :: pint ! Air pressure at interface (Pa) @@ -113,7 +112,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & ! ! These conditions are generally only satisfied in a non-MPAS MT configuration !------------------------------------------------------------------------------ - if (( .not. is_mpas ) .and. & + if (( trick_rrtmgp ) .and. & (nlay==pverp) .and. & (minval(pint(:,1)) < 1._kind_phys) .and. & (minval(pint(:,2)) > 1._kind_phys) ) then @@ -298,10 +297,6 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & errflg = 1 return end if - ! PEVERWHEE - ZERO AEROSOLS FOR TESTING - aer_sw%optical_props%tau = 0.0_kind_phys - aer_sw%optical_props%g = 0.0_kind_phys - aer_sw%optical_props%ssa = 1.0_kind_phys end if if (dolw) then @@ -325,8 +320,6 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & errflg = 1 return end if - ! PEVERWHEE - ZERO AEROSOLS FOR TESTING! - aer_lw%optical_props%tau = 0.0_kind_phys ! Initialize object for Planck sources. errmsg = sources_lw%sources%alloc(ncol, nlay, kdist_lw%gas_props) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 2811e602..5b6334ca 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -29,8 +29,8 @@ type = logical dimensions = () intent = in -[ is_mpas ] - standard_name = is_mpas_dynamical_core +[ trick_rrtmgp ] + standard_name = do_trick_rrtmgp units = flag type = logical dimensions = () diff --git a/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 new file mode 100644 index 00000000..e224fcce --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 @@ -0,0 +1,37 @@ +!> \file rrtmgp_lw_aerosols.F90 +!! + +!> This module contains the call to the RRTMGP-lw radiation routine +module rrtmgp_lw_aerosols + implicit none + private + + public rrtmgp_lw_aerosols_run +contains + +!> \section arg_table_rrtmgp_lw_aerosols_run Argument Table +!! \htmlinclude rrtmgp_lw_aerosols_run.html +!! + subroutine rrtmgp_lw_aerosols_run(dolwrad, aer_lw, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_kinds, only: kind_phys + + ! Inputs + logical, intent(in) :: dolwrad !< Flag to perform longwave calculation + + ! Outputs + class(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw !< Aerosol optical properties object + + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. dolwrad) return + + aer_lw%optical_props%tau = 0.0_kind_phys + + end subroutine rrtmgp_lw_aerosols_run +end module rrtmgp_lw_aerosols diff --git a/schemes/rrtmgp/rrtmgp_lw_aerosols.meta b/schemes/rrtmgp/rrtmgp_lw_aerosols.meta new file mode 100644 index 00000000..f5598619 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_aerosols.meta @@ -0,0 +1,31 @@ +[ccpp-table-properties] + name = rrtmgp_lw_aerosols + type = scheme + +[ccpp-arg-table] + name = rrtmgp_lw_aerosols_run + type = scheme +[ dolwrad ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ aer_lw ] + standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 84ee1501..94fce7f4 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -299,4 +299,18 @@ 2.0D0 + + logical + rrtmgp + rrtmgp + do_trick_rrtmgp + flag + + Flag to do RRTMGP level trickery + + + .true. + .false. + + diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 new file mode 100644 index 00000000..bdc6a246 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 @@ -0,0 +1,39 @@ +!> \file rrtmgp_sw_aerosols.F90 +!! + +!> This module contains the call to the RRTMGP-sw radiation routine +module rrtmgp_sw_aerosols + implicit none + private + + public rrtmgp_sw_aerosols_run +contains + +!> \section arg_table_rrtmgp_sw_aerosols_run Argument Table +!! \htmlinclude rrtmgp_sw_aerosols_run.html +!! + subroutine rrtmgp_sw_aerosols_run(doswrad, aer_sw, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use ccpp_kinds, only: kind_phys + + ! Inputs + logical, intent(in) :: doswrad !< Flag to perform shortwave calculation + + ! Outputs + class(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw !< Aerosol optical properties object + + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doswrad) return + + aer_sw%optical_props%tau = 0.0_kind_phys + aer_sw%optical_props%g = 0.0_kind_phys + aer_sw%optical_props%ssa = 1.0_kind_phys + + end subroutine rrtmgp_sw_aerosols_run +end module rrtmgp_sw_aerosols diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.meta b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta new file mode 100644 index 00000000..d6d74b73 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta @@ -0,0 +1,31 @@ +[ccpp-table-properties] + name = rrtmgp_sw_aerosols + type = scheme + +[ccpp-arg-table] + name = rrtmgp_sw_aerosols_run + type = scheme +[ doswrad ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ aer_sw ] + standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 98056fa3..7c9bd86c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -4,7 +4,6 @@ !> This module contains an init routine to initialize the shortwave gas optics object !> with data read in from file on the host side module rrtmgp_sw_gas_optics - use cam_logfile, only: iulog implicit none private diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index e248c993..3be3e7e6 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -5,7 +5,6 @@ ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- module rrtmgp_sw_solar_var - use ccpp_kinds, only : kind_phys implicit none @@ -49,7 +48,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw ! Initialize error variables errflg = 0 errmsg = '' - + if (do_spectral_scaling) then ! Determine target irradiance for each band diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 index 3925d092..96eab49d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 @@ -4,7 +4,6 @@ ! to approximate the spectral distribution of irradiance ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- -! peverwhee - dependencies = radiation_utils, mo_util module rrtmgp_sw_solar_var_setup use ccpp_kinds, only : kind_phys diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta index c54c605b..95ac33a5 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_solar_var_setup type = scheme + dependencies = utils/radiation_utils.F90 [ccpp-arg-table] name = rrtmgp_sw_solar_var_setup_init diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index afaa62cb..e469301a 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -1,7 +1,7 @@ - + initialize_constituents rrtmgp_pre rrtmgp_cloud_optics_setup @@ -17,7 +17,7 @@ rrtmgp_sw_gas_optics solar_irradiance_data rrtmgp_sw_solar_var - + rrtmgp_sw_aerosols rrtmgp_sw_rte rrtmgp_sw_calculate_fluxes rrtmgp_sw_calculate_heating_rate @@ -31,7 +31,7 @@ rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics - + rrtmgp_lw_aerosols rrtmgp_lw_rte rrtmgp_lw_calculate_fluxes rrtmgp_lw_calculate_heating_rate From b773615b693e5f77369280f2202995a5002414b4 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sun, 12 Oct 2025 14:55:06 -0600 Subject: [PATCH 101/140] fix diagnostic issues --- schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index 0d5eefdb..53588e01 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -125,10 +125,10 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs real(kind_phys) :: fsntoac(ncol) real(kind_phys) :: fsutoa(ncol) real(kind_phys) :: fsdsc(ncol) - real(kind_phys) :: flux_sw_up(ncol,pver) - real(kind_phys) :: flux_sw_dn(ncol,pver) - real(kind_phys) :: flux_sw_clr_up(ncol,pver) - real(kind_phys) :: flux_sw_clr_dn(ncol,pver) + real(kind_phys) :: flux_sw_up(ncol,pverp) + real(kind_phys) :: flux_sw_dn(ncol,pverp) + real(kind_phys) :: flux_sw_clr_up(ncol,pverp) + real(kind_phys) :: flux_sw_clr_dn(ncol,pverp) real(kind_phys) :: fsntc(ncol) real(kind_phys) :: fsnsc(ncol) real(kind_phys) :: fsn200(ncol) @@ -152,6 +152,7 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs fsntoac = 0.0_kind_phys fsutoa = 0.0_kind_phys fsdsc = 0.0_kind_phys + fsds = 0.0_kind_phys flux_sw_up = 0.0_kind_phys flux_sw_dn = 0.0_kind_phys flux_sw_clr_up = 0.0_kind_phys @@ -171,7 +172,7 @@ subroutine rrtmgp_sw_diagnostics_run(num_diag_subcycles, icall, active_calls, fs flux_sw_clr_dn(idxday(idx),ktopcam:) = fswc%fluxes%flux_dn(idx,ktoprad:) end do - fsntc(:) = fcns(:, pverp) ! net sw clearsky flux at top + fsntc(:) = fcns(:, ktopcam) ! net sw clearsky flux at top fsnsc(:) = fcns(:, pverp) ! net sw clearsky flux at surface ! History out field calls From 16c146fe5167f1224a8cd88eb3b77ec9f8033291 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Sun, 12 Oct 2025 16:19:10 -0600 Subject: [PATCH 102/140] add cloud diagnostics --- schemes/rrtmgp/rrtmgp_variables.F90 | 10 +- schemes/rrtmgp/rrtmgp_variables.meta | 10 +- .../rrtmgp_cloud_diagnostics.F90 | 98 +++++++++++++++ .../rrtmgp_cloud_diagnostics.meta | 113 ++++++++++++++++++ test/test_suites/suite_rrtmgp.xml | 1 + 5 files changed, 222 insertions(+), 10 deletions(-) create mode 100644 schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 7f4c8e9d..1f2c25c3 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -3,14 +3,14 @@ module rrtmgp_variables implicit none private - public :: rrtmgp_variables_run + public :: rrtmgp_variables_init CONTAINS -!> \section arg_table_rrtmgp_variables_run Argument Table -!! \htmlinclude rrtmgp_variables_run.html +!> \section arg_table_rrtmgp_variables_init Argument Table +!! \htmlinclude rrtmgp_variables_init.html !! - subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & + subroutine rrtmgp_variables_init(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & do_grau, grau_associated, tiny_rad, errmsg, errflg) use ccpp_kinds, only: kind_phys ! Inputs @@ -57,5 +57,5 @@ subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real end if - end subroutine rrtmgp_variables_run + end subroutine rrtmgp_variables_init end module rrtmgp_variables diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index 6008aec2..a49001df 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -3,31 +3,31 @@ type = scheme [ccpp-arg-table] - name = rrtmgp_variables_run + name = rrtmgp_variables_init type = scheme [ cldfsnow ] standard_name = liquid_plus_snow_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_dimension,vertical_layer_dimension) intent = in [ cldfgrau ] standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_dimension,vertical_layer_dimension) intent = in [ degrau ] standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation units = m type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_dimension,vertical_layer_dimension) intent = in [ icgrauwp ] standard_name = stratiform_in_cloud_graupel_water_path units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_dimension,vertical_layer_dimension) intent = in [ unset_real ] standard_name = definition_of_unset_for_real_variables diff --git a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 new file mode 100644 index 00000000..9428b1a1 --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 @@ -0,0 +1,98 @@ +module rrtmgp_cloud_diagnostics + implicit none + private + save + + public :: rrtmgp_cloud_diagnostics_init ! init routine + public :: rrtmgp_cloud_diagnostics_run ! main routine + +CONTAINS + + !> \section arg_table_rrtmgp_cloud_diagnostics_init Argument Table + !! \htmlinclude rrtmgp_cloud_diagnostics_init.html + subroutine rrtmgp_cloud_diagnostics_init(has_snow, has_graupel, graupel_in_rad, errmsg, errflg) + use cam_history, only: history_add_field + + logical, intent(in) :: has_snow + logical, intent(in) :: has_graupel + logical, intent(in) :: graupel_in_rad + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + integer :: icall + + errmsg = '' + errflg = 0 + + ! Add diagnostic fields + call history_add_field('TOT_CLD_VISTAU', 'Total gbx cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + call history_add_field('TOT_ICLD_VISTAU', 'Total in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + call history_add_field('LIQ_ICLD_VISTAU', 'Liquid in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + call history_add_field('ICE_ICLD_VISTAU', 'Ice in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + + if (has_snow) then + call history_add_field('SNOW_ICLD_VISTAU', 'Snow in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + end if + if (has_graupel .and. graupel_in_rad) then + call history_add_field('GRAU_ICLD_VISTAU', 'Graupel in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + flag_xyfill=.true.) + end if + + end subroutine rrtmgp_cloud_diagnostics_init + + !> \section arg_table_rrtmgp_cloud_diagnostics_run Argument Table + !! \htmlinclude rrtmgp_cloud_diagnostics_run.html + subroutine rrtmgp_cloud_diagnostics_run(write_output, has_snow, has_graupel, graupel_in_rad, tot_cld_vistau, tot_icld_vistau, & + liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) + use cam_history, only: history_out_field + use ccpp_kinds, only: kind_phys + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + logical, intent(in) :: write_output + logical, intent(in) :: has_snow + logical, intent(in) :: has_graupel + logical, intent(in) :: graupel_in_rad + real(kind_phys), intent(in) :: tot_cld_vistau(:,:) + real(kind_phys), intent(in) :: tot_icld_vistau(:,:) + real(kind_phys), intent(in) :: liq_icld_vistau(:,:) + real(kind_phys), intent(in) :: ice_icld_vistau(:,:) + real(kind_phys), intent(in) :: snow_icld_vistau(:,:) + real(kind_phys), intent(in) :: grau_icld_vistau(:,:) + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + errmsg = '' + errflg = 0 + + if (.not. write_output) then + return + end if + + if (has_snow) then + call history_out_field('SNOW_ICLD_VISTAU', snow_icld_vistau) + end if + if (has_graupel .and. graupel_in_rad) then + call history_out_field('GRAU_ICLD_VISTAU', grau_icld_vistau) + end if + + call history_out_field('TOT_CLD_VISTAU', tot_cld_vistau) + call history_out_field('TOT_ICLD_VISTAU', tot_icld_vistau) + call history_out_field('LIQ_ICLD_VISTAU', liq_icld_vistau) + call history_out_field('ICE_ICLD_VISTAU', ice_icld_vistau) + call history_out_field('SNOW_ICLD_VISTAU', snow_icld_vistau) + call history_out_field('GRAU_ICLD_VISTAU', grau_icld_vistau) + + end subroutine rrtmgp_cloud_diagnostics_run + +end module rrtmgp_cloud_diagnostics diff --git a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta new file mode 100644 index 00000000..63f0e792 --- /dev/null +++ b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta @@ -0,0 +1,113 @@ +[ccpp-table-properties] + name = rrtmgp_cloud_diagnostics + type = scheme + +[ccpp-arg-table] + name = rrtmgp_cloud_diagnostics_init + type = scheme +[ has_snow ] + standard_name = include_snow_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ has_graupel ] + standard_name = include_graupel_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ graupel_in_rad ] + standard_name = do_calculate_radiative_effect_of_graupel + units = flag + type = logical + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_cloud_diagnostics_run + type = scheme +[ write_output ] + standard_name = write_RRTMGP_diagnostics + units = flag + type = logical + dimensions = () + intent = in +[ has_snow ] + standard_name = include_snow_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ has_graupel ] + standard_name = include_graupel_in_radiation_calculation + units = flag + type = logical + dimensions = () + intent = in +[ graupel_in_rad ] + standard_name = do_calculate_radiative_effect_of_graupel + units = flag + type = logical + dimensions = () + intent = in +[ tot_cld_vistau ] + standard_name = total_cloud_optical_depth_for_visible_band_times_cloud_fraction + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tot_icld_vistau ] + standard_name = total_cloud_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ liq_icld_vistau ] + standard_name = cloud_liquid_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ ice_icld_vistau ] + standard_name = cloud_ice_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ snow_icld_vistau ] + standard_name = snow_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ grau_icld_vistau ] + standard_name = graupel_optical_depth_for_visible_band + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index e469301a..c327dcd5 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,6 +10,7 @@ rrtmgp_inputs rrtmgp_sw_cloud_optics rrtmgp_sw_mcica_subcol_gen + rrtmgp_cloud_diagnostics rrtmgp_constituents From e154fb9192b706e8c420cb68f8d7fe5c8fea30f5 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 13 Oct 2025 01:43:44 -0600 Subject: [PATCH 103/140] add missing dependencies --- schemes/rrtmgp/objects/ccpp_fluxes.meta | 1 + schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta | 2 ++ schemes/rrtmgp/objects/ccpp_optical_props.meta | 3 +++ 3 files changed, 6 insertions(+) diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta index 557fb9a5..7f52198a 100644 --- a/schemes/rrtmgp/objects/ccpp_fluxes.meta +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -2,6 +2,7 @@ name = ty_fluxes_broadband_ccpp type = ddt dependencies = ../ext/rte-frontend/mo_fluxes.F90 + dependencies = ../ext/rte-kernels/mo_fluxes_broadband_kernels.F90 [ccpp-arg-table] name = ty_fluxes_broadband_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta index f14c9463..f7e2ad0c 100644 --- a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -4,6 +4,8 @@ dependencies = ../ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,../ext/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 dependencies = ../ext/gas-optics/mo_gas_optics_constants.F90,../ext/gas-optics/mo_gas_optics_util_string.F90 dependencies = ../ext/gas-optics/mo_gas_optics.F90 + dependencies = ../ext/rte-kernels/mo_rte_kind.F90 + dependencies = ../ext/rte-kernels/mo_rte_util_array.F90 [ccpp-arg-table] name = ty_gas_optics_rrtmgp_ccpp diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta index 0253c486..e1aeadfb 100644 --- a/schemes/rrtmgp/objects/ccpp_optical_props.meta +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -2,6 +2,9 @@ name = ty_optical_props_1scl_ccpp type = ddt dependencies = ../ext/rte-frontend/mo_optical_props.F90 + dependencies = ../ext/rte-frontend/mo_rte_config.F90 + dependencies = ../ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ../ext/rte-kernels/mo_optical_props_kernels.F90 [ccpp-arg-table] name = ty_optical_props_1scl_ccpp From 8c9542641d8141b31fd561481cb01871d90fe93e Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 14 Oct 2025 11:25:54 -0600 Subject: [PATCH 104/140] fix parallel issue --- schemes/rrtmgp/rrtmgp_inputs.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 3 +-- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 8 +++++++- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 12 ++++++++++++ test/test_suites/suite_rrtmgp.xml | 8 ++++---- 7 files changed, 27 insertions(+), 10 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 0fc14599..8273f24f 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -276,7 +276,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & ! If no daylight columns, can't create empty RRTMGP objects if (dosw .and. nday > 0) then ! Initialize object for gas concentrations. - errmsg = gas_concs_sw%gas_concs%init(gaslist_lc) + errmsg = gas_concs_sw%gas_concs%init(gaslist_lc) if (len_trim(errmsg) > 0) then errflg = 1 return diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 7c9bd86c..23afc841 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -361,7 +361,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l errmsg = '' errflg = 0 - if (.not. dosw) then + if (.not. dosw .or. ncol == 0) then return end if diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index 43cb9ca5..a970ef98 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -1,5 +1,4 @@ module rrtmgp_sw_gas_optics_pre - implicit none private @@ -54,7 +53,7 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, errmsg = '' errflg = 0 - if (.not. dosw) then + if (.not. dosw .or. nday == 0) then return end if diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 5faedfb8..fee3bcb2 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -53,7 +53,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr errmsg = '' errflg = 0 - if (.not. doswrad) return + if (.not. doswrad .or. nday == 0) return iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nday) diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 3be3e7e6..81182411 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -21,7 +21,7 @@ module rrtmgp_sw_solar_var !! \htmlinclude rrtmgp_sw_solar_var_run.html !! subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, & - do_spectral_scaling, sfac, eccf, errmsg, errflg) + nday, dosw, do_spectral_scaling, sfac, eccf, errmsg, errflg) use rrtmgp_sw_solar_var_setup, only: irrad, radbinmax, radbinmin ! Arguments @@ -29,11 +29,13 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw real(kind_phys), intent(in) :: sol_tsi ! total solar irradiance real(kind_phys), intent(in) :: sol_irrad(:) ! solar irradiance real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints + integer, intent(in) :: nday ! number of daytime points integer, intent(in) :: nbins ! number of bins integer, intent(in) :: ccpp_constant_two integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling + logical, intent(in) :: dosw real(kind_phys), intent(in) :: eccf ! eccentricity factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg @@ -49,6 +51,10 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw errflg = 0 errmsg = '' + if (.not. dosw .or. nday == 0) then + return + end if + if (do_spectral_scaling) then ! Determine target irradiance for each band diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index 96a8e2e5..16b9fd94 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -54,6 +54,18 @@ type = real | kind = kind_phys dimensions = () intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in [ do_spectral_scaling ] standard_name = do_spectral_scaling_of_solar_irradiance_data units = flag diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index c327dcd5..be4103b0 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -14,10 +14,10 @@ rrtmgp_constituents - rrtmgp_sw_gas_optics_pre - rrtmgp_sw_gas_optics - solar_irradiance_data - rrtmgp_sw_solar_var + rrtmgp_sw_gas_optics_pre + rrtmgp_sw_gas_optics + solar_irradiance_data + rrtmgp_sw_solar_var rrtmgp_sw_aerosols rrtmgp_sw_rte rrtmgp_sw_calculate_fluxes From fac586f77f1e61fd8bceb33bd388edbeb3bdde13 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 15 Oct 2025 16:46:58 -0600 Subject: [PATCH 105/140] fix so do_snow is set properly; cloud diagnostics need a new idea! --- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_variables.F90 | 10 +++++----- schemes/rrtmgp/rrtmgp_variables.meta | 10 +++++----- test/test_suites/suite_rrtmgp.xml | 10 +++++----- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index 729c4502..da5935e7 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -46,8 +46,8 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 1f2c25c3..7f4c8e9d 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -3,14 +3,14 @@ module rrtmgp_variables implicit none private - public :: rrtmgp_variables_init + public :: rrtmgp_variables_run CONTAINS -!> \section arg_table_rrtmgp_variables_init Argument Table -!! \htmlinclude rrtmgp_variables_init.html +!> \section arg_table_rrtmgp_variables_run Argument Table +!! \htmlinclude rrtmgp_variables_run.html !! - subroutine rrtmgp_variables_init(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & + subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & do_grau, grau_associated, tiny_rad, errmsg, errflg) use ccpp_kinds, only: kind_phys ! Inputs @@ -57,5 +57,5 @@ subroutine rrtmgp_variables_init(cldfsnow, cldfgrau, degrau, icgrauwp, unset_rea end if - end subroutine rrtmgp_variables_init + end subroutine rrtmgp_variables_run end module rrtmgp_variables diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index a49001df..6008aec2 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -3,31 +3,31 @@ type = scheme [ccpp-arg-table] - name = rrtmgp_variables_init + name = rrtmgp_variables_run type = scheme [ cldfsnow ] standard_name = liquid_plus_snow_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfgrau ] standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ degrau ] standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation units = m type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ icgrauwp ] standard_name = stratiform_in_cloud_graupel_water_path units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ unset_real ] standard_name = definition_of_unset_for_real_variables diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index be4103b0..3441f8da 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,14 +10,14 @@ rrtmgp_inputs rrtmgp_sw_cloud_optics rrtmgp_sw_mcica_subcol_gen - rrtmgp_cloud_diagnostics + rrtmgp_constituents - rrtmgp_sw_gas_optics_pre - rrtmgp_sw_gas_optics - solar_irradiance_data - rrtmgp_sw_solar_var + rrtmgp_sw_gas_optics_pre + rrtmgp_sw_gas_optics + solar_irradiance_data + rrtmgp_sw_solar_var rrtmgp_sw_aerosols rrtmgp_sw_rte rrtmgp_sw_calculate_fluxes From 107dca4941ce9f43093c0d066dff272b94b74d9f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 17 Oct 2025 22:52:37 -0600 Subject: [PATCH 106/140] add nday check to sw aerosol scheme --- schemes/rrtmgp/rrtmgp_sw_aerosols.F90 | 5 +++-- schemes/rrtmgp/rrtmgp_sw_aerosols.meta | 6 ++++++ schemes/rrtmgp/rrtmgp_sw_rte.F90 | 2 +- test/test_suites/suite_rrtmgp.xml | 2 +- 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 index bdc6a246..70f3566a 100644 --- a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 @@ -12,12 +12,13 @@ module rrtmgp_sw_aerosols !> \section arg_table_rrtmgp_sw_aerosols_run Argument Table !! \htmlinclude rrtmgp_sw_aerosols_run.html !! - subroutine rrtmgp_sw_aerosols_run(doswrad, aer_sw, errmsg, errflg) + subroutine rrtmgp_sw_aerosols_run(doswrad, nday, aer_sw, errmsg, errflg) use ccpp_optical_props, only: ty_optical_props_2str_ccpp use ccpp_kinds, only: kind_phys ! Inputs logical, intent(in) :: doswrad !< Flag to perform shortwave calculation + integer, intent(in) :: nday !< daytime points dimension ! Outputs class(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw !< Aerosol optical properties object @@ -29,7 +30,7 @@ subroutine rrtmgp_sw_aerosols_run(doswrad, aer_sw, errmsg, errflg) errmsg = '' errflg = 0 - if (.not. doswrad) return + if (.not. doswrad .or. nday == 0) return aer_sw%optical_props%tau = 0.0_kind_phys aer_sw%optical_props%g = 0.0_kind_phys diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.meta b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta index d6d74b73..d4246e82 100644 --- a/schemes/rrtmgp/rrtmgp_sw_aerosols.meta +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta @@ -11,6 +11,12 @@ type = logical dimensions = () intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in [ aer_sw ] standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP units = none diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index fee3bcb2..dacd0e85 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -53,7 +53,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr errmsg = '' errflg = 0 - if (.not. doswrad .or. nday == 0) return + if (.not. doswrad .or. rrtmgp_phys_blksz == 0) return iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nday) diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 3441f8da..449340b4 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -1,7 +1,7 @@ - + initialize_constituents rrtmgp_pre rrtmgp_cloud_optics_setup From 12eca68aadd0c3b9dfdea9f0344c9219e8412c4d Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 17 Oct 2025 23:54:23 -0600 Subject: [PATCH 107/140] add loop variable --- test/test_suites/suite_rrtmgp.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 449340b4..9b144c82 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -12,7 +12,7 @@ rrtmgp_sw_mcica_subcol_gen - + rrtmgp_constituents rrtmgp_sw_gas_optics_pre rrtmgp_sw_gas_optics @@ -28,7 +28,7 @@ rrtmgp_lw_cloud_optics rrtmgp_lw_mcica_subcol_gen - + rrtmgp_constituents rrtmgp_lw_gas_optics_pre rrtmgp_lw_gas_optics From b56f64b5ca97964b53b277fc1e43a551972329c0 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 20 Oct 2025 11:04:23 -0600 Subject: [PATCH 108/140] get cloud diagnostics back --- schemes/rrtmgp/rrtmgp_constituents.F90 | 55 ------- schemes/rrtmgp/rrtmgp_constituents.meta | 102 ------------- schemes/rrtmgp/rrtmgp_inputs.F90 | 10 +- schemes/rrtmgp/rrtmgp_inputs.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 2 +- schemes/rrtmgp/rrtmgp_variables.F90 | 95 ++++++++++--- schemes/rrtmgp/rrtmgp_variables.meta | 134 ++++++++++++++---- .../rrtmgp_cloud_diagnostics.meta | 4 +- test/test_suites/suite_rrtmgp.xml | 2 +- 9 files changed, 189 insertions(+), 219 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index e8d29b27..9902bc4f 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -1,8 +1,6 @@ module rrtmgp_constituents public :: rrtmgp_constituents_register - public :: rrtmgp_constituents_init - public :: rrtmgp_constituents_timestep_init public :: rrtmgp_constituents_run contains @@ -113,59 +111,6 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, end subroutine rrtmgp_constituents_register -!> \section arg_table_rrtmgp_constituents_init Argument Table -!! \htmlinclude rrtmgp_constituents_init.html -!! - subroutine rrtmgp_constituents_init(ndiag, unset_real, active_call_array, & - tlev, fluxlwup_Jac, rad_heat, is_first_restart_step, & - use_tlev, errmsg, errflg) - use ccpp_kinds, only: kind_phys - integer, intent(in) :: ndiag - real(kind_phys), intent(in) :: unset_real - logical, intent(out) :: active_call_array(:) - real(kind_phys), intent(out) :: tlev(:,:) - real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) - real(kind_phys), intent(out) :: rad_heat(:,:) - logical, intent(out) :: is_first_restart_step - logical, intent(out) :: use_tlev - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize error variables - errflg = 0 - errmsg = '' - - active_call_array = .true. - is_first_restart_step = .false. - - ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA - use_tlev = .false. - tlev = unset_real - fluxlwup_Jac = unset_real - rad_heat = unset_real - - end subroutine rrtmgp_constituents_init - -!> \section arg_table_rrtmgp_constituents_timestep_init Argument Table -!! \htmlinclude rrtmgp_constituents_timestep_init.html -!! - subroutine rrtmgp_constituents_timestep_init(ncol, nday, rrtmgp_phys_blksz_lw, & - rrtmgp_phys_blksz_sw, errmsg, errflg) - integer, intent(in) :: nday - integer, intent(in) :: ncol - integer, intent(out) :: rrtmgp_phys_blksz_lw - integer, intent(out) :: rrtmgp_phys_blksz_sw - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - - errflg = 0 - errmsg = '' - - rrtmgp_phys_blksz_lw = ncol - rrtmgp_phys_blksz_sw = nday - - end subroutine rrtmgp_constituents_timestep_init - !> \section arg_table_rrtmgp_constituents_run Argument Table !! \htmlinclude rrtmgp_constituents_run.html !! diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index d632daa9..00cf1610 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -36,108 +36,6 @@ type = integer dimensions = () intent = out -[ccpp-arg-table] - name = rrtmgp_constituents_init - type = scheme -[ ndiag ] - standard_name = number_of_diagnostic_subcycles - units = count - type = integer - dimensions = () - intent = in -[ unset_real ] - standard_name = definition_of_unset_for_real_variables - units = 1 - type = real | kind = kind_phys - dimensions = () - intent = in -[ active_call_array ] - standard_name = is_active_diagnostic_call_array - units = flag - type = logical - dimensions = (number_of_diagnostic_subcycles) - intent = out -[ tlev ] - standard_name = air_temperature_at_interface_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_interface_dimension) - intent = out -[ fluxlwup_Jac ] - standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP - units = W m-2 K-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_interface_dimension) - intent = out -[ rad_heat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = J kg-1 s-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) - intent = out -[ is_first_restart_step ] - standard_name = is_first_restart_timestep - units = flag - type = logical - dimensions = () - intent = out -[ use_tlev ] - standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation - units = flag - type = logical - dimensions = () - intent = out -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out -[ccpp-arg-table] - name = rrtmgp_constituents_timestep_init - type = scheme -[ ncol ] - standard_name = horizontal_dimension - units = count - type = integer - dimensions = () - intent = in -[ nday ] - standard_name = daytime_points_dimension - units = count - type = integer - dimensions = () - intent = in -[ rrtmgp_phys_blksz_lw ] - standard_name = number_of_columns_per_longwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = out -[ rrtmgp_phys_blksz_sw ] - standard_name = number_of_columns_per_shortwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = out -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out [ccpp-arg-table] name = rrtmgp_constituents_run type = scheme diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 8273f24f..36a0655f 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -9,7 +9,7 @@ module rrtmgp_inputs !> \section arg_table_rrtmgp_inputs_run Argument Table !! \htmlinclude rrtmgp_inputs_run.html !! - subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & +subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, & trick_rrtmgp, pmid, pint, t, nday, idxday, & cldfprime, coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, & pmid_rad, pint_rad, t_day, pmid_day, pint_day, coszrs_day, & @@ -40,8 +40,8 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & integer, intent(in) :: nday ! Number of daylight columns logical, intent(in) :: dosw ! Flag for performing the shortwave calculation logical, intent(in) :: dolw ! Flag for performing the longwave calculation - logical, intent(in) :: snow_associated ! Flag for whether the cloud snow fraction argument should be used - logical, intent(in) :: graupel_associated ! Flag for whether the cloud graupel fraction argument should be used + logical, intent(in) :: do_snow ! Flag for whether the cloud snow fraction argument should be used + logical, intent(in) :: do_graupel ! Flag for whether the cloud graupel fraction argument should be used logical, intent(in) :: trick_rrtmgp ! Flag for whether to trick RRTMGP levels integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns real(kind_phys), dimension(:,:), intent(in) :: pmid ! Air pressure at midpoint (Pa) @@ -255,7 +255,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & ! 2. modify for snow. use max(cld, cldfsnow) ! 3. modify for graupel if graupel_in_rad is true. ! use max(cldfprime, cldfgrau) - if (snow_associated) then + if (do_snow) then do kdx = 1, pver do idx = 1, ncol cldfprime(idx,kdx) = max(cld(idx,kdx), cldfsnow(idx,kdx)) @@ -265,7 +265,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & cldfprime(:,:) = cld(:,:) end if - if (graupel_associated .and. graupel_in_rad) then + if (do_graupel .and. graupel_in_rad) then do kdx = 1, pver do idx = 1, ncol cldfprime(idx,kdx) = max(cldfprime(idx,kdx), cldfgrau(idx,kdx)) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index 5b6334ca..f63262c1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -17,13 +17,13 @@ type = logical dimensions = () intent = in -[ snow_associated ] +[ do_snow ] standard_name = include_snow_in_radiation_calculation units = flag type = logical dimensions = () intent = in -[ graupel_associated ] +[ do_graupel ] standard_name = include_graupel_in_radiation_calculation units = flag type = logical diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 81182411..85c2ad15 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -36,7 +36,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling logical, intent(in) :: dosw - real(kind_phys), intent(in) :: eccf ! eccentricity factor + real(kind_phys), intent(in) :: eccf ! Earth-Sun distance factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 7f4c8e9d..c5bbe01a 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -3,28 +3,87 @@ module rrtmgp_variables implicit none private + public :: rrtmgp_variables_init + public :: rrtmgp_variables_timestep_init public :: rrtmgp_variables_run CONTAINS +!> \section arg_table_rrtmgp_variables_init Argument Table +!! \htmlinclude rrtmgp_variables_init.html +!! + subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & + fluxlwup_Jac, rad_heat, use_tlev, snow_exists, grau_exists, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + real(kind_phys), intent(in) :: unset_real + logical, intent(out) :: active_call_array(:) + real(kind_phys), intent(out) :: tlev(:,:) + real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) + real(kind_phys), intent(out) :: rad_heat(:,:) + logical, intent(out) :: use_tlev + logical, intent(out) :: snow_exists + logical, intent(out) :: grau_exists + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize error variables + errflg = 0 + errmsg = '' + + ! Initialize the active call array + active_call_array = .true. + + ! Set tlev & fluxlwup_Jac to unset values; not used by default in CAM-SIMA + use_tlev = .false. + tlev = unset_real + fluxlwup_Jac = unset_real + + ! Initialize rad_heat + rad_heat = unset_real + + ! REMOVECAM: The grau_exists and snow_exists flags should be set to .true. by + ! schemes that introduce graupel and/or snow + ! Set the snow and graupel flags to the values needed for the snapshot test + snow_exists = .true. + grau_exists = .false. + + end subroutine rrtmgp_variables_init + +!> \section arg_table_rrtmgp_variables_timestep_init Argument Table +!! \htmlinclude rrtmgp_variables_timestep_init.html +!! + subroutine rrtmgp_variables_timestep_init(ncol, nday, rrtmgp_phys_blksz_lw, & + rrtmgp_phys_blksz_sw, errmsg, errflg) + integer, intent(in) :: nday + integer, intent(in) :: ncol + integer, intent(out) :: rrtmgp_phys_blksz_lw + integer, intent(out) :: rrtmgp_phys_blksz_sw + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errflg = 0 + errmsg = '' + + rrtmgp_phys_blksz_lw = ncol + rrtmgp_phys_blksz_sw = nday + + end subroutine rrtmgp_variables_timestep_init + !> \section arg_table_rrtmgp_variables_run Argument Table !! \htmlinclude rrtmgp_variables_run.html !! - subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real, graupel_in_rad, do_snow, & - do_grau, grau_associated, tiny_rad, errmsg, errflg) + subroutine rrtmgp_variables_run(graupel_in_rad, grau_exists, snow_exists, & + do_grau, do_snow, tiny_rad, errmsg, errflg) use ccpp_kinds, only: kind_phys ! Inputs - real(kind_phys), dimension(:,:), intent(in) :: cldfsnow - real(kind_phys), dimension(:,:), intent(in) :: cldfgrau - real(kind_phys), dimension(:,:), intent(in) :: degrau - real(kind_phys), dimension(:,:), intent(in) :: icgrauwp - real(kind_phys), intent(in) :: unset_real logical, intent(in) :: graupel_in_rad + logical, intent(in) :: grau_exists + logical, intent(in) :: snow_exists ! Outputs - logical, intent(out) :: do_snow logical, intent(out) :: do_grau - logical, intent(out) :: grau_associated + logical, intent(out) :: do_snow real(kind_phys), intent(out) :: tiny_rad character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,26 +95,16 @@ subroutine rrtmgp_variables_run(cldfsnow, cldfgrau, degrau, icgrauwp, unset_real ! Set definition of tiny for radiation tiny_rad = 1.e-80_kind_phys - ! Initialize flags - do_snow = .false. + ! Initialize graupel flag do_grau = .false. - grau_associated = .false. - - ! Determine if the snow cloud fraction variable is set to something - if (cldfsnow(1,1) /= unset_real) then - do_snow = .true. - end if - - ! Determine if the graupel cloud fraction variable is set to something - if (cldfgrau(1,1) /= unset_real) then - grau_associated = .true. - end if ! Determine if we should include graupel in the radiation calculation - if (graupel_in_rad .and. ((cldfgrau(1,1) /= unset_real) .and. (degrau(1,1) /= unset_real) .and. (icgrauwp(1,1) /= unset_real))) then + if (graupel_in_rad .and. grau_exists) then do_grau = .true. end if + ! Snow included if it exists + do_snow = snow_exists end subroutine rrtmgp_variables_run end module rrtmgp_variables diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index 6008aec2..b4dfd3ee 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -3,58 +3,136 @@ type = scheme [ccpp-arg-table] - name = rrtmgp_variables_run + name = rrtmgp_variables_init type = scheme -[ cldfsnow ] - standard_name = liquid_plus_snow_stratiform_cloud_area_fraction - units = fraction +[ unset_real ] + standard_name = definition_of_unset_for_real_variables + units = 1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = () intent = in -[ cldfgrau ] - standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction - units = fraction +[ active_call_array ] + standard_name = is_active_diagnostic_call_array + units = flag + type = logical + dimensions = (number_of_diagnostic_subcycles) + intent = out +[ tlev ] + standard_name = air_temperature_at_interface_for_RRTMGP + units = K type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - intent = in -[ degrau ] - standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation - units = m + dimensions = (horizontal_dimension,vertical_interface_dimension) + intent = out +[ fluxlwup_Jac ] + standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP + units = W m-2 K-1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - intent = in -[ icgrauwp ] - standard_name = stratiform_in_cloud_graupel_water_path - units = kg m-2 + dimensions = (horizontal_dimension,vertical_interface_dimension) + intent = out +[ rad_heat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - intent = in -[ unset_real ] - standard_name = definition_of_unset_for_real_variables + dimensions = (horizontal_dimension,vertical_layer_dimension) + intent = out +[ use_tlev ] + standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation + units = flag + type = logical + dimensions = () + intent = out +[ grau_exists ] + standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction + units = flag + type = logical + dimensions = () + intent = out +[ snow_exists ] + standard_name = include_liquid_plus_snow_stratiform_cloud_area_fraction + units = flag + type = logical + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code units = 1 - type = real | kind = kind_phys + type = integer + dimensions = () + intent = out +[ccpp-arg-table] + name = rrtmgp_variables_timestep_init + type = scheme +[ ncol ] + standard_name = horizontal_dimension + units = count + type = integer + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer dimensions = () intent = in +[ rrtmgp_phys_blksz_lw ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ rrtmgp_phys_blksz_sw ] + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out +[ccpp-arg-table] + name = rrtmgp_variables_run + type = scheme [ graupel_in_rad ] standard_name = do_calculate_radiative_effect_of_graupel units = flag type = logical dimensions = () intent = in -[ do_snow ] - standard_name = include_snow_in_radiation_calculation +[ grau_exists ] + standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction units = flag type = logical dimensions = () - intent = out + intent = in +[ snow_exists ] + standard_name = include_liquid_plus_snow_stratiform_cloud_area_fraction + units = flag + type = logical + dimensions = () + intent = in [ do_grau ] standard_name = include_graupel_in_radiation_calculation units = flag type = logical dimensions = () intent = out -[ grau_associated ] - standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction +[ do_snow ] + standard_name = include_snow_in_radiation_calculation units = flag type = logical dimensions = () diff --git a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta index 63f0e792..8516d2e5 100644 --- a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta @@ -6,13 +6,13 @@ name = rrtmgp_cloud_diagnostics_init type = scheme [ has_snow ] - standard_name = include_snow_in_radiation_calculation + standard_name = include_liquid_plus_snow_stratiform_cloud_area_fraction units = flag type = logical dimensions = () intent = in [ has_graupel ] - standard_name = include_graupel_in_radiation_calculation + standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction units = flag type = logical dimensions = () diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 9b144c82..4d7ff057 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -10,7 +10,7 @@ rrtmgp_inputs rrtmgp_sw_cloud_optics rrtmgp_sw_mcica_subcol_gen - + rrtmgp_cloud_diagnostics rrtmgp_constituents From bff238e34e4084bc3de455df1b062e51a7bba8ed Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 20 Oct 2025 11:56:21 -0600 Subject: [PATCH 109/140] code clean up and adding missing dependencies --- .../radiation_utils/solar_irradiance_data.F90 | 1 - .../solar_irradiance_data.meta | 1 + schemes/rrtmgp/rrtmgp_constituents.F90 | 12 +++---- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 14 ++++---- .../rrtmgp_lw_calculate_heating_rate.F90 | 16 ++++----- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 1 - schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 1 + schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 3 +- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 1 + schemes/rrtmgp/rrtmgp_post.F90 | 2 +- schemes/rrtmgp/rrtmgp_subcycle.F90 | 6 ++-- schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 | 24 ++++++------- .../rrtmgp_sw_calculate_heating_rate.F90 | 16 ++++----- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 1 - schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 1 + schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 6 ++-- .../rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta | 1 + schemes/rrtmgp/rrtmgp_sw_rte.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 4 +-- schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 | 4 +-- schemes/rrtmgp/rrtmgp_variables.F90 | 36 +++++++++---------- 21 files changed, 77 insertions(+), 76 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index edb10163..48cefb71 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -4,7 +4,6 @@ ! to approximate the spectral distribution of irradiance ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- -! peverwhee - dependencies = time_coordinate module solar_irradiance_data use cam_time_coord, only: time_coordinate use ccpp_kinds, only: kind_phys diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta index a541f45f..7f1d44a1 100644 --- a/schemes/radiation_utils/solar_irradiance_data.meta +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = solar_irradiance_data type = scheme + dependencies = ../../../../utils/cam_time_coord.F90 [ccpp-arg-table] name = solar_irradiance_data_register diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 9902bc4f..59a62762 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -11,9 +11,9 @@ module rrtmgp_constituents subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errflg) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys - integer, intent(in) :: nradgas - type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) - character(len=256), intent(in) :: rad_climate(:) + integer, intent(in) :: nradgas ! Number of radiatively active gases + type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) ! Runtime constituent properties + character(len=256), intent(in) :: rad_climate(:) ! (namelist) list of radiatively active gases and sources character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -118,9 +118,9 @@ subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg use ccpp_constituent_prop_mod, only: int_unassigned use ccpp_scheme_utils, only: ccpp_constituent_index use ccpp_kinds, only: kind_phys - character(len=5), intent(in) :: gaslist(:) - real(kind_phys), intent(in) :: const_array(:,:,:) - real(kind_phys), intent(out) :: rad_const_array(:,:,:) + character(len=5), intent(in) :: gaslist(:) ! Radiatively active gas list + real(kind_phys), intent(in) :: const_array(:,:,:) ! Constituents array + real(kind_phys), intent(out) :: rad_const_array(:,:,:) ! Radiatively active constituent mixing ratios integer, intent(out) :: errflg character(len=512), intent(out) :: errmsg diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index 72401375..13990a35 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -23,19 +23,19 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles integer, intent(in) :: icall ! Current diagnostic subcycle integer, intent(in) :: pverp ! Number of vertical layer interfaces - integer, intent(in) :: ncol - integer, intent(in) :: nlay + integer, intent(in) :: ncol ! Number of horizontal grid points + integer, intent(in) :: nlay ! Number of vertical layers in RRTMGP integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object ! Output variables - real(kind_phys), intent(out) :: fnl(:,:) - real(kind_phys), intent(out) :: fcnl(:,:) - real(kind_phys), intent(out) :: flns(:) - real(kind_phys), intent(out) :: flnt(:) - real(kind_phys), intent(out) :: flwds(:) + real(kind_phys), intent(out) :: fnl(:,:) ! Longwave net radiative flux [W m-2] + real(kind_phys), intent(out) :: fcnl(:,:) ! Longwave net radiative clear-sky flux [W m-2] + real(kind_phys), intent(out) :: flns(:) ! Longwave net upward flux at surface [W m-2] + real(kind_phys), intent(out) :: flnt(:) ! Longwave net outgoing flux at model top [W m-2] + real(kind_phys), intent(out) :: flwds(:) ! Longwave downward radiative flux at surface [W m-2] ! CCPP error handling variables diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 index e389f51d..4a109e44 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -7,14 +7,14 @@ module rrtmgp_lw_calculate_heating_rate subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, & flux_net_clrsky, hrate, hrate_clrsky, errmsg, errflg) use ccpp_kinds, only: kind_phys - integer, intent(in) :: ktopcam - integer, intent(in) :: pver - real(kind_phys), intent(in) :: gravit - real(kind_phys), intent(in) :: rpdel(:,:) - real(kind_phys), intent(in) :: flux_net(:,:) - real(kind_phys), intent(in) :: flux_net_clrsky(:,:) - real(kind_phys), intent(out) :: hrate(:,:) - real(kind_phys), intent(out) :: hrate_clrsky(:,:) + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: pver ! Number of vertical levels + real(kind_phys), intent(in) :: gravit ! Standard gravitational acceleration [m s-2] + real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of air pressure thickness [Pa-1] + real(kind_phys), intent(in) :: flux_net(:,:) ! Longwave net radiative flux [W m-2] + real(kind_phys), intent(in) :: flux_net_clrsky(:,:) ! Longwave net radiative clear-sky flux [W m-2] + real(kind_phys), intent(out) :: hrate(:,:) ! Tendency of dry air enthalpy due to LW radiation [J kg-1 s-1] + real(kind_phys), intent(out) :: hrate_clrsky(:,:) ! Tendency of dry air enthalpy due to clear-sky LW radiation [J kg-1 s-1] character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 45a9014c..444cd947 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -1,4 +1,3 @@ -! PEVERWHEE - dependencies = interpolate_data !> \file rrtmgp_lw_cloud_optics.F90 !! diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index c5c7e267..e2f3e533 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -2,6 +2,7 @@ name = rrtmgp_lw_cloud_optics type = scheme dependencies = ext/rte-kernels/mo_optical_props_kernels.F90 + dependencies = ../../../../utils/interpolate_data.F90 [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index c5034465..1d7bb335 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -1,5 +1,4 @@ module rrtmgp_lw_mcica_subcol_gen -! PEVERWHEE - dependencies = shr_RandNum_mod !---------------------------------------------------------------------------------------- ! @@ -62,7 +61,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: ktopcam + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: nbnd ! Number of spectral bands integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) integer, intent(in) :: ncol ! Number of columns diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 47bd4177..678b70d2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_mcica_subcol_gen type = scheme + dependencies = ../../../../../share/RandNum/src/shr_RandNum_mod.F90 [ccpp-arg-table] name = rrtmgp_lw_mcica_subcol_gen_run diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index 17e35a3c..bd448b77 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -37,7 +37,7 @@ subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_opt real(kind_phys), dimension(:,:), intent(out) :: qrs ! Shortwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] - real(kind_phys), dimension(:), intent(inout) :: flwds ! Down longwave flux at surface [W m-2] + real(kind_phys), dimension(:), intent(inout) :: flwds ! Down longwave flux at surface [W m-2] character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_subcycle.F90 b/schemes/rrtmgp/rrtmgp_subcycle.F90 index e785db08..9b91c56d 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.F90 +++ b/schemes/rrtmgp/rrtmgp_subcycle.F90 @@ -12,7 +12,7 @@ module rrtmgp_subcycle !! \htmlinclude rrtmgp_subcycle_init !! subroutine rrtmgp_subcycle_init(diag_cur, errmsg, errflg) - integer, intent(out) :: diag_cur + integer, intent(out) :: diag_cur ! Current diagnostic subcycle character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -25,8 +25,8 @@ end subroutine rrtmgp_subcycle_init !! \htmlinclude rrtmgp_subcycle_run.html !! subroutine rrtmgp_subcycle_run(diag_cur, num_diag_cycles, errmsg, errflg) - integer, intent(in) :: num_diag_cycles - integer, intent(inout) :: diag_cur + integer, intent(in) :: num_diag_cycles ! Number of diagnostic subcycles + integer, intent(inout) :: diag_cur ! Current diagnostic subcycle character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 index 0f71eb8c..8156eead 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 @@ -23,24 +23,24 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp integer, intent(in) :: num_diag_subcycles ! Number of diagnostics subcycles integer, intent(in) :: icall ! Current diagnostic subcycle integer, intent(in) :: pverp ! Number of vertical layer interfaces - integer, intent(in) :: ncol - integer, intent(in) :: nlay - integer, intent(in) :: nday + integer, intent(in) :: ncol ! Number of horizontal grid points + integer, intent(in) :: nlay ! Number of vertical layers in RRTMGP + integer, intent(in) :: nday ! Daytime points dimension integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: idxday(:) + integer, intent(in) :: idxday(:) ! Daytime points indices logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active type(ty_fluxes_byband_ccpp), intent(in) :: fsw ! Shortwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: fswc ! Shortwave clear-sky flux object ! Output variables - real(kind_phys), intent(out) :: fns(:,:) - real(kind_phys), intent(out) :: fcns(:,:) - real(kind_phys), intent(out) :: fsns(:) - real(kind_phys), intent(out) :: fsnt(:) - real(kind_phys), intent(out) :: soll(:) - real(kind_phys), intent(out) :: sols(:) - real(kind_phys), intent(out) :: solld(:) - real(kind_phys), intent(out) :: solsd(:) + real(kind_phys), intent(out) :: fns(:,:) ! Shortwave net radiative flux [W m-2] + real(kind_phys), intent(out) :: fcns(:,:) ! Shortwave net radiative clear-sky flux [W m-2] + real(kind_phys), intent(out) :: fsns(:) ! Shortwave net upward flux at surface [W m-2] + real(kind_phys), intent(out) :: fsnt(:) ! Shortwave net outgoing flux at model top [W m-2] + real(kind_phys), intent(out) :: soll(:) ! Direct solar radiative flux at surface >= 700nm [W m-2] + real(kind_phys), intent(out) :: sols(:) ! Direct solar radiative flux at surface < 700nm [W m-2] + real(kind_phys), intent(out) :: solld(:) ! Diffuse solar radiative flux at surface >= 700nm [W m-2] + real(kind_phys), intent(out) :: solsd(:) ! Diffuse solar radiative flux at surface < 700nm [W m-2] ! CCPP error handling variables diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 index d46d28fb..69f4e229 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 @@ -7,14 +7,14 @@ module rrtmgp_sw_calculate_heating_rate subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, flux_net_clrsky, & hrate, hrate_clrsky, errmsg, errflg) use ccpp_kinds, only: kind_phys - integer, intent(in) :: ktopcam - integer, intent(in) :: pver - real(kind_phys), intent(in) :: gravit - real(kind_phys), intent(in) :: rpdel(:,:) - real(kind_phys), intent(in) :: flux_net(:,:) - real(kind_phys), intent(in) :: flux_net_clrsky(:,:) - real(kind_phys), intent(out) :: hrate(:,:) - real(kind_phys), intent(out) :: hrate_clrsky(:,:) + integer, intent(in) :: ktopcam ! Vertical index at top level where RRTMGP is active + integer, intent(in) :: pver ! Number of vertical layers + real(kind_phys), intent(in) :: gravit ! Standard gravitiational acceleration [m s-2] + real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of air pressure thickness [Pa-1] + real(kind_phys), intent(in) :: flux_net(:,:) ! Shortwave net radiative flux [W m-2] + real(kind_phys), intent(in) :: flux_net_clrsky(:,:) ! Shortwave net radiative clear-sky flux [W m-2] + real(kind_phys), intent(out) :: hrate(:,:) ! Tendency of dry air enthalpy due to SW radiation [J kg-1 s-1] + real(kind_phys), intent(out) :: hrate_clrsky(:,:) ! Tendency of dry air enthalpy due to SW clear-sky radiation [J kg-1 s-1] character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 987d3dc6..93c2ac94 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -1,4 +1,3 @@ -! PEVERWHEE - dependencies = interpolate_data !> \file rrtmgp_sw_cloud_optics.F90 !! module rrtmgp_sw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index 4f905858..9798b68a 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_optics type = scheme + dependencies = ../../../../utils/interpolate_data.F90 [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_run diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 23afc841..787f5c1c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -30,7 +30,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object character(len=512), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errflg ! CCPP error code + integer, intent(out) :: errflg ! CCPP error code ! Local variables class(abstract_netcdf_reader_t), pointer :: file_reader @@ -340,7 +340,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l ! Inputs logical, intent(in) :: dosw !< Flag for whether to perform shortwave calculation integer, intent(in) :: iter_num !< Subcycle iteration number - integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: ncol !< Daytime points dimension integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] @@ -350,7 +350,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l ! Outputs type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object - real(kind_phys), intent(out) :: toa_src_sw(:,:) + real(kind_phys), intent(out) :: toa_src_sw(:,:) !< Top of atmosphere solar radiation flux on g points [W m-2] character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta index 849d45b3..c8a66584 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta @@ -1,6 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_mcica_subcol_gen type = scheme + dependencies = ../../../../../share/RandNum/src/shr_RandNum_mod.F90 [ccpp-arg-table] name = rrtmgp_sw_mcica_subcol_gen_run diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index dacd0e85..479a2b84 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -34,7 +34,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw !< Top-of-atmosphere flux on g-points [W m-2] real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir !< Albedo direct at surface [fraction] real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif !< Albedo diffuse at surface [fraction] - real(kind_phys), dimension(:), intent(in) :: coszen_day !< Cosine of solar zenith angle for daytime points + real(kind_phys), dimension(:), intent(in) :: coszen_day !< Cosine of solar zenith angle for daytime points ! Outputs class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 85c2ad15..3f4e397d 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -31,11 +31,11 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints integer, intent(in) :: nday ! number of daytime points integer, intent(in) :: nbins ! number of bins - integer, intent(in) :: ccpp_constant_two + integer, intent(in) :: ccpp_constant_two ! dimension for band2gpt_sw integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling - logical, intent(in) :: dosw + logical, intent(in) :: dosw ! flag to do shortwave radiation real(kind_phys), intent(in) :: eccf ! Earth-Sun distance factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) character(len=512), intent(out) :: errmsg diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 index 96eab49d..a37f1889 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 @@ -28,9 +28,9 @@ module rrtmgp_sw_solar_var_setup !! subroutine rrtmgp_sw_solar_var_setup_init(nswbands, do_spectral_scaling, has_spectrum, errmsg, errflg) use radiation_utils, only : get_sw_spectral_boundaries_ccpp - integer, intent(in) :: nswbands ! number of shortwave bands + integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling - logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum + logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index c5bbe01a..0ed4faff 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -16,14 +16,14 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & fluxlwup_Jac, rad_heat, use_tlev, snow_exists, grau_exists, & errmsg, errflg) use ccpp_kinds, only: kind_phys - real(kind_phys), intent(in) :: unset_real - logical, intent(out) :: active_call_array(:) - real(kind_phys), intent(out) :: tlev(:,:) - real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) - real(kind_phys), intent(out) :: rad_heat(:,:) - logical, intent(out) :: use_tlev - logical, intent(out) :: snow_exists - logical, intent(out) :: grau_exists + real(kind_phys), intent(in) :: unset_real ! Definition of "unset" + logical, intent(out) :: active_call_array(:) ! Diagnostic subcycles + real(kind_phys), intent(out) :: tlev(:,:) ! Air temperature at interfaces [K] + real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) ! Surface temperature flux Jacobian [W m-2 K-1] + real(kind_phys), intent(out) :: rad_heat(:,:) ! Tendency of dry air enthalpy [J kg-1 s-1] + logical, intent(out) :: use_tlev ! Flag to use temperature at interfaces in radiation calculation + logical, intent(out) :: snow_exists ! Flag to include snow cloud area fraction + logical, intent(out) :: grau_exists ! Flag to include graupel cloud area fraction character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -55,10 +55,10 @@ end subroutine rrtmgp_variables_init !! subroutine rrtmgp_variables_timestep_init(ncol, nday, rrtmgp_phys_blksz_lw, & rrtmgp_phys_blksz_sw, errmsg, errflg) - integer, intent(in) :: nday - integer, intent(in) :: ncol - integer, intent(out) :: rrtmgp_phys_blksz_lw - integer, intent(out) :: rrtmgp_phys_blksz_sw + integer, intent(in) :: nday ! Daytime points dimension + integer, intent(in) :: ncol ! Total horizontal gridpoints + integer, intent(out) :: rrtmgp_phys_blksz_lw ! Number of LW columns to process at once + integer, intent(out) :: rrtmgp_phys_blksz_sw ! Number of SW columns to process at once character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -77,14 +77,14 @@ subroutine rrtmgp_variables_run(graupel_in_rad, grau_exists, snow_exists, & do_grau, do_snow, tiny_rad, errmsg, errflg) use ccpp_kinds, only: kind_phys ! Inputs - logical, intent(in) :: graupel_in_rad - logical, intent(in) :: grau_exists - logical, intent(in) :: snow_exists + logical, intent(in) :: graupel_in_rad ! Namelist control of whether to include graupel in radiation calculation + logical, intent(in) :: grau_exists ! Flag to include graupel cloud area fraction + logical, intent(in) :: snow_exists ! Flag to include snow cloud area fraction ! Outputs - logical, intent(out) :: do_grau - logical, intent(out) :: do_snow - real(kind_phys), intent(out) :: tiny_rad + logical, intent(out) :: do_grau ! Flag to use graupel in radiation calcuation + logical, intent(out) :: do_snow ! Flag to use snow in radiation calculation + real(kind_phys), intent(out) :: tiny_rad ! Definition of tiny for RRTMGP character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg From b0cf14d631c641c69280f7b7ad81f61cc921af50 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 20 Oct 2025 14:35:16 -0600 Subject: [PATCH 110/140] remove unused diagnostics --- schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index 53588e01..f6c6ec78 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -55,10 +55,7 @@ subroutine rrtmgp_sw_diagnostics_init(num_diag_subcycles, active_calls, errmsg, call history_add_field('FSNS'//diag(icall-1), 'Net solar flux at surface', horiz_only, 'avg', 'W m-2') call history_add_field('FSNSC'//diag(icall-1), 'Clearsky net solar flux at surface', horiz_only, 'avg', 'W m-2') call history_add_field('FSDS'//diag(icall-1), 'Downwelling solar flux at surface', horiz_only, 'avg', 'W m-2') - call history_add_field('FSDSC'//diag(icall-1), 'Clearky downwelling solar flux at surface', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNIRTOA'//diag(icall-1),'Net near-infrared flux (Nimbus-7 WFOV at top of atmosphere', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNRTOAC'//diag(icall-1),'Clearsky net near-infrared flux (Nimbus-7 WFOV at top of atmosphere', horiz_only, 'avg', 'W m-2') - call history_add_field('FSNRTOAS'//diag(icall-1),'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', horiz_only, 'avg', 'W m-2') + call history_add_field('FSDSC'//diag(icall-1), 'Clearsky downwelling solar flux at surface', horiz_only, 'avg', 'W m-2') ! Fluxes on CAM grid call history_add_field('FUS'//diag(icall-1), 'Shortwave upward flux', 'ilev', 'inst', 'W m-2') From d76289441a862ba2e3cbcb9ec27c19fbe97277d9 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 21 Oct 2025 10:04:38 -0600 Subject: [PATCH 111/140] clean up white space --- schemes/rrtmgp/rrtmgp_inputs.F90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 36a0655f..da20bc18 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -9,17 +9,15 @@ module rrtmgp_inputs !> \section arg_table_rrtmgp_inputs_run Argument Table !! \htmlinclude rrtmgp_inputs_run.html !! -subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, & - trick_rrtmgp, pmid, pint, t, nday, idxday, & - cldfprime, coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, & - pmid_rad, pint_rad, t_day, pmid_day, pint_day, coszrs_day, & - alb_dir, alb_dif, lwup, stebol, ncol, ktopcam, ktoprad, & - nswbands, asdir, asdif, sw_low_bounds, sw_high_bounds, & - aldir, aldif, nlay, pverp, pver, cld, cldfsnow, & - cldfgrau, graupel_in_rad, gasnamelength, gaslist_lc, & - gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & - sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, & - errmsg, errflg) +subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & + pmid, pint, t, nday, idxday, cldfprime, coszrs, kdist_sw, & + t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, t_day, pmid_day, & + pint_day, coszrs_day, alb_dir, alb_dif, lwup, stebol, ncol, & + ktopcam, ktoprad, nswbands, asdir, asdif, sw_low_bounds, & + sw_high_bounds, aldir, aldif, nlay, pverp, pver, cld, & + cldfsnow, cldfgrau, graupel_in_rad, gasnamelength, & + gaslist_lc, gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & + sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp From 602948472353d82ac54179563124bacd94dab0cf Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 21 Oct 2025 21:28:00 -0600 Subject: [PATCH 112/140] initialize irad value --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index fceaabba..9295db39 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -134,6 +134,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw ! "irad_always" is number of time steps to execute radiation continuously from ! start of initial OR restart run + irad_always_out = irad_always if (irad_always > 0) then irad_always_out = irad_always + nstep end if From 0831605c7fb707c3d9b2975567b4c36d350b61eb Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 22 Oct 2025 10:49:01 -0600 Subject: [PATCH 113/140] add support for gpu-enabled rrtmgp --- schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 | 400 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta | 143 +++++++ .../rrtmgp_lw_gas_optics_gpu_namelist.xml | 91 ++++ schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 | 242 +++++++++++ schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta | 131 ++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 | 389 +++++++++++++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta | 121 ++++++ .../rrtmgp_sw_gas_optics_gpu_namelist.xml | 91 ++++ schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 | 129 ++++++ schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta | 121 ++++++ test/test_suites/suite_rrtmgp_gpu.xml | 53 +++ 11 files changed, 1911 insertions(+) create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml create mode 100644 schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta create mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml create mode 100644 schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 create mode 100644 schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta create mode 100644 test/test_suites/suite_rrtmgp_gpu.xml diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 new file mode 100644 index 00000000..74d7cd87 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 @@ -0,0 +1,400 @@ +!> \file rrtmgp_lw_gas_optics_gpu.F90 +!! + +!> This module contains a run routine to compute gas optics during the radiation subcycle +module rrtmgp_lw_gas_optics_gpu + + implicit none + private + + public :: rrtmgp_lw_gas_optics_gpu_init + public :: rrtmgp_lw_gas_optics_gpu_run + +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_gpu_init Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_gpu_init.html +!! + subroutine rrtmgp_lw_gas_optics_gpu_init(kdist, lw_filename, available_gases, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + use mo_rte_kind, only: wl + + ! Inputs + character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object + character(len=512), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errflg ! CCPP error code + + ! Local variables + class(abstract_netcdf_reader_t), pointer :: file_reader + character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band + integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), allocatable :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), allocatable :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), allocatable :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable + integer, parameter :: missing_variable_error_code = 3 + character(len=256) :: alloc_errmsg + integer :: idx + + ! Initialize error variables + errmsg = '' + errflg = 0 + + file_reader => create_netcdf_reader_t() + + ! Open the longwave coefficients file + call file_reader%open_file(lw_filename, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Read the coefficients from the file + call file_reader%get_var('gas_names', gas_names, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('key_species', key_species, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('press_ref', press_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kmajor', kmajor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('totplnk', totplnk, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('plank_fraction', planck_frac, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) + ! OK if variable is not on file + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + end if + if (errflg /= missing_variable_error_code) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) + ! OK if variable is not on file + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + end if + if (errflg /= missing_variable_error_code) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Close the longwave coefficients file + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then + return + end if + deallocate(file_reader) + nullify(file_reader) + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & + optimal_angle_fit) + + if (len_trim(errmsg) > 0) then + errflg = 1 + end if + call check_error_msg('rrtmgp_lw_gas_optics_gpu_init_load', errmsg) + + end subroutine rrtmgp_lw_gas_optics_gpu_init + +!> \section arg_table_rrtmgp_lw_gas_optics_gpu_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_gpu_run.html +!! + subroutine rrtmgp_lw_gas_optics_gpu_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & + gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + ! Inputs + logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation + logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + real(kind_phys), dimension(:), intent(in) :: tsfg !< Surface skin temperature [K] + real(kind_phys), dimension(:,:), intent(in) :: t_lev !< Air temperature at interfaces [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object + type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + !$acc data copyin(lw_gas_props%gas_props, p_lay, p_lev, t_lay, & + !$acc tsfg, gas_concs%gas_concs) & + !$acc copy(lw_optical_props_clrsky%optical_props, lw_optical_props_clrsky%optical_props%tau, & + !$acc sources%sources, sources%sources%lay_source, & + !$acc sources%sources%sfc_source, & + !$acc sources%sources%lev_source, & + !$acc sources%sources%sfc_source_jac) + + if (include_interface_temp) then + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev(iCol:iCol2,:)) ! IN - Temperature @ layer-interfaces (K) (optional) + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources) ! OUT - RRTMGP DDT: source functions + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + !$acc end data + + end subroutine rrtmgp_lw_gas_optics_gpu_run + +end module rrtmgp_lw_gas_optics_gpu diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta new file mode 100644 index 00000000..e0208f10 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta @@ -0,0 +1,143 @@ +[ccpp-table-properties] + name = rrtmgp_lw_gas_optics_gpu + type = scheme + dependencies = ext/rte-kernels/mo_rte_kind.F90 + dependencies = objects/ccpp_gas_concentrations.F90 + dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 + dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 + +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_gpu_init + type = scheme +[ kdist ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = out +[ lw_filename ] + standard_name = filename_of_rrtmgp_longwave_k_distribution + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_gpu_run + type = scheme +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ p_lay ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) + intent = in +[ p_lev ] + standard_name = air_pressure_at_interface_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_plus_one) + intent = in +[ t_lay ] + standard_name = air_temperature_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) + intent = in +[ tsfg ] + standard_name = ground_temperature_at_surface_for_radiation + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ gas_concs ] + standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ lw_optical_props_clrsky ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ sources ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = inout +[ t_lev ] + standard_name = air_temperature_at_interface_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = in +[ include_interface_temp ] + standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation + units = flag + type = logical + dimensions = () + intent = in +[ lw_gas_props ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml new file mode 100644 index 00000000..4473a504 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml @@ -0,0 +1,91 @@ + + + + + + + + + char*512 + rrtmgp_lw_gas_optics + rrtmgp_lw_gas_optics + filename_of_rrtmgp_longwave_k_distribution + none + + The filename of the longwave coefficients file for RRTMGP + + + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-lw-g128.nc + + + diff --git a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 new file mode 100644 index 00000000..1ced98eb --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 @@ -0,0 +1,242 @@ +!> \file rrtmgp_lw_rte_gpu.F90 +!! + +!> This module contains the call to the RRTMGP-LW radiation routine +module rrtmgp_lw_rte_gpu + implicit none + private + + public rrtmgp_lw_rte_gpu_run +contains + +!> \section arg_table_rrtmgp_lw_rte_gpu_run Argument Table +!! \htmlinclude rrtmgp_lw_rte_gpu_run.html +!! + subroutine rrtmgp_lw_rte_gpu_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & + nGauss_angles, lw_optical_props_clrsky, lw_optical_props_clouds, & + sources, sfc_emiss_byband, lw_gas_props, aerlw, fluxlwUP_jac, lw_Ds, & + flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_lw, only: rte_lw + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + + ! Inputs + logical, intent(in) :: doLWrad !< Flag to perform longwave calculation + logical, intent(in) :: doLWclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doGP_lwscat !< Flag to include scattering in clouds + logical, intent(in) :: use_LW_jacobian !< Flag to compute Jacobian + logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles + + integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used + + real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band + class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object + + ! Outputs + real(kind_phys), dimension(:,:), target, intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clear-sky optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clouds !< Cloud optical properties object + + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object + + real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + character(len=512),intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + !$acc data copyin(lw_optical_props_clrsky%optical_props,lw_optical_props_clrsky%optical_props%tau, & + !$acc aerlw%optical_props,aerlw%optical_props%tau, & + !$acc lw_optical_props_clouds%optical_props, lw_optical_props_clouds%optical_props%tau, & + !$acc sources%sources,sources%sources%lay_source, & + !$acc sources%sources%sfc_source, & + !$acc sources%sources%lev_source, & + !$acc sources%sources%sfc_source_jac, & + !$acc sfc_emiss_byband) & + !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net, flux_clrsky%fluxes%flux_up, & + !$acc flux_clrsky%fluxes%flux_dn, flux_allsky%fluxes, flux_allsky%fluxes%flux_net, & + !$acc flux_allsky%fluxes%flux_up, flux_allsky%fluxes%flux_dn, & + !$acc lw_Ds) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Increment + errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_rte_gpu_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Call RTE solver + if (doLWclrsky) then + if (use_lw_optimal_angles) then + errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) + call check_error_msg('rrtmgp_lw_rte_gpu_opt_angle', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes) ! OUT - Fluxes + end if + end if + call check_error_msg('rrtmgp_lw_rte_gpu_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP + ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the + ! type to determine physics configuration/pathway/etc... + ! + ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. + ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the + ! rte solver (rte_lw). Rte_lw queries the type to determine if scattering is to be + ! included in the calculation. The increment procedures are called so that the correct + ! optical properties are inherited. + ! + ! ################################################################################### + + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Increment + errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) + call check_error_msg('rrtmgp_lw_rte_gpu_increment_clrsky_to_clouds', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + ! No scattering in LW clouds. + else + ! Increment + errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_rte_gpu_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + end if + call check_error_msg('rrtmgp_lw_rte_gpu_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + !$acc end data + + end subroutine rrtmgp_lw_rte_gpu_run +end module rrtmgp_lw_rte_gpu diff --git a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta new file mode 100644 index 00000000..fed84f20 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta @@ -0,0 +1,131 @@ +[ccpp-table-properties] + name = rrtmgp_lw_rte_gpu + type = scheme + dependencies = ext/rte-frontend/mo_rte_lw.F90 + dependencies = ext/rte-frontend/mo_rte_config.F90 + dependencies = ext/rte-kernels/mo_rte_util_array.F90 + dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ../../../../utils/machine.F90 + dependencies = ./utils/radiation_tools.F90 + dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = ./objects/ccpp_optical_props.F90 + dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 + dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 + +[ccpp-arg-table] + name = rrtmgp_lw_rte_gpu_run + type = scheme +[ doLWrad ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ doLWclrsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + units = flag + type = logical + dimensions = () + intent = in +[ doGP_lwscat ] + standard_name = include_longwave_scattering_in_cloud_optics + units = flag + type = logical + dimensions = () + intent = in +[ use_LW_jacobian ] + standard_name = calculate_longwave_jacobian_for_RRTMGP + units = flag + type = logical + dimensions = () + intent = in +[ use_LW_optimal_angles ] + standard_name = compute_optimal_angles_for_use_in_RRTMGP_longwave_calculation + units = flag + type = logical + dimensions = () + intent = in +[ nGauss_angles ] + standard_name = number_of_gaussian_quadrature_angles_for_radiation + units = count + type = integer + dimensions = () + intent = in +[ lw_optical_props_clrsky ] + standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ lw_optical_props_clouds ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ sources ] + standard_name = longwave_planck_sources_object_for_RRTMGP + units = none + type = ty_source_func_lw_ccpp + dimensions = () + intent = in +[ sfc_emiss_byband ] + standard_name = longwave_emissivity_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) + intent = in +[ lw_gas_props ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ aerlw ] + standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = inout +[ fluxlwUP_jac ] + standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP + units = W m-2 K-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = inout +[ lw_Ds ] + standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,number_of_longwave_g_point_intervals) + allocatable = True + intent = out +[ flux_clrsky ] + standard_name = longwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ flux_allsky ] + standard_name = longwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 new file mode 100644 index 00000000..4ddadf5f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 @@ -0,0 +1,389 @@ +!> \file rrtmgp_sw_gas_optics_gpu.F90 +!! + +!> This module contains an init routine to initialize the shortwave gas optics object +!> with data read in from file on the host side +module rrtmgp_sw_gas_optics_gpu + + implicit none + private + public :: rrtmgp_sw_gas_optics_gpu_init + public :: rrtmgp_sw_gas_optics_gpu_run + +contains +!> \section arg_table_rrtmgp_sw_gas_optics_gpu_init Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_gpu_init.html +!! + subroutine rrtmgp_sw_gas_optics_gpu_init(kdist, sw_filename, available_gases, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + use mo_rte_kind, only: wl + + ! Inputs + character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP shortwave coefficients file + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object + character(len=512), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errflg ! CCPP error code + + ! Local variables + class(abstract_netcdf_reader_t), pointer :: file_reader + character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases + character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas + character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas + character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band + integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), dimension(:), allocatable :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), allocatable :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] + real(kind_phys), dimension(:), allocatable :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] + real(kind_phys), allocatable :: mg_default ! Mean value of Mg2 solar activity index [1] + real(kind_phys), allocatable :: sb_default ! Mean value of sunspot index [1] + real(kind_phys), allocatable :: tsi_default ! Default total solar irradiance [W m-2] + real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. + integer, parameter :: missing_variable_error_code = 3 + character(len=256) :: alloc_errmsg + integer :: idx + + ! Initialize error variables + errmsg = '' + errflg = 0 + + file_reader => create_netcdf_reader_t() + + ! Open the shortwave coefficients file + call file_reader%open_file(sw_filename, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Read the coefficients from the file + call file_reader%get_var('gas_names', gas_names, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('key_species', key_species, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('press_ref', press_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kmajor', kmajor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('tsi_default', tsi_default, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('mg_default', mg_default, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('sb_default', sb_default, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) + ! OK if variable is not on file + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + end if + if (errflg /= missing_variable_error_code) then + allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) + rayl_lower_allocatable = rayl_lower + end if + call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) + ! OK if variable is not on file + if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + return + end if + if (errflg /= missing_variable_error_code) then + allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) + rayl_upper_allocatable = rayl_upper + end if + call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + minor_scales_with_density_lower(idx) = .false. + else + minor_scales_with_density_lower(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + scale_by_complement_lower(idx) = .false. + else + scale_by_complement_lower(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + minor_scales_with_density_upper(idx) = .false. + else + minor_scales_with_density_upper(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) + if (errflg /= 0) then + return + end if + allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg + return + end if + do idx = 1, size(int2log) + if (int2log(idx) == 0) then + scale_by_complement_upper(idx) = .false. + else + scale_by_complement_upper(idx) = .true. + end if + end do + deallocate(int2log) + call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) + if (errflg /= 0) then + return + end if + call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Close the shortwave coefficients file + call file_reader%close_file(errmsg, errflg) + if (errflg /= 0) then + return + end if + + deallocate(file_reader) + nullify(file_reader) + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + solar_src_quiet, solar_src_facular, solar_src_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower_allocatable, rayl_upper_allocatable) + + if (len_trim(errmsg) > 0) then + errflg = 1 + end if + call check_error_msg('rrtmgp_sw_gas_optics_gpu_init_load', errmsg) + + end subroutine rrtmgp_sw_gas_optics_gpu_init + +!> \section arg_table_rrtmgp_sw_gas_optics_gpu_run Argument Table +!! \htmlinclude rrtmgp_sw_gas_optics_gpu_run.html +!! + subroutine rrtmgp_sw_gas_optics_gpu_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, & + gas_concs, sw_optical_props, sw_gas_props, toa_src_sw, errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use radiation_tools, only: check_error_msg + ! Inputs + logical, intent(in) :: dosw !< Flag for whether to perform shortwave calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Daytime points dimension + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object + real(kind_phys), intent(out) :: toa_src_sw(:,:) !< Top of atmosphere solar radiation flux on g points [W m-2] + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw .or. ncol == 0) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs,sw_optical_props%optical_props) & + !$acc copyout(toa_src_sw) + errmsg = sw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + sw_optical_props%optical_props, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw) ! OUT - TOA incident shortwave radiation (spectral) + + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + !$acc end data + + end subroutine rrtmgp_sw_gas_optics_gpu_run + +end module rrtmgp_sw_gas_optics_gpu diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta new file mode 100644 index 00000000..0ab39203 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta @@ -0,0 +1,121 @@ +[ccpp-table-properties] + name = rrtmgp_sw_gas_optics_gpu + type = scheme + dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 + dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 + +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_gpu_init + type = scheme +[ kdist ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = out +[ sw_filename ] + standard_name = filename_of_rrtmgp_shortwave_k_distribution + units = none + type = character | kind = len=* + dimensions = () + intent = in +[ available_gases ] + standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_gpu_run + type = scheme +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ ncol ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_longwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ p_lay ] + standard_name = air_pressure_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) + intent = in +[ p_lev ] + standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) + intent = in +[ t_lay ] + standard_name = air_temperature_for_daytime_points_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) + intent = in +[ gas_concs ] + standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP + units = none + type = ty_gas_concs_ccpp + dimensions = () + intent = in +[ sw_optical_props ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ sw_gas_props ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = inout +[ toa_src_sw ] + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 + type = real | kind = kind_phys + dimensions = (daytime_points_dimension, number_of_shortwave_g_point_intervals) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml new file mode 100644 index 00000000..3747fd28 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml @@ -0,0 +1,91 @@ + + + + + + + + + char*512 + rrtmgp_sw_gas_optics + rrtmgp_sw_gas_optics + filename_of_rrtmgp_shortwave_k_distribution + none + + The filename of the shortwave coefficients file for RRTMGP + + + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc + + + diff --git a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 new file mode 100644 index 00000000..c10e4764 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 @@ -0,0 +1,129 @@ +!> \file rrtmgp_sw_rte_gpu.F90 +!! + +!> This module contains the call to the RRTMGP-sw radiation routine +module rrtmgp_sw_rte_gpu + implicit none + private + + public rrtmgp_sw_rte_gpu_run +contains + +!> \section arg_table_rrtmgp_sw_rte_gpu_run Argument Table +!! \htmlinclude rrtmgp_sw_rte_gpu_run.html +!! + subroutine rrtmgp_sw_rte_gpu_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & + sw_optical_props_clouds, aersw, coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & + flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_sw, only: rte_sw + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use radiation_tools, only: check_error_msg + + ! Inputs + logical, intent(in) :: doswrad !< Flag to perform shortwave calculation + logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes + + integer, intent(in) :: nday !< Number of horizontal daylight points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw !< Top-of-atmosphere flux on g-points [W m-2] + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir !< Albedo direct at surface [fraction] + real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif !< Albedo diffuse at surface [fraction] + real(kind_phys), dimension(:), intent(in) :: coszen_day !< Cosine of solar zenith angle for daytime points + + ! Outputs + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_2str_ccpp), intent(inout) :: aersw !< Aerosol optical properties object + class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clear-sky optical properties object + class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props_clouds !< Cloud optical properties object + + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Local variables + integer :: iCol, iCol2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doswrad .or. rrtmgp_phys_blksz == 0) return + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nday) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) + ! + ! ################################################################################### + !$acc data copyin(coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & + !$acc sw_optical_props%optical_props, sw_optical_props%optical_props%tau, sw_optical_props%optical_props%ssa, & + !$acc sw_optical_props%optical_props%g, aersw%optical_props%tau, & + !$acc aersw%optical_props, aersw%optical_props%ssa, aersw%optical_props%g, & + !$acc sw_optical_props_clouds%optical_props, sw_optical_props_clouds%optical_props%tau, sw_optical_props_clouds%optical_props%ssa, & + !$acc sw_optical_props_clouds%optical_props%g) & + !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net,flux_clrsky%fluxes%flux_up,flux_clrsky%fluxes%flux_dn, & + !$acc flux_allsky%fluxes, flux_allsky%fluxes%flux_net,flux_allsky%fluxes%flux_up,flux_allsky%fluxes%flux_dn) + ! Increment optics (always) + errmsg = aersw%optical_props%increment(sw_optical_props%optical_props) + call check_error_msg('rrtmgp_sw_rte_gpu_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Optionally compute clear-sky fluxes + if (doswclrsky) then + errmsg = rte_sw( & + sw_optical_props%optical_props, & ! IN - optical-properties + coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + call check_error_msg('rrtmgp_sw_rte_gpu_rte_sw_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! + ! ################################################################################### + + if (doswallsky) then + ! Increment + errmsg = sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props) + call check_error_msg('rrtmgp_sw_rte_gpu_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Compute fluxes + errmsg = rte_sw( & + sw_optical_props%optical_props, & ! IN - optical-properties + coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky%fluxes) ! OUT - Fluxes, all-sky, 3D (1,nLay,nBand) + call check_error_msg('rrtmgp_sw_rte_gpu_rte_sw_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + !$acc end data + + end subroutine rrtmgp_sw_rte_gpu_run +end module rrtmgp_sw_rte_gpu diff --git a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta new file mode 100644 index 00000000..77a53a51 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta @@ -0,0 +1,121 @@ +[ccpp-table-properties] + name = rrtmgp_sw_rte_gpu + type = scheme + dependencies = ext/rte-frontend/mo_rte_sw.F90 + dependencies = ext/rte-frontend/mo_rte_config.F90 + dependencies = ext/rte-kernels/mo_rte_util_array.F90 + dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 + dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 + dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ../../../../utils/machine.F90 + dependencies = ./utils/radiation_tools.F90 + dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = ./objects/ccpp_optical_props.F90 + dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 + dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 + +[ccpp-arg-table] + name = rrtmgp_sw_rte_gpu_run + type = scheme +[ doswrad ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = in +[ doswclrsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky + units = flag + type = logical + dimensions = () + intent = in +[ doswallsky ] + standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_all_sky + units = flag + type = logical + dimensions = () + intent = in +[ nday ] + standard_name = daytime_points_dimension + units = count + type = integer + dimensions = () + intent = in +[ iter_num ] + standard_name = iteration_number_for_radiation_subcycle + units = count + type = integer + dimensions = () + intent = in +[ rrtmgp_phys_blksz ] + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP + units = count + type = integer + dimensions = () + intent = in +[ sw_optical_props ] + standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ sw_optical_props_clouds ] + standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ aersw ] + standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_2str_ccpp + dimensions = () + intent = inout +[ coszen_day ] + standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep + units = rad + type = real | kind = kind_phys + dimensions = (daytime_points_dimension) + intent = in +[ toa_src_sw ] + standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points + units = W m-2 + type = real | kind = kind_phys + dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) + intent = in +[ sfc_alb_dir ] + standard_name = albedo_direct_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = in +[ sfc_alb_dif ] + standard_name = albedo_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + intent = in +[ flux_clrsky ] + standard_name = shortwave_clear_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_broadband_ccpp + dimensions = () + intent = inout +[ flux_allsky ] + standard_name = shortwave_all_sky_flux_object_for_RRTMGP + units = none + type = ty_fluxes_byband_ccpp + dimensions = () + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/test/test_suites/suite_rrtmgp_gpu.xml b/test/test_suites/suite_rrtmgp_gpu.xml new file mode 100644 index 00000000..fbcb17cc --- /dev/null +++ b/test/test_suites/suite_rrtmgp_gpu.xml @@ -0,0 +1,53 @@ + + + + + initialize_constituents + rrtmgp_pre + rrtmgp_cloud_optics_setup + tropopause_find + rrtmgp_variables + rrtmgp_inputs + rrtmgp_sw_cloud_optics + rrtmgp_sw_mcica_subcol_gen + rrtmgp_cloud_diagnostics + + + rrtmgp_constituents + rrtmgp_sw_gas_optics_pre + rrtmgp_sw_gas_optics_gpu + solar_irradiance_data + rrtmgp_sw_solar_var + rrtmgp_sw_aerosols + rrtmgp_sw_rte_gpu + rrtmgp_sw_calculate_fluxes + rrtmgp_sw_calculate_heating_rate + rrtmgp_sw_diagnostics + rrtmgp_subcycle + + rrtmgp_lw_cloud_optics + rrtmgp_lw_mcica_subcol_gen + + + rrtmgp_constituents + rrtmgp_lw_gas_optics_pre + rrtmgp_lw_gas_optics_gpu + rrtmgp_lw_aerosols + rrtmgp_lw_rte_gpu + rrtmgp_lw_calculate_fluxes + rrtmgp_lw_calculate_heating_rate + rrtmgp_lw_diagnostics + rrtmgp_subcycle + + + rrtmgp_inputs_setup + rrtmgp_sw_solar_var_setup + rrtmgp_dry_static_energy_tendency + calculate_net_heating + rrtmgp_post + rrtmgp_diagnostics + + apply_heating_rate + geopotential_temp + + From 68fd028217976dbd3fece695c7aede27a5fe7279 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 10:52:11 -0600 Subject: [PATCH 114/140] remove h2o from nl source list; move gaslist to nl --- schemes/rrtmgp/rrtmgp_constituents.F90 | 5 ++--- schemes/rrtmgp/rrtmgp_constituents.meta | 10 ++-------- schemes/rrtmgp/rrtmgp_constituents_namelist.xml | 6 +++--- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 1 - schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_pre.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_pre.meta | 4 ++-- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 13 +++++++++++++ schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 2 +- 9 files changed, 26 insertions(+), 21 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 59a62762..a91fda97 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -8,10 +8,9 @@ module rrtmgp_constituents !> \section arg_table_rrtmgp_constituents_register Argument Table !! \htmlinclude rrtmgp_constituents_register.html !! - subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errmsg, errflg) + subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errflg) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys - integer, intent(in) :: nradgas ! Number of radiatively active gases type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) ! Runtime constituent properties character(len=256), intent(in) :: rad_climate(:) ! (namelist) list of radiatively active gases and sources character(len=512), intent(out) :: errmsg @@ -28,7 +27,7 @@ subroutine rrtmgp_constituents_register(nradgas, rad_climate, rrtmgp_dyn_consts, errflg = 0 ! Allocate the dynamic constituents array - allocate(rrtmgp_dyn_consts(nradgas), stat=ierr, errmsg=alloc_errmsg) + allocate(rrtmgp_dyn_consts(size(rad_climate)), stat=ierr, errmsg=alloc_errmsg) if (ierr /= 0) then write(errmsg, *) 'rrtmgp_constituents_register: Unable to allocate rrtmgp_dyn_consts - message: ', alloc_errmsg errflg = 1 diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 00cf1610..798c8847 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -5,17 +5,11 @@ [ccpp-arg-table] name = rrtmgp_constituents_register type = scheme -[ nradgas ] - standard_name = number_of_active_gases_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in [ rad_climate ] standard_name = sources_of_radiatively_active_gases_for_climate_calculation units = none type = character | kind = len=256 - dimensions = (cam_nl_autogen1_dimension) + dimensions = (cam_nl_autogen2_dimension) intent = in [ rrtmgp_dyn_consts ] standard_name = rrtmgp_constituents_dyn_consts @@ -43,7 +37,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (number_of_active_gases_for_RRTMGP) + dimensions = (cam_nl_autogen1_dimension) intent = in [ const_array ] standard_name = ccpp_constituents diff --git a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml index ad60e637..670c2c82 100644 --- a/schemes/rrtmgp/rrtmgp_constituents_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_constituents_namelist.xml @@ -76,17 +76,17 @@ This is the CCPP unit specification of the variable (e.g., m s-1). --> - char*256(8) + char*256(7) rrtmgp_constituents rrtmgp_constituents sources_of_radiatively_active_gases_for_climate_calculation none List of radiatively active gases and whether they are advected or not for the climate - calculation in RRTMGP. + calculation in RRTMGP (H2O not included because it is assumed to be advected if present). - 'A:Q:H2O', 'N:O2:O2', 'A:CO2:CO2', 'N:ozone:O3', 'A:N2O:N2O', 'A:CH4:CH4', 'N:CFC11STAR:CFC11', 'A:CFC12:CFC12' + 'N:O2:O2', 'A:CO2:CO2', 'N:ozone:O3', 'A:N2O:N2O', 'A:CH4:CH4', 'N:CFC11STAR:CFC11', 'A:CFC12:CFC12' diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 9295db39..fceaabba 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -134,7 +134,6 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw ! "irad_always" is number of time steps to execute radiation continuously from ! start of initial OR restart run - irad_always_out = irad_always if (irad_always > 0) then irad_always_out = irad_always + nstep end if diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index f928f7f6..6183ad0d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -39,7 +39,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (number_of_active_gases_for_RRTMGP) + dimensions = (cam_nl_autogen1_dimension) intent = in [ pverp ] standard_name = vertical_interface_dimension diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 05a9d4a4..94155dea 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -17,7 +17,7 @@ subroutine rrtmgp_pre_init(nradgas, available_gases, gaslist, gaslist_lc, errmsg use atmos_phys_string_utils, only: to_lower integer, intent(in) :: nradgas ! Number of radiatively active gases type(ty_gas_concs_ccpp), intent(out) :: available_gases ! Gas concentrations object - character(len=5), intent(out) :: gaslist(:) ! Radiatively active gas list + character(len=5), intent(in) :: gaslist(:) ! Radiatively active gas list character(len=5), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -30,7 +30,7 @@ subroutine rrtmgp_pre_init(nradgas, available_gases, gaslist, gaslist_lc, errmsg errflg = 0 ! Initialize gas list - gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) +! gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects ! work with CAM's uppercase names, but other objects that get input from the gas diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 7c15bd21..d108da10 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -22,8 +22,8 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (number_of_active_gases_for_RRTMGP) - intent = out + dimensions = (cam_nl_autogen1_dimension) + intent = in [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 94fce7f4..55ec7978 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -313,4 +313,17 @@ .false. + + char*5(8) + rrtmgp + rrtmgp + list_of_active_gases_for_RRTMGP + none + + List of radiatively active gases used in RRTMGP + + + 'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12' + + diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta index ee4ad9c3..e81c9da2 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -39,7 +39,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (number_of_active_gases_for_RRTMGP) + dimensions = (cam_nl_autogen1_dimension) intent = in [ idxday ] standard_name = daytime_points From 215a362ede33dc12eaaa289a5601309c01109b47 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 14:48:29 -0600 Subject: [PATCH 115/140] add rrtmgp to cam4 suite but comment it out until we get a working qpc4 compset --- suites/suite_cam4.xml | 53 ++++++++++++++++++++++++++++--- test/test_suites/suite_rrtmgp.xml | 12 +++---- 2 files changed, 55 insertions(+), 10 deletions(-) diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml index a92bf774..0d6dd06d 100644 --- a/suites/suite_cam4.xml +++ b/suites/suite_cam4.xml @@ -7,7 +7,7 @@ Shallow convection Hack Macrophysics RK Microphysics RK - Radiation RRTMGP (not implemented) + Radiation RRTMGP (commented out) Chemistry None (not implemented) Vertical Diffusion HB Gravity Wave Drag Orographic (not implemented) @@ -214,9 +214,54 @@ sima_state_diagnostics - + + + + + + + + + + + diff --git a/test/test_suites/suite_rrtmgp.xml b/test/test_suites/suite_rrtmgp.xml index 4d7ff057..edc64652 100644 --- a/test/test_suites/suite_rrtmgp.xml +++ b/test/test_suites/suite_rrtmgp.xml @@ -13,13 +13,13 @@ rrtmgp_cloud_diagnostics - rrtmgp_constituents - rrtmgp_sw_gas_optics_pre - rrtmgp_sw_gas_optics - solar_irradiance_data - rrtmgp_sw_solar_var + rrtmgp_constituents + rrtmgp_sw_gas_optics_pre + rrtmgp_sw_gas_optics + solar_irradiance_data + rrtmgp_sw_solar_var rrtmgp_sw_aerosols - rrtmgp_sw_rte + rrtmgp_sw_rte rrtmgp_sw_calculate_fluxes rrtmgp_sw_calculate_heating_rate rrtmgp_sw_diagnostics From 9e8bf60441f3fe718b96c2d42d59f031475225ee Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 15:23:06 -0600 Subject: [PATCH 116/140] remove commented code --- schemes/rrtmgp/rrtmgp_pre.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 94155dea..795a59a4 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -29,9 +29,6 @@ subroutine rrtmgp_pre_init(nradgas, available_gases, gaslist, gaslist_lc, errmsg errmsg = '' errflg = 0 - ! Initialize gas list -! gaslist = (/'H2O ','O3 ', 'O2 ', 'CO2 ', 'N2O ', 'CH4 ', 'CFC11', 'CFC12'/) - ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects ! work with CAM's uppercase names, but other objects that get input from the gas ! concs objects don't work. From 87a5214171cb2c1c9d7144d7a01ab7259d1b148f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 15:48:16 -0600 Subject: [PATCH 117/140] initialize irad_always_out --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index fceaabba..9295db39 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -134,6 +134,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw ! "irad_always" is number of time steps to execute radiation continuously from ! start of initial OR restart run + irad_always_out = irad_always if (irad_always > 0) then irad_always_out = irad_always + nstep end if From e3ab8e8fe77b1d8f695f3eb63fa5734ed46a8a7a Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 15:56:09 -0600 Subject: [PATCH 118/140] fix indents --- schemes/rrtmgp/rrtmgp_pre.F90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 795a59a4..80772179 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -49,19 +49,19 @@ end subroutine rrtmgp_pre_init subroutine rrtmgp_pre_timestep_init(ncol, coszrs, nstep, dtime, iradsw, irad_always, offset, & idxday, nday, idxnite, nnite, errmsg, errflg) use ccpp_kinds, only: kind_phys - real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle - integer, intent(in) :: nstep ! Current timestep number - integer, intent(in) :: ncol ! Number of horizontal columns - real(kind_phys), intent(in) :: dtime ! Timestep size - integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) - integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously - integer, intent(out) :: nday ! Number of daylight columns - integer, intent(out) :: nnite ! Number of nighttime columns - integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns - integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns - integer, intent(out) :: offset ! Offset for next SW radiation timestep - integer, intent(out) :: errflg - character(len=512), intent(out) :: errmsg + real(kind_phys), intent(in) :: coszrs(:) ! Cosine solar zenith angle + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: ncol ! Number of horizontal columns + real(kind_phys), intent(in) :: dtime ! Timestep size + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: nday ! Number of daylight columns + integer, intent(out) :: nnite ! Number of nighttime columns + integer, intent(out) :: idxday(:) ! Indices of daylight columns + integer, intent(out) :: idxnite(:) ! Indices of nighttime columns + integer, intent(out) :: offset ! Offset for next SW radiation timestep + integer, intent(out) :: errflg + character(len=512), intent(out) :: errmsg logical :: dosw_next integer :: nstepsw_next, idx From 2bd18822ec5efa005ef17e32c59cc45405f6cb6f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 23 Oct 2025 15:58:39 -0600 Subject: [PATCH 119/140] remove temp scheme --- schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 | 38 ------------------ schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta | 49 ------------------------ 2 files changed, 87 deletions(-) delete mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 deleted file mode 100644 index 76109ca1..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.F90 +++ /dev/null @@ -1,38 +0,0 @@ -module rrtmgp_sw_cloud_temp - - public :: rrtmgp_sw_cloud_temp_run - -CONTAINS - !> \section arg_table_rrtmgp_sw_cloud_temp_run Argument Table - !! \htmlinclude rrtmgp_sw_cloud_temp_run.html - subroutine rrtmgp_sw_cloud_temp_run(dosw, ncol, nlay, kdist_sw, cloud_sw, errmsg, errflg) - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_optical_props, only: ty_optical_props_2str_ccpp - ! Inputs - integer, intent(in) :: ncol ! Number of columns - integer, intent(in) :: nlay ! Number of vertical layers in radiation - logical, intent(in) :: dosw ! Flag for whether to perform longwave calculation - class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Longwave gas optics object - - ! Outputs - type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! Longwave cloud optics object - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - ! Set error variables - errmsg = '' - errflg = 0 - - ! If not doing shortwave, no need to proceed - if (.not. dosw) then - return - end if - - errmsg =cloud_sw%optical_props%alloc_2str(ncol, nlay, kdist_sw%gas_props) - if (len_trim(errmsg) > 0) then - errflg = 1 - return - end if - - end subroutine rrtmgp_sw_cloud_temp_run - -end module rrtmgp_sw_cloud_temp diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta deleted file mode 100644 index 614e5563..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_temp.meta +++ /dev/null @@ -1,49 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_cloud_temp - type = scheme - -[ccpp-arg-table] - name = rrtmgp_sw_cloud_temp_run - type = scheme -[ dosw ] - standard_name = do_shortwave_radiation - units = flag - type = logical - dimensions = () - intent = in -[ ncol ] - standard_name = horizontal_loop_extent - units = count - type = integer - dimensions = () - intent = in -[ nlay ] - standard_name = vertical_layer_dimension - units = count - type = integer - dimensions = () - intent = in -[ kdist_sw ] - standard_name = shortwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = in -[ cloud_sw ] - standard_name = shortwave_cloud_optical_properties_object_for_rrtmgp - units = none - type = ty_optical_props_2str_ccpp - dimensions = () - intent = out -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out From b0a79e8a6adb0ab5458955c8d9eed578ccb7f10f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 24 Oct 2025 09:45:33 -0600 Subject: [PATCH 120/140] update dimension names --- schemes/rrtmgp/rrtmgp_constituents.meta | 4 ++-- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 798c8847..5267b580 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -9,7 +9,7 @@ standard_name = sources_of_radiatively_active_gases_for_climate_calculation units = none type = character | kind = len=256 - dimensions = (cam_nl_autogen2_dimension) + dimensions = (rad_climate_dimension) intent = in [ rrtmgp_dyn_consts ] standard_name = rrtmgp_constituents_dyn_consts @@ -37,7 +37,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (cam_nl_autogen1_dimension) + dimensions = (gaslist_dimension) intent = in [ const_array ] standard_name = ccpp_constituents diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index 6183ad0d..e0caf522 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -39,7 +39,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (cam_nl_autogen1_dimension) + dimensions = (gaslist_dimension) intent = in [ pverp ] standard_name = vertical_interface_dimension diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index d108da10..94acf451 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -22,7 +22,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (cam_nl_autogen1_dimension) + dimensions = (gaslist_dimension) intent = in [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta index e81c9da2..dea63056 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -39,7 +39,7 @@ standard_name = list_of_active_gases_for_RRTMGP units = none type = character | kind = len=5 - dimensions = (cam_nl_autogen1_dimension) + dimensions = (gaslist_dimension) intent = in [ idxday ] standard_name = daytime_points From 0344b67884e81777ea771c008528900292fb36ed Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 3 Nov 2025 09:18:13 -0700 Subject: [PATCH 121/140] fix constituent units --- schemes/rrtmgp/rrtmgp_constituents.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index a91fda97..7a240eb9 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -66,7 +66,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & - units = 'kg-1', & + units = 'kg kg-1', & vertical_dim = 'vertical_layer_dimension', & min_value = 0.0_kind_phys, & advected = .true., & @@ -78,7 +78,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & - units = 'kg-1', & + units = 'kg kg-1', & vertical_dim = 'vertical_layer_dimension', & min_value = 0.0_kind_phys, & advected = .false., & @@ -90,7 +90,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & - units = 'kg-1', & + units = 'kg kg-1', & vertical_dim = 'vertical_layer_dimension', & min_value = 0.0_kind_phys, & default_value = 0.0_kind_phys, & From a679332c528d7317bc7d4ebcad96ed814098769c Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Mon, 10 Nov 2025 16:21:01 -0700 Subject: [PATCH 122/140] Fix bugs/error messages found during CAM4 aquaplanet testing. --- .../radiation_utils/solar_irradiance_data.F90 | 54 +++++++++++++------ 1 file changed, 39 insertions(+), 15 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 48cefb71..0e82bd6e 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -1,5 +1,5 @@ !------------------------------------------------------------------------------- -! This module uses the solar irradiance data +! 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 @@ -49,6 +49,8 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg class(abstract_netcdf_reader_t), pointer :: file_reader integer, parameter :: missing_variable_error_code = 3 + character(len=*), parameter :: subname = 'solar_irradiance_data_register: ' + ! Set error variables errmsg = '' errflg = 0 @@ -56,17 +58,27 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg nbins = 0 nbinsp = 0 + ! Check if irradiance file path is set. + ! If not then assume that a constant + ! solar flux will be set: + if (trim(irrad_file_path) == 'NONE') then + fixed_scon = .true. + return !Nothing else to do in the register phase. + end if + file_reader => create_netcdf_reader_t() ! Open the solar irradiance data file call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if ! Read the wavelengths variable call file_reader%get_var('wavelength', lambda, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + errmsg = subname // errmsg return else if (errflg == missing_variable_error_code) then ! Check old name (for backward compatibility @@ -76,6 +88,7 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg ! Close the solar irradiance file call file_reader%close_file(errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if deallocate(file_reader) @@ -132,6 +145,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da character(len=256) :: alloc_errmsg real(kind_phys) :: fac + character(len=*), parameter :: subname = 'solar_irradiance_data_init: ' + ! Set error variables errmsg = '' errflg = 0 @@ -141,12 +156,6 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da has_spectrum = .false. - if (irrad_file_path /= 'NONE') then - fixed_scon = .false. - else - fixed_scon = .true. - end if - if (solar_const>0._kind_phys) then sol_tsi = solar_const end if @@ -163,12 +172,14 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Open the solar irradiance data file call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if ! Check what the file contains call file_reader%get_var('ssi', ssi, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + errmsg = subname // errmsg return else if (errflg /= missing_variable_error_code) then has_spectrum = .true. @@ -176,6 +187,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da call file_reader%get_var('tsi', tsi, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + errmsg = subname // errmsg return else if (errflg /= missing_variable_error_code .and. solar_const < 0._kind_phys) then has_tsi = .true. @@ -183,6 +195,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da call file_reader%get_var('ssi_ref', ssi_ref, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + errmsg = subname // errmsg return else if (errflg /= missing_variable_error_code) then has_ref_spectrum = .true. @@ -191,6 +204,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da if (has_ref_spectrum) then call file_reader%get_var('tsi_ref', ref_tsi, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if end if @@ -201,16 +215,19 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da if (has_spectrum) then call file_reader%get_var('wavelength', lambda, errmsg, errflg) if (errflg /= 0 .and. errflg /= missing_variable_error_code) then + errmsg = subname // errmsg return else if (errflg == missing_variable_error_code) then ! Check old name (for backward compatibility call file_reader%get_var('wvl', lambda, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if end if call file_reader%get_var('band_width', dellam, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if end if @@ -218,6 +235,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Close the solar irradiance file call file_reader%close_file(errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if deallocate(file_reader) @@ -225,12 +243,12 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da allocate(irrad_fac(nbins), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate irrad_fac; error = ', alloc_errmsg + write(errmsg,*) subname // 'failed to allocate irrad_fac; error = ', alloc_errmsg return end if allocate(etf_fac(nbins), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate etf_fac; error = ', alloc_errmsg + write(errmsg,*) subname // 'failed to allocate etf_fac; error = ', alloc_errmsg return end if @@ -238,12 +256,12 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da if ( has_spectrum ) then allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate we; error = ', alloc_errmsg + write(errmsg,*) subname // 'failed to allocate we; error = ', alloc_errmsg return end if allocate(sol_etf(nbins), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) 'solar_data_init: failed to allocate sol_etf; error = ', alloc_errmsg + write(errmsg,*) subname // 'failed to allocate sol_etf; error = ', alloc_errmsg return end if @@ -281,7 +299,7 @@ end subroutine solar_irradiance_data_init subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & sol_irrad, we, sol_tsi, errmsg, errflg) use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - ! Arguments + ! Arguments character(len=*), intent(in) :: irrad_file_path real(kind_phys), intent(in) :: we(:) ! wavelength endpoints integer, intent(in) :: nbins ! number of bins @@ -293,7 +311,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg - ! Local variables + ! Local variables integer :: idx, index, nt integer :: offset(2), count(2) integer, allocatable :: itsi(:) @@ -301,7 +319,9 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru real(kind_phys) :: data(nbins) integer :: ierr real(kind_phys) :: delt - class(abstract_netcdf_reader_t), pointer :: file_reader + class(abstract_netcdf_reader_t), pointer :: file_reader + + character(len=*), parameter :: subname = 'solar_irradiance_data_run: ' ! Initialize error variables errflg = 0 @@ -321,6 +341,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru ! Open the solar irradiance data file call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if nt = 2 @@ -333,12 +354,14 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru if (has_spectrum) then call file_reader%get_var('ssi', irradi, errmsg, errflg, offset, count) if (errflg /= 0) then + errmsg = subname // errmsg return end if end if if (has_tsi .and. (.not. do_spectral_scaling)) then call file_reader%get_var('tsi', itsi, errmsg, errflg, (/index/), (/nt/)) if (errflg /= 0) then + errmsg = subname // errmsg return end if if ( any(itsi(:nt) < 0._kind_phys) ) then @@ -350,6 +373,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru ! Close the solar irradiance file call file_reader%close_file(errmsg, errflg) if (errflg /= 0) then + errmsg = subname // errmsg return end if deallocate(file_reader) @@ -374,7 +398,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru if (has_spectrum) then deallocate(irradi) end if - + end subroutine solar_irradiance_data_run end module solar_irradiance_data From b0a631e5f5d7591379f13e42a109797beff7f85e Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Thu, 20 Nov 2025 13:46:09 -0700 Subject: [PATCH 123/140] Always allocate 'we' variable in order to avoid CCPP runtime subsetting error. --- .../radiation_utils/solar_irradiance_data.F90 | 22 ++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 0e82bd6e..2cf31844 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -55,8 +55,10 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg errmsg = '' errflg = 0 - nbins = 0 - nbinsp = 0 + ! Initialize to one to avoid + ! automatic CCPP subsetting errors + nbins = 1 + nbinsp = 1 ! Check if irradiance file path is set. ! If not then assume that a constant @@ -160,7 +162,21 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da sol_tsi = solar_const end if - if ( fixed_scon ) return + if ( fixed_scon ) then + ! Allocate wavelength ends, + ! which depend on the number + ! of wavelength bins, in + ! order to avoid CCPP + ! subsetting errors: + !------------------ + allocate(we(nbinsp), stat=errflg, errmsg=errmsg) + if (errflg /= 0) then + errmsg = subname // errmsg + end if + !------------------ + + return !Nothing more to do, so exit subroutine. + end if fixed = trim(solar_data_type) == 'FIXED' From 76f3878cb09ea424b8b4412ab0239ae2f531902a Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 8 Dec 2025 09:37:09 -0700 Subject: [PATCH 124/140] use existing rebin functionality --- schemes/radiation_utils/mo_util.F90 | 81 ------------------------- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 2 +- 3 files changed, 2 insertions(+), 83 deletions(-) delete mode 100644 schemes/radiation_utils/mo_util.F90 diff --git a/schemes/radiation_utils/mo_util.F90 b/schemes/radiation_utils/mo_util.F90 deleted file mode 100644 index 42ea6f40..00000000 --- a/schemes/radiation_utils/mo_util.F90 +++ /dev/null @@ -1,81 +0,0 @@ -module mo_util - - use shr_kind_mod, only : r8 => shr_kind_r8 - - implicit none - - private - public :: rebin - -contains - - subroutine rebin( nsrc, ntrg, src_x, trg_x, src, trg ) - !--------------------------------------------------------------- - ! ... rebin src to trg - !--------------------------------------------------------------- - - 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) :: trg_x(ntrg+1) ! target coordinates - real(r8), intent(in) :: src(nsrc) ! source array - real(r8), intent(out) :: trg(ntrg) ! target array - - !--------------------------------------------------------------- - ! ... local variables - !--------------------------------------------------------------- - integer :: i, l - integer :: si, si1 - integer :: sil, siu - real(r8) :: y - real(r8) :: sl, su - real(r8) :: tl, tu - - !--------------------------------------------------------------- - ! ... check interval overlap - !--------------------------------------------------------------- - ! if( trg_x(1) < src_x(1) .or. trg_x(ntrg+1) > src_x(nsrc+1) ) then - ! write(iulog,*) 'rebin: target grid is outside source grid' - ! write(iulog,*) ' target grid from ',trg_x(1),' to ',trg_x(ntrg+1) - ! write(iulog,*) ' source grid from ',src_x(1),' to ',src_x(nsrc+1) - ! call endrun - ! end if - - do i = 1,ntrg - tl = trg_x(i) - if( tl < src_x(nsrc+1) ) then - do sil = 1,nsrc+1 - if( tl <= src_x(sil) ) then - exit - end if - end do - tu = trg_x(i+1) - do siu = 1,nsrc+1 - if( tu <= src_x(siu) ) then - exit - end if - end do - y = 0._r8 - sil = max( sil,2 ) - siu = min( siu,nsrc+1 ) - do si = sil,siu - si1 = si - 1 - sl = max( tl,src_x(si1) ) - su = min( tu,src_x(si) ) - y = y + (su - sl)*src(si1) - end do - trg(i) = y/(trg_x(i+1) - trg_x(i)) - else - trg(i) = 0._r8 - end if - end do - - end subroutine rebin - - -end module mo_util diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 3f4e397d..b118fe22 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -92,7 +92,7 @@ end subroutine rrtmgp_sw_solar_var_run subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) - use mo_util, only : rebin + use ccpp_tuvx_utils, only : rebin implicit none diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index 16b9fd94..05bd45c6 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_solar_var type = scheme - dependencies = ../radiation_utils/mo_util.F90 + dependencies = ../../to_be_ccppized/ccpp_tuvx_utils.F90 [ccpp-arg-table] name = rrtmgp_sw_solar_var_run From 18dc65dc160efe8d3674a175a545fd145fbac232 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 9 Dec 2025 10:43:21 -0700 Subject: [PATCH 125/140] address some review comments --- schemes/rrtmgp/rrtmgp_constituents.F90 | 139 +++++++++--------- schemes/rrtmgp/rrtmgp_inputs.F90 | 2 +- schemes/rrtmgp/rrtmgp_inputs.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_aerosols.F90 | 2 + schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 1 - schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 3 +- schemes/rrtmgp/rrtmgp_lw_rte.meta | 8 +- schemes/rrtmgp/rrtmgp_sw_aerosols.F90 | 2 + schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 3 +- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 1 - schemes/rrtmgp/rrtmgp_sw_rte.F90 | 1 + schemes/rrtmgp/rrtmgp_variables.F90 | 8 - schemes/rrtmgp/rrtmgp_variables.meta | 12 -- 13 files changed, 85 insertions(+), 99 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 7a240eb9..29d57551 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -36,75 +36,76 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, ! Parse gases, long names, and sources from rad_climate parse_loop: do gas_idx = 1, size(rad_climate) - if ( len_trim(rad_climate(gas_idx)) == 0 ) then - exit parse_loop - endif - - ! There are no fields in the input strings in which a blank character is allowed. - ! To simplify the parsing go through the input strings and remove blanks. - tmpstr = adjustl(rad_climate(gas_idx)) - do - strlen = len_trim(tmpstr) - ipos = index(tmpstr, ' ') - if (ipos == 0 .or. ipos > strlen) exit - tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) - end do - - ! Locate the ':' separating source from long name. - idx = index(tmpstr, ':') - source = tmpstr(:idx-1) - tmpstr = tmpstr(idx+1:) - - ! locate the ':' separating long name from rad gas ("standard") name - idx = scan(tmpstr, ':') - - long_name = tmpstr(:idx-1) - stdname = tmpstr(idx+1:) - - ! Register the constituent based on the source - if (source == 'A') then - call rrtmgp_dyn_consts(gas_idx)%instantiate( & - std_name = stdname, & - long_name = long_name, & - units = 'kg kg-1', & - vertical_dim = 'vertical_layer_dimension', & - min_value = 0.0_kind_phys, & - advected = .true., & - water_species = .false., & - mixing_ratio_type = 'dry', & - errcode = errflg, & - errmsg = errmsg) - else if (source == 'N') then - call rrtmgp_dyn_consts(gas_idx)%instantiate( & - std_name = stdname, & - long_name = long_name, & - units = 'kg kg-1', & - vertical_dim = 'vertical_layer_dimension', & - min_value = 0.0_kind_phys, & - advected = .false., & - water_species = .false., & - mixing_ratio_type = 'dry', & - errcode = errflg, & - errmsg = errmsg) - else if (source == 'Z') then - call rrtmgp_dyn_consts(gas_idx)%instantiate( & - std_name = stdname, & - long_name = long_name, & - units = 'kg kg-1', & - vertical_dim = 'vertical_layer_dimension', & - min_value = 0.0_kind_phys, & - default_value = 0.0_kind_phys, & - advected = .false., & - water_species = .false., & - mixing_ratio_type = 'dry', & - errcode = errflg, & - errmsg = errmsg) - else - write(errmsg,*) 'rrtmgp_constituent_register: invalid gas source "', source, '" for radiation', & - ' constituent "', stdname, '"' - errflg = 1 - return - end if + + if ( len_trim(rad_climate(gas_idx)) == 0 ) then + exit parse_loop + endif + + ! There are no fields in the input strings in which a blank character is allowed. + ! To simplify the parsing go through the input strings and remove blanks. + tmpstr = adjustl(rad_climate(gas_idx)) + do + strlen = len_trim(tmpstr) + ipos = index(tmpstr, ' ') + if (ipos == 0 .or. ipos > strlen) exit + tmpstr = tmpstr(:ipos-1) // tmpstr(ipos+1:strlen) + end do + + ! Locate the ':' separating source from long name. + idx = index(tmpstr, ':') + source = tmpstr(:idx-1) + tmpstr = tmpstr(idx+1:) + + ! locate the ':' separating long name from rad gas ("standard") name + idx = scan(tmpstr, ':') + + long_name = tmpstr(:idx-1) + stdname = tmpstr(idx+1:) + + ! Register the constituent based on the source + if (source == 'A') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + advected = .true., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errflg, & + errmsg = errmsg) + else if (source == 'N') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + advected = .false., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errflg, & + errmsg = errmsg) + else if (source == 'Z') then + call rrtmgp_dyn_consts(gas_idx)%instantiate( & + std_name = stdname, & + long_name = long_name, & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + min_value = 0.0_kind_phys, & + default_value = 0.0_kind_phys, & + advected = .false., & + water_species = .false., & + mixing_ratio_type = 'dry', & + errcode = errflg, & + errmsg = errmsg) + else + write(errmsg,*) 'rrtmgp_constituent_register: invalid gas source "', source, '" for radiation', & + ' constituent "', stdname, '"' + errflg = 1 + return + end if end do parse_loop diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index da20bc18..edf88fc3 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -59,7 +59,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & real(kind_phys), intent(in) :: stebol ! Stefan-Boltzmann constant (W m-2 K-4) type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object - character(len=5), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases + character(len=*), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases ! Outputs real(kind_phys), dimension(:,:), intent(out) :: t_rad ! Air temperature with radiation indexing (K) real(kind_phys), dimension(:,:), intent(out) :: pmid_rad ! Midpoint pressure with radiation indexing (Pa) diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index f63262c1..a61777f2 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -272,7 +272,7 @@ [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=5 + type = character | kind = len=* dimensions = (number_of_active_gases_for_RRTMGP) intent = in [ gas_concs_lw ] diff --git a/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 index e224fcce..1f9621a6 100644 --- a/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 @@ -31,6 +31,8 @@ subroutine rrtmgp_lw_aerosols_run(dolwrad, aer_lw, errmsg, errflg) if (.not. dolwrad) return + ! REMOVECAM: scheme is just a stub for now + ! Set the optical properties to 0 for snapshot testing aer_lw%optical_props%tau = 0.0_kind_phys end subroutine rrtmgp_lw_aerosols_run diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 444cd947..0bc8b46b 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -72,7 +72,6 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, cld, cldfsnow, cldfgrau, ! cloud radiative parameters are "in cloud" not "in cell" real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) real(kind_phys) :: ice_lw_abs(nlwbands, ncol, pver) ! ice absorption optics depth (LW) - !real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_run' !-------------------------------------------------------------------------------- diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index c1c88272..0bf815e8 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -304,10 +304,11 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & optimal_angle_fit) + call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) if (len_trim(errmsg) > 0) then errflg = 1 + return end if - call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) end subroutine rrtmgp_lw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index f4b57c63..9fd03ca7 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -8,10 +8,10 @@ dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 dependencies = ../../../../utils/machine.F90 - dependencies = ./utils/radiation_tools.F90 - dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 - dependencies = ./objects/ccpp_optical_props.F90 - dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 + dependencies = utils/radiation_tools.F90 + dependencies = objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = objects/ccpp_optical_props.F90 + dependencies = objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_lw_rte_run diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 index 70f3566a..9e43e6cc 100644 --- a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 @@ -32,6 +32,8 @@ subroutine rrtmgp_sw_aerosols_run(doswrad, nday, aer_sw, errmsg, errflg) if (.not. doswrad .or. nday == 0) return + ! REMOVECAM: scheme is just a stub for now + ! Set the optical properties to constants for snapshot testing aer_sw%optical_props%tau = 0.0_kind_phys aer_sw%optical_props%g = 0.0_kind_phys aer_sw%optical_props%ssa = 1.0_kind_phys diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 787f5c1c..7e489b27 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -320,10 +320,11 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & tsi_default, mg_default, sb_default, & rayl_lower_allocatable, rayl_upper_allocatable) + call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) if (len_trim(errmsg) > 0) then errflg = 1 + return end if - call check_error_msg('rrtmgp_sw_gas_optics_init_load', errmsg) end subroutine rrtmgp_sw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index da5935e7..b1bb39c9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -21,7 +21,6 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp use shr_RandNum_mod, only: ShrKissRandGen ! SIMA-specific randum number generator - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp ! Compute combined cloud optical properties. ! Create MCICA stochastic arrays for cloud SW optical properties. diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 479a2b84..cb48a004 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -113,6 +113,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 + return end if end if diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 0ed4faff..d70183f8 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -22,8 +22,6 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) ! Surface temperature flux Jacobian [W m-2 K-1] real(kind_phys), intent(out) :: rad_heat(:,:) ! Tendency of dry air enthalpy [J kg-1 s-1] logical, intent(out) :: use_tlev ! Flag to use temperature at interfaces in radiation calculation - logical, intent(out) :: snow_exists ! Flag to include snow cloud area fraction - logical, intent(out) :: grau_exists ! Flag to include graupel cloud area fraction character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg @@ -42,12 +40,6 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & ! Initialize rad_heat rad_heat = unset_real - ! REMOVECAM: The grau_exists and snow_exists flags should be set to .true. by - ! schemes that introduce graupel and/or snow - ! Set the snow and graupel flags to the values needed for the snapshot test - snow_exists = .true. - grau_exists = .false. - end subroutine rrtmgp_variables_init !> \section arg_table_rrtmgp_variables_timestep_init Argument Table diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index b4dfd3ee..418b4abd 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -41,18 +41,6 @@ type = logical dimensions = () intent = out -[ grau_exists ] - standard_name = include_liquid_plus_graupel_stratiform_cloud_area_fraction - units = flag - type = logical - dimensions = () - intent = out -[ snow_exists ] - standard_name = include_liquid_plus_snow_stratiform_cloud_area_fraction - units = flag - type = logical - dimensions = () - intent = out [ errmsg ] standard_name = ccpp_error_message units = none From 371f333e788b03e3a456d99d696836767554362f Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 11 Dec 2025 16:42:11 -0700 Subject: [PATCH 126/140] address further review comments --- .../radiation_utils/solar_irradiance_data.F90 | 102 +++++------ .../solar_irradiance_data.meta | 35 ++-- .../solar_irradiance_data_namelist.xml | 4 +- schemes/rrtmgp/rrtmgp_constituents.F90 | 17 +- schemes/rrtmgp/rrtmgp_constituents.meta | 6 +- schemes/rrtmgp/rrtmgp_inputs.F90 | 19 +- schemes/rrtmgp/rrtmgp_inputs.meta | 168 +++++++++--------- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 14 +- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 98 +++++----- schemes/rrtmgp/rrtmgp_lw_aerosols.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 3 +- .../rrtmgp/rrtmgp_lw_calculate_fluxes.meta | 2 +- .../rrtmgp_lw_calculate_heating_rate.F90 | 2 +- .../rrtmgp_lw_calculate_heating_rate.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 8 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta | 55 +++--- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 10 +- schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 20 +-- .../rrtmgp/rrtmgp_lw_gas_optics_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 2 +- .../rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta | 3 +- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 4 +- schemes/rrtmgp/rrtmgp_lw_rte.meta | 3 +- schemes/rrtmgp/rrtmgp_post.F90 | 2 +- schemes/rrtmgp/rrtmgp_post.meta | 2 +- schemes/rrtmgp/rrtmgp_pre.F90 | 22 +-- schemes/rrtmgp/rrtmgp_pre.meta | 72 ++++---- schemes/rrtmgp/rrtmgp_pre_namelist.xml | 12 +- schemes/rrtmgp/rrtmgp_subcycle.F90 | 4 +- schemes/rrtmgp/rrtmgp_subcycle.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_aerosols.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_aerosols.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 | 6 +- .../rrtmgp/rrtmgp_sw_calculate_fluxes.meta | 6 +- .../rrtmgp_sw_calculate_heating_rate.F90 | 2 +- .../rrtmgp_sw_calculate_heating_rate.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 38 ++-- schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta | 61 ++++--- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 10 +- schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 36 ++-- .../rrtmgp/rrtmgp_sw_gas_optics_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta | 4 +- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 6 +- .../rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta | 23 ++- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 2 +- schemes/rrtmgp/rrtmgp_sw_rte.meta | 13 +- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 6 +- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 8 +- schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 | 7 +- schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta | 2 +- schemes/rrtmgp/rrtmgp_variables.F90 | 14 +- schemes/rrtmgp/rrtmgp_variables.meta | 14 +- schemes/rrtmgp/utils/radiation_tools.F90 | 2 +- .../rrtmgp_cloud_optics_setup_namelist.xml | 8 +- .../rrtmgp_cloud_diagnostics.F90 | 3 +- .../rrtmgp_cloud_diagnostics.meta | 2 +- .../sima_diagnostics/rrtmgp_diagnostics.F90 | 8 +- .../rrtmgp_lw_diagnostics.F90 | 6 +- 60 files changed, 494 insertions(+), 504 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 2cf31844..039dacfa 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -5,11 +5,12 @@ ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- module solar_irradiance_data + ! Module not fully portable due to this time coordinate dependency use cam_time_coord, only: time_coordinate use ccpp_kinds, only: kind_phys + use ccpp_io_reader, only: abstract_netcdf_reader_t implicit none - save private public :: solar_irradiance_data_register @@ -17,12 +18,13 @@ module solar_irradiance_data public :: solar_irradiance_data_run type(time_coordinate) :: time_coord + class(abstract_netcdf_reader_t), pointer :: file_reader real(kind_phys), allocatable :: ref_tsi real(kind_phys), public, protected, allocatable :: sol_etf(:) real(kind_phys), public, protected, allocatable :: ssi_ref(:) ! a reference spectrum constructed from 3 solar cycles of data - real(kind_phys), allocatable :: irradi(:,:) real(kind_phys), allocatable :: irrad_fac(:) real(kind_phys), allocatable :: etf_fac(:) + real(kind_phys), allocatable :: lambda(:) logical, protected :: has_ref_spectrum = .false. logical, protected :: has_tsi = .false. logical, protected :: initialized = .false. @@ -36,17 +38,15 @@ module solar_irradiance_data !! \htmlinclude solar_irradiance_data_register.html !! subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg, errflg) - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + use ccpp_io_reader, only: create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path integer, intent(out) :: nbins integer, intent(out) :: nbinsp - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - real(kind_phys), allocatable :: lambda(:) - class(abstract_netcdf_reader_t), pointer :: file_reader integer, parameter :: missing_variable_error_code = 3 character(len=*), parameter :: subname = 'solar_irradiance_data_register: ' @@ -83,8 +83,12 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg errmsg = subname // errmsg return else if (errflg == missing_variable_error_code) then - ! Check old name (for backward compatibility + ! Check old name (for backwards compatibility in CAM) call file_reader%get_var('wvl', lambda, errmsg, errflg) + if (errflg /= 0) then + errmsg = subname // errmsg + return + end if end if ! Close the solar irradiance file @@ -93,8 +97,6 @@ subroutine solar_irradiance_data_register(irrad_file_path, nbins, nbinsp, errmsg errmsg = subname // errmsg return end if - deallocate(file_reader) - nullify(file_reader) if (errflg /= 0) then ! Override the errflg, it's ok if there is no wavelength info on file in some scenarios @@ -112,8 +114,8 @@ end subroutine solar_irradiance_data_register !! subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_data_ymd, solar_data_tod, solar_const, & solar_heating_spectral_scl, speed_of_light, planck_const, nbins, nbinsp, do_spectral_scaling, has_spectrum, sol_tsi, & - we, sol_irrad, errmsg, errflg) - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + wavelength_endpoints, sol_irrad, errmsg, errflg) + use ccpp_io_reader, only: create_netcdf_reader_t ! Arguments character(len=*), intent(in) :: irrad_file_path character(len=*), intent(in) :: solar_data_type @@ -124,13 +126,13 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da real(kind_phys), intent(in) :: speed_of_light real(kind_phys), intent(in) :: planck_const logical, intent(out) :: do_spectral_scaling ! flag to do spectral scaling - logical, intent(out) :: has_spectrum ! flag for whether solar input file has irradiance spectrum + logical, intent(out) :: has_spectrum ! flag for whether solar input file has irradiance spectrum real(kind_phys), intent(out) :: sol_tsi - real(kind_phys), allocatable, intent(out) :: we(:) + real(kind_phys), allocatable, intent(out) :: wavelength_endpoints(:) real(kind_phys), intent(out) :: sol_irrad(:) integer, intent(in) :: nbins integer, intent(in) :: nbinsp - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -139,10 +141,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da real(kind_phys), allocatable :: ssi(:,:) real(kind_phys), allocatable :: ssi_ref(:) real(kind_phys), allocatable :: tsi(:) - real(kind_phys), allocatable :: lambda(:) real(kind_phys), allocatable :: dellam(:) integer, allocatable :: wvl_vid - class(abstract_netcdf_reader_t), pointer :: file_reader integer, parameter :: missing_variable_error_code = 3 character(len=256) :: alloc_errmsg real(kind_phys) :: fac @@ -169,7 +169,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! order to avoid CCPP ! subsetting errors: !------------------ - allocate(we(nbinsp), stat=errflg, errmsg=errmsg) + allocate(wavelength_endpoints(nbinsp), stat=errflg, errmsg=errmsg) if (errflg /= 0) then errmsg = subname // errmsg end if @@ -183,8 +183,6 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da call time_coord%initialize(irrad_file_path, fixed=fixed, fixed_ymd=solar_data_ymd, fixed_tod=solar_data_tod, & force_time_interp=.true., try_dates=.true.) - file_reader => create_netcdf_reader_t() - ! Open the solar irradiance data file call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then @@ -229,18 +227,6 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Read in data if (has_spectrum) then - call file_reader%get_var('wavelength', lambda, errmsg, errflg) - if (errflg /= 0 .and. errflg /= missing_variable_error_code) then - errmsg = subname // errmsg - return - else if (errflg == missing_variable_error_code) then - ! Check old name (for backward compatibility - call file_reader%get_var('wvl', lambda, errmsg, errflg) - if (errflg /= 0) then - errmsg = subname // errmsg - return - end if - end if call file_reader%get_var('band_width', dellam, errmsg, errflg) if (errflg /= 0) then errmsg = subname // errmsg @@ -254,8 +240,6 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da errmsg = subname // errmsg return end if - deallocate(file_reader) - nullify(file_reader) allocate(irrad_fac(nbins), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then @@ -270,9 +254,9 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! Calculate wavelength ends and convert units if ( has_spectrum ) then - allocate(we(nbins+1), stat=errflg, errmsg=alloc_errmsg) + allocate(wavelength_endpoints(nbins+1), stat=errflg, errmsg=alloc_errmsg) if( errflg /= 0 ) then - write(errmsg,*) subname // 'failed to allocate we; error = ', alloc_errmsg + write(errmsg,*) subname // 'failed to allocate wavelength_endpoints; error = ', alloc_errmsg return end if allocate(sol_etf(nbins), stat=errflg, errmsg=alloc_errmsg) @@ -281,8 +265,8 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da return end if - we(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) - we(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) + wavelength_endpoints(:nbins) = lambda(:nbins) - 0.5_kind_phys*dellam(:nbins) + wavelength_endpoints(nbins+1) = lambda(nbins) + 0.5_kind_phys*dellam(nbins) do idx = 1,nbins irrad_fac(idx) = 1.e-3_kind_phys ! mW/m2/nm --> W/m2/nm etf_fac(idx) = 1.e-16_kind_phys*lambda(idx)*fac ! mW/m2/nm --> photons/cm2/sec/nm @@ -295,10 +279,10 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da deallocate(lambda) deallocate(dellam) - ! need to force data loading when the model starts at a time =/ 00:00:00.000 + ! need to force data loading when the host model starts at a time =/ 00:00:00.000 ! -- may occur in restarts also call solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & - sol_irrad, we, sol_tsi, errmsg, errflg) + sol_irrad, wavelength_endpoints, sol_tsi, errmsg, errflg) if (errflg /= 0) then return end if @@ -313,29 +297,28 @@ end subroutine solar_irradiance_data_init !! \htmlinclude solar_irradiance_data_run.html !! subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & - sol_irrad, we, sol_tsi, errmsg, errflg) - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t + sol_irrad, wavelength_endpoints, sol_tsi, errmsg, errflg) ! Arguments character(len=*), intent(in) :: irrad_file_path - real(kind_phys), intent(in) :: we(:) ! wavelength endpoints - integer, intent(in) :: nbins ! number of bins - integer, intent(in) :: nbinsp ! number of bins plus one + real(kind_phys), intent(in) :: wavelength_endpoints(:) ! wavelength endpoints + integer, intent(in) :: nbins ! number of bins + integer, intent(in) :: nbinsp ! number of bins plus one logical, intent(in) :: has_spectrum - logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling - real(kind_phys), intent(out) :: sol_tsi ! total solar irradiance - real(kind_phys), intent(out) :: sol_irrad(:) ! solar irradiance - character(len=512), intent(out) :: errmsg + logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling + real(kind_phys), intent(out) :: sol_tsi ! total solar irradiance + real(kind_phys), intent(out) :: sol_irrad(:) ! solar irradiance + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables integer :: idx, index, nt integer :: offset(2), count(2) integer, allocatable :: itsi(:) + real(kind_phys), allocatable :: irradi(:,:) logical :: read_data real(kind_phys) :: data(nbins) integer :: ierr real(kind_phys) :: delt - class(abstract_netcdf_reader_t), pointer :: file_reader character(len=*), parameter :: subname = 'solar_irradiance_data_run: ' @@ -352,8 +335,6 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru call time_coord%advance() if ( read_data ) then - file_reader => create_netcdf_reader_t() - ! Open the solar irradiance data file call file_reader%open_file(irrad_file_path, errmsg, errflg) if (errflg /= 0) then @@ -392,8 +373,6 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru errmsg = subname // errmsg return end if - deallocate(file_reader) - nullify(file_reader) end if delt = time_coord%wghts(2) @@ -411,10 +390,19 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru sol_tsi = itsi(1) + delt*( itsi(2) - itsi(1) ) end if - if (has_spectrum) then - deallocate(irradi) - end if - end subroutine solar_irradiance_data_run + subroutine solar_irradiance_data_final(errmsg, errflg) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Deallocate the module-level file reader object + deallocate(file_reader) + nullify(file_reader) + + end subroutine solar_irradiance_data_final + end module solar_irradiance_data diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta index 7f1d44a1..8a4289da 100644 --- a/schemes/radiation_utils/solar_irradiance_data.meta +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -1,7 +1,6 @@ [ccpp-table-properties] name = solar_irradiance_data type = scheme - dependencies = ../../../../utils/cam_time_coord.F90 [ccpp-arg-table] name = solar_irradiance_data_register @@ -25,9 +24,9 @@ dimensions = () intent = out [ errmsg ] - standard_name = ccpp_error_messag + standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -53,7 +52,7 @@ dimensions = () intent = in [ solar_data_ymd ] - standard_name = year_month_date_for_solar_irradiance_data + standard_name = year_month_day_for_solar_irradiance_data units = 1 type = integer dimensions = () @@ -71,7 +70,7 @@ dimensions = () intent = in [ solar_heating_spectral_scl ] - standard_name = do_radiation_heating_spectral_scaling + standard_name = do_solar_radiation_heating_spectral_scaling units = flag type = logical dimensions = () @@ -118,7 +117,7 @@ type = real | kind = kind_phys dimensions = () intent = out -[ we ] +[ wavelength_endpoints ] standard_name = wavelength_endpoints units = nm type = real | kind = kind_phys @@ -131,9 +130,9 @@ dimensions = (number_of_wavelength_samples_of_spectrum) intent = out [ errmsg ] - standard_name = ccpp_error_messag + standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -182,7 +181,7 @@ type = real | kind = kind_phys dimensions = (number_of_wavelength_samples_of_spectrum) intent = out -[ we ] +[ wavelength_endpoints ] standard_name = wavelength_endpoints units = nm type = real | kind = kind_phys @@ -197,7 +196,23 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = solar_irradiance_data_final + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/radiation_utils/solar_irradiance_data_namelist.xml b/schemes/radiation_utils/solar_irradiance_data_namelist.xml index 391241ce..65aff254 100644 --- a/schemes/radiation_utils/solar_irradiance_data_namelist.xml +++ b/schemes/radiation_utils/solar_irradiance_data_namelist.xml @@ -95,7 +95,7 @@ type_of_solar_irradiance_data none - The type of solar irradiance data. + The type of solar irradiance data ('FIXED' or 'SERIAL'). FIXED @@ -118,7 +118,7 @@ integer solar_data solar_data - year_month_date_for_solar_irradiance_data + year_month_day_for_solar_irradiance_data 1 YMD for start of fixed solar irradiance data diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 29d57551..206d8353 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -13,7 +13,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, use ccpp_kinds, only: kind_phys type(ccpp_constituent_properties_t), allocatable, intent(out) :: rrtmgp_dyn_consts(:) ! Runtime constituent properties character(len=256), intent(in) :: rad_climate(:) ! (namelist) list of radiatively active gases and sources - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -53,17 +53,26 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, ! Locate the ':' separating source from long name. idx = index(tmpstr, ':') + if (idx == 0) then + errmsg = 'rad_climate namelist variable error: all entries must be of the format "flag:long_name:gas_name". Failed to parse "'//trim(tmpstr)//'"' + errflg = 1 + end if source = tmpstr(:idx-1) tmpstr = tmpstr(idx+1:) ! locate the ':' separating long name from rad gas ("standard") name idx = scan(tmpstr, ':') + if (idx == 0) then + errmsg = 'rad_climate namelist variable error: all entries must be of the format "flag:long_name:gas_name". Failed to parse "'//trim(tmpstr)//'"' + errflg = 1 + end if long_name = tmpstr(:idx-1) stdname = tmpstr(idx+1:) ! Register the constituent based on the source if (source == 'A') then + ! Add advected constituent call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & @@ -76,6 +85,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode = errflg, & errmsg = errmsg) else if (source == 'N') then + ! Add non-advected constituent call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & @@ -88,6 +98,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, errcode = errflg, & errmsg = errmsg) else if (source == 'Z') then + ! Add non-advected constituent set to 0.0 call rrtmgp_dyn_consts(gas_idx)%instantiate( & std_name = stdname, & long_name = long_name, & @@ -118,11 +129,11 @@ subroutine rrtmgp_constituents_run(gaslist, const_array, rad_const_array, errmsg use ccpp_constituent_prop_mod, only: int_unassigned use ccpp_scheme_utils, only: ccpp_constituent_index use ccpp_kinds, only: kind_phys - character(len=5), intent(in) :: gaslist(:) ! Radiatively active gas list + character(len=*), intent(in) :: gaslist(:) ! Radiatively active gas list real(kind_phys), intent(in) :: const_array(:,:,:) ! Constituents array real(kind_phys), intent(out) :: rad_const_array(:,:,:) ! Radiatively active constituent mixing ratios integer, intent(out) :: errflg - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg ! Local variables integer :: gas_idx diff --git a/schemes/rrtmgp/rrtmgp_constituents.meta b/schemes/rrtmgp/rrtmgp_constituents.meta index 5267b580..6069d87d 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.meta +++ b/schemes/rrtmgp/rrtmgp_constituents.meta @@ -21,7 +21,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -36,7 +36,7 @@ [ gaslist ] standard_name = list_of_active_gases_for_RRTMGP units = none - type = character | kind = len=5 + type = character | kind = len=* dimensions = (gaslist_dimension) intent = in [ const_array ] @@ -54,7 +54,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index edf88fc3..9c7a04d3 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -10,14 +10,14 @@ module rrtmgp_inputs !! \htmlinclude rrtmgp_inputs_run.html !! subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & - pmid, pint, t, nday, idxday, cldfprime, coszrs, kdist_sw, & - t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, t_day, pmid_day, & - pint_day, coszrs_day, alb_dir, alb_dif, lwup, stebol, ncol, & - ktopcam, ktoprad, nswbands, asdir, asdif, sw_low_bounds, & - sw_high_bounds, aldir, aldif, nlay, pverp, pver, cld, & - cldfsnow, cldfgrau, graupel_in_rad, gasnamelength, & - gaslist_lc, gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & - sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, errmsg, errflg) + pmid, pint, t, nday, idxday, coszrs, kdist_sw, kdist_lw, & + lwup, stebol, ncol, ktopcam, ktoprad, nswbands, asdir, asdif,& + sw_low_bounds, sw_high_bounds, aldir, aldif, nlay, pverp, & + pver, cld, cldfsnow, cldfgrau, graupel_in_rad, gaslist_lc, & + cldfprime, t_sfc, emis_sfc, t_rad, pmid_rad, pint_rad, t_day,& + pmid_day, pint_day, coszrs_day, alb_dir, alb_dif, gas_concs_lw, & + aer_lw, atm_optics_lw, sources_lw, aer_sw, atm_optics_sw, & + gas_concs_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp @@ -34,7 +34,6 @@ subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & integer, intent(in) :: nswbands ! Number of shortwave bands integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: gasnamelength ! Length of gases in gas_list integer, intent(in) :: nday ! Number of daylight columns logical, intent(in) :: dosw ! Flag for performing the shortwave calculation logical, intent(in) :: dolw ! Flag for performing the longwave calculation @@ -81,7 +80,7 @@ subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & type(ty_gas_concs_ccpp), intent(out) :: gas_concs_sw ! Gas concentrations object for shortwave radiation type(ty_optical_props_2str_ccpp), intent(out) :: atm_optics_sw ! Atmosphere optical properties object for shortwave radiation type(ty_optical_props_2str_ccpp), intent(out) :: aer_sw ! Aerosol optical properties object for shortwave radiation - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_inputs.meta b/schemes/rrtmgp/rrtmgp_inputs.meta index a61777f2..5844ec45 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.meta +++ b/schemes/rrtmgp/rrtmgp_inputs.meta @@ -54,23 +54,17 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) intent = in -[ cldfprime ] - standard_name = modified_cloud_area_fraction_for_RRTMGP - units = fraction - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = out [ coszrs ] standard_name = cosine_of_solar_zenith_angle_for_radiation units = 1 @@ -83,72 +77,12 @@ type = ty_gas_optics_rrtmgp_ccpp dimensions = () intent = in -[ t_sfc ] - standard_name = ground_temperature_at_surface_for_radiation - units = K - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) - intent = out -[ emis_sfc ] - standard_name = longwave_emissivity_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) - intent = out -[ t_rad ] - standard_name = air_temperature_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) - intent = out -[ pmid_rad ] - standard_name = air_pressure_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) - intent = out -[ pint_rad ] - standard_name = air_pressure_at_interface_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP_plus_one) - intent = out -[ t_day ] - standard_name = air_temperature_for_daytime_points_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) - intent = out -[ pmid_day ] - standard_name = air_pressure_for_daytime_points_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) - intent = out -[ pint_day ] - standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) - intent = out -[ coszrs_day ] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep - units = rad - type = real | kind = kind_phys - dimensions = (daytime_points_dimension) - intent = out -[ alb_dir ] - standard_name = albedo_direct_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) - intent = out -[ alb_dif ] - standard_name = albedo_diffused_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) - intent = out +[ kdist_lw ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = in [ lwup ] standard_name = longwave_upward_radiative_flux_at_surface_from_coupler units = W m-2 @@ -263,18 +197,84 @@ type = logical dimensions = () intent = in -[ gasnamelength ] - standard_name = character_length_of_list_of_active_gases_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in [ gaslist_lc ] standard_name = lowercase_list_of_active_gases_for_RRTMGP units = none type = character | kind = len=* dimensions = (number_of_active_gases_for_RRTMGP) intent = in +[ cldfprime ] + standard_name = modified_cloud_area_fraction_for_RRTMGP + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ t_sfc ] + standard_name = ground_temperature_at_surface_for_radiation + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ emis_sfc ] + standard_name = longwave_emissivity_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) + intent = out +[ t_rad ] + standard_name = air_temperature_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) + intent = out +[ pmid_rad ] + standard_name = air_pressure_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, number_of_vertical_layers_in_RRTMGP) + intent = out +[ pint_rad ] + standard_name = air_pressure_at_interface_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, number_of_vertical_interfaces_in_RRTMGP) + intent = out +[ t_day ] + standard_name = air_temperature_for_daytime_columns_for_RRTMGP + units = K + type = real | kind = kind_phys + dimensions = (daytime_columns_dimension, number_of_vertical_layers_in_RRTMGP) + intent = out +[ pmid_day ] + standard_name = air_pressure_for_daytime_columns_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_columns_dimension, number_of_vertical_layers_in_RRTMGP) + intent = out +[ pint_day ] + standard_name = air_pressure_at_interface_for_daytime_columns_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_columns_dimension, number_of_vertical_interfaces_in_RRTMGP) + intent = out +[ coszrs_day ] + standard_name = cosine_of_solar_zenith_angle_for_daytime_columns_on_radiation_timestep + units = rad + type = real | kind = kind_phys + dimensions = (daytime_columns_dimension) + intent = out +[ alb_dir ] + standard_name = albedo_direct_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_columns_dimension) + intent = out +[ alb_dif ] + standard_name = albedo_diffused_at_surface + units = fraction + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,daytime_columns_dimension) + intent = out [ gas_concs_lw ] standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP units = none @@ -293,12 +293,6 @@ type = ty_optical_props_1scl_ccpp dimensions = () intent = out -[ kdist_lw ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = in [ sources_lw ] standard_name = longwave_planck_sources_object_for_RRTMGP units = none @@ -327,7 +321,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 9295db39..510517b9 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -9,12 +9,12 @@ module rrtmgp_inputs_setup !> \section arg_table_rrtmgp_inputs_setup_init Argument Table !! \htmlinclude rrtmgp_inputs_setup_init.html !! - subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & - pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & - timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, & - p_top_for_rrtmgp, nlwbands, nradgas, gasnamelength, idx_sw_diag, idx_nir_diag, idx_uv_diag, & - idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, changeseed, nlayp, & - nextsw_cday, current_cal_day, band2gpt_sw, irad_always_out, errmsg, errflg) + subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, pver, pverp, kdist_sw, & + kdist_lw, qrl, is_first_step, use_rad_dt_cosz, timestep_size, nstep, iradsw, dt_avg, & + irad_always, is_first_restar_step, p_top_for_rrtmgp, nradgas, gasnamelength, current_cal_day, & + ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, changeseed, & + nlay, nlayp, nextsw_cday, band2gpt_sw, irad_always_out, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp @@ -62,7 +62,7 @@ subroutine rrtmgp_inputs_setup_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands real(kind_phys), dimension(:,:), intent(inout) :: qrl ! Longwave radiative heating - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer, intent(out) :: irad_always_out ! Number of time steps to execute radiation continuously real(kind_phys), intent(out) :: dt_avg ! averaging time interval for zenith angle diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index a0d16d55..a2b8b4f1 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -6,38 +6,14 @@ [ccpp-arg-table] name = rrtmgp_inputs_setup_init type = scheme -[ ktopcam ] - standard_name = vertical_index_at_top_level_where_RRTMGP_is_active - units = index - type = integer - dimensions = () - intent = out -[ ktoprad ] - standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active - units = index - type = integer - dimensions = () - intent = out -[ nlaycam ] - standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels +[ nswbands ] + standard_name = number_of_bands_for_shortwave_radiation units = count type = integer dimensions = () - intent = out -[ sw_low_bounds ] - standard_name = min_shortwave_wavenumber_per_band - units = cm-1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation) - intent = out -[ sw_high_bounds ] - standard_name = max_shortwave_wavenumber_per_band - units = cm-1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation) - intent = out -[ nswbands ] - standard_name = number_of_bands_for_shortwave_radiation + intent = in +[ nlwbands ] + standard_name = number_of_bands_for_longwave_radiation units = count type = integer dimensions = () @@ -48,12 +24,6 @@ type = real | kind = kind_phys dimensions = (vertical_interface_dimension) intent = in -[ nlay ] - standard_name = number_of_vertical_layers_in_RRTMGP - units = count - type = integer - dimensions = () - intent = out [ pver ] standard_name = vertical_layer_dimension units = count @@ -138,12 +108,6 @@ type = real | kind = kind_phys dimensions = () intent = in -[ nlwbands ] - standard_name = number_of_bands_for_longwave_radiation - units = count - type = integer - dimensions = () - intent = in [ nradgas ] standard_name = number_of_active_gases_for_RRTMGP units = count @@ -156,6 +120,42 @@ type = integer dimensions = () intent = in +[ current_cal_day ] + standard_name = fractional_calendar_days_on_end_of_current_timestep + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ ktopcam ] + standard_name = vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ ktoprad ] + standard_name = RRTMGP_vertical_index_at_top_level_where_RRTMGP_is_active + units = index + type = integer + dimensions = () + intent = out +[ nlaycam ] + standard_name = number_of_vertical_layers_in_RRTMGP_coinciding_with_CAM_levels + units = count + type = integer + dimensions = () + intent = out +[ sw_low_bounds ] + standard_name = min_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out +[ sw_high_bounds ] + standard_name = max_shortwave_wavenumber_per_band + units = cm-1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation) + intent = out [ idx_sw_diag ] standard_name = index_of_shortwave_band units = index @@ -210,8 +210,14 @@ type = integer dimensions = () intent = out +[ nlay ] + standard_name = number_of_vertical_layers_in_RRTMGP + units = count + type = integer + dimensions = () + intent = out [ nlayp ] - standard_name = number_of_vertical_layers_in_RRTMGP_plus_one + standard_name = number_of_vertical_interfaces_in_RRTMGP units = count type = integer dimensions = () @@ -222,12 +228,6 @@ type = real | kind = kind_phys dimensions = () intent = out -[ current_cal_day ] - standard_name = fractional_calendar_days_on_end_of_current_timestep - units = 1 - type = real | kind = kind_phys - dimensions = () - intent = in [ band2gpt_sw ] standard_name = shortwave_start_and_end_gpoint_for_each_band units = index @@ -244,7 +244,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 index 1f9621a6..4078204a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_aerosols.F90 @@ -1,7 +1,7 @@ !> \file rrtmgp_lw_aerosols.F90 !! -!> This module contains the call to the RRTMGP-lw radiation routine +!> This module sets the RRTMGP aerosol longwave optical depth module rrtmgp_lw_aerosols implicit none private diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index 13990a35..0391703b 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -3,7 +3,6 @@ module rrtmgp_lw_calculate_fluxes use ccpp_kinds, only: kind_phys implicit none private - save public :: rrtmgp_lw_calculate_fluxes_run ! main routine @@ -39,7 +38,7 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! CCPP error handling variables - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta index 4bd967a3..1d91c99a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.meta @@ -98,7 +98,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 index 4a109e44..309aa64a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -15,7 +15,7 @@ subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, fl real(kind_phys), intent(in) :: flux_net_clrsky(:,:) ! Longwave net radiative clear-sky flux [W m-2] real(kind_phys), intent(out) :: hrate(:,:) ! Tendency of dry air enthalpy due to LW radiation [J kg-1 s-1] real(kind_phys), intent(out) :: hrate_clrsky(:,:) ! Tendency of dry air enthalpy due to clear-sky LW radiation [J kg-1 s-1] - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: k diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta index 0209a089..8a49a94a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.meta @@ -56,7 +56,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index 0bc8b46b..b0e2a760 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -20,9 +20,9 @@ module rrtmgp_lw_cloud_optics !! \htmlinclude rrtmgp_lw_cloud_optics_run.html !! subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, cld, cldfsnow, cldfgrau, & - cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, tiny_in, dei, icswpth, & - des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, ktopcam, cld_lw_abs, & - snow_lw_abs, grau_lw_abs, c_cld_lw_abs, errmsg, errflg) + cldfprime, kdist_lw, lamc, pgam, iclwpth, iciwpth, tiny_in, dei, icswpth, & + des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, ktopcam, & + cloud_lw, cld_lw_abs, snow_lw_abs, grau_lw_abs, c_cld_lw_abs, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp use ccpp_kinds, only: kind_phys @@ -63,7 +63,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, cld, cldfsnow, cldfgrau, real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) real(kind_phys), dimension(:,:,:), intent(out) :: c_cld_lw_abs - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta index e2f3e533..5e62ae1c 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.meta @@ -2,7 +2,6 @@ name = rrtmgp_lw_cloud_optics type = scheme dependencies = ext/rte-kernels/mo_optical_props_kernels.F90 - dependencies = ../../../../utils/interpolate_data.F90 [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_run @@ -29,25 +28,25 @@ standard_name = cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfsnow ] standard_name = liquid_plus_snow_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfgrau ] standard_name = liquid_plus_graupel_stratiform_cloud_area_fraction units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ cldfprime ] standard_name = modified_cloud_area_fraction_for_RRTMGP units = fraction type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ kdist_lw ] standard_name = longwave_gas_optics_object_for_RRTMGP @@ -55,35 +54,29 @@ type = ty_gas_optics_rrtmgp_ccpp dimensions = () intent = in -[ cloud_lw ] - standard_name = longwave_cloud_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_1scl_ccpp - dimensions = () - intent = out [ lamc ] standard_name = slope_of_droplet_distribution_for_optics units = 1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ pgam ] standard_name = size_distribution_shape_parameter_for_microphysics units = 1 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ iclwpth ] standard_name = in_cloud_liquid_water_path_for_radiation units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ iciwpth ] - standard_name = cloud_ice_water_path + standard_name = in_cloud_ice_water_path units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ tiny_in ] standard_name = definition_of_tiny_for_RRTMGP @@ -93,33 +86,33 @@ intent = in [ dei ] standard_name = effective_diameter_of_stratiform_cloud_ice_particle_for_radiation - units = micron + units = um type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ icswpth ] - standard_name = cloud_snow_water_path + standard_name = in_cloud_snow_water_path units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ des ] standard_name = effective_diameter_of_stratiform_snow_particle_for_radiation - units = micron + units = um type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ icgrauwpth ] standard_name = stratiform_in_cloud_graupel_water_path units = kg m-2 type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ degrau ] standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation units = m type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ nlwbands ] standard_name = number_of_bands_for_longwave_radiation @@ -151,23 +144,29 @@ type = integer dimensions = () intent = in +[ cloud_lw ] + standard_name = longwave_cloud_optical_properties_object_for_RRTMGP + units = none + type = ty_optical_props_1scl_ccpp + dimensions = () + intent = out [ cld_lw_abs ] standard_name = in_cloud_longwave_liquid_plus_ice_optical_depth units = 1 type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ snow_lw_abs ] standard_name = in_cloud_longwave_snow_optical_depth units = 1 type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ grau_lw_abs ] standard_name = in_cloud_longwave_graupel_optical_depth units = 1 type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent, vertical_layer_dimension) + dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ c_cld_lw_abs ] standard_name = combined_longwave_cloud_absorption_optical_depth @@ -179,7 +178,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 0bf815e8..5388b60f 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -15,9 +15,9 @@ module rrtmgp_lw_gas_optics !> \section arg_table_rrtmgp_lw_gas_optics_init Argument Table !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! - subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & + subroutine rrtmgp_lw_gas_optics_init(lw_filename, available_gases, kdist, & errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg @@ -30,7 +30,7 @@ subroutine rrtmgp_lw_gas_optics_init(kdist, lw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object - character(len=512), intent(out) :: errmsg ! CCPP error message + character(len=*), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errflg ! CCPP error code ! Local variables @@ -318,7 +318,7 @@ end subroutine rrtmgp_lw_gas_optics_init subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp @@ -341,7 +341,7 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 162f26cd..c25d0553 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -7,12 +7,6 @@ [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init type = scheme -[ kdist ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = out [ lw_filename ] standard_name = filename_of_rrtmgp_longwave_k_distribution units = none @@ -20,15 +14,21 @@ dimensions = () intent = in [ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + standard_name = gas_volume_mixing_ratios_object_for_RRTMGP units = none type = ty_gas_concs_ccpp dimensions = () intent = in +[ kdist ] + standard_name = longwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = out [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -75,7 +75,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_plus_one) + dimensions = (horizontal_loop_extent,number_of_vertical_interfaces_in_RRTMGP) intent = in [ t_lay ] standard_name = air_temperature_for_RRTMGP @@ -129,7 +129,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml index 4473a504..e0d65438 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_namelist.xml @@ -82,7 +82,7 @@ filename_of_rrtmgp_longwave_k_distribution none - The filename of the longwave coefficients file for RRTMGP + The path and filename of the longwave coefficients file for RRTMGP ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-lw-g128.nc diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index 7b9a3c52..5ab32ca8 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -31,7 +31,7 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, ! last index corresponds to index in gaslist type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta index e0caf522..c6f81326 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.meta @@ -81,7 +81,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 1d7bb335..1b624a7c 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -73,7 +73,7 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & real(kind_phys), dimension(:,:), intent(in) :: cldfprime real(kind_phys), dimension(:,:,:), intent(in) :: c_cld_lw_abs type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta index 678b70d2..e5589a1d 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.meta @@ -1,7 +1,6 @@ [ccpp-table-properties] name = rrtmgp_lw_mcica_subcol_gen type = scheme - dependencies = ../../../../../share/RandNum/src/shr_RandNum_mod.F90 [ccpp-arg-table] name = rrtmgp_lw_mcica_subcol_gen_run @@ -94,7 +93,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index 4623fc73..f70919db 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -16,7 +16,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, nGauss_angles, lw_optical_props_clrsky, lw_optical_props_clouds, & sources, sfc_emiss_byband, lw_gas_props, aerlw, fluxlwUP_jac, lw_Ds, & flux_clrsky, flux_allsky, errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use mo_rte_lw, only: rte_lw use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp use ccpp_optical_props, only: ty_optical_props_1scl_ccpp @@ -48,7 +48,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point - character(len=512),intent(out) :: errmsg !< CCPP error message + character(len=*), intent(out) :: errmsg !< CCPP error message integer, intent(out) :: errflg !< CCPP error flag ! Initialize CCPP error handling variables diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index 9fd03ca7..c0fa00dd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -7,7 +7,6 @@ dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = ../../../../utils/machine.F90 dependencies = utils/radiation_tools.F90 dependencies = objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 dependencies = objects/ccpp_optical_props.F90 @@ -117,7 +116,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 index bd448b77..ae150c8f 100644 --- a/schemes/rrtmgp/rrtmgp_post.F90 +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -38,7 +38,7 @@ subroutine rrtmgp_post_run(nlay, dolw, qrs_prime, qrl_prime, fsns, pdel, atm_opt real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] real(kind_phys), dimension(:), intent(inout) :: flwds ! Down longwave flux at surface [W m-2] - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Set error varaibles diff --git a/schemes/rrtmgp/rrtmgp_post.meta b/schemes/rrtmgp/rrtmgp_post.meta index 24003894..55a7a2f8 100644 --- a/schemes/rrtmgp/rrtmgp_post.meta +++ b/schemes/rrtmgp/rrtmgp_post.meta @@ -135,7 +135,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 index 80772179..82820574 100644 --- a/schemes/rrtmgp/rrtmgp_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -16,10 +16,10 @@ subroutine rrtmgp_pre_init(nradgas, available_gases, gaslist, gaslist_lc, errmsg use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use atmos_phys_string_utils, only: to_lower integer, intent(in) :: nradgas ! Number of radiatively active gases - type(ty_gas_concs_ccpp), intent(out) :: available_gases ! Gas concentrations object character(len=5), intent(in) :: gaslist(:) ! Radiatively active gas list + type(ty_gas_concs_ccpp), intent(out) :: available_gases ! Gas concentrations object character(len=5), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -61,7 +61,7 @@ subroutine rrtmgp_pre_timestep_init(ncol, coszrs, nstep, dtime, iradsw, irad_alw integer, intent(out) :: idxnite(:) ! Indices of nighttime columns integer, intent(out) :: offset ! Offset for next SW radiation timestep integer, intent(out) :: errflg - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg logical :: dosw_next integer :: nstepsw_next, idx @@ -99,9 +99,9 @@ end subroutine rrtmgp_pre_timestep_init !! \htmlinclude rrtmgp_pre_run.html !! subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & - next_cday, idxday, nday, idxnite, nnite, dosw, dolw, dosw_heat, dolw_heat, & - nlay, nlwbands, nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, & - errmsg, errflg) + next_cday, idxday, nday, idxnite, nnite, nlay, nlwbands, nswbands, & + spectralflux, nextsw_cday, dosw, dolw, dosw_heat, dolw_heat, fsw, & + fswc, flw, flwc, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_fluxes, only: ty_fluxes_broadband_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp @@ -117,6 +117,10 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco integer, intent(in) :: nlay ! Number of vertical layers integer, intent(in) :: nlwbands ! Number of longwave bands integer, intent(in) :: nswbands ! Number of shortwave bands + integer, intent(in) :: nday ! Number of daylight columns + integer, intent(in) :: nnite ! Number of nighttime columns + integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(in) :: idxnite ! Indices of nighttime columns logical, intent(in) :: spectralflux ! Flag to calculate fluxes (up and down) per band ! Outputs real(kind_phys), intent(inout) :: nextsw_cday ! The next calendar day during which calculation will be performed @@ -124,15 +128,11 @@ subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, nco class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object - integer, intent(in) :: nday ! Number of daylight columns - integer, intent(in) :: nnite ! Number of nighttime columns - integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns - integer, dimension(:), intent(in) :: idxnite ! Indices of nighttime columns logical, intent(out) :: dosw ! Flag to do shortwave calculation logical, intent(out) :: dolw ! Flag to do longwave calculation logical, intent(out) :: dosw_heat ! Flag to calculate net shortwave heating logical, intent(out) :: dolw_heat ! Flag to calculate net longwave heating - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 94acf451..5689fab2 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -13,7 +13,7 @@ dimensions = () intent = in [ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + standard_name = gas_volume_mixing_ratios_object_for_RRTMGP units = none type = ty_gas_concs_ccpp dimensions = () @@ -34,7 +34,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -91,25 +91,25 @@ dimensions = () intent = out [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_dimension) intent = out [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = out [ idxnite ] - standard_name = nighttime_points + standard_name = nighttime_columns units = index type = integer dimensions = (horizontal_dimension) intent = out [ nnite ] - standard_name = nighttime_points_dimension + standard_name = nighttime_columns_dimension units = count type = integer dimensions = () @@ -119,7 +119,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -183,53 +183,29 @@ dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ idxnite ] - standard_name = nighttime_points + standard_name = nighttime_columns units = index type = integer dimensions = (horizontal_loop_extent) intent = in [ nnite ] - standard_name = nighttime_points_dimension + standard_name = nighttime_columns_dimension units = count type = integer dimensions = () intent = in -[ dosw ] - standard_name = do_shortwave_radiation - units = flag - type = logical - dimensions = () - intent = out -[ dolw ] - standard_name = do_longwave_radiation - units = flag - type = logical - dimensions = () - intent = out -[ dosw_heat ] - standard_name = calculate_net_shortwave_heating - units = flag - type = logical - dimensions = () - intent = out -[ dolw_heat ] - standard_name = calculate_net_longwave_heating - units = flag - type = logical - dimensions = () - intent = out [ nlay ] standard_name = number_of_vertical_layers_in_RRTMGP units = count @@ -260,6 +236,30 @@ type = real | kind = kind_phys dimensions = () intent = inout +[ dosw ] + standard_name = do_shortwave_radiation + units = flag + type = logical + dimensions = () + intent = out +[ dolw ] + standard_name = do_longwave_radiation + units = flag + type = logical + dimensions = () + intent = out +[ dosw_heat ] + standard_name = calculate_net_shortwave_heating + units = flag + type = logical + dimensions = () + intent = out +[ dolw_heat ] + standard_name = calculate_net_longwave_heating + units = flag + type = logical + dimensions = () + intent = out [ fsw ] standard_name = shortwave_all_sky_flux_object_for_RRTMGP units = none @@ -288,7 +288,7 @@ standard_name = ccpp_error_message long_name = Error message for error handling in CCPP units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_pre_namelist.xml b/schemes/rrtmgp/rrtmgp_pre_namelist.xml index 55ec7978..61f13b1e 100644 --- a/schemes/rrtmgp/rrtmgp_pre_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_pre_namelist.xml @@ -160,7 +160,7 @@ compute_optimal_angles_for_use_in_RRTMGP_longwave_calculation flag - If true, use compute and use optimal angles for RRTMGP longwave + If true, compute and use optimal angles for RRTMGP longwave .false. @@ -173,7 +173,7 @@ number_of_gaussian_quadrature_angles_for_radiation count - The number of Gaussian quadrature angles for use in radiation - if less than zero, unused + The number of Gaussian quadrature angles for use in radiation - if less than one, unused 0 @@ -225,7 +225,7 @@ do_calculate_radiative_effect_of_graupel flag - Flag to use graupel cloud fraction in radiation + If true, use graupel cloud fraction in radiation .false. @@ -293,10 +293,10 @@ Top pressure level for RRTMGP Default: 1.0 for WACCM/WACCMX - 10. for all other CAM runs + 5. for all other CAM runs - 2.0D0 + 5.0D0 @@ -306,7 +306,7 @@ do_trick_rrtmgp flag - Flag to do RRTMGP level trickery + If true, trick RRTMGP into using top pressure levels below the standard default. .true. diff --git a/schemes/rrtmgp/rrtmgp_subcycle.F90 b/schemes/rrtmgp/rrtmgp_subcycle.F90 index 9b91c56d..b5b908a8 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.F90 +++ b/schemes/rrtmgp/rrtmgp_subcycle.F90 @@ -13,7 +13,7 @@ module rrtmgp_subcycle !! subroutine rrtmgp_subcycle_init(diag_cur, errmsg, errflg) integer, intent(out) :: diag_cur ! Current diagnostic subcycle - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg errmsg = '' @@ -27,7 +27,7 @@ end subroutine rrtmgp_subcycle_init subroutine rrtmgp_subcycle_run(diag_cur, num_diag_cycles, errmsg, errflg) integer, intent(in) :: num_diag_cycles ! Number of diagnostic subcycles integer, intent(inout) :: diag_cur ! Current diagnostic subcycle - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg errmsg = '' diff --git a/schemes/rrtmgp/rrtmgp_subcycle.meta b/schemes/rrtmgp/rrtmgp_subcycle.meta index 5427d08d..6fa4ac12 100644 --- a/schemes/rrtmgp/rrtmgp_subcycle.meta +++ b/schemes/rrtmgp/rrtmgp_subcycle.meta @@ -14,7 +14,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -41,7 +41,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 index 9e43e6cc..5f72395c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.F90 @@ -1,7 +1,7 @@ !> \file rrtmgp_sw_aerosols.F90 !! -!> This module contains the call to the RRTMGP-sw radiation routine +!> This module sets the RRTMGP aerosol shortwave optical properties module rrtmgp_sw_aerosols implicit none private diff --git a/schemes/rrtmgp/rrtmgp_sw_aerosols.meta b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta index d4246e82..f9736f22 100644 --- a/schemes/rrtmgp/rrtmgp_sw_aerosols.meta +++ b/schemes/rrtmgp/rrtmgp_sw_aerosols.meta @@ -12,7 +12,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 index 8156eead..827d13f9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 @@ -3,7 +3,6 @@ module rrtmgp_sw_calculate_fluxes use ccpp_kinds, only: kind_phys implicit none private - save public :: rrtmgp_sw_calculate_fluxes_run ! main routine @@ -44,7 +43,7 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! CCPP error handling variables - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -91,6 +90,8 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp ! Calculate diffuse flux from total and direct flux_dn_diffuse = fsw%fluxes%bnd_flux_dn - fsw%fluxes%bnd_flux_dn_dir + ! The following calculations are hard-coded and will need to be modified + ! if the RRTMGP flux bands type/array ever changes do idx = 1, nday soll(idxday(idx)) = sum(fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,1:9)) & + 0.5_kind_phys * fsw%fluxes%bnd_flux_dn_dir(idx,nlay+1,10) @@ -104,6 +105,7 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp solsd(idxday(idx)) = 0.5_kind_phys * flux_dn_diffuse(idx, nlay+1, 10) & + sum(flux_dn_diffuse(idx,nlay+1,11:14)) end do + end subroutine rrtmgp_sw_calculate_fluxes_run end module rrtmgp_sw_calculate_fluxes diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta index f9ef4824..709d48ec 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.meta @@ -36,13 +36,13 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) @@ -128,7 +128,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 index 69f4e229..bc1d7114 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.F90 @@ -15,7 +15,7 @@ subroutine rrtmgp_sw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, fl real(kind_phys), intent(in) :: flux_net_clrsky(:,:) ! Shortwave net radiative clear-sky flux [W m-2] real(kind_phys), intent(out) :: hrate(:,:) ! Tendency of dry air enthalpy due to SW radiation [J kg-1 s-1] real(kind_phys), intent(out) :: hrate_clrsky(:,:) ! Tendency of dry air enthalpy due to SW clear-sky radiation [J kg-1 s-1] - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: k diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta index e4c21d78..c046966e 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_heating_rate.meta @@ -56,7 +56,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index 93c2ac94..cfaa2a68 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -1,12 +1,6 @@ !> \file rrtmgp_sw_cloud_optics.F90 !! module rrtmgp_sw_cloud_optics - use ccpp_kinds, only: kind_phys - use rrtmgp_cloud_optics_setup, only: g_lambda, g_mu, nmu, nlambda - use rrtmgp_cloud_optics_setup, only: g_d_eff, n_g_d - use rrtmgp_cloud_optics_setup, only: ext_sw_liq, ext_sw_ice - use rrtmgp_cloud_optics_setup, only: asm_sw_liq, asm_sw_ice - use rrtmgp_cloud_optics_setup, only: ssa_sw_liq, ssa_sw_ice !-------------------------------------------------------------------------------- ! Transform data for inputs from CAM's data structures to those used by @@ -36,15 +30,16 @@ module rrtmgp_sw_cloud_optics !! \htmlinclude rrtmgp_sw_cloud_optics_run.html !! subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nswgpts, nday, idxday, fillvalue, & - nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, cld_tau, grau_tau, & - snow_tau, degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, idx_sw_diag, do_graupel, & - do_snow, kdist_sw, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, tot_cld_vistau, tot_icld_vistau, & - liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) + nswbands, iulog, pgam, lamc, nnite, idxnite, cld, cldfsnow, cldfgrau, cldfprime, & + degrau, dei, des, iclwpth, iciwpth, icswpth, icgrauwpth, tiny_in, idx_sw_diag, do_graupel, & + do_snow, kdist_sw, cld_tau, grau_tau, snow_tau, c_cld_tau, c_cld_tau_w, c_cld_tau_w_g, tot_cld_vistau, & + tot_icld_vistau, liq_icld_vistau, ice_icld_vistau, snow_icld_vistau, grau_icld_vistau, errmsg, errflg) use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp use rrtmgp_cloud_optics_setup, only: g_mu, g_lambda, nmu, nlambda, g_d_eff, n_g_d use rrtmgp_cloud_optics_setup, only: ext_sw_liq, asm_sw_liq, ssa_sw_liq use rrtmgp_cloud_optics_setup, only: ext_sw_ice, asm_sw_ice, ssa_sw_ice + use ccpp_kinds, only: kind_phys ! Compute combined cloud optical properties. @@ -71,9 +66,9 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nswgp real(kind_phys), intent(in) :: lamc(:,:) ! Prognosed value of lambda for cloud [1] real(kind_phys), intent(in) :: pgam(:,:) ! Prognosed value of mu for cloud [1] - real(kind_phys), intent(in) :: dei(:,:) ! Mean effective radius for ice cloud [micron] - real(kind_phys), intent(in) :: des(:,:) ! Mean effective radius for snow [micron] - real(kind_phys), intent(in) :: degrau(:,:) ! Mean effective radius for graupel [micron] + real(kind_phys), intent(in) :: dei(:,:) ! Mean effective radius for ice cloud [um] + real(kind_phys), intent(in) :: des(:,:) ! Mean effective radius for snow [um] + real(kind_phys), intent(in) :: degrau(:,:) ! Mean effective radius for graupel [um] real(kind_phys), intent(in) :: iclwpth(:,:) ! In-cloud liquid water path [kg m-2] real(kind_phys), intent(in) :: iciwpth(:,:) ! In-cloud ice water path [kg m-2] real(kind_phys), intent(in) :: icswpth(:,:) ! In-cloud snow water path [kg m-2] @@ -100,7 +95,7 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nswgp real(kind_phys), intent(out) :: grau_icld_vistau(:,:) ! Graupel in-cloud visible sw optical depth ! Error variables - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -259,6 +254,7 @@ end subroutine rrtmgp_sw_cloud_optics_run subroutine get_grau_optics_sw(ncol, pver, nswbands, tiny_in, g_d_eff, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & iulog, icgrauwpth, degrau, idx_sw_diag, tau, tau_w, tau_w_g, tau_w_f) + use ccpp_kinds, only: kind_phys integer, intent(in) :: ncol integer, intent(in) :: pver @@ -298,7 +294,9 @@ end subroutine get_grau_optics_sw !============================================================================== subroutine get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_sw_liq, ssa_sw_liq, lamc, pgam, g_lambda, & - g_mu, iclwpth, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) + g_mu, iclwpth, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) + use ccpp_kinds, only: kind_phys + integer, intent(in) :: ncol integer, intent(in) :: pver integer, intent(in) :: nswbands @@ -316,7 +314,7 @@ subroutine get_liquid_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_liq, asm_s real(kind_phys), intent(out) :: tau_w (:,:,:) ! single scattering albedo * tau real(kind_phys), intent(out) :: tau_w_g(:,:,:) ! asymmetry parameter * tau * w real(kind_phys), intent(out) :: tau_w_f(:,:,:) ! forward scattered fraction * tau * w - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind_phys), dimension(ncol,pver) :: kext @@ -343,6 +341,7 @@ end subroutine get_liquid_optics_sw subroutine interpolate_ice_optics_sw(ncol, pver, nswbands, tiny_in, ext_sw_ice, asm_sw_ice, ssa_sw_ice, & iciwpth, dei, g_d_eff, tau, tau_w, tau_w_g, tau_w_f) + use ccpp_kinds, only: kind_phys ! SIMA-specific interpolation routines use interpolate_data, only: interp_type, lininterp, lininterp_init, lininterp_finish, extrap_method_bndry @@ -406,9 +405,10 @@ end subroutine interpolate_ice_optics_sw subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_liq, ssa_sw_liq, clwptn, lamc, pgam, tau, tau_w, tau_w_g, tau_w_f, errmsg, errflg) ! SIMA-specific interpolation routines - use interpolate_data, only: interp_type, lininterp, lininterp_finish - use radiation_utils, only: get_mu_lambda_weights_ccpp + use interpolate_data, only: interp_type, lininterp, lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp use rrtmgp_cloud_optics_setup, only: nmu, nlambda + use ccpp_kinds, only: kind_phys integer, intent(in) :: nswbands real(kind_phys), intent(in) :: tiny_in @@ -422,7 +422,7 @@ subroutine gam_liquid_sw(nswbands, tiny_in, g_lambda, g_mu, ext_sw_liq, asm_sw_l real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) [kg m-2] real(kind_phys), intent(out) :: tau(:), tau_w(:), tau_w_f(:), tau_w_g(:) - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: swband ! sw band index diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta index 9798b68a..46277111 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.meta @@ -1,7 +1,6 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_optics type = scheme - dependencies = ../../../../utils/interpolate_data.F90 [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_run @@ -43,13 +42,13 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) @@ -85,13 +84,13 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ nnite ] - standard_name = nighttime_points_dimension + standard_name = nighttime_columns_dimension units = count type = integer dimensions = () intent = in [ idxnite ] - standard_name = nighttime_points + standard_name = nighttime_columns units = index type = integer dimensions = (horizontal_loop_extent) @@ -120,24 +119,6 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real | kind = kind_phys intent = in -[ cld_tau ] - standard_name = liquid_plus_ice_optical_depth - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) - intent = out -[ grau_tau ] - standard_name = graupel_optical_depth - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) - intent = out -[ snow_tau ] - standard_name = snow_optical_depth - units = 1 - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) - intent = out [ degrau ] standard_name = effective_diameter_of_stratiform_cloud_graupel_particle_for_radiation units = m @@ -146,13 +127,13 @@ intent = in [ dei ] standard_name = effective_diameter_of_stratiform_cloud_ice_particle_for_radiation - units = micron + units = um type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ des ] standard_name = effective_diameter_of_stratiform_snow_particle_for_radiation - units = micron + units = um type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in @@ -163,13 +144,13 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ iciwpth ] - standard_name = cloud_ice_water_path + standard_name = in_cloud_ice_water_path units = kg m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in [ icswpth ] - standard_name = cloud_snow_water_path + standard_name = in_cloud_snow_water_path units = kg m-2 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -210,6 +191,24 @@ type = ty_gas_optics_rrtmgp_ccpp dimensions = () intent = in +[ cld_tau ] + standard_name = liquid_plus_ice_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ grau_tau ] + standard_name = graupel_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out +[ snow_tau ] + standard_name = snow_optical_depth + units = 1 + type = real | kind = kind_phys + dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) + intent = out [ c_cld_tau ] standard_name = combined_shortwave_cloud_extinction_optical_depth units = 1 @@ -217,19 +216,19 @@ dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ c_cld_tau_w ] - standard_name = combined_shortwave_cloud_single_scattering_albedo + standard_name = combined_shortwave_cloud_single_scattering_albedo_multiplied_by_optical_depth units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ c_cld_tau_w_g ] - standard_name = combined_shortwave_cloud_asymmetry_parameter + standard_name = combined_shortwave_cloud_asymmetry_parameter_multiplied_by_single_scattering_albedo_multiplied_by_optical_depth units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = out [ tot_cld_vistau ] - standard_name = total_cloud_optical_depth_for_visible_band_times_cloud_fraction + standard_name = total_cloud_optical_depth_for_visible_band_multiplied_by_cloud_fraction units = 1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) @@ -267,7 +266,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 7e489b27..8bbccd4e 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -14,9 +14,9 @@ module rrtmgp_sw_gas_optics !> \section arg_table_rrtmgp_sw_gas_optics_init Argument Table !! \htmlinclude rrtmgp_sw_gas_optics_init.html !! - subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & + subroutine rrtmgp_sw_gas_optics_init(sw_filename, available_gases, kdist, & errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use radiation_tools, only: check_error_msg @@ -29,7 +29,7 @@ subroutine rrtmgp_sw_gas_optics_init(kdist, sw_filename, available_gases, & ! Outputs class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object - character(len=512), intent(out) :: errmsg ! CCPP error message + character(len=*), intent(out) :: errmsg ! CCPP error message integer, intent(out) :: errflg ! CCPP error code ! Local variables @@ -333,7 +333,7 @@ end subroutine rrtmgp_sw_gas_optics_init !! subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, & gas_concs, sw_optical_props, sw_gas_props, toa_src_sw, errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_optical_props, only: ty_optical_props_2str_ccpp @@ -352,7 +352,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object real(kind_phys), intent(out) :: toa_src_sw(:,:) !< Top of atmosphere solar radiation flux on g points [W m-2] - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index a4ac2a90..b530275c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -5,12 +5,6 @@ [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init type = scheme -[ kdist ] - standard_name = shortwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = out [ sw_filename ] standard_name = filename_of_rrtmgp_shortwave_k_distribution units = none @@ -18,15 +12,21 @@ dimensions = () intent = in [ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP + standard_name = gas_volume_mixing_ratios_object_for_RRTMGP units = none type = ty_gas_concs_ccpp dimensions = () intent = in +[ kdist ] + standard_name = shortwave_gas_optics_object_for_RRTMGP + units = none + type = ty_gas_optics_rrtmgp_ccpp + dimensions = () + intent = out [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -52,34 +52,34 @@ dimensions = () intent = in [ ncol ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ rrtmgp_phys_blksz ] - standard_name = number_of_columns_per_longwave_block_for_RRTMGP + standard_name = number_of_columns_per_shortwave_block_for_RRTMGP units = count type = integer dimensions = () intent = in [ p_lay ] - standard_name = air_pressure_for_daytime_points_for_RRTMGP + standard_name = air_pressure_for_daytime_columns_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) + dimensions = (daytime_columns_dimension, number_of_vertical_layers_in_RRTMGP) intent = in [ p_lev ] - standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP + standard_name = air_pressure_at_interface_for_daytime_columns_for_RRTMGP units = Pa type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) + dimensions = (daytime_columns_dimension, number_of_vertical_interfaces_in_RRTMGP) intent = in [ t_lay ] - standard_name = air_temperature_for_daytime_points_for_RRTMGP + standard_name = air_temperature_for_daytime_columns_for_RRTMGP units = K type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) + dimensions = (daytime_columns_dimension, number_of_vertical_layers_in_RRTMGP) intent = in [ gas_concs ] standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP @@ -103,12 +103,12 @@ standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points units = W m-2 type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_shortwave_g_point_intervals) + dimensions = (daytime_columns_dimension, number_of_shortwave_g_point_intervals) intent = out [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml index 3747fd28..f4feb13a 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_namelist.xml @@ -82,7 +82,7 @@ filename_of_rrtmgp_shortwave_k_distribution none - The filename of the shortwave coefficients file for RRTMGP + The path and filename of the shortwave coefficients file for RRTMGP ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta index dea63056..008bec1c 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.meta @@ -30,7 +30,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () @@ -42,7 +42,7 @@ dimensions = (gaslist_dimension) intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index b1bb39c9..a6243a4f 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -15,7 +15,7 @@ module rrtmgp_sw_mcica_subcol_gen !! \htmlinclude rrtmgp_sw_mcica_subcol_gen_run.html subroutine 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, pmid_day, errmsg, errflg) + c_cld_tau_w, c_cld_tau_w_g, pmid_day, cloud_sw, errmsg, errflg) use ccpp_kinds, only: kind_phys use ccpp_gas_concentrations, only: ty_gas_concs_ccpp use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp @@ -41,11 +41,11 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda real(kind_phys), intent(in) :: c_cld_tau_w(:,:,:) ! combined cloud single scattering albedo * tau real(kind_phys), intent(in) :: c_cld_tau_w_g(:,:,:) ! combined cloud asymmetry parameter * w * tau real(kind_phys), intent(in) :: cldfprime(:,:) ! combined cloud fraction - real(kind_phys), intent(in) :: pmid_day(:,:) ! air ressure at mid-points [Pa] + real(kind_phys), intent(in) :: pmid_day(:,:) ! air pressure at mid-points [Pa] logical, intent(in) :: dosw ! Flag to do shortwave radiation this timestep type(ty_optical_props_2str_ccpp), intent(out) :: cloud_sw ! SW cloud optical properties object - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta index c8a66584..aa6fc068 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.meta @@ -1,7 +1,6 @@ [ccpp-table-properties] name = rrtmgp_sw_mcica_subcol_gen type = scheme - dependencies = ../../../../../share/RandNum/src/shr_RandNum_mod.F90 [ccpp-arg-table] name = rrtmgp_sw_mcica_subcol_gen_run @@ -31,7 +30,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () @@ -55,7 +54,7 @@ dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) @@ -85,33 +84,33 @@ dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = in [ c_cld_tau_w ] - standard_name = combined_shortwave_cloud_single_scattering_albedo + standard_name = combined_shortwave_cloud_single_scattering_albedo_multiplied_by_optical_depth units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = in [ c_cld_tau_w_g ] - standard_name = combined_shortwave_cloud_asymmetry_parameter + standard_name = combined_shortwave_cloud_asymmetry_parameter_multiplied_by_single_scattering_albedo_multiplied_by_optical_depth units = 1 type = real | kind = kind_phys dimensions = (number_of_bands_for_shortwave_radiation,horizontal_loop_extent,vertical_layer_dimension) intent = in +[ pmid_day ] + standard_name = air_pressure_for_daytime_columns_for_RRTMGP + units = Pa + type = real | kind = kind_phys + dimensions = (daytime_columns_dimension, number_of_vertical_layers_in_RRTMGP) + intent = in [ cloud_sw ] standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP units = none type = ty_optical_props_2str_ccpp dimensions = () intent = out -[ pmid_day ] - standard_name = air_pressure_for_daytime_points_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) - intent = in [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index cb48a004..6fd6ecdd 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -15,7 +15,7 @@ module rrtmgp_sw_rte subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & sw_optical_props_clouds, aersw, coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & flux_clrsky, flux_allsky, errmsg, errflg) - use machine, only: kind_phys + use ccpp_kinds, only: kind_phys use mo_rte_sw, only: rte_sw use ccpp_optical_props, only: ty_optical_props_2str_ccpp use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta index 966b685c..2abcef17 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -7,7 +7,6 @@ dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = ../../../../utils/machine.F90 dependencies = ./utils/radiation_tools.F90 dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 dependencies = ./objects/ccpp_optical_props.F90 @@ -35,7 +34,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () @@ -71,28 +70,28 @@ dimensions = () intent = inout [ coszen_day ] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep + standard_name = cosine_of_solar_zenith_angle_for_daytime_columns_on_radiation_timestep units = rad type = real | kind = kind_phys - dimensions = (daytime_points_dimension) + dimensions = (daytime_columns_dimension) intent = in [ toa_src_sw ] standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points units = W m-2 type = real | kind = kind_phys - dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) + dimensions = (daytime_columns_dimension,number_of_shortwave_g_point_intervals) intent = in [ sfc_alb_dir ] standard_name = albedo_direct_at_surface units = fraction type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + dimensions = (number_of_bands_for_shortwave_radiation,daytime_columns_dimension) intent = in [ sfc_alb_dif ] standard_name = albedo_diffused_at_surface units = fraction type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) + dimensions = (number_of_bands_for_shortwave_radiation,daytime_columns_dimension) intent = in [ flux_clrsky ] standard_name = shortwave_clear_sky_flux_object_for_RRTMGP diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index b118fe22..7126a006 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -5,10 +5,8 @@ ! when the radiation scheme might use a different solar source function !------------------------------------------------------------------------------- module rrtmgp_sw_solar_var - use ccpp_kinds, only : kind_phys implicit none - save private public :: rrtmgp_sw_solar_var_run @@ -23,6 +21,7 @@ module rrtmgp_sw_solar_var subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, & nday, dosw, do_spectral_scaling, sfac, eccf, errmsg, errflg) use rrtmgp_sw_solar_var_setup, only: irrad, radbinmax, radbinmin + use ccpp_kinds, only : kind_phys ! Arguments real(kind_phys), intent(inout) :: toa_flux(:,:) ! top-of-atmosphere flux to be scaled (columns,gpts) @@ -38,7 +37,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw logical, intent(in) :: dosw ! flag to do shortwave radiation real(kind_phys), intent(in) :: eccf ! Earth-Sun distance factor real(kind_phys), intent(out) :: sfac(:,:) ! scaling factors (columns,gpts) - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -93,6 +92,7 @@ end subroutine rrtmgp_sw_solar_var_run subroutine integrate_spectrum( nsrc, ntrg, src_x, min_trg, max_trg, src, trg ) use ccpp_tuvx_utils, only : rebin + use ccpp_kinds, only : kind_phys implicit none diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index 05bd45c6..b1d22a44 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -10,7 +10,7 @@ standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points units = W m-2 type = real | kind = kind_phys - dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) + dimensions = (daytime_columns_dimension,number_of_shortwave_g_point_intervals) intent = inout [ ccpp_constant_two ] standard_name = ccpp_constant_two @@ -55,7 +55,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () @@ -76,7 +76,7 @@ standard_name = scaling_factors_for_top_of_atmosphere_solar_radiation_flux units = 1 type = real | kind = kind_phys - dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) + dimensions = (daytime_columns_dimension,number_of_shortwave_g_point_intervals) intent = out [ eccf ] standard_name = earth_sun_distance @@ -87,7 +87,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 index a37f1889..2c2e4f9b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.F90 @@ -9,7 +9,6 @@ module rrtmgp_sw_solar_var_setup use ccpp_kinds, only : kind_phys implicit none - save private public :: rrtmgp_sw_solar_var_setup_init @@ -31,7 +30,7 @@ subroutine rrtmgp_sw_solar_var_setup_init(nswbands, do_spectral_scaling, has_spe integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling logical, intent(in) :: has_spectrum ! flag for whether solar input file has irradiance spectrum - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer :: radmax_loc @@ -43,7 +42,7 @@ subroutine rrtmgp_sw_solar_var_setup_init(nswbands, do_spectral_scaling, has_spe write(errmsg, *) 'rrtmgp_sw_solar_var_setup_init: solar input fil must have irradiance spectrum' errflg = 1 return - endif + end if allocate (radbinmax(nswbands),stat=errflg,errmsg=alloc_errmsg) if (errflg /= 0) then @@ -74,7 +73,7 @@ subroutine rrtmgp_sw_solar_var_setup_init(nswbands, do_spectral_scaling, has_spe radmax_loc = maxloc(radbinmax,1) radbinmax(radmax_loc) = max(100000._kind_phys,radbinmax(radmax_loc)) - endif + end if end subroutine rrtmgp_sw_solar_var_setup_init diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta index 95ac33a5..f9d0952f 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var_setup.meta @@ -27,7 +27,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index d70183f8..38ae13d8 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -12,17 +12,16 @@ module rrtmgp_variables !> \section arg_table_rrtmgp_variables_init Argument Table !! \htmlinclude rrtmgp_variables_init.html !! - subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & - fluxlwup_Jac, rad_heat, use_tlev, snow_exists, grau_exists, & + subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & + fluxlwup_Jac, use_tlev, snow_exists, grau_exists, & errmsg, errflg) use ccpp_kinds, only: kind_phys real(kind_phys), intent(in) :: unset_real ! Definition of "unset" logical, intent(out) :: active_call_array(:) ! Diagnostic subcycles real(kind_phys), intent(out) :: tlev(:,:) ! Air temperature at interfaces [K] real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) ! Surface temperature flux Jacobian [W m-2 K-1] - real(kind_phys), intent(out) :: rad_heat(:,:) ! Tendency of dry air enthalpy [J kg-1 s-1] logical, intent(out) :: use_tlev ! Flag to use temperature at interfaces in radiation calculation - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Initialize error variables @@ -37,9 +36,6 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & tlev = unset_real fluxlwup_Jac = unset_real - ! Initialize rad_heat - rad_heat = unset_real - end subroutine rrtmgp_variables_init !> \section arg_table_rrtmgp_variables_timestep_init Argument Table @@ -51,7 +47,7 @@ subroutine rrtmgp_variables_timestep_init(ncol, nday, rrtmgp_phys_blksz_lw, & integer, intent(in) :: ncol ! Total horizontal gridpoints integer, intent(out) :: rrtmgp_phys_blksz_lw ! Number of LW columns to process at once integer, intent(out) :: rrtmgp_phys_blksz_sw ! Number of SW columns to process at once - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg errflg = 0 @@ -77,7 +73,7 @@ subroutine rrtmgp_variables_run(graupel_in_rad, grau_exists, snow_exists, & logical, intent(out) :: do_grau ! Flag to use graupel in radiation calcuation logical, intent(out) :: do_snow ! Flag to use snow in radiation calculation real(kind_phys), intent(out) :: tiny_rad ! Definition of tiny for RRTMGP - character(len=512), intent(out) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Set error variables diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index 418b4abd..3827a9f2 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -29,12 +29,6 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension,vertical_interface_dimension) intent = out -[ rad_heat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = J kg-1 s-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension,vertical_layer_dimension) - intent = out [ use_tlev ] standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation units = flag @@ -44,7 +38,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -63,7 +57,7 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () @@ -83,7 +77,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] @@ -134,7 +128,7 @@ [ errmsg ] standard_name = ccpp_error_message units = none - type = character | kind = len=512 + type = character | kind = len=* dimensions = () intent = out [ errflg ] diff --git a/schemes/rrtmgp/utils/radiation_tools.F90 b/schemes/rrtmgp/utils/radiation_tools.F90 index e941a346..b38ff6a2 100644 --- a/schemes/rrtmgp/utils/radiation_tools.F90 +++ b/schemes/rrtmgp/utils/radiation_tools.F90 @@ -3,7 +3,7 @@ !> This module contains tools for radiation module radiation_tools - use machine, only: & + use ccpp_kinds, only: & kind_phys ! Working type implicit none diff --git a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml index d62110bf..1438a713 100644 --- a/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml +++ b/schemes/rrtmgp/utils/rrtmgp_cloud_optics_setup_namelist.xml @@ -75,7 +75,7 @@ units This is the CCPP unit specification of the variable (e.g., m s-1). --> - + char*256 rrtmgp_cloud_optics radconst @@ -88,7 +88,7 @@ ${DIN_LOC_ROOT}/atm/cam/physprops/iceoptics_c080917.nc - + char*256 rrtmgp_cloud_optics radconst @@ -101,7 +101,7 @@ ${DIN_LOC_ROOT}/atm/cam/physprops/F_nwvl200_mu20_lam50_res64_t298_c080428.nc - + char*32 rrtmgp_cloud_optics radconst @@ -114,7 +114,7 @@ mitchell - + char*32 rrtmgp_cloud_optics radconst diff --git a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 index 9428b1a1..e7f7287c 100644 --- a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.F90 @@ -1,7 +1,6 @@ module rrtmgp_cloud_diagnostics implicit none private - save public :: rrtmgp_cloud_diagnostics_init ! init routine public :: rrtmgp_cloud_diagnostics_run ! main routine @@ -26,7 +25,7 @@ subroutine rrtmgp_cloud_diagnostics_init(has_snow, has_graupel, graupel_in_rad, errflg = 0 ! Add diagnostic fields - call history_add_field('TOT_CLD_VISTAU', 'Total gbx cloud extinction visible sw optical depth', 'lev', 'avg', '1', & + call history_add_field('TOT_CLD_VISTAU', 'Total grid box cloud extinction visible sw optical depth', 'lev', 'avg', '1', & flag_xyfill=.true.) call history_add_field('TOT_ICLD_VISTAU', 'Total in-cloud extinction visible sw optical depth', 'lev', 'avg', '1', & flag_xyfill=.true.) diff --git a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta index 8516d2e5..661318e7 100644 --- a/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_cloud_diagnostics.meta @@ -64,7 +64,7 @@ dimensions = () intent = in [ tot_cld_vistau ] - standard_name = total_cloud_optical_depth_for_visible_band_times_cloud_fraction + standard_name = total_cloud_optical_depth_for_visible_band_multiplied_by_cloud_fraction units = 1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 index 035075f5..3b72cee6 100644 --- a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 @@ -23,7 +23,7 @@ subroutine rrtmgp_diagnostics_init(errmsg, errflg) errflg = 0 ! Heating rate needed for d(theta)/dt computation - call history_add_field('HR', 'Heating rate needed for d(theat)/dt computation', 'lev', 'avg', 'K s-1') + call history_add_field('HR', 'Heating rate needed for d(theta)/dt computation', 'lev', 'avg', 'K s-1') end subroutine rrtmgp_diagnostics_init @@ -54,7 +54,7 @@ subroutine rrtmgp_diagnostics_run(write_output, active_calls, num_diag_subcycles ! Local variables integer :: idx, kdx integer :: diag_index - real(kind_phys) :: ftem(ncol, pver) + real(kind_phys) :: net_heating_rate(ncol, pver) errmsg = '' errflg = 0 @@ -70,11 +70,11 @@ subroutine rrtmgp_diagnostics_run(write_output, active_calls, num_diag_subcycles ! Compute heating rate for dtheta/dt do kdx = 1, pver do idx = 1, ncol - ftem(idx,kdx) = (qrs(idx,kdx) + qrl(idx,kdx))/cpair * (1.e5_kind_phys/pmid(idx,kdx))**cappa + net_heating_rate(idx,kdx) = (qrs(idx,kdx) + qrl(idx,kdx))/cpair * (1.e5_kind_phys/pmid(idx,kdx))**cappa end do end do - call history_out_field('HR', ftem) + call history_out_field('HR', net_heating_rate) end subroutine rrtmgp_diagnostics_run diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 index 6e019720..79516e9e 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -105,7 +105,7 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl real(kind_phys) :: fln200(ncol) real(kind_phys) :: fln200c(ncol) real(kind_phys) :: flnr(ncol) - real(kind_phys) :: ftem(ncol) + real(kind_phys) :: lwcf(ncol) errmsg = '' errflg = 0 @@ -128,8 +128,8 @@ subroutine rrtmgp_lw_diagnostics_run(num_diag_subcycles, icall, active_calls, fl call history_out_field('FLUT'//diag(diag_index), flw%fluxes%flux_up(:, ktoprad)) call history_out_field('FLUTC'//diag(diag_index), flwc%fluxes%flux_up(:, ktoprad)) - ftem(:) = flwc%fluxes%flux_up(:, ktoprad) - flw%fluxes%flux_up(:, ktoprad) - call history_out_field('LWCF'//diag(diag_index), ftem) + lwcf(:) = flwc%fluxes%flux_up(:, ktoprad) - flw%fluxes%flux_up(:, ktoprad) + call history_out_field('LWCF'//diag(diag_index), lwcf) ! Output fluxes at 200 mb call vertinterp(ncol, ncol, pverp, pint, 20000._kind_phys, fnl, fln200) From 720978729c246b087085a8e26f6fb33487838869 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 15 Dec 2025 09:57:38 -0700 Subject: [PATCH 127/140] fixes to get sima to work --- schemes/radiation_utils/solar_irradiance_data.F90 | 4 ++++ .../radiation_utils/solar_irradiance_data_namelist.xml | 2 +- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_variables.F90 | 9 ++++++--- schemes/rrtmgp/rrtmgp_variables.meta | 6 ++++++ schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta | 4 ++-- 6 files changed, 21 insertions(+), 8 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 039dacfa..68855719 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -16,6 +16,7 @@ module solar_irradiance_data public :: solar_irradiance_data_register public :: solar_irradiance_data_init public :: solar_irradiance_data_run + public :: solar_irradiance_data_final type(time_coordinate) :: time_coord class(abstract_netcdf_reader_t), pointer :: file_reader @@ -392,6 +393,9 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru end subroutine solar_irradiance_data_run +!> \section arg_table_solar_irradiance_data_final Argument Table +!! \htmlinclude solar_irradiance_data_final.html +!! subroutine solar_irradiance_data_final(errmsg, errflg) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/schemes/radiation_utils/solar_irradiance_data_namelist.xml b/schemes/radiation_utils/solar_irradiance_data_namelist.xml index 65aff254..f1bfce2c 100644 --- a/schemes/radiation_utils/solar_irradiance_data_namelist.xml +++ b/schemes/radiation_utils/solar_irradiance_data_namelist.xml @@ -105,7 +105,7 @@ logical solar_data solar_data - do_radiation_heating_spectral_scaling + do_solar_radiation_heating_spectral_scaling flag Flag for whether to do radiation heating spectral scaling diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index 510517b9..a3f61c2e 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -9,9 +9,9 @@ module rrtmgp_inputs_setup !> \section arg_table_rrtmgp_inputs_setup_init Argument Table !! \htmlinclude rrtmgp_inputs_setup_init.html !! - subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, pver, pverp, kdist_sw, & + subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, kdist_sw, & kdist_lw, qrl, is_first_step, use_rad_dt_cosz, timestep_size, nstep, iradsw, dt_avg, & - irad_always, is_first_restar_step, p_top_for_rrtmgp, nradgas, gasnamelength, current_cal_day, & + irad_always, is_first_restart_step, p_top_for_rrtmgp, nradgas, gasnamelength, current_cal_day, & ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, idx_sw_diag, idx_nir_diag, & idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, changeseed, & nlay, nlayp, nextsw_cday, band2gpt_sw, irad_always_out, errmsg, errflg) diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 38ae13d8..2e198a28 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -12,14 +12,14 @@ module rrtmgp_variables !> \section arg_table_rrtmgp_variables_init Argument Table !! \htmlinclude rrtmgp_variables_init.html !! - subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & - fluxlwup_Jac, use_tlev, snow_exists, grau_exists, & - errmsg, errflg) + subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, rad_heat, & + fluxlwup_Jac, use_tlev, errmsg, errflg) use ccpp_kinds, only: kind_phys real(kind_phys), intent(in) :: unset_real ! Definition of "unset" logical, intent(out) :: active_call_array(:) ! Diagnostic subcycles real(kind_phys), intent(out) :: tlev(:,:) ! Air temperature at interfaces [K] real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) ! Surface temperature flux Jacobian [W m-2 K-1] + real(kind_phys), intent(out) :: rad_heat(:,:) ! Tendency of dry air enthalpy at constant pressure [J kg-1 s-1] logical, intent(out) :: use_tlev ! Flag to use temperature at interfaces in radiation calculation character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,6 +36,9 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & tlev = unset_real fluxlwup_Jac = unset_real + ! Initialize rad_heat + rad_heat = unset_real + end subroutine rrtmgp_variables_init !> \section arg_table_rrtmgp_variables_timestep_init Argument Table diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index 3827a9f2..d52a4bfb 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -23,6 +23,12 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension,vertical_interface_dimension) intent = out +[ rad_heat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out [ fluxlwup_Jac ] standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP units = W m-2 K-1 diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta index 9f12e001..409ca039 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.meta @@ -76,13 +76,13 @@ dimensions = () intent = in [ nday ] - standard_name = daytime_points_dimension + standard_name = daytime_columns_dimension units = count type = integer dimensions = () intent = in [ idxday ] - standard_name = daytime_points + standard_name = daytime_columns units = index type = integer dimensions = (horizontal_loop_extent) From aabfd2f556f7375c86ed978db7603f308f95f440 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 15 Dec 2025 10:42:01 -0700 Subject: [PATCH 128/140] remove save attribute --- schemes/sima_diagnostics/rrtmgp_diagnostics.F90 | 1 - schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 | 1 - schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 | 1 - schemes/sima_diagnostics/scheme_diagnostics_template.F90 | 1 - 4 files changed, 4 deletions(-) diff --git a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 index 3b72cee6..48aa9fa8 100644 --- a/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_diagnostics.F90 @@ -4,7 +4,6 @@ module rrtmgp_diagnostics implicit none private - save public :: rrtmgp_diagnostics_init ! init routine public :: rrtmgp_diagnostics_run ! main routine diff --git a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 index 79516e9e..227f4a73 100644 --- a/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_lw_diagnostics.F90 @@ -3,7 +3,6 @@ module rrtmgp_lw_diagnostics implicit none private - save public :: rrtmgp_lw_diagnostics_init ! init routine public :: rrtmgp_lw_diagnostics_run ! main routine diff --git a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 index f6c6ec78..3753cec7 100644 --- a/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 +++ b/schemes/sima_diagnostics/rrtmgp_sw_diagnostics.F90 @@ -3,7 +3,6 @@ module rrtmgp_sw_diagnostics implicit none private - save public :: rrtmgp_sw_diagnostics_init ! init routine public :: rrtmgp_sw_diagnostics_run ! main routine diff --git a/schemes/sima_diagnostics/scheme_diagnostics_template.F90 b/schemes/sima_diagnostics/scheme_diagnostics_template.F90 index a00a2d86..5d6e5201 100644 --- a/schemes/sima_diagnostics/scheme_diagnostics_template.F90 +++ b/schemes/sima_diagnostics/scheme_diagnostics_template.F90 @@ -21,7 +21,6 @@ module SCHEME_diagnostics implicit none private - save public :: SCHEME_diagnostics_init ! init routine public :: SCHEME_diagnostics_run ! main routine From 5f06efa4729d59bce3a4bd3b4cc350cb9e9da8cc Mon Sep 17 00:00:00 2001 From: Jesse Nusbaumer Date: Tue, 16 Dec 2025 20:30:58 -0700 Subject: [PATCH 129/140] Deallocate file_reader at init time if solar forcing is fixed. --- schemes/radiation_utils/solar_irradiance_data.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 68855719..29c6a36f 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -289,6 +289,13 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da end if initialized = .true. + ! If solar forcing is fixed, then the file reader is + ! no longer needed beyond this point: + if (fixed) then + deallocate(file_reader) + nullify(file_reader) + end if + end subroutine solar_irradiance_data_init !------------------------------------------------------------------------------- @@ -404,8 +411,10 @@ subroutine solar_irradiance_data_final(errmsg, errflg) errflg = 0 ! Deallocate the module-level file reader object - deallocate(file_reader) - nullify(file_reader) + if (associated(file_reader)) then + deallocate(file_reader) + nullify(file_reader) + end if end subroutine solar_irradiance_data_final From bc09f5500ac136a92068a300157c94e7b816a155 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 18 Dec 2025 13:04:34 -0700 Subject: [PATCH 130/140] further review comments; move solar irradiance read to timestep init --- schemes/radiation_utils/solar_irradiance_data.F90 | 14 +++++++------- schemes/radiation_utils/solar_irradiance_data.meta | 2 +- schemes/rrtmgp/rrtmgp_constituents.F90 | 2 ++ schemes/rrtmgp/rrtmgp_inputs.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 9 +++++++-- schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 | 4 ++-- .../rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 2 +- schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_lw_rte.meta | 4 ++-- schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_variables.F90 | 6 +----- schemes/rrtmgp/rrtmgp_variables.meta | 6 ------ schemes/rrtmgp/utils/calculate_net_heating.F90 | 6 +++--- schemes/rrtmgp/utils/calculate_net_heating.meta | 12 ++++++------ 19 files changed, 47 insertions(+), 50 deletions(-) diff --git a/schemes/radiation_utils/solar_irradiance_data.F90 b/schemes/radiation_utils/solar_irradiance_data.F90 index 68855719..c3ffaf08 100644 --- a/schemes/radiation_utils/solar_irradiance_data.F90 +++ b/schemes/radiation_utils/solar_irradiance_data.F90 @@ -15,7 +15,7 @@ module solar_irradiance_data private public :: solar_irradiance_data_register public :: solar_irradiance_data_init - public :: solar_irradiance_data_run + public :: solar_irradiance_data_timestep_init public :: solar_irradiance_data_final type(time_coordinate) :: time_coord @@ -282,7 +282,7 @@ subroutine solar_irradiance_data_init(irrad_file_path, solar_data_type, solar_da ! need to force data loading when the host model starts at a time =/ 00:00:00.000 ! -- may occur in restarts also - call solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & + call solar_irradiance_data_timestep_init(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & sol_irrad, wavelength_endpoints, sol_tsi, errmsg, errflg) if (errflg /= 0) then return @@ -294,10 +294,10 @@ end subroutine solar_irradiance_data_init !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- -!> \section arg_table_solar_irradiance_data_run Argument Table -!! \htmlinclude solar_irradiance_data_run.html +!> \section arg_table_solar_irradiance_data_timestep_init Argument Table +!! \htmlinclude solar_irradiance_data_timestep_init.html !! - subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & + subroutine solar_irradiance_data_timestep_init(irrad_file_path, nbins, nbinsp, has_spectrum, do_spectral_scaling, & sol_irrad, wavelength_endpoints, sol_tsi, errmsg, errflg) ! Arguments character(len=*), intent(in) :: irrad_file_path @@ -321,7 +321,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru integer :: ierr real(kind_phys) :: delt - character(len=*), parameter :: subname = 'solar_irradiance_data_run: ' + character(len=*), parameter :: subname = 'solar_irradiance_data_timestep_init: ' ! Initialize error variables errflg = 0 @@ -391,7 +391,7 @@ subroutine solar_irradiance_data_run(irrad_file_path, nbins, nbinsp, has_spectru sol_tsi = itsi(1) + delt*( itsi(2) - itsi(1) ) end if - end subroutine solar_irradiance_data_run + end subroutine solar_irradiance_data_timestep_init !> \section arg_table_solar_irradiance_data_final Argument Table !! \htmlinclude solar_irradiance_data_final.html diff --git a/schemes/radiation_utils/solar_irradiance_data.meta b/schemes/radiation_utils/solar_irradiance_data.meta index 8a4289da..69cdc723 100644 --- a/schemes/radiation_utils/solar_irradiance_data.meta +++ b/schemes/radiation_utils/solar_irradiance_data.meta @@ -143,7 +143,7 @@ intent = out [ccpp-arg-table] - name = solar_irradiance_data_run + name = solar_irradiance_data_timestep_init type = scheme [ irrad_file_path ] standard_name = filename_of_solar_irradiance_data diff --git a/schemes/rrtmgp/rrtmgp_constituents.F90 b/schemes/rrtmgp/rrtmgp_constituents.F90 index 206d8353..7d3166fd 100644 --- a/schemes/rrtmgp/rrtmgp_constituents.F90 +++ b/schemes/rrtmgp/rrtmgp_constituents.F90 @@ -56,6 +56,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, if (idx == 0) then errmsg = 'rad_climate namelist variable error: all entries must be of the format "flag:long_name:gas_name". Failed to parse "'//trim(tmpstr)//'"' errflg = 1 + return end if source = tmpstr(:idx-1) tmpstr = tmpstr(idx+1:) @@ -65,6 +66,7 @@ subroutine rrtmgp_constituents_register(rad_climate, rrtmgp_dyn_consts, errmsg, if (idx == 0) then errmsg = 'rad_climate namelist variable error: all entries must be of the format "flag:long_name:gas_name". Failed to parse "'//trim(tmpstr)//'"' errflg = 1 + return end if long_name = tmpstr(:idx-1) diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 index 9c7a04d3..71b6cc15 100644 --- a/schemes/rrtmgp/rrtmgp_inputs.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -32,8 +32,8 @@ subroutine rrtmgp_inputs_run(dosw, dolw, do_snow, do_graupel, trick_rrtmgp, & integer, intent(in) :: pverp ! Number of vertical interfaces integer, intent(in) :: nlay ! Number of vertical layers used in radiation calculation integer, intent(in) :: nswbands ! Number of shortwave bands - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays integer, intent(in) :: nday ! Number of daylight columns logical, intent(in) :: dosw ! Flag for performing the shortwave calculation logical, intent(in) :: dolw ! Flag for performing the longwave calculation diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index a3f61c2e..c5622c6c 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -40,8 +40,8 @@ subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, real(kind_phys), intent(in) :: p_top_for_rrtmgp ! Top pressure to use for RRTMGP (Pa) ! Outputs - integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(out) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay ! or is 1 less than nlay if "extra layer" is used in the radiation calculations integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation @@ -127,6 +127,11 @@ subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, ! Set the radiation timestep for cosz calculations if requested using ! the adjusted iradsw value from radiation if (use_rad_dt_cosz) then + if (iradsw < 0) then + errflg = 1 + write(errmsg,*) 'iradsw is negative; has not been properly adjusted' + return + end if dt_avg = iradsw*timestep_size else dt_avg = 0._kind_phys diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 index 0391703b..a9967bbd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_fluxes.F90 @@ -24,8 +24,8 @@ subroutine rrtmgp_lw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp integer, intent(in) :: pverp ! Number of vertical layer interfaces integer, intent(in) :: ncol ! Number of horizontal grid points integer, intent(in) :: nlay ! Number of vertical layers in RRTMGP - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active type(ty_fluxes_byband_ccpp), intent(in) :: flw ! Longwave all-sky flux object type(ty_fluxes_broadband_ccpp), intent(in) :: flwc ! Longwave clear-sky flux object diff --git a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 index 309aa64a..ba486002 100644 --- a/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_calculate_heating_rate.F90 @@ -7,7 +7,7 @@ module rrtmgp_lw_calculate_heating_rate subroutine rrtmgp_lw_calculate_heating_rate_run(ktopcam, pver, gravit, rpdel, flux_net, & flux_net_clrsky, hrate, hrate_clrsky, errmsg, errflg) use ccpp_kinds, only: kind_phys - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: pver ! Number of vertical levels real(kind_phys), intent(in) :: gravit ! Standard gravitational acceleration [m s-2] real(kind_phys), intent(in) :: rpdel(:,:) ! Reciprocal of air pressure thickness [Pa-1] diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 index b0e2a760..73b874cd 100644 --- a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -37,7 +37,7 @@ subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, cld, cldfsnow, cldfgrau, integer, intent(in) :: nlay ! Number of vertical layers in radiation integer, intent(in) :: nlwbands ! Number of longwave bands integer, intent(in) :: pver ! Total number of vertical layers - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 index 5ab32ca8..dd712e1c 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -21,8 +21,8 @@ subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, integer, intent(in) :: nlay ! Number of layers in radiation calculation integer, intent(in) :: ncol ! Total number of columns integer, intent(in) :: pverp ! Total number of layer interfaces - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: nradgas ! Number of radiatively active gases logical, intent(in) :: dolw ! Flag for whether to perform longwave calculaion real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 index 1b624a7c..fa70b9a2 100644 --- a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -60,8 +60,8 @@ subroutine rrtmgp_lw_mcica_subcol_gen_run( & ! arguments class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: nbnd ! Number of spectral bands integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) integer, intent(in) :: ncol ! Number of columns diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index c0fa00dd..81c71e77 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -8,9 +8,9 @@ dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 dependencies = utils/radiation_tools.F90 - dependencies = objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 + dependencies = objects/ccpp_source_functions.F90,objects/ccpp_gas_optics_rrtmgp.F90 dependencies = objects/ccpp_optical_props.F90 - dependencies = objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 + dependencies = objects/ccpp_fluxes.F90,objects/ccpp_fluxes_byband.F90 [ccpp-arg-table] name = rrtmgp_lw_rte_run diff --git a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 index 827d13f9..83f37453 100644 --- a/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_calculate_fluxes.F90 @@ -25,8 +25,8 @@ subroutine rrtmgp_sw_calculate_fluxes_run(num_diag_subcycles, icall, ncol, pverp integer, intent(in) :: ncol ! Number of horizontal grid points integer, intent(in) :: nlay ! Number of vertical layers in RRTMGP integer, intent(in) :: nday ! Daytime points dimension - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays integer, intent(in) :: idxday(:) ! Daytime points indices logical, intent(in) :: active_calls(:) ! Logical array of flags for whether a specified subcycle is active type(ty_fluxes_byband_ccpp), intent(in) :: fsw ! Shortwave all-sky flux object diff --git a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 index cfaa2a68..f7434ef9 100644 --- a/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_cloud_optics.F90 @@ -49,8 +49,8 @@ subroutine rrtmgp_sw_cloud_optics_run(dosw, ncol, pver, ktopcam, ktoprad, nswgp integer, intent(in) :: idxday(:) ! Indices of daylight columns integer, intent(in) :: nswgpts ! Number of shortwave g-points integer, intent(in) :: pver ! Number of vertical layers - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays integer, intent(in) :: nswbands ! Number of shortwve bands integer, intent(in) :: nnite ! Number of night columns integer, intent(in) :: idxnite(:) ! Indices of night columns in the chunk diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 index a970ef98..66848a89 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics_pre.F90 @@ -22,8 +22,8 @@ subroutine rrtmgp_sw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, nday, integer, intent(in) :: nday ! Total number of daylight columns integer, intent(in) :: pverp ! Total number of layer interfaces integer, intent(in) :: idxday(:) ! Indices of daylight columns - integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays - integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of host model arrays + integer, intent(in) :: ktopcam ! Index in host model arrays of top level (layer or interface) at which RRTMGP is active integer, intent(in) :: nradgas ! Number of radiatively active gases logical, intent(in) :: dosw ! Flag for whether to perform longwave calculaion real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] diff --git a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 index a6243a4f..d9ac7bb6 100644 --- a/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_mcica_subcol_gen.F90 @@ -33,8 +33,8 @@ subroutine rrtmgp_sw_mcica_subcol_gen_run(dosw, kdist_sw, nswbands, nswgpts, nda 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) :: pver ! total number of vertical layers - integer, intent(in) :: ktopcam ! index in CAM arrays of top level (layer or interface) at which RRTMGP is active - integer, intent(in) :: ktoprad ! index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! index in host model arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! index in RRTMGP array corresponding to top layer or interface of host model arrays integer, intent(in) :: idxday(:) ! indices of daylight columns in the chunk real(kind_phys), intent(in) :: tiny ! definition of tiny in RRTMGP real(kind_phys), intent(in) :: c_cld_tau(:,:,:) ! combined cloud extinction optical depth diff --git a/schemes/rrtmgp/rrtmgp_variables.F90 b/schemes/rrtmgp/rrtmgp_variables.F90 index 2e198a28..ac436726 100644 --- a/schemes/rrtmgp/rrtmgp_variables.F90 +++ b/schemes/rrtmgp/rrtmgp_variables.F90 @@ -12,14 +12,13 @@ module rrtmgp_variables !> \section arg_table_rrtmgp_variables_init Argument Table !! \htmlinclude rrtmgp_variables_init.html !! - subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, rad_heat, & + subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, & fluxlwup_Jac, use_tlev, errmsg, errflg) use ccpp_kinds, only: kind_phys real(kind_phys), intent(in) :: unset_real ! Definition of "unset" logical, intent(out) :: active_call_array(:) ! Diagnostic subcycles real(kind_phys), intent(out) :: tlev(:,:) ! Air temperature at interfaces [K] real(kind_phys), intent(out) :: fluxlwup_Jac(:,:) ! Surface temperature flux Jacobian [W m-2 K-1] - real(kind_phys), intent(out) :: rad_heat(:,:) ! Tendency of dry air enthalpy at constant pressure [J kg-1 s-1] logical, intent(out) :: use_tlev ! Flag to use temperature at interfaces in radiation calculation character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,9 +35,6 @@ subroutine rrtmgp_variables_init(unset_real, active_call_array, tlev, rad_heat, tlev = unset_real fluxlwup_Jac = unset_real - ! Initialize rad_heat - rad_heat = unset_real - end subroutine rrtmgp_variables_init !> \section arg_table_rrtmgp_variables_timestep_init Argument Table diff --git a/schemes/rrtmgp/rrtmgp_variables.meta b/schemes/rrtmgp/rrtmgp_variables.meta index d52a4bfb..3827a9f2 100644 --- a/schemes/rrtmgp/rrtmgp_variables.meta +++ b/schemes/rrtmgp/rrtmgp_variables.meta @@ -23,12 +23,6 @@ type = real | kind = kind_phys dimensions = (horizontal_dimension,vertical_interface_dimension) intent = out -[ rad_heat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = J kg-1 s-1 - type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) - intent = out [ fluxlwup_Jac ] standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP units = W m-2 K-1 diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 index c1606516..ffa1e374 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.F90 +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -23,9 +23,9 @@ module calculate_net_heating !> \section arg_table_calculate_net_heating_run Argument Table !! \htmlinclude calculate_net_heating_run.html !! -subroutine calculate_net_heating_run(ncol, rad_heat, qrl_prime, qrs_prime, & - is_offline_dyn, fsns, fsnt, flns, flnt, net_flx, & - errmsg, errflg) +subroutine calculate_net_heating_run(ncol, qrl_prime, qrs_prime, & + is_offline_dyn, fsns, fsnt, flns, flnt, rad_heat, & + net_flx, errmsg, errflg) !----------------------------------------------------------------------- ! Compute net radiative heating from qrs and qrl, and the associated net ! boundary flux. diff --git a/schemes/rrtmgp/utils/calculate_net_heating.meta b/schemes/rrtmgp/utils/calculate_net_heating.meta index a5494962..7eedfe1b 100644 --- a/schemes/rrtmgp/utils/calculate_net_heating.meta +++ b/schemes/rrtmgp/utils/calculate_net_heating.meta @@ -11,12 +11,6 @@ type = integer dimensions = () intent = in -[ rad_heat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure - units = J kg-1 s-1 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent, vertical_layer_dimension) - intent = inout [ qrl_prime ] standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_longwave_radiation units = J kg-1 s-1 @@ -59,6 +53,12 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in +[ rad_heat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout [ net_flx ] standard_name = total_column_radiative_flux units = W m-2 From a9707699db4399695c03d58577705da05fbc385b Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 19 Dec 2025 12:18:07 -0700 Subject: [PATCH 131/140] add subroutine name to error message --- schemes/rrtmgp/rrtmgp_inputs_setup.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 index c5622c6c..3d711219 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.F90 +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.F90 @@ -129,7 +129,7 @@ subroutine rrtmgp_inputs_setup_init(nswbands, nlwbands, pref_edge, pver, pverp, if (use_rad_dt_cosz) then if (iradsw < 0) then errflg = 1 - write(errmsg,*) 'iradsw is negative; has not been properly adjusted' + write(errmsg,*) 'rrtmgp_inputs_setup_init: iradsw is negative; has not been properly adjusted' return end if dt_avg = iradsw*timestep_size From a385cf1ee5e5b39f9b1a36ab8d9589316f394275 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 22 Dec 2025 10:47:04 -0700 Subject: [PATCH 132/140] unify gpuized and cpuized schemes --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 9 + schemes/rrtmgp/rrtmgp_lw_gas_optics.meta | 2 + schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 | 400 ------------------ schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta | 143 ------- .../rrtmgp_lw_gas_optics_gpu_namelist.xml | 91 ---- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 14 + schemes/rrtmgp/rrtmgp_lw_rte.meta | 1 + schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 | 242 ----------- schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta | 131 ------ schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 3 + schemes/rrtmgp/rrtmgp_sw_gas_optics.meta | 2 + schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 | 389 ----------------- schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta | 121 ------ .../rrtmgp_sw_gas_optics_gpu_namelist.xml | 91 ---- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 9 + schemes/rrtmgp/rrtmgp_sw_rte.meta | 1 + schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 | 129 ------ schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta | 121 ------ 18 files changed, 41 insertions(+), 1858 deletions(-) delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta delete mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml delete mode 100644 schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta delete mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta delete mode 100644 schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml delete mode 100644 schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 delete mode 100644 schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index c1c88272..3d1bd0b4 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -357,6 +357,14 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + !$acc data copyin(lw_gas_props%gas_props, p_lay, p_lev, t_lay, & + !$acc tsfg, gas_concs%gas_concs) & + !$acc copy(lw_optical_props_clrsky%optical_props, lw_optical_props_clrsky%optical_props%tau, & + !$acc sources%sources, sources%sources%lay_source, & + !$acc sources%sources%sfc_source, & + !$acc sources%sources%lev_source, & + !$acc sources%sources%sfc_source_jac) + if (include_interface_temp) then errmsg = lw_gas_props%gas_props%gas_optics(& p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) @@ -385,6 +393,7 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l errflg = 1 end if end if + !$acc end data end subroutine rrtmgp_lw_gas_optics_run diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta index 162f26cd..493c1294 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.meta @@ -3,6 +3,8 @@ type = scheme dependencies = ext/rte-kernels/mo_rte_kind.F90 dependencies = objects/ccpp_gas_concentrations.F90 + dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 + dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 [ccpp-arg-table] name = rrtmgp_lw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 deleted file mode 100644 index 74d7cd87..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.F90 +++ /dev/null @@ -1,400 +0,0 @@ -!> \file rrtmgp_lw_gas_optics_gpu.F90 -!! - -!> This module contains a run routine to compute gas optics during the radiation subcycle -module rrtmgp_lw_gas_optics_gpu - - implicit none - private - - public :: rrtmgp_lw_gas_optics_gpu_init - public :: rrtmgp_lw_gas_optics_gpu_run - -contains - -!> \section arg_table_rrtmgp_lw_gas_optics_gpu_init Argument Table -!! \htmlinclude rrtmgp_lw_gas_optics_gpu_init.html -!! - subroutine rrtmgp_lw_gas_optics_gpu_init(kdist, lw_filename, available_gases, & - errmsg, errflg) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - use mo_rte_kind, only: wl - - ! Inputs - character(len=*), intent(in) :: lw_filename ! Full path to RRTMGP longwave coefficients file - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - - ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object - character(len=512), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errflg ! CCPP error code - - ! Local variables - class(abstract_netcdf_reader_t), pointer :: file_reader - character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band - integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:,:), allocatable :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point - real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:,:), allocatable :: totplnk ! Integrated Planck function by band - real(kind_phys), dimension(:,:), allocatable :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation - real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable - integer, parameter :: missing_variable_error_code = 3 - character(len=256) :: alloc_errmsg - integer :: idx - - ! Initialize error variables - errmsg = '' - errflg = 0 - - file_reader => create_netcdf_reader_t() - - ! Open the longwave coefficients file - call file_reader%open_file(lw_filename, errmsg, errflg) - if (errflg /= 0) then - return - end if - - ! Read the coefficients from the file - call file_reader%get_var('gas_names', gas_names, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('key_species', key_species, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('press_ref', press_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kmajor', kmajor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('totplnk', totplnk, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('plank_fraction', planck_frac, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('optimal_angle_fit', optimal_angle_fit, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) - ! OK if variable is not on file - if (errflg /= 0 .and. errflg /= missing_variable_error_code) then - return - end if - if (errflg /= missing_variable_error_code) then - allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) - rayl_lower_allocatable = rayl_lower - end if - call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) - ! OK if variable is not on file - if (errflg /= 0 .and. errflg /= missing_variable_error_code) then - return - end if - if (errflg /= missing_variable_error_code) then - allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) - rayl_upper_allocatable = rayl_upper - end if - call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - minor_scales_with_density_lower(idx) = .false. - else - minor_scales_with_density_lower(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - scale_by_complement_lower(idx) = .false. - else - scale_by_complement_lower(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - minor_scales_with_density_upper(idx) = .false. - else - minor_scales_with_density_upper(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - scale_by_complement_upper(idx) = .false. - else - scale_by_complement_upper(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - - ! Close the longwave coefficients file - call file_reader%close_file(errmsg, errflg) - if (errflg /= 0) then - return - end if - deallocate(file_reader) - nullify(file_reader) - - ! Initialize the gas optics object with data. - errmsg = kdist%gas_props%load( & - available_gases%gas_concs, gas_names, key_species, & - band2gpt, band_lims_wavenum, & - press_ref, press_ref_trop, temp_ref, & - temp_ref_p, temp_ref_t, vmr_ref, & - kmajor, kminor_lower, kminor_upper, & - gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, & - minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, & - scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, & - totplnk, planck_frac, rayl_lower_allocatable, rayl_upper_allocatable, & - optimal_angle_fit) - - if (len_trim(errmsg) > 0) then - errflg = 1 - end if - call check_error_msg('rrtmgp_lw_gas_optics_gpu_init_load', errmsg) - - end subroutine rrtmgp_lw_gas_optics_gpu_init - -!> \section arg_table_rrtmgp_lw_gas_optics_gpu_run Argument Table -!! \htmlinclude rrtmgp_lw_gas_optics_gpu_run.html -!! - subroutine rrtmgp_lw_gas_optics_gpu_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & - gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & - errmsg, errflg) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use radiation_tools, only: check_error_msg - ! Inputs - logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation - logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation - integer, intent(in) :: iter_num !< Subcycle iteration number - integer, intent(in) :: ncol !< Total number of columns - integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once - real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] - real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] - real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] - real(kind_phys), dimension(:), intent(in) :: tsfg !< Surface skin temperature [K] - real(kind_phys), dimension(:,:), intent(in) :: t_lev !< Air temperature at interfaces [K] - type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object - - ! Outputs - type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties - type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object - type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: iCol, iCol2 - - ! Set error variables - errmsg = '' - errflg = 0 - - if (.not. dolw) then - return - end if - - iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 - iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) - - !$acc data copyin(lw_gas_props%gas_props, p_lay, p_lev, t_lay, & - !$acc tsfg, gas_concs%gas_concs) & - !$acc copy(lw_optical_props_clrsky%optical_props, lw_optical_props_clrsky%optical_props%tau, & - !$acc sources%sources, sources%sources%lay_source, & - !$acc sources%sources%sfc_source, & - !$acc sources%sources%lev_source, & - !$acc sources%sources%sfc_source_jac) - - if (include_interface_temp) then - errmsg = lw_gas_props%gas_props%gas_optics(& - p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) - gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios - lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties - sources%sources, & ! OUT - RRTMGP DDT: source functions - tlev=t_lev(iCol:iCol2,:)) ! IN - Temperature @ layer-interfaces (K) (optional) - call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - else - errmsg = lw_gas_props%gas_props%gas_optics(& - p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) - gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties - sources%sources) ! OUT - RRTMGP DDT: source functions - call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if - !$acc end data - - end subroutine rrtmgp_lw_gas_optics_gpu_run - -end module rrtmgp_lw_gas_optics_gpu diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta deleted file mode 100644 index e0208f10..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu.meta +++ /dev/null @@ -1,143 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_gas_optics_gpu - type = scheme - dependencies = ext/rte-kernels/mo_rte_kind.F90 - dependencies = objects/ccpp_gas_concentrations.F90 - dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 - dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 - -[ccpp-arg-table] - name = rrtmgp_lw_gas_optics_gpu_init - type = scheme -[ kdist ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = out -[ lw_filename ] - standard_name = filename_of_rrtmgp_longwave_k_distribution - units = none - type = character | kind = len=* - dimensions = () - intent = in -[ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP - units = none - type = ty_gas_concs_ccpp - dimensions = () - intent = in -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out - -[ccpp-arg-table] - name = rrtmgp_lw_gas_optics_gpu_run - type = scheme -[ dolw ] - standard_name = do_longwave_radiation - units = flag - type = logical - dimensions = () - intent = in -[ iter_num ] - standard_name = iteration_number_for_radiation_subcycle - units = count - type = integer - dimensions = () - intent = in -[ ncol ] - standard_name = horizontal_loop_extent - units = count - type = integer - dimensions = () - intent = in -[ rrtmgp_phys_blksz ] - standard_name = number_of_columns_per_longwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in -[ p_lay ] - standard_name = air_pressure_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) - intent = in -[ p_lev ] - standard_name = air_pressure_at_interface_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP_plus_one) - intent = in -[ t_lay ] - standard_name = air_temperature_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_vertical_layers_in_RRTMGP) - intent = in -[ tsfg ] - standard_name = ground_temperature_at_surface_for_radiation - units = K - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) - intent = in -[ gas_concs ] - standard_name = longwave_gas_volume_mixing_ratios_object_for_RRTMGP - units = none - type = ty_gas_concs_ccpp - dimensions = () - intent = in -[ lw_optical_props_clrsky ] - standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_1scl_ccpp - dimensions = () - intent = inout -[ sources ] - standard_name = longwave_planck_sources_object_for_RRTMGP - units = none - type = ty_source_func_lw_ccpp - dimensions = () - intent = inout -[ t_lev ] - standard_name = air_temperature_at_interface_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - intent = in -[ include_interface_temp ] - standard_name = include_air_temperature_at_interfaces_in_gas_optics_calculation - units = flag - type = logical - dimensions = () - intent = in -[ lw_gas_props ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = inout -[ errmsg ] - standard_name = ccpp_error_message - long_name = Error message for error handling in CCPP - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - long_name = Error flag for error handling in CCPP - units = 1 - type = integer - dimensions = () - intent = out diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml b/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml deleted file mode 100644 index 4473a504..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics_gpu_namelist.xml +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - char*512 - rrtmgp_lw_gas_optics - rrtmgp_lw_gas_optics - filename_of_rrtmgp_longwave_k_distribution - none - - The filename of the longwave coefficients file for RRTMGP - - - ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-lw-g128.nc - - - diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index 4623fc73..1fb4f802 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -57,6 +57,19 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, if (.not. doLWrad) return + !$acc data copyin(lw_optical_props_clrsky%optical_props,lw_optical_props_clrsky%optical_props%tau, & + !$acc aerlw%optical_props,aerlw%optical_props%tau, & + !$acc lw_optical_props_clouds%optical_props, lw_optical_props_clouds%optical_props%tau, & + !$acc sources%sources,sources%sources%lay_source, & + !$acc sources%sources%sfc_source, & + !$acc sources%sources%lev_source, & + !$acc sources%sources%sfc_source_jac, & + !$acc sfc_emiss_byband) & + !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net, flux_clrsky%fluxes%flux_up, & + !$acc flux_clrsky%fluxes%flux_dn, flux_allsky%fluxes, flux_allsky%fluxes%flux_net, & + !$acc flux_allsky%fluxes%flux_up, flux_allsky%fluxes%flux_dn, & + !$acc lw_Ds) + ! ################################################################################### ! ! Compute clear-sky fluxes (gaseous+aerosol) (optional) @@ -223,6 +236,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, if (len_trim(errmsg) /= 0) then errflg = 1 end if + !$acc end data end subroutine rrtmgp_lw_rte_run end module rrtmgp_lw_rte diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.meta b/schemes/rrtmgp/rrtmgp_lw_rte.meta index f4b57c63..5e01a45a 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_lw_rte.meta @@ -7,6 +7,7 @@ dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 dependencies = ../../../../utils/machine.F90 dependencies = ./utils/radiation_tools.F90 dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 diff --git a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 deleted file mode 100644 index 1ced98eb..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.F90 +++ /dev/null @@ -1,242 +0,0 @@ -!> \file rrtmgp_lw_rte_gpu.F90 -!! - -!> This module contains the call to the RRTMGP-LW radiation routine -module rrtmgp_lw_rte_gpu - implicit none - private - - public rrtmgp_lw_rte_gpu_run -contains - -!> \section arg_table_rrtmgp_lw_rte_gpu_run Argument Table -!! \htmlinclude rrtmgp_lw_rte_gpu_run.html -!! - subroutine rrtmgp_lw_rte_gpu_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & - nGauss_angles, lw_optical_props_clrsky, lw_optical_props_clouds, & - sources, sfc_emiss_byband, lw_gas_props, aerlw, fluxlwUP_jac, lw_Ds, & - flux_clrsky, flux_allsky, errmsg, errflg) - use machine, only: kind_phys - use mo_rte_lw, only: rte_lw - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp - use ccpp_optical_props, only: ty_optical_props_1scl_ccpp - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_source_functions, only: ty_source_func_lw_ccpp - use radiation_tools, only: check_error_msg - - ! Inputs - logical, intent(in) :: doLWrad !< Flag to perform longwave calculation - logical, intent(in) :: doLWclrsky !< Flag to compute clear-sky fluxes - logical, intent(in) :: doGP_lwscat !< Flag to include scattering in clouds - logical, intent(in) :: use_LW_jacobian !< Flag to compute Jacobian - logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles - - integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used - - real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band - class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object - - ! Outputs - real(kind_phys), dimension(:,:), target, intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] - class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] - class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] - class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object - class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clear-sky optical properties object - class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clouds !< Cloud optical properties object - - class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object - - real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point - character(len=512),intent(out) :: errmsg !< CCPP error message - integer, intent(out) :: errflg !< CCPP error flag - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doLWrad) return - - !$acc data copyin(lw_optical_props_clrsky%optical_props,lw_optical_props_clrsky%optical_props%tau, & - !$acc aerlw%optical_props,aerlw%optical_props%tau, & - !$acc lw_optical_props_clouds%optical_props, lw_optical_props_clouds%optical_props%tau, & - !$acc sources%sources,sources%sources%lay_source, & - !$acc sources%sources%sfc_source, & - !$acc sources%sources%lev_source, & - !$acc sources%sources%sfc_source_jac, & - !$acc sfc_emiss_byband) & - !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net, flux_clrsky%fluxes%flux_up, & - !$acc flux_clrsky%fluxes%flux_dn, flux_allsky%fluxes, flux_allsky%fluxes%flux_net, & - !$acc flux_allsky%fluxes%flux_up, flux_allsky%fluxes%flux_dn, & - !$acc lw_Ds) - - ! ################################################################################### - ! - ! Compute clear-sky fluxes (gaseous+aerosol) (optional) - ! - ! ################################################################################### - ! Increment - errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) - call check_error_msg('rrtmgp_lw_rte_gpu_increment_aerosol_to_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - - ! Call RTE solver - if (doLWclrsky) then - if (use_lw_optimal_angles) then - errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) - call check_error_msg('rrtmgp_lw_rte_gpu_opt_angle', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point - else - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes, & ! OUT - Fluxes - lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point - end if - else - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - else - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_clrsky%fluxes) ! OUT - Fluxes - end if - end if - call check_error_msg('rrtmgp_lw_rte_gpu_lw_rte_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - end if - - ! ################################################################################### - ! - ! All-sky fluxes (clear-sky + clouds + precipitation) - ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP - ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the - ! type to determine physics configuration/pathway/etc... - ! - ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. - ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the - ! rte solver (rte_lw). Rte_lw queries the type to determine if scattering is to be - ! included in the calculation. The increment procedures are called so that the correct - ! optical properties are inherited. - ! - ! ################################################################################### - - ! Include LW cloud-scattering? - if (doGP_lwscat) then - ! Increment - errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) - call check_error_msg('rrtmgp_lw_rte_gpu_increment_clrsky_to_clouds', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - if (use_LW_jacobian) then - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - else - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - end if - else - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - else - errmsg = rte_lw( & - lw_optical_props_clouds%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes) ! OUT - Fluxes - end if - end if - ! No scattering in LW clouds. - else - ! Increment - errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) - call check_error_msg('rrtmgp_lw_rte_gpu_increment_clouds_to_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - - if (use_LW_jacobian) then - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - else - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) - end if - else - if (nGauss_angles > 1) then - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes, & ! OUT - Fluxes - n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - else - errmsg = rte_lw( & - lw_optical_props_clrsky%optical_props, & ! IN - optical-properties - sources%sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky%fluxes) ! OUT - Fluxes - end if - end if - end if - call check_error_msg('rrtmgp_lw_rte_gpu_lw_rte_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - !$acc end data - - end subroutine rrtmgp_lw_rte_gpu_run -end module rrtmgp_lw_rte_gpu diff --git a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta b/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta deleted file mode 100644 index fed84f20..00000000 --- a/schemes/rrtmgp/rrtmgp_lw_rte_gpu.meta +++ /dev/null @@ -1,131 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_lw_rte_gpu - type = scheme - dependencies = ext/rte-frontend/mo_rte_lw.F90 - dependencies = ext/rte-frontend/mo_rte_config.F90 - dependencies = ext/rte-kernels/mo_rte_util_array.F90 - dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 - dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 - dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = ../../../../utils/machine.F90 - dependencies = ./utils/radiation_tools.F90 - dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 - dependencies = ./objects/ccpp_optical_props.F90 - dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 - dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 - -[ccpp-arg-table] - name = rrtmgp_lw_rte_gpu_run - type = scheme -[ doLWrad ] - standard_name = do_longwave_radiation - units = flag - type = logical - dimensions = () - intent = in -[ doLWclrsky ] - standard_name = do_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky - units = flag - type = logical - dimensions = () - intent = in -[ doGP_lwscat ] - standard_name = include_longwave_scattering_in_cloud_optics - units = flag - type = logical - dimensions = () - intent = in -[ use_LW_jacobian ] - standard_name = calculate_longwave_jacobian_for_RRTMGP - units = flag - type = logical - dimensions = () - intent = in -[ use_LW_optimal_angles ] - standard_name = compute_optimal_angles_for_use_in_RRTMGP_longwave_calculation - units = flag - type = logical - dimensions = () - intent = in -[ nGauss_angles ] - standard_name = number_of_gaussian_quadrature_angles_for_radiation - units = count - type = integer - dimensions = () - intent = in -[ lw_optical_props_clrsky ] - standard_name = longwave_atmosphere_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_1scl_ccpp - dimensions = () - intent = inout -[ lw_optical_props_clouds ] - standard_name = longwave_cloud_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_1scl_ccpp - dimensions = () - intent = inout -[ sources ] - standard_name = longwave_planck_sources_object_for_RRTMGP - units = none - type = ty_source_func_lw_ccpp - dimensions = () - intent = in -[ sfc_emiss_byband ] - standard_name = longwave_emissivity_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_longwave_radiation,horizontal_loop_extent) - intent = in -[ lw_gas_props ] - standard_name = longwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = inout -[ aerlw ] - standard_name = longwave_aerosol_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_1scl_ccpp - dimensions = () - intent = inout -[ fluxlwUP_jac ] - standard_name = jacobian_of_longwave_upward_flux_for_RRTMGP - units = W m-2 K-1 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - intent = inout -[ lw_Ds ] - standard_name = inverse_cosine_of_radiation_transport_angle_per_column_and_g_point - units = 1 - type = real | kind = kind_phys - dimensions = (horizontal_loop_extent,number_of_longwave_g_point_intervals) - allocatable = True - intent = out -[ flux_clrsky ] - standard_name = longwave_clear_sky_flux_object_for_RRTMGP - units = none - type = ty_fluxes_broadband_ccpp - dimensions = () - intent = inout -[ flux_allsky ] - standard_name = longwave_all_sky_flux_object_for_RRTMGP - units = none - type = ty_fluxes_byband_ccpp - dimensions = () - intent = inout -[ errmsg ] - standard_name = ccpp_error_message - long_name = Error message for error handling in CCPP - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - long_name = Error flag for error handling in CCPP - units = 1 - type = integer - dimensions = () - intent = out - diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 787f5c1c..5d2861a1 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -368,6 +368,8 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs,sw_optical_props%optical_props) & + !$acc copyout(toa_src_sw) errmsg = sw_gas_props%gas_props%gas_optics(& p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) @@ -380,6 +382,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l if (len_trim(errmsg) /= 0) then errflg = 1 end if + !$acc end data end subroutine rrtmgp_sw_gas_optics_run diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta index a4ac2a90..ad51b13b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.meta @@ -1,6 +1,8 @@ [ccpp-table-properties] name = rrtmgp_sw_gas_optics type = scheme + dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 + dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 deleted file mode 100644 index 4ddadf5f..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.F90 +++ /dev/null @@ -1,389 +0,0 @@ -!> \file rrtmgp_sw_gas_optics_gpu.F90 -!! - -!> This module contains an init routine to initialize the shortwave gas optics object -!> with data read in from file on the host side -module rrtmgp_sw_gas_optics_gpu - - implicit none - private - public :: rrtmgp_sw_gas_optics_gpu_init - public :: rrtmgp_sw_gas_optics_gpu_run - -contains -!> \section arg_table_rrtmgp_sw_gas_optics_gpu_init Argument Table -!! \htmlinclude rrtmgp_sw_gas_optics_gpu_init.html -!! - subroutine rrtmgp_sw_gas_optics_gpu_init(kdist, sw_filename, available_gases, & - errmsg, errflg) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use radiation_tools, only: check_error_msg - use ccpp_io_reader, only: abstract_netcdf_reader_t, create_netcdf_reader_t - use mo_rte_kind, only: wl - - ! Inputs - character(len=*), intent(in) :: sw_filename ! Full path to RRTMGP shortwave coefficients file - class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object - - ! Outputs - class(ty_gas_optics_rrtmgp_ccpp), intent(out) :: kdist ! RRTMGP gas optics object - character(len=512), intent(out) :: errmsg ! CCPP error message - integer, intent(out) :: errflg ! CCPP error code - - ! Local variables - class(abstract_netcdf_reader_t), pointer :: file_reader - character(len=:), dimension(:), allocatable :: gas_names ! Names of absorbing gases - character(len=:), dimension(:), allocatable :: gas_minor ! Name of absorbing minor gas - character(len=:), dimension(:), allocatable :: identifier_minor ! Unique string identifying minor gas - character(len=:), dimension(:), allocatable :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere - character(len=:), dimension(:), allocatable :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere - character(len=:), dimension(:), allocatable :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere - character(len=:), dimension(:), allocatable :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere - integer, dimension(:,:,:), allocatable :: key_species ! Key species pair for each band - integer, dimension(:,:), allocatable :: band2gpt ! Array for converting shortwave band limits to g-points - integer, dimension(:,:), allocatable :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere - integer, dimension(:,:), allocatable :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:), allocatable :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" - integer, dimension(:), allocatable :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" - logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere - logical(wl), dimension(:), allocatable :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere - logical(wl), dimension(:), allocatable :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere - logical(wl), dimension(:), allocatable :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere - real(kind_phys), dimension(:,:,:,:), allocatable :: kmajor ! Stored absorption coefficients due to major absorbing gases - real(kind_phys), dimension(:,:,:), allocatable :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array - real(kind_phys), dimension(:,:,:), allocatable :: vmr_ref ! Volume mixing ratios for reference atmosphere - real(kind_phys), dimension(:,:), allocatable :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] - real(kind_phys), dimension(:), allocatable :: press_ref ! Pressures for reference atmosphere [Pa] - real(kind_phys), dimension(:), allocatable :: temp_ref ! Temperatures for reference atmosphere [K] - real(kind_phys), dimension(:), allocatable :: solar_src_quiet ! Quiet sun term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), allocatable :: solar_src_facular ! Facular brightening term of incoming solar irradiance [W m-2] - real(kind_phys), dimension(:), allocatable :: solar_src_sunspot ! Sunspot dimming term of incoming solar irradiance [W m-2] - real(kind_phys), allocatable :: mg_default ! Mean value of Mg2 solar activity index [1] - real(kind_phys), allocatable :: sb_default ! Mean value of sunspot index [1] - real(kind_phys), allocatable :: tsi_default ! Default total solar irradiance [W m-2] - real(kind_phys), allocatable :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] - real(kind_phys), allocatable :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] - real(kind_phys), allocatable :: temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_lower_allocatable ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere - real(kind_phys), dimension(:,:,:), allocatable :: rayl_upper_allocatable ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere - integer, dimension(:), allocatable :: int2log ! use this to convert integer-to-logical. - integer, parameter :: missing_variable_error_code = 3 - character(len=256) :: alloc_errmsg - integer :: idx - - ! Initialize error variables - errmsg = '' - errflg = 0 - - file_reader => create_netcdf_reader_t() - - ! Open the shortwave coefficients file - call file_reader%open_file(sw_filename, errmsg, errflg) - if (errflg /= 0) then - return - end if - - ! Read the coefficients from the file - call file_reader%get_var('gas_names', gas_names, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('key_species', key_species, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('bnd_limits_gpt', band2gpt, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('bnd_limits_wavenumber', band_lims_wavenum, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('press_ref', press_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('press_ref_trop', press_ref_trop, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('temp_ref', temp_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('absorption_coefficient_ref_T', temp_ref_t, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('absorption_coefficient_ref_P', temp_ref_p, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('vmr_ref', vmr_ref, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kmajor', kmajor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_lower', kminor_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_upper', kminor_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('solar_source_quiet', solar_src_quiet, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('solar_source_facular', solar_src_facular, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('solar_source_sunspot', solar_src_sunspot, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('tsi_default', tsi_default, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('mg_default', mg_default, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('sb_default', sb_default, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('rayl_lower', rayl_lower, errmsg, errflg) - ! OK if variable is not on file - if (errflg /= 0 .and. errflg /= missing_variable_error_code) then - return - end if - if (errflg /= missing_variable_error_code) then - allocate(rayl_lower_allocatable(size(rayl_lower,1), size(rayl_lower,2), size(rayl_lower,3))) - rayl_lower_allocatable = rayl_lower - end if - call file_reader%get_var('rayl_upper', rayl_upper, errmsg, errflg) - ! OK if variable is not on file - if (errflg /= 0 .and. errflg /= missing_variable_error_code) then - return - end if - if (errflg /= missing_variable_error_code) then - allocate(rayl_upper_allocatable(size(rayl_upper,1), size(rayl_upper,2), size(rayl_upper,3))) - rayl_upper_allocatable = rayl_upper - end if - call file_reader%get_var('gas_minor', gas_minor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('identifier_minor', identifier_minor, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_gases_lower', minor_gases_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_gases_upper', minor_gases_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_limits_gpt_lower', minor_limits_gpt_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_limits_gpt_upper', minor_limits_gpt_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('minor_scales_with_density_lower', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(minor_scales_with_density_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - minor_scales_with_density_lower(idx) = .false. - else - minor_scales_with_density_lower(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scale_by_complement_lower', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(scale_by_complement_lower(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_lower" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - scale_by_complement_lower(idx) = .false. - else - scale_by_complement_lower(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('minor_scales_with_density_upper', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(minor_scales_with_density_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "minor_scales_with_density_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - minor_scales_with_density_upper(idx) = .false. - else - minor_scales_with_density_upper(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scale_by_complement_upper', int2log, errmsg, errflg) - if (errflg /= 0) then - return - end if - allocate(scale_by_complement_upper(size(int2log)), stat=errflg, errmsg=alloc_errmsg) - if (errflg /= 0) then - write(errmsg, '(a,a)') 'Error allocating "scale_by_complement_upper" - message: ', alloc_errmsg - return - end if - do idx = 1, size(int2log) - if (int2log(idx) == 0) then - scale_by_complement_upper(idx) = .false. - else - scale_by_complement_upper(idx) = .true. - end if - end do - deallocate(int2log) - call file_reader%get_var('scaling_gas_lower', scaling_gas_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('scaling_gas_upper', scaling_gas_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_start_lower', kminor_start_lower, errmsg, errflg) - if (errflg /= 0) then - return - end if - call file_reader%get_var('kminor_start_upper', kminor_start_upper, errmsg, errflg) - if (errflg /= 0) then - return - end if - - ! Close the shortwave coefficients file - call file_reader%close_file(errmsg, errflg) - if (errflg /= 0) then - return - end if - - deallocate(file_reader) - nullify(file_reader) - - ! Initialize the gas optics object with data. - errmsg = kdist%gas_props%load( & - available_gases%gas_concs, gas_names, key_species, & - band2gpt, band_lims_wavenum, & - press_ref, press_ref_trop, temp_ref, & - temp_ref_p, temp_ref_t, vmr_ref, & - kmajor, kminor_lower, kminor_upper, & - gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, & - minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, & - minor_scales_with_density_upper, & - scaling_gas_lower, scaling_gas_upper, & - scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, & - solar_src_quiet, solar_src_facular, solar_src_sunspot, & - tsi_default, mg_default, sb_default, & - rayl_lower_allocatable, rayl_upper_allocatable) - - if (len_trim(errmsg) > 0) then - errflg = 1 - end if - call check_error_msg('rrtmgp_sw_gas_optics_gpu_init_load', errmsg) - - end subroutine rrtmgp_sw_gas_optics_gpu_init - -!> \section arg_table_rrtmgp_sw_gas_optics_gpu_run Argument Table -!! \htmlinclude rrtmgp_sw_gas_optics_gpu_run.html -!! - subroutine rrtmgp_sw_gas_optics_gpu_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, & - gas_concs, sw_optical_props, sw_gas_props, toa_src_sw, errmsg, errflg) - use machine, only: kind_phys - use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp - use ccpp_gas_concentrations, only: ty_gas_concs_ccpp - use ccpp_optical_props, only: ty_optical_props_2str_ccpp - use radiation_tools, only: check_error_msg - ! Inputs - logical, intent(in) :: dosw !< Flag for whether to perform shortwave calculation - integer, intent(in) :: iter_num !< Subcycle iteration number - integer, intent(in) :: ncol !< Daytime points dimension - integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once - real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] - real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] - real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] - type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object - - ! Outputs - type(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clearsky optical properties - type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: sw_gas_props !< RRTMGP gas optics object - real(kind_phys), intent(out) :: toa_src_sw(:,:) !< Top of atmosphere solar radiation flux on g points [W m-2] - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: iCol, iCol2 - - ! Set error variables - errmsg = '' - errflg = 0 - - if (.not. dosw .or. ncol == 0) then - return - end if - - iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 - iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) - - !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs,sw_optical_props%optical_props) & - !$acc copyout(toa_src_sw) - errmsg = sw_gas_props%gas_props%gas_optics(& - p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios - sw_optical_props%optical_props, & ! OUT - RRTMGP DDT: Shortwave optical properties, by - ! spectral point (tau,ssa,g) - toa_src_sw) ! OUT - TOA incident shortwave radiation (spectral) - - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - !$acc end data - - end subroutine rrtmgp_sw_gas_optics_gpu_run - -end module rrtmgp_sw_gas_optics_gpu diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta deleted file mode 100644 index 0ab39203..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu.meta +++ /dev/null @@ -1,121 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_gas_optics_gpu - type = scheme - dependencies = ext/rte-kernels/accel/mo_optical_props_kernels.F90 - dependencies = ext/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 - -[ccpp-arg-table] - name = rrtmgp_sw_gas_optics_gpu_init - type = scheme -[ kdist ] - standard_name = shortwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = out -[ sw_filename ] - standard_name = filename_of_rrtmgp_shortwave_k_distribution - units = none - type = character | kind = len=* - dimensions = () - intent = in -[ available_gases ] - standard_name = gas_concentrations_rrtmgp_object_for_RRTMGP - units = none - type = ty_gas_concs_ccpp - dimensions = () - intent = in -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out - -[ccpp-arg-table] - name = rrtmgp_sw_gas_optics_gpu_run - type = scheme -[ dosw ] - standard_name = do_shortwave_radiation - units = flag - type = logical - dimensions = () - intent = in -[ iter_num ] - standard_name = iteration_number_for_radiation_subcycle - units = count - type = integer - dimensions = () - intent = in -[ ncol ] - standard_name = daytime_points_dimension - units = count - type = integer - dimensions = () - intent = in -[ rrtmgp_phys_blksz ] - standard_name = number_of_columns_per_longwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in -[ p_lay ] - standard_name = air_pressure_for_daytime_points_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) - intent = in -[ p_lev ] - standard_name = air_pressure_at_interface_for_daytime_points_for_RRTMGP - units = Pa - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP_plus_one) - intent = in -[ t_lay ] - standard_name = air_temperature_for_daytime_points_for_RRTMGP - units = K - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_vertical_layers_in_RRTMGP) - intent = in -[ gas_concs ] - standard_name = shortwave_gas_volume_mixing_ratios_object_for_RRTMGP - units = none - type = ty_gas_concs_ccpp - dimensions = () - intent = in -[ sw_optical_props ] - standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_2str_ccpp - dimensions = () - intent = inout -[ sw_gas_props ] - standard_name = shortwave_gas_optics_object_for_RRTMGP - units = none - type = ty_gas_optics_rrtmgp_ccpp - dimensions = () - intent = inout -[ toa_src_sw ] - standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points - units = W m-2 - type = real | kind = kind_phys - dimensions = (daytime_points_dimension, number_of_shortwave_g_point_intervals) - intent = out -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=512 - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml b/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml deleted file mode 100644 index 3747fd28..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics_gpu_namelist.xml +++ /dev/null @@ -1,91 +0,0 @@ - - - - - - - - - char*512 - rrtmgp_sw_gas_optics - rrtmgp_sw_gas_optics - filename_of_rrtmgp_shortwave_k_distribution - none - - The filename of the shortwave coefficients file for RRTMGP - - - ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc - - - diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 479a2b84..a8ab1f79 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -63,6 +63,14 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! Compute clear-sky fluxes (gaseous+aerosol) ! ! ################################################################################### + !$acc data copyin(coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & + !$acc sw_optical_props%optical_props, sw_optical_props%optical_props%tau, sw_optical_props%optical_props%ssa, & + !$acc sw_optical_props%optical_props%g, aersw%optical_props%tau, & + !$acc aersw%optical_props, aersw%optical_props%ssa, aersw%optical_props%g, & + !$acc sw_optical_props_clouds%optical_props, sw_optical_props_clouds%optical_props%tau, sw_optical_props_clouds%optical_props%ssa, & + !$acc sw_optical_props_clouds%optical_props%g) & + !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net,flux_clrsky%fluxes%flux_up,flux_clrsky%fluxes%flux_dn, & + !$acc flux_allsky%fluxes, flux_allsky%fluxes%flux_net,flux_allsky%fluxes%flux_up,flux_allsky%fluxes%flux_dn) ! Increment optics (always) errmsg = aersw%optical_props%increment(sw_optical_props%optical_props) call check_error_msg('rrtmgp_sw_rte_increment_aerosol_to_clrsky', errmsg) @@ -115,6 +123,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr errflg = 1 end if end if + !$acc end data end subroutine rrtmgp_sw_rte_run end module rrtmgp_sw_rte diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.meta b/schemes/rrtmgp/rrtmgp_sw_rte.meta index 966b685c..0d061f38 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.meta +++ b/schemes/rrtmgp/rrtmgp_sw_rte.meta @@ -7,6 +7,7 @@ dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 + dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 dependencies = ../../../../utils/machine.F90 dependencies = ./utils/radiation_tools.F90 dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 diff --git a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 deleted file mode 100644 index c10e4764..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.F90 +++ /dev/null @@ -1,129 +0,0 @@ -!> \file rrtmgp_sw_rte_gpu.F90 -!! - -!> This module contains the call to the RRTMGP-sw radiation routine -module rrtmgp_sw_rte_gpu - implicit none - private - - public rrtmgp_sw_rte_gpu_run -contains - -!> \section arg_table_rrtmgp_sw_rte_gpu_run Argument Table -!! \htmlinclude rrtmgp_sw_rte_gpu_run.html -!! - subroutine rrtmgp_sw_rte_gpu_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rrtmgp_phys_blksz, sw_optical_props, & - sw_optical_props_clouds, aersw, coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & - flux_clrsky, flux_allsky, errmsg, errflg) - use machine, only: kind_phys - use mo_rte_sw, only: rte_sw - use ccpp_optical_props, only: ty_optical_props_2str_ccpp - use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp - use ccpp_fluxes, only: ty_fluxes_broadband_ccpp - use radiation_tools, only: check_error_msg - - ! Inputs - logical, intent(in) :: doswrad !< Flag to perform shortwave calculation - logical, intent(in) :: doswclrsky !< Flag to compute clear-sky fluxes - logical, intent(in) :: doswallsky !< Flag to compute all-sky fluxes - - integer, intent(in) :: nday !< Number of horizontal daylight points - integer, intent(in) :: iter_num !< Radiation subcycle iteration number - integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once - - real(kind_phys), dimension(:,:), intent(in) :: toa_src_sw !< Top-of-atmosphere flux on g-points [W m-2] - real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dir !< Albedo direct at surface [fraction] - real(kind_phys), dimension(:,:), intent(in) :: sfc_alb_dif !< Albedo diffuse at surface [fraction] - real(kind_phys), dimension(:), intent(in) :: coszen_day !< Cosine of solar zenith angle for daytime points - - ! Outputs - class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] - class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] - class(ty_optical_props_2str_ccpp), intent(inout) :: aersw !< Aerosol optical properties object - class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props !< Clear-sky optical properties object - class(ty_optical_props_2str_ccpp), intent(inout) :: sw_optical_props_clouds !< Cloud optical properties object - - character(len=*), intent(out) :: errmsg !< CCPP error message - integer, intent(out) :: errflg !< CCPP error flag - - ! Local variables - integer :: iCol, iCol2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. doswrad .or. rrtmgp_phys_blksz == 0) return - - iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 - iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nday) - - ! ################################################################################### - ! - ! Compute clear-sky fluxes (gaseous+aerosol) - ! - ! ################################################################################### - !$acc data copyin(coszen_day, toa_src_sw, sfc_alb_dir, sfc_alb_dif, & - !$acc sw_optical_props%optical_props, sw_optical_props%optical_props%tau, sw_optical_props%optical_props%ssa, & - !$acc sw_optical_props%optical_props%g, aersw%optical_props%tau, & - !$acc aersw%optical_props, aersw%optical_props%ssa, aersw%optical_props%g, & - !$acc sw_optical_props_clouds%optical_props, sw_optical_props_clouds%optical_props%tau, sw_optical_props_clouds%optical_props%ssa, & - !$acc sw_optical_props_clouds%optical_props%g) & - !$acc copy(flux_clrsky%fluxes, flux_clrsky%fluxes%flux_net,flux_clrsky%fluxes%flux_up,flux_clrsky%fluxes%flux_dn, & - !$acc flux_allsky%fluxes, flux_allsky%fluxes%flux_net,flux_allsky%fluxes%flux_up,flux_allsky%fluxes%flux_dn) - ! Increment optics (always) - errmsg = aersw%optical_props%increment(sw_optical_props%optical_props) - call check_error_msg('rrtmgp_sw_rte_gpu_increment_aerosol_to_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - - ! Optionally compute clear-sky fluxes - if (doswclrsky) then - errmsg = rte_sw( & - sw_optical_props%optical_props, & ! IN - optical-properties - coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle - toa_src_sw, & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky%fluxes) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) - call check_error_msg('rrtmgp_sw_rte_gpu_rte_sw_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - end if - - ! ################################################################################### - ! - ! All-sky fluxes (clear-sky + clouds + precipitation) - ! - ! ################################################################################### - - if (doswallsky) then - ! Increment - errmsg = sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props) - call check_error_msg('rrtmgp_sw_rte_gpu_increment_clouds_to_clrsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return - end if - - ! Compute fluxes - errmsg = rte_sw( & - sw_optical_props%optical_props, & ! IN - optical-properties - coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle - toa_src_sw, & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky%fluxes) ! OUT - Fluxes, all-sky, 3D (1,nLay,nBand) - call check_error_msg('rrtmgp_sw_rte_gpu_rte_sw_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - end if - end if - !$acc end data - - end subroutine rrtmgp_sw_rte_gpu_run -end module rrtmgp_sw_rte_gpu diff --git a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta b/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta deleted file mode 100644 index 77a53a51..00000000 --- a/schemes/rrtmgp/rrtmgp_sw_rte_gpu.meta +++ /dev/null @@ -1,121 +0,0 @@ -[ccpp-table-properties] - name = rrtmgp_sw_rte_gpu - type = scheme - dependencies = ext/rte-frontend/mo_rte_sw.F90 - dependencies = ext/rte-frontend/mo_rte_config.F90 - dependencies = ext/rte-kernels/mo_rte_util_array.F90 - dependencies = ext/rte-frontend/mo_rte_util_array_validation.F90 - dependencies = ext/rte-kernels/mo_rte_solver_kernels.F90 - dependencies = ext/rte-kernels/mo_fluxes_broadband_kernels.F90 - dependencies = ../../../../utils/machine.F90 - dependencies = ./utils/radiation_tools.F90 - dependencies = ./objects/ccpp_source_functions.F90,./objects/ccpp_gas_optics_rrtmgp.F90 - dependencies = ./objects/ccpp_optical_props.F90 - dependencies = ./objects/ccpp_fluxes.F90,./objects/ccpp_fluxes_byband.F90 - dependencies = ext/rte-kernels/accel/mo_rte_solver_kernels.F90 - -[ccpp-arg-table] - name = rrtmgp_sw_rte_gpu_run - type = scheme -[ doswrad ] - standard_name = do_shortwave_radiation - units = flag - type = logical - dimensions = () - intent = in -[ doswclrsky ] - standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky - units = flag - type = logical - dimensions = () - intent = in -[ doswallsky ] - standard_name = do_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_all_sky - units = flag - type = logical - dimensions = () - intent = in -[ nday ] - standard_name = daytime_points_dimension - units = count - type = integer - dimensions = () - intent = in -[ iter_num ] - standard_name = iteration_number_for_radiation_subcycle - units = count - type = integer - dimensions = () - intent = in -[ rrtmgp_phys_blksz ] - standard_name = number_of_columns_per_shortwave_block_for_RRTMGP - units = count - type = integer - dimensions = () - intent = in -[ sw_optical_props ] - standard_name = shortwave_atmosphere_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_2str_ccpp - dimensions = () - intent = inout -[ sw_optical_props_clouds ] - standard_name = shortwave_cloud_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_2str_ccpp - dimensions = () - intent = inout -[ aersw ] - standard_name = shortwave_aerosol_optical_properties_object_for_RRTMGP - units = none - type = ty_optical_props_2str_ccpp - dimensions = () - intent = inout -[ coszen_day ] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep - units = rad - type = real | kind = kind_phys - dimensions = (daytime_points_dimension) - intent = in -[ toa_src_sw ] - standard_name = top_of_atmosphere_solar_radiation_flux_on_g_points - units = W m-2 - type = real | kind = kind_phys - dimensions = (daytime_points_dimension,number_of_shortwave_g_point_intervals) - intent = in -[ sfc_alb_dir ] - standard_name = albedo_direct_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) - intent = in -[ sfc_alb_dif ] - standard_name = albedo_diffused_at_surface - units = fraction - type = real | kind = kind_phys - dimensions = (number_of_bands_for_shortwave_radiation,daytime_points_dimension) - intent = in -[ flux_clrsky ] - standard_name = shortwave_clear_sky_flux_object_for_RRTMGP - units = none - type = ty_fluxes_broadband_ccpp - dimensions = () - intent = inout -[ flux_allsky ] - standard_name = shortwave_all_sky_flux_object_for_RRTMGP - units = none - type = ty_fluxes_byband_ccpp - dimensions = () - intent = inout -[ errmsg ] - standard_name = ccpp_error_message - units = none - type = character | kind = len=* - dimensions = () - intent = out -[ errflg ] - standard_name = ccpp_error_code - units = 1 - type = integer - dimensions = () - intent = out From 58915fb57d5b5c5999d984c17896a3977b9c79e3 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 22 Dec 2025 11:34:23 -0700 Subject: [PATCH 133/140] remove unused suite --- test/test_suites/suite_rrtmgp_gpu.xml | 53 --------------------------- 1 file changed, 53 deletions(-) delete mode 100644 test/test_suites/suite_rrtmgp_gpu.xml diff --git a/test/test_suites/suite_rrtmgp_gpu.xml b/test/test_suites/suite_rrtmgp_gpu.xml deleted file mode 100644 index fbcb17cc..00000000 --- a/test/test_suites/suite_rrtmgp_gpu.xml +++ /dev/null @@ -1,53 +0,0 @@ - - - - - initialize_constituents - rrtmgp_pre - rrtmgp_cloud_optics_setup - tropopause_find - rrtmgp_variables - rrtmgp_inputs - rrtmgp_sw_cloud_optics - rrtmgp_sw_mcica_subcol_gen - rrtmgp_cloud_diagnostics - - - rrtmgp_constituents - rrtmgp_sw_gas_optics_pre - rrtmgp_sw_gas_optics_gpu - solar_irradiance_data - rrtmgp_sw_solar_var - rrtmgp_sw_aerosols - rrtmgp_sw_rte_gpu - rrtmgp_sw_calculate_fluxes - rrtmgp_sw_calculate_heating_rate - rrtmgp_sw_diagnostics - rrtmgp_subcycle - - rrtmgp_lw_cloud_optics - rrtmgp_lw_mcica_subcol_gen - - - rrtmgp_constituents - rrtmgp_lw_gas_optics_pre - rrtmgp_lw_gas_optics_gpu - rrtmgp_lw_aerosols - rrtmgp_lw_rte_gpu - rrtmgp_lw_calculate_fluxes - rrtmgp_lw_calculate_heating_rate - rrtmgp_lw_diagnostics - rrtmgp_subcycle - - - rrtmgp_inputs_setup - rrtmgp_sw_solar_var_setup - rrtmgp_dry_static_energy_tendency - calculate_net_heating - rrtmgp_post - rrtmgp_diagnostics - - apply_heating_rate - geopotential_temp - - From 4ad6d2dc5548d0703bd5ccccc673fe6be86b2964 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 5 Jan 2026 13:31:48 -0700 Subject: [PATCH 134/140] change standard name for constant and update units of fractional day vars --- schemes/rrtmgp/rrtmgp_inputs_setup.meta | 4 ++-- schemes/rrtmgp/rrtmgp_pre.meta | 2 +- schemes/rrtmgp/rrtmgp_sw_solar_var.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_sw_solar_var.meta | 6 +++--- schemes/tropopause_find/tropopause_find.meta | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_inputs_setup.meta b/schemes/rrtmgp/rrtmgp_inputs_setup.meta index a2b8b4f1..df5f5822 100644 --- a/schemes/rrtmgp/rrtmgp_inputs_setup.meta +++ b/schemes/rrtmgp/rrtmgp_inputs_setup.meta @@ -122,7 +122,7 @@ intent = in [ current_cal_day ] standard_name = fractional_calendar_days_on_end_of_current_timestep - units = 1 + units = days type = real | kind = kind_phys dimensions = () intent = in @@ -232,7 +232,7 @@ standard_name = shortwave_start_and_end_gpoint_for_each_band units = index type = integer - dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) + dimensions = (constant_dimension_two,number_of_bands_for_shortwave_radiation) intent = out [ irad_always_out ] standard_name = number_of_timesteps_to_force_radiation_calculation_after_initialization diff --git a/schemes/rrtmgp/rrtmgp_pre.meta b/schemes/rrtmgp/rrtmgp_pre.meta index 5689fab2..8cfe0f1e 100644 --- a/schemes/rrtmgp/rrtmgp_pre.meta +++ b/schemes/rrtmgp/rrtmgp_pre.meta @@ -178,7 +178,7 @@ intent = in [ next_cday ] standard_name = fractional_calendar_days_on_end_of_next_timestep - units = 1 + units = days type = real | kind = kind_phys dimensions = () intent = in diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 index 7126a006..0ac8fd8a 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.F90 @@ -18,7 +18,7 @@ module rrtmgp_sw_solar_var !> \section arg_table_rrtmgp_sw_solar_var_run Argument Table !! \htmlinclude rrtmgp_sw_solar_var_run.html !! - subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, & + subroutine rrtmgp_sw_solar_var_run(toa_flux, constant_dim_two, band2gpt_sw, nswbands, sol_irrad, wave_end, nbins, sol_tsi, & nday, dosw, do_spectral_scaling, sfac, eccf, errmsg, errflg) use rrtmgp_sw_solar_var_setup, only: irrad, radbinmax, radbinmin use ccpp_kinds, only : kind_phys @@ -30,7 +30,7 @@ subroutine rrtmgp_sw_solar_var_run(toa_flux, ccpp_constant_two, band2gpt_sw, nsw real(kind_phys), intent(in) :: wave_end(:) ! wavelength endpoints integer, intent(in) :: nday ! number of daytime points integer, intent(in) :: nbins ! number of bins - integer, intent(in) :: ccpp_constant_two ! dimension for band2gpt_sw + integer, intent(in) :: constant_dim_two ! dimension for band2gpt_sw integer, intent(in) :: band2gpt_sw(:,:) ! array for converting shortwave band limits to g-points integer, intent(in) :: nswbands ! number of shortwave bands logical, intent(in) :: do_spectral_scaling ! flag to do spectral scaling diff --git a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta index b1d22a44..92f0f58b 100644 --- a/schemes/rrtmgp/rrtmgp_sw_solar_var.meta +++ b/schemes/rrtmgp/rrtmgp_sw_solar_var.meta @@ -12,8 +12,8 @@ type = real | kind = kind_phys dimensions = (daytime_columns_dimension,number_of_shortwave_g_point_intervals) intent = inout -[ ccpp_constant_two ] - standard_name = ccpp_constant_two +[ constant_dim_two ] + standard_name = constant_dimension_two units = count type = integer dimensions = () @@ -22,7 +22,7 @@ standard_name = shortwave_start_and_end_gpoint_for_each_band units = index type = integer - dimensions = (ccpp_constant_two,number_of_bands_for_shortwave_radiation) + dimensions = (constant_dimension_two,number_of_bands_for_shortwave_radiation) intent = in [ nswbands ] standard_name = number_of_bands_for_shortwave_radiation diff --git a/schemes/tropopause_find/tropopause_find.meta b/schemes/tropopause_find/tropopause_find.meta index a34f9df0..693d766b 100644 --- a/schemes/tropopause_find/tropopause_find.meta +++ b/schemes/tropopause_find/tropopause_find.meta @@ -107,7 +107,7 @@ intent = in [ calday ] standard_name = fractional_calendar_days_on_end_of_current_timestep - units = 1 + units = days type = real | kind = kind_phys dimensions = () intent = in From b45d07d03406eccd807cd2bb576542a7e02b2a35 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Tue, 13 Jan 2026 16:40:46 -0700 Subject: [PATCH 135/140] move optical props to copy directive --- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 63ce9ffc..0cafb483 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -369,7 +369,8 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) - !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs,sw_optical_props%optical_props) & + !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs) & + !$acc copy(sw_optical_props%optical_props) & !$acc copyout(toa_src_sw) errmsg = sw_gas_props%gas_props%gas_optics(& p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) From 063f591d5f4966b8825f7d301f87378c461433fc Mon Sep 17 00:00:00 2001 From: peverwhee Date: Fri, 23 Jan 2026 11:41:30 -0700 Subject: [PATCH 136/140] remove returns within the acc blocks --- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 25 ++++++++++--------------- schemes/rrtmgp/rrtmgp_sw_rte.F90 | 30 ++++++++++++++---------------- 2 files changed, 24 insertions(+), 31 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index e6c812cb..c6059607 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -80,19 +80,17 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, call check_error_msg('rrtmgp_lw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if ! Call RTE solver - if (doLWclrsky) then + if (errflg == 0 .and. doLWclrsky) then if (use_lw_optimal_angles) then errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) call check_error_msg('rrtmgp_lw_rte_opt_angle', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if - if (nGauss_angles > 1) then + if (nGauss_angles > 1 .and. errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function @@ -100,7 +98,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_clrsky%fluxes, & ! OUT - Fluxes n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point - else + elseif (errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function @@ -109,14 +107,14 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point end if else - if (nGauss_angles > 1) then + if (nGauss_angles > 1 .and. errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky%fluxes, & ! OUT - Fluxes n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - else + elseif (errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function @@ -127,7 +125,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, call check_error_msg('rrtmgp_lw_rte_lw_rte_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if end if @@ -147,15 +144,14 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, ! ################################################################################### ! Include LW cloud-scattering? - if (doGP_lwscat) then + if (doGP_lwscat .and. errflg == 0) then ! Increment errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) call check_error_msg('rrtmgp_lw_rte_increment_clrsky_to_clouds', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if - if (use_LW_jacobian) then + if (use_LW_jacobian .and. errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clouds%optical_props, & ! IN - optical-properties @@ -172,7 +168,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_allsky%fluxes, & ! OUT - Fluxes flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) end if - else + elseif (errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clouds%optical_props, & ! IN - optical-properties @@ -195,10 +191,9 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, call check_error_msg('rrtmgp_lw_rte_increment_clouds_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if - if (use_LW_jacobian) then + if (use_LW_jacobian .and. errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties @@ -215,7 +210,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_allsky%fluxes, & ! OUT - Fluxes flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) end if - else + elseif (errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index 4cc65856..e20ddb40 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -76,11 +76,10 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr call check_error_msg('rrtmgp_sw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if ! Optionally compute clear-sky fluxes - if (doswclrsky) then + if (doswclrsky .and. errflg == 0) then errmsg = rte_sw( & sw_optical_props%optical_props, & ! IN - optical-properties coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle @@ -91,7 +90,6 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr call check_error_msg('rrtmgp_sw_rte_rte_sw_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if end if @@ -101,27 +99,27 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr ! ! ################################################################################### - if (doswallsky) then + if (doswallsky .and. errflg == 0) then ! Increment errmsg = sw_optical_props_clouds%optical_props%increment(sw_optical_props%optical_props) call check_error_msg('rrtmgp_sw_rte_increment_clouds_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 - return end if ! Compute fluxes - errmsg = rte_sw( & - sw_optical_props%optical_props, & ! IN - optical-properties - coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle - toa_src_sw, & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky%fluxes) ! OUT - Fluxes, all-sky, 3D (1,nLay,nBand) - call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky', errmsg) - if (len_trim(errmsg) /= 0) then - errflg = 1 - return + if (errflg == 0) then + errmsg = rte_sw( & + sw_optical_props%optical_props, & ! IN - optical-properties + coszen_day(iCol:iCol2), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky%fluxes) ! OUT - Fluxes, all-sky, 3D (1,nLay,nBand) + call check_error_msg('rrtmgp_sw_rte_rte_sw_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if end if end if !$acc end data From 18eae2ac0e4b25a6c81cad640030c9ec89297535 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Mon, 26 Jan 2026 21:53:42 -0700 Subject: [PATCH 137/140] move optics to copyin --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 4 ++-- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index 12c5969d..adb6c9bc 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -359,8 +359,8 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) !$acc data copyin(lw_gas_props%gas_props, p_lay, p_lev, t_lay, & - !$acc tsfg, gas_concs%gas_concs) & - !$acc copy(lw_optical_props_clrsky%optical_props, lw_optical_props_clrsky%optical_props%tau, & + !$acc tsfg, gas_concs%gas_concs, lw_optical_props_clrsky%optical_props) & + !$acc copy(lw_optical_props_clrsky%optical_props%tau, & !$acc sources%sources, sources%sources%lay_source, & !$acc sources%sources%sfc_source, & !$acc sources%sources%lev_source, & diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 0cafb483..2ac207c4 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -369,8 +369,8 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) - !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs) & - !$acc copy(sw_optical_props%optical_props) & + !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs, & + !$acc sw_optical_props%optical_props) & !$acc copyout(toa_src_sw) errmsg = sw_gas_props%gas_props%gas_optics(& p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) From 6b856cf63c719b3ab128bd6f9d4807ea1e6c78b6 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Wed, 28 Jan 2026 17:12:16 -0700 Subject: [PATCH 138/140] remove optical props objs from acc directives --- schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 5 ++--- schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 | 3 +-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 index adb6c9bc..5f258010 100644 --- a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -359,9 +359,8 @@ subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) !$acc data copyin(lw_gas_props%gas_props, p_lay, p_lev, t_lay, & - !$acc tsfg, gas_concs%gas_concs, lw_optical_props_clrsky%optical_props) & - !$acc copy(lw_optical_props_clrsky%optical_props%tau, & - !$acc sources%sources, sources%sources%lay_source, & + !$acc tsfg, gas_concs%gas_concs) & + !$acc copy(sources%sources, sources%sources%lay_source, & !$acc sources%sources%sfc_source, & !$acc sources%sources%lev_source, & !$acc sources%sources%sfc_source_jac) diff --git a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 index 2ac207c4..6191e7b6 100644 --- a/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_gas_optics.F90 @@ -369,8 +369,7 @@ subroutine rrtmgp_sw_gas_optics_run(dosw, iter_num, ncol, rrtmgp_phys_blksz, p_l iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) - !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs, & - !$acc sw_optical_props%optical_props) & + !$acc data copyin(sw_gas_props%gas_props,p_lay,p_lev,t_lay,gas_concs%gas_concs) & !$acc copyout(toa_src_sw) errmsg = sw_gas_props%gas_props%gas_optics(& p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) From 276278172ba90066545eb86d19b886ddc0215a43 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 29 Jan 2026 11:09:24 -0700 Subject: [PATCH 139/140] add space between else and if --- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index c6059607..0216ae4f 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -98,7 +98,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_clrsky%fluxes, & ! OUT - Fluxes n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point - elseif (errflg == 0) then + else if (errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function @@ -114,7 +114,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_clrsky%fluxes, & ! OUT - Fluxes n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature - elseif (errflg == 0) then + else if (errflg == 0) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties sources%sources, & ! IN - source function @@ -168,7 +168,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_allsky%fluxes, & ! OUT - Fluxes flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) end if - elseif (errflg == 0) then + else if (errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clouds%optical_props, & ! IN - optical-properties @@ -210,7 +210,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, flux_allsky%fluxes, & ! OUT - Fluxes flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) end if - elseif (errflg == 0) then + else if (errflg == 0) then if (nGauss_angles > 1) then errmsg = rte_lw( & lw_optical_props_clrsky%optical_props, & ! IN - optical-properties From 5677c3d0f4ea1cca06f35274f0ef09dd17bffbe4 Mon Sep 17 00:00:00 2001 From: peverwhee Date: Thu, 29 Jan 2026 11:11:42 -0700 Subject: [PATCH 140/140] add clarifying comment about returning within acc directive block --- schemes/rrtmgp/rrtmgp_lw_rte.F90 | 1 + schemes/rrtmgp/rrtmgp_sw_rte.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/schemes/rrtmgp/rrtmgp_lw_rte.F90 b/schemes/rrtmgp/rrtmgp_lw_rte.F90 index 0216ae4f..573c5746 100644 --- a/schemes/rrtmgp/rrtmgp_lw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_lw_rte.F90 @@ -80,6 +80,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, call check_error_msg('rrtmgp_lw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 + ! Can't return from within a top-level acc block end if ! Call RTE solver diff --git a/schemes/rrtmgp/rrtmgp_sw_rte.F90 b/schemes/rrtmgp/rrtmgp_sw_rte.F90 index e20ddb40..e3cec314 100644 --- a/schemes/rrtmgp/rrtmgp_sw_rte.F90 +++ b/schemes/rrtmgp/rrtmgp_sw_rte.F90 @@ -76,6 +76,7 @@ subroutine rrtmgp_sw_rte_run(doswrad, doswclrsky, doswallsky, nday, iter_num, rr call check_error_msg('rrtmgp_sw_rte_increment_aerosol_to_clrsky', errmsg) if (len_trim(errmsg) /= 0) then errflg = 1 + ! Can't return from within a top-level acc block end if ! Optionally compute clear-sky fluxes