From dbd57f1213bc8ecca8e62d8be86bf2dfb0ff61e4 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 10 Aug 2021 12:37:35 -0400 Subject: [PATCH 01/71] Update YAKL --- externals/YAKL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/YAKL b/externals/YAKL index d833aabc6ed6..9187f44aa3bc 160000 --- a/externals/YAKL +++ b/externals/YAKL @@ -1 +1 @@ -Subproject commit d833aabc6ed6b99dd3c3118abdc523251699628b +Subproject commit 9187f44aa3bc7738f61f10225f8b5c3272cfa8f3 From 6c25ee607b060bcd64668161240ff934cb7cb98c Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 9 Dec 2020 13:13:03 -0700 Subject: [PATCH 02/71] Update RRTMGP --- .gitmodules | 3 +++ components/eam/src/physics/rrtmgp/external | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 315399033fc7..20d66a97a286 100644 --- a/.gitmodules +++ b/.gitmodules @@ -52,3 +52,6 @@ [submodule "externals/mct"] path = externals/mct url = git@github.com:MCSclimate/MCT.git +[submodule "externals/netcdf-cxx4"] + path = externals/netcdf-cxx4 + url = git@github.com:Unidata/netcdf-cxx4.git diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index 54ea4a9a2033..b9edc5e6eb7f 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit 54ea4a9a203381868f181eb2ab88f3663160f286 +Subproject commit b9edc5e6eb7faa560e6a742fb390ac160ef2b188 From cffc6e1994d7c7c9ce894daa6ed039088e97aa5f Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Mon, 5 Apr 2021 18:17:32 -0400 Subject: [PATCH 03/71] Add a crm_physics_final to clean up --- components/eam/src/physics/crm/physpkg.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/crm/physpkg.F90 b/components/eam/src/physics/crm/physpkg.F90 index 7a53657642bb..d7c4d796840e 100644 --- a/components/eam/src/physics/crm/physpkg.F90 +++ b/components/eam/src/physics/crm/physpkg.F90 @@ -985,7 +985,7 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) use physics_buffer, only : physics_buffer_desc, pbuf_deallocate use chemistry, only : chem_final use wv_saturation, only : wv_sat_final - use crm_physics, only: crm_physics_final + use crm_physics, only : crm_physics_final !----------------------------------------------------------------------- ! Purpose: Finalization of physics package !----------------------------------------------------------------------- From 2a1578e995c8062995012faa20ab2a7faa7e4e58 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 13 Aug 2020 19:57:42 -0400 Subject: [PATCH 04/71] Add option -rrtmgpxx to configure Add option -rrtmgpxx to configure to build the RRTMGP++ code instead of RRTMGP. --- components/cmake/build_model.cmake | 13 +++++++++++++ components/cmake/common_setup.cmake | 10 ++++++++-- components/eam/bld/configure | 2 ++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 4b772dd83277..851c7eaf7b8f 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -105,6 +105,16 @@ function(build_model COMP_CLASS COMP_NAME) cmake/atm/../../eam/src/physics/crm/crm_ecpp_output_module.F90 ) endif() + # Add rrtmgp++ source code if asked for + if (USE_RRTMGPXX) + message(STATUS "Building RRTMGPXX") + # Build rrtmgpxx as a library + set(RRTMGPXX_HOME ${CMAKE_CURRENT_SOURCE_DIR}/../../cam/src/physics/rrtmgp/external/cpp) + set(RRTMGPXX_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgpxx) + add_subdirectory(${RRTMGPXX_HOME} ${RRTMGPXX_BIN}) + # Add samxx F90 files to the main E3SM build + #set(SOURCES ${SOURCES} cmake/atm/../../cam/src/physics/crm/rrtmgpxx/cpp_interface_mod.F90) + endif() endif() #------------------------------------------------------------------------------- @@ -248,6 +258,9 @@ function(build_model COMP_CLASS COMP_NAME) if (USE_SAMXX) target_link_libraries(${TARGET_NAME} PRIVATE samxx) endif() + if (USE_RRTMGPXX) + target_link_libraries(${TARGET_NAME} rrtmgp) + endif() endif() if (USE_KOKKOS) target_link_libraries (${TARGET_NAME} PRIVATE Kokkos::kokkos) diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index 3c6d85b25ee9..80b489806f69 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -35,8 +35,14 @@ if (NOT HAS_SAMXX EQUAL -1) set(USE_SAMXX TRUE) endif() -# If samxx is being used, then YAKL must be used as well -set(USE_YAKL ${USE_SAMXX}) +string(FIND "${CAM_CONFIG_OPTS}" "-rrtmgpxx" HAS_RRTMGPXX) +if (NOT HAS_RRTMGPXX EQUAL -1) + # The following is for the RRTMGPXX code: + set(USE_RRTMGPXX TRUE) +endif() + +# If samxx or rrtmgpxx is being used, then YAKL must be used as well +set(USE_YAKL ${USE_SAMXX} OR ${USE_RRTMGPXX}) # If YAKL is being used, then we need to enable USE_CXX if (${USE_YAKL}) diff --git a/components/eam/bld/configure b/components/eam/bld/configure index a64a8e37293c..14fe6d9f8044 100755 --- a/components/eam/bld/configure +++ b/components/eam/bld/configure @@ -279,6 +279,7 @@ OPTIONS -use_ECPP use CRM clouds for vertical transport, aqueous chemistry and wet removable of aerosols -crm_adv CRM advection scheme [MPDATA | UM5] -crm CRM model [sam | samomp | samxx] + -rrtmgpxx Use RRTMGP++ code EOF } @@ -351,6 +352,7 @@ GetOptions( "MMF_microphysics_scheme=s" => \$opts{'MMF_microphysics_scheme'}, "crm_adv=s" => \$opts{'crm_adv'}, "crm=s" => \$opts{'crm'}, + "rrtmgpxx" => \$opts{'rrtmgpxx'}, "debug" => \$opts{'debug'}, "rain_evap_to_coarse_aero" => \$opts{'rain_evap_to_coarse_aero'}, "bc_dep_to_snow_updates" => \$opts{'bc_dep_to_snow_updates'}, From 074895974fd4d967e2f37f98f4481f758ca5aa15 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 10:30:36 -0400 Subject: [PATCH 05/71] Switch to RRTMGP version of load_coefficients --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 2 +- .../eam/src/physics/rrtmgp/radiation.F90 | 2 +- .../physics/rrtmgp/rrtmgp_coefficients.F90 | 237 ------------------ 3 files changed, 2 insertions(+), 239 deletions(-) delete mode 100644 components/eam/src/physics/rrtmgp/rrtmgp_coefficients.F90 diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 15c6127565c5..9febae0f4334 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -445,7 +445,7 @@ subroutine radiation_init(state) use physics_types, only: physics_state ! RRTMGP modules - use rrtmgp_coefficients, only: rrtmgp_load_coefficients=>load_and_init + use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init use mo_gas_concentrations, only: ty_gas_concs ! For optics diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 08d9cc6bc2a0..f1541397afa6 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -439,7 +439,7 @@ subroutine radiation_init(state) use physics_types, only: physics_state ! RRTMGP modules - use rrtmgp_coefficients, only: rrtmgp_load_coefficients=>load_and_init + use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init use mo_gas_concentrations, only: ty_gas_concs ! For optics diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_coefficients.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_coefficients.F90 deleted file mode 100644 index a05c51f4f084..000000000000 --- a/components/eam/src/physics/rrtmgp/rrtmgp_coefficients.F90 +++ /dev/null @@ -1,237 +0,0 @@ -! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) -! -! Contacts: Robert Pincus and Eli Mlawer -! email: rrtmgp@aer.com -! -! Copyright 2015-2018, Atmospheric and Environmental Research and -! Regents of the University of Colorado. All right reserved. -! -! Use and duplication is permitted under the terms of the -! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause -! ------------------------------------------------------------------------------------------------- -! -! The gas optics class used by RRMTGP needs to be initialized with data stored in a netCDF file. -! RRTMGP itself doesn't include methods for reading the data so we don't conflict with users' -! local environment. This module provides a straight-forward implementation of reading the data -! and calling gas_optics%load(). -! -! ------------------------------------------------------------------------------------------------- -module rrtmgp_coefficients - ! - ! Modules for working with rte and rrtmgp - ! - use mo_rte_kind, only: wp, wl - use mo_gas_concentrations, only: ty_gas_concs - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - ! -------------------------------------------------- - use mo_simple_netcdf, only: read_field, read_char_vec, read_logical_vec, var_exists, get_dim_size - use netcdf - implicit none - private - public :: load_and_init - -contains - subroutine stop_on_err(msg) - use iso_fortran_env, only : error_unit - character(len=*), intent(in) :: msg - - if(msg /= "") then - write(error_unit, *) msg - stop - end if - end subroutine - !-------------------------------------------------------------------------------------------------------------------- - ! read optical coefficients from NetCDF file - subroutine load_and_init(kdist, filename, available_gases) - class(ty_gas_optics_rrtmgp), intent(inout) :: kdist - character(len=*), intent(in ) :: filename - class(ty_gas_concs), intent(in ) :: available_gases ! Which gases does the host model have available? - ! -------------------------------------------------- - ! - ! Variables that will be passed to gas_optics%load() - ! - character(len=32), dimension(:), allocatable :: gas_names - integer, dimension(:,:,:), allocatable :: key_species - integer, dimension(:,: ), allocatable :: band2gpt - real(wp), dimension(:,: ), allocatable :: band_lims - real(wp) :: press_ref_trop, temp_ref_p, temp_ref_t - real(wp), dimension(: ), allocatable :: press_ref - real(wp), dimension(: ), allocatable :: temp_ref - real(wp), dimension(:,:,: ), allocatable :: vmr_ref - real(wp), dimension(:,:,:,:), allocatable :: kmajor - - character(len=32), dimension(:), allocatable :: gas_minor, identifier_minor - character(len=32), dimension(:), allocatable :: minor_gases_lower, minor_gases_upper - integer, dimension(:,:), allocatable :: minor_limits_gpt_lower, minor_limits_gpt_upper - logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower, minor_scales_with_density_upper - character(len=32), dimension(:), allocatable :: scaling_gas_lower, scaling_gas_upper - logical(wl), dimension(:), allocatable :: scale_by_complement_lower, scale_by_complement_upper - integer, dimension(:), allocatable :: kminor_start_lower, kminor_start_upper - real(wp), dimension(:,:,:), allocatable :: kminor_lower, kminor_upper - - real(wp), dimension(:,:,: ), allocatable :: rayl_lower, rayl_upper - real(wp), dimension(: ), allocatable :: solar_src - real(wp), dimension(:,: ), allocatable :: totplnk - real(wp), dimension(:,:,:,:), allocatable :: planck_frac - ! ----------------- - ! - ! Book-keeping variables - ! - integer :: ncid - integer :: ntemps, & - npress, & - nabsorbers, & - nextabsorbers, & - nminorabsorbers, & - nmixingfracs, & - nlayers, & - nbnds, & - ngpts, & - npairs, & - nminor_absorber_intervals_lower, & - nminor_absorber_intervals_upper, & - ncontributors_lower, & - ncontributors_upper, & - ninternalSourcetemps - ! -------------------------------------------------- - ! - ! How big are the various arrays? - ! - if(nf90_open(trim(fileName), NF90_NOWRITE, ncid) /= NF90_NOERR) & - call stop_on_err("load_and_init(): can't open file " // trim(fileName)) - ntemps = get_dim_size(ncid,'temperature') - npress = get_dim_size(ncid,'pressure') - nabsorbers = get_dim_size(ncid,'absorber') - nminorabsorbers = get_dim_size(ncid,'minor_absorber') - nextabsorbers = get_dim_size(ncid,'absorber_ext') - nmixingfracs = get_dim_size(ncid,'mixing_fraction') - nlayers = get_dim_size(ncid,'atmos_layer') - nbnds = get_dim_size(ncid,'bnd') - ngpts = get_dim_size(ncid,'gpt') - npairs = get_dim_size(ncid,'pair') - nminor_absorber_intervals_lower & - = get_dim_size(ncid,'minor_absorber_intervals_lower') - nminor_absorber_intervals_upper & - = get_dim_size(ncid,'minor_absorber_intervals_upper') - ninternalSourcetemps & - = get_dim_size(ncid,'temperature_Planck') - ncontributors_lower = get_dim_size(ncid,'contributors_lower') - ncontributors_upper = get_dim_size(ncid,'contributors_upper') - ! ----------------- - ! - ! Read the many arrays - ! - gas_names = read_char_vec(ncid, 'gas_names', nabsorbers) - key_species = read_field(ncid, 'key_species', 2, nlayers, nbnds) - band_lims = read_field(ncid, 'bnd_limits_wavenumber', 2, nbnds) - band2gpt = int(read_field(ncid, 'bnd_limits_gpt', 2, nbnds)) - press_ref = read_field(ncid, 'press_ref', npress) - temp_ref = read_field(ncid, 'temp_ref', ntemps) - temp_ref_p = read_field(ncid, 'absorption_coefficient_ref_P') - temp_ref_t = read_field(ncid, 'absorption_coefficient_ref_T') - press_ref_trop = read_field(ncid, 'press_ref_trop') - kminor_lower = read_field(ncid, 'kminor_lower', & - ncontributors_lower, nmixingfracs, ntemps) - kminor_upper = read_field(ncid, 'kminor_upper', & - ncontributors_upper, nmixingfracs, ntemps) - gas_minor = read_char_vec(ncid, 'gas_minor', nminorabsorbers) - identifier_minor = read_char_vec(ncid, 'identifier_minor', nminorabsorbers) - minor_gases_lower = read_char_vec(ncid, 'minor_gases_lower', nminor_absorber_intervals_lower) - minor_gases_upper = read_char_vec(ncid, 'minor_gases_upper', nminor_absorber_intervals_upper) - minor_limits_gpt_lower & - = int(read_field(ncid, 'minor_limits_gpt_lower', npairs,nminor_absorber_intervals_lower)) - minor_limits_gpt_upper & - = int(read_field(ncid, 'minor_limits_gpt_upper', npairs,nminor_absorber_intervals_upper)) - minor_scales_with_density_lower & - = read_logical_vec(ncid, 'minor_scales_with_density_lower', nminor_absorber_intervals_lower) - minor_scales_with_density_upper & - = read_logical_vec(ncid, 'minor_scales_with_density_upper', nminor_absorber_intervals_upper) - scale_by_complement_lower & - = read_logical_vec(ncid, 'scale_by_complement_lower', nminor_absorber_intervals_lower) - scale_by_complement_upper & - = read_logical_vec(ncid, 'scale_by_complement_upper', nminor_absorber_intervals_upper) - scaling_gas_lower & - = read_char_vec(ncid, 'scaling_gas_lower', nminor_absorber_intervals_lower) - scaling_gas_upper & - = read_char_vec(ncid, 'scaling_gas_upper', nminor_absorber_intervals_upper) - kminor_start_lower & - = read_field(ncid, 'kminor_start_lower', nminor_absorber_intervals_lower) - kminor_start_upper & - = read_field(ncid, 'kminor_start_upper', nminor_absorber_intervals_upper) - vmr_ref = read_field(ncid, 'vmr_ref', nlayers, nextabsorbers, ntemps) - - kmajor = read_field(ncid, 'kmajor', ngpts, nmixingfracs, npress+1, ntemps) - if(var_exists(ncid, 'rayl_lower')) then - rayl_lower = read_field(ncid, 'rayl_lower', ngpts, nmixingfracs, ntemps) - rayl_upper = read_field(ncid, 'rayl_upper', ngpts, nmixingfracs, ntemps) - end if - ! -------------------------------------------------- - ! - ! Initialize the gas optics class with data. The calls look slightly different depending - ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) - ! gas_optics%load() returns a string; a non-empty string indicates an error. - ! - if(var_exists(ncid, 'totplnk')) then - ! - ! If there's a totplnk variable in the file it's a longwave (internal sources) type - ! - totplnk = read_field(ncid, 'totplnk', ninternalSourcetemps, nbnds) - planck_frac = read_field(ncid, 'plank_fraction', ngpts, nmixingfracs, npress+1, ntemps) - call stop_on_err(kdist%load(available_gases, & - gas_names, & - key_species, & - band2gpt, & - band_lims, & - 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)) - else - ! - ! Solar source doesn't have an dependencies yet - ! - solar_src = read_field(ncid, 'solar_source', ngpts) - call stop_on_err(kdist%load(available_gases, & - gas_names, & - key_species, & - band2gpt, & - band_lims, & - 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, & - rayl_lower, rayl_upper)) - end if - ! -------------------------------------------------- - ncid = nf90_close(ncid) - end subroutine load_and_init -end module rrtmgp_coefficients From 1a07ab5184fa9002dcda0c9a0e77ff966fc6d6cd Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 15:20:17 -0400 Subject: [PATCH 06/71] Move init to rrtmgp_interface --- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 106 ++++++++++++++++++ .../eam/src/physics/crm/rrtmgp/radiation.F90 | 45 ++------ .../eam/src/physics/rrtmgp/radiation.F90 | 66 ++--------- 3 files changed, 124 insertions(+), 93 deletions(-) create mode 100644 components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 diff --git a/components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 new file mode 100644 index 000000000000..ff4fb39073f6 --- /dev/null +++ b/components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -0,0 +1,106 @@ +! Module to bridge the gap between the Fortran and C++ implemenations of +! RRTMGP. Remove class references from function calls, and handle all of that +! here. This is necessary because radiation_tend will remain in F90 (to deal +! with E3SM data types), but we will switch to C++ for the underlying RRTMGP +! code. +module rrtmgp_interface + + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_load_coefficients, only: load_and_init + + implicit none + + private + + ! Gas optics objects that hold k-distribution information. These are made + ! module variables because we only want to initialize them once at init time. + type(ty_gas_optics_rrtmgp), public :: k_dist_sw, k_dist_lw + + ! Make these module variables so that we do not have to provide access to + ! k_dist objects; this just makes it easier to switch between F90 and C++ + ! interfaces. + integer, public :: nswbands, nlwbands, nswgpts, nlwgpts + + public :: rrtmgp_initialize, & + get_nbnds_sw, get_nbnds_lw, & + get_ngpts_sw, get_ngpts_lw + +contains + + integer function get_nbnds_sw() + get_nbnds_sw = k_dist_sw%get_nband() + end function get_nbnds_sw + + integer function get_nbnds_lw() + get_nbnds_lw = k_dist_lw%get_nband() + end function get_nbnds_lw + + integer function get_ngpts_sw() + get_ngpts_sw = k_dist_sw%get_ngpt() + end function get_ngpts_sw + + integer function get_ngpts_lw() + get_ngpts_lw = k_dist_lw%get_ngpt() + end function get_ngpts_lw + + subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) + character(len=*), intent(in) :: active_gases(:) + character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw + type(ty_gas_concs) :: available_gases + ! Read gas optics coefficients from file + ! Need to initialize available_gases here! The only field of the + ! available_gases type that is used int he kdist initialize is + ! available_gases%gas_name, which gives the name of each gas that would be + ! present in the ty_gas_concs object. So, we can just set this here, rather + ! than trying to fully populate the ty_gas_concs object here, which would be + ! impossible from this initialization routine because I do not thing the + ! rad_cnst objects are setup yet. + ! the other tasks! + ! TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast + call set_available_gases(active_gases, available_gases) + call load_and_init(k_dist_sw, coefficients_file_sw, available_gases) + call load_and_init(k_dist_lw, coefficients_file_lw, available_gases) + ! Set number of bands based on what we read in from input data + nswbands = k_dist_sw%get_nband() + nlwbands = k_dist_lw%get_nband() + ! Number of gpoints depend on inputdata, so initialize here + nswgpts = k_dist_sw%get_ngpt() + nlwgpts = k_dist_lw%get_ngpt() + end subroutine rrtmgp_initialize + + ! -------------------------------------------------------------------------- + ! Private routines + ! -------------------------------------------------------------------------- + + subroutine set_available_gases(gases, gas_concentrations) + + use mo_gas_concentrations, only: ty_gas_concs + use mo_rrtmgp_util_string, only: lower_case + + type(ty_gas_concs), intent(inout) :: gas_concentrations + character(len=*), intent(in) :: gases(:) + character(len=32), dimension(size(gases)) :: gases_lowercase + integer :: igas + + ! Initialize with lowercase gas names; we should work in lowercase + ! whenever possible because we cannot trust string comparisons in RRTMGP + ! to be case insensitive + do igas = 1,size(gases) + gases_lowercase(igas) = trim(lower_case(gases(igas))) + end do + call handle_error(gas_concentrations%init(gases_lowercase)) + + end subroutine set_available_gases + + ! Stop run ungracefully since we don't want dependencies on E3SM abortutils + ! here + subroutine handle_error(msg) + character(len=*), intent(in) :: msg + if (trim(msg) .ne. '') then + print *, trim(msg) + stop + end if + end subroutine handle_error + +end module rrtmgp_interface diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 9febae0f4334..f6ab6887bd57 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -27,7 +27,10 @@ module radiation ! RRTMGP gas optics object to store coefficient information. This is imported ! here so that we can make the k_dist objects module data and only load them ! once. - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use rrtmgp_interface, only: & + k_dist_sw, k_dist_lw, rrtmgp_initialize, & + rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & + nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -140,18 +143,9 @@ module radiation ! angle calculation? What is the other behavior? real(r8) :: dt_avg = 0.0_r8 - ! k-distribution coefficients. These will be populated by reading from the - ! RRTMGP coefficients files, specified by coefficients_file_sw and - ! coefficients_file_lw in the radiation namelist. They exist as module data - ! because we only want to load those files once. - type(ty_gas_optics_rrtmgp) :: k_dist_sw, k_dist_lw - ! k-distribution coefficients files to read from. These are set via namelist ! variables. - character(len=cl) :: coefficients_file_sw, coefficients_file_lw - - ! Number of g-points in k-distribution (set based on absorption coefficient inputdata) - integer :: nswgpts, nlwgpts + character(len=cl) :: rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw ! Band midpoints; these need to be module variables because of how cam_history works; ! add_hist_coord sets up pointers to these, so they need to persist. @@ -215,7 +209,6 @@ subroutine radiation_readnl(nlfile, dtime_in) integer :: unitn, ierr integer :: dtime ! timestep size character(len=*), parameter :: subroutine_name = 'radiation_readnl' - character(len=cl) :: rrtmgp_coefficients_file_lw, rrtmgp_coefficients_file_sw ! Variables defined in namelist namelist /radiation_nl/ rrtmgp_coefficients_file_lw, & @@ -256,10 +249,6 @@ subroutine radiation_readnl(nlfile, dtime_in) call mpibcast(rrtmgp_enable_temperature_warnings, 1, mpi_logical, mstrid, mpicom, ierr) #endif - ! Set module data - coefficients_file_lw = rrtmgp_coefficients_file_lw - coefficients_file_sw = rrtmgp_coefficients_file_sw - ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary if (present(dtime_in)) then dtime = dtime_in @@ -273,7 +262,7 @@ subroutine radiation_readnl(nlfile, dtime_in) ! Print runtime options to log. if (masterproc) then write(iulog,*) 'RRTMGP radiation scheme parameters:' - write(iulog,10) trim(coefficients_file_lw), trim(coefficients_file_sw), & + write(iulog,10) trim(rrtmgp_coefficients_file_lw), trim(rrtmgp_coefficients_file_sw), & iradsw, iradlw, irad_always, & use_rad_dt_cosz, spectralflux, & do_aerosol_rad, fixed_total_solar_irradiance, & @@ -502,26 +491,12 @@ subroutine radiation_init(state) ! Do initialization for perturbation growth tests call perturbation_growth_init() - ! Read gas optics coefficients from file - ! Need to initialize available_gases here! The only field of the - ! available_gases type that is used int he kdist initialize is - ! available_gases%gas_name, which gives the name of each gas that would be - ! present in the ty_gas_concs object. So, we can just set this here, rather - ! than trying to fully populate the ty_gas_concs object here, which would be - ! impossible from this initialization routine because I do not thing the - ! rad_cnst objects are setup yet. - call set_available_gases(active_gases, available_gases) - call rrtmgp_load_coefficients(k_dist_sw, coefficients_file_sw, available_gases) - call rrtmgp_load_coefficients(k_dist_lw, coefficients_file_lw, available_gases) + ! Setup the RRTMGP interface + call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) ! Make sure number of bands in absorption coefficient files matches what we expect - call assert(nswbands == k_dist_sw%get_nband(), 'nswbands does not match absorption coefficient data') - call assert(nlwbands == k_dist_lw%get_nband(), 'nlwbands does not match absorption coefficient data') - - ! Set number of g-points for used for correlated-k. These are determined - ! by the absorption coefficient data. - nswgpts = k_dist_sw%get_ngpt() - nlwgpts = k_dist_lw%get_ngpt() + call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') + call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index f1541397afa6..14b083bb230e 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -26,7 +26,10 @@ module radiation ! RRTMGP gas optics object to store coefficient information. This is imported ! here so that we can make the k_dist objects module data and only load them ! once. - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use rrtmgp_interface, only: & + k_dist_sw, k_dist_lw, rrtmgp_initialize, & + rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & + nswgpts, nlwgpts use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks @@ -137,19 +140,10 @@ module radiation ! angle calculation? What is the other behavior? real(r8) :: dt_avg = 0.0_r8 - ! k-distribution coefficients. These will be populated by reading from the - ! RRTMGP coefficients files, specified by coefficients_file_sw and - ! coefficients_file_lw in the radiation namelist. They exist as module data - ! because we only want to load those files once. - type(ty_gas_optics_rrtmgp) :: k_dist_sw, k_dist_lw - ! k-distribution coefficients files to read from. These are set via namelist ! variables. character(len=cl) :: rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw - ! Number of g-points in k-distribution (set based on absorption coefficient inputdata) - integer :: nswgpts, nlwgpts - ! Band midpoints; these need to be module variables because of how cam_history works; ! add_hist_coord sets up pointers to these, so they need to persist. real(r8), target :: sw_band_midpoints(nswbands), lw_band_midpoints(nlwbands) @@ -468,13 +462,6 @@ subroutine radiation_init(state) character(len=128) :: error_message - ! ty_gas_concs object that would normally hold volume mixing ratios for - ! radiatively-important gases. Here, this is just used to provide the names - ! of gases that are available in the model (needed by the kdist - ! initialization routines that are called within the load_coefficients - ! methods). - type(ty_gas_concs) :: available_gases - character(len=32) :: subname = 'radiation_init' !----------------------------------------------------------------------- @@ -492,27 +479,12 @@ subroutine radiation_init(state) ! Do initialization for perturbation growth tests call perturbation_growth_init() - ! Read gas optics coefficients from file - ! Need to initialize available_gases here! The only field of the - ! available_gases type that is used int he kdist initialize is - ! available_gases%gas_name, which gives the name of each gas that would be - ! present in the ty_gas_concs object. So, we can just set this here, rather - ! than trying to fully populate the ty_gas_concs object here, which would be - ! impossible from this initialization routine because I do not thing the - ! rad_cnst objects are setup yet. - ! the other tasks! - ! TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast - call set_available_gases(active_gases, available_gases) - call rrtmgp_load_coefficients(k_dist_sw, rrtmgp_coefficients_file_sw, available_gases) - call rrtmgp_load_coefficients(k_dist_lw, rrtmgp_coefficients_file_lw, available_gases) + ! Setup the RRTMGP interface + call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) ! Make sure number of bands in absorption coefficient files matches what we expect - call assert(nswbands == k_dist_sw%get_nband(), 'nswbands does not match absorption coefficient data') - call assert(nlwbands == k_dist_lw%get_nband(), 'nlwbands does not match absorption coefficient data') - - ! Number of gpoints depend on inputdata, so initialize here - nswgpts = k_dist_sw%get_ngpt() - nlwgpts = k_dist_lw%get_ngpt() + call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') + call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL @@ -1024,28 +996,6 @@ subroutine perturbation_growth_init() end subroutine perturbation_growth_init - - subroutine set_available_gases(gases, gas_concentrations) - - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - - type(ty_gas_concs), intent(inout) :: gas_concentrations - character(len=*), intent(in) :: gases(:) - character(len=32), dimension(size(gases)) :: gases_lowercase - integer :: igas - - ! Initialize with lowercase gas names; we should work in lowercase - ! whenever possible because we cannot trust string comparisons in RRTMGP - ! to be case insensitive - do igas = 1,size(gases) - gases_lowercase(igas) = trim(lower_case(gases(igas))) - end do - call handle_error(gas_concentrations%init(gases_lowercase)) - - end subroutine set_available_gases - - !=============================================================================== !---------------------------------------------------------------------------- From 767a8d5a2fde057dae148139aa7e784b49421924 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 16:33:23 -0400 Subject: [PATCH 07/71] Interface to get min/max RRTMGP temperatures --- components/eam/src/physics/crm/rrtmgp/radiation.F90 | 6 ++++-- components/eam/src/physics/rrtmgp/radiation.F90 | 6 ++++-- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 12 +++++++++++- 3 files changed, 19 insertions(+), 5 deletions(-) rename components/{cam => eam}/src/physics/rrtmgp/rrtmgp_interface.F90 (90%) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index f6ab6887bd57..b5acd71676ec 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -30,6 +30,8 @@ module radiation use rrtmgp_interface, only: & k_dist_sw, k_dist_lw, rrtmgp_initialize, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & + rrtmgp_get_min_temperature => get_min_temperature, & + rrtmgp_get_max_temperature => get_max_temperature, & nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks @@ -1569,11 +1571,11 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! values to min/max specified call t_startf('rad_check_temperatures') call handle_error(clip_values( & - tmid_col(1:ncol,1:nlev_rad), k_dist_lw%get_temp_min(), k_dist_lw%get_temp_max(), & + tmid_col(1:ncol,1:nlev_rad), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & trim(subname) // ' tmid' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call handle_error(clip_values( & - tint_col(1:ncol,1:nlev_rad+1), k_dist_lw%get_temp_min(), k_dist_lw%get_temp_max(), & + tint_col(1:ncol,1:nlev_rad+1), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & trim(subname) // ' tint' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call t_stopf('rad_check_temperatures') diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 14b083bb230e..c8f28ae1ea81 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -29,6 +29,8 @@ module radiation use rrtmgp_interface, only: & k_dist_sw, k_dist_lw, rrtmgp_initialize, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & + rrtmgp_get_min_temperature => get_min_temperature, & + rrtmgp_get_max_temperature => get_max_temperature, & nswgpts, nlwgpts use mo_rte_kind, only: wp @@ -1209,11 +1211,11 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! values to min/max specified call t_startf('rrtmgp_check_temperatures') call handle_error(clip_values( & - tmid(1:ncol,1:nlev_rad), k_dist_lw%get_temp_min(), k_dist_lw%get_temp_max(), & + tmid(1:ncol,1:nlev_rad), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & trim(subname) // ' tmid' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call handle_error(clip_values( & - tint(1:ncol,1:nlev_rad+1), k_dist_lw%get_temp_min(), k_dist_lw%get_temp_max(), & + tint(1:ncol,1:nlev_rad+1), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & trim(subname) // ' tint' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call t_stopf('rrtmgp_check_temperatures') diff --git a/components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 similarity index 90% rename from components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 rename to components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index ff4fb39073f6..06066e4707f2 100644 --- a/components/cam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -8,6 +8,7 @@ module rrtmgp_interface use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use mo_load_coefficients, only: load_and_init + use mo_rte_kind, only: wp implicit none @@ -24,7 +25,8 @@ module rrtmgp_interface public :: rrtmgp_initialize, & get_nbnds_sw, get_nbnds_lw, & - get_ngpts_sw, get_ngpts_lw + get_ngpts_sw, get_ngpts_lw, & + get_min_temperature, get_max_temperature contains @@ -69,6 +71,14 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi nlwgpts = k_dist_lw%get_ngpt() end subroutine rrtmgp_initialize + real(wp) function get_min_temperature() + get_min_temperature = min(k_dist_sw%get_temp_min(), k_dist_lw%get_temp_min()) + end function get_min_temperature + + real(wp) function get_max_temperature() + get_max_temperature = max(k_dist_sw%get_temp_max(), k_dist_lw%get_temp_max()) + end function get_max_temperature + ! -------------------------------------------------------------------------- ! Private routines ! -------------------------------------------------------------------------- From 5e0e204fe2c69ab2f9ae44f6f59d5a574917f7ec Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 16:55:03 -0400 Subject: [PATCH 08/71] Interface for gpoing_bands --- components/eam/src/physics/crm/rrtmgp/radiation.F90 | 5 +++-- components/eam/src/physics/rrtmgp/radiation.F90 | 5 +++-- .../eam/src/physics/rrtmgp/rrtmgp_interface.F90 | 11 +++++++++++ 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index b5acd71676ec..03e0d44a0db4 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -32,6 +32,7 @@ module radiation rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & + get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks @@ -1622,7 +1623,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state call sample_cloud_optics_sw( & - ncol, pver, nswgpts, k_dist_sw%get_gpoint_bands(), & + ncol, pver, nswgpts, get_gpoint_bands_sw(), & state%pmid, cld, cldfsnow, & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw & @@ -1645,7 +1646,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) call sample_cloud_optics_lw( & - ncol, pver, nlwgpts, k_dist_lw%get_gpoint_bands(), & + ncol, pver, nlwgpts, get_gpoint_bands_sw(), & state%pmid, cld, cldfsnow, & cld_tau_bnd_lw, cld_tau_gpt_lw & ) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index c8f28ae1ea81..f28f548caa2b 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -31,6 +31,7 @@ module radiation rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & + get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts use mo_rte_kind, only: wp @@ -1269,7 +1270,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state call sample_cloud_optics_sw( & - ncol, pver, nswgpts, k_dist_sw%get_gpoint_bands(), & + ncol, pver, nswgpts, get_gpoint_bands_sw(), & state%pmid, cld, cldfsnow, & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw & @@ -1376,7 +1377,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) call sample_cloud_optics_lw( & - ncol, pver, nlwgpts, k_dist_lw%get_gpoint_bands(), & + ncol, pver, nlwgpts, get_gpoint_bands_lw(), & state%pmid, cld, cldfsnow, & cld_tau_bnd_lw, cld_tau_gpt_lw & ) diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index 06066e4707f2..11ce5d3c85e8 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -26,6 +26,7 @@ module rrtmgp_interface public :: rrtmgp_initialize, & get_nbnds_sw, get_nbnds_lw, & get_ngpts_sw, get_ngpts_lw, & + get_gpoint_bands_sw, get_gpoint_bands_lw, & get_min_temperature, get_max_temperature contains @@ -46,6 +47,16 @@ integer function get_ngpts_lw() get_ngpts_lw = k_dist_lw%get_ngpt() end function get_ngpts_lw + function get_gpoint_bands_sw() result(gpoint_bands) + integer, dimension(nswgpts) :: gpoint_bands + gpoint_bands = k_dist_sw%get_gpoint_bands() + end function get_gpoint_bands_sw + + function get_gpoint_bands_lw() result(gpoint_bands) + integer, dimension(nlwgpts) :: gpoint_bands + gpoint_bands = k_dist_lw%get_gpoint_bands() + end function get_gpoint_bands_lw + subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) character(len=*), intent(in) :: active_gases(:) character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw From d24862a59a5364b1cbb8926edb865fcf4d85071e Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 17:25:14 -0400 Subject: [PATCH 09/71] Remove k_dist from set_albedo --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 15 ++++++++------- components/eam/src/physics/rrtmgp/radiation.F90 | 13 +++++++------ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 03e0d44a0db4..29fab39b9733 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -20,6 +20,7 @@ module radiation nswbands, nlwbands, & get_band_index_sw, get_band_index_lw, test_get_band_index, & get_sw_spectral_midpoints, get_lw_spectral_midpoints, & + get_sw_spectral_boundaries, & rrtmg_to_rrtmgp_swbands use cam_history_support, only: add_hist_coord use physconst, only: cpair, cappa @@ -1646,7 +1647,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) call sample_cloud_optics_lw( & - ncol, pver, nlwgpts, get_gpoint_bands_sw(), & + ncol, pver, nlwgpts, get_gpoint_bands_lw(), & state%pmid, cld, cldfsnow, & cld_tau_bnd_lw, cld_tau_gpt_lw & ) @@ -2493,7 +2494,7 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) real(r8), intent(inout) :: albedo_dif(:,:) ! surface albedo, diffuse radiation ! Local namespace - real(r8) :: wavenumber_limits(2,nswbands) + real(r8), dimension(nswbands) :: lower_bounds, upper_bounds integer :: ncol, iband character(len=10) :: subname = 'set_albedo' @@ -2517,20 +2518,20 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) ! Albedos are input as broadband (visible, and near-IR), and we need to map ! these to appropriate bands. Bands are categorized broadly as "visible" or ! "infrared" based on wavenumber, so we get the wavenumber limits here - wavenumber_limits = k_dist_sw%get_band_lims_wavenumber() + call get_sw_spectral_boundaries(lower_bounds, upper_bounds, 'cm^-1') ! Loop over bands, and determine for each band whether it is broadly in the ! visible or infrared part of the spectrum (visible or "not visible") do iband = 1,nswbands - if (is_visible(wavenumber_limits(1,iband)) .and. & - is_visible(wavenumber_limits(2,iband))) then + if (is_visible(lower_bounds(iband)) .and. & + is_visible(upper_bounds(iband))) then ! Entire band is in the visible albedo_dir(iband,1:ncol) = cam_in%asdir(1:ncol) albedo_dif(iband,1:ncol) = cam_in%asdif(1:ncol) - else if (.not.is_visible(wavenumber_limits(1,iband)) .and. & - .not.is_visible(wavenumber_limits(2,iband))) then + else if (.not.is_visible(lower_bounds(iband)) .and. & + .not.is_visible(upper_bounds(iband))) then ! Entire band is in the longwave (near-infrared) albedo_dir(iband,1:ncol) = cam_in%aldir(1:ncol) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index f28f548caa2b..c2524232fb6a 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -20,6 +20,7 @@ module radiation use radconstants, only: nswbands, nlwbands, & get_band_index_sw, get_band_index_lw, test_get_band_index, & get_sw_spectral_midpoints, get_lw_spectral_midpoints, & + get_sw_spectral_boundaries, & rrtmg_to_rrtmgp_swbands use physconst, only: cpair, cappa @@ -2216,7 +2217,7 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) real(r8), intent(inout) :: albedo_dif(:,:) ! surface albedo, diffuse radiation ! Local namespace - real(r8) :: wavenumber_limits(2,nswbands) + real(r8), dimension(nswbands) :: lower_bounds, upper_bounds integer :: ncol, iband character(len=10) :: subname = 'set_albedo' @@ -2240,20 +2241,20 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) ! Albedos are input as broadband (visible, and near-IR), and we need to map ! these to appropriate bands. Bands are categorized broadly as "visible" or ! "infrared" based on wavenumber, so we get the wavenumber limits here - wavenumber_limits(:,:) = k_dist_sw%get_band_lims_wavenumber() + call get_sw_spectral_boundaries(lower_bounds, upper_bounds, 'cm^-1') ! Loop over bands, and determine for each band whether it is broadly in the ! visible or infrared part of the spectrum (visible or "not visible") do iband = 1,nswbands - if (is_visible(wavenumber_limits(1,iband)) .and. & - is_visible(wavenumber_limits(2,iband))) then + if (is_visible(lower_bounds(iband)) .and. & + is_visible(upper_bounds(iband))) then ! Entire band is in the visible albedo_dir(iband,1:ncol) = cam_in%asdir(1:ncol) albedo_dif(iband,1:ncol) = cam_in%asdif(1:ncol) - else if (.not.is_visible(wavenumber_limits(1,iband)) .and. & - .not.is_visible(wavenumber_limits(2,iband))) then + else if (.not.is_visible(lower_bounds(iband)) .and. & + .not.is_visible(upper_bounds(iband))) then ! Entire band is in the longwave (near-infrared) albedo_dir(iband,1:ncol) = cam_in%aldir(1:ncol) From 90f37fa9826d2994fab607be6dd8daea7ea39ba5 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 17 Aug 2020 18:55:35 -0400 Subject: [PATCH 10/71] Passthrough interface for rte_sw --- .../eam/src/physics/rrtmgp/radiation.F90 | 14 +++---- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 39 ++++++++++++++++++- 2 files changed, 45 insertions(+), 8 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index c2524232fb6a..ba71a7f7f187 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -28,7 +28,7 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - k_dist_sw, k_dist_lw, rrtmgp_initialize, & + k_dist_sw, k_dist_lw, rrtmgp_initialize, rrtmgp_run_sw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & @@ -1688,19 +1688,19 @@ subroutine radiation_driver_sw(ncol, & ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') - call handle_error(rte_sw( & - k_dist_sw, gas_concentrations, & + call rrtmgp_run_sw( & + nday, nlev_rad, & + gas_concentrations, & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & coszrs_day(1:nday), & albedo_dir_day(1:nswbands,1:nday), & albedo_dif_day(1:nswbands,1:nday), & - cld_optics_sw, & + cld_optics_sw, aer_optics_sw, & fluxes_allsky_day, fluxes_clrsky_day, & - aer_props=aer_optics_sw, & - tsi_scaling=tsi_scaling & - )) + tsi_scaling & + ) call t_stopf('rad_calculations_sw') ! Calculate heating rates on the DAYTIME columns diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index 11ce5d3c85e8..f8e4a591400c 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -9,6 +9,9 @@ module rrtmgp_interface use mo_gas_concentrations, only: ty_gas_concs use mo_load_coefficients, only: load_and_init use mo_rte_kind, only: wp + use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_rrtmgp_clr_all_sky, only: rte_sw implicit none @@ -23,7 +26,7 @@ module rrtmgp_interface ! interfaces. integer, public :: nswbands, nlwbands, nswgpts, nlwgpts - public :: rrtmgp_initialize, & + public :: rrtmgp_initialize, rrtmgp_run_sw, & get_nbnds_sw, get_nbnds_lw, & get_ngpts_sw, get_ngpts_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & @@ -82,6 +85,40 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi nlwgpts = k_dist_lw%get_ngpt() end subroutine rrtmgp_initialize + subroutine rrtmgp_run_sw( & + nday, nlev, gas_concentrations, & + pmid_day, tmid_day, pint_day, coszrs_day, & + albedo_dir_day, albedo_dif_day, & + cld_optics_sw, aer_optics_sw, & + fluxes_allsky_day, fluxes_clrsky_day, & + tsi_scaling & + ) + integer, intent(in) :: nday, nlev + type(ty_gas_concs), intent(in) :: gas_concentrations + real(wp), intent(in), dimension(:,:) :: & + pmid_day, tmid_day, pint_day + real(wp), intent(in), dimension(:) :: coszrs_day + real(wp), intent(in), dimension(:,:) :: albedo_dir_day, albedo_dif_day + type(ty_optical_props_2str), intent(in) :: cld_optics_sw, aer_optics_sw + type(ty_fluxes_byband), intent(inout) :: fluxes_allsky_day, fluxes_clrsky_day + real(wp), intent(in) :: tsi_scaling + + call handle_error(rte_sw( & + k_dist_sw, gas_concentrations, & + pmid_day(1:nday,1:nlev), & + tmid_day(1:nday,1:nlev), & + pint_day(1:nday,1:nlev+1), & + coszrs_day(1:nday), & + albedo_dir_day(1:nswbands,1:nday), & + albedo_dif_day(1:nswbands,1:nday), & + cld_optics_sw, & + fluxes_allsky_day, fluxes_clrsky_day, & + aer_props=aer_optics_sw, & + tsi_scaling=tsi_scaling & + )) + end subroutine rrtmgp_run_sw + + real(wp) function get_min_temperature() get_min_temperature = min(k_dist_sw%get_temp_min(), k_dist_lw%get_temp_min()) end function get_min_temperature From c5beafc7a30e67e758ed93ffff2c860efdc2a7b1 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 16 Sep 2020 17:16:14 -0400 Subject: [PATCH 11/71] Add interfaces for rrtmgp_run_lw and rrtmgp_run_sw --- .../eam/src/physics/rrtmgp/radiation.F90 | 402 ++--------------- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 421 +++++++++++++++++- 2 files changed, 454 insertions(+), 369 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index ba71a7f7f187..9b897e99cc55 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -28,12 +28,16 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - k_dist_sw, k_dist_lw, rrtmgp_initialize, rrtmgp_run_sw, & + k_dist_sw, k_dist_lw, & + rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts + nswgpts, nlwgpts, & + initialize_rrtmgp_fluxes, free_fluxes, & + free_optics_sw, free_optics_lw, reset_fluxes, & + set_gas_concentrations use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks @@ -1510,11 +1514,10 @@ subroutine radiation_driver_sw(ncol, & use perf_mod, only: t_startf, t_stopf use mo_rrtmgp_clr_all_sky, only: rte_sw use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_2str use mo_gas_concentrations, only: ty_gas_concs use radiation_utils, only: calculate_heating_rate use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & - compress_optics_sw, set_aerosol_optics_sw + set_aerosol_optics_sw ! Inputs integer, intent(in) :: ncol @@ -1528,21 +1531,6 @@ subroutine radiation_driver_sw(ncol, & real(r8), intent(in), dimension(:,:,:) :: cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt real(r8), intent(in), dimension(:,:,:) :: aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd - ! Temporary fluxes compressed to daytime only arrays - type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day - - ! Temporary heating rates on radiation vertical grid (and daytime only) - real(r8), dimension(ncol,nlev_rad) :: qrs_rad, qrsc_rad - - ! Albedo for shortwave calculations - real(r8), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day - - ! Cloud and aerosol optics - type(ty_optical_props_2str) :: aer_optics_sw, cld_optics_sw - - ! Gas concentrations - type(ty_gas_concs) :: gas_concentrations - ! Incoming solar radiation, scaled for solar zenith angle ! and earth-sun distance real(r8) :: solar_irradiance_by_gpt(ncol,nswgpts) @@ -1552,26 +1540,11 @@ subroutine radiation_driver_sw(ncol, & integer :: nday, nnight ! Number of daylight columns integer :: day_indices(ncol), night_indices(ncol) ! Indicies of daylight coumns - ! Cosine solar zenith angle for daytime columns - real(r8) :: coszrs_day(ncol) ! cosine solar zenith angle - ! Scaling factor for total sky irradiance; used to account for orbital ! eccentricity, and could be used to scale total sky irradiance for different ! climates as well (i.e., paleoclimate simulations) real(r8) :: tsi_scaling - ! Loop indices - integer :: iband - - ! State fields that are passed into RRTMGP. Some of these may need to - ! modified from what exist in the physics_state object, i.e. to clip - ! temperatures to make sure they are within the valid range. - real(r8), dimension(ncol,nlev_rad) :: tmid_day, pmid_day - real(r8), dimension(ncol,nlev_rad+1) :: pint_day, tint_day - - real(r8), dimension(size(active_gases),ncol,pver) :: gas_vmr_day - integer :: igas, iday, icol - ! Everybody needs a name character(*), parameter :: subroutine_name = 'radiation_driver_sw' @@ -1603,140 +1576,42 @@ subroutine radiation_driver_sw(ncol, & return end if - ! Compress state to daytime-only - do iday = 1,nday - icol = day_indices(iday) - tmid_day(iday,:) = tmid(icol,:) - pmid_day(iday,:) = pmid(icol,:) - pint_day(iday,:) = pint(icol,:) - end do - - ! Compress to daytime-only arrays - do iband = 1,nswbands - call compress_day_columns(albedo_dir(iband,1:ncol), albedo_dir_day(iband,1:nday), day_indices(1:nday)) - call compress_day_columns(albedo_dif(iband,1:ncol), albedo_dif_day(iband,1:nday), day_indices(1:nday)) - end do - call compress_day_columns(coszrs(1:ncol), coszrs_day(1:nday), day_indices(1:nday)) - - ! Allocate shortwave fluxes (allsky and clearsky) - ! TODO: why do I need to provide my own routines to do this? Why is - ! this not part of the ty_fluxes_byband object? - ! - ! NOTE: fluxes defined at interfaces, so initialize to have vertical - ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to - ! have vertical dimension nlev_rad (defined at midpoints). - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) - - ! Populate RRTMGP optics - call handle_error(cld_optics_sw%alloc_2str(nday, nlev_rad, k_dist_sw, name='shortwave cloud optics')) - cld_optics_sw%tau = 0 - cld_optics_sw%ssa = 1 - cld_optics_sw%g = 0 - call compress_optics_sw( & - day_indices, cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - cld_optics_sw%tau(1:nday,2:nlev_rad,:), & - cld_optics_sw%ssa(1:nday,2:nlev_rad,:), & - cld_optics_sw%g (1:nday,2:nlev_rad,:) & - ) - ! Apply delta scaling to account for forward-scattering - call handle_error(cld_optics_sw%delta_scale()) - - ! Initialize aerosol optics; passing only the wavenumber bounds for each - ! "band" rather than passing the full spectral discretization object, and - ! omitting the "g-point" mapping forces the optics to be indexed and - ! stored by band rather than by g-point. This is most consistent with our - ! treatment of aerosol optics in the model, and prevents us from having to - ! map bands to g-points ourselves since that will all be handled by the - ! private routines internal to the optics class. - call handle_error(aer_optics_sw%alloc_2str( & - nday, nlev_rad, k_dist_sw%get_band_lims_wavenumber(), & - name='shortwave aerosol optics' & - )) - - ! Populate aerosol optics (and compress to daytime only) - if (do_aerosol_rad) then - aer_optics_sw%tau = 0 - aer_optics_sw%ssa = 1 - aer_optics_sw%g = 0 - call compress_optics_sw( & - day_indices, & - aer_tau_bnd(1:ncol,1:pver,:), & - aer_ssa_bnd(1:ncol,1:pver,:), & - aer_asm_bnd(1:ncol,1:pver,:), & - aer_optics_sw%tau(1:nday,2:nlev_rad,:), & - aer_optics_sw%ssa(1:nday,2:nlev_rad,:), & - aer_optics_sw%g (1:nday,2:nlev_rad,:) & - ) - ! Apply delta scaling to account for forward-scattering - call handle_error(aer_optics_sw%delta_scale()) - else - aer_optics_sw%tau(:,:,:) = 0 - aer_optics_sw%ssa(:,:,:) = 0 - aer_optics_sw%g (:,:,:) = 0 - end if - - ! Compress gases to daytime-only - call t_startf('rad_set_gases_sw') - do igas = 1,size(active_gases) - call compress_day_columns(gas_vmr(igas,1:ncol,1:pver), & - gas_vmr_day(igas,1:nday,1:pver), & - day_indices(1:nday)) - end do - call set_gas_concentrations(nday, gas_names, gas_vmr_day, gas_concentrations) - call t_stopf('rad_set_gases_sw') + ! Add a level above model top to optical properties! ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') call rrtmgp_run_sw( & - nday, nlev_rad, & - gas_concentrations, & - pmid_day(1:nday,1:nlev_rad), & - tmid_day(1:nday,1:nlev_rad), & - pint_day(1:nday,1:nlev_rad+1), & - coszrs_day(1:nday), & - albedo_dir_day(1:nswbands,1:nday), & - albedo_dif_day(1:nswbands,1:nday), & - cld_optics_sw, aer_optics_sw, & - fluxes_allsky_day, fluxes_clrsky_day, & + size(active_gases), ncol, nday, nlev_rad, & + day_indices, gas_names, gas_vmr, & + pmid(1:ncol,1:nlev_rad), & + tmid(1:ncol,1:nlev_rad), & + pint(1:ncol,1:nlev_rad+1), & + coszrs(1:ncol), & + albedo_dir(1:nswbands,1:ncol), & + albedo_dif(1:nswbands,1:ncol), & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + fluxes_allsky, fluxes_clrsky, & tsi_scaling & ) call t_stopf('rad_calculations_sw') - ! Calculate heating rates on the DAYTIME columns + ! Calculate heating rates call t_startf('rad_heating_rate_sw') call calculate_heating_rate( & - fluxes_allsky_day%flux_up, & - fluxes_allsky_day%flux_dn, & - pint_day(1:nday,1:nlev_rad+1), & - qrs_rad(1:nday,1:nlev_rad) & + fluxes_allsky%flux_up(1:ncol,ktop:kbot+1), & + fluxes_allsky%flux_dn(1:ncol,ktop:kbot+1), & + pint(1:ncol,ktop:kbot+1), & + qrs(1:ncol,1:pver) & ) call calculate_heating_rate( & - fluxes_clrsky_day%flux_up, & - fluxes_clrsky_day%flux_dn, & - pint_day(1:nday,1:nlev_rad+1), & - qrsc_rad(1:nday,1:nlev_rad) & + fluxes_clrsky%flux_up(1:ncol,ktop:kbot+1), & + fluxes_clrsky%flux_dn(1:ncol,ktop:kbot+1), & + pint(1:ncol,ktop:kbot+1), & + qrsc(1:ncol,1:pver) & ) call t_stopf('rad_heating_rate_sw') - ! Expand fluxes from daytime-only arrays to full chunk arrays - call t_startf('rad_expand_fluxes_sw') - call expand_day_fluxes(fluxes_allsky_day, fluxes_allsky, day_indices(1:nday)) - call expand_day_fluxes(fluxes_clrsky_day, fluxes_clrsky, day_indices(1:nday)) - call t_stopf('rad_expand_fluxes_sw') - - ! Expand heating rates to all columns and map back to CAM levels - call t_startf('rad_expand_heating_rate_sw') - call expand_day_columns(qrs_rad(1:nday,ktop:kbot), qrs(1:ncol,1:pver), day_indices(1:nday)) - call expand_day_columns(qrsc_rad(1:nday,ktop:kbot), qrsc(1:ncol,1:pver), day_indices(1:nday)) - call t_stopf('rad_expand_heating_rate_sw') - - ! Free fluxes and optical properties - call free_optics_sw(cld_optics_sw) - call free_optics_sw(aer_optics_sw) - call free_fluxes(fluxes_allsky_day) - call free_fluxes(fluxes_clrsky_day) - end subroutine radiation_driver_sw !---------------------------------------------------------------------------- @@ -1907,17 +1782,25 @@ subroutine radiation_driver_lw(ncol, & ! Do longwave radiative transfer calculations call t_startf('rad_calculations_lw') - call handle_error(rte_lw( & - k_dist_lw, gas_concentrations, & - pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), & - pint(1:ncol,1:nlev_rad+1), tint(1:ncol,nlev_rad+1), & - surface_emissivity(1:nlwbands,1:ncol), & - cld_optics_lw, & - fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics_lw, & - t_lev=tint(1:ncol,1:nlev_rad+1), & - n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG - )) + call rrtmgp_run_lw( & + size(active_gases), ncol, nlev_rad, & + gas_names, gas_vmr, & + surface_emissivity, & + pmid, tmid, pint, tint, & + cld_tau_gpt, aer_tau_bnd, & + fluxes_allsky, fluxes_clrsky & + ) +! call handle_error(rte_lw( & +! k_dist_lw, gas_concentrations, & +! pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), & +! pint(1:ncol,1:nlev_rad+1), tint(1:ncol,nlev_rad+1), & +! surface_emissivity(1:nlwbands,1:ncol), & +! cld_optics_lw, & +! fluxes_allsky, fluxes_clrsky, & +! aer_props=aer_optics_lw, & +! t_lev=tint(1:ncol,1:nlev_rad+1), & +! n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG +! )) call t_stopf('rad_calculations_lw') ! Calculate heating rates @@ -2063,28 +1946,6 @@ end subroutine set_net_fluxes_lw !---------------------------------------------------------------------------- - subroutine reset_fluxes(fluxes) - - use mo_rte_kind, only: wp - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - - ! Reset broadband fluxes - fluxes%flux_up(:,:) = 0._wp - fluxes%flux_dn(:,:) = 0._wp - fluxes%flux_net(:,:) = 0._wp - if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._wp - - ! Reset band-by-band fluxes - fluxes%bnd_flux_up(:,:,:) = 0._wp - fluxes%bnd_flux_dn(:,:,:) = 0._wp - fluxes%bnd_flux_net(:,:,:) = 0._wp - if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._wp - - end subroutine reset_fluxes - - !---------------------------------------------------------------------------- - subroutine set_daynight_indices(coszrs, day_indices, night_indices) ! Input: cosine of solar zenith angle real(r8), intent(in) :: coszrs(:) @@ -2444,85 +2305,6 @@ end subroutine output_fluxes_lw !---------------------------------------------------------------------------- - ! For some reason the RRTMGP flux objects do not include initialization - ! routines, but rather expect the user to associate the individual fluxes (which - ! are pointers) with appropriate targets. Instead, this routine treats those - ! pointers as allocatable members and allocates space for them. TODO: is this - ! appropriate use? - subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) - - use mo_fluxes_byband, only: ty_fluxes_byband - integer, intent(in) :: ncol, nlevels, nbands - type(ty_fluxes_byband), intent(inout) :: fluxes - logical, intent(in), optional :: do_direct - - logical :: do_direct_local - - if (present(do_direct)) then - do_direct_local = .true. - else - do_direct_local = .false. - end if - - ! Allocate flux arrays - ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as - ! number of model levels plus one, or allocate as nlevels+1 if nlevels - ! represents number of model levels rather than number of interface levels. - - ! Broadband fluxes - allocate(fluxes%flux_up(ncol, nlevels)) - allocate(fluxes%flux_dn(ncol, nlevels)) - allocate(fluxes%flux_net(ncol, nlevels)) - if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) - - ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) - if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) - - ! Initialize - call reset_fluxes(fluxes) - - end subroutine initialize_rrtmgp_fluxes - - !---------------------------------------------------------------------------- - - subroutine free_fluxes(fluxes) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) - if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) - if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) - if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) - if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) - if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) - if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) - if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) - end subroutine free_fluxes - - !---------------------------------------------------------------------------- - - subroutine free_optics_sw(optics) - use mo_optical_props, only: ty_optical_props_2str - type(ty_optical_props_2str), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - if (allocated(optics%ssa)) deallocate(optics%ssa) - if (allocated(optics%g)) deallocate(optics%g) - call optics%finalize() - end subroutine free_optics_sw - - !---------------------------------------------------------------------------- - - subroutine free_optics_lw(optics) - use mo_optical_props, only: ty_optical_props_1scl - type(ty_optical_props_1scl), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - call optics%finalize() - end subroutine free_optics_lw - - !---------------------------------------------------------------------------- - subroutine get_gas_vmr(icall, state, pbuf, gas_names, gas_vmr) use physics_types, only: physics_state @@ -2552,7 +2334,7 @@ subroutine get_gas_vmr(icall, state, pbuf, gas_names, gas_vmr) ! Molar weight of air real(r8), parameter :: mol_weight_air = 28.97 ! g/mol - + ! Defaults for gases that are not available (TODO: is this still accurate?) real(r8), parameter :: co_vol_mix_ratio = 1.0e-7_r8 real(r8), parameter :: n2_vol_mix_ratio = 0.7906_r8 @@ -2622,53 +2404,6 @@ end subroutine get_gas_vmr !---------------------------------------------------------------------------- - subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - - integer, intent(in) :: ncol - character(len=*), intent(in), dimension(:) :: gas_names - real(r8), intent(in), dimension(:,:,:) :: gas_vmr - type(ty_gas_concs), intent(out) :: gas_concentrations - - ! Local variables - real(r8), dimension(pcols,nlev_rad) :: vol_mix_ratio_out - - ! Loop indices - integer :: igas - - ! Character array to hold lowercase gas names - character(len=32), allocatable :: gas_names_lower(:) - - ! Name of subroutine for error messages - character(len=32) :: subname = 'set_gas_concentrations' - - ! Initialize gas concentrations with lower case names - allocate(gas_names_lower(size(gas_names))) - do igas = 1,size(gas_names) - gas_names_lower(igas) = trim(lower_case(gas_names(igas))) - end do - call handle_error(gas_concentrations%init(gas_names_lower)) - - ! For each gas, add level above model top and set values in RRTMGP object - do igas = 1,size(gas_names) - vol_mix_ratio_out = 0 - ! Map to radiation grid - vol_mix_ratio_out(1:ncol,ktop:kbot) = gas_vmr(igas,1:ncol,1:pver) - ! Copy top-most model level to top-most rad level (which could be above - ! the top of the model) - vol_mix_ratio_out(1:ncol,1) = gas_vmr(igas,1:ncol,1) - ! Set volumn mixing ratio in gas concentration object for just columns - ! in this chunk - call handle_error(gas_concentrations%set_vmr( & - trim(lower_case(gas_names(igas))), vol_mix_ratio_out(1:ncol,1:nlev_rad)) & - ) - end do - - end subroutine set_gas_concentrations - - !---------------------------------------------------------------------------- - logical function string_in_list(string, list) character(len=*), intent(in) :: string character(len=*), intent(in) :: list(:) @@ -2689,47 +2424,6 @@ end function string_in_list !---------------------------------------------------------------------------- - subroutine expand_day_fluxes(daytime_fluxes, expanded_fluxes, day_indices) - use mo_rte_kind, only: wp - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: daytime_fluxes - type(ty_fluxes_byband), intent(inout) :: expanded_fluxes - integer, intent(in) :: day_indices(:) - - integer :: nday, iday, icol - - ! Reset fluxes in expanded_fluxes object to zero - call reset_fluxes(expanded_fluxes) - - ! Number of daytime columns is number of indices greater than zero - nday = count(day_indices > 0) - - ! Loop over daytime indices and map daytime fluxes into expanded arrays - do iday = 1,nday - - ! Map daytime index to proper column index - icol = day_indices(iday) - - ! Expand broadband fluxes - expanded_fluxes%flux_up(icol,:) = daytime_fluxes%flux_up(iday,:) - expanded_fluxes%flux_dn(icol,:) = daytime_fluxes%flux_dn(iday,:) - expanded_fluxes%flux_net(icol,:) = daytime_fluxes%flux_net(iday,:) - if (associated(daytime_fluxes%flux_dn_dir)) then - expanded_fluxes%flux_dn_dir(icol,:) = daytime_fluxes%flux_dn_dir(iday,:) - end if - - ! Expand band-by-band fluxes - expanded_fluxes%bnd_flux_up(icol,:,:) = daytime_fluxes%bnd_flux_up(iday,:,:) - expanded_fluxes%bnd_flux_dn(icol,:,:) = daytime_fluxes%bnd_flux_dn(iday,:,:) - expanded_fluxes%bnd_flux_net(icol,:,:) = daytime_fluxes%bnd_flux_net(iday,:,:) - if (associated(daytime_fluxes%bnd_flux_dn_dir)) then - expanded_fluxes%bnd_flux_dn_dir(icol,:,:) = daytime_fluxes%bnd_flux_dn_dir(iday,:,:) - end if - - end do - - end subroutine expand_day_fluxes - ! Should we do snow optics? Check for existence of "cldfsnow" variable logical function do_snow_optics() use physics_buffer, only: pbuf_get_index diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index f8e4a591400c..aca0635490f3 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -5,13 +5,18 @@ ! code. module rrtmgp_interface + use perf_mod, only: t_startf, t_stopf + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use radiation_utils, only: compress_day_columns, expand_day_columns + use radiation_state, only: ktop, kbot, nlev_rad + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use mo_load_coefficients, only: load_and_init use mo_rte_kind, only: wp use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl use mo_fluxes_byband, only: ty_fluxes_byband - use mo_rrtmgp_clr_all_sky, only: rte_sw + use mo_rrtmgp_clr_all_sky, only: rte_sw, rte_lw implicit none @@ -26,11 +31,15 @@ module rrtmgp_interface ! interfaces. integer, public :: nswbands, nlwbands, nswgpts, nlwgpts - public :: rrtmgp_initialize, rrtmgp_run_sw, & + public :: & + rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & get_nbnds_sw, get_nbnds_lw, & get_ngpts_sw, get_ngpts_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - get_min_temperature, get_max_temperature + get_min_temperature, get_max_temperature, & + initialize_rrtmgp_fluxes, free_fluxes, & + free_optics_sw, free_optics_lw, reset_fluxes, & + set_gas_concentrations contains @@ -86,23 +95,116 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi end subroutine rrtmgp_initialize subroutine rrtmgp_run_sw( & - nday, nlev, gas_concentrations, & - pmid_day, tmid_day, pint_day, coszrs_day, & - albedo_dir_day, albedo_dif_day, & - cld_optics_sw, aer_optics_sw, & - fluxes_allsky_day, fluxes_clrsky_day, & + ngas, ncol, nday, nlev, day_indices, & + gas_names, gas_vmr, & + pmid, tmid, pint, coszrs, & + albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + fluxes_allsky, fluxes_clrsky, & tsi_scaling & ) - integer, intent(in) :: nday, nlev - type(ty_gas_concs), intent(in) :: gas_concentrations + integer, intent(in) :: ngas, ncol, nday, nlev + integer, intent(in), dimension(:) :: day_indices + character(len=*), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr real(wp), intent(in), dimension(:,:) :: & - pmid_day, tmid_day, pint_day - real(wp), intent(in), dimension(:) :: coszrs_day - real(wp), intent(in), dimension(:,:) :: albedo_dir_day, albedo_dif_day - type(ty_optical_props_2str), intent(in) :: cld_optics_sw, aer_optics_sw - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky_day, fluxes_clrsky_day + pmid, tmid, pint + real(wp), intent(in), dimension(:) :: coszrs + real(wp), intent(in), dimension(:,:) :: albedo_dir, albedo_dif + real(wp), intent(in), dimension(:,:,:) :: & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd + type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky real(wp), intent(in) :: tsi_scaling + real(wp), dimension(nday) :: coszrs_day + real(wp), dimension(nswbands,nday) :: albedo_dir_day, albedo_dif_day + real(wp), dimension(nday,nlev) :: pmid_day, tmid_day + real(wp), dimension(nday,nlev+1) :: pint_day + real(wp), dimension(ngas,nday,pver) :: gas_vmr_day + type(ty_gas_concs) :: gas_concentrations + type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw + type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day + + ! Loop indices + integer :: iband, igas, iday, icol + + ! Compress state to daytime-only + do iday = 1,nday + icol = day_indices(iday) + tmid_day(iday,:) = tmid(icol,:) + pmid_day(iday,:) = pmid(icol,:) + pint_day(iday,:) = pint(icol,:) + end do + + ! Compress to daytime-only arrays + do iband = 1,nswbands + call compress_day_columns(albedo_dir(iband,1:ncol), albedo_dir_day(iband,1:nday), day_indices(1:nday)) + call compress_day_columns(albedo_dif(iband,1:ncol), albedo_dif_day(iband,1:nday), day_indices(1:nday)) + end do + call compress_day_columns(coszrs(1:ncol), coszrs_day(1:nday), day_indices(1:nday)) + + ! Allocate shortwave fluxes (allsky and clearsky) + ! TODO: why do I need to provide my own routines to do this? Why is + ! this not part of the ty_fluxes_byband object? + ! + ! NOTE: fluxes defined at interfaces, so initialize to have vertical + ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to + ! have vertical dimension nlev_rad (defined at midpoints). + call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_allsky_day, do_direct=.true.) + call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_clrsky_day, do_direct=.true.) + + ! Populate RRTMGP optics + call handle_error(cld_optics_sw%alloc_2str(nday, nlev, k_dist_sw, name='shortwave cloud optics')) + cld_optics_sw%tau = 0 + cld_optics_sw%ssa = 1 + cld_optics_sw%g = 0 + call compress_optics_sw( & + day_indices, cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + cld_optics_sw%tau(1:nday,2:nlev,:), & + cld_optics_sw%ssa(1:nday,2:nlev,:), & + cld_optics_sw%g (1:nday,2:nlev,:) & + ) + ! Apply delta scaling to account for forward-scattering + call handle_error(cld_optics_sw%delta_scale()) + + ! Initialize aerosol optics; passing only the wavenumber bounds for each + ! "band" rather than passing the full spectral discretization object, and + ! omitting the "g-point" mapping forces the optics to be indexed and + ! stored by band rather than by g-point. This is most consistent with our + ! treatment of aerosol optics in the model, and prevents us from having to + ! map bands to g-points ourselves since that will all be handled by the + ! private routines internal to the optics class. + call handle_error(aer_optics_sw%alloc_2str( & + nday, nlev, k_dist_sw%get_band_lims_wavenumber(), & + name='shortwave aerosol optics' & + )) + aer_optics_sw%tau = 0 + aer_optics_sw%ssa = 1 + aer_optics_sw%g = 0 + call compress_optics_sw( & + day_indices, & + aer_tau_bnd(1:ncol,1:pver,:), & + aer_ssa_bnd(1:ncol,1:pver,:), & + aer_asm_bnd(1:ncol,1:pver,:), & + aer_optics_sw%tau(1:nday,2:nlev,:), & + aer_optics_sw%ssa(1:nday,2:nlev,:), & + aer_optics_sw%g (1:nday,2:nlev,:) & + ) + ! Apply delta scaling to account for forward-scattering + call handle_error(aer_optics_sw%delta_scale()) + + ! Compress gases to daytime-only + call t_startf('rad_set_gases_sw') + do igas = 1,ngas + call compress_day_columns(gas_vmr(igas,1:ncol,1:pver), & + gas_vmr_day(igas,1:nday,1:pver), & + day_indices(1:nday)) + end do + call set_gas_concentrations(nday, gas_names, gas_vmr_day, gas_concentrations) + call t_stopf('rad_set_gases_sw') + call handle_error(rte_sw( & k_dist_sw, gas_concentrations, & pmid_day(1:nday,1:nlev), & @@ -116,9 +218,82 @@ subroutine rrtmgp_run_sw( & aer_props=aer_optics_sw, & tsi_scaling=tsi_scaling & )) + + ! Expand fluxes from daytime-only arrays to full chunk arrays + call t_startf('rad_expand_fluxes_sw') + call expand_day_fluxes(fluxes_allsky_day, fluxes_allsky, day_indices(1:nday)) + call expand_day_fluxes(fluxes_clrsky_day, fluxes_clrsky, day_indices(1:nday)) + call t_stopf('rad_expand_fluxes_sw') + + ! Clean up after ourselves + call free_optics_sw(cld_optics_sw) + call free_optics_sw(aer_optics_sw) + call free_fluxes(fluxes_allsky_day) + call free_fluxes(fluxes_clrsky_day) + end subroutine rrtmgp_run_sw + subroutine rrtmgp_run_lw( & + ngas, ncol, nlev, & + gas_names, gas_vmr, & + surface_emissivity, & + pmid, tmid, pint, tint, & + cld_tau_gpt, aer_tau_bnd, & + fluxes_allsky, fluxes_clrsky & + ) + + integer, intent(in) :: ngas, ncol, nlev + character(len=*), intent(in), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr + real(wp), intent(in), dimension(:,:) :: surface_emissivity + real(wp), intent(in), dimension(:,:) :: pmid, tmid, pint, tint + real(wp), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd + type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + + type(ty_gas_concs) :: gas_concentrations + type(ty_optical_props_1scl) :: cld_optics, aer_optics + + ! Setup gas concentrations object + call t_startf('rad_gas_concentrations_lw') + call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + call t_stopf('rad_gas_concentrations_lw') + + ! Populate RRTMGP optics + call t_startf('longwave cloud optics') + call handle_error(cld_optics%alloc_1scl(ncol, nlev, k_dist_lw, name='longwave cloud optics')) + cld_optics%tau = 0.0 + cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,1:pver,:) + call handle_error(cld_optics%delta_scale()) + call t_stopf('longwave cloud optics') + + ! Initialize aerosol optics; passing only the wavenumber bounds for each + ! "band" rather than passing the full spectral discretization object, and + ! omitting the "g-point" mapping forces the optics to be indexed and + ! stored by band rather than by g-point. This is most consistent with our + ! treatment of aerosol optics in the model, and prevents us from having to + ! map bands to g-points ourselves since that will all be handled by the + ! private routines internal to the optics class. + call handle_error(aer_optics%alloc_1scl(ncol, nlev, k_dist_lw%get_band_lims_wavenumber())) + call aer_optics%set_name('longwave aerosol optics') + aer_optics%tau = 0 + aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) + + ! Do longwave radiative transfer calculations + call handle_error(rte_lw( & + k_dist_lw, gas_concentrations, & + pmid(1:ncol,1:nlev), tmid(1:ncol,1:nlev), & + pint(1:ncol,1:nlev+1), tint(1:ncol,nlev+1), & + surface_emissivity(1:nlwbands,1:ncol), & + cld_optics, & + fluxes_allsky, fluxes_clrsky, & + aer_props=aer_optics, & + t_lev=tint(1:ncol,1:nlev+1), & + n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG + )) + + end subroutine rrtmgp_run_lw + real(wp) function get_min_temperature() get_min_temperature = min(k_dist_sw%get_temp_min(), k_dist_lw%get_temp_min()) end function get_min_temperature @@ -151,6 +326,222 @@ subroutine set_available_gases(gases, gas_concentrations) end subroutine set_available_gases + ! For some reason the RRTMGP flux objects do not include initialization + ! routines, but rather expect the user to associate the individual fluxes (which + ! are pointers) with appropriate targets. Instead, this routine treats those + ! pointers as allocatable members and allocates space for them. TODO: is this + ! appropriate use? + subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + + use mo_fluxes_byband, only: ty_fluxes_byband + integer, intent(in) :: ncol, nlevels, nbands + type(ty_fluxes_byband), intent(inout) :: fluxes + logical, intent(in), optional :: do_direct + + logical :: do_direct_local + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Allocate flux arrays + ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as + ! number of model levels plus one, or allocate as nlevels+1 if nlevels + ! represents number of model levels rather than number of interface levels. + + ! Broadband fluxes + allocate(fluxes%flux_up(ncol, nlevels)) + allocate(fluxes%flux_dn(ncol, nlevels)) + allocate(fluxes%flux_net(ncol, nlevels)) + if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) + + ! Fluxes by band + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) + if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) + + ! Initialize + call reset_fluxes(fluxes) + + end subroutine initialize_rrtmgp_fluxes + + !---------------------------------------------------------------------------- + + subroutine free_fluxes(fluxes) + use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(inout) :: fluxes + if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) + if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) + if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) + if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) + if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) + if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) + if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) + if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + end subroutine free_fluxes + + !---------------------------------------------------------------------------- + + subroutine reset_fluxes(fluxes) + + use mo_rte_kind, only: wp + use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(inout) :: fluxes + + ! Reset broadband fluxes + fluxes%flux_up(:,:) = 0._wp + fluxes%flux_dn(:,:) = 0._wp + fluxes%flux_net(:,:) = 0._wp + if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._wp + + ! Reset band-by-band fluxes + fluxes%bnd_flux_up(:,:,:) = 0._wp + fluxes%bnd_flux_dn(:,:,:) = 0._wp + fluxes%bnd_flux_net(:,:,:) = 0._wp + if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._wp + + end subroutine reset_fluxes + + !---------------------------------------------------------------------------- + + subroutine free_optics_sw(optics) + use mo_optical_props, only: ty_optical_props_2str + type(ty_optical_props_2str), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + if (allocated(optics%ssa)) deallocate(optics%ssa) + if (allocated(optics%g)) deallocate(optics%g) + call optics%finalize() + end subroutine free_optics_sw + + !---------------------------------------------------------------------------- + + subroutine free_optics_lw(optics) + use mo_optical_props, only: ty_optical_props_1scl + type(ty_optical_props_1scl), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + call optics%finalize() + end subroutine free_optics_lw + + !---------------------------------------------------------------------------- + + ! Compress optics arrays to smaller arrays containing only daytime columns. + ! This is to work with the RRTMGP shortwave routines that will fail if they + ! encounter non-sunlit columns, and also allows us to perform less + ! computations. This routine is primarily a convenience routine to do all of + ! the shortwave optics arrays at once, as we do this for individual arrays + ! elsewhere in the code. + subroutine compress_optics_sw(day_indices, tau, ssa, asm, tau_day, ssa_day, asm_day) + integer, intent(in), dimension(:) :: day_indices + real(wp), intent(in), dimension(:,:,:) :: tau, ssa, asm + real(wp), intent(out), dimension(:,:,:) :: tau_day, ssa_day, asm_day + integer :: nday, iday, ilev, ibnd + nday = count(day_indices > 0) + do ibnd = 1,size(tau,3) + do ilev = 1,size(tau,2) + do iday = 1,nday + tau_day(iday,ilev,ibnd) = tau(day_indices(iday),ilev,ibnd) + ssa_day(iday,ilev,ibnd) = ssa(day_indices(iday),ilev,ibnd) + asm_day(iday,ilev,ibnd) = asm(day_indices(iday),ilev,ibnd) + end do + end do + end do + end subroutine compress_optics_sw + + + subroutine expand_day_fluxes(daytime_fluxes, expanded_fluxes, day_indices) + use mo_rte_kind, only: wp + use mo_fluxes_byband, only: ty_fluxes_byband + type(ty_fluxes_byband), intent(in) :: daytime_fluxes + type(ty_fluxes_byband), intent(inout) :: expanded_fluxes + integer, intent(in) :: day_indices(:) + + integer :: nday, iday, icol + + ! Reset fluxes in expanded_fluxes object to zero + call reset_fluxes(expanded_fluxes) + + ! Number of daytime columns is number of indices greater than zero + nday = count(day_indices > 0) + + ! Loop over daytime indices and map daytime fluxes into expanded arrays + do iday = 1,nday + + ! Map daytime index to proper column index + icol = day_indices(iday) + + ! Expand broadband fluxes + expanded_fluxes%flux_up(icol,:) = daytime_fluxes%flux_up(iday,:) + expanded_fluxes%flux_dn(icol,:) = daytime_fluxes%flux_dn(iday,:) + expanded_fluxes%flux_net(icol,:) = daytime_fluxes%flux_net(iday,:) + if (associated(daytime_fluxes%flux_dn_dir)) then + expanded_fluxes%flux_dn_dir(icol,:) = daytime_fluxes%flux_dn_dir(iday,:) + end if + + ! Expand band-by-band fluxes + expanded_fluxes%bnd_flux_up(icol,:,:) = daytime_fluxes%bnd_flux_up(iday,:,:) + expanded_fluxes%bnd_flux_dn(icol,:,:) = daytime_fluxes%bnd_flux_dn(iday,:,:) + expanded_fluxes%bnd_flux_net(icol,:,:) = daytime_fluxes%bnd_flux_net(iday,:,:) + if (associated(daytime_fluxes%bnd_flux_dn_dir)) then + expanded_fluxes%bnd_flux_dn_dir(icol,:,:) = daytime_fluxes%bnd_flux_dn_dir(iday,:,:) + end if + + end do + + end subroutine expand_day_fluxes + + + subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + use mo_gas_concentrations, only: ty_gas_concs + use mo_rrtmgp_util_string, only: lower_case + + integer, intent(in) :: ncol + character(len=*), intent(in), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr + type(ty_gas_concs), intent(out) :: gas_concentrations + + ! Local variables + real(wp), dimension(ncol,nlev_rad) :: vol_mix_ratio_out + + ! Loop indices + integer :: igas + + ! Character array to hold lowercase gas names + character(len=32), allocatable :: gas_names_lower(:) + + ! Name of subroutine for error messages + character(len=32) :: subname = 'set_gas_concentrations' + + ! Initialize gas concentrations with lower case names + allocate(gas_names_lower(size(gas_names))) + do igas = 1,size(gas_names) + gas_names_lower(igas) = trim(lower_case(gas_names(igas))) + end do + call handle_error(gas_concentrations%init(gas_names_lower)) + + ! For each gas, add level above model top and set values in RRTMGP object + do igas = 1,size(gas_names) + vol_mix_ratio_out = 0 + ! Map to radiation grid + vol_mix_ratio_out(1:ncol,ktop:kbot) = gas_vmr(igas,1:ncol,1:pver) + ! Copy top-most model level to top-most rad level (which could be above + ! the top of the model) + vol_mix_ratio_out(1:ncol,1) = gas_vmr(igas,1:ncol,1) + ! Set volumn mixing ratio in gas concentration object for just columns + ! in this chunk + call handle_error(gas_concentrations%set_vmr( & + trim(lower_case(gas_names(igas))), vol_mix_ratio_out(1:ncol,1:nlev_rad)) & + ) + end do + + end subroutine set_gas_concentrations + + !---------------------------------------------------------------------------- + + + ! Stop run ungracefully since we don't want dependencies on E3SM abortutils ! here subroutine handle_error(msg) From f83e785223aefb2ddaa73084f90f8b21a938ade9 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 2 Oct 2020 18:59:25 -0400 Subject: [PATCH 12/71] Pass optics arrays instead of classes --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 403 +++++++++++------- .../eam/src/physics/rrtmgp/cam_optics.F90 | 24 -- .../eam/src/physics/rrtmgp/radiation.F90 | 56 +-- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 6 +- 4 files changed, 266 insertions(+), 223 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 29fab39b9733..1ea3fe2f13a1 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -29,19 +29,22 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - k_dist_sw, k_dist_lw, rrtmgp_initialize, & + k_dist_sw, k_dist_lw, & + rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts + nswgpts, nlwgpts, & + initialize_rrtmgp_fluxes, free_fluxes, & + free_optics_sw, free_optics_lw, reset_fluxes, & + set_gas_concentrations ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range use radiation_state, only: ktop, kbot, nlev_rad - use radiation_utils, only: compress_day_columns, expand_day_columns, & - handle_error, clip_values + use radiation_utils, only: handle_error, clip_values ! For MMF use crmdims, only: crm_nx_rad, crm_ny_rad, crm_nz @@ -1293,7 +1296,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Cloud and aerosol optics type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw - type(ty_optical_props_1scl) :: cld_optics_lw, aer_optics_lw real(r8), dimension(pcols * crm_nx_rad * crm_ny_rad,pver) :: qrs_all, qrsc_all @@ -1303,11 +1305,18 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Working variables for optics real(r8), dimension(pcols,pver,nlwbands) :: cld_tau_bnd_lw, aer_tau_bnd_lw real(r8), dimension(pcols,pver,nlwgpts) :: cld_tau_gpt_lw + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nlwgpts) :: cld_tau_gpt_lw_all real(r8), dimension(pcols,pver,nswbands) :: & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw real(r8), dimension(pcols,pver,nswgpts) :: & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nswgpts) :: & + cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nswbands) :: & + aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nlwbands) :: & + aer_tau_bnd_lw_all ! NOTE: these are diagnostic only real(r8), dimension(pcols,pver,nswbands) :: liq_tau_bnd_sw, ice_tau_bnd_sw, snw_tau_bnd_sw real(r8), dimension(pcols,pver,nlwbands) :: liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw @@ -1447,10 +1456,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call handle_error(cld_optics_sw%alloc_2str( & ncol_tot, nlev_rad, k_dist_sw, name='cld_optics_sw' & )) - call handle_error(cld_optics_lw%alloc_1scl( & - ncol_tot, nlev_rad, k_dist_lw, name='cld_optics_lw' & - )) - cld_optics_lw%tau = 0 cld_optics_sw%tau = 0 cld_optics_sw%ssa = 0 cld_optics_sw%g = 0 @@ -1466,11 +1471,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ncol_tot, nlev_rad, k_dist_sw%get_band_lims_wavenumber(), & name='aer_optics_sw' & )) - call handle_error(aer_optics_lw%alloc_1scl( & - ncol_tot, nlev_rad, k_dist_lw%get_band_lims_wavenumber(), & - name='aer_optics_lw' & - )) - aer_optics_lw%tau = 0 aer_optics_sw%tau = 0 aer_optics_sw%ssa = 0 aer_optics_sw%g = 0 @@ -1509,6 +1509,14 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call t_stopf('rad_aerosol_optics_lw') end if ! radiation_do('lw') end if ! do_aerosol_rad + cld_tau_gpt_lw_all = 0._r8 + cld_tau_gpt_sw_all = 0._r8 + cld_ssa_gpt_sw_all = 0._r8 + cld_asm_gpt_sw_all = 0._r8 + aer_tau_bnd_lw_all = 0._r8 + aer_tau_bnd_sw_all = 0._r8 + aer_ssa_bnd_sw_all = 0._r8 + aer_asm_bnd_sw_all = 0._r8 ! make sure water path variables are zeroed out do ilay = 1, pver @@ -1630,10 +1638,36 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw & ) call t_stopf('rad_cloud_optics_sw') + + ! Do aerosol optics + aer_tau_bnd_sw = 0._r8 + aer_ssa_bnd_sw = 0._r8 + aer_asm_bnd_sw = 0._r8 + if (do_aerosol_rad) then + call t_startf('rad_aerosol_optics_sw') + call set_aerosol_optics_sw( & + icall, state, pbuf, night_indices(1:nnight), is_cmip6_volc, & + aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw & + ) + ! Now reorder bands to be consistent with RRTMGP + ! TODO: fix the input files themselves! + do icol = 1,size(aer_tau_bnd_sw,1) + do ilay = 1,size(aer_tau_bnd_sw,2) + aer_tau_bnd_sw(icol,ilay,:) = reordered(aer_tau_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) + aer_ssa_bnd_sw(icol,ilay,:) = reordered(aer_ssa_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) + aer_asm_bnd_sw(icol,ilay,:) = reordered(aer_asm_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) + end do + end do + call t_stopf('rad_aerosol_optics_sw') + + end if ! Check (and possibly clip) values before passing to RRTMGP driver call handle_error(clip_values(cld_tau_gpt_sw, 0._r8, huge(cld_tau_gpt_sw), trim(subname) // ' cld_tau_gpt_sw', tolerance=1e-10_r8)) call handle_error(clip_values(cld_ssa_gpt_sw, 0._r8, 1._r8, trim(subname) // ' cld_ssa_gpt_sw', tolerance=1e-10_r8)) call handle_error(clip_values(cld_asm_gpt_sw, -1._r8, 1._r8, trim(subname) // ' cld_asm_gpt_sw', tolerance=1e-10_r8)) + call handle_error(clip_values(aer_tau_bnd_sw, 0._r8, huge(aer_tau_bnd_sw), trim(subname) // ' aer_tau_bnd_sw', tolerance=1e-10_r8)) + call handle_error(clip_values(aer_ssa_bnd_sw, 0._r8, 1._r8, trim(subname) // ' aer_ssa_bnd_sw', tolerance=1e-10_r8)) + call handle_error(clip_values(aer_asm_bnd_sw, -1._r8, 1._r8, trim(subname) // ' aer_asm_bnd_sw', tolerance=1e-10_r8)) end if ! Longwave cloud and aerosol optics @@ -1653,8 +1687,17 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ) call output_cloud_optics_lw(state, cld_tau_bnd_lw) call t_stopf('rad_cloud_optics_lw') + + ! Do aerosol optics + aer_tau_bnd_lw = 0._r8 + if (do_aerosol_rad) then + call t_startf('rad_aerosol_optics_lw') + call set_aerosol_optics_lw(icall, state, pbuf, is_cmip6_volc, aer_tau_bnd_lw) + call t_stopf('rad_aerosol_optics_lw') + end if ! Check (and possibly clip) values before passing to RRTMGP driver call handle_error(clip_values(cld_tau_gpt_lw, 0._r8, huge(cld_tau_gpt_lw), trim(subname) // ': cld_tau_gpt_lw', tolerance=1e-10_r8)) + call handle_error(clip_values(aer_tau_bnd_lw, 0._r8, huge(aer_tau_bnd_lw), trim(subname) // ': aer_tau_bnd_lw', tolerance=1e-10_r8)) end if ! Pack data @@ -1667,14 +1710,26 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & tmid(j,:) = tmid_col(ic,:) pint(j,:) = pint_col(ic,:) tint(j,:) = tint_col(ic,:) - cld_optics_lw%tau(j,ktop:kbot,:) = cld_tau_gpt_lw(ic,:,:) cld_optics_sw%tau(j,ktop:kbot,:) = cld_tau_gpt_sw(ic,:,:) cld_optics_sw%ssa(j,ktop:kbot,:) = cld_ssa_gpt_sw(ic,:,:) cld_optics_sw%g (j,ktop:kbot,:) = cld_asm_gpt_sw(ic,:,:) - aer_optics_lw%tau(j,ktop:kbot,:) = aer_tau_bnd_lw(ic,:,:) - aer_optics_sw%tau(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) - aer_optics_sw%ssa(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) - aer_optics_sw%g (j,ktop:kbot,:) = aer_asm_bnd_sw(ic,:,:) + cld_tau_gpt_lw_all(j,ktop:kbot,:) = cld_tau_gpt_lw(ic,:,:) + cld_tau_gpt_sw_all(j,ktop:kbot,:) = cld_tau_gpt_sw(ic,:,:) + cld_ssa_gpt_sw_all(j,ktop:kbot,:) = cld_ssa_gpt_sw(ic,:,:) + cld_asm_gpt_sw_all(j,ktop:kbot,:) = cld_asm_gpt_sw(ic,:,:) + if (do_aerosol_rad) then + aer_optics_sw%tau(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) + aer_optics_sw%ssa(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) + aer_optics_sw%g (j,ktop:kbot,:) = aer_asm_bnd_sw(ic,:,:) + else + aer_optics_sw%tau(j,ktop:kbot,:) = 0 + aer_optics_sw%ssa(j,ktop:kbot,:) = 0 + aer_optics_sw%g (j,ktop:kbot,:) = 0 + end if + aer_tau_bnd_lw_all(j,ktop:kbot,:) = aer_tau_bnd_lw(ic,:,:) + aer_tau_bnd_sw_all(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) + aer_ssa_bnd_sw_all(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) + aer_asm_bnd_sw_all(j,ktop:kbot,:) = aer_asm_bnd_sw(ic,:,:) vmr_all(:,j,:) = vmr_col(:,ic,:) j = j + 1 end do ! ic = 1,ncol @@ -1708,6 +1763,12 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Do shortwave radiative transfer calculations call t_startf('rad_calculate_fluxes_sw') +! call radiation_driver_sw(ncol_tot, & +! active_gases, vmr_all, & +! pmid, pint, tmid, albedo_dir_all, albedo_dif_all, coszrs_all, & +! cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & +! aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & +! fluxes_allsky_all, fluxes_clrsky_all, qrs_all, qrsc_all) call calculate_fluxes_sw( & active_gases(:), vmr_all(:,1:ncol_tot,1:nlev_rad), & pmid(1:ncol_tot,1:nlev_rad), tmid(1:ncol_tot,1:nlev_rad), & @@ -1715,23 +1776,25 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & coszrs_all(1:ncol_tot), & albedo_dir_all(1:nswbands,1:ncol_tot), & albedo_dif_all(1:nswbands,1:ncol_tot), & - cld_optics_sw, aer_optics_sw, & + cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & + aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & + !cld_optics_sw, aer_optics_sw, & fluxes_allsky_all, fluxes_clrsky_all, tsi_scaling & ) call t_stopf('rad_calculate_fluxes_sw') - ! Calculate heating rates call t_startf('rad_heating_rate_sw') call calculate_heating_rate(fluxes_allsky_all%flux_up(1:ncol_tot,ktop:kbot+1), & - fluxes_allsky_all%flux_dn(1:ncol_tot,ktop:kbot+1), & - pint(1:ncol_tot,ktop:kbot+1), & - qrs_all(1:ncol_tot,1:pver)) + fluxes_allsky_all%flux_dn(1:ncol_tot,ktop:kbot+1), & + pint(1:ncol_tot,ktop:kbot+1), & + qrs_all(1:ncol_tot,1:pver) & + ) call calculate_heating_rate(fluxes_clrsky_all%flux_up(1:ncol_tot,ktop:kbot+1), & - fluxes_clrsky_all%flux_dn(1:ncol_tot,ktop:kbot+1), & - pint(1:ncol_tot,ktop:kbot+1), & - qrsc_all(1:ncol_tot,1:pver)) + fluxes_clrsky_all%flux_dn(1:ncol_tot,ktop:kbot+1), & + pint(1:ncol_tot,ktop:kbot+1), & + qrsc_all(1:ncol_tot,1:pver) & + ) call t_stopf('rad_heating_rate_sw') - ! Calculate CRM domain averages call t_startf('rad_average_fluxes_sw') call average_packed_array(qrs_all (1:ncol_tot,:) , qrs (1:ncol,:) ) @@ -1818,12 +1881,12 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Calculate longwave fluxes call t_startf('rad_fluxes_lw') - call calculate_fluxes_lw( & + call calculate_fluxes_lw( & active_gases, vmr_all(:,1:ncol_tot,1:nlev_rad), & surface_emissivity(1:nlwbands,1:ncol_tot), & pmid(1:ncol_tot,1:nlev_rad ), tmid(1:ncol_tot,1:nlev_rad ), & pint(1:ncol_tot,1:nlev_rad+1), tint(1:ncol_tot,1:nlev_rad+1), & - cld_optics_lw , aer_optics_lw, & + cld_tau_gpt_lw_all , aer_tau_bnd_lw_all, & fluxes_allsky_all , fluxes_clrsky_all & ) call t_stopf('rad_fluxes_lw') @@ -1885,8 +1948,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call free_fluxes(fluxes_clrsky) call free_fluxes(fluxes_allsky_all) call free_fluxes(fluxes_clrsky_all) - call free_optics_lw(cld_optics_lw) - call free_optics_lw(aer_optics_lw) else @@ -1959,12 +2020,123 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & end subroutine radiation_tend + subroutine radiation_driver_sw(ncol, & + gas_names, gas_vmr, & + pmid, pint, tmid, albedo_dir, albedo_dif, coszrs, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + fluxes_allsky, fluxes_clrsky, qrs, qrsc) + + use perf_mod, only: t_startf, t_stopf + use mo_rrtmgp_clr_all_sky, only: rte_sw + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_optical_props, only: ty_optical_props_2str + use mo_gas_concentrations, only: ty_gas_concs + use radiation_utils, only: calculate_heating_rate + use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & + set_aerosol_optics_sw + + ! Inputs + integer, intent(in) :: ncol + type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + real(r8), intent(inout) :: qrs(:,:), qrsc(:,:) + character(len=*), intent(in), dimension(:) :: gas_names + real(r8), intent(in), dimension(:,:,:) :: gas_vmr + real(r8), intent(in), dimension(:,:) :: pmid, pint, tmid + real(r8), intent(in), dimension(:,:) :: albedo_dir, albedo_dif + real(r8), intent(in), dimension(:) :: coszrs + real(r8), intent(in), dimension(:,:,:) :: cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt + real(r8), intent(in), dimension(:,:,:) :: aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd + + ! Incoming solar radiation, scaled for solar zenith angle + ! and earth-sun distance + real(r8) :: solar_irradiance_by_gpt(ncol,nswgpts) + + ! Gathered indicies of day and night columns + ! chunk_column_index = day_indices(daylight_column_index) + integer :: nday, nnight ! Number of daylight columns + integer :: day_indices(ncol), night_indices(ncol) ! Indicies of daylight coumns + + ! Scaling factor for total sky irradiance; used to account for orbital + ! eccentricity, and could be used to scale total sky irradiance for different + ! climates as well (i.e., paleoclimate simulations) + real(r8) :: tsi_scaling + + ! Everybody needs a name + character(*), parameter :: subroutine_name = 'radiation_driver_sw' + + + if (fixed_total_solar_irradiance<0) then + ! Get orbital eccentricity factor to scale total sky irradiance + tsi_scaling = get_eccentricity_factor() + else + ! For fixed TSI we divide by the default solar constant of 1360.9 + ! At some point we will want to replace this with a method that + ! retrieves the solar constant + tsi_scaling = fixed_total_solar_irradiance / 1360.9_r8 + end if + + ! Gather night/day column indices for subsetting SW inputs; we only want to + ! do the shortwave radiative transfer during the daytime to save + ! computational cost (and because RRTMGP will fail for cosine solar zenith + ! angles less than or equal to zero) + call set_daynight_indices(coszrs(1:ncol), day_indices(1:ncol), night_indices(1:ncol)) + nday = count(day_indices(1:ncol) > 0) + nnight = count(night_indices(1:ncol) > 0) + + ! If no daytime columns in this chunk, then we return zeros + if (nday == 0) then + call reset_fluxes(fluxes_allsky) + call reset_fluxes(fluxes_clrsky) + qrs(1:ncol,1:pver) = 0 + qrsc(1:ncol,1:pver) = 0 + return + end if + + ! Do shortwave radiative transfer calculations + call t_startf('rad_calculations_sw') + call rrtmgp_run_sw( & + size(active_gases), ncol, nday, nlev_rad, & + day_indices, gas_names, gas_vmr, & + pmid(1:ncol,1:nlev_rad), & + tmid(1:ncol,1:nlev_rad), & + pint(1:ncol,1:nlev_rad+1), & + coszrs(1:ncol), & + albedo_dir(1:nswbands,1:ncol), & + albedo_dif(1:nswbands,1:ncol), & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + fluxes_allsky, fluxes_clrsky, & + tsi_scaling & + ) + call t_stopf('rad_calculations_sw') + + ! Calculate heating rates + call t_startf('rad_heating_rate_sw') + call calculate_heating_rate( & + fluxes_allsky%flux_up(1:ncol,ktop:kbot+1), & + fluxes_allsky%flux_dn(1:ncol,ktop:kbot+1), & + pint(1:ncol,ktop:kbot+1), & + qrs(1:ncol,1:pver) & + ) + call calculate_heating_rate( & + fluxes_clrsky%flux_up(1:ncol,ktop:kbot+1), & + fluxes_clrsky%flux_dn(1:ncol,ktop:kbot+1), & + pint(1:ncol,ktop:kbot+1), & + qrsc(1:ncol,1:pver) & + ) + call t_stopf('rad_heating_rate_sw') + + end subroutine radiation_driver_sw + !---------------------------------------------------------------------------- subroutine calculate_fluxes_sw(gas_names, gas_vmr, & pmid, tmid, pint, & coszrs, alb_dir, alb_dif, & - cld_optics, aer_optics, & + cld_tau, cld_ssa, cld_asm, & + aer_tau, aer_ssa, aer_asm, & + !cld_optics, aer_optics, & fluxes_allsky, fluxes_clrsky, & tsi_scaling) @@ -1980,7 +2152,10 @@ subroutine calculate_fluxes_sw(gas_names, gas_vmr, & real(r8), intent(in), dimension(:,:) :: pmid, tmid, pint real(r8), intent(in), dimension(:) :: coszrs real(r8), intent(in), dimension(:,:) :: alb_dir, alb_dif - type(ty_optical_props_2str), intent(in) :: cld_optics, aer_optics + !type(ty_optical_props_2str), intent(in) :: cld_optics, aer_optics + real(r8), intent(in), dimension(:,:,:) :: & + cld_tau, cld_ssa, cld_asm, & + aer_tau, aer_ssa, aer_asm type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(in) :: tsi_scaling @@ -2025,10 +2200,6 @@ subroutine calculate_fluxes_sw(gas_names, gas_vmr, & call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_allsky_day, do_direct=.true.) call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_clrsky_day, do_direct=.true.) - ! Check incoming optical properties - call handle_error(cld_optics%validate()) - call handle_error(aer_optics%validate()) - ! Compress to day-time only do iday = 1,nday icol = day_indices(iday) @@ -2047,12 +2218,12 @@ subroutine calculate_fluxes_sw(gas_names, gas_vmr, & gas_vmr_day(:,iday,:) = gas_vmr(:,icol,:) ! Compress optics - cld_optics_day%tau(iday,:,:) = cld_optics%tau(icol,:,:) - cld_optics_day%ssa(iday,:,:) = cld_optics%ssa(icol,:,:) - cld_optics_day%g (iday,:,:) = cld_optics%g (icol,:,:) - aer_optics_day%tau(iday,:,:) = aer_optics%tau(icol,:,:) - aer_optics_day%ssa(iday,:,:) = aer_optics%ssa(icol,:,:) - aer_optics_day%g (iday,:,:) = aer_optics%g (icol,:,:) + cld_optics_day%tau(iday,:,:) = cld_tau(icol,:,:) + cld_optics_day%ssa(iday,:,:) = cld_ssa(icol,:,:) + cld_optics_day%g (iday,:,:) = cld_asm(icol,:,:) + aer_optics_day%tau(iday,:,:) = aer_tau(icol,:,:) + aer_optics_day%ssa(iday,:,:) = aer_ssa(icol,:,:) + aer_optics_day%g (iday,:,:) = aer_asm(icol,:,:) end do ! Apply delta scaling to account for forward-scattering @@ -2126,7 +2297,7 @@ end subroutine calculate_fluxes_sw subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & pmid, tmid, pint, tint, & - cld_optics, aer_optics, & + cld_tau_gpt, aer_tau_bnd, & fluxes_allsky, fluxes_clrsky) use perf_mod, only: t_startf, t_stopf @@ -2140,7 +2311,7 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & real(r8), intent(in) :: gas_vmr(:,:,:) real(r8), intent(in) :: emis_sfc(:,:) real(r8), intent(in) :: pmid(:,:), tmid(:,:), pint(:,:), tint(:,:) - type(ty_optical_props_1scl), intent(inout) :: cld_optics, aer_optics + real(r8), intent(in) :: cld_tau_gpt(:,:,:), aer_tau_bnd(:,:,:) type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky type(ty_gas_concs) :: gas_concs @@ -2149,6 +2320,10 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & ! Character array to hold lowercase gas names character(len=32), allocatable :: gas_names_lower(:) + real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad + real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad + type(ty_optical_props_1scl) :: cld_optics_lw, aer_optics_lw + ncol = size(pmid,1) nlev = size(pmid,2) @@ -2167,23 +2342,50 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & end do deallocate(gas_names_lower) - ! Apply delta-scaling to account for forward scattering - call handle_error(cld_optics%delta_scale()) - call handle_error(aer_optics%delta_scale()) + ! Setup optical properties + call handle_error(cld_optics_lw%alloc_1scl( & + ncol, nlev, k_dist_lw, name='cld_optics_lw' & + )) + cld_optics_lw%tau = 0 + !cld_optics_lw%tau(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) + cld_optics_lw%tau(:,:,:) = cld_tau_gpt(:,:,:) + call handle_error(aer_optics_lw%alloc_1scl( & + ncol, nlev, k_dist_lw%get_band_lims_wavenumber(), & + name='aer_optics_lw' & + )) + aer_optics_lw%tau = 0 + !aer_optics_lw%tau(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) + aer_optics_lw%tau(:,:,:) = aer_tau_bnd(:,:,:) + + ! Add a level + cld_tau_gpt_rad = 0 + aer_tau_bnd_rad = 0 + cld_tau_gpt_rad(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) + aer_tau_bnd_rad(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) ! Do longwave radiative transfer calculations call t_startf('rad_rte_lw') +! call rrtmgp_run_lw( & +! size(active_gases), ncol, nlev, & +! gas_names, gas_vmr, & +! emis_sfc, & +! pmid, tmid, pint, tint, & +! cld_tau_gpt_rad, aer_tau_bnd_rad, & +! fluxes_allsky, fluxes_clrsky & +! ) call handle_error(rte_lw(k_dist_lw, gas_concs, & pmid(1:ncol,1:nlev), tmid(1:ncol,1:nlev), & pint(1:ncol,1:nlev+1), tint(1:ncol,nlev+1), & emis_sfc(1:nlwbands,1:ncol), & - cld_optics, & + cld_optics_lw, & fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics, & + aer_props=aer_optics_lw, & t_lev=tint(1:ncol,1:nlev+1), & n_gauss_angles=1)) ! Set to 3 for consistency with RRTMG call t_stopf('rad_rte_lw') + call free_optics_lw(cld_optics_lw) + call free_optics_lw(aer_optics_lw) end subroutine calculate_fluxes_lw !---------------------------------------------------------------------------- @@ -2344,27 +2546,6 @@ end subroutine set_net_fluxes_lw !---------------------------------------------------------------------------- - subroutine reset_fluxes(fluxes) - - use mo_rte_kind, only: wp - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - - ! Reset broadband fluxes - fluxes%flux_up(:,:) = 0._wp - fluxes%flux_dn(:,:) = 0._wp - fluxes%flux_net(:,:) = 0._wp - if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._wp - - ! Reset band-by-band fluxes - fluxes%bnd_flux_up(:,:,:) = 0._wp - fluxes%bnd_flux_dn(:,:,:) = 0._wp - fluxes%bnd_flux_net(:,:,:) = 0._wp - if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._wp - - end subroutine reset_fluxes - - subroutine set_daynight_indices(coszrs, day_indices, night_indices) ! Input: cosine of solar zenith angle real(r8), intent(in) :: coszrs(:) @@ -2806,84 +2987,6 @@ end subroutine output_cloud_optics_lw !---------------------------------------------------------------------------- - - ! For some reason the RRTMGP flux objects do not include initialization - ! routines, but rather expect the user to associate the individual fluxes (which - ! are pointers) with appropriate targets. Instead, this routine treats those - ! pointers as allocatable members and allocates space for them. TODO: is this - ! appropriate use? - subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) - - use mo_fluxes_byband, only: ty_fluxes_byband - integer, intent(in) :: ncol, nlevels, nbands - type(ty_fluxes_byband), intent(inout) :: fluxes - logical, intent(in), optional :: do_direct - - logical :: do_direct_local - - if (present(do_direct)) then - do_direct_local = .true. - else - do_direct_local = .false. - end if - - ! Allocate flux arrays - ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as - ! number of model levels plus one, or allocate as nlevels+1 if nlevels - ! represents number of model levels rather than number of interface levels. - - ! Broadband fluxes - allocate(fluxes%flux_up(ncol, nlevels)) - allocate(fluxes%flux_dn(ncol, nlevels)) - allocate(fluxes%flux_net(ncol, nlevels)) - if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) - - ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) - if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) - - ! Initialize - call reset_fluxes(fluxes) - - end subroutine initialize_rrtmgp_fluxes - - subroutine free_fluxes(fluxes) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) - if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) - if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) - if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) - if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) - if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) - if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) - if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) - end subroutine free_fluxes - - !---------------------------------------------------------------------------- - - subroutine free_optics_sw(optics) - use mo_optical_props, only: ty_optical_props_2str - type(ty_optical_props_2str), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - if (allocated(optics%ssa)) deallocate(optics%ssa) - if (allocated(optics%g)) deallocate(optics%g) - call optics%finalize() - end subroutine free_optics_sw - - !---------------------------------------------------------------------------- - - subroutine free_optics_lw(optics) - use mo_optical_props, only: ty_optical_props_1scl - type(ty_optical_props_1scl), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - call optics%finalize() - end subroutine free_optics_lw - - !---------------------------------------------------------------------------- - subroutine get_gas_vmr(icall, state, pbuf, gas_name, vmr) use physics_types, only: physics_state diff --git a/components/eam/src/physics/rrtmgp/cam_optics.F90 b/components/eam/src/physics/rrtmgp/cam_optics.F90 index 0e28f8099bd1..6ccb6b255766 100644 --- a/components/eam/src/physics/rrtmgp/cam_optics.F90 +++ b/components/eam/src/physics/rrtmgp/cam_optics.F90 @@ -14,7 +14,6 @@ module cam_optics get_cloud_optics_lw, & sample_cloud_optics_sw, & sample_cloud_optics_lw, & - compress_optics_sw, & set_aerosol_optics_sw, & set_aerosol_optics_lw @@ -389,29 +388,6 @@ end subroutine sample_cloud_optics_sw !---------------------------------------------------------------------------- - ! Compress optics arrays to smaller arrays containing only daytime columns. - ! This is to work with the RRTMGP shortwave routines that will fail if they - ! encounter non-sunlit columns, and also allows us to perform less - ! computations. This routine is primarily a convenience routine to do all of - ! the shortwave optics arrays at once, as we do this for individual arrays - ! elsewhere in the code. - subroutine compress_optics_sw(day_indices, tau, ssa, asm, tau_day, ssa_day, asm_day) - integer, intent(in), dimension(:) :: day_indices - real(r8), intent(in), dimension(:,:,:) :: tau, ssa, asm - real(r8), intent(out), dimension(:,:,:) :: tau_day, ssa_day, asm_day - integer :: nday, iday, ilev, ibnd - nday = count(day_indices > 0) - do ibnd = 1,size(tau,3) - do ilev = 1,size(tau,2) - do iday = 1,nday - tau_day(iday,ilev,ibnd) = tau(day_indices(iday),ilev,ibnd) - ssa_day(iday,ilev,ibnd) = ssa(day_indices(iday),ilev,ibnd) - asm_day(iday,ilev,ibnd) = asm(day_indices(iday),ilev,ibnd) - end do - end do - end do - end subroutine compress_optics_sw - !---------------------------------------------------------------------------- ! Do MCICA sampling of optics here. This will map bands to gpoints, diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 9b897e99cc55..bda6e70ad2d4 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1721,6 +1721,9 @@ subroutine radiation_driver_lw(ncol, & real(r8), intent(in), dimension(:,:) :: pmid, pint, tmid, tint real(r8), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd + real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad + real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad + ! Everybody needs a name character(*), parameter :: subroutine_name = 'radiation_driver_lw' @@ -1732,8 +1735,6 @@ subroutine radiation_driver_lw(ncol, & ! RRTMGP types type(ty_gas_concs) :: gas_concentrations - type(ty_optical_props_1scl) :: aer_optics_lw - type(ty_optical_props_1scl) :: cld_optics_lw ! Set surface emissivity to 1 here. There is a note in the RRTMG ! implementation that this is treated in the land model, but the old @@ -1743,24 +1744,6 @@ subroutine radiation_driver_lw(ncol, & ! TODO: set this more intelligently? surface_emissivity(1:nlwbands,1:ncol) = 1.0_r8 - ! Populate RRTMGP optics - call t_startf('longwave cloud optics') - call handle_error(cld_optics_lw%alloc_1scl(ncol, nlev_rad, k_dist_lw, name='longwave cloud optics')) - cld_optics_lw%tau = 0.0 - cld_optics_lw%tau(1:ncol,2:nlev_rad,:) = cld_tau_gpt(1:ncol,1:pver,:) - call handle_error(cld_optics_lw%delta_scale()) - call t_stopf('longwave cloud optics') - - ! Initialize aerosol optics; passing only the wavenumber bounds for each - ! "band" rather than passing the full spectral discretization object, and - ! omitting the "g-point" mapping forces the optics to be indexed and - ! stored by band rather than by g-point. This is most consistent with our - ! treatment of aerosol optics in the model, and prevents us from having to - ! map bands to g-points ourselves since that will all be handled by the - ! private routines internal to the optics class. - call handle_error(aer_optics_lw%alloc_1scl(ncol, nlev_rad, k_dist_lw%get_band_lims_wavenumber())) - call aer_optics_lw%set_name('longwave aerosol optics') - ! Set gas concentrations (I believe the active gases may change ! for different values of icall, which is why we do this within ! the loop). @@ -1768,17 +1751,11 @@ subroutine radiation_driver_lw(ncol, & call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) call t_stopf('rad_gas_concentrations_lw') - if (do_aerosol_rad) then - ! Get longwave aerosol optics - call t_startf('rad_aer_optics_lw') - aer_optics_lw%tau(:,:,:) = 0 - aer_optics_lw%tau(1:ncol,ktop:kbot,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) - ! Apply delta scaling to account for forward-scattering - call handle_error(aer_optics_lw%delta_scale()) - call t_stopf('rad_aer_optics_lw') - else - aer_optics_lw%tau(:,:,:) = 0 - end if + ! Add an empty level above model top + cld_tau_gpt_rad = 0 + cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt(:,:,:) + aer_tau_bnd_rad = 0 + aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd(:,:,:) ! Do longwave radiative transfer calculations call t_startf('rad_calculations_lw') @@ -1787,20 +1764,9 @@ subroutine radiation_driver_lw(ncol, & gas_names, gas_vmr, & surface_emissivity, & pmid, tmid, pint, tint, & - cld_tau_gpt, aer_tau_bnd, & + cld_tau_gpt_rad, aer_tau_bnd_rad, & fluxes_allsky, fluxes_clrsky & ) -! call handle_error(rte_lw( & -! k_dist_lw, gas_concentrations, & -! pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), & -! pint(1:ncol,1:nlev_rad+1), tint(1:ncol,nlev_rad+1), & -! surface_emissivity(1:nlwbands,1:ncol), & -! cld_optics_lw, & -! fluxes_allsky, fluxes_clrsky, & -! aer_props=aer_optics_lw, & -! t_lev=tint(1:ncol,1:nlev_rad+1), & -! n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG -! )) call t_stopf('rad_calculations_lw') ! Calculate heating rates @@ -1821,10 +1787,6 @@ subroutine radiation_driver_lw(ncol, & qrl(1:ncol,1:pver) = qrl_rad(1:ncol,ktop:kbot) qrlc(1:ncol,1:pver) = qrlc_rad(1:ncol,ktop:kbot) - ! Free fluxes and optical properties - call free_optics_lw(cld_optics_lw) - call free_optics_lw(aer_optics_lw) - end subroutine radiation_driver_lw !---------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index aca0635490f3..0fe095bd0a57 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -263,7 +263,8 @@ subroutine rrtmgp_run_lw( & call t_startf('longwave cloud optics') call handle_error(cld_optics%alloc_1scl(ncol, nlev, k_dist_lw, name='longwave cloud optics')) cld_optics%tau = 0.0 - cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,1:pver,:) + !cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,1:pver,:) + cld_optics%tau(1:ncol,1:nlev,:) = cld_tau_gpt(1:ncol,1:nlev,:) call handle_error(cld_optics%delta_scale()) call t_stopf('longwave cloud optics') @@ -277,7 +278,8 @@ subroutine rrtmgp_run_lw( & call handle_error(aer_optics%alloc_1scl(ncol, nlev, k_dist_lw%get_band_lims_wavenumber())) call aer_optics%set_name('longwave aerosol optics') aer_optics%tau = 0 - aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) + !aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) + aer_optics%tau(1:ncol,1:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:nlev,1:nlwbands) ! Do longwave radiative transfer calculations call handle_error(rte_lw( & From 978c5c2ed7d84dad201e157aebeccabbea367631 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 2 Oct 2020 19:47:34 -0400 Subject: [PATCH 13/71] Remove unused gas_concentrations --- .../eam/src/physics/rrtmgp/radiation.F90 | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index bda6e70ad2d4..3cd3c17f82be 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -36,8 +36,7 @@ module radiation get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts, & initialize_rrtmgp_fluxes, free_fluxes, & - free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations + free_optics_sw, free_optics_lw, reset_fluxes use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks @@ -442,7 +441,6 @@ subroutine radiation_init(state) ! RRTMGP modules use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init - use mo_gas_concentrations, only: ty_gas_concs ! For optics use cloud_rad_props, only: cloud_rad_props_init @@ -1514,10 +1512,8 @@ subroutine radiation_driver_sw(ncol, & use perf_mod, only: t_startf, t_stopf use mo_rrtmgp_clr_all_sky, only: rte_sw use mo_fluxes_byband, only: ty_fluxes_byband - use mo_gas_concentrations, only: ty_gas_concs use radiation_utils, only: calculate_heating_rate - use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & - set_aerosol_optics_sw + ! Inputs integer, intent(in) :: ncol @@ -1709,7 +1705,6 @@ subroutine radiation_driver_lw(ncol, & use mo_rrtmgp_clr_all_sky, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband use mo_optical_props, only: ty_optical_props_1scl - use mo_gas_concentrations, only: ty_gas_concs use radiation_utils, only: calculate_heating_rate ! Inputs @@ -1733,9 +1728,6 @@ subroutine radiation_driver_lw(ncol, & ! Temporary heating rates on radiation vertical grid real(r8), dimension(ncol,nlev_rad) :: qrl_rad, qrlc_rad - ! RRTMGP types - type(ty_gas_concs) :: gas_concentrations - ! Set surface emissivity to 1 here. There is a note in the RRTMG ! implementation that this is treated in the land model, but the old ! RRTMG implementation also sets this to 1. This probably does not make @@ -1744,13 +1736,6 @@ subroutine radiation_driver_lw(ncol, & ! TODO: set this more intelligently? surface_emissivity(1:nlwbands,1:ncol) = 1.0_r8 - ! Set gas concentrations (I believe the active gases may change - ! for different values of icall, which is why we do this within - ! the loop). - call t_startf('rad_gas_concentrations_lw') - call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) - call t_stopf('rad_gas_concentrations_lw') - ! Add an empty level above model top cld_tau_gpt_rad = 0 cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt(:,:,:) From d845b38bc1f34eb675796ddb7305406e9fb0ac65 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 5 Oct 2020 19:03:52 -0400 Subject: [PATCH 14/71] Move handling of day compression --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 167 ++++++++++-------- .../eam/src/physics/rrtmgp/radiation.F90 | 75 ++++++-- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 93 +++------- 3 files changed, 181 insertions(+), 154 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 1ea3fe2f13a1..c8f6e66fb07c 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -38,7 +38,7 @@ module radiation nswgpts, nlwgpts, & initialize_rrtmgp_fluxes, free_fluxes, & free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations + set_gas_concentrations, expand_day_fluxes ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -472,13 +472,6 @@ subroutine radiation_init(state) character(len=128) :: error_message - ! ty_gas_concs object that would normally hold volume mixing ratios for - ! radiatively-important gases. Here, this is just used to provide the names - ! of gases that are available in the model (needed by the kdist - ! initialization routines that are called within the load_coefficients - ! methods). - type(ty_gas_concs) :: available_gases - character(len=32) :: subname = 'radiation_init' character(len=10), dimension(3) :: dims_crm_rad = (/'crm_nx_rad','crm_ny_rad','crm_nz '/) @@ -1051,26 +1044,6 @@ subroutine perturbation_growth_init() end subroutine perturbation_growth_init - subroutine set_available_gases(gases, gas_concentrations) - - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - - type(ty_gas_concs), intent(inout) :: gas_concentrations - character(len=*), intent(in) :: gases(:) - character(len=32), dimension(size(gases)) :: gases_lowercase - integer :: igas - - ! Initialize with lowercase gas names; we should work in lowercase - ! whenever possible because we cannot trust string comparisons in RRTMGP - ! to be case insensitive - do igas = 1,size(gases) - gases_lowercase(igas) = trim(lower_case(gases(igas))) - end do - call handle_error(gas_concentrations%init(gases_lowercase)) - - end subroutine set_available_gases - !=============================================================================== !---------------------------------------------------------------------------- @@ -1263,8 +1236,8 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & real(r8), dimension(pcols,pver) :: dei_save, rei_save, rel_save ! Arrays to hold gas volume mixing ratios - real(r8), dimension(size(active_gases),pcols,nlev_rad) :: vmr_col - real(r8), dimension(size(active_gases),pcols * crm_nx_rad * crm_ny_rad,nlev_rad) :: vmr_all + real(r8), dimension(size(active_gases),pcols,pver) :: vmr_col + real(r8), dimension(size(active_gases),pcols * crm_nx_rad * crm_ny_rad,pver) :: vmr_all ! Clear-sky CRM heating (for debugging) real(r8), dimension(pcols,crm_nx_rad,crm_ny_rad,crm_nz) :: & @@ -1305,17 +1278,17 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Working variables for optics real(r8), dimension(pcols,pver,nlwbands) :: cld_tau_bnd_lw, aer_tau_bnd_lw real(r8), dimension(pcols,pver,nlwgpts) :: cld_tau_gpt_lw - real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nlwgpts) :: cld_tau_gpt_lw_all + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,pver,nlwgpts) :: cld_tau_gpt_lw_all real(r8), dimension(pcols,pver,nswbands) :: & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw real(r8), dimension(pcols,pver,nswgpts) :: & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw - real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nswgpts) :: & + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,pver,nswgpts) :: & cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all - real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nswbands) :: & + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,pver,nswbands) :: & aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all - real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,nlev_rad,nlwbands) :: & + real(r8), dimension(pcols*crm_nx_rad*crm_ny_rad,pver,nlwbands) :: & aer_tau_bnd_lw_all ! NOTE: these are diagnostic only real(r8), dimension(pcols,pver,nswbands) :: liq_tau_bnd_sw, ice_tau_bnd_sw, snw_tau_bnd_sw @@ -1594,9 +1567,10 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call t_startf('rad_gas_concentrations') do igas = 1,size(active_gases) ! Get volume mixing ratio for this gas - call get_gas_vmr(icall, state, pbuf, trim(active_gases(igas)), vmr_col(igas,1:ncol,ktop:kbot)) + call get_gas_vmr(icall, state, pbuf, trim(active_gases(igas)), vmr_col(igas,1:ncol,1:pver)) + !call get_gas_vmr(icall, state, pbuf, trim(active_gases(igas)), vmr_col(igas,1:ncol,ktop:kbot)) ! Copy top model level to level above model top - vmr_col(igas,1:ncol,1) = vmr_col(igas,1:ncol,ktop) + !vmr_col(igas,1:ncol,1) = vmr_col(igas,1:ncol,ktop) end do call t_stopf('rad_gas_concentrations') @@ -1713,10 +1687,10 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & cld_optics_sw%tau(j,ktop:kbot,:) = cld_tau_gpt_sw(ic,:,:) cld_optics_sw%ssa(j,ktop:kbot,:) = cld_ssa_gpt_sw(ic,:,:) cld_optics_sw%g (j,ktop:kbot,:) = cld_asm_gpt_sw(ic,:,:) - cld_tau_gpt_lw_all(j,ktop:kbot,:) = cld_tau_gpt_lw(ic,:,:) - cld_tau_gpt_sw_all(j,ktop:kbot,:) = cld_tau_gpt_sw(ic,:,:) - cld_ssa_gpt_sw_all(j,ktop:kbot,:) = cld_ssa_gpt_sw(ic,:,:) - cld_asm_gpt_sw_all(j,ktop:kbot,:) = cld_asm_gpt_sw(ic,:,:) + cld_tau_gpt_lw_all(j,:,:) = cld_tau_gpt_lw(ic,:,:) + cld_tau_gpt_sw_all(j,:,:) = cld_tau_gpt_sw(ic,:,:) + cld_ssa_gpt_sw_all(j,:,:) = cld_ssa_gpt_sw(ic,:,:) + cld_asm_gpt_sw_all(j,:,:) = cld_asm_gpt_sw(ic,:,:) if (do_aerosol_rad) then aer_optics_sw%tau(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) aer_optics_sw%ssa(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) @@ -1726,10 +1700,10 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & aer_optics_sw%ssa(j,ktop:kbot,:) = 0 aer_optics_sw%g (j,ktop:kbot,:) = 0 end if - aer_tau_bnd_lw_all(j,ktop:kbot,:) = aer_tau_bnd_lw(ic,:,:) - aer_tau_bnd_sw_all(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) - aer_ssa_bnd_sw_all(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) - aer_asm_bnd_sw_all(j,ktop:kbot,:) = aer_asm_bnd_sw(ic,:,:) + aer_tau_bnd_lw_all(j,:,:) = aer_tau_bnd_lw(ic,:,:) + aer_tau_bnd_sw_all(j,:,:) = aer_tau_bnd_sw(ic,:,:) + aer_ssa_bnd_sw_all(j,:,:) = aer_ssa_bnd_sw(ic,:,:) + aer_asm_bnd_sw_all(j,:,:) = aer_asm_bnd_sw(ic,:,:) vmr_all(:,j,:) = vmr_col(:,ic,:) j = j + 1 end do ! ic = 1,ncol @@ -1763,13 +1737,13 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Do shortwave radiative transfer calculations call t_startf('rad_calculate_fluxes_sw') -! call radiation_driver_sw(ncol_tot, & -! active_gases, vmr_all, & -! pmid, pint, tmid, albedo_dir_all, albedo_dif_all, coszrs_all, & -! cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & -! aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & -! fluxes_allsky_all, fluxes_clrsky_all, qrs_all, qrsc_all) - call calculate_fluxes_sw( & + if (.true.) call radiation_driver_sw(ncol_tot, & + active_gases, vmr_all, & + pmid, pint, tmid, albedo_dir_all, albedo_dif_all, coszrs_all, & + cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & + aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & + fluxes_allsky_all, fluxes_clrsky_all, qrs_all, qrsc_all) + if (.false.) call calculate_fluxes_sw( & active_gases(:), vmr_all(:,1:ncol_tot,1:nlev_rad), & pmid(1:ncol_tot,1:nlev_rad), tmid(1:ncol_tot,1:nlev_rad), & pint(1:ncol_tot,1:nlev_rad+1), & @@ -1882,7 +1856,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Calculate longwave fluxes call t_startf('rad_fluxes_lw') call calculate_fluxes_lw( & - active_gases, vmr_all(:,1:ncol_tot,1:nlev_rad), & + active_gases, vmr_all(:,1:ncol_tot,1:pver), & surface_emissivity(1:nlwbands,1:ncol_tot), & pmid(1:ncol_tot,1:nlev_rad ), tmid(1:ncol_tot,1:nlev_rad ), & pint(1:ncol_tot,1:nlev_rad+1), tint(1:ncol_tot,1:nlev_rad+1), & @@ -2048,12 +2022,23 @@ subroutine radiation_driver_sw(ncol, & real(r8), intent(in), dimension(:,:,:) :: cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt real(r8), intent(in), dimension(:,:,:) :: aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd + ! Compressed daytime-only arrays + real(r8), dimension(ncol) :: coszrs_day + real(r8), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day + real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day + real(r8), dimension(ncol,nlev_rad+1) :: pint_day + real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day + real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day + real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day + type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day + ! Incoming solar radiation, scaled for solar zenith angle ! and earth-sun distance real(r8) :: solar_irradiance_by_gpt(ncol,nswgpts) ! Gathered indicies of day and night columns ! chunk_column_index = day_indices(daylight_column_index) + integer :: iday, icol integer :: nday, nnight ! Number of daylight columns integer :: day_indices(ncol), night_indices(ncol) ! Indicies of daylight coumns @@ -2093,24 +2078,64 @@ subroutine radiation_driver_sw(ncol, & return end if + ! Compress to daytime-only arrays + do iday = 1,nday + icol = day_indices(iday) + tmid_day(iday,:) = tmid(icol,:) + pmid_day(iday,:) = pmid(icol,:) + pint_day(iday,:) = pint(icol,:) + albedo_dir_day(:,iday) = albedo_dir(:,icol) + albedo_dif_day(:,iday) = albedo_dif(:,icol) + coszrs_day(iday) = coszrs(icol) + gas_vmr_day(:,iday,:) = gas_vmr(:,icol,:) + cld_tau_gpt_day(iday,:,:) = cld_tau_gpt(icol,:,:) + cld_ssa_gpt_day(iday,:,:) = cld_ssa_gpt(icol,:,:) + cld_asm_gpt_day(iday,:,:) = cld_asm_gpt(icol,:,:) + aer_tau_bnd_day(iday,:,:) = aer_tau_bnd(icol,:,:) + aer_ssa_bnd_day(iday,:,:) = aer_ssa_bnd(icol,:,:) + aer_asm_bnd_day(iday,:,:) = aer_asm_bnd(icol,:,:) + end do + + ! Allocate shortwave fluxes (allsky and clearsky) + ! TODO: why do I need to provide my own routines to do this? Why is + ! this not part of the ty_fluxes_byband object? + ! + ! NOTE: fluxes defined at interfaces, so initialize to have vertical + ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to + ! have vertical dimension nlev_rad (defined at midpoints). + call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) + call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) + + ! Add a level above model top to optical properties! + ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') call rrtmgp_run_sw( & - size(active_gases), ncol, nday, nlev_rad, & - day_indices, gas_names, gas_vmr, & - pmid(1:ncol,1:nlev_rad), & - tmid(1:ncol,1:nlev_rad), & - pint(1:ncol,1:nlev_rad+1), & - coszrs(1:ncol), & - albedo_dir(1:nswbands,1:ncol), & - albedo_dif(1:nswbands,1:ncol), & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - fluxes_allsky, fluxes_clrsky, & + size(active_gases), nday, nlev_rad, & + gas_names, gas_vmr_day, & + pmid_day(1:nday,1:nlev_rad), & + tmid_day(1:nday,1:nlev_rad), & + pint_day(1:nday,1:nlev_rad+1), & + coszrs_day(1:nday), & + albedo_dir_day(1:nswbands,1:nday), & + albedo_dif_day(1:nswbands,1:nday), & + cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & + aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & + fluxes_allsky_day, fluxes_clrsky_day, & tsi_scaling & ) call t_stopf('rad_calculations_sw') + ! Expand fluxes from daytime-only arrays to full chunk arrays + call t_startf('rad_expand_fluxes_sw') + call expand_day_fluxes(fluxes_allsky_day, fluxes_allsky, day_indices(1:nday)) + call expand_day_fluxes(fluxes_clrsky_day, fluxes_clrsky, day_indices(1:nday)) + call t_stopf('rad_expand_fluxes_sw') + + ! Clean up after ourselves + call free_fluxes(fluxes_allsky_day) + call free_fluxes(fluxes_clrsky_day) + ! Calculate heating rates call t_startf('rad_heating_rate_sw') call calculate_heating_rate( & @@ -2127,6 +2152,7 @@ subroutine radiation_driver_sw(ncol, & ) call t_stopf('rad_heating_rate_sw') + end subroutine radiation_driver_sw !---------------------------------------------------------------------------- @@ -2251,7 +2277,7 @@ subroutine calculate_fluxes_sw(gas_names, gas_vmr, & ! Compute fluxes call t_startf('rad_rte_sw') - call handle_error(rte_sw(k_dist_sw, gas_concs, & + if (.true.) call handle_error(rte_sw(k_dist_sw, gas_concs, & pmid_day(1:nday,1:nlev), & tmid_day(1:nday,1:nlev), & pint_day(1:nday,1:nlev+1), & @@ -2323,6 +2349,7 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad type(ty_optical_props_1scl) :: cld_optics_lw, aer_optics_lw + real(r8), dimension(size(gas_vmr,1),size(gas_vmr,2),size(gas_vmr,3)+1) :: gas_vmr_rad ncol = size(pmid,1) nlev = size(pmid,2) @@ -2335,9 +2362,11 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & call handle_error(gas_concs%init(gas_names_lower)) ! Populate gas concentrations + gas_vmr_rad(:,:,ktop:kbot) = gas_vmr(:,:,:) + gas_vmr_rad(:,:,1) = gas_vmr(:,:,1) do igas = 1,size(gas_names) call handle_error(gas_concs%set_vmr( & - gas_names_lower(igas), gas_vmr(igas,:,:) & + gas_names_lower(igas), gas_vmr_rad(igas,:,:) & )) end do deallocate(gas_names_lower) @@ -2347,15 +2376,15 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & ncol, nlev, k_dist_lw, name='cld_optics_lw' & )) cld_optics_lw%tau = 0 - !cld_optics_lw%tau(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) - cld_optics_lw%tau(:,:,:) = cld_tau_gpt(:,:,:) + cld_optics_lw%tau(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) + !cld_optics_lw%tau(:,:,:) = cld_tau_gpt(:,:,:) call handle_error(aer_optics_lw%alloc_1scl( & ncol, nlev, k_dist_lw%get_band_lims_wavenumber(), & name='aer_optics_lw' & )) aer_optics_lw%tau = 0 - !aer_optics_lw%tau(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) - aer_optics_lw%tau(:,:,:) = aer_tau_bnd(:,:,:) + aer_optics_lw%tau(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) + !aer_optics_lw%tau(:,:,:) = aer_tau_bnd(:,:,:) ! Add a level cld_tau_gpt_rad = 0 diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 3cd3c17f82be..9d4663a77ff9 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -36,7 +36,8 @@ module radiation get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts, & initialize_rrtmgp_fluxes, free_fluxes, & - free_optics_sw, free_optics_lw, reset_fluxes + free_optics_sw, free_optics_lw, reset_fluxes, & + expand_day_fluxes use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks @@ -1338,6 +1339,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw, & fluxes_allsky, fluxes_clrsky, qrs, qrsc & ) + ! Send fluxes to history buffer call output_fluxes_sw(icall, state, fluxes_allsky, fluxes_clrsky, qrs, qrsc) end if @@ -1533,9 +1535,19 @@ subroutine radiation_driver_sw(ncol, & ! Gathered indicies of day and night columns ! chunk_column_index = day_indices(daylight_column_index) + integer :: icol, iday integer :: nday, nnight ! Number of daylight columns integer :: day_indices(ncol), night_indices(ncol) ! Indicies of daylight coumns + real(wp), dimension(ncol) :: coszrs_day + real(wp), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day + real(wp), dimension(ncol,nlev_rad) :: pmid_day, tmid_day + real(wp), dimension(ncol,nlev_rad+1) :: pint_day + real(wp), dimension(size(gas_names),ncol,pver) :: gas_vmr_day + real(wp), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day + real(wp), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day + type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day + ! Scaling factor for total sky irradiance; used to account for orbital ! eccentricity, and could be used to scale total sky irradiance for different ! climates as well (i.e., paleoclimate simulations) @@ -1572,26 +1584,64 @@ subroutine radiation_driver_sw(ncol, & return end if + ! Compress to daytime-only arrays + do iday = 1,nday + icol = day_indices(iday) + tmid_day(iday,:) = tmid(icol,:) + pmid_day(iday,:) = pmid(icol,:) + pint_day(iday,:) = pint(icol,:) + albedo_dir_day(:,iday) = albedo_dir(:,icol) + albedo_dif_day(:,iday) = albedo_dif(:,icol) + coszrs_day(iday) = coszrs(icol) + gas_vmr_day(:,iday,:) = gas_vmr(:,icol,:) + cld_tau_gpt_day(iday,:,:) = cld_tau_gpt(icol,:,:) + cld_ssa_gpt_day(iday,:,:) = cld_ssa_gpt(icol,:,:) + cld_asm_gpt_day(iday,:,:) = cld_asm_gpt(icol,:,:) + aer_tau_bnd_day(iday,:,:) = aer_tau_bnd(icol,:,:) + aer_ssa_bnd_day(iday,:,:) = aer_ssa_bnd(icol,:,:) + aer_asm_bnd_day(iday,:,:) = aer_asm_bnd(icol,:,:) + end do + + ! Allocate shortwave fluxes (allsky and clearsky) + ! TODO: why do I need to provide my own routines to do this? Why is + ! this not part of the ty_fluxes_byband object? + ! + ! NOTE: fluxes defined at interfaces, so initialize to have vertical + ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to + ! have vertical dimension nlev_rad (defined at midpoints). + call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) + call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) + ! Add a level above model top to optical properties! ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') call rrtmgp_run_sw( & - size(active_gases), ncol, nday, nlev_rad, & - day_indices, gas_names, gas_vmr, & - pmid(1:ncol,1:nlev_rad), & - tmid(1:ncol,1:nlev_rad), & - pint(1:ncol,1:nlev_rad+1), & - coszrs(1:ncol), & - albedo_dir(1:nswbands,1:ncol), & - albedo_dif(1:nswbands,1:ncol), & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - fluxes_allsky, fluxes_clrsky, & + size(active_gases), nday, nlev_rad, & + gas_names, gas_vmr_day, & + pmid_day(1:nday,1:nlev_rad), & + tmid_day(1:nday,1:nlev_rad), & + pint_day(1:nday,1:nlev_rad+1), & + coszrs_day(1:nday), & + albedo_dir_day(1:nswbands,1:nday), & + albedo_dif_day(1:nswbands,1:nday), & + cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & + aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & + fluxes_allsky_day, fluxes_clrsky_day, & tsi_scaling & ) call t_stopf('rad_calculations_sw') + ! Expand fluxes from daytime-only arrays to full chunk arrays + call t_startf('rad_expand_fluxes_sw') + call expand_day_fluxes(fluxes_allsky_day, fluxes_allsky, day_indices(1:nday)) + call expand_day_fluxes(fluxes_clrsky_day, fluxes_clrsky, day_indices(1:nday)) + call t_stopf('rad_expand_fluxes_sw') + + ! Clean up after ourselves + call free_fluxes(fluxes_allsky_day) + call free_fluxes(fluxes_clrsky_day) + ! Calculate heating rates call t_startf('rad_heating_rate_sw') call calculate_heating_rate( & @@ -1704,7 +1754,6 @@ subroutine radiation_driver_lw(ncol, & use perf_mod, only: t_startf, t_stopf use mo_rrtmgp_clr_all_sky, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_1scl use radiation_utils, only: calculate_heating_rate ! Inputs diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index 0fe095bd0a57..bf9d2d27e95f 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -39,7 +39,7 @@ module rrtmgp_interface get_min_temperature, get_max_temperature, & initialize_rrtmgp_fluxes, free_fluxes, & free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations + set_gas_concentrations, expand_day_fluxes contains @@ -95,7 +95,7 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi end subroutine rrtmgp_initialize subroutine rrtmgp_run_sw( & - ngas, ncol, nday, nlev, day_indices, & + ngas, ncol, nlev, & gas_names, gas_vmr, & pmid, tmid, pint, coszrs, & albedo_dir, albedo_dif, & @@ -104,8 +104,7 @@ subroutine rrtmgp_run_sw( & fluxes_allsky, fluxes_clrsky, & tsi_scaling & ) - integer, intent(in) :: ngas, ncol, nday, nlev - integer, intent(in), dimension(:) :: day_indices + integer, intent(in) :: ngas, ncol, nlev character(len=*), dimension(:) :: gas_names real(wp), intent(in), dimension(:,:,:) :: gas_vmr real(wp), intent(in), dimension(:,:) :: & @@ -118,54 +117,25 @@ subroutine rrtmgp_run_sw( & type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky real(wp), intent(in) :: tsi_scaling - real(wp), dimension(nday) :: coszrs_day - real(wp), dimension(nswbands,nday) :: albedo_dir_day, albedo_dif_day - real(wp), dimension(nday,nlev) :: pmid_day, tmid_day - real(wp), dimension(nday,nlev+1) :: pint_day - real(wp), dimension(ngas,nday,pver) :: gas_vmr_day type(ty_gas_concs) :: gas_concentrations type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw - type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day ! Loop indices integer :: iband, igas, iday, icol - ! Compress state to daytime-only - do iday = 1,nday - icol = day_indices(iday) - tmid_day(iday,:) = tmid(icol,:) - pmid_day(iday,:) = pmid(icol,:) - pint_day(iday,:) = pint(icol,:) - end do - - ! Compress to daytime-only arrays - do iband = 1,nswbands - call compress_day_columns(albedo_dir(iband,1:ncol), albedo_dir_day(iband,1:nday), day_indices(1:nday)) - call compress_day_columns(albedo_dif(iband,1:ncol), albedo_dif_day(iband,1:nday), day_indices(1:nday)) - end do - call compress_day_columns(coszrs(1:ncol), coszrs_day(1:nday), day_indices(1:nday)) - ! Allocate shortwave fluxes (allsky and clearsky) ! TODO: why do I need to provide my own routines to do this? Why is ! this not part of the ty_fluxes_byband object? - ! - ! NOTE: fluxes defined at interfaces, so initialize to have vertical - ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to - ! have vertical dimension nlev_rad (defined at midpoints). - call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_allsky_day, do_direct=.true.) - call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_clrsky_day, do_direct=.true.) ! Populate RRTMGP optics - call handle_error(cld_optics_sw%alloc_2str(nday, nlev, k_dist_sw, name='shortwave cloud optics')) + call handle_error(cld_optics_sw%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) cld_optics_sw%tau = 0 cld_optics_sw%ssa = 1 cld_optics_sw%g = 0 - call compress_optics_sw( & - day_indices, cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - cld_optics_sw%tau(1:nday,2:nlev,:), & - cld_optics_sw%ssa(1:nday,2:nlev,:), & - cld_optics_sw%g (1:nday,2:nlev,:) & - ) + cld_optics_sw%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) + cld_optics_sw%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) + cld_optics_sw%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) + ! Apply delta scaling to account for forward-scattering call handle_error(cld_optics_sw%delta_scale()) @@ -177,59 +147,38 @@ subroutine rrtmgp_run_sw( & ! map bands to g-points ourselves since that will all be handled by the ! private routines internal to the optics class. call handle_error(aer_optics_sw%alloc_2str( & - nday, nlev, k_dist_sw%get_band_lims_wavenumber(), & + ncol, nlev, k_dist_sw%get_band_lims_wavenumber(), & name='shortwave aerosol optics' & )) aer_optics_sw%tau = 0 aer_optics_sw%ssa = 1 aer_optics_sw%g = 0 - call compress_optics_sw( & - day_indices, & - aer_tau_bnd(1:ncol,1:pver,:), & - aer_ssa_bnd(1:ncol,1:pver,:), & - aer_asm_bnd(1:ncol,1:pver,:), & - aer_optics_sw%tau(1:nday,2:nlev,:), & - aer_optics_sw%ssa(1:nday,2:nlev,:), & - aer_optics_sw%g (1:nday,2:nlev,:) & - ) - ! Apply delta scaling to account for forward-scattering - call handle_error(aer_optics_sw%delta_scale()) + aer_optics_sw%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) + aer_optics_sw%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) + aer_optics_sw%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) - ! Compress gases to daytime-only + ! Set gas concentrations call t_startf('rad_set_gases_sw') - do igas = 1,ngas - call compress_day_columns(gas_vmr(igas,1:ncol,1:pver), & - gas_vmr_day(igas,1:nday,1:pver), & - day_indices(1:nday)) - end do - call set_gas_concentrations(nday, gas_names, gas_vmr_day, gas_concentrations) + call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) call t_stopf('rad_set_gases_sw') call handle_error(rte_sw( & k_dist_sw, gas_concentrations, & - pmid_day(1:nday,1:nlev), & - tmid_day(1:nday,1:nlev), & - pint_day(1:nday,1:nlev+1), & - coszrs_day(1:nday), & - albedo_dir_day(1:nswbands,1:nday), & - albedo_dif_day(1:nswbands,1:nday), & + pmid(1:ncol,1:nlev), & + tmid(1:ncol,1:nlev), & + pint(1:ncol,1:nlev+1), & + coszrs(1:ncol), & + albedo_dir(1:nswbands,1:ncol), & + albedo_dif(1:nswbands,1:ncol), & cld_optics_sw, & - fluxes_allsky_day, fluxes_clrsky_day, & + fluxes_allsky, fluxes_clrsky, & aer_props=aer_optics_sw, & tsi_scaling=tsi_scaling & )) - ! Expand fluxes from daytime-only arrays to full chunk arrays - call t_startf('rad_expand_fluxes_sw') - call expand_day_fluxes(fluxes_allsky_day, fluxes_allsky, day_indices(1:nday)) - call expand_day_fluxes(fluxes_clrsky_day, fluxes_clrsky, day_indices(1:nday)) - call t_stopf('rad_expand_fluxes_sw') - ! Clean up after ourselves call free_optics_sw(cld_optics_sw) call free_optics_sw(aer_optics_sw) - call free_fluxes(fluxes_allsky_day) - call free_fluxes(fluxes_clrsky_day) end subroutine rrtmgp_run_sw From 50cdd39f95bc9d60c9cb1807ba96e19884162b61 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 5 Oct 2020 19:45:28 -0400 Subject: [PATCH 15/71] MMF to use common rrtmgp_run_lw --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 291 ++---------------- 1 file changed, 22 insertions(+), 269 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index c8f6e66fb07c..76249c5e1334 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -38,7 +38,7 @@ module radiation nswgpts, nlwgpts, & initialize_rrtmgp_fluxes, free_fluxes, & free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations, expand_day_fluxes + expand_day_fluxes ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -442,7 +442,6 @@ subroutine radiation_init(state) ! RRTMGP modules use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init - use mo_gas_concentrations, only: ty_gas_concs ! For optics use cloud_rad_props, only: cloud_rad_props_init @@ -1094,9 +1093,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & use radconstants, only: idx_sw_diag ! RRTMGP radiation drivers and derived types - use mo_gas_concentrations, only: ty_gas_concs - use mo_optical_props, only: ty_optical_props_1scl, & - ty_optical_props_2str use mo_fluxes_byband, only: ty_fluxes_byband use mo_rrtmgp_util_string, only: lower_case @@ -1267,9 +1263,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! climates as well (i.e., paleoclimate simulations) real(r8) :: tsi_scaling - ! Cloud and aerosol optics - type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw - real(r8), dimension(pcols * crm_nx_rad * crm_ny_rad,pver) :: qrs_all, qrsc_all ! Area factor for calculating CRM domain averages @@ -1482,6 +1475,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call t_stopf('rad_aerosol_optics_lw') end if ! radiation_do('lw') end if ! do_aerosol_rad + cld_tau_gpt_lw_all = 0._r8 cld_tau_gpt_sw_all = 0._r8 cld_ssa_gpt_sw_all = 0._r8 @@ -1684,22 +1678,10 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & tmid(j,:) = tmid_col(ic,:) pint(j,:) = pint_col(ic,:) tint(j,:) = tint_col(ic,:) - cld_optics_sw%tau(j,ktop:kbot,:) = cld_tau_gpt_sw(ic,:,:) - cld_optics_sw%ssa(j,ktop:kbot,:) = cld_ssa_gpt_sw(ic,:,:) - cld_optics_sw%g (j,ktop:kbot,:) = cld_asm_gpt_sw(ic,:,:) cld_tau_gpt_lw_all(j,:,:) = cld_tau_gpt_lw(ic,:,:) cld_tau_gpt_sw_all(j,:,:) = cld_tau_gpt_sw(ic,:,:) cld_ssa_gpt_sw_all(j,:,:) = cld_ssa_gpt_sw(ic,:,:) cld_asm_gpt_sw_all(j,:,:) = cld_asm_gpt_sw(ic,:,:) - if (do_aerosol_rad) then - aer_optics_sw%tau(j,ktop:kbot,:) = aer_tau_bnd_sw(ic,:,:) - aer_optics_sw%ssa(j,ktop:kbot,:) = aer_ssa_bnd_sw(ic,:,:) - aer_optics_sw%g (j,ktop:kbot,:) = aer_asm_bnd_sw(ic,:,:) - else - aer_optics_sw%tau(j,ktop:kbot,:) = 0 - aer_optics_sw%ssa(j,ktop:kbot,:) = 0 - aer_optics_sw%g (j,ktop:kbot,:) = 0 - end if aer_tau_bnd_lw_all(j,:,:) = aer_tau_bnd_lw(ic,:,:) aer_tau_bnd_sw_all(j,:,:) = aer_tau_bnd_sw(ic,:,:) aer_ssa_bnd_sw_all(j,:,:) = aer_ssa_bnd_sw(ic,:,:) @@ -1735,27 +1717,15 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_allsky_all, do_direct=.true.) call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_clrsky_all, do_direct=.true.) - ! Do shortwave radiative transfer calculations - call t_startf('rad_calculate_fluxes_sw') + ! Calculate shortwave fluxes + call t_startf('rad_radiation_driver_sw') if (.true.) call radiation_driver_sw(ncol_tot, & active_gases, vmr_all, & pmid, pint, tmid, albedo_dir_all, albedo_dif_all, coszrs_all, & cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & fluxes_allsky_all, fluxes_clrsky_all, qrs_all, qrsc_all) - if (.false.) call calculate_fluxes_sw( & - active_gases(:), vmr_all(:,1:ncol_tot,1:nlev_rad), & - pmid(1:ncol_tot,1:nlev_rad), tmid(1:ncol_tot,1:nlev_rad), & - pint(1:ncol_tot,1:nlev_rad+1), & - coszrs_all(1:ncol_tot), & - albedo_dir_all(1:nswbands,1:ncol_tot), & - albedo_dif_all(1:nswbands,1:ncol_tot), & - cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & - aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & - !cld_optics_sw, aer_optics_sw, & - fluxes_allsky_all, fluxes_clrsky_all, tsi_scaling & - ) - call t_stopf('rad_calculate_fluxes_sw') + call t_stopf('rad_radiation_driver_sw') ! Calculate heating rates call t_startf('rad_heating_rate_sw') call calculate_heating_rate(fluxes_allsky_all%flux_up(1:ncol_tot,ktop:kbot+1), & @@ -1829,9 +1799,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call free_fluxes(fluxes_allsky_all) call free_fluxes(fluxes_clrsky_all) - ! Free optical properties - call free_optics_sw(cld_optics_sw) - call free_optics_sw(aer_optics_sw) else ! Conserve energy @@ -1855,7 +1822,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Calculate longwave fluxes call t_startf('rad_fluxes_lw') - call calculate_fluxes_lw( & + call radiation_driver_lw( & active_gases, vmr_all(:,1:ncol_tot,1:pver), & surface_emissivity(1:nlwbands,1:ncol_tot), & pmid(1:ncol_tot,1:nlev_rad ), tmid(1:ncol_tot,1:nlev_rad ), & @@ -2004,8 +1971,6 @@ subroutine radiation_driver_sw(ncol, & use perf_mod, only: t_startf, t_stopf use mo_rrtmgp_clr_all_sky, only: rte_sw use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_2str - use mo_gas_concentrations, only: ty_gas_concs use radiation_utils, only: calculate_heating_rate use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & set_aerosol_optics_sw @@ -2157,180 +2122,13 @@ end subroutine radiation_driver_sw !---------------------------------------------------------------------------- - subroutine calculate_fluxes_sw(gas_names, gas_vmr, & - pmid, tmid, pint, & - coszrs, alb_dir, alb_dif, & - cld_tau, cld_ssa, cld_asm, & - aer_tau, aer_ssa, aer_asm, & - !cld_optics, aer_optics, & - fluxes_allsky, fluxes_clrsky, & - tsi_scaling) - - use perf_mod, only: t_startf, t_stopf - use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_2str - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - use mo_rrtmgp_clr_all_sky, only: rte_sw - - character(len=*), intent(in) :: gas_names(:) - real(r8), intent(in), dimension(:,:,:) :: gas_vmr - real(r8), intent(in), dimension(:,:) :: pmid, tmid, pint - real(r8), intent(in), dimension(:) :: coszrs - real(r8), intent(in), dimension(:,:) :: alb_dir, alb_dif - !type(ty_optical_props_2str), intent(in) :: cld_optics, aer_optics - real(r8), intent(in), dimension(:,:,:) :: & - cld_tau, cld_ssa, cld_asm, & - aer_tau, aer_ssa, aer_asm - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky - real(r8), intent(in) :: tsi_scaling - - ! For day-only arrays/objects - type(ty_optical_props_2str) :: cld_optics_day, aer_optics_day - type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day - real(r8), dimension(size(pmid,1), size(pmid,2)) :: pmid_day, tmid_day - real(r8), dimension(size(pint,1), size(pint,2)) :: pint_day - real(r8), dimension(size(coszrs)) :: coszrs_day - real(r8), dimension(size(alb_dir,1),size(alb_dir,2)) :: alb_dir_day, alb_dif_day - real(r8), dimension(size(gas_vmr,1),size(gas_vmr,2),size(gas_vmr,3)) :: gas_vmr_day - - type(ty_gas_concs) :: gas_concs - integer :: ncol, nday, nlev, igas, iday, icol - integer, dimension(size(coszrs)) :: day_indices, night_indices - - ! Character array to hold lowercase gas names - character(len=32), allocatable :: gas_names_lower(:) - - - ncol = size(pmid,1) - nlev = size(pmid,2) - - ! Get day-night indices - call set_daynight_indices(coszrs, day_indices, night_indices) - nday = count(day_indices > 0) - - ! If we don't have any daytime indices, zero fluxes and return - if (nday <= 0) then - call reset_fluxes(fluxes_allsky) - call reset_fluxes(fluxes_clrsky) - return - end if - - ! Allocate daytime-only optics - call handle_error(cld_optics_day%alloc_2str(nday, nlev, k_dist_sw, name='sw day-time cloud optics')) - call handle_error(aer_optics_day%alloc_2str(nday, nlev, k_dist_sw%get_band_lims_wavenumber(), name='sw day-time aerosol optics')) - - ! Allocate fluxes - ! TODO: use pointers to stack arrays to save from allocating/deallocating - ! each step - call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_allsky_day, do_direct=.true.) - call initialize_rrtmgp_fluxes(nday, nlev+1, nswbands, fluxes_clrsky_day, do_direct=.true.) - - ! Compress to day-time only - do iday = 1,nday - icol = day_indices(iday) - - ! Compress state - pmid_day(iday,:) = pmid(icol,:) - tmid_day(iday,:) = tmid(icol,:) - pint_day(iday,:) = pint(icol,:) - - ! Compress coszrs and albedo - coszrs_day(iday) = coszrs(icol) - alb_dir_day(:,iday) = alb_dir(:,icol) - alb_dif_day(:,iday) = alb_dif(:,icol) - - ! Compress gases - gas_vmr_day(:,iday,:) = gas_vmr(:,icol,:) - - ! Compress optics - cld_optics_day%tau(iday,:,:) = cld_tau(icol,:,:) - cld_optics_day%ssa(iday,:,:) = cld_ssa(icol,:,:) - cld_optics_day%g (iday,:,:) = cld_asm(icol,:,:) - aer_optics_day%tau(iday,:,:) = aer_tau(icol,:,:) - aer_optics_day%ssa(iday,:,:) = aer_ssa(icol,:,:) - aer_optics_day%g (iday,:,:) = aer_asm(icol,:,:) - end do - - ! Apply delta scaling to account for forward-scattering - call handle_error(cld_optics_day%delta_scale()) - call handle_error(aer_optics_day%delta_scale()) - - ! Check incoming optical properties - call handle_error(cld_optics_day%validate()) - call handle_error(aer_optics_day%validate()) - - ! Initialize gas concentrations with lower case names - allocate(gas_names_lower(size(gas_names))) - do igas = 1,size(gas_names) - gas_names_lower(igas) = trim(lower_case(gas_names(igas))) - end do - call handle_error(gas_concs%init(gas_names_lower)) - - ! Populate gas concentrations - do igas = 1,size(gas_names) - call handle_error(gas_concs%set_vmr( & - gas_names_lower(igas), gas_vmr_day(igas,1:nday,:) & - )) - end do - deallocate(gas_names_lower) - - ! Compute fluxes - call t_startf('rad_rte_sw') - if (.true.) call handle_error(rte_sw(k_dist_sw, gas_concs, & - pmid_day(1:nday,1:nlev), & - tmid_day(1:nday,1:nlev), & - pint_day(1:nday,1:nlev+1), & - coszrs_day(1:nday), & - alb_dir_day(1:nswbands,1:nday), & - alb_dif_day(1:nswbands,1:nday), & - cld_optics_day, & - fluxes_allsky_day, fluxes_clrsky_day, & - aer_props=aer_optics_day, & - tsi_scaling=tsi_scaling)) - call t_stopf('rad_rte_sw') - - ! Expand daytime-only fluxes - call reset_fluxes(fluxes_allsky) - call reset_fluxes(fluxes_clrsky) - do iday = 1,nday - icol = day_indices(iday) - fluxes_allsky%flux_up(icol,:) = fluxes_allsky_day%flux_up(iday,:) - fluxes_allsky%flux_dn(icol,:) = fluxes_allsky_day%flux_dn(iday,:) - fluxes_allsky%flux_net(icol,:) = fluxes_allsky_day%flux_net(iday,:) - fluxes_allsky%bnd_flux_up(icol,:,:) = fluxes_allsky_day%bnd_flux_up(iday,:,:) - fluxes_allsky%bnd_flux_dn(icol,:,:) = fluxes_allsky_day%bnd_flux_dn(iday,:,:) - fluxes_allsky%bnd_flux_net(icol,:,:) = fluxes_allsky_day%bnd_flux_net(iday,:,:) - fluxes_allsky%bnd_flux_dn_dir(icol,:,:) = fluxes_allsky_day%bnd_flux_dn_dir(iday,:,:) - fluxes_clrsky%flux_up(icol,:) = fluxes_clrsky_day%flux_up(iday,:) - fluxes_clrsky%flux_dn(icol,:) = fluxes_clrsky_day%flux_dn(iday,:) - fluxes_clrsky%flux_net(icol,:) = fluxes_clrsky_day%flux_net(iday,:) - fluxes_clrsky%bnd_flux_up(icol,:,:) = fluxes_clrsky_day%bnd_flux_up(iday,:,:) - fluxes_clrsky%bnd_flux_dn(icol,:,:) = fluxes_clrsky_day%bnd_flux_dn(iday,:,:) - fluxes_clrsky%bnd_flux_net(icol,:,:) = fluxes_clrsky_day%bnd_flux_net(iday,:,:) - fluxes_clrsky%bnd_flux_dn_dir(icol,:,:) = fluxes_clrsky_day%bnd_flux_dn_dir(iday,:,:) - end do - - ! Free memory - call free_optics_sw(cld_optics_day) - call free_optics_sw(aer_optics_day) - call free_fluxes(fluxes_allsky_day) - call free_fluxes(fluxes_clrsky_day) - - end subroutine calculate_fluxes_sw - - !---------------------------------------------------------------------------- - - subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & + subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & pmid, tmid, pint, tint, & cld_tau_gpt, aer_tau_bnd, & fluxes_allsky, fluxes_clrsky) use perf_mod, only: t_startf, t_stopf - use mo_rrtmgp_clr_all_sky, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband - use mo_optical_props, only: ty_optical_props_1scl - use mo_gas_concentrations, only: ty_gas_concs use mo_rrtmgp_util_string, only: lower_case character(len=*), intent(in) :: gas_names(:) @@ -2340,82 +2138,37 @@ subroutine calculate_fluxes_lw(gas_names, gas_vmr, emis_sfc, & real(r8), intent(in) :: cld_tau_gpt(:,:,:), aer_tau_bnd(:,:,:) type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky - type(ty_gas_concs) :: gas_concs integer :: ncol, nlev, igas - ! Character array to hold lowercase gas names - character(len=32), allocatable :: gas_names_lower(:) - + ! Arrays with extra level above model top real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad - type(ty_optical_props_1scl) :: cld_optics_lw, aer_optics_lw real(r8), dimension(size(gas_vmr,1),size(gas_vmr,2),size(gas_vmr,3)+1) :: gas_vmr_rad ncol = size(pmid,1) nlev = size(pmid,2) - ! Initialize gas concentrations with lower case names - allocate(gas_names_lower(size(gas_names))) - do igas = 1,size(gas_names) - gas_names_lower(igas) = trim(lower_case(gas_names(igas))) - end do - call handle_error(gas_concs%init(gas_names_lower)) - - ! Populate gas concentrations + ! Add a level above model top gas_vmr_rad(:,:,ktop:kbot) = gas_vmr(:,:,:) gas_vmr_rad(:,:,1) = gas_vmr(:,:,1) - do igas = 1,size(gas_names) - call handle_error(gas_concs%set_vmr( & - gas_names_lower(igas), gas_vmr_rad(igas,:,:) & - )) - end do - deallocate(gas_names_lower) - - ! Setup optical properties - call handle_error(cld_optics_lw%alloc_1scl( & - ncol, nlev, k_dist_lw, name='cld_optics_lw' & - )) - cld_optics_lw%tau = 0 - cld_optics_lw%tau(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) - !cld_optics_lw%tau(:,:,:) = cld_tau_gpt(:,:,:) - call handle_error(aer_optics_lw%alloc_1scl( & - ncol, nlev, k_dist_lw%get_band_lims_wavenumber(), & - name='aer_optics_lw' & - )) - aer_optics_lw%tau = 0 - aer_optics_lw%tau(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) - !aer_optics_lw%tau(:,:,:) = aer_tau_bnd(:,:,:) - - ! Add a level cld_tau_gpt_rad = 0 aer_tau_bnd_rad = 0 cld_tau_gpt_rad(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) aer_tau_bnd_rad(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) - ! Do longwave radiative transfer calculations - call t_startf('rad_rte_lw') -! call rrtmgp_run_lw( & -! size(active_gases), ncol, nlev, & -! gas_names, gas_vmr, & -! emis_sfc, & -! pmid, tmid, pint, tint, & -! cld_tau_gpt_rad, aer_tau_bnd_rad, & -! fluxes_allsky, fluxes_clrsky & -! ) - call handle_error(rte_lw(k_dist_lw, gas_concs, & - pmid(1:ncol,1:nlev), tmid(1:ncol,1:nlev), & - pint(1:ncol,1:nlev+1), tint(1:ncol,nlev+1), & - emis_sfc(1:nlwbands,1:ncol), & - cld_optics_lw, & - fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics_lw, & - t_lev=tint(1:ncol,1:nlev+1), & - n_gauss_angles=1)) ! Set to 3 for consistency with RRTMG - call t_stopf('rad_rte_lw') - - call free_optics_lw(cld_optics_lw) - call free_optics_lw(aer_optics_lw) - end subroutine calculate_fluxes_lw + ! Compute fluxes + call t_startf('rad_rrtmgp_run_lw') + call rrtmgp_run_lw( & + size(active_gases), ncol, nlev, & + gas_names, gas_vmr, & + emis_sfc, & + pmid, tmid, pint, tint, & + cld_tau_gpt_rad, aer_tau_bnd_rad, & + fluxes_allsky, fluxes_clrsky & + ) + call t_stopf('rad_rrtmgp_run_lw') + + end subroutine radiation_driver_lw !---------------------------------------------------------------------------- From 55e9fc73683891135999c58f66f1874aaef45e32 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 6 Oct 2020 15:31:03 -0400 Subject: [PATCH 16/71] Remove ty_fluxes from calls in radiation_tend --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 77 ++++---- .../eam/src/physics/rrtmgp/radiation.F90 | 75 ++++---- .../src/physics/rrtmgp/radiation_utils.F90 | 121 +++++++++++- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 182 +++++++++--------- 4 files changed, 284 insertions(+), 171 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 76249c5e1334..63418d3d46d2 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -35,16 +35,15 @@ module radiation rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts, & - initialize_rrtmgp_fluxes, free_fluxes, & - free_optics_sw, free_optics_lw, reset_fluxes, & - expand_day_fluxes + nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range use radiation_state, only: ktop, kbot, nlev_rad - use radiation_utils, only: handle_error, clip_values + use radiation_utils, only: handle_error, clip_values, & + fluxes_t, initialize_fluxes, free_fluxes, reset_fluxes, & + expand_day_fluxes ! For MMF use crmdims, only: crm_nx_rad, crm_ny_rad, crm_nz @@ -1093,7 +1092,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & use radconstants, only: idx_sw_diag ! RRTMGP radiation drivers and derived types - use mo_fluxes_byband, only: ty_fluxes_byband use mo_rrtmgp_util_string, only: lower_case ! CAM history module provides subroutine to send output data to the history @@ -1195,7 +1193,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & character(*), parameter :: subname = 'radiation_tend' ! Radiative fluxes - type(ty_fluxes_byband) :: fluxes_allsky , fluxes_clrsky, & + type(fluxes_t) :: fluxes_allsky , fluxes_clrsky, & fluxes_allsky_all, fluxes_clrsky_all ! Copy of state @@ -1712,10 +1710,10 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to ! have vertical dimension nlev_rad (defined at midpoints). - call initialize_rrtmgp_fluxes(ncol , nlev_rad+1, nswbands, fluxes_allsky , do_direct=.true.) - call initialize_rrtmgp_fluxes(ncol , nlev_rad+1, nswbands, fluxes_clrsky , do_direct=.true.) - call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_allsky_all, do_direct=.true.) - call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_clrsky_all, do_direct=.true.) + call initialize_fluxes(ncol , nlev_rad+1, nswbands, fluxes_allsky , do_direct=.true.) + call initialize_fluxes(ncol , nlev_rad+1, nswbands, fluxes_clrsky , do_direct=.true.) + call initialize_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_allsky_all, do_direct=.true.) + call initialize_fluxes(ncol_tot, nlev_rad+1, nswbands, fluxes_clrsky_all, do_direct=.true.) ! Calculate shortwave fluxes call t_startf('rad_radiation_driver_sw') @@ -1812,13 +1810,13 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & if (radiation_do('lw')) then ! Allocate longwave outputs; why is this not part of the - ! ty_fluxes_byband object? + ! fluxes_t object? ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1 - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky) - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky) - call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nlwbands, fluxes_allsky_all) - call initialize_rrtmgp_fluxes(ncol_tot, nlev_rad+1, nlwbands, fluxes_clrsky_all) + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky) + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky) + call initialize_fluxes(ncol_tot, nlev_rad+1, nlwbands, fluxes_allsky_all) + call initialize_fluxes(ncol_tot, nlev_rad+1, nlwbands, fluxes_clrsky_all) ! Calculate longwave fluxes call t_startf('rad_fluxes_lw') @@ -1970,14 +1968,13 @@ subroutine radiation_driver_sw(ncol, & use perf_mod, only: t_startf, t_stopf use mo_rrtmgp_clr_all_sky, only: rte_sw - use mo_fluxes_byband, only: ty_fluxes_byband use radiation_utils, only: calculate_heating_rate use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & set_aerosol_optics_sw ! Inputs integer, intent(in) :: ncol - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrs(:,:), qrsc(:,:) character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr @@ -1995,7 +1992,7 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day - type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day + type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day ! Incoming solar radiation, scaled for solar zenith angle ! and earth-sun distance @@ -2063,13 +2060,13 @@ subroutine radiation_driver_sw(ncol, & ! Allocate shortwave fluxes (allsky and clearsky) ! TODO: why do I need to provide my own routines to do this? Why is - ! this not part of the ty_fluxes_byband object? + ! this not part of the fluxes_t object? ! ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to ! have vertical dimension nlev_rad (defined at midpoints). - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) ! Add a level above model top to optical properties! @@ -2086,7 +2083,14 @@ subroutine radiation_driver_sw(ncol, & albedo_dif_day(1:nswbands,1:nday), & cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & - fluxes_allsky_day, fluxes_clrsky_day, & + fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, & + fluxes_allsky_day%flux_dn_dir, & + fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, & + fluxes_allsky_day%bnd_flux_dn_dir, & + fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, & + fluxes_clrsky_day%flux_dn_dir, & + fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, & + fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) call t_stopf('rad_calculations_sw') @@ -2128,7 +2132,6 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & fluxes_allsky, fluxes_clrsky) use perf_mod, only: t_startf, t_stopf - use mo_fluxes_byband, only: ty_fluxes_byband use mo_rrtmgp_util_string, only: lower_case character(len=*), intent(in) :: gas_names(:) @@ -2136,7 +2139,7 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & real(r8), intent(in) :: emis_sfc(:,:) real(r8), intent(in) :: pmid(:,:), tmid(:,:), pint(:,:), tint(:,:) real(r8), intent(in) :: cld_tau_gpt(:,:,:), aer_tau_bnd(:,:,:) - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky integer :: ncol, nlev, igas @@ -2164,7 +2167,10 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & emis_sfc, & pmid, tmid, pint, tint, & cld_tau_gpt_rad, aer_tau_bnd_rad, & - fluxes_allsky, fluxes_clrsky & + fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & + fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & + fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & + fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) call t_stopf('rad_rrtmgp_run_lw') @@ -2212,10 +2218,9 @@ end subroutine average_packed_array !---------------------------------------------------------------------------- subroutine export_surface_fluxes(fluxes, cam_out, band) - use mo_fluxes_byband, only: ty_fluxes_byband use camsrfexch, only: cam_out_t - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes type(cam_out_t), intent(inout) :: cam_out character(len=*), intent(in) :: band integer :: icol @@ -2293,8 +2298,7 @@ end subroutine export_surface_fluxes subroutine set_net_fluxes_sw(fluxes, fsds, fsns, fsnt) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes real(r8), intent(inout) :: fsds(:) real(r8), intent(inout) :: fsns(:) real(r8), intent(inout) :: fsnt(:) @@ -2313,8 +2317,7 @@ end subroutine set_net_fluxes_sw subroutine set_net_fluxes_lw(fluxes, flns, flnt) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes real(r8), intent(inout) :: flns(:) real(r8), intent(inout) :: flnt(:) integer :: ncol @@ -2555,12 +2558,11 @@ subroutine output_fluxes_sw(icall, state, flux_all, flux_clr, qrs, qrsc) use physconst, only: cpair use physics_types, only: physics_state use cam_history, only: outfld - use mo_fluxes_byband, only: ty_fluxes_byband integer, intent(in) :: icall type(physics_state), intent(in) :: state - type(ty_fluxes_byband), intent(in) :: flux_all - type(ty_fluxes_byband), intent(in) :: flux_clr + type(fluxes_t), intent(in) :: flux_all + type(fluxes_t), intent(in) :: flux_clr real(r8), intent(in) :: qrs(:,:), qrsc(:,:) ! SW cloud radiative effect @@ -2621,12 +2623,11 @@ subroutine output_fluxes_lw(icall, state, flux_all, flux_clr, qrl, qrlc) use physconst, only: cpair use physics_types, only: physics_state use cam_history, only: outfld - use mo_fluxes_byband, only: ty_fluxes_byband integer, intent(in) :: icall type(physics_state), intent(in) :: state - type(ty_fluxes_byband), intent(in) :: flux_all - type(ty_fluxes_byband), intent(in) :: flux_clr + type(fluxes_t), intent(in) :: flux_all + type(fluxes_t), intent(in) :: flux_clr ! Heating rates real(r8), intent(in) :: qrl(:,:), qrlc(:,:) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 9d4663a77ff9..0f23f7fb36bb 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -28,16 +28,12 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - k_dist_sw, k_dist_lw, & rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts, & - initialize_rrtmgp_fluxes, free_fluxes, & - free_optics_sw, free_optics_lw, reset_fluxes, & - expand_day_fluxes + nswgpts, nlwgpts use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks @@ -45,7 +41,8 @@ module radiation use radiation_state, only: ktop, kbot, nlev_rad use radiation_utils, only: compress_day_columns, expand_day_columns, & - handle_error + handle_error, fluxes_t, & + initialize_fluxes, reset_fluxes, free_fluxes, expand_day_fluxes implicit none private @@ -1033,9 +1030,6 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! For getting radiative constituent gases use rad_constituents, only: N_DIAG, rad_cnst_get_call_list - ! RRTMGP radiation drivers and derived types - use mo_fluxes_byband, only: ty_fluxes_byband - ! CAM history module provides subroutine to send output data to the history ! buffer to be aggregated and written to disk use cam_history, only: outfld @@ -1161,7 +1155,8 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & character(*), parameter :: subname = 'radiation_tend' ! Radiative fluxes - type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky + type(fluxes_t) :: fluxes_allsky, fluxes_clrsky + !type(fluxes_t) :: fluxes_allsky, fluxes_clrsky ! Zero-array for cloud properties if not diagnosed by microphysics real(r8), target, dimension(pcols,pver) :: zeros @@ -1230,8 +1225,8 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & if (radiation_do('sw')) then ! Allocate shortwave fluxes - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nswbands, fluxes_allsky, do_direct=.true.) - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nswbands, fluxes_clrsky, do_direct=.true.) + call initialize_fluxes(ncol, nlev_rad+1, nswbands, fluxes_allsky, do_direct=.true.) + call initialize_fluxes(ncol, nlev_rad+1, nswbands, fluxes_clrsky, do_direct=.true.) ! Get albedo. This uses CAM routines internally and just provides a ! wrapper to improve readability of the code here. @@ -1344,13 +1339,13 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & call output_fluxes_sw(icall, state, fluxes_allsky, fluxes_clrsky, qrs, qrsc) end if end do - + ! Set net fluxes used by other components (land?) call set_net_fluxes_sw(fluxes_allsky, fsds, fsns, fsnt) ! Set surface fluxes that are used by the land model call export_surface_fluxes(fluxes_allsky, cam_out, 'shortwave') - + ! Free memory allocated for shortwave fluxes call free_fluxes(fluxes_allsky) call free_fluxes(fluxes_clrsky) @@ -1368,11 +1363,11 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & if (radiation_do('lw')) then ! Allocate longwave outputs; why is this not part of the - ! ty_fluxes_byband object? + ! fluxes_t object? ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1 - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky) - call initialize_rrtmgp_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky) + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky) + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky) call t_startf('rad_cld_optics_lw') cld_tau_gpt_lw = 0._r8 @@ -1512,14 +1507,12 @@ subroutine radiation_driver_sw(ncol, & fluxes_allsky, fluxes_clrsky, qrs, qrsc) use perf_mod, only: t_startf, t_stopf - use mo_rrtmgp_clr_all_sky, only: rte_sw - use mo_fluxes_byband, only: ty_fluxes_byband use radiation_utils, only: calculate_heating_rate ! Inputs integer, intent(in) :: ncol - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrs(:,:), qrsc(:,:) character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr @@ -1546,7 +1539,7 @@ subroutine radiation_driver_sw(ncol, & real(wp), dimension(size(gas_names),ncol,pver) :: gas_vmr_day real(wp), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(wp), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day - type(ty_fluxes_byband) :: fluxes_allsky_day, fluxes_clrsky_day + type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day ! Scaling factor for total sky irradiance; used to account for orbital ! eccentricity, and could be used to scale total sky irradiance for different @@ -1604,13 +1597,13 @@ subroutine radiation_driver_sw(ncol, & ! Allocate shortwave fluxes (allsky and clearsky) ! TODO: why do I need to provide my own routines to do this? Why is - ! this not part of the ty_fluxes_byband object? + ! this not part of the fluxes_t object? ! ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to ! have vertical dimension nlev_rad (defined at midpoints). - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) - call initialize_rrtmgp_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) ! Add a level above model top to optical properties! @@ -1627,7 +1620,11 @@ subroutine radiation_driver_sw(ncol, & albedo_dif_day(1:nswbands,1:nday), & cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & - fluxes_allsky_day, fluxes_clrsky_day, & + fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, fluxes_allsky_day%flux_dn_dir, & + fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & + fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & + fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & + !fluxes_allsky_day, fluxes_clrsky_day, & tsi_scaling & ) call t_stopf('rad_calculations_sw') @@ -1752,13 +1749,11 @@ subroutine radiation_driver_lw(ncol, & fluxes_allsky, fluxes_clrsky, qrl, qrlc) use perf_mod, only: t_startf, t_stopf - use mo_rrtmgp_clr_all_sky, only: rte_lw - use mo_fluxes_byband, only: ty_fluxes_byband use radiation_utils, only: calculate_heating_rate ! Inputs integer, intent(in) :: ncol - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrl(:,:), qrlc(:,:) character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr @@ -1799,7 +1794,10 @@ subroutine radiation_driver_lw(ncol, & surface_emissivity, & pmid, tmid, pint, tint, & cld_tau_gpt_rad, aer_tau_bnd_rad, & - fluxes_allsky, fluxes_clrsky & + fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & + fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & + fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & + fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) call t_stopf('rad_calculations_lw') @@ -1826,10 +1824,9 @@ end subroutine radiation_driver_lw !---------------------------------------------------------------------------- subroutine export_surface_fluxes(fluxes, cam_out, band) - use mo_fluxes_byband, only: ty_fluxes_byband use camsrfexch, only: cam_out_t - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes type(cam_out_t), intent(inout) :: cam_out character(len=*), intent(in) :: band integer :: icol @@ -1907,8 +1904,7 @@ end subroutine export_surface_fluxes subroutine set_net_fluxes_sw(fluxes, fsds, fsns, fsnt) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes real(r8), intent(inout) :: fsds(:) real(r8), intent(inout) :: fsns(:) real(r8), intent(inout) :: fsnt(:) @@ -1927,8 +1923,7 @@ end subroutine set_net_fluxes_sw subroutine set_net_fluxes_lw(fluxes, flns, flnt) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: fluxes + type(fluxes_t), intent(in) :: fluxes real(r8), intent(inout) :: flns(:) real(r8), intent(inout) :: flnt(:) integer :: ncol @@ -2171,12 +2166,11 @@ subroutine output_fluxes_sw(icall, state, flux_all, flux_clr, qrs, qrsc) use physconst, only: cpair use physics_types, only: physics_state use cam_history, only: outfld - use mo_fluxes_byband, only: ty_fluxes_byband integer, intent(in) :: icall type(physics_state), intent(in) :: state - type(ty_fluxes_byband), intent(in) :: flux_all - type(ty_fluxes_byband), intent(in) :: flux_clr + type(fluxes_t), intent(in) :: flux_all + type(fluxes_t), intent(in) :: flux_clr real(r8), intent(in) :: qrs(:,:), qrsc(:,:) ! SW cloud radiative effect @@ -2236,12 +2230,11 @@ subroutine output_fluxes_lw(icall, state, flux_all, flux_clr, qrl, qrlc) use physconst, only: cpair use physics_types, only: physics_state use cam_history, only: outfld - use mo_fluxes_byband, only: ty_fluxes_byband integer, intent(in) :: icall type(physics_state), intent(in) :: state - type(ty_fluxes_byband), intent(in) :: flux_all - type(ty_fluxes_byband), intent(in) :: flux_clr + type(fluxes_t), intent(in) :: flux_all + type(fluxes_t), intent(in) :: flux_clr ! Heating rates real(r8), intent(in) :: qrl(:,:), qrlc(:,:) diff --git a/components/eam/src/physics/rrtmgp/radiation_utils.F90 b/components/eam/src/physics/rrtmgp/radiation_utils.F90 index 98e3dd74b441..596ae28223b8 100644 --- a/components/eam/src/physics/rrtmgp/radiation_utils.F90 +++ b/components/eam/src/physics/rrtmgp/radiation_utils.F90 @@ -8,7 +8,9 @@ module radiation_utils public :: compress_day_columns, expand_day_columns, & calculate_heating_rate, clip_values, & - handle_error + handle_error, & + fluxes_t, initialize_fluxes, reset_fluxes, free_fluxes, & + expand_day_fluxes ! Interface blocks for overloaded procedures interface compress_day_columns @@ -23,6 +25,19 @@ module radiation_utils module procedure clip_values_1d, clip_values_2d, clip_values_3d end interface clip_values + ! Type to hold fluxes + type fluxes_t + real(r8), allocatable :: flux_up(:,:) + real(r8), allocatable :: flux_dn(:,:) + real(r8), allocatable :: flux_net(:,:) + real(r8), allocatable :: flux_dn_dir(:,:) + real(r8), allocatable :: bnd_flux_up(:,:,:) + real(r8), allocatable :: bnd_flux_dn(:,:,:) + real(r8), allocatable :: bnd_flux_net(:,:,:) + real(r8), allocatable :: bnd_flux_dn_dir(:,:,:) + end type + + ! Max length for character strings integer, parameter :: max_char_len = 512 @@ -30,7 +45,111 @@ module radiation_utils character(len=*), parameter :: module_name = 'radiation_utils' contains + !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + subroutine initialize_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + + integer, intent(in) :: ncol, nlevels, nbands + type(fluxes_t), intent(inout) :: fluxes + logical, intent(in), optional :: do_direct + + logical :: do_direct_local + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Allocate flux arrays + ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as + ! number of model levels plus one, or allocate as nlevels+1 if nlevels + ! represents number of model levels rather than number of interface levels. + + ! Broadband fluxes + allocate(fluxes%flux_up(ncol, nlevels)) + allocate(fluxes%flux_dn(ncol, nlevels)) + allocate(fluxes%flux_net(ncol, nlevels)) + if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) + + ! Fluxes by band + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) + if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) + + ! Initialize + call reset_fluxes(fluxes) + + end subroutine initialize_fluxes + !------------------------------------------------------------------------------- + subroutine reset_fluxes(fluxes) + + type(fluxes_t), intent(inout) :: fluxes + + ! Reset broadband fluxes + fluxes%flux_up(:,:) = 0._r8 + fluxes%flux_dn(:,:) = 0._r8 + fluxes%flux_net(:,:) = 0._r8 + if (allocated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._r8 + + ! Reset band-by-band fluxes + fluxes%bnd_flux_up(:,:,:) = 0._r8 + fluxes%bnd_flux_dn(:,:,:) = 0._r8 + fluxes%bnd_flux_net(:,:,:) = 0._r8 + if (allocated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._r8 + + end subroutine reset_fluxes + !------------------------------------------------------------------------------- + subroutine free_fluxes(fluxes) + type(fluxes_t), intent(inout) :: fluxes + if (allocated(fluxes%flux_up)) deallocate(fluxes%flux_up) + if (allocated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) + if (allocated(fluxes%flux_net)) deallocate(fluxes%flux_net) + if (allocated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) + if (allocated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) + if (allocated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) + if (allocated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) + if (allocated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) + end subroutine free_fluxes + !------------------------------------------------------------------------------- + subroutine expand_day_fluxes(daytime_fluxes, expanded_fluxes, day_indices) + type(fluxes_t), intent(in) :: daytime_fluxes + type(fluxes_t), intent(inout) :: expanded_fluxes + integer, intent(in) :: day_indices(:) + integer :: nday, iday, icol + + ! Reset fluxes in expanded_fluxes object to zero + call reset_fluxes(expanded_fluxes) + + ! Number of daytime columns is number of indices greater than zero + nday = count(day_indices > 0) + + ! Loop over daytime indices and map daytime fluxes into expanded arrays + do iday = 1,nday + + ! Map daytime index to proper column index + icol = day_indices(iday) + + ! Expand broadband fluxes + expanded_fluxes%flux_up(icol,:) = daytime_fluxes%flux_up(iday,:) + expanded_fluxes%flux_dn(icol,:) = daytime_fluxes%flux_dn(iday,:) + expanded_fluxes%flux_net(icol,:) = daytime_fluxes%flux_net(iday,:) + if (allocated(daytime_fluxes%flux_dn_dir)) then + expanded_fluxes%flux_dn_dir(icol,:) = daytime_fluxes%flux_dn_dir(iday,:) + end if + + ! Expand band-by-band fluxes + expanded_fluxes%bnd_flux_up(icol,:,:) = daytime_fluxes%bnd_flux_up(iday,:,:) + expanded_fluxes%bnd_flux_dn(icol,:,:) = daytime_fluxes%bnd_flux_dn(iday,:,:) + expanded_fluxes%bnd_flux_net(icol,:,:) = daytime_fluxes%bnd_flux_net(iday,:,:) + if (allocated(daytime_fluxes%bnd_flux_dn_dir)) then + expanded_fluxes%bnd_flux_dn_dir(icol,:,:) = daytime_fluxes%bnd_flux_dn_dir(iday,:,:) + end if + + end do + end subroutine expand_day_fluxes !------------------------------------------------------------------------------- subroutine compress_day_columns_1d(xcol, xday, day_indices) diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index bf9d2d27e95f..d15f16efb22a 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -39,7 +39,7 @@ module rrtmgp_interface get_min_temperature, get_max_temperature, & initialize_rrtmgp_fluxes, free_fluxes, & free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations, expand_day_fluxes + set_gas_concentrations contains @@ -101,7 +101,10 @@ subroutine rrtmgp_run_sw( & albedo_dir, albedo_dif, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - fluxes_allsky, fluxes_clrsky, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & tsi_scaling & ) integer, intent(in) :: ngas, ncol, nlev @@ -114,9 +117,15 @@ subroutine rrtmgp_run_sw( & real(wp), intent(in), dimension(:,:,:) :: & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + real(wp), intent(inout), target, dimension(:,:) :: & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir + real(wp), intent(inout), target, dimension(:,:,:) :: & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir real(wp), intent(in) :: tsi_scaling + type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky type(ty_gas_concs) :: gas_concentrations type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw @@ -124,8 +133,22 @@ subroutine rrtmgp_run_sw( & integer :: iband, igas, iday, icol ! Allocate shortwave fluxes (allsky and clearsky) - ! TODO: why do I need to provide my own routines to do this? Why is - ! this not part of the ty_fluxes_byband object? + fluxes_allsky%flux_up => allsky_flux_up + fluxes_allsky%flux_dn => allsky_flux_dn + fluxes_allsky%flux_net => allsky_flux_net + fluxes_allsky%flux_dn_dir => allsky_flux_dn_dir + fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up + fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn + fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net + fluxes_allsky%bnd_flux_dn_dir => allsky_bnd_flux_dn_dir + fluxes_clrsky%flux_up => clrsky_flux_up + fluxes_clrsky%flux_dn => clrsky_flux_dn + fluxes_clrsky%flux_net => clrsky_flux_net + fluxes_clrsky%flux_dn_dir => clrsky_flux_dn_dir + fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up + fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn + fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net + fluxes_clrsky%bnd_flux_dn_dir => clrsky_bnd_flux_dn_dir ! Populate RRTMGP optics call handle_error(cld_optics_sw%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) @@ -189,7 +212,10 @@ subroutine rrtmgp_run_lw( & surface_emissivity, & pmid, tmid, pint, tint, & cld_tau_gpt, aer_tau_bnd, & - fluxes_allsky, fluxes_clrsky & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net & ) integer, intent(in) :: ngas, ncol, nlev @@ -198,11 +224,33 @@ subroutine rrtmgp_run_lw( & real(wp), intent(in), dimension(:,:) :: surface_emissivity real(wp), intent(in), dimension(:,:) :: pmid, tmid, pint, tint real(wp), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd - type(ty_fluxes_byband), intent(inout) :: fluxes_allsky, fluxes_clrsky + real(wp), intent(inout), dimension(:,:), target :: & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net + real(wp), intent(inout), dimension(:,:,:), target :: & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net + + type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky type(ty_gas_concs) :: gas_concentrations type(ty_optical_props_1scl) :: cld_optics, aer_optics + + ! Allocate fluxes (allsky and clearsky) + fluxes_allsky%flux_up => allsky_flux_up + fluxes_allsky%flux_dn => allsky_flux_dn + fluxes_allsky%flux_net => allsky_flux_net + fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up + fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn + fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net + fluxes_clrsky%flux_up => clrsky_flux_up + fluxes_clrsky%flux_dn => clrsky_flux_dn + fluxes_clrsky%flux_net => clrsky_flux_net + fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up + fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn + fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net + ! Setup gas concentrations object call t_startf('rad_gas_concentrations_lw') call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) @@ -277,48 +325,6 @@ subroutine set_available_gases(gases, gas_concentrations) end subroutine set_available_gases - ! For some reason the RRTMGP flux objects do not include initialization - ! routines, but rather expect the user to associate the individual fluxes (which - ! are pointers) with appropriate targets. Instead, this routine treats those - ! pointers as allocatable members and allocates space for them. TODO: is this - ! appropriate use? - subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) - - use mo_fluxes_byband, only: ty_fluxes_byband - integer, intent(in) :: ncol, nlevels, nbands - type(ty_fluxes_byband), intent(inout) :: fluxes - logical, intent(in), optional :: do_direct - - logical :: do_direct_local - - if (present(do_direct)) then - do_direct_local = .true. - else - do_direct_local = .false. - end if - - ! Allocate flux arrays - ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as - ! number of model levels plus one, or allocate as nlevels+1 if nlevels - ! represents number of model levels rather than number of interface levels. - - ! Broadband fluxes - allocate(fluxes%flux_up(ncol, nlevels)) - allocate(fluxes%flux_dn(ncol, nlevels)) - allocate(fluxes%flux_net(ncol, nlevels)) - if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) - - ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) - if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) - - ! Initialize - call reset_fluxes(fluxes) - - end subroutine initialize_rrtmgp_fluxes - !---------------------------------------------------------------------------- subroutine free_fluxes(fluxes) @@ -402,48 +408,6 @@ subroutine compress_optics_sw(day_indices, tau, ssa, asm, tau_day, ssa_day, asm_ end subroutine compress_optics_sw - subroutine expand_day_fluxes(daytime_fluxes, expanded_fluxes, day_indices) - use mo_rte_kind, only: wp - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(in) :: daytime_fluxes - type(ty_fluxes_byband), intent(inout) :: expanded_fluxes - integer, intent(in) :: day_indices(:) - - integer :: nday, iday, icol - - ! Reset fluxes in expanded_fluxes object to zero - call reset_fluxes(expanded_fluxes) - - ! Number of daytime columns is number of indices greater than zero - nday = count(day_indices > 0) - - ! Loop over daytime indices and map daytime fluxes into expanded arrays - do iday = 1,nday - - ! Map daytime index to proper column index - icol = day_indices(iday) - - ! Expand broadband fluxes - expanded_fluxes%flux_up(icol,:) = daytime_fluxes%flux_up(iday,:) - expanded_fluxes%flux_dn(icol,:) = daytime_fluxes%flux_dn(iday,:) - expanded_fluxes%flux_net(icol,:) = daytime_fluxes%flux_net(iday,:) - if (associated(daytime_fluxes%flux_dn_dir)) then - expanded_fluxes%flux_dn_dir(icol,:) = daytime_fluxes%flux_dn_dir(iday,:) - end if - - ! Expand band-by-band fluxes - expanded_fluxes%bnd_flux_up(icol,:,:) = daytime_fluxes%bnd_flux_up(iday,:,:) - expanded_fluxes%bnd_flux_dn(icol,:,:) = daytime_fluxes%bnd_flux_dn(iday,:,:) - expanded_fluxes%bnd_flux_net(icol,:,:) = daytime_fluxes%bnd_flux_net(iday,:,:) - if (associated(daytime_fluxes%bnd_flux_dn_dir)) then - expanded_fluxes%bnd_flux_dn_dir(icol,:,:) = daytime_fluxes%bnd_flux_dn_dir(iday,:,:) - end if - - end do - - end subroutine expand_day_fluxes - - subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) use mo_gas_concentrations, only: ty_gas_concs use mo_rrtmgp_util_string, only: lower_case @@ -491,7 +455,43 @@ end subroutine set_gas_concentrations !---------------------------------------------------------------------------- + subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) + + use mo_fluxes_byband, only: ty_fluxes_byband + + integer, intent(in) :: ncol, nlevels, nbands + type(ty_fluxes_byband), intent(inout) :: fluxes + logical, intent(in), optional :: do_direct + + logical :: do_direct_local + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Allocate flux arrays + ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as + ! number of model levels plus one, or allocate as nlevels+1 if nlevels + ! represents number of model levels rather than number of interface levels. + ! Broadband fluxes + allocate(fluxes%flux_up(ncol, nlevels)) + allocate(fluxes%flux_dn(ncol, nlevels)) + allocate(fluxes%flux_net(ncol, nlevels)) + if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) + + ! Fluxes by band + allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) + allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) + if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) + + ! Initialize + call reset_fluxes(fluxes) + + end subroutine initialize_rrtmgp_fluxes ! Stop run ungracefully since we don't want dependencies on E3SM abortutils ! here From e909659b7512f346d210c8418def6963e65c0b16 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 6 Oct 2020 18:11:45 -0400 Subject: [PATCH 17/71] Remove unused functions --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 17 +--- .../eam/src/physics/rrtmgp/radiation.F90 | 29 +++---- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 82 +------------------ 3 files changed, 16 insertions(+), 112 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 63418d3d46d2..65712b0459c9 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -29,7 +29,6 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - k_dist_sw, k_dist_lw, & rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & @@ -439,9 +438,6 @@ subroutine radiation_init(state) use radiation_data, only: init_rad_data use physics_types, only: physics_state - ! RRTMGP modules - use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init - ! For optics use cloud_rad_props, only: cloud_rad_props_init use ebert_curry, only: ec_rad_props_init @@ -1091,9 +1087,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Index to visible channel for diagnostic outputs use radconstants, only: idx_sw_diag - ! RRTMGP radiation drivers and derived types - use mo_rrtmgp_util_string, only: lower_case - ! CAM history module provides subroutine to send output data to the history ! buffer to be aggregated and written to disk use cam_history, only: outfld @@ -1967,7 +1960,6 @@ subroutine radiation_driver_sw(ncol, & fluxes_allsky, fluxes_clrsky, qrs, qrsc) use perf_mod, only: t_startf, t_stopf - use mo_rrtmgp_clr_all_sky, only: rte_sw use radiation_utils, only: calculate_heating_rate use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & set_aerosol_optics_sw @@ -2132,7 +2124,6 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & fluxes_allsky, fluxes_clrsky) use perf_mod, only: t_startf, t_stopf - use mo_rrtmgp_util_string, only: lower_case character(len=*), intent(in) :: gas_names(:) real(r8), intent(in) :: gas_vmr(:,:,:) @@ -2533,13 +2524,11 @@ end subroutine set_albedo ! Function to check if a wavenumber is in the visible or IR logical function is_visible(wavenumber) - use mo_rte_kind, only: wp - ! Input wavenumber; this needs to be input in inverse cm (cm^-1) - real(wp), intent(in) :: wavenumber + real(r8), intent(in) :: wavenumber ! Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1 - real(wp), parameter :: visible_wavenumber_threshold = 14286._wp ! cm^-1 + real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 ! Wavenumber is in the visible if it is above the visible threshold ! wavenumber, and in the infrared if it is below the threshold @@ -2775,7 +2764,7 @@ subroutine get_gas_vmr(icall, state, pbuf, gas_name, vmr) use physics_types, only: physics_state use physics_buffer, only: physics_buffer_desc use rad_constituents, only: rad_cnst_get_gas - use mo_rrtmgp_util_string, only: lower_case, string_loc_in_array + use mo_rrtmgp_util_string, only: string_loc_in_array integer, intent(in) :: icall type(physics_state), intent(in) :: state diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 0f23f7fb36bb..ced865ac1e75 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -24,9 +24,8 @@ module radiation rrtmg_to_rrtmgp_swbands use physconst, only: cpair, cappa - ! RRTMGP gas optics object to store coefficient information. This is imported - ! here so that we can make the k_dist objects module data and only load them - ! once. + ! RRTMGP interface to separate E3SM-specific data types from RRTMGP-specific + ! data types, that may be in Fortran or C++ use rrtmgp_interface, only: & rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & @@ -34,7 +33,6 @@ module radiation rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts - use mo_rte_kind, only: wp ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -437,9 +435,6 @@ subroutine radiation_init(state) use radiation_data, only: init_rad_data use physics_types, only: physics_state - ! RRTMGP modules - use mo_load_coefficients, only: rrtmgp_load_coefficients=>load_and_init - ! For optics use cloud_rad_props, only: cloud_rad_props_init use ebert_curry, only: ec_rad_props_init @@ -1532,13 +1527,13 @@ subroutine radiation_driver_sw(ncol, & integer :: nday, nnight ! Number of daylight columns integer :: day_indices(ncol), night_indices(ncol) ! Indicies of daylight coumns - real(wp), dimension(ncol) :: coszrs_day - real(wp), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day - real(wp), dimension(ncol,nlev_rad) :: pmid_day, tmid_day - real(wp), dimension(ncol,nlev_rad+1) :: pint_day - real(wp), dimension(size(gas_names),ncol,pver) :: gas_vmr_day - real(wp), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day - real(wp), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day + real(r8), dimension(ncol) :: coszrs_day + real(r8), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day + real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day + real(r8), dimension(ncol,nlev_rad+1) :: pint_day + real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day + real(r8), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day + real(r8), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day ! Scaling factor for total sky irradiance; used to account for orbital @@ -2141,13 +2136,11 @@ end subroutine set_albedo ! Function to check if a wavenumber is in the visible or IR logical function is_visible(wavenumber) - use mo_rte_kind, only: wp - ! Input wavenumber; this needs to be input in inverse cm (cm^-1) - real(wp), intent(in) :: wavenumber + real(r8), intent(in) :: wavenumber ! Threshold between visible and infrared is 0.7 micron, or 14286 cm^-1 - real(wp), parameter :: visible_wavenumber_threshold = 14286._wp ! cm^-1 + real(r8), parameter :: visible_wavenumber_threshold = 14286._r8 ! cm^-1 ! Wavenumber is in the visible if it is above the visible threshold ! wavenumber, and in the infrared if it is below the threshold diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index d15f16efb22a..c4548cf738dd 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -24,7 +24,7 @@ module rrtmgp_interface ! Gas optics objects that hold k-distribution information. These are made ! module variables because we only want to initialize them once at init time. - type(ty_gas_optics_rrtmgp), public :: k_dist_sw, k_dist_lw + type(ty_gas_optics_rrtmgp) :: k_dist_sw, k_dist_lw ! Make these module variables so that we do not have to provide access to ! k_dist objects; this just makes it easier to switch between F90 and C++ @@ -36,10 +36,7 @@ module rrtmgp_interface get_nbnds_sw, get_nbnds_lw, & get_ngpts_sw, get_ngpts_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - get_min_temperature, get_max_temperature, & - initialize_rrtmgp_fluxes, free_fluxes, & - free_optics_sw, free_optics_lw, reset_fluxes, & - set_gas_concentrations + get_min_temperature, get_max_temperature contains @@ -327,43 +324,6 @@ end subroutine set_available_gases !---------------------------------------------------------------------------- - subroutine free_fluxes(fluxes) - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - if (associated(fluxes%flux_up)) deallocate(fluxes%flux_up) - if (associated(fluxes%flux_dn)) deallocate(fluxes%flux_dn) - if (associated(fluxes%flux_net)) deallocate(fluxes%flux_net) - if (associated(fluxes%flux_dn_dir)) deallocate(fluxes%flux_dn_dir) - if (associated(fluxes%bnd_flux_up)) deallocate(fluxes%bnd_flux_up) - if (associated(fluxes%bnd_flux_dn)) deallocate(fluxes%bnd_flux_dn) - if (associated(fluxes%bnd_flux_net)) deallocate(fluxes%bnd_flux_net) - if (associated(fluxes%bnd_flux_dn_dir)) deallocate(fluxes%bnd_flux_dn_dir) - end subroutine free_fluxes - - !---------------------------------------------------------------------------- - - subroutine reset_fluxes(fluxes) - - use mo_rte_kind, only: wp - use mo_fluxes_byband, only: ty_fluxes_byband - type(ty_fluxes_byband), intent(inout) :: fluxes - - ! Reset broadband fluxes - fluxes%flux_up(:,:) = 0._wp - fluxes%flux_dn(:,:) = 0._wp - fluxes%flux_net(:,:) = 0._wp - if (associated(fluxes%flux_dn_dir)) fluxes%flux_dn_dir(:,:) = 0._wp - - ! Reset band-by-band fluxes - fluxes%bnd_flux_up(:,:,:) = 0._wp - fluxes%bnd_flux_dn(:,:,:) = 0._wp - fluxes%bnd_flux_net(:,:,:) = 0._wp - if (associated(fluxes%bnd_flux_dn_dir)) fluxes%bnd_flux_dn_dir(:,:,:) = 0._wp - - end subroutine reset_fluxes - - !---------------------------------------------------------------------------- - subroutine free_optics_sw(optics) use mo_optical_props, only: ty_optical_props_2str type(ty_optical_props_2str), intent(inout) :: optics @@ -455,44 +415,6 @@ end subroutine set_gas_concentrations !---------------------------------------------------------------------------- - subroutine initialize_rrtmgp_fluxes(ncol, nlevels, nbands, fluxes, do_direct) - - use mo_fluxes_byband, only: ty_fluxes_byband - - integer, intent(in) :: ncol, nlevels, nbands - type(ty_fluxes_byband), intent(inout) :: fluxes - logical, intent(in), optional :: do_direct - - logical :: do_direct_local - - if (present(do_direct)) then - do_direct_local = .true. - else - do_direct_local = .false. - end if - - ! Allocate flux arrays - ! NOTE: fluxes defined at interfaces, so need to either pass nlevels as - ! number of model levels plus one, or allocate as nlevels+1 if nlevels - ! represents number of model levels rather than number of interface levels. - - ! Broadband fluxes - allocate(fluxes%flux_up(ncol, nlevels)) - allocate(fluxes%flux_dn(ncol, nlevels)) - allocate(fluxes%flux_net(ncol, nlevels)) - if (do_direct_local) allocate(fluxes%flux_dn_dir(ncol, nlevels)) - - ! Fluxes by band - allocate(fluxes%bnd_flux_up(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_dn(ncol, nlevels, nbands)) - allocate(fluxes%bnd_flux_net(ncol, nlevels, nbands)) - if (do_direct_local) allocate(fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands)) - - ! Initialize - call reset_fluxes(fluxes) - - end subroutine initialize_rrtmgp_fluxes - ! Stop run ungracefully since we don't want dependencies on E3SM abortutils ! here subroutine handle_error(msg) From 90682ce2867ef4be58ef0a28d72a1093e71f7104 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 6 Oct 2020 18:22:41 -0400 Subject: [PATCH 18/71] Move get_gas_vmr to radiation_utils --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 112 +----------------- .../eam/src/physics/rrtmgp/radiation.F90 | 102 +--------------- .../src/physics/rrtmgp/radiation_utils.F90 | 103 +++++++++++++++- 3 files changed, 106 insertions(+), 211 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 65712b0459c9..389b54d15977 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -42,7 +42,7 @@ module radiation use radiation_state, only: ktop, kbot, nlev_rad use radiation_utils, only: handle_error, clip_values, & fluxes_t, initialize_fluxes, free_fluxes, reset_fluxes, & - expand_day_fluxes + expand_day_fluxes, get_gas_vmr ! For MMF use crmdims, only: crm_nx_rad, crm_ny_rad, crm_nz @@ -1550,13 +1550,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Set gas concentrations call t_startf('rad_gas_concentrations') - do igas = 1,size(active_gases) - ! Get volume mixing ratio for this gas - call get_gas_vmr(icall, state, pbuf, trim(active_gases(igas)), vmr_col(igas,1:ncol,1:pver)) - !call get_gas_vmr(icall, state, pbuf, trim(active_gases(igas)), vmr_col(igas,1:ncol,ktop:kbot)) - ! Copy top model level to level above model top - !vmr_col(igas,1:ncol,1) = vmr_col(igas,1:ncol,ktop) - end do + call get_gas_vmr(icall, state, pbuf, active_gases, vmr_col) call t_stopf('rad_gas_concentrations') ! Do shortwave cloud and aerosol optics calculations @@ -2759,108 +2753,6 @@ end subroutine output_cloud_optics_lw !---------------------------------------------------------------------------- - subroutine get_gas_vmr(icall, state, pbuf, gas_name, vmr) - - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use rad_constituents, only: rad_cnst_get_gas - use mo_rrtmgp_util_string, only: string_loc_in_array - - integer, intent(in) :: icall - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - character(len=*), intent(in) :: gas_name - real(r8), intent(out) :: vmr(:,:) - - ! Mass mixing ratio - real(r8), pointer :: mass_mix_ratio(:,:) - - ! Gases and molecular weights. Note that we do NOT have CFCs yet (I think - ! this is coming soon in RRTMGP). RRTMGP also allows for absorption due to - ! CO and N2, which RRTMG did not have. - character(len=3), dimension(8) :: gas_species = (/ & - 'H2O', 'CO2', 'O3 ', 'N2O', & - 'CO ', 'CH4', 'O2 ', 'N2 ' & - /) - real(r8), dimension(8) :: mol_weight_gas = (/ & - 18.01528, 44.0095, 47.9982, 44.0128, & - 28.0101, 16.04246, 31.998, 28.0134 & - /) ! g/mol - - ! Molar weight of air - real(r8), parameter :: mol_weight_air = 28.97 ! g/mol - - ! Defaults for gases that are not available (TODO: is this still accurate?) - real(r8), parameter :: co_vmr = 1.0e-7_r8 - real(r8), parameter :: n2_vmr = 0.7906_r8 - - ! Loop indices - integer :: igas - - ! Number of columns - integer :: ncol - - ! Name of routine - character(len=32) :: subname = 'get_gas_vmr' - - ! Number of columns in chunk - ncol = state%ncol - - ! Get index into gas names we define above that we know the molecular - ! weights for; if this gas is not in list of gases we know about, skip - igas = string_loc_in_array(gas_name, gas_species) - if (igas <= 0) then - call endrun('Gas name ' // trim(gas_name) // ' not recognized.') - end if - - ! initialize - vmr(:,:) = 0._r8 - - select case(trim(gas_species(igas))) - - case('CO') - - ! CO not available, use default - vmr(1:ncol,1:pver) = co_vmr - - case('N2') - - ! N2 not available, use default - vmr(1:ncol,1:pver) = n2_vmr - - case('H2O') - - ! Water vapor is represented as specific humidity in CAM, so we - ! need to handle water a little differently; first, read water vapor - ! specific humidity into mass mixing ratio array - call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, & - mass_mix_ratio) - - ! Convert to volume mixing ratio by multiplying by the ratio of - ! molecular weight of dry air to molecular weight of gas. Note that - ! first specific humidity (held in the mass_mix_ratio array read - ! from rad_constituents) is converted to an actual mass mixing - ! ratio. - vmr(1:ncol,1:pver) = mass_mix_ratio(1:ncol,1:pver) / ( & - 1._r8 - mass_mix_ratio(1:ncol,1:pver) & - ) * mol_weight_air / mol_weight_gas(igas) - - case DEFAULT - - ! Get mass mixing ratio from the rad_constituents interface - call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, mass_mix_ratio) - - ! Convert to volume mixing ratio by multiplying by the ratio of - ! molecular weight of dry air to molecular weight of gas - vmr(1:ncol,1:pver) = mass_mix_ratio(1:ncol,1:pver) & - * mol_weight_air / mol_weight_gas(igas) - - end select - - end subroutine get_gas_vmr - - !---------------------------------------------------------------------------- - ! Should we do snow optics? Check for existence of "cldfsnow" variable logical function do_snow_optics() use physics_buffer, only: physics_buffer_desc, pbuf_get_index diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index ced865ac1e75..cf493684caac 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -40,7 +40,8 @@ module radiation use radiation_state, only: ktop, kbot, nlev_rad use radiation_utils, only: compress_day_columns, expand_day_columns, & handle_error, fluxes_t, & - initialize_fluxes, reset_fluxes, free_fluxes, expand_day_fluxes + initialize_fluxes, reset_fluxes, free_fluxes, expand_day_fluxes, & + get_gas_vmr implicit none private @@ -2287,105 +2288,6 @@ end subroutine output_fluxes_lw !---------------------------------------------------------------------------- - subroutine get_gas_vmr(icall, state, pbuf, gas_names, gas_vmr) - - use physics_types, only: physics_state - use physics_buffer, only: physics_buffer_desc - use rad_constituents, only: rad_cnst_get_gas - - integer, intent(in) :: icall - type(physics_state), intent(in) :: state - type(physics_buffer_desc), pointer :: pbuf(:) - character(len=*), intent(in), dimension(:) :: gas_names - real(r8), intent(out), dimension(:,:,:) :: gas_vmr - - ! Mass mixing ratio - real(r8), pointer :: mmr(:,:) - - ! Gases and molecular weights. Note that we do NOT have CFCs yet (I think - ! this is coming soon in RRTMGP). RRTMGP also allows for absorption due to - ! CO and N2, which RRTMG did not have. - character(len=3), dimension(8) :: gas_species = (/ & - 'H2O', 'CO2', 'O3 ', 'N2O', & - 'CO ', 'CH4', 'O2 ', 'N2 ' & - /) - real(r8), dimension(8) :: mol_weight_gas = (/ & - 18.01528, 44.0095, 47.9982, 44.0128, & - 28.0101, 16.04246, 31.998, 28.0134 & - /) ! g/mol - - ! Molar weight of air - real(r8), parameter :: mol_weight_air = 28.97 ! g/mol - - ! Defaults for gases that are not available (TODO: is this still accurate?) - real(r8), parameter :: co_vol_mix_ratio = 1.0e-7_r8 - real(r8), parameter :: n2_vol_mix_ratio = 0.7906_r8 - - ! Loop indices - integer :: igas - - ! Number of columns - integer :: ncol - - ! Name of subroutine for error messages - character(len=32) :: subname = 'get_gas_vmr' - - ! Number of columns in chunk - ncol = state%ncol - - ! initialize - gas_vmr(:,:,:) = 0._r8 - - ! For each gas species needed for RRTMGP, read the mass mixing ratio from the - ! CAM rad_constituents interface, convert to volume mixing ratios, and - ! subset for daytime-only indices if needed. - do igas = 1,size(gas_names) - - select case(trim(gas_names(igas))) - - case('CO') - - ! CO not available, use default - gas_vmr(igas,1:ncol,1:pver) = co_vol_mix_ratio - - case('N2') - - ! N2 not available, use default - gas_vmr(igas,1:ncol,1:pver) = n2_vol_mix_ratio - - case('H2O') - - ! Water vapor is represented as specific humidity in CAM, so we - ! need to handle water a little differently - call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, mmr) - - ! Convert to volume mixing ratio by multiplying by the ratio of - ! molecular weight of dry air to molecular weight of gas. Note that - ! first specific humidity (held in the mass_mix_ratio array read - ! from rad_constituents) is converted to an actual mass mixing - ! ratio. - gas_vmr(igas,1:ncol,1:pver) = mmr(1:ncol,1:pver) / ( & - 1._r8 - mmr(1:ncol,1:pver) & - ) * mol_weight_air / mol_weight_gas(igas) - - case DEFAULT - - ! Get mass mixing ratio from the rad_constituents interface - call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, mmr) - - ! Convert to volume mixing ratio by multiplying by the ratio of - ! molecular weight of dry air to molecular weight of gas - gas_vmr(igas,1:ncol,1:pver) = mmr(1:ncol,1:pver) & - * mol_weight_air / mol_weight_gas(igas) - - end select - - end do ! igas - - end subroutine get_gas_vmr - - !---------------------------------------------------------------------------- - logical function string_in_list(string, list) character(len=*), intent(in) :: string character(len=*), intent(in) :: list(:) diff --git a/components/eam/src/physics/rrtmgp/radiation_utils.F90 b/components/eam/src/physics/rrtmgp/radiation_utils.F90 index 596ae28223b8..34be77e5ff2e 100644 --- a/components/eam/src/physics/rrtmgp/radiation_utils.F90 +++ b/components/eam/src/physics/rrtmgp/radiation_utils.F90 @@ -10,7 +10,7 @@ module radiation_utils calculate_heating_rate, clip_values, & handle_error, & fluxes_t, initialize_fluxes, reset_fluxes, free_fluxes, & - expand_day_fluxes + expand_day_fluxes, get_gas_vmr ! Interface blocks for overloaded procedures interface compress_day_columns @@ -240,6 +240,107 @@ end subroutine expand_day_columns_2d !------------------------------------------------------------------------------- + subroutine get_gas_vmr(icall, state, pbuf, gas_names, gas_vmr) + + use physics_types, only: physics_state + use physics_buffer, only: physics_buffer_desc + use rad_constituents, only: rad_cnst_get_gas + + integer, intent(in) :: icall + type(physics_state), intent(in) :: state + type(physics_buffer_desc), pointer :: pbuf(:) + character(len=*), intent(in), dimension(:) :: gas_names + real(r8), intent(out), dimension(:,:,:) :: gas_vmr + + ! Mass mixing ratio + real(r8), pointer :: mmr(:,:) + + ! Gases and molecular weights. Note that we do NOT have CFCs yet (I think + ! this is coming soon in RRTMGP). RRTMGP also allows for absorption due to + ! CO and N2, which RRTMG did not have. + character(len=3), dimension(8) :: gas_species = (/ & + 'H2O', 'CO2', 'O3 ', 'N2O', & + 'CO ', 'CH4', 'O2 ', 'N2 ' & + /) + real(r8), dimension(8) :: mol_weight_gas = (/ & + 18.01528, 44.0095, 47.9982, 44.0128, & + 28.0101, 16.04246, 31.998, 28.0134 & + /) ! g/mol + + ! Molar weight of air + real(r8), parameter :: mol_weight_air = 28.97 ! g/mol + + ! Defaults for gases that are not available (TODO: is this still accurate?) + real(r8), parameter :: co_vol_mix_ratio = 1.0e-7_r8 + real(r8), parameter :: n2_vol_mix_ratio = 0.7906_r8 + + ! Loop indices + integer :: igas + + ! Number of columns + integer :: ncol + integer :: nlev + + ! Name of subroutine for error messages + character(len=32) :: subname = 'get_gas_vmr' + + ! Number of columns in chunk + ncol = state%ncol + nlev = size(gas_vmr,3) + + ! initialize + gas_vmr(:,:,:) = 0._r8 + + ! For each gas species needed for RRTMGP, read the mass mixing ratio from the + ! CAM rad_constituents interface, convert to volume mixing ratios, and + ! subset for daytime-only indices if needed. + do igas = 1,size(gas_names) + + select case(trim(gas_names(igas))) + + case('CO') + + ! CO not available, use default + gas_vmr(igas,1:ncol,1:nlev) = co_vol_mix_ratio + + case('N2') + + ! N2 not available, use default + gas_vmr(igas,1:ncol,1:nlev) = n2_vol_mix_ratio + + case('H2O') + + ! Water vapor is represented as specific humidity in CAM, so we + ! need to handle water a little differently + call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, mmr) + + ! Convert to volume mixing ratio by multiplying by the ratio of + ! molecular weight of dry air to molecular weight of gas. Note that + ! first specific humidity (held in the mass_mix_ratio array read + ! from rad_constituents) is converted to an actual mass mixing + ! ratio. + gas_vmr(igas,1:ncol,1:nlev) = mmr(1:ncol,1:nlev) / ( & + 1._r8 - mmr(1:ncol,1:nlev) & + ) * mol_weight_air / mol_weight_gas(igas) + + case DEFAULT + + ! Get mass mixing ratio from the rad_constituents interface + call rad_cnst_get_gas(icall, trim(gas_species(igas)), state, pbuf, mmr) + + ! Convert to volume mixing ratio by multiplying by the ratio of + ! molecular weight of dry air to molecular weight of gas + gas_vmr(igas,1:ncol,1:nlev) = mmr(1:ncol,1:nlev) & + * mol_weight_air / mol_weight_gas(igas) + + end select + + end do ! igas + + end subroutine get_gas_vmr + + !------------------------------------------------------------------------------- + subroutine calculate_heating_rate(flux_up, flux_dn, pint, heating_rate) use physconst, only: gravit From 77f6c6e2e45f7169a363fc111cdf96c7058b6646 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 7 Oct 2020 13:54:22 -0400 Subject: [PATCH 19/71] Fix cmake logic for MMFXX --- components/cmake/common_setup.cmake | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/components/cmake/common_setup.cmake b/components/cmake/common_setup.cmake index 80b489806f69..6c458f15b999 100644 --- a/components/cmake/common_setup.cmake +++ b/components/cmake/common_setup.cmake @@ -42,7 +42,11 @@ if (NOT HAS_RRTMGPXX EQUAL -1) endif() # If samxx or rrtmgpxx is being used, then YAKL must be used as well -set(USE_YAKL ${USE_SAMXX} OR ${USE_RRTMGPXX}) +if (USE_SAMXX OR USE_RRTMGPXX) + set(USE_YAKL TRUE) +else() + set(USE_YAKL FALSE) +endif() # If YAKL is being used, then we need to enable USE_CXX if (${USE_YAKL}) From f3d20a892fd0986198657d3771c3c10cbf2c2345 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 7 Oct 2020 13:55:46 -0400 Subject: [PATCH 20/71] Fix bugs from rebase --- components/eam/src/physics/crm/rrtmgp/radiation.F90 | 5 +++++ components/eam/src/physics/rrtmgp/radiation.F90 | 10 +++++++--- components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 | 5 ++++- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 389b54d15977..8abd9f535690 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -2471,6 +2471,11 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) ! "infrared" based on wavenumber, so we get the wavenumber limits here call get_sw_spectral_boundaries(lower_bounds, upper_bounds, 'cm^-1') + ! We need to reorder the spectral bounds since we store them in RRTMG + ! order in radconstants! + lower_bounds = reordered(lower_bounds, rrtmg_to_rrtmgp_swbands) + upper_bounds = reordered(upper_bounds, rrtmg_to_rrtmgp_swbands) + ! Loop over bands, and determine for each band whether it is broadly in the ! visible or infrared part of the spectrum (visible or "not visible") do iband = 1,nswbands diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index cf493684caac..3802ba36d71f 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1389,13 +1389,12 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & call get_gas_vmr(icall, state, pbuf, active_gases, gas_vmr) call t_stopf('rad_gas_concentrations_sw') ! Get aerosol optics + aer_tau_bnd_lw = 0._r8 if (do_aerosol_rad) then call t_startf('rad_aer_optics_lw') aer_tau_bnd_lw = 0._r8 call aer_rad_props_lw(is_cmip6_volc, icall, dt, state, pbuf, aer_tau_bnd_lw) call t_stopf('rad_aer_optics_lw') - else - aer_tau_bnd_lw = 0 end if ! Check (and possibly clip) values before passing to RRTMGP driver @@ -1620,7 +1619,6 @@ subroutine radiation_driver_sw(ncol, & fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & - !fluxes_allsky_day, fluxes_clrsky_day, & tsi_scaling & ) call t_stopf('rad_calculations_sw') @@ -1777,6 +1775,7 @@ subroutine radiation_driver_lw(ncol, & surface_emissivity(1:nlwbands,1:ncol) = 1.0_r8 ! Add an empty level above model top + ! TODO: handle gases here too cld_tau_gpt_rad = 0 cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt(:,:,:) aer_tau_bnd_rad = 0 @@ -2091,6 +2090,11 @@ subroutine set_albedo(cam_in, albedo_dir, albedo_dif) ! "infrared" based on wavenumber, so we get the wavenumber limits here call get_sw_spectral_boundaries(lower_bounds, upper_bounds, 'cm^-1') + ! We need to reorder the spectral bounds since we store them in RRTMG + ! order in radconstants! + lower_bounds = reordered(lower_bounds, rrtmg_to_rrtmgp_swbands) + upper_bounds = reordered(upper_bounds, rrtmg_to_rrtmgp_swbands) + ! Loop over bands, and determine for each band whether it is broadly in the ! visible or infrared part of the spectrum (visible or "not visible") do iband = 1,nswbands diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index c4548cf738dd..d1c1d3018030 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -177,6 +177,9 @@ subroutine rrtmgp_run_sw( & aer_optics_sw%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) aer_optics_sw%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) + ! Apply delta scaling to account for forward-scattering + call handle_error(aer_optics_sw%delta_scale()) + ! Set gas concentrations call t_startf('rad_set_gases_sw') call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) @@ -257,7 +260,6 @@ subroutine rrtmgp_run_lw( & call t_startf('longwave cloud optics') call handle_error(cld_optics%alloc_1scl(ncol, nlev, k_dist_lw, name='longwave cloud optics')) cld_optics%tau = 0.0 - !cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,1:pver,:) cld_optics%tau(1:ncol,1:nlev,:) = cld_tau_gpt(1:ncol,1:nlev,:) call handle_error(cld_optics%delta_scale()) call t_stopf('longwave cloud optics') @@ -274,6 +276,7 @@ subroutine rrtmgp_run_lw( & aer_optics%tau = 0 !aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) aer_optics%tau(1:ncol,1:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:nlev,1:nlwbands) + call handle_error(aer_optics%delta_scale()) ! Do longwave radiative transfer calculations call handle_error(rte_lw( & From 2c7ce6d4323a2f39f20e573d6b4f9c82ea0dbe88 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 23 Oct 2020 17:04:29 -0600 Subject: [PATCH 21/71] Start building C++ bridge --- components/cmake/build_model.cmake | 17 +- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 446 ++++++++++++++++++ .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 31 ++ 3 files changed, 488 insertions(+), 6 deletions(-) create mode 100644 components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 create mode 100644 components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 851c7eaf7b8f..418eec69cf05 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -109,11 +109,16 @@ function(build_model COMP_CLASS COMP_NAME) if (USE_RRTMGPXX) message(STATUS "Building RRTMGPXX") # Build rrtmgpxx as a library - set(RRTMGPXX_HOME ${CMAKE_CURRENT_SOURCE_DIR}/../../cam/src/physics/rrtmgp/external/cpp) - set(RRTMGPXX_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgpxx) - add_subdirectory(${RRTMGPXX_HOME} ${RRTMGPXX_BIN}) - # Add samxx F90 files to the main E3SM build - #set(SOURCES ${SOURCES} cmake/atm/../../cam/src/physics/crm/rrtmgpxx/cpp_interface_mod.F90) + set(RRTMGPXX_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgpxx) + add_subdirectory( + ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp + ${RRTMGPXX_BIN}) + # Add files to the main E3SM build + #set(SOURCES ${SOURCES} cmake/atm/../../eam/src/physics/crm/rrtmgpxx/cpp_interface_mod.F90) + set(SOURCES ${SOURCES} + cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 + cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp + ) endif() endif() @@ -259,7 +264,7 @@ function(build_model COMP_CLASS COMP_NAME) target_link_libraries(${TARGET_NAME} PRIVATE samxx) endif() if (USE_RRTMGPXX) - target_link_libraries(${TARGET_NAME} rrtmgp) + target_link_libraries(${TARGET_NAME} PRIVATE rrtmgp) endif() endif() if (USE_KOKKOS) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 new file mode 100644 index 000000000000..28476cc3802a --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -0,0 +1,446 @@ +! Module to bridge the gap between the Fortran and C++ implemenations of +! RRTMGP. Remove class references from function calls, and handle all of that +! here. This is necessary because radiation_tend will remain in F90 (to deal +! with E3SM data types), but we will switch to C++ for the underlying RRTMGP +! code. +module rrtmgpxx_interface + + use perf_mod, only: t_startf, t_stopf + use ppgrid, only: pcols, pver, pverp, begchunk, endchunk + use radiation_utils, only: compress_day_columns, expand_day_columns + use radiation_state, only: ktop, kbot, nlev_rad + + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_load_coefficients, only: load_and_init + use mo_rte_kind, only: wp + use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_rrtmgp_clr_all_sky, only: rte_sw, rte_lw + use iso_c_binding + + implicit none + + private + + ! Gas optics objects that hold k-distribution information. These are made + ! module variables because we only want to initialize them once at init time. + type(ty_gas_optics_rrtmgp) :: k_dist_sw, k_dist_lw + + ! Make these module variables so that we do not have to provide access to + ! k_dist objects; this just makes it easier to switch between F90 and C++ + ! interfaces. + integer, public :: nswbands, nlwbands, nswgpts, nlwgpts + + public :: & + rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & + get_nbnds_sw, get_nbnds_lw, & + get_ngpts_sw, get_ngpts_lw, & + get_gpoint_bands_sw, get_gpoint_bands_lw, & + get_min_temperature, get_max_temperature + + interface + function get_nbands_sw() bind(C,name="get_nbands_sw") + use iso_c_binding + implicit none + integer(c_int) :: get_nbands_sw + end function + + function get_nbands_lw() bind(C,name="get_nbands_lw") + use iso_c_binding + implicit none + integer(c_int) :: get_nbands_lw + end function + end interface + +contains + + integer function get_nbnds_sw() + get_nbnds_sw = k_dist_sw%get_nband() + end function get_nbnds_sw + + integer function get_nbnds_lw() + get_nbnds_lw = k_dist_lw%get_nband() + end function get_nbnds_lw + + integer function get_ngpts_sw() + get_ngpts_sw = k_dist_sw%get_ngpt() + end function get_ngpts_sw + + integer function get_ngpts_lw() + get_ngpts_lw = k_dist_lw%get_ngpt() + end function get_ngpts_lw + + function get_gpoint_bands_sw() result(gpoint_bands) + integer, dimension(nswgpts) :: gpoint_bands + gpoint_bands = k_dist_sw%get_gpoint_bands() + end function get_gpoint_bands_sw + + function get_gpoint_bands_lw() result(gpoint_bands) + integer, dimension(nlwgpts) :: gpoint_bands + gpoint_bands = k_dist_lw%get_gpoint_bands() + end function get_gpoint_bands_lw + + subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) + character(len=*), intent(in) :: active_gases(:) + character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw + type(ty_gas_concs) :: available_gases + ! Read gas optics coefficients from file + ! Need to initialize available_gases here! The only field of the + ! available_gases type that is used int he kdist initialize is + ! available_gases%gas_name, which gives the name of each gas that would be + ! present in the ty_gas_concs object. So, we can just set this here, rather + ! than trying to fully populate the ty_gas_concs object here, which would be + ! impossible from this initialization routine because I do not thing the + ! rad_cnst objects are setup yet. + ! the other tasks! + ! TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast + call set_available_gases(active_gases, available_gases) + call load_and_init(k_dist_sw, coefficients_file_sw, available_gases) + call load_and_init(k_dist_lw, coefficients_file_lw, available_gases) + ! Set number of bands based on what we read in from input data + nswbands = k_dist_sw%get_nband() + nlwbands = k_dist_lw%get_nband() + ! Number of gpoints depend on inputdata, so initialize here + nswgpts = k_dist_sw%get_ngpt() + nlwgpts = k_dist_lw%get_ngpt() + end subroutine rrtmgp_initialize + + subroutine rrtmgp_run_sw( & + ngas, ncol, nlev, & + gas_names, gas_vmr, & + pmid, tmid, pint, coszrs, & + albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & + tsi_scaling & + ) + integer, intent(in) :: ngas, ncol, nlev + character(len=*), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr + real(wp), intent(in), dimension(:,:) :: & + pmid, tmid, pint + real(wp), intent(in), dimension(:) :: coszrs + real(wp), intent(in), dimension(:,:) :: albedo_dir, albedo_dif + real(wp), intent(in), dimension(:,:,:) :: & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd + real(wp), intent(inout), target, dimension(:,:) :: & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir + real(wp), intent(inout), target, dimension(:,:,:) :: & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir + real(wp), intent(in) :: tsi_scaling + + type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky + type(ty_gas_concs) :: gas_concentrations + type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw + + ! Loop indices + integer :: iband, igas, iday, icol + + ! Allocate shortwave fluxes (allsky and clearsky) + fluxes_allsky%flux_up => allsky_flux_up + fluxes_allsky%flux_dn => allsky_flux_dn + fluxes_allsky%flux_net => allsky_flux_net + fluxes_allsky%flux_dn_dir => allsky_flux_dn_dir + fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up + fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn + fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net + fluxes_allsky%bnd_flux_dn_dir => allsky_bnd_flux_dn_dir + fluxes_clrsky%flux_up => clrsky_flux_up + fluxes_clrsky%flux_dn => clrsky_flux_dn + fluxes_clrsky%flux_net => clrsky_flux_net + fluxes_clrsky%flux_dn_dir => clrsky_flux_dn_dir + fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up + fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn + fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net + fluxes_clrsky%bnd_flux_dn_dir => clrsky_bnd_flux_dn_dir + + ! Populate RRTMGP optics + call handle_error(cld_optics_sw%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) + cld_optics_sw%tau = 0 + cld_optics_sw%ssa = 1 + cld_optics_sw%g = 0 + cld_optics_sw%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) + cld_optics_sw%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) + cld_optics_sw%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) + + ! Apply delta scaling to account for forward-scattering + call handle_error(cld_optics_sw%delta_scale()) + + ! Initialize aerosol optics; passing only the wavenumber bounds for each + ! "band" rather than passing the full spectral discretization object, and + ! omitting the "g-point" mapping forces the optics to be indexed and + ! stored by band rather than by g-point. This is most consistent with our + ! treatment of aerosol optics in the model, and prevents us from having to + ! map bands to g-points ourselves since that will all be handled by the + ! private routines internal to the optics class. + call handle_error(aer_optics_sw%alloc_2str( & + ncol, nlev, k_dist_sw%get_band_lims_wavenumber(), & + name='shortwave aerosol optics' & + )) + aer_optics_sw%tau = 0 + aer_optics_sw%ssa = 1 + aer_optics_sw%g = 0 + aer_optics_sw%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) + aer_optics_sw%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) + aer_optics_sw%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) + + ! Apply delta scaling to account for forward-scattering + call handle_error(aer_optics_sw%delta_scale()) + + ! Set gas concentrations + call t_startf('rad_set_gases_sw') + call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + call t_stopf('rad_set_gases_sw') + + call handle_error(rte_sw( & + k_dist_sw, gas_concentrations, & + pmid(1:ncol,1:nlev), & + tmid(1:ncol,1:nlev), & + pint(1:ncol,1:nlev+1), & + coszrs(1:ncol), & + albedo_dir(1:nswbands,1:ncol), & + albedo_dif(1:nswbands,1:ncol), & + cld_optics_sw, & + fluxes_allsky, fluxes_clrsky, & + aer_props=aer_optics_sw, & + tsi_scaling=tsi_scaling & + )) + + ! Clean up after ourselves + call free_optics_sw(cld_optics_sw) + call free_optics_sw(aer_optics_sw) + + end subroutine rrtmgp_run_sw + + + subroutine rrtmgp_run_lw( & + ngas, ncol, nlev, & + gas_names, gas_vmr, & + surface_emissivity, & + pmid, tmid, pint, tint, & + cld_tau_gpt, aer_tau_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net & + ) + + integer, intent(in) :: ngas, ncol, nlev + character(len=*), intent(in), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr + real(wp), intent(in), dimension(:,:) :: surface_emissivity + real(wp), intent(in), dimension(:,:) :: pmid, tmid, pint, tint + real(wp), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd + real(wp), intent(inout), dimension(:,:), target :: & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net + real(wp), intent(inout), dimension(:,:,:), target :: & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net + + type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky + + type(ty_gas_concs) :: gas_concentrations + type(ty_optical_props_1scl) :: cld_optics, aer_optics + + + ! Allocate fluxes (allsky and clearsky) + fluxes_allsky%flux_up => allsky_flux_up + fluxes_allsky%flux_dn => allsky_flux_dn + fluxes_allsky%flux_net => allsky_flux_net + fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up + fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn + fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net + fluxes_clrsky%flux_up => clrsky_flux_up + fluxes_clrsky%flux_dn => clrsky_flux_dn + fluxes_clrsky%flux_net => clrsky_flux_net + fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up + fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn + fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net + + ! Setup gas concentrations object + call t_startf('rad_gas_concentrations_lw') + call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + call t_stopf('rad_gas_concentrations_lw') + + ! Populate RRTMGP optics + call t_startf('longwave cloud optics') + call handle_error(cld_optics%alloc_1scl(ncol, nlev, k_dist_lw, name='longwave cloud optics')) + cld_optics%tau = 0.0 + cld_optics%tau(1:ncol,1:nlev,:) = cld_tau_gpt(1:ncol,1:nlev,:) + call handle_error(cld_optics%delta_scale()) + call t_stopf('longwave cloud optics') + + ! Initialize aerosol optics; passing only the wavenumber bounds for each + ! "band" rather than passing the full spectral discretization object, and + ! omitting the "g-point" mapping forces the optics to be indexed and + ! stored by band rather than by g-point. This is most consistent with our + ! treatment of aerosol optics in the model, and prevents us from having to + ! map bands to g-points ourselves since that will all be handled by the + ! private routines internal to the optics class. + call handle_error(aer_optics%alloc_1scl(ncol, nlev, k_dist_lw%get_band_lims_wavenumber())) + call aer_optics%set_name('longwave aerosol optics') + aer_optics%tau = 0 + !aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) + aer_optics%tau(1:ncol,1:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:nlev,1:nlwbands) + call handle_error(aer_optics%delta_scale()) + + ! Do longwave radiative transfer calculations + call handle_error(rte_lw( & + k_dist_lw, gas_concentrations, & + pmid(1:ncol,1:nlev), tmid(1:ncol,1:nlev), & + pint(1:ncol,1:nlev+1), tint(1:ncol,nlev+1), & + surface_emissivity(1:nlwbands,1:ncol), & + cld_optics, & + fluxes_allsky, fluxes_clrsky, & + aer_props=aer_optics, & + t_lev=tint(1:ncol,1:nlev+1), & + n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG + )) + + end subroutine rrtmgp_run_lw + + real(wp) function get_min_temperature() + get_min_temperature = min(k_dist_sw%get_temp_min(), k_dist_lw%get_temp_min()) + end function get_min_temperature + + real(wp) function get_max_temperature() + get_max_temperature = max(k_dist_sw%get_temp_max(), k_dist_lw%get_temp_max()) + end function get_max_temperature + + ! -------------------------------------------------------------------------- + ! Private routines + ! -------------------------------------------------------------------------- + + subroutine set_available_gases(gases, gas_concentrations) + + use mo_gas_concentrations, only: ty_gas_concs + use mo_rrtmgp_util_string, only: lower_case + + type(ty_gas_concs), intent(inout) :: gas_concentrations + character(len=*), intent(in) :: gases(:) + character(len=32), dimension(size(gases)) :: gases_lowercase + integer :: igas + + ! Initialize with lowercase gas names; we should work in lowercase + ! whenever possible because we cannot trust string comparisons in RRTMGP + ! to be case insensitive + do igas = 1,size(gases) + gases_lowercase(igas) = trim(lower_case(gases(igas))) + end do + call handle_error(gas_concentrations%init(gases_lowercase)) + + end subroutine set_available_gases + + !---------------------------------------------------------------------------- + + subroutine free_optics_sw(optics) + use mo_optical_props, only: ty_optical_props_2str + type(ty_optical_props_2str), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + if (allocated(optics%ssa)) deallocate(optics%ssa) + if (allocated(optics%g)) deallocate(optics%g) + call optics%finalize() + end subroutine free_optics_sw + + !---------------------------------------------------------------------------- + + subroutine free_optics_lw(optics) + use mo_optical_props, only: ty_optical_props_1scl + type(ty_optical_props_1scl), intent(inout) :: optics + if (allocated(optics%tau)) deallocate(optics%tau) + call optics%finalize() + end subroutine free_optics_lw + + !---------------------------------------------------------------------------- + + ! Compress optics arrays to smaller arrays containing only daytime columns. + ! This is to work with the RRTMGP shortwave routines that will fail if they + ! encounter non-sunlit columns, and also allows us to perform less + ! computations. This routine is primarily a convenience routine to do all of + ! the shortwave optics arrays at once, as we do this for individual arrays + ! elsewhere in the code. + subroutine compress_optics_sw(day_indices, tau, ssa, asm, tau_day, ssa_day, asm_day) + integer, intent(in), dimension(:) :: day_indices + real(wp), intent(in), dimension(:,:,:) :: tau, ssa, asm + real(wp), intent(out), dimension(:,:,:) :: tau_day, ssa_day, asm_day + integer :: nday, iday, ilev, ibnd + nday = count(day_indices > 0) + do ibnd = 1,size(tau,3) + do ilev = 1,size(tau,2) + do iday = 1,nday + tau_day(iday,ilev,ibnd) = tau(day_indices(iday),ilev,ibnd) + ssa_day(iday,ilev,ibnd) = ssa(day_indices(iday),ilev,ibnd) + asm_day(iday,ilev,ibnd) = asm(day_indices(iday),ilev,ibnd) + end do + end do + end do + end subroutine compress_optics_sw + + + subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + use mo_gas_concentrations, only: ty_gas_concs + use mo_rrtmgp_util_string, only: lower_case + + integer, intent(in) :: ncol + character(len=*), intent(in), dimension(:) :: gas_names + real(wp), intent(in), dimension(:,:,:) :: gas_vmr + type(ty_gas_concs), intent(out) :: gas_concentrations + + ! Local variables + real(wp), dimension(ncol,nlev_rad) :: vol_mix_ratio_out + + ! Loop indices + integer :: igas + + ! Character array to hold lowercase gas names + character(len=32), allocatable :: gas_names_lower(:) + + ! Name of subroutine for error messages + character(len=32) :: subname = 'set_gas_concentrations' + + ! Initialize gas concentrations with lower case names + allocate(gas_names_lower(size(gas_names))) + do igas = 1,size(gas_names) + gas_names_lower(igas) = trim(lower_case(gas_names(igas))) + end do + call handle_error(gas_concentrations%init(gas_names_lower)) + + ! For each gas, add level above model top and set values in RRTMGP object + do igas = 1,size(gas_names) + vol_mix_ratio_out = 0 + ! Map to radiation grid + vol_mix_ratio_out(1:ncol,ktop:kbot) = gas_vmr(igas,1:ncol,1:pver) + ! Copy top-most model level to top-most rad level (which could be above + ! the top of the model) + vol_mix_ratio_out(1:ncol,1) = gas_vmr(igas,1:ncol,1) + ! Set volumn mixing ratio in gas concentration object for just columns + ! in this chunk + call handle_error(gas_concentrations%set_vmr( & + trim(lower_case(gas_names(igas))), vol_mix_ratio_out(1:ncol,1:nlev_rad)) & + ) + end do + + end subroutine set_gas_concentrations + + !---------------------------------------------------------------------------- + + ! Stop run ungracefully since we don't want dependencies on E3SM abortutils + ! here + subroutine handle_error(msg) + character(len=*), intent(in) :: msg + if (trim(msg) .ne. '') then + print *, trim(msg) + stop + end if + end subroutine handle_error + +end module rrtmgpxx_interface diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp new file mode 100644 index 000000000000..8d4f703793a7 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -0,0 +1,31 @@ +#include "mo_gas_concentrations.h" +#include "mo_gas_optics_rrtmgp.h" +#include "mo_load_coefficients.h" +#include "const.h" + +GasOpticsRRTMGP k_dist_sw; +GasOpticsRRTMGP k_dist_lw; + +// Hardcode gases for now; TODO: fix this!!!! +// Convert to string1d +const char *active_gases[8] = { + "H2O", "CO2", "O3 ", "N2O", + "CO ", "CH4", "O2 ", "N2 " +}; + +void rrtmgp_initialize(char const *coefficients_file_sw, char const *coefficients_file_lw) { + // Read gas optics coefficients from file + // Need to initialize available_gases here! The only field of the + // available_gases type that is used int he kdist initialize is + // available_gases%gas_name, which gives the name of each gas that would be + // present in the ty_gas_concs object. So, we can just set this here, rather + // than trying to fully populate the ty_gas_concs object here, which would be + // impossible from this initialization routine because I do not thing the + // rad_cnst objects are setup yet. + // the other tasks! + // TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast + //gas_names = string1d("gas_names", 8); + GasConcs available_gases; + load_and_init(k_dist_sw, coefficients_file_sw, available_gases); + load_and_init(k_dist_lw, coefficients_file_lw, available_gases); +} From 7de353505db2e2aed53fb49826062b232b8d644d Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 9 Dec 2020 13:30:33 -0700 Subject: [PATCH 22/71] Call radiation finalize --- components/eam/src/physics/cam/physpkg.F90 | 5 ++ .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 51 ++++++++++---- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 66 +++++++++++++++++-- .../eam/src/physics/rrtmgp/radiation.F90 | 9 +++ 4 files changed, 112 insertions(+), 19 deletions(-) diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90 index f92886a29b1c..50a2abaf30a8 100644 --- a/components/eam/src/physics/cam/physpkg.F90 +++ b/components/eam/src/physics/cam/physpkg.F90 @@ -1347,6 +1347,7 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) use physics_buffer, only : physics_buffer_desc, pbuf_deallocate use chemistry, only : chem_final use wv_saturation, only : wv_sat_final + use radiation, only: radiation_final !----------------------------------------------------------------------- ! ! Purpose: @@ -1373,6 +1374,10 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) call wv_sat_final call t_stopf ('wv_sat_final') + call t_startf ('radiation_final') + call radiation_final() + call t_stopf ('radiation_final') + call t_startf ('print_cost_p') call print_cost_p call t_stopf ('print_cost_p') diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 28476cc3802a..b6550703d538 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -33,13 +33,14 @@ module rrtmgpxx_interface integer, public :: nswbands, nlwbands, nswgpts, nlwgpts public :: & - rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & - get_nbnds_sw, get_nbnds_lw, & + rrtmgpxx_initialize, rrtmgpxx_finalize, rrtmgp_run_sw, rrtmgp_run_lw, & + get_nbands_sw, get_nbands_lw, & get_ngpts_sw, get_ngpts_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & get_min_temperature, get_max_temperature interface + function get_nbands_sw() bind(C,name="get_nbands_sw") use iso_c_binding implicit none @@ -51,17 +52,24 @@ function get_nbands_lw() bind(C,name="get_nbands_lw") implicit none integer(c_int) :: get_nbands_lw end function - end interface -contains + subroutine rrtmgpxx_initialize_cpp(coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") + use iso_c_binding, only: C_CHAR, C_NULL_CHAR + character(kind=c_char) :: coefficients_file_sw(*) + character(kind=c_char) :: coefficients_file_lw(*) + end subroutine rrtmgpxx_initialize_cpp + + subroutine rrtmgpxx_finalize() bind(C, name="rrtmgpxx_finalize") + end subroutine rrtmgpxx_finalize - integer function get_nbnds_sw() - get_nbnds_sw = k_dist_sw%get_nband() - end function get_nbnds_sw + subroutine add_gas_name(gas_name) bind(C, name="add_gas_name") + use iso_c_binding, only: C_CHAR + character(kind=c_char) :: gas_name + end subroutine add_gas_name - integer function get_nbnds_lw() - get_nbnds_lw = k_dist_lw%get_nband() - end function get_nbnds_lw + end interface + +contains integer function get_ngpts_sw() get_ngpts_sw = k_dist_sw%get_ngpt() @@ -81,7 +89,8 @@ function get_gpoint_bands_lw() result(gpoint_bands) gpoint_bands = k_dist_lw%get_gpoint_bands() end function get_gpoint_bands_lw - subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) + subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) + use iso_c_binding, only: C_CHAR, C_NULL_CHAR character(len=*), intent(in) :: active_gases(:) character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw type(ty_gas_concs) :: available_gases @@ -104,7 +113,15 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi ! Number of gpoints depend on inputdata, so initialize here nswgpts = k_dist_sw%get_ngpt() nlwgpts = k_dist_lw%get_ngpt() - end subroutine rrtmgp_initialize + ! Add active gases + call add_gases(active_gases) + ! Initialize RRTMGP + call rrtmgpxx_initialize_cpp( & + C_CHAR_""//trim(coefficients_file_sw)//C_NULL_CHAR, & + C_CHAR_""//trim(coefficients_file_lw)//C_NULL_CHAR & + ) + end subroutine rrtmgpxx_initialize + subroutine rrtmgp_run_sw( & ngas, ncol, nlev, & @@ -340,6 +357,16 @@ subroutine set_available_gases(gases, gas_concentrations) end subroutine set_available_gases + subroutine add_gases(gases) + use mo_rrtmgp_util_string, only: lower_case + use iso_c_binding, only: C_CHAR, C_NULL_CHAR + character(len=*), intent(in) :: gases(:) + integer :: igas + do igas = 1,size(gases) + call add_gas_name(trim(lower_case(gases(igas)))//C_NULL_CHAR) + end do + end subroutine add_gases + !---------------------------------------------------------------------------- subroutine free_optics_sw(optics) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index 8d4f703793a7..da5726d3c521 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -3,17 +3,28 @@ #include "mo_load_coefficients.h" #include "const.h" +// Prototypes +extern "C" void add_gas_name(char const *gas_name); +extern "C" void convert_gas_names(string1d &gas_names); +extern "C" void vect_to_string1d(std::vector vect, string1d strarr); +extern "C" int get_nbands_sw(); +extern "C" int get_nbands_lw(); +extern "C" void rrtmgpxx_finalize(); + GasOpticsRRTMGP k_dist_sw; GasOpticsRRTMGP k_dist_lw; -// Hardcode gases for now; TODO: fix this!!!! -// Convert to string1d -const char *active_gases[8] = { - "H2O", "CO2", "O3 ", "N2O", - "CO ", "CH4", "O2 ", "N2 " -}; +// Vector of strings to hold active gas names. +// These need to be added at runtime, one by one, +// via the add_gas_name function. +std::vector gas_names_vect; + +extern "C" void rrtmgpxx_initialize_cpp(char const *coefficients_file_sw, char const *coefficients_file_lw) { + // First, make sure yakl has been initialized + if (!yakl::isInitialized()) { + yakl::init(); + } -void rrtmgp_initialize(char const *coefficients_file_sw, char const *coefficients_file_lw) { // Read gas optics coefficients from file // Need to initialize available_gases here! The only field of the // available_gases type that is used int he kdist initialize is @@ -25,7 +36,48 @@ void rrtmgp_initialize(char const *coefficients_file_sw, char const *coefficient // the other tasks! // TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast //gas_names = string1d("gas_names", 8); + // + // Let us cheat for a moment and hard-code the gases. + // TODO: fix this! + string1d gas_names("gas_names", gas_names_vect.size()); + convert_gas_names(gas_names); GasConcs available_gases; + available_gases.init(gas_names, 1, 1); load_and_init(k_dist_sw, coefficients_file_sw, available_gases); load_and_init(k_dist_lw, coefficients_file_lw, available_gases); } + +extern "C" void rrtmgpxx_finalize() { + k_dist_sw.finalize(); + k_dist_lw.finalize(); + yakl::finalize(); +} + +extern "C" void add_gas_name(char const *gas_name) { + gas_names_vect.push_back(std::string(gas_name)); +} + +extern "C" void convert_gas_names(string1d &gas_names) { + int ngas = gas_names_vect.size(); + if (ngas == 0) { + throw "No active gases; are you sure you initialized gas_names_vect?"; + } + for (int i = 1; i <= ngas; i++) { + gas_names(i) = gas_names_vect[i-1]; + } +} + +extern "C" void vect_to_string1d(std::vector vect, string1d strarr) { + int n = vect.size(); + for (int i = 0; i < n; i++) { + strarr(i+1) = vect[i]; + } +} + +extern "C" int get_nbands_sw() { + return k_dist_sw.get_nband(); +} + +extern "C" int get_nbands_lw() { + return k_dist_lw.get_nband(); +} diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 3802ba36d71f..fc47d5b35b29 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -33,6 +33,8 @@ module radiation rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts + use rrtmgpxx_interface, only: & + rrtmgpxx_initialize, rrtmgpxx_finalize, get_nbands_sw, get_nbands_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -65,6 +67,7 @@ module radiation radiation_nextsw_cday, &! calendar day of next radiation calculation radiation_do, &! query which radiation calcs are done this timestep radiation_init, &! calls radini + radiation_final, &! Deallocate memory, finalize yakl radiation_readnl, &! read radiation namelist radiation_tend ! moved from radctl.F90 @@ -481,10 +484,13 @@ subroutine radiation_init(state) ! Setup the RRTMGP interface call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) + call rrtmgpxx_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) ! Make sure number of bands in absorption coefficient files matches what we expect call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') + !call assert(nswbands == get_nbands_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') + !call assert(nlwbands == get_nbands_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL @@ -872,6 +878,9 @@ subroutine radiation_init(state) end subroutine radiation_init + subroutine radiation_final() + call rrtmgpxx_finalize() + end subroutine radiation_final subroutine perturbation_growth_init() From 987dbd79c05fa2d1c018de8738d2bf34f0847bfe Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 9 Dec 2020 14:17:57 -0700 Subject: [PATCH 23/71] Add get_ngpt routines --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 32 +++++++++++-------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 18 ++++++++--- .../eam/src/physics/rrtmgp/radiation.F90 | 11 +++++-- 3 files changed, 40 insertions(+), 21 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index b6550703d538..a12469ffc495 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -34,23 +34,35 @@ module rrtmgpxx_interface public :: & rrtmgpxx_initialize, rrtmgpxx_finalize, rrtmgp_run_sw, rrtmgp_run_lw, & - get_nbands_sw, get_nbands_lw, & - get_ngpts_sw, get_ngpts_lw, & + get_nband_sw, get_nband_lw, & + get_ngpt_sw, get_ngpt_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & get_min_temperature, get_max_temperature interface - function get_nbands_sw() bind(C,name="get_nbands_sw") + function get_nband_sw() bind(C,name="get_nband_sw") use iso_c_binding implicit none - integer(c_int) :: get_nbands_sw + integer(c_int) :: get_nband_sw end function - function get_nbands_lw() bind(C,name="get_nbands_lw") + function get_nband_lw() bind(C,name="get_nband_lw") use iso_c_binding implicit none - integer(c_int) :: get_nbands_lw + integer(c_int) :: get_nband_lw + end function + + function get_ngpt_sw() bind(C, name="get_ngpt_sw") + use iso_c_binding + implicit none + integer(c_int) :: get_ngpt_sw + end function + + function get_ngpt_lw() bind(C, name="get_ngpt_lw") + use iso_c_binding + implicit none + integer(c_int) :: get_ngpt_lw end function subroutine rrtmgpxx_initialize_cpp(coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") @@ -71,14 +83,6 @@ end subroutine add_gas_name contains - integer function get_ngpts_sw() - get_ngpts_sw = k_dist_sw%get_ngpt() - end function get_ngpts_sw - - integer function get_ngpts_lw() - get_ngpts_lw = k_dist_lw%get_ngpt() - end function get_ngpts_lw - function get_gpoint_bands_sw() result(gpoint_bands) integer, dimension(nswgpts) :: gpoint_bands gpoint_bands = k_dist_sw%get_gpoint_bands() diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index da5726d3c521..0a8d516c0ed8 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -7,8 +7,10 @@ extern "C" void add_gas_name(char const *gas_name); extern "C" void convert_gas_names(string1d &gas_names); extern "C" void vect_to_string1d(std::vector vect, string1d strarr); -extern "C" int get_nbands_sw(); -extern "C" int get_nbands_lw(); +extern "C" int get_nband_sw(); +extern "C" int get_nband_lw(); +extern "C" int get_ngpt_sw(); +extern "C" int get_ngpt_lw(); extern "C" void rrtmgpxx_finalize(); GasOpticsRRTMGP k_dist_sw; @@ -74,10 +76,18 @@ extern "C" void vect_to_string1d(std::vector vect, string1d strarr) } } -extern "C" int get_nbands_sw() { +extern "C" int get_nband_sw() { return k_dist_sw.get_nband(); } -extern "C" int get_nbands_lw() { +extern "C" int get_nband_lw() { return k_dist_lw.get_nband(); } + +extern "C" int get_ngpt_sw() { + return k_dist_sw.get_ngpt(); +} + +extern "C" int get_ngpt_lw() { + return k_dist_lw.get_ngpt(); +} diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index fc47d5b35b29..9fa3bce5925d 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -34,7 +34,8 @@ module radiation get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts use rrtmgpxx_interface, only: & - rrtmgpxx_initialize, rrtmgpxx_finalize, get_nbands_sw, get_nbands_lw + rrtmgpxx_initialize, rrtmgpxx_finalize, get_nband_sw, get_nband_lw, & + get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -489,8 +490,12 @@ subroutine radiation_init(state) ! Make sure number of bands in absorption coefficient files matches what we expect call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') - !call assert(nswbands == get_nbands_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') - !call assert(nlwbands == get_nbands_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') + call assert(nswbands == get_nband_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') + call assert(nlwbands == get_nband_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') + + ! Check that gpoints are consistent after initialization + call assert(nswgpts == get_ngpt_sw(), 'nswgpts does not match RRTMGPXX absorption coefficient data') + call assert(nlwgpts == get_ngpt_lw(), 'nlwgpts does not match RRTMGPXX absorption coefficient data') ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL From ad561dfdd9cf12c055d278a89f50373865f4690f Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 9 Dec 2020 16:52:24 -0700 Subject: [PATCH 24/71] get_gpoint_bands to c++ --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 42 +++++++++++-------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 26 ++++++++++++ .../eam/src/physics/rrtmgp/radiation.F90 | 17 +++++++- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 12 +++--- 4 files changed, 71 insertions(+), 26 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index a12469ffc495..d01d19966df6 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -65,6 +65,30 @@ function get_ngpt_lw() bind(C, name="get_ngpt_lw") integer(c_int) :: get_ngpt_lw end function + function get_min_temperature() bind(C, name="get_min_temperature") + use iso_c_binding + implicit none + real(c_double) :: get_min_temperature + end function + + function get_max_temperature() bind(C, name="get_max_temperature") + use iso_c_binding + implicit none + real(c_double) :: get_max_temperature + end function + + subroutine get_gpoint_bands_sw(gpoint_bands) bind(C, name="get_gpoint_bands_sw") + use iso_c_binding + implicit none + integer(c_int), dimension(*) :: gpoint_bands + end subroutine + + subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") + use iso_c_binding + implicit none + integer(c_int), dimension(*) :: gpoint_bands + end subroutine + subroutine rrtmgpxx_initialize_cpp(coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") use iso_c_binding, only: C_CHAR, C_NULL_CHAR character(kind=c_char) :: coefficients_file_sw(*) @@ -83,16 +107,6 @@ end subroutine add_gas_name contains - function get_gpoint_bands_sw() result(gpoint_bands) - integer, dimension(nswgpts) :: gpoint_bands - gpoint_bands = k_dist_sw%get_gpoint_bands() - end function get_gpoint_bands_sw - - function get_gpoint_bands_lw() result(gpoint_bands) - integer, dimension(nlwgpts) :: gpoint_bands - gpoint_bands = k_dist_lw%get_gpoint_bands() - end function get_gpoint_bands_lw - subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) use iso_c_binding, only: C_CHAR, C_NULL_CHAR character(len=*), intent(in) :: active_gases(:) @@ -329,14 +343,6 @@ subroutine rrtmgp_run_lw( & end subroutine rrtmgp_run_lw - real(wp) function get_min_temperature() - get_min_temperature = min(k_dist_sw%get_temp_min(), k_dist_lw%get_temp_min()) - end function get_min_temperature - - real(wp) function get_max_temperature() - get_max_temperature = max(k_dist_sw%get_temp_max(), k_dist_lw%get_temp_max()) - end function get_max_temperature - ! -------------------------------------------------------------------------- ! Private routines ! -------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index 0a8d516c0ed8..a3000ba870b8 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -11,6 +11,10 @@ extern "C" int get_nband_sw(); extern "C" int get_nband_lw(); extern "C" int get_ngpt_sw(); extern "C" int get_ngpt_lw(); +extern "C" double get_min_temperature(); +extern "C" double get_max_temperature(); +extern "C" void get_gpoint_bands_sw(int *gpoint_bands); +extern "C" void get_gpoint_bands_lw(int *gpoint_bands); extern "C" void rrtmgpxx_finalize(); GasOpticsRRTMGP k_dist_sw; @@ -91,3 +95,25 @@ extern "C" int get_ngpt_sw() { extern "C" int get_ngpt_lw() { return k_dist_lw.get_ngpt(); } + +extern "C" double get_min_temperature() { + return min(k_dist_sw.temp_ref_min, k_dist_lw.temp_ref_min); +} + +extern "C" double get_max_temperature() { + return max(k_dist_sw.temp_ref_max, k_dist_lw.temp_ref_max); +} + +int1d gpoint_bands_sw; +extern "C" void get_gpoint_bands_sw(int *gpoint_bands_p) { + gpoint_bands_sw = int1d("gpoint_bands", gpoint_bands_p, k_dist_sw.get_ngpt()); + auto tmp = k_dist_sw.get_gpoint_bands(); + tmp.deep_copy_to(gpoint_bands_sw); +} + +int1d gpoint_bands_lw; +extern "C" void get_gpoint_bands_lw(int *gpoint_bands_p) { + gpoint_bands_lw = int1d("gpoint_bands", gpoint_bands_p, k_dist_lw.get_ngpt()); + auto tmp = k_dist_lw.get_gpoint_bands(); + tmp.deep_copy_to(gpoint_bands_lw); +} diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 9fa3bce5925d..054ebee1a99f 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -35,6 +35,10 @@ module radiation nswgpts, nlwgpts use rrtmgpxx_interface, only: & rrtmgpxx_initialize, rrtmgpxx_finalize, get_nband_sw, get_nband_lw, & + rrtmgpxx_get_min_temperature => get_min_temperature, & + rrtmgpxx_get_max_temperature => get_max_temperature, & + rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & + rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks @@ -497,6 +501,10 @@ subroutine radiation_init(state) call assert(nswgpts == get_ngpt_sw(), 'nswgpts does not match RRTMGPXX absorption coefficient data') call assert(nlwgpts == get_ngpt_lw(), 'nlwgpts does not match RRTMGPXX absorption coefficient data') + ! Check that min and max temperatures are consistent + call assert(rrtmgp_get_min_temperature() == rrtmgpxx_get_min_temperature(), 'RRTMGP and RRTMGPXX min temperatures do not match.') + call assert(rrtmgp_get_max_temperature() == rrtmgpxx_get_max_temperature(), 'RRTMGP and RRTMGPXX max temperatures do not match.') + ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL nlev_rad = pver @@ -1171,6 +1179,9 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! Zero-array for cloud properties if not diagnosed by microphysics real(r8), target, dimension(pcols,pver) :: zeros + integer, dimension(nswgpts) :: gpoint_bands_sw + integer, dimension(nlwgpts) :: gpoint_bands_lw + !---------------------------------------------------------------------- ! Number of physics columns in this "chunk" @@ -1278,8 +1289,9 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & end do ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state + call rrtmgpxx_get_gpoint_bands_sw(gpoint_bands_sw) call sample_cloud_optics_sw( & - ncol, pver, nswgpts, get_gpoint_bands_sw(), & + ncol, pver, nswgpts, gpoint_bands_sw, & state%pmid, cld, cldfsnow, & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw & @@ -1386,8 +1398,9 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & lambdac, mu, dei, des, rei, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) + call rrtmgpxx_get_gpoint_bands_lw(gpoint_bands_lw) call sample_cloud_optics_lw( & - ncol, pver, nlwgpts, get_gpoint_bands_lw(), & + ncol, pver, nlwgpts, gpoint_bands_lw, & state%pmid, cld, cldfsnow, & cld_tau_bnd_lw, cld_tau_gpt_lw & ) diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index d1c1d3018030..b1860057a77c 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -56,15 +56,15 @@ integer function get_ngpts_lw() get_ngpts_lw = k_dist_lw%get_ngpt() end function get_ngpts_lw - function get_gpoint_bands_sw() result(gpoint_bands) - integer, dimension(nswgpts) :: gpoint_bands + subroutine get_gpoint_bands_sw(gpoint_bands) + integer, intent(out), dimension(nswgpts) :: gpoint_bands gpoint_bands = k_dist_sw%get_gpoint_bands() - end function get_gpoint_bands_sw + end subroutine get_gpoint_bands_sw - function get_gpoint_bands_lw() result(gpoint_bands) - integer, dimension(nlwgpts) :: gpoint_bands + subroutine get_gpoint_bands_lw(gpoint_bands) + integer, intent(out), dimension(nlwgpts) :: gpoint_bands gpoint_bands = k_dist_lw%get_gpoint_bands() - end function get_gpoint_bands_lw + end subroutine get_gpoint_bands_lw subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) character(len=*), intent(in) :: active_gases(:) From 19d5eccd34ca6844b07b5e85dbae64bb7842b26b Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 9 Dec 2020 16:58:10 -0700 Subject: [PATCH 25/71] Use RRTMGPXX bands and gpoints --- .../src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 12 ++++++------ components/eam/src/physics/rrtmgp/radiation.F90 | 6 +++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index d01d19966df6..4f364c37007b 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -125,12 +125,6 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ call set_available_gases(active_gases, available_gases) call load_and_init(k_dist_sw, coefficients_file_sw, available_gases) call load_and_init(k_dist_lw, coefficients_file_lw, available_gases) - ! Set number of bands based on what we read in from input data - nswbands = k_dist_sw%get_nband() - nlwbands = k_dist_lw%get_nband() - ! Number of gpoints depend on inputdata, so initialize here - nswgpts = k_dist_sw%get_ngpt() - nlwgpts = k_dist_lw%get_ngpt() ! Add active gases call add_gases(active_gases) ! Initialize RRTMGP @@ -138,6 +132,12 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ C_CHAR_""//trim(coefficients_file_sw)//C_NULL_CHAR, & C_CHAR_""//trim(coefficients_file_lw)//C_NULL_CHAR & ) + ! Set number of bands based on what we read in from input data + nswbands = get_nband_sw() + nlwbands = get_nband_lw() + ! Number of gpoints depend on inputdata, so initialize here + nswgpts = get_ngpt_sw() + nlwgpts = get_ngpt_lw() end subroutine rrtmgpxx_initialize diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 054ebee1a99f..58a777a85d4b 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -31,15 +31,15 @@ module radiation rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & - get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts + get_gpoint_bands_sw, get_gpoint_bands_lw use rrtmgpxx_interface, only: & rrtmgpxx_initialize, rrtmgpxx_finalize, get_nband_sw, get_nband_lw, & rrtmgpxx_get_min_temperature => get_min_temperature, & rrtmgpxx_get_max_temperature => get_max_temperature, & rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & - get_ngpt_sw, get_ngpt_lw + get_ngpt_sw, get_ngpt_lw, & + nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range From 2c1e24dc07fbea096ecd83caad297523e4c67dab Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 14 Dec 2020 17:30:40 -0700 Subject: [PATCH 26/71] Enable C++ SW flux driver Enable C++ SW flux computations. These run alongside the F90 computations right now, and we compare fluxes after both calls. Unfortunately, it looks like the C++ and F90 codes are NOT BFB at the moment, so answers are not identical, but agree to better than 1e-5 W/m^2. For now, we set a tolerance of 1e-5 on this comparison, but it would be worthwhile to check if we can make the C++ and F90 codes BFB to allow for a robust comparison between the new and old RRTMGP drivers. --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 131 ++++++++++++++---- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 130 ++++++++++++++++- .../eam/src/physics/rrtmgp/radiation.F90 | 8 +- 3 files changed, 235 insertions(+), 34 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 4f364c37007b..9df86131b6df 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -17,6 +17,7 @@ module rrtmgpxx_interface use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl use mo_fluxes_byband, only: ty_fluxes_byband use mo_rrtmgp_clr_all_sky, only: rte_sw, rte_lw + use assertions, only: assert use iso_c_binding implicit none @@ -33,7 +34,7 @@ module rrtmgpxx_interface integer, public :: nswbands, nlwbands, nswgpts, nlwgpts public :: & - rrtmgpxx_initialize, rrtmgpxx_finalize, rrtmgp_run_sw, rrtmgp_run_lw, & + rrtmgpxx_initialize, rrtmgpxx_finalize, rrtmgpxx_run_sw, rrtmgpxx_run_lw, & get_nband_sw, get_nband_lw, & get_ngpt_sw, get_ngpt_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & @@ -91,6 +92,7 @@ subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") subroutine rrtmgpxx_initialize_cpp(coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") use iso_c_binding, only: C_CHAR, C_NULL_CHAR + implicit none character(kind=c_char) :: coefficients_file_sw(*) character(kind=c_char) :: coefficients_file_lw(*) end subroutine rrtmgpxx_initialize_cpp @@ -98,6 +100,33 @@ end subroutine rrtmgpxx_initialize_cpp subroutine rrtmgpxx_finalize() bind(C, name="rrtmgpxx_finalize") end subroutine rrtmgpxx_finalize + subroutine rrtmgpxx_run_sw_cpp( & + ngas, ncol, nlev, & + gas_vmr, & + pmid, tmid, pint, coszrs, & + albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & + tsi_scaling & + ) bind(C, name="rrtmgpxx_run_sw_cpp") + use iso_c_binding + implicit none + integer(kind=c_int), value :: ngas, ncol, nlev + real(kind=c_double), dimension(*) :: & + gas_vmr, pmid, tmid, pint, coszrs, albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir + real(kind=c_double), value :: tsi_scaling + end subroutine rrtmgpxx_run_sw_cpp + subroutine add_gas_name(gas_name) bind(C, name="add_gas_name") use iso_c_binding, only: C_CHAR character(kind=c_char) :: gas_name @@ -141,7 +170,7 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ end subroutine rrtmgpxx_initialize - subroutine rrtmgp_run_sw( & + subroutine rrtmgpxx_run_sw( & ngas, ncol, nlev, & gas_names, gas_vmr, & pmid, tmid, pint, coszrs, & @@ -174,7 +203,17 @@ subroutine rrtmgp_run_sw( & type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky type(ty_gas_concs) :: gas_concentrations - type(ty_optical_props_2str) :: cld_optics_sw, aer_optics_sw + type(ty_optical_props_2str) :: cld_optics, aer_optics + + real(wp), allocatable, dimension(:,:,:) :: gas_vmr_rad + + ! Fluxes from the cxx code + real(wp), dimension(ncol,nlev+1) :: & + allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, allsky_flux_dn_dir_cxx, & + clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, clrsky_flux_dn_dir_cxx + real(wp), dimension(ncol,nlev+1,nswbands) :: & + allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, allsky_bnd_flux_dn_dir_cxx, & + clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx, clrsky_bnd_flux_dn_dir_cxx ! Loop indices integer :: iband, igas, iday, icol @@ -198,16 +237,16 @@ subroutine rrtmgp_run_sw( & fluxes_clrsky%bnd_flux_dn_dir => clrsky_bnd_flux_dn_dir ! Populate RRTMGP optics - call handle_error(cld_optics_sw%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) - cld_optics_sw%tau = 0 - cld_optics_sw%ssa = 1 - cld_optics_sw%g = 0 - cld_optics_sw%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) - cld_optics_sw%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) - cld_optics_sw%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) + call handle_error(cld_optics%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) + cld_optics%tau = 0 + cld_optics%ssa = 1 + cld_optics%g = 0 + cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) + cld_optics%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) + cld_optics%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) ! Apply delta scaling to account for forward-scattering - call handle_error(cld_optics_sw%delta_scale()) + call handle_error(cld_optics%delta_scale()) ! Initialize aerosol optics; passing only the wavenumber bounds for each ! "band" rather than passing the full spectral discretization object, and @@ -216,25 +255,33 @@ subroutine rrtmgp_run_sw( & ! treatment of aerosol optics in the model, and prevents us from having to ! map bands to g-points ourselves since that will all be handled by the ! private routines internal to the optics class. - call handle_error(aer_optics_sw%alloc_2str( & + call handle_error(aer_optics%alloc_2str( & ncol, nlev, k_dist_sw%get_band_lims_wavenumber(), & name='shortwave aerosol optics' & )) - aer_optics_sw%tau = 0 - aer_optics_sw%ssa = 1 - aer_optics_sw%g = 0 - aer_optics_sw%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) - aer_optics_sw%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) - aer_optics_sw%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) + aer_optics%tau = 0 + aer_optics%ssa = 1 + aer_optics%g = 0 + aer_optics%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) + aer_optics%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) + aer_optics%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) ! Apply delta scaling to account for forward-scattering - call handle_error(aer_optics_sw%delta_scale()) + call handle_error(aer_optics%delta_scale()) ! Set gas concentrations call t_startf('rad_set_gases_sw') call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) call t_stopf('rad_set_gases_sw') + ! DEBUG + !cld_optics%tau = 0 + !cld_optics%ssa = 0 + !cld_optics%g = 0 + !aer_optics%tau = 0 + !aer_optics%ssa = 0 + !aer_optics%g = 0 + call handle_error(rte_sw( & k_dist_sw, gas_concentrations, & pmid(1:ncol,1:nlev), & @@ -243,20 +290,52 @@ subroutine rrtmgp_run_sw( & coszrs(1:ncol), & albedo_dir(1:nswbands,1:ncol), & albedo_dif(1:nswbands,1:ncol), & - cld_optics_sw, & + cld_optics, & fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics_sw, & + aer_props=aer_optics, & tsi_scaling=tsi_scaling & )) + ! Try calling C++ version + allocate(gas_vmr_rad(ngas, ncol, nlev)) + gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) + gas_vmr_rad(:,1:ncol,2:nlev) = gas_vmr(:,1:ncol,:) + call rrtmgpxx_run_sw_cpp( & + ngas, ncol, nlev, & + gas_vmr_rad(1:ngas,1:ncol,1:nlev), & + pmid, tmid, pint, coszrs, & + albedo_dir(1:nswbands,1:ncol), albedo_dif(1:nswbands,1:ncol), & + cld_optics%tau, cld_optics%ssa, cld_optics%g, & + aer_optics%tau, aer_optics%ssa, aer_optics%g, & + allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, allsky_flux_dn_dir_cxx, & + allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, allsky_bnd_flux_dn_dir_cxx, & + clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, clrsky_flux_dn_dir_cxx, & + clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx, clrsky_bnd_flux_dn_dir_cxx, & + tsi_scaling & + ) + deallocate(gas_vmr_rad) + + ! Check values + !print *, 'CXX min/max flux_dn: ', minval(allsky_flux_dn_cxx), ', ', maxval(allsky_flux_dn_cxx) + !print *, 'CXX-F90 flux_dn: ', allsky_flux_dn_cxx(1,:) - allsky_flux_dn(1,:), ', ', allsky_flux_dn_cxx(1,:) - allsky_flux_dn(1,:) + !print *, 'CXX/F90 flux_dn: ', allsky_flux_dn_cxx(1,2), ', ', allsky_flux_dn(1,2) + !print *, 'CXX - F90 flux_up error: ', maxval(abs(allsky_flux_up_cxx - allsky_flux_up)) + !print *, 'CXX - F90 flux_dn error: ', maxval(abs(allsky_flux_dn_cxx - allsky_flux_dn)) + !print *, 'CXX - F90 flux_dn_dir error: ', maxval(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir)) + !print *, 'CXX - F90 flux_net error: ', maxval(abs(allsky_flux_net_cxx - allsky_flux_net)) + call assert(all(abs(allsky_flux_up_cxx - allsky_flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') + call assert(all(abs(allsky_flux_dn_cxx - allsky_flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') + call assert(all(abs(allsky_flux_net_cxx - allsky_flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') + call assert(all(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir) < 1e-5), 'F90 and CXX allsky_flux_dn_dir differs.') + ! Clean up after ourselves - call free_optics_sw(cld_optics_sw) - call free_optics_sw(aer_optics_sw) + call free_optics_sw(cld_optics) + call free_optics_sw(aer_optics) - end subroutine rrtmgp_run_sw + end subroutine rrtmgpxx_run_sw - subroutine rrtmgp_run_lw( & + subroutine rrtmgpxx_run_lw( & ngas, ncol, nlev, & gas_names, gas_vmr, & surface_emissivity, & @@ -341,7 +420,7 @@ subroutine rrtmgp_run_lw( & n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG )) - end subroutine rrtmgp_run_lw + end subroutine rrtmgpxx_run_lw ! -------------------------------------------------------------------------- ! Private routines diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index a3000ba870b8..523dc6792125 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -1,8 +1,14 @@ #include "mo_gas_concentrations.h" #include "mo_gas_optics_rrtmgp.h" #include "mo_load_coefficients.h" +#include "mo_rte_sw.h" +#include "mo_rte_lw.h" +#include "mo_optical_props.h" #include "const.h" +using yakl::intrinsics::minval; +using yakl::intrinsics::maxval; + // Prototypes extern "C" void add_gas_name(char const *gas_name); extern "C" void convert_gas_names(string1d &gas_names); @@ -16,7 +22,18 @@ extern "C" double get_max_temperature(); extern "C" void get_gpoint_bands_sw(int *gpoint_bands); extern "C" void get_gpoint_bands_lw(int *gpoint_bands); extern "C" void rrtmgpxx_finalize(); - +extern "C" void rrtmgpxx_run_sw_cpp ( + int ngas, int ncol, int nlay, + double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, + double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, + double *cld_tau_gpt_p, double *cld_ssa_gpt_p, double *cld_asm_gpt_p, + double *aer_tau_bnd_p, double *aer_ssa_bnd_p, double *aer_asm_bnd_p, + double *allsky_flux_up_p , double *allsky_flux_dn_p , double *allsky_flux_net_p , double *allsky_flux_dn_dir_p, + double *allsky_bnd_flux_up_p, double *allsky_bnd_flux_dn_p, double *allsky_bnd_flux_net_p, double *allsky_bnd_flux_dn_dir_p, + double *clrsky_flux_up_p , double *clrsky_flux_dn_p , double *clrsky_flux_net_p , double *clrsky_flux_dn_dir_p, + double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p, double *clrsky_bnd_flux_dn_dir_p, + double tsi_scaling + ); GasOpticsRRTMGP k_dist_sw; GasOpticsRRTMGP k_dist_lw; @@ -104,16 +121,119 @@ extern "C" double get_max_temperature() { return max(k_dist_sw.temp_ref_max, k_dist_lw.temp_ref_max); } -int1d gpoint_bands_sw; extern "C" void get_gpoint_bands_sw(int *gpoint_bands_p) { - gpoint_bands_sw = int1d("gpoint_bands", gpoint_bands_p, k_dist_sw.get_ngpt()); + auto gpoint_bands_sw = int1d("gpoint_bands", gpoint_bands_p, k_dist_sw.get_ngpt()); auto tmp = k_dist_sw.get_gpoint_bands(); tmp.deep_copy_to(gpoint_bands_sw); } -int1d gpoint_bands_lw; extern "C" void get_gpoint_bands_lw(int *gpoint_bands_p) { - gpoint_bands_lw = int1d("gpoint_bands", gpoint_bands_p, k_dist_lw.get_ngpt()); + auto gpoint_bands_lw = int1d("gpoint_bands", gpoint_bands_p, k_dist_lw.get_ngpt()); auto tmp = k_dist_lw.get_gpoint_bands(); tmp.deep_copy_to(gpoint_bands_lw); } + +extern "C" void rrtmgpxx_run_sw_cpp ( + int ngas, int ncol, int nlay, + double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, + double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, + double *cld_tau_gpt_p, double *cld_ssa_gpt_p, double *cld_asm_gpt_p, + double *aer_tau_bnd_p, double *aer_ssa_bnd_p, double *aer_asm_bnd_p, + double *allsky_flux_up_p , double *allsky_flux_dn_p , double *allsky_flux_net_p , double *allsky_flux_dn_dir_p, + double *allsky_bnd_flux_up_p, double *allsky_bnd_flux_dn_p, double *allsky_bnd_flux_net_p, double *allsky_bnd_flux_dn_dir_p, + double *clrsky_flux_up_p , double *clrsky_flux_dn_p , double *clrsky_flux_net_p , double *clrsky_flux_dn_dir_p, + double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p, double *clrsky_bnd_flux_dn_dir_p, + double tsi_scaling + ) { + // Wrap pointers in YAKL arrays + int nswbands = k_dist_sw.get_nband(); + int nswgpts = k_dist_sw.get_ngpt(); + auto gas_vmr = real3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); + auto pmid = real2d("pmid", pmid_p, ncol, nlay); + auto tmid = real2d("tmid", tmid_p, ncol, nlay); + auto pint = real2d("pint", pint_p, ncol, nlay+1); + auto coszrs = real1d("coszrs", coszrs_p, ncol); + auto albedo_dir = real2d("albedo_dir", albedo_dir_p, nswbands, ncol); + auto albedo_dif = real2d("albedo_dif", albedo_dif_p, nswbands, ncol); + auto cld_tau_gpt = real3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nswgpts); + auto cld_ssa_gpt = real3d("cld_ssa_gpt", cld_ssa_gpt_p, ncol, nlay, nswgpts); + auto cld_asm_gpt = real3d("cld_asm_gpt", cld_asm_gpt_p, ncol, nlay, nswgpts); + auto aer_tau_bnd = real3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nswbands); + auto aer_ssa_bnd = real3d("aer_ssa_bnd", aer_ssa_bnd_p, ncol, nlay, nswbands); + auto aer_asm_bnd = real3d("aer_asm_bnd", aer_asm_bnd_p, ncol, nlay, nswbands); + auto allsky_flux_up = real2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); + auto allsky_flux_dn = real2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); + auto allsky_flux_dn_dir = real2d("allsky_flux_dn_dir", allsky_flux_dn_dir_p, ncol, nlay+1); + auto allsky_flux_net = real2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); + auto clrsky_flux_up = real2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); + auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); + auto clrsky_flux_dn_dir = real2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); + auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + + string1d gas_names("gas_names", gas_names_vect.size()); + convert_gas_names(gas_names); + GasConcs gas_concs; + gas_concs.init(gas_names, ncol, nlay); + real2d tmp2d; + tmp2d = real2d("tmp", ncol, nlay); + for (int igas = 1; igas <= ngas; igas++) { + for (int icol = 1; icol <= ncol; icol++) { + for (int ilay = 1; ilay <= nlay; ilay++) { + tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); + } + } + gas_concs.set_vmr(gas_names(igas), tmp2d); + } + + // Build fluxes + FluxesBroadband fluxes; + fluxes.flux_up = allsky_flux_up; + fluxes.flux_dn = allsky_flux_dn; + fluxes.flux_dn_dir = allsky_flux_dn_dir; + fluxes.flux_net = allsky_flux_net; + + // Populate optical property objects + OpticalProps2str combined_optics; + combined_optics.alloc_2str(ncol, nlay, k_dist_sw); + auto pmid_host = pmid.createHostCopy(); + bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); + real2d toa_flux("toa_flux", ncol, nswgpts); + k_dist_sw.gas_optics(top_at_1, pmid, pint, tmid, gas_concs, combined_optics, toa_flux); + + // Apply TOA flux scaling + parallel_for(Bounds<2>(nswgpts,ncol), YAKL_LAMBDA (int igpt, int icol) { + toa_flux(icol, igpt) = tsi_scaling * toa_flux(icol, igpt); + }); + + // Add in aerosol + OpticalProps2str aerosol_optics; + /* + aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw); + auto gpt_bnd = aerosol_optics.get_gpoint_bands(); + parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics.ssa(icol,ilay,igpt) = aer_ssa_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics.g (icol,ilay,igpt) = aer_asm_bnd(icol,ilay,gpt_bnd(igpt)); + }); + */ + aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw.get_band_lims_wavenumber()); + parallel_for(Bounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); + aerosol_optics.ssa(icol,ilay,ibnd) = aer_ssa_bnd(icol,ilay,ibnd); + aerosol_optics.g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); + }); + aerosol_optics.increment(combined_optics); + + // Add in clouds + OpticalProps2str cloud_optics; + cloud_optics.alloc_2str(ncol, nlay, k_dist_sw); + parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { + cloud_optics.tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); + cloud_optics.ssa(icol,ilay,igpt) = cld_ssa_gpt(icol,ilay,igpt); + cloud_optics.g (icol,ilay,igpt) = cld_asm_gpt(icol,ilay,igpt); + }); + cloud_optics.increment(combined_optics); + + // Call SW flux driver + rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes); +} diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 58a777a85d4b..6e74be53f9ca 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -33,11 +33,13 @@ module radiation rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw use rrtmgpxx_interface, only: & - rrtmgpxx_initialize, rrtmgpxx_finalize, get_nband_sw, get_nband_lw, & + rrtmgpxx_initialize, rrtmgpxx_finalize, & + rrtmgpxx_run_sw, rrtmgpxx_run_lw, & rrtmgpxx_get_min_temperature => get_min_temperature, & rrtmgpxx_get_max_temperature => get_max_temperature, & rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & + get_nband_sw, get_nband_lw, & get_ngpt_sw, get_ngpt_lw, & nswgpts, nlwgpts @@ -1631,7 +1633,7 @@ subroutine radiation_driver_sw(ncol, & ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') - call rrtmgp_run_sw( & + call rrtmgpxx_run_sw( & size(active_gases), nday, nlev_rad, & gas_names, gas_vmr_day, & pmid_day(1:nday,1:nlev_rad), & @@ -1810,7 +1812,7 @@ subroutine radiation_driver_lw(ncol, & ! Do longwave radiative transfer calculations call t_startf('rad_calculations_lw') - call rrtmgp_run_lw( & + call rrtmgpxx_run_lw( & size(active_gases), ncol, nlev_rad, & gas_names, gas_vmr, & surface_emissivity, & From b895f9db5d14b791a83bfcb3ac2ebb20d2d8a510 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Mon, 14 Dec 2020 17:36:59 -0700 Subject: [PATCH 27/71] Compare clearsky fluxes for SW --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 4 ++++ .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 23 ++++++++++++------- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 9df86131b6df..8391904be584 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -327,6 +327,10 @@ subroutine rrtmgpxx_run_sw( & call assert(all(abs(allsky_flux_dn_cxx - allsky_flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') call assert(all(abs(allsky_flux_net_cxx - allsky_flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') call assert(all(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir) < 1e-5), 'F90 and CXX allsky_flux_dn_dir differs.') + call assert(all(abs(clrsky_flux_up_cxx - clrsky_flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') + call assert(all(abs(clrsky_flux_dn_cxx - clrsky_flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') + call assert(all(abs(clrsky_flux_net_cxx - clrsky_flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') + call assert(all(abs(clrsky_flux_dn_dir_cxx - clrsky_flux_dn_dir) < 1e-5), 'F90 and CXX clrsky_flux_dn_dir differs.') ! Clean up after ourselves call free_optics_sw(cld_optics) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index 523dc6792125..f28141bbd422 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -170,6 +170,7 @@ extern "C" void rrtmgpxx_run_sw_cpp ( auto clrsky_flux_dn_dir = real2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + // Populate gas concentrations string1d gas_names("gas_names", gas_names_vect.size()); convert_gas_names(gas_names); GasConcs gas_concs; @@ -185,13 +186,6 @@ extern "C" void rrtmgpxx_run_sw_cpp ( gas_concs.set_vmr(gas_names(igas), tmp2d); } - // Build fluxes - FluxesBroadband fluxes; - fluxes.flux_up = allsky_flux_up; - fluxes.flux_dn = allsky_flux_dn; - fluxes.flux_dn_dir = allsky_flux_dn_dir; - fluxes.flux_net = allsky_flux_net; - // Populate optical property objects OpticalProps2str combined_optics; combined_optics.alloc_2str(ncol, nlay, k_dist_sw); @@ -224,6 +218,14 @@ extern "C" void rrtmgpxx_run_sw_cpp ( }); aerosol_optics.increment(combined_optics); + // Do the clearsky calculation before adding in clouds + FluxesBroadband fluxes_clrsky; + fluxes_clrsky.flux_up = clrsky_flux_up; + fluxes_clrsky.flux_dn = clrsky_flux_dn; + fluxes_clrsky.flux_dn_dir = clrsky_flux_dn_dir; + fluxes_clrsky.flux_net = clrsky_flux_net; + rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_clrsky); + // Add in clouds OpticalProps2str cloud_optics; cloud_optics.alloc_2str(ncol, nlay, k_dist_sw); @@ -235,5 +237,10 @@ extern "C" void rrtmgpxx_run_sw_cpp ( cloud_optics.increment(combined_optics); // Call SW flux driver - rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes); + FluxesBroadband fluxes_allsky; + fluxes_allsky.flux_up = allsky_flux_up; + fluxes_allsky.flux_dn = allsky_flux_dn; + fluxes_allsky.flux_dn_dir = allsky_flux_dn_dir; + fluxes_allsky.flux_net = allsky_flux_net; + rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_allsky); } From 5d3ffc36ded0da0ffb3b4617eb2bff312d87b949 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 15 Dec 2020 14:09:30 -0700 Subject: [PATCH 28/71] Need to be careful about ncol sizes in rrtmgpxx_run_lw call --- components/eam/src/physics/rrtmgp/radiation.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 6e74be53f9ca..1b029bce68dc 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1814,10 +1814,10 @@ subroutine radiation_driver_lw(ncol, & call t_startf('rad_calculations_lw') call rrtmgpxx_run_lw( & size(active_gases), ncol, nlev_rad, & - gas_names, gas_vmr, & - surface_emissivity, & - pmid, tmid, pint, tint, & - cld_tau_gpt_rad, aer_tau_bnd_rad, & + gas_names, gas_vmr(:,1:ncol,:), & + surface_emissivity(1:nlwbands,1:ncol), & + pmid(1:ncol,:), tmid(1:ncol,:), pint(1:ncol,:), tint(1:ncol,:), & + cld_tau_gpt_rad(1:ncol,:,:), aer_tau_bnd_rad(1:ncol,:,:), & fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & From 1f2f520a3dd219893a74dcac72bb6707f9fef9e3 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 15 Dec 2020 14:09:52 -0700 Subject: [PATCH 29/71] Add call to C++ longwave driver --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 126 +++---------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 170 ++++++++++++++++-- .../eam/src/physics/rrtmgp/radiation.F90 | 40 ++++- 3 files changed, 216 insertions(+), 120 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 8391904be584..557fa792ed51 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -34,7 +34,8 @@ module rrtmgpxx_interface integer, public :: nswbands, nlwbands, nswgpts, nlwgpts public :: & - rrtmgpxx_initialize, rrtmgpxx_finalize, rrtmgpxx_run_sw, rrtmgpxx_run_lw, & + rrtmgpxx_initialize, rrtmgpxx_finalize, & + rrtmgpxx_run_sw, rrtmgpxx_run_lw, & get_nband_sw, get_nband_lw, & get_ngpt_sw, get_ngpt_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & @@ -127,6 +128,30 @@ subroutine rrtmgpxx_run_sw_cpp( & real(kind=c_double), value :: tsi_scaling end subroutine rrtmgpxx_run_sw_cpp + subroutine rrtmgpxx_run_lw ( & + ngas, ncol, nlev, & + gas_vmr, & + pmid, tmid, pint, tint, & + surface_emissivity, & + cld_tau, aer_tau, & + allsky_flux_up_cxx , allsky_flux_dn_cxx , allsky_flux_net_cxx, & + allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, & + clrsky_flux_up_cxx , clrsky_flux_dn_cxx , clrsky_flux_net_cxx, & + clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx & + ) bind(C, name="rrtmgpxx_run_lw") + use iso_c_binding + implicit none + integer(kind=c_int), value :: ngas, ncol, nlev + real(kind=c_double), dimension(*) :: & + gas_vmr, & + pmid, tmid, pint, tint, surface_emissivity, & + cld_tau, aer_tau, & + allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, & + allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, & + clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, & + clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx + end subroutine rrtmgpxx_run_lw + subroutine add_gas_name(gas_name) bind(C, name="add_gas_name") use iso_c_binding, only: C_CHAR character(kind=c_char) :: gas_name @@ -274,14 +299,6 @@ subroutine rrtmgpxx_run_sw( & call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) call t_stopf('rad_set_gases_sw') - ! DEBUG - !cld_optics%tau = 0 - !cld_optics%ssa = 0 - !cld_optics%g = 0 - !aer_optics%tau = 0 - !aer_optics%ssa = 0 - !aer_optics%g = 0 - call handle_error(rte_sw( & k_dist_sw, gas_concentrations, & pmid(1:ncol,1:nlev), & @@ -316,9 +333,6 @@ subroutine rrtmgpxx_run_sw( & deallocate(gas_vmr_rad) ! Check values - !print *, 'CXX min/max flux_dn: ', minval(allsky_flux_dn_cxx), ', ', maxval(allsky_flux_dn_cxx) - !print *, 'CXX-F90 flux_dn: ', allsky_flux_dn_cxx(1,:) - allsky_flux_dn(1,:), ', ', allsky_flux_dn_cxx(1,:) - allsky_flux_dn(1,:) - !print *, 'CXX/F90 flux_dn: ', allsky_flux_dn_cxx(1,2), ', ', allsky_flux_dn(1,2) !print *, 'CXX - F90 flux_up error: ', maxval(abs(allsky_flux_up_cxx - allsky_flux_up)) !print *, 'CXX - F90 flux_dn error: ', maxval(abs(allsky_flux_dn_cxx - allsky_flux_dn)) !print *, 'CXX - F90 flux_dn_dir error: ', maxval(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir)) @@ -338,94 +352,6 @@ subroutine rrtmgpxx_run_sw( & end subroutine rrtmgpxx_run_sw - - subroutine rrtmgpxx_run_lw( & - ngas, ncol, nlev, & - gas_names, gas_vmr, & - surface_emissivity, & - pmid, tmid, pint, tint, & - cld_tau_gpt, aer_tau_bnd, & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net & - ) - - integer, intent(in) :: ngas, ncol, nlev - character(len=*), intent(in), dimension(:) :: gas_names - real(wp), intent(in), dimension(:,:,:) :: gas_vmr - real(wp), intent(in), dimension(:,:) :: surface_emissivity - real(wp), intent(in), dimension(:,:) :: pmid, tmid, pint, tint - real(wp), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd - real(wp), intent(inout), dimension(:,:), target :: & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net - real(wp), intent(inout), dimension(:,:,:), target :: & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net - - type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky - - type(ty_gas_concs) :: gas_concentrations - type(ty_optical_props_1scl) :: cld_optics, aer_optics - - - ! Allocate fluxes (allsky and clearsky) - fluxes_allsky%flux_up => allsky_flux_up - fluxes_allsky%flux_dn => allsky_flux_dn - fluxes_allsky%flux_net => allsky_flux_net - fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up - fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn - fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net - fluxes_clrsky%flux_up => clrsky_flux_up - fluxes_clrsky%flux_dn => clrsky_flux_dn - fluxes_clrsky%flux_net => clrsky_flux_net - fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up - fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn - fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net - - ! Setup gas concentrations object - call t_startf('rad_gas_concentrations_lw') - call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) - call t_stopf('rad_gas_concentrations_lw') - - ! Populate RRTMGP optics - call t_startf('longwave cloud optics') - call handle_error(cld_optics%alloc_1scl(ncol, nlev, k_dist_lw, name='longwave cloud optics')) - cld_optics%tau = 0.0 - cld_optics%tau(1:ncol,1:nlev,:) = cld_tau_gpt(1:ncol,1:nlev,:) - call handle_error(cld_optics%delta_scale()) - call t_stopf('longwave cloud optics') - - ! Initialize aerosol optics; passing only the wavenumber bounds for each - ! "band" rather than passing the full spectral discretization object, and - ! omitting the "g-point" mapping forces the optics to be indexed and - ! stored by band rather than by g-point. This is most consistent with our - ! treatment of aerosol optics in the model, and prevents us from having to - ! map bands to g-points ourselves since that will all be handled by the - ! private routines internal to the optics class. - call handle_error(aer_optics%alloc_1scl(ncol, nlev, k_dist_lw%get_band_lims_wavenumber())) - call aer_optics%set_name('longwave aerosol optics') - aer_optics%tau = 0 - !aer_optics%tau(1:ncol,2:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:pver,1:nlwbands) - aer_optics%tau(1:ncol,1:nlev,1:nlwbands) = aer_tau_bnd(1:ncol,1:nlev,1:nlwbands) - call handle_error(aer_optics%delta_scale()) - - ! Do longwave radiative transfer calculations - call handle_error(rte_lw( & - k_dist_lw, gas_concentrations, & - pmid(1:ncol,1:nlev), tmid(1:ncol,1:nlev), & - pint(1:ncol,1:nlev+1), tint(1:ncol,nlev+1), & - surface_emissivity(1:nlwbands,1:ncol), & - cld_optics, & - fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics, & - t_lev=tint(1:ncol,1:nlev+1), & - n_gauss_angles=1 & ! Set to 3 for consistency with RRTMG - )) - - end subroutine rrtmgpxx_run_lw - ! -------------------------------------------------------------------------- ! Private routines ! -------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index f28141bbd422..ba682d8bf23d 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -34,6 +34,18 @@ extern "C" void rrtmgpxx_run_sw_cpp ( double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p, double *clrsky_bnd_flux_dn_dir_p, double tsi_scaling ); +extern "C" void rrtmgpxx_run_lw ( + int ngas, int ncol, int nlay, + double *gas_vmr_p , + double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, + double *emis_sfc_p , + double *cld_tau_gpt_p , double *aer_tau_bnd_p , + double *allsky_flux_up_p , double *allsky_flux_dn_p , double *allsky_flux_net_p , + double *allsky_bnd_flux_up_p, double *allsky_bnd_flux_dn_p, double *allsky_bnd_flux_net_p, + double *clrsky_flux_up_p , double *clrsky_flux_dn_p , double *clrsky_flux_net_p , + double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p + ); + GasOpticsRRTMGP k_dist_sw; GasOpticsRRTMGP k_dist_lw; @@ -170,7 +182,7 @@ extern "C" void rrtmgpxx_run_sw_cpp ( auto clrsky_flux_dn_dir = real2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); - // Populate gas concentrations + // Populate gas concentrations object string1d gas_names("gas_names", gas_names_vect.size()); convert_gas_names(gas_names); GasConcs gas_concs; @@ -186,7 +198,7 @@ extern "C" void rrtmgpxx_run_sw_cpp ( gas_concs.set_vmr(gas_names(igas), tmp2d); } - // Populate optical property objects + // Do gas optics OpticalProps2str combined_optics; combined_optics.alloc_2str(ncol, nlay, k_dist_sw); auto pmid_host = pmid.createHostCopy(); @@ -201,21 +213,22 @@ extern "C" void rrtmgpxx_run_sw_cpp ( // Add in aerosol OpticalProps2str aerosol_optics; - /* - aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw); - auto gpt_bnd = aerosol_optics.get_gpoint_bands(); - parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); - aerosol_optics.ssa(icol,ilay,igpt) = aer_ssa_bnd(icol,ilay,gpt_bnd(igpt)); - aerosol_optics.g (icol,ilay,igpt) = aer_asm_bnd(icol,ilay,gpt_bnd(igpt)); - }); - */ - aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw.get_band_lims_wavenumber()); - parallel_for(Bounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); - aerosol_optics.ssa(icol,ilay,ibnd) = aer_ssa_bnd(icol,ilay,ibnd); - aerosol_optics.g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); - }); + if (true) { + aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw); + auto gpt_bnd = aerosol_optics.get_gpoint_bands(); + parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics.ssa(icol,ilay,igpt) = aer_ssa_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics.g (icol,ilay,igpt) = aer_asm_bnd(icol,ilay,gpt_bnd(igpt)); + }); + } else { + aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw.get_band_lims_wavenumber()); + parallel_for(Bounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); + aerosol_optics.ssa(icol,ilay,ibnd) = aer_ssa_bnd(icol,ilay,ibnd); + aerosol_optics.g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); + }); + } aerosol_optics.increment(combined_optics); // Do the clearsky calculation before adding in clouds @@ -244,3 +257,126 @@ extern "C" void rrtmgpxx_run_sw_cpp ( fluxes_allsky.flux_net = allsky_flux_net; rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_allsky); } + +extern "C" void rrtmgpxx_run_lw ( + int ngas, int ncol, int nlay, + double *gas_vmr_p , + double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, + double *emis_sfc_p , + double *cld_tau_gpt_p , double *aer_tau_bnd_p , + double *allsky_flux_up_p , double *allsky_flux_dn_p , double *allsky_flux_net_p , + double *allsky_bnd_flux_up_p, double *allsky_bnd_flux_dn_p, double *allsky_bnd_flux_net_p, + double *clrsky_flux_up_p , double *clrsky_flux_dn_p , double *clrsky_flux_net_p , + double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p + ) { + // Wrap pointers in YAKL arrays + int nlwbands = k_dist_lw.get_nband(); + int nlwgpts = k_dist_lw.get_ngpt(); + auto gas_vmr = real3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); + auto pmid = real2d("pmid", pmid_p, ncol, nlay); + auto tmid = real2d("tmid", tmid_p, ncol, nlay); + auto pint = real2d("pint", pint_p, ncol, nlay+1); + auto tint = real2d("tint", tint_p, ncol, nlay+1); + auto emis_sfc = real2d("emis_sfc", emis_sfc_p, nlwbands, ncol); + auto cld_tau_gpt = real3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nlwgpts); + auto aer_tau_bnd = real3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nlwbands); + auto allsky_flux_up = real2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); + auto allsky_flux_dn = real2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); + auto allsky_flux_net = real2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); + auto clrsky_flux_up = real2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); + auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); + auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + + // Populate gas concentrations + string1d gas_names("gas_names", gas_names_vect.size()); + convert_gas_names(gas_names); + GasConcs gas_concs; + gas_concs.init(gas_names, ncol, nlay); + real2d tmp2d; + tmp2d = real2d("tmp", ncol, nlay); + for (int igas = 1; igas <= ngas; igas++) { + for (int icol = 1; icol <= ncol; icol++) { + for (int ilay = 1; ilay <= nlay; ilay++) { + tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); + } + } + gas_concs.set_vmr(gas_names(igas), tmp2d); + } + + // Boundary conditions + SourceFuncLW lw_sources; + lw_sources.alloc(ncol, nlay, k_dist_lw); + + // Weights and angle secants for first order (k=1) Gaussian quadrature. + // Values from Table 2, Clough et al, 1992, doi:10.1029/92JD01419 + // after Abramowitz & Stegun 1972, page 921 + int constexpr max_gauss_pts = 4; + realHost2d gauss_Ds_host ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); + gauss_Ds_host(1,1) = 1.66_wp ; gauss_Ds_host(2,1) = 0._wp; gauss_Ds_host(3,1) = 0._wp; gauss_Ds_host(4,1) = 0._wp; + gauss_Ds_host(1,2) = 1.18350343_wp; gauss_Ds_host(2,2) = 2.81649655_wp; gauss_Ds_host(3,2) = 0._wp; gauss_Ds_host(4,2) = 0._wp; + gauss_Ds_host(1,3) = 1.09719858_wp; gauss_Ds_host(2,3) = 1.69338507_wp; gauss_Ds_host(3,3) = 4.70941630_wp; gauss_Ds_host(4,3) = 0._wp; + gauss_Ds_host(1,4) = 1.06056257_wp; gauss_Ds_host(2,4) = 1.38282560_wp; gauss_Ds_host(3,4) = 2.40148179_wp; gauss_Ds_host(4,4) = 7.15513024_wp; + + realHost2d gauss_wts_host("gauss_wts",max_gauss_pts,max_gauss_pts); + gauss_wts_host(1,1) = 0.5_wp ; gauss_wts_host(2,1) = 0._wp ; gauss_wts_host(3,1) = 0._wp ; gauss_wts_host(4,1) = 0._wp ; + gauss_wts_host(1,2) = 0.3180413817_wp; gauss_wts_host(2,2) = 0.1819586183_wp; gauss_wts_host(3,2) = 0._wp ; gauss_wts_host(4,2) = 0._wp ; + gauss_wts_host(1,3) = 0.2009319137_wp; gauss_wts_host(2,3) = 0.2292411064_wp; gauss_wts_host(3,3) = 0.0698269799_wp; gauss_wts_host(4,3) = 0._wp ; + gauss_wts_host(1,4) = 0.1355069134_wp; gauss_wts_host(2,4) = 0.2034645680_wp; gauss_wts_host(3,4) = 0.1298475476_wp; gauss_wts_host(4,4) = 0.0311809710_wp; + + real2d gauss_Ds ("gauss_Ds" ,max_gauss_pts,max_gauss_pts); + real2d gauss_wts("gauss_wts",max_gauss_pts,max_gauss_pts); + gauss_Ds_host .deep_copy_to(gauss_Ds ); + gauss_wts_host.deep_copy_to(gauss_wts); + + // Populate optical property objects + OpticalProps1scl combined_optics; + combined_optics.alloc_1scl(ncol, nlay, k_dist_lw); + auto pmid_host = pmid.createHostCopy(); + bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); + real1d t_sfc("t_sfc", ncol); + for (int icol=1; icol<=ncol; icol++) { + t_sfc(icol) = tint(icol,nlay+1); + } + //k_dist_lw.gas_optics(top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), real2d()); + k_dist_lw.gas_optics(top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), tint); + + // Add in aerosol; we can define this by bands or gpoints. If we define by + // bands, then internally when increment() is called it will map these to + // gpoints. Not sure if there is a beneift one way or another. + OpticalProps1scl aerosol_optics; + if (false) { + aerosol_optics.alloc_1scl(ncol, nlay, k_dist_lw); + auto gpt_bnd = aerosol_optics.get_gpoint_bands(); + parallel_for(Bounds<3>(nlwgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); + }); + } else { + aerosol_optics.alloc_1scl(ncol, nlay, k_dist_lw.get_band_lims_wavenumber()); + parallel_for(Bounds<3>(nlwbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { + aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); + }); + } + aerosol_optics.increment(combined_optics); + + // Do the clearsky calculation before adding in clouds + FluxesBroadband fluxes_clrsky; + fluxes_clrsky.flux_up = clrsky_flux_up; + fluxes_clrsky.flux_dn = clrsky_flux_dn; + fluxes_clrsky.flux_net = clrsky_flux_net; + rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_clrsky); + + // Add in clouds + OpticalProps1scl cloud_optics; + cloud_optics.alloc_1scl(ncol, nlay, k_dist_lw); + parallel_for(Bounds<3>(nlwgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { + cloud_optics.tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); + }); + cloud_optics.increment(combined_optics); + + // Call LW flux driver + FluxesBroadband fluxes_allsky; + fluxes_allsky.flux_up = allsky_flux_up; + fluxes_allsky.flux_dn = allsky_flux_dn; + fluxes_allsky.flux_net = allsky_flux_net; + rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_allsky); +} diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 1b029bce68dc..a12619a7b237 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1795,6 +1795,11 @@ subroutine radiation_driver_lw(ncol, & ! Temporary heating rates on radiation vertical grid real(r8), dimension(ncol,nlev_rad) :: qrl_rad, qrlc_rad + real(r8), dimension(size(gas_vmr, 1),ncol,nlev_rad) :: gas_vmr_rad + + ! Fluxes from C++ interface for comparison + type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx + ! Set surface emissivity to 1 here. There is a note in the RRTMG ! implementation that this is treated in the land model, but the old ! RRTMG implementation also sets this to 1. This probably does not make @@ -1811,8 +1816,8 @@ subroutine radiation_driver_lw(ncol, & aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd(:,:,:) ! Do longwave radiative transfer calculations - call t_startf('rad_calculations_lw') - call rrtmgpxx_run_lw( & + call t_startf('rrtmgp_run_lw') + call rrtmgp_run_lw( & size(active_gases), ncol, nlev_rad, & gas_names, gas_vmr(:,1:ncol,:), & surface_emissivity(1:nlwbands,1:ncol), & @@ -1823,7 +1828,36 @@ subroutine radiation_driver_lw(ncol, & fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) - call t_stopf('rad_calculations_lw') + call t_stopf('rrtmgp_run_lw') + call t_startf('rrtmgpxx_run_lw') + ! Try calling C++ version + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky_cxx) + call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky_cxx) + gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) + gas_vmr_rad(:,1:ncol,2:nlev_rad) = gas_vmr(:,1:ncol,:) + call rrtmgpxx_run_lw( & + size(active_gases), ncol, nlev_rad, & + gas_vmr_rad(:,1:ncol,:), & + pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & + surface_emissivity(1:nlwbands,1:ncol), & + cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & + fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , & + fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, & + fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , & + fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net & + ) + call t_stopf('rrtmgpxx_run_lw') + ! Check fluxes + if (.true.) then + call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') + end if + call free_fluxes(fluxes_allsky_cxx) + call free_fluxes(fluxes_clrsky_cxx) ! Calculate heating rates call calculate_heating_rate( & From 285c9e39807df6f3eddfc87a944a2fa3690863e3 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 15 Dec 2020 18:46:29 -0700 Subject: [PATCH 30/71] Move handling of extra level to radiation.F90 --- .../eam/src/physics/rrtmgp/radiation.F90 | 70 +++++++++++++++++-- 1 file changed, 64 insertions(+), 6 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index a12619a7b237..6ee7e528d054 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1561,10 +1561,21 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day real(r8), dimension(ncol,nlev_rad+1) :: pint_day real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day + real(r8), dimension(size(gas_names),ncol,nlev_rad) :: gas_vmr_rad real(r8), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day + real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad + real(r8), dimension(size(cld_ssa_gpt,1),size(cld_ssa_gpt,2)+1,size(cld_ssa_gpt,3)) :: cld_ssa_gpt_rad + real(r8), dimension(size(cld_asm_gpt,1),size(cld_asm_gpt,2)+1,size(cld_asm_gpt,3)) :: cld_asm_gpt_rad + real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad + real(r8), dimension(size(aer_ssa_bnd,1),size(aer_ssa_bnd,2)+1,size(aer_ssa_bnd,3)) :: aer_ssa_bnd_rad + real(r8), dimension(size(aer_asm_bnd,1),size(aer_asm_bnd,2)+1,size(aer_asm_bnd,3)) :: aer_asm_bnd_rad + + ! Fluxes from C++ interface for comparison + type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx + ! Scaling factor for total sky irradiance; used to account for orbital ! eccentricity, and could be used to scale total sky irradiance for different ! climates as well (i.e., paleoclimate simulations) @@ -1629,11 +1640,24 @@ subroutine radiation_driver_sw(ncol, & call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) - ! Add a level above model top to optical properties! + ! Add an empty level above model top + ! TODO: handle gases here too + cld_tau_gpt_rad = 0 + cld_ssa_gpt_rad = 0 + cld_asm_gpt_rad = 0 + cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt_day(:,:,:) + cld_ssa_gpt_rad(:,ktop:kbot,:) = cld_ssa_gpt_day(:,:,:) + cld_asm_gpt_rad(:,ktop:kbot,:) = cld_asm_gpt_day(:,:,:) + aer_tau_bnd_rad = 0 + aer_ssa_bnd_rad = 0 + aer_asm_bnd_rad = 0 + aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd_day(:,:,:) + aer_ssa_bnd_rad(:,ktop:kbot,:) = aer_ssa_bnd_day(:,:,:) + aer_asm_bnd_rad(:,ktop:kbot,:) = aer_asm_bnd_day(:,:,:) ! Do shortwave radiative transfer calculations - call t_startf('rad_calculations_sw') - call rrtmgpxx_run_sw( & + call t_startf('rad_rrtmgp_run_sw') + call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & gas_names, gas_vmr_day, & pmid_day(1:nday,1:nlev_rad), & @@ -1642,15 +1666,49 @@ subroutine radiation_driver_sw(ncol, & coszrs_day(1:nday), & albedo_dir_day(1:nswbands,1:nday), & albedo_dif_day(1:nswbands,1:nday), & - cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & - aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & + cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & + aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, fluxes_allsky_day%flux_dn_dir, & fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) - call t_stopf('rad_calculations_sw') + call t_stopf('rad_rrtmgp_run_sw') + call t_startf('rad_rrtmgpxx_run_sw') + gas_vmr_rad(:,:nday,1) = gas_vmr_day(:,:nday,1) + gas_vmr_rad(:,:nday,2:nlev_rad) = gas_vmr_day(:,:nday,1:pver) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_cxx, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) + call rrtmgpxx_run_sw( & + size(active_gases), nday, nlev_rad, & + gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & + pmid_day(1:nday,1:nlev_rad), & + tmid_day(1:nday,1:nlev_rad), & + pint_day(1:nday,1:nlev_rad+1), & + coszrs_day(1:nday), & + albedo_dir_day(1:nswbands,1:nday), & + albedo_dif_day(1:nswbands,1:nday), & + cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & + aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & + fluxes_allsky_cxx%flux_up, fluxes_allsky_cxx%flux_dn, fluxes_allsky_cxx%flux_net, fluxes_allsky_cxx%flux_dn_dir, & + fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & + fluxes_clrsky_cxx%flux_up, fluxes_clrsky_cxx%flux_dn, fluxes_clrsky_cxx%flux_net, fluxes_clrsky_cxx%flux_dn_dir, & + fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net, fluxes_clrsky_cxx%bnd_flux_dn_dir, & + tsi_scaling & + ) + call t_stopf('rad_rrtmgpxx_run_sw') + ! Check fluxes + if (.true.) then + call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky_day%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky_day%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky_day%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky_day%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky_day%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky_day%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') + end if + call free_fluxes(fluxes_allsky_cxx) + call free_fluxes(fluxes_clrsky_cxx) ! Expand fluxes from daytime-only arrays to full chunk arrays call t_startf('rad_expand_fluxes_sw') From 09134ab7d56774c218a2112ea4e4352ece100572 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 15 Dec 2020 18:53:53 -0700 Subject: [PATCH 31/71] Clean up and call C++ sw driver directly --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 164 +----------------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 6 +- .../eam/src/physics/rrtmgp/radiation.F90 | 6 +- .../src/physics/rrtmgp/radiation_utils.F90 | 1 - .../src/physics/rrtmgp/rrtmgp_interface.F90 | 12 +- 5 files changed, 16 insertions(+), 173 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 557fa792ed51..2da78000dcd6 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -101,7 +101,7 @@ end subroutine rrtmgpxx_initialize_cpp subroutine rrtmgpxx_finalize() bind(C, name="rrtmgpxx_finalize") end subroutine rrtmgpxx_finalize - subroutine rrtmgpxx_run_sw_cpp( & + subroutine rrtmgpxx_run_sw( & ngas, ncol, nlev, & gas_vmr, & pmid, tmid, pint, coszrs, & @@ -113,7 +113,7 @@ subroutine rrtmgpxx_run_sw_cpp( & clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & tsi_scaling & - ) bind(C, name="rrtmgpxx_run_sw_cpp") + ) bind(C, name="rrtmgpxx_run_sw") use iso_c_binding implicit none integer(kind=c_int), value :: ngas, ncol, nlev @@ -126,7 +126,7 @@ subroutine rrtmgpxx_run_sw_cpp( & clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir real(kind=c_double), value :: tsi_scaling - end subroutine rrtmgpxx_run_sw_cpp + end subroutine rrtmgpxx_run_sw subroutine rrtmgpxx_run_lw ( & ngas, ncol, nlev, & @@ -194,164 +194,6 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ nlwgpts = get_ngpt_lw() end subroutine rrtmgpxx_initialize - - subroutine rrtmgpxx_run_sw( & - ngas, ncol, nlev, & - gas_names, gas_vmr, & - pmid, tmid, pint, coszrs, & - albedo_dir, albedo_dif, & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & - tsi_scaling & - ) - integer, intent(in) :: ngas, ncol, nlev - character(len=*), dimension(:) :: gas_names - real(wp), intent(in), dimension(:,:,:) :: gas_vmr - real(wp), intent(in), dimension(:,:) :: & - pmid, tmid, pint - real(wp), intent(in), dimension(:) :: coszrs - real(wp), intent(in), dimension(:,:) :: albedo_dir, albedo_dif - real(wp), intent(in), dimension(:,:,:) :: & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd - real(wp), intent(inout), target, dimension(:,:) :: & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir - real(wp), intent(inout), target, dimension(:,:,:) :: & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir - real(wp), intent(in) :: tsi_scaling - - type(ty_fluxes_byband) :: fluxes_allsky, fluxes_clrsky - type(ty_gas_concs) :: gas_concentrations - type(ty_optical_props_2str) :: cld_optics, aer_optics - - real(wp), allocatable, dimension(:,:,:) :: gas_vmr_rad - - ! Fluxes from the cxx code - real(wp), dimension(ncol,nlev+1) :: & - allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, allsky_flux_dn_dir_cxx, & - clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, clrsky_flux_dn_dir_cxx - real(wp), dimension(ncol,nlev+1,nswbands) :: & - allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, allsky_bnd_flux_dn_dir_cxx, & - clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx, clrsky_bnd_flux_dn_dir_cxx - - ! Loop indices - integer :: iband, igas, iday, icol - - ! Allocate shortwave fluxes (allsky and clearsky) - fluxes_allsky%flux_up => allsky_flux_up - fluxes_allsky%flux_dn => allsky_flux_dn - fluxes_allsky%flux_net => allsky_flux_net - fluxes_allsky%flux_dn_dir => allsky_flux_dn_dir - fluxes_allsky%bnd_flux_up => allsky_bnd_flux_up - fluxes_allsky%bnd_flux_dn => allsky_bnd_flux_dn - fluxes_allsky%bnd_flux_net => allsky_bnd_flux_net - fluxes_allsky%bnd_flux_dn_dir => allsky_bnd_flux_dn_dir - fluxes_clrsky%flux_up => clrsky_flux_up - fluxes_clrsky%flux_dn => clrsky_flux_dn - fluxes_clrsky%flux_net => clrsky_flux_net - fluxes_clrsky%flux_dn_dir => clrsky_flux_dn_dir - fluxes_clrsky%bnd_flux_up => clrsky_bnd_flux_up - fluxes_clrsky%bnd_flux_dn => clrsky_bnd_flux_dn - fluxes_clrsky%bnd_flux_net => clrsky_bnd_flux_net - fluxes_clrsky%bnd_flux_dn_dir => clrsky_bnd_flux_dn_dir - - ! Populate RRTMGP optics - call handle_error(cld_optics%alloc_2str(ncol, nlev, k_dist_sw, name='shortwave cloud optics')) - cld_optics%tau = 0 - cld_optics%ssa = 1 - cld_optics%g = 0 - cld_optics%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) - cld_optics%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) - cld_optics%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) - - ! Apply delta scaling to account for forward-scattering - call handle_error(cld_optics%delta_scale()) - - ! Initialize aerosol optics; passing only the wavenumber bounds for each - ! "band" rather than passing the full spectral discretization object, and - ! omitting the "g-point" mapping forces the optics to be indexed and - ! stored by band rather than by g-point. This is most consistent with our - ! treatment of aerosol optics in the model, and prevents us from having to - ! map bands to g-points ourselves since that will all be handled by the - ! private routines internal to the optics class. - call handle_error(aer_optics%alloc_2str( & - ncol, nlev, k_dist_sw%get_band_lims_wavenumber(), & - name='shortwave aerosol optics' & - )) - aer_optics%tau = 0 - aer_optics%ssa = 1 - aer_optics%g = 0 - aer_optics%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) - aer_optics%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) - aer_optics%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) - - ! Apply delta scaling to account for forward-scattering - call handle_error(aer_optics%delta_scale()) - - ! Set gas concentrations - call t_startf('rad_set_gases_sw') - call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) - call t_stopf('rad_set_gases_sw') - - call handle_error(rte_sw( & - k_dist_sw, gas_concentrations, & - pmid(1:ncol,1:nlev), & - tmid(1:ncol,1:nlev), & - pint(1:ncol,1:nlev+1), & - coszrs(1:ncol), & - albedo_dir(1:nswbands,1:ncol), & - albedo_dif(1:nswbands,1:ncol), & - cld_optics, & - fluxes_allsky, fluxes_clrsky, & - aer_props=aer_optics, & - tsi_scaling=tsi_scaling & - )) - - ! Try calling C++ version - allocate(gas_vmr_rad(ngas, ncol, nlev)) - gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) - gas_vmr_rad(:,1:ncol,2:nlev) = gas_vmr(:,1:ncol,:) - call rrtmgpxx_run_sw_cpp( & - ngas, ncol, nlev, & - gas_vmr_rad(1:ngas,1:ncol,1:nlev), & - pmid, tmid, pint, coszrs, & - albedo_dir(1:nswbands,1:ncol), albedo_dif(1:nswbands,1:ncol), & - cld_optics%tau, cld_optics%ssa, cld_optics%g, & - aer_optics%tau, aer_optics%ssa, aer_optics%g, & - allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, allsky_flux_dn_dir_cxx, & - allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, allsky_bnd_flux_dn_dir_cxx, & - clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, clrsky_flux_dn_dir_cxx, & - clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx, clrsky_bnd_flux_dn_dir_cxx, & - tsi_scaling & - ) - deallocate(gas_vmr_rad) - - ! Check values - !print *, 'CXX - F90 flux_up error: ', maxval(abs(allsky_flux_up_cxx - allsky_flux_up)) - !print *, 'CXX - F90 flux_dn error: ', maxval(abs(allsky_flux_dn_cxx - allsky_flux_dn)) - !print *, 'CXX - F90 flux_dn_dir error: ', maxval(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir)) - !print *, 'CXX - F90 flux_net error: ', maxval(abs(allsky_flux_net_cxx - allsky_flux_net)) - call assert(all(abs(allsky_flux_up_cxx - allsky_flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') - call assert(all(abs(allsky_flux_dn_cxx - allsky_flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') - call assert(all(abs(allsky_flux_net_cxx - allsky_flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') - call assert(all(abs(allsky_flux_dn_dir_cxx - allsky_flux_dn_dir) < 1e-5), 'F90 and CXX allsky_flux_dn_dir differs.') - call assert(all(abs(clrsky_flux_up_cxx - clrsky_flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') - call assert(all(abs(clrsky_flux_dn_cxx - clrsky_flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') - call assert(all(abs(clrsky_flux_net_cxx - clrsky_flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') - call assert(all(abs(clrsky_flux_dn_dir_cxx - clrsky_flux_dn_dir) < 1e-5), 'F90 and CXX clrsky_flux_dn_dir differs.') - - ! Clean up after ourselves - call free_optics_sw(cld_optics) - call free_optics_sw(aer_optics) - - end subroutine rrtmgpxx_run_sw - ! -------------------------------------------------------------------------- ! Private routines ! -------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index ba682d8bf23d..39ff415aebf5 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -22,7 +22,7 @@ extern "C" double get_max_temperature(); extern "C" void get_gpoint_bands_sw(int *gpoint_bands); extern "C" void get_gpoint_bands_lw(int *gpoint_bands); extern "C" void rrtmgpxx_finalize(); -extern "C" void rrtmgpxx_run_sw_cpp ( +extern "C" void rrtmgpxx_run_sw ( int ngas, int ncol, int nlay, double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, @@ -145,7 +145,7 @@ extern "C" void get_gpoint_bands_lw(int *gpoint_bands_p) { tmp.deep_copy_to(gpoint_bands_lw); } -extern "C" void rrtmgpxx_run_sw_cpp ( +extern "C" void rrtmgpxx_run_sw ( int ngas, int ncol, int nlay, double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, @@ -229,6 +229,7 @@ extern "C" void rrtmgpxx_run_sw_cpp ( aerosol_optics.g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); }); } + aerosol_optics.delta_scale(); aerosol_optics.increment(combined_optics); // Do the clearsky calculation before adding in clouds @@ -247,6 +248,7 @@ extern "C" void rrtmgpxx_run_sw_cpp ( cloud_optics.ssa(icol,ilay,igpt) = cld_ssa_gpt(icol,ilay,igpt); cloud_optics.g (icol,ilay,igpt) = cld_asm_gpt(icol,ilay,igpt); }); + cloud_optics.delta_scale(); cloud_optics.increment(combined_optics); // Call SW flux driver diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 6ee7e528d054..20e6a91ff3d3 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1682,15 +1682,15 @@ subroutine radiation_driver_sw(ncol, & call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) call rrtmgpxx_run_sw( & size(active_gases), nday, nlev_rad, & - gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & + gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & coszrs_day(1:nday), & albedo_dir_day(1:nswbands,1:nday), & albedo_dif_day(1:nswbands,1:nday), & - cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & - aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & + cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & + aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & fluxes_allsky_cxx%flux_up, fluxes_allsky_cxx%flux_dn, fluxes_allsky_cxx%flux_net, fluxes_allsky_cxx%flux_dn_dir, & fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & fluxes_clrsky_cxx%flux_up, fluxes_clrsky_cxx%flux_dn, fluxes_clrsky_cxx%flux_net, fluxes_clrsky_cxx%flux_dn_dir, & diff --git a/components/eam/src/physics/rrtmgp/radiation_utils.F90 b/components/eam/src/physics/rrtmgp/radiation_utils.F90 index 34be77e5ff2e..e217839699a5 100644 --- a/components/eam/src/physics/rrtmgp/radiation_utils.F90 +++ b/components/eam/src/physics/rrtmgp/radiation_utils.F90 @@ -37,7 +37,6 @@ module radiation_utils real(r8), allocatable :: bnd_flux_dn_dir(:,:,:) end type - ! Max length for character strings integer, parameter :: max_char_len = 512 diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index b1860057a77c..ad33712f7145 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -152,9 +152,9 @@ subroutine rrtmgp_run_sw( & cld_optics_sw%tau = 0 cld_optics_sw%ssa = 1 cld_optics_sw%g = 0 - cld_optics_sw%tau(1:ncol,2:nlev,:) = cld_tau_gpt(1:ncol,:,:) - cld_optics_sw%ssa(1:ncol,2:nlev,:) = cld_ssa_gpt(1:ncol,:,:) - cld_optics_sw%g (1:ncol,2:nlev,:) = cld_asm_gpt(1:ncol,:,:) + cld_optics_sw%tau(1:ncol,1:nlev,:) = cld_tau_gpt(1:ncol,:,:) + cld_optics_sw%ssa(1:ncol,1:nlev,:) = cld_ssa_gpt(1:ncol,:,:) + cld_optics_sw%g (1:ncol,1:nlev,:) = cld_asm_gpt(1:ncol,:,:) ! Apply delta scaling to account for forward-scattering call handle_error(cld_optics_sw%delta_scale()) @@ -173,9 +173,9 @@ subroutine rrtmgp_run_sw( & aer_optics_sw%tau = 0 aer_optics_sw%ssa = 1 aer_optics_sw%g = 0 - aer_optics_sw%tau(1:ncol,2:nlev,:) = aer_tau_bnd(1:ncol,1:pver,:) - aer_optics_sw%ssa(1:ncol,2:nlev,:) = aer_ssa_bnd(1:ncol,1:pver,:) - aer_optics_sw%g (1:ncol,2:nlev,:) = aer_asm_bnd(1:ncol,1:pver,:) + aer_optics_sw%tau(1:ncol,1:nlev,:) = aer_tau_bnd(1:ncol,1:nlev,:) + aer_optics_sw%ssa(1:ncol,1:nlev,:) = aer_ssa_bnd(1:ncol,1:nlev,:) + aer_optics_sw%g (1:ncol,1:nlev,:) = aer_asm_bnd(1:ncol,1:nlev,:) ! Apply delta scaling to account for forward-scattering call handle_error(aer_optics_sw%delta_scale()) From 4049804f2540aed20d87969ea1a35031ed93da7e Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Wed, 16 Dec 2020 09:50:50 -0700 Subject: [PATCH 32/71] Remove unused routines from rrtmgpxx_interface.F90 --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 142 ------------------ .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 7 + .../eam/src/physics/rrtmgp/radiation.F90 | 8 +- 3 files changed, 11 insertions(+), 146 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 2da78000dcd6..9302d0356927 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -5,29 +5,12 @@ ! code. module rrtmgpxx_interface - use perf_mod, only: t_startf, t_stopf - use ppgrid, only: pcols, pver, pverp, begchunk, endchunk - use radiation_utils, only: compress_day_columns, expand_day_columns - use radiation_state, only: ktop, kbot, nlev_rad - - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_gas_concentrations, only: ty_gas_concs - use mo_load_coefficients, only: load_and_init - use mo_rte_kind, only: wp - use mo_optical_props, only: ty_optical_props_2str, ty_optical_props_1scl - use mo_fluxes_byband, only: ty_fluxes_byband - use mo_rrtmgp_clr_all_sky, only: rte_sw, rte_lw - use assertions, only: assert use iso_c_binding implicit none private - ! Gas optics objects that hold k-distribution information. These are made - ! module variables because we only want to initialize them once at init time. - type(ty_gas_optics_rrtmgp) :: k_dist_sw, k_dist_lw - ! Make these module variables so that we do not have to provide access to ! k_dist objects; this just makes it easier to switch between F90 and C++ ! interfaces. @@ -165,20 +148,6 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ use iso_c_binding, only: C_CHAR, C_NULL_CHAR character(len=*), intent(in) :: active_gases(:) character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw - type(ty_gas_concs) :: available_gases - ! Read gas optics coefficients from file - ! Need to initialize available_gases here! The only field of the - ! available_gases type that is used int he kdist initialize is - ! available_gases%gas_name, which gives the name of each gas that would be - ! present in the ty_gas_concs object. So, we can just set this here, rather - ! than trying to fully populate the ty_gas_concs object here, which would be - ! impossible from this initialization routine because I do not thing the - ! rad_cnst objects are setup yet. - ! the other tasks! - ! TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast - call set_available_gases(active_gases, available_gases) - call load_and_init(k_dist_sw, coefficients_file_sw, available_gases) - call load_and_init(k_dist_lw, coefficients_file_lw, available_gases) ! Add active gases call add_gases(active_gases) ! Initialize RRTMGP @@ -198,26 +167,6 @@ end subroutine rrtmgpxx_initialize ! Private routines ! -------------------------------------------------------------------------- - subroutine set_available_gases(gases, gas_concentrations) - - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - - type(ty_gas_concs), intent(inout) :: gas_concentrations - character(len=*), intent(in) :: gases(:) - character(len=32), dimension(size(gases)) :: gases_lowercase - integer :: igas - - ! Initialize with lowercase gas names; we should work in lowercase - ! whenever possible because we cannot trust string comparisons in RRTMGP - ! to be case insensitive - do igas = 1,size(gases) - gases_lowercase(igas) = trim(lower_case(gases(igas))) - end do - call handle_error(gas_concentrations%init(gases_lowercase)) - - end subroutine set_available_gases - subroutine add_gases(gases) use mo_rrtmgp_util_string, only: lower_case use iso_c_binding, only: C_CHAR, C_NULL_CHAR @@ -230,97 +179,6 @@ end subroutine add_gases !---------------------------------------------------------------------------- - subroutine free_optics_sw(optics) - use mo_optical_props, only: ty_optical_props_2str - type(ty_optical_props_2str), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - if (allocated(optics%ssa)) deallocate(optics%ssa) - if (allocated(optics%g)) deallocate(optics%g) - call optics%finalize() - end subroutine free_optics_sw - - !---------------------------------------------------------------------------- - - subroutine free_optics_lw(optics) - use mo_optical_props, only: ty_optical_props_1scl - type(ty_optical_props_1scl), intent(inout) :: optics - if (allocated(optics%tau)) deallocate(optics%tau) - call optics%finalize() - end subroutine free_optics_lw - - !---------------------------------------------------------------------------- - - ! Compress optics arrays to smaller arrays containing only daytime columns. - ! This is to work with the RRTMGP shortwave routines that will fail if they - ! encounter non-sunlit columns, and also allows us to perform less - ! computations. This routine is primarily a convenience routine to do all of - ! the shortwave optics arrays at once, as we do this for individual arrays - ! elsewhere in the code. - subroutine compress_optics_sw(day_indices, tau, ssa, asm, tau_day, ssa_day, asm_day) - integer, intent(in), dimension(:) :: day_indices - real(wp), intent(in), dimension(:,:,:) :: tau, ssa, asm - real(wp), intent(out), dimension(:,:,:) :: tau_day, ssa_day, asm_day - integer :: nday, iday, ilev, ibnd - nday = count(day_indices > 0) - do ibnd = 1,size(tau,3) - do ilev = 1,size(tau,2) - do iday = 1,nday - tau_day(iday,ilev,ibnd) = tau(day_indices(iday),ilev,ibnd) - ssa_day(iday,ilev,ibnd) = ssa(day_indices(iday),ilev,ibnd) - asm_day(iday,ilev,ibnd) = asm(day_indices(iday),ilev,ibnd) - end do - end do - end do - end subroutine compress_optics_sw - - - subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) - use mo_gas_concentrations, only: ty_gas_concs - use mo_rrtmgp_util_string, only: lower_case - - integer, intent(in) :: ncol - character(len=*), intent(in), dimension(:) :: gas_names - real(wp), intent(in), dimension(:,:,:) :: gas_vmr - type(ty_gas_concs), intent(out) :: gas_concentrations - - ! Local variables - real(wp), dimension(ncol,nlev_rad) :: vol_mix_ratio_out - - ! Loop indices - integer :: igas - - ! Character array to hold lowercase gas names - character(len=32), allocatable :: gas_names_lower(:) - - ! Name of subroutine for error messages - character(len=32) :: subname = 'set_gas_concentrations' - - ! Initialize gas concentrations with lower case names - allocate(gas_names_lower(size(gas_names))) - do igas = 1,size(gas_names) - gas_names_lower(igas) = trim(lower_case(gas_names(igas))) - end do - call handle_error(gas_concentrations%init(gas_names_lower)) - - ! For each gas, add level above model top and set values in RRTMGP object - do igas = 1,size(gas_names) - vol_mix_ratio_out = 0 - ! Map to radiation grid - vol_mix_ratio_out(1:ncol,ktop:kbot) = gas_vmr(igas,1:ncol,1:pver) - ! Copy top-most model level to top-most rad level (which could be above - ! the top of the model) - vol_mix_ratio_out(1:ncol,1) = gas_vmr(igas,1:ncol,1) - ! Set volumn mixing ratio in gas concentration object for just columns - ! in this chunk - call handle_error(gas_concentrations%set_vmr( & - trim(lower_case(gas_names(igas))), vol_mix_ratio_out(1:ncol,1:nlev_rad)) & - ) - end do - - end subroutine set_gas_concentrations - - !---------------------------------------------------------------------------- - ! Stop run ungracefully since we don't want dependencies on E3SM abortutils ! here subroutine handle_error(msg) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index 39ff415aebf5..005458fa47b8 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -183,6 +183,10 @@ extern "C" void rrtmgpxx_run_sw ( auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); // Populate gas concentrations object + // TODO: clean this up. We could keep gas_concs in file scope, and then + // also maybe update the gas concs directly from gas_vmr via a parallel_for + // rather than going through the set_vmr method, since we are not passing + // the gas names through this interface anyways. string1d gas_names("gas_names", gas_names_vect.size()); convert_gas_names(gas_names); GasConcs gas_concs; @@ -199,6 +203,7 @@ extern "C" void rrtmgpxx_run_sw ( } // Do gas optics + // TODO: should we avoid allocating here? OpticalProps2str combined_optics; combined_optics.alloc_2str(ncol, nlay, k_dist_sw); auto pmid_host = pmid.createHostCopy(); @@ -212,6 +217,7 @@ extern "C" void rrtmgpxx_run_sw ( }); // Add in aerosol + // TODO: should we avoid allocating here? OpticalProps2str aerosol_optics; if (true) { aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw); @@ -233,6 +239,7 @@ extern "C" void rrtmgpxx_run_sw ( aerosol_optics.increment(combined_optics); // Do the clearsky calculation before adding in clouds + // TODO: we need band-by-band fluxes too FluxesBroadband fluxes_clrsky; fluxes_clrsky.flux_up = clrsky_flux_up; fluxes_clrsky.flux_dn = clrsky_flux_dn; diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 20e6a91ff3d3..fb56fd8d02c7 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1654,6 +1654,8 @@ subroutine radiation_driver_sw(ncol, & aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd_day(:,:,:) aer_ssa_bnd_rad(:,ktop:kbot,:) = aer_ssa_bnd_day(:,:,:) aer_asm_bnd_rad(:,ktop:kbot,:) = aer_asm_bnd_day(:,:,:) + gas_vmr_rad(:,:nday,1) = gas_vmr_day(:,:nday,1) + gas_vmr_rad(:,:nday,ktop:kbot) = gas_vmr_day(:,:nday,1:pver) ! Do shortwave radiative transfer calculations call t_startf('rad_rrtmgp_run_sw') @@ -1676,8 +1678,6 @@ subroutine radiation_driver_sw(ncol, & ) call t_stopf('rad_rrtmgp_run_sw') call t_startf('rad_rrtmgpxx_run_sw') - gas_vmr_rad(:,:nday,1) = gas_vmr_day(:,:nday,1) - gas_vmr_rad(:,:nday,2:nlev_rad) = gas_vmr_day(:,:nday,1:pver) call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_cxx, do_direct=.true.) call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) call rrtmgpxx_run_sw( & @@ -1691,9 +1691,9 @@ subroutine radiation_driver_sw(ncol, & albedo_dif_day(1:nswbands,1:nday), & cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & - fluxes_allsky_cxx%flux_up, fluxes_allsky_cxx%flux_dn, fluxes_allsky_cxx%flux_net, fluxes_allsky_cxx%flux_dn_dir, & + fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , fluxes_allsky_cxx%flux_dn_dir , & fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & - fluxes_clrsky_cxx%flux_up, fluxes_clrsky_cxx%flux_dn, fluxes_clrsky_cxx%flux_net, fluxes_clrsky_cxx%flux_dn_dir, & + fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , fluxes_clrsky_cxx%flux_dn_dir , & fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net, fluxes_clrsky_cxx%bnd_flux_dn_dir, & tsi_scaling & ) From c0a662e28c3e70dc7f5baeb044c5700afa0efdbf Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 17 Dec 2020 18:07:38 -0700 Subject: [PATCH 33/71] Refactor handling of string arrays Refactor code to handle passing string arrays for gas names from F90 to C++. Instead of needing a separate interface to add gases one by one to the C++ interface, pass a C pointer to an array of null-terminated strings to the C++ interface. To simplify this, we add a function that takes an F90 string array, appends the C_NULL_CHAR to the end of each element, and returns a C pointer. To workaround a strange issue with moving this to a function, we also need to return the array of converted strings that the pointer references. All this allows us to nearly directly call the C++ version of the rrtmgpxx_initialize and run routines, and remove quite a bit of boiler plate code. --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 74 +++++++++---------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 66 ++++++----------- .../eam/src/physics/rrtmgp/radiation.F90 | 44 ++++++----- 3 files changed, 85 insertions(+), 99 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index 9302d0356927..f7654025f457 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -22,7 +22,8 @@ module rrtmgpxx_interface get_nband_sw, get_nband_lw, & get_ngpt_sw, get_ngpt_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - get_min_temperature, get_max_temperature + get_min_temperature, get_max_temperature, & + c_strarr interface @@ -74,9 +75,11 @@ subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") integer(c_int), dimension(*) :: gpoint_bands end subroutine - subroutine rrtmgpxx_initialize_cpp(coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") - use iso_c_binding, only: C_CHAR, C_NULL_CHAR + subroutine rrtmgpxx_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") + use iso_c_binding implicit none + integer(kind=c_int), value :: ngas + type(c_ptr), dimension(*) :: gas_names character(kind=c_char) :: coefficients_file_sw(*) character(kind=c_char) :: coefficients_file_lw(*) end subroutine rrtmgpxx_initialize_cpp @@ -86,7 +89,7 @@ end subroutine rrtmgpxx_finalize subroutine rrtmgpxx_run_sw( & ngas, ncol, nlev, & - gas_vmr, & + gas_names, gas_vmr, & pmid, tmid, pint, coszrs, & albedo_dir, albedo_dif, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & @@ -100,6 +103,7 @@ subroutine rrtmgpxx_run_sw( & use iso_c_binding implicit none integer(kind=c_int), value :: ngas, ncol, nlev + type(c_ptr), dimension(*) :: gas_names real(kind=c_double), dimension(*) :: & gas_vmr, pmid, tmid, pint, coszrs, albedo_dir, albedo_dif, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & @@ -113,7 +117,7 @@ end subroutine rrtmgpxx_run_sw subroutine rrtmgpxx_run_lw ( & ngas, ncol, nlev, & - gas_vmr, & + gas_names, gas_vmr, & pmid, tmid, pint, tint, & surface_emissivity, & cld_tau, aer_tau, & @@ -125,6 +129,7 @@ subroutine rrtmgpxx_run_lw ( & use iso_c_binding implicit none integer(kind=c_int), value :: ngas, ncol, nlev + type(c_ptr), dimension(*) :: gas_names real(kind=c_double), dimension(*) :: & gas_vmr, & pmid, tmid, pint, tint, surface_emissivity, & @@ -135,11 +140,6 @@ subroutine rrtmgpxx_run_lw ( & clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx end subroutine rrtmgpxx_run_lw - subroutine add_gas_name(gas_name) bind(C, name="add_gas_name") - use iso_c_binding, only: C_CHAR - character(kind=c_char) :: gas_name - end subroutine add_gas_name - end interface contains @@ -148,10 +148,13 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ use iso_c_binding, only: C_CHAR, C_NULL_CHAR character(len=*), intent(in) :: active_gases(:) character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw - ! Add active gases - call add_gases(active_gases) + character(len=len(active_gases)+1), dimension(size(active_gases)), target :: active_gases_c + integer :: igas + ! Initialize RRTMGP call rrtmgpxx_initialize_cpp( & + size(active_gases), & + c_strarr(active_gases, active_gases_c), & C_CHAR_""//trim(coefficients_file_sw)//C_NULL_CHAR, & C_CHAR_""//trim(coefficients_file_lw)//C_NULL_CHAR & ) @@ -163,30 +166,27 @@ subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_ nlwgpts = get_ngpt_lw() end subroutine rrtmgpxx_initialize - ! -------------------------------------------------------------------------- - ! Private routines - ! -------------------------------------------------------------------------- - - subroutine add_gases(gases) - use mo_rrtmgp_util_string, only: lower_case - use iso_c_binding, only: C_CHAR, C_NULL_CHAR - character(len=*), intent(in) :: gases(:) - integer :: igas - do igas = 1,size(gases) - call add_gas_name(trim(lower_case(gases(igas)))//C_NULL_CHAR) + ! Utility function to convert F90 string arrays to C-compatible string + ! pointers; NOTE: str_c seems to need to be intent(out), or else the first + ! element in the pointer array is messed up for some reason. + function c_strarr(str, str_c) result(str_p) + use iso_c_binding + implicit none + character(len=*), dimension(:), intent(in) :: str + character(len=*), dimension(:), target, intent(out) :: str_c + type(c_ptr), dimension(size(str)) :: str_p + integer :: istr + do istr = 1,size(str) + str_c(istr) = trim(str(istr))//C_NULL_CHAR + str_p(istr) = c_loc(str_c(istr)) end do - end subroutine add_gases - - !---------------------------------------------------------------------------- - - ! Stop run ungracefully since we don't want dependencies on E3SM abortutils - ! here - subroutine handle_error(msg) - character(len=*), intent(in) :: msg - if (trim(msg) .ne. '') then - print *, trim(msg) - stop - end if - end subroutine handle_error - + end function c_strarr + +! function c_string(str) result(str_c) +! implicit none +! use iso_c_binding +! character(len=*), intent(in) :: str +! character(kind=c_char) :: str_c +! str_c = trim(str)//C_NULL_CHAR +! end function c_string end module rrtmgpxx_interface diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index 005458fa47b8..bcddefd53a47 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -10,9 +10,6 @@ using yakl::intrinsics::minval; using yakl::intrinsics::maxval; // Prototypes -extern "C" void add_gas_name(char const *gas_name); -extern "C" void convert_gas_names(string1d &gas_names); -extern "C" void vect_to_string1d(std::vector vect, string1d strarr); extern "C" int get_nband_sw(); extern "C" int get_nband_lw(); extern "C" int get_ngpt_sw(); @@ -24,7 +21,7 @@ extern "C" void get_gpoint_bands_lw(int *gpoint_bands); extern "C" void rrtmgpxx_finalize(); extern "C" void rrtmgpxx_run_sw ( int ngas, int ncol, int nlay, - double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, + char *gas_names_p[], double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, double *cld_tau_gpt_p, double *cld_ssa_gpt_p, double *cld_asm_gpt_p, double *aer_tau_bnd_p, double *aer_ssa_bnd_p, double *aer_asm_bnd_p, @@ -36,7 +33,7 @@ extern "C" void rrtmgpxx_run_sw ( ); extern "C" void rrtmgpxx_run_lw ( int ngas, int ncol, int nlay, - double *gas_vmr_p , + char *gas_names_p[], double *gas_vmr_p , double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, double *emis_sfc_p , double *cld_tau_gpt_p , double *aer_tau_bnd_p , @@ -46,15 +43,14 @@ extern "C" void rrtmgpxx_run_lw ( double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p ); +// Objects live here in file scope because they need to be initialized just *once* GasOpticsRRTMGP k_dist_sw; GasOpticsRRTMGP k_dist_lw; // Vector of strings to hold active gas names. -// These need to be added at runtime, one by one, -// via the add_gas_name function. -std::vector gas_names_vect; +//string1d gas_names1d; -extern "C" void rrtmgpxx_initialize_cpp(char const *coefficients_file_sw, char const *coefficients_file_lw) { +extern "C" void rrtmgpxx_initialize_cpp(int ngas, char *gas_names[], char const *coefficients_file_sw, char const *coefficients_file_lw) { // First, make sure yakl has been initialized if (!yakl::isInitialized()) { yakl::init(); @@ -62,22 +58,19 @@ extern "C" void rrtmgpxx_initialize_cpp(char const *coefficients_file_sw, char c // Read gas optics coefficients from file // Need to initialize available_gases here! The only field of the - // available_gases type that is used int he kdist initialize is + // available_gases type that is used in the kdist initialize is // available_gases%gas_name, which gives the name of each gas that would be // present in the ty_gas_concs object. So, we can just set this here, rather // than trying to fully populate the ty_gas_concs object here, which would be // impossible from this initialization routine because I do not thing the // rad_cnst objects are setup yet. // the other tasks! - // TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast - //gas_names = string1d("gas_names", 8); - // - // Let us cheat for a moment and hard-code the gases. - // TODO: fix this! - string1d gas_names("gas_names", gas_names_vect.size()); - convert_gas_names(gas_names); + string1d gas_names1d("gas_names1d", ngas); + for (int igas=0; igas vect, string1d strarr) { - int n = vect.size(); - for (int i = 0; i < n; i++) { - strarr(i+1) = vect[i]; - } -} - extern "C" int get_nband_sw() { return k_dist_sw.get_nband(); } @@ -147,7 +119,7 @@ extern "C" void get_gpoint_bands_lw(int *gpoint_bands_p) { extern "C" void rrtmgpxx_run_sw ( int ngas, int ncol, int nlay, - double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, + char *gas_names_p[], double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, double *cld_tau_gpt_p, double *cld_ssa_gpt_p, double *cld_asm_gpt_p, double *aer_tau_bnd_p, double *aer_ssa_bnd_p, double *aer_asm_bnd_p, @@ -187,8 +159,10 @@ extern "C" void rrtmgpxx_run_sw ( // also maybe update the gas concs directly from gas_vmr via a parallel_for // rather than going through the set_vmr method, since we are not passing // the gas names through this interface anyways. - string1d gas_names("gas_names", gas_names_vect.size()); - convert_gas_names(gas_names); + string1d gas_names("gas_names", ngas); + for (int igas = 1; igas<=ngas; igas++) { + gas_names(igas) = gas_names_p[igas-1]; + } GasConcs gas_concs; gas_concs.init(gas_names, ncol, nlay); real2d tmp2d; @@ -269,7 +243,7 @@ extern "C" void rrtmgpxx_run_sw ( extern "C" void rrtmgpxx_run_lw ( int ngas, int ncol, int nlay, - double *gas_vmr_p , + char *gas_names_p[] , double *gas_vmr_p , double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, double *emis_sfc_p , double *cld_tau_gpt_p , double *aer_tau_bnd_p , @@ -297,8 +271,10 @@ extern "C" void rrtmgpxx_run_lw ( auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); // Populate gas concentrations - string1d gas_names("gas_names", gas_names_vect.size()); - convert_gas_names(gas_names); + string1d gas_names("gas_names", ngas); + for (int igas = 1; igas<=ngas; igas++) { + gas_names(igas) = gas_names_p[igas-1]; + } GasConcs gas_concs; gas_concs.init(gas_names, ncol, nlay); real2d tmp2d; diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index fb56fd8d02c7..80d20a44e360 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -11,6 +11,7 @@ module radiation ! E3SM-specific modules that are used throughout this module. An effort was made ! to keep imports as local as possible, so we only load a few of these at the ! module (rather than the subroutine) level. + use iso_c_binding use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use cam_abortutils, only: endrun @@ -31,17 +32,18 @@ module radiation rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & rrtmgp_get_min_temperature => get_min_temperature, & rrtmgp_get_max_temperature => get_max_temperature, & - get_gpoint_bands_sw, get_gpoint_bands_lw + get_gpoint_bands_sw, get_gpoint_bands_lw, & + nswgpts, nlwgpts use rrtmgpxx_interface, only: & - rrtmgpxx_initialize, rrtmgpxx_finalize, & + rrtmgpxx_initialize_cpp, rrtmgpxx_finalize, & rrtmgpxx_run_sw, rrtmgpxx_run_lw, & rrtmgpxx_get_min_temperature => get_min_temperature, & rrtmgpxx_get_max_temperature => get_max_temperature, & rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & + c_strarr, & get_nband_sw, get_nband_lw, & - get_ngpt_sw, get_ngpt_lw, & - nswgpts, nlwgpts + get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -175,6 +177,9 @@ module radiation 'H2O', 'CO2', 'O3 ', 'N2O', & 'CO ', 'CH4', 'O2 ', 'N2 ' & /) + ! Null-terminated C-compatible version of active gases for use with C++ + ! routines. + character(len=len(active_gases)+1), dimension(size(active_gases)), target :: active_gases_c ! Stuff to generate random numbers for perturbation growth tests. This needs to ! be public module data because restart_physics needs to read it to write it to @@ -491,11 +496,15 @@ subroutine radiation_init(state) ! Setup the RRTMGP interface call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) - call rrtmgpxx_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) + call rrtmgpxx_initialize_cpp( & + size(active_gases), c_strarr(active_gases, active_gases_c), & + trim(rrtmgp_coefficients_file_sw)//C_NULL_CHAR, & + trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & + ) ! Make sure number of bands in absorption coefficient files matches what we expect - call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') - call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') + !call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') + !call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') call assert(nswbands == get_nband_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') call assert(nlwbands == get_nband_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') @@ -1645,17 +1654,17 @@ subroutine radiation_driver_sw(ncol, & cld_tau_gpt_rad = 0 cld_ssa_gpt_rad = 0 cld_asm_gpt_rad = 0 - cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt_day(:,:,:) - cld_ssa_gpt_rad(:,ktop:kbot,:) = cld_ssa_gpt_day(:,:,:) - cld_asm_gpt_rad(:,ktop:kbot,:) = cld_asm_gpt_day(:,:,:) + cld_tau_gpt_rad(1:nday,ktop:kbot,:) = cld_tau_gpt_day(1:nday,1:pver,:) + cld_ssa_gpt_rad(1:nday,ktop:kbot,:) = cld_ssa_gpt_day(1:nday,1:pver,:) + cld_asm_gpt_rad(1:nday,ktop:kbot,:) = cld_asm_gpt_day(1:nday,1:pver,:) aer_tau_bnd_rad = 0 aer_ssa_bnd_rad = 0 aer_asm_bnd_rad = 0 - aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd_day(:,:,:) - aer_ssa_bnd_rad(:,ktop:kbot,:) = aer_ssa_bnd_day(:,:,:) - aer_asm_bnd_rad(:,ktop:kbot,:) = aer_asm_bnd_day(:,:,:) - gas_vmr_rad(:,:nday,1) = gas_vmr_day(:,:nday,1) - gas_vmr_rad(:,:nday,ktop:kbot) = gas_vmr_day(:,:nday,1:pver) + aer_tau_bnd_rad(1:nday,ktop:kbot,:) = aer_tau_bnd_day(1:nday,:,:) + aer_ssa_bnd_rad(1:nday,ktop:kbot,:) = aer_ssa_bnd_day(1:nday,:,:) + aer_asm_bnd_rad(1:nday,ktop:kbot,:) = aer_asm_bnd_day(1:nday,:,:) + gas_vmr_rad(:,1:nday,1) = gas_vmr_day(:,1:nday,1) + gas_vmr_rad(:,1:nday,ktop:kbot) = gas_vmr_day(:,1:nday,1:pver) ! Do shortwave radiative transfer calculations call t_startf('rad_rrtmgp_run_sw') @@ -1682,7 +1691,7 @@ subroutine radiation_driver_sw(ncol, & call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) call rrtmgpxx_run_sw( & size(active_gases), nday, nlev_rad, & - gas_vmr_rad(:,1:nday,1:nlev_rad), & + c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & @@ -1738,6 +1747,7 @@ subroutine radiation_driver_sw(ncol, & end subroutine radiation_driver_sw + !---------------------------------------------------------------------------- ! Utility function to reorder an array given a new indexing @@ -1895,7 +1905,7 @@ subroutine radiation_driver_lw(ncol, & gas_vmr_rad(:,1:ncol,2:nlev_rad) = gas_vmr(:,1:ncol,:) call rrtmgpxx_run_lw( & size(active_gases), ncol, nlev_rad, & - gas_vmr_rad(:,1:ncol,:), & + c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & surface_emissivity(1:nlwbands,1:ncol), & cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & From 07e21677049c0a7dd688427188d5931c7f1cd6ac Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 17 Dec 2020 18:16:26 -0700 Subject: [PATCH 34/71] Replace rrtmgpxx_interface with rrtmgpxx_interface_cpp --- .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 26 ++----------------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 2 +- .../eam/src/physics/rrtmgp/radiation.F90 | 4 +-- 3 files changed, 5 insertions(+), 27 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 index f7654025f457..603d64c5fd89 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 @@ -75,14 +75,14 @@ subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") integer(c_int), dimension(*) :: gpoint_bands end subroutine - subroutine rrtmgpxx_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize_cpp") + subroutine rrtmgpxx_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize") use iso_c_binding implicit none integer(kind=c_int), value :: ngas type(c_ptr), dimension(*) :: gas_names character(kind=c_char) :: coefficients_file_sw(*) character(kind=c_char) :: coefficients_file_lw(*) - end subroutine rrtmgpxx_initialize_cpp + end subroutine rrtmgpxx_initialize subroutine rrtmgpxx_finalize() bind(C, name="rrtmgpxx_finalize") end subroutine rrtmgpxx_finalize @@ -144,28 +144,6 @@ end subroutine rrtmgpxx_run_lw contains - subroutine rrtmgpxx_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) - use iso_c_binding, only: C_CHAR, C_NULL_CHAR - character(len=*), intent(in) :: active_gases(:) - character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw - character(len=len(active_gases)+1), dimension(size(active_gases)), target :: active_gases_c - integer :: igas - - ! Initialize RRTMGP - call rrtmgpxx_initialize_cpp( & - size(active_gases), & - c_strarr(active_gases, active_gases_c), & - C_CHAR_""//trim(coefficients_file_sw)//C_NULL_CHAR, & - C_CHAR_""//trim(coefficients_file_lw)//C_NULL_CHAR & - ) - ! Set number of bands based on what we read in from input data - nswbands = get_nband_sw() - nlwbands = get_nband_lw() - ! Number of gpoints depend on inputdata, so initialize here - nswgpts = get_ngpt_sw() - nlwgpts = get_ngpt_lw() - end subroutine rrtmgpxx_initialize - ! Utility function to convert F90 string arrays to C-compatible string ! pointers; NOTE: str_c seems to need to be intent(out), or else the first ! element in the pointer array is messed up for some reason. diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index bcddefd53a47..f70b136f84a1 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -50,7 +50,7 @@ GasOpticsRRTMGP k_dist_lw; // Vector of strings to hold active gas names. //string1d gas_names1d; -extern "C" void rrtmgpxx_initialize_cpp(int ngas, char *gas_names[], char const *coefficients_file_sw, char const *coefficients_file_lw) { +extern "C" void rrtmgpxx_initialize(int ngas, char *gas_names[], char const *coefficients_file_sw, char const *coefficients_file_lw) { // First, make sure yakl has been initialized if (!yakl::isInitialized()) { yakl::init(); diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 80d20a44e360..cfa11b895d60 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -35,7 +35,7 @@ module radiation get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts use rrtmgpxx_interface, only: & - rrtmgpxx_initialize_cpp, rrtmgpxx_finalize, & + rrtmgpxx_initialize, rrtmgpxx_finalize, & rrtmgpxx_run_sw, rrtmgpxx_run_lw, & rrtmgpxx_get_min_temperature => get_min_temperature, & rrtmgpxx_get_max_temperature => get_max_temperature, & @@ -496,7 +496,7 @@ subroutine radiation_init(state) ! Setup the RRTMGP interface call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) - call rrtmgpxx_initialize_cpp( & + call rrtmgpxx_initialize( & size(active_gases), c_strarr(active_gases, active_gases_c), & trim(rrtmgp_coefficients_file_sw)//C_NULL_CHAR, & trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & From d9e1ab5ba0e6cc1f69bc00c9961b5cf205bd7acc Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 18 Dec 2020 11:05:54 -0700 Subject: [PATCH 35/71] Move handling extra level for gases to radiation_driver --- .../eam/src/physics/rrtmgp/radiation.F90 | 14 +++++--------- .../src/physics/rrtmgp/rrtmgp_interface.F90 | 18 ++---------------- 2 files changed, 7 insertions(+), 25 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index cfa11b895d60..84d11030ba6f 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -1640,9 +1640,6 @@ subroutine radiation_driver_sw(ncol, & end do ! Allocate shortwave fluxes (allsky and clearsky) - ! TODO: why do I need to provide my own routines to do this? Why is - ! this not part of the fluxes_t object? - ! ! NOTE: fluxes defined at interfaces, so initialize to have vertical ! dimension nlev_rad+1, while we initialized the RRTMGP input variables to ! have vertical dimension nlev_rad (defined at midpoints). @@ -1650,7 +1647,7 @@ subroutine radiation_driver_sw(ncol, & call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) ! Add an empty level above model top - ! TODO: handle gases here too + ! TODO: combine with day compression above cld_tau_gpt_rad = 0 cld_ssa_gpt_rad = 0 cld_asm_gpt_rad = 0 @@ -1670,7 +1667,7 @@ subroutine radiation_driver_sw(ncol, & call t_startf('rad_rrtmgp_run_sw') call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & - gas_names, gas_vmr_day, & + gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & @@ -1877,17 +1874,18 @@ subroutine radiation_driver_lw(ncol, & surface_emissivity(1:nlwbands,1:ncol) = 1.0_r8 ! Add an empty level above model top - ! TODO: handle gases here too cld_tau_gpt_rad = 0 cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt(:,:,:) aer_tau_bnd_rad = 0 aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd(:,:,:) + gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) + gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Do longwave radiative transfer calculations call t_startf('rrtmgp_run_lw') call rrtmgp_run_lw( & size(active_gases), ncol, nlev_rad, & - gas_names, gas_vmr(:,1:ncol,:), & + gas_names, gas_vmr_rad(:,1:ncol,1:nlev_rad), & surface_emissivity(1:nlwbands,1:ncol), & pmid(1:ncol,:), tmid(1:ncol,:), pint(1:ncol,:), tint(1:ncol,:), & cld_tau_gpt_rad(1:ncol,:,:), aer_tau_bnd_rad(1:ncol,:,:), & @@ -1901,8 +1899,6 @@ subroutine radiation_driver_lw(ncol, & ! Try calling C++ version call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky_cxx) call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky_cxx) - gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) - gas_vmr_rad(:,1:ncol,2:nlev_rad) = gas_vmr(:,1:ncol,:) call rrtmgpxx_run_lw( & size(active_gases), ncol, nlev_rad, & c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 index ad33712f7145..4fac2ab2e537 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 @@ -380,18 +380,12 @@ subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) real(wp), intent(in), dimension(:,:,:) :: gas_vmr type(ty_gas_concs), intent(out) :: gas_concentrations - ! Local variables - real(wp), dimension(ncol,nlev_rad) :: vol_mix_ratio_out - ! Loop indices integer :: igas ! Character array to hold lowercase gas names character(len=32), allocatable :: gas_names_lower(:) - ! Name of subroutine for error messages - character(len=32) :: subname = 'set_gas_concentrations' - ! Initialize gas concentrations with lower case names allocate(gas_names_lower(size(gas_names))) do igas = 1,size(gas_names) @@ -399,18 +393,10 @@ subroutine set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) end do call handle_error(gas_concentrations%init(gas_names_lower)) - ! For each gas, add level above model top and set values in RRTMGP object + ! Set gas concentrations do igas = 1,size(gas_names) - vol_mix_ratio_out = 0 - ! Map to radiation grid - vol_mix_ratio_out(1:ncol,ktop:kbot) = gas_vmr(igas,1:ncol,1:pver) - ! Copy top-most model level to top-most rad level (which could be above - ! the top of the model) - vol_mix_ratio_out(1:ncol,1) = gas_vmr(igas,1:ncol,1) - ! Set volumn mixing ratio in gas concentration object for just columns - ! in this chunk call handle_error(gas_concentrations%set_vmr( & - trim(lower_case(gas_names(igas))), vol_mix_ratio_out(1:ncol,1:nlev_rad)) & + trim(lower_case(gas_names(igas))), gas_vmr(igas,1:ncol,:)) & ) end do From 684de5556b3e493befe614f4489b0faaf694ac23 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 15 Jan 2021 13:51:43 -0700 Subject: [PATCH 36/71] Add radiation_final() call for MMF --- components/eam/src/physics/crm/physpkg.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/components/eam/src/physics/crm/physpkg.F90 b/components/eam/src/physics/crm/physpkg.F90 index d7c4d796840e..e14cbc67e75b 100644 --- a/components/eam/src/physics/crm/physpkg.F90 +++ b/components/eam/src/physics/crm/physpkg.F90 @@ -986,6 +986,7 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) use chemistry, only : chem_final use wv_saturation, only : wv_sat_final use crm_physics, only : crm_physics_final + use radiation, only : radiation_final !----------------------------------------------------------------------- ! Purpose: Finalization of physics package !----------------------------------------------------------------------- @@ -1011,6 +1012,10 @@ subroutine phys_final( phys_state, phys_tend, pbuf2d ) call wv_sat_final call t_stopf ('wv_sat_final') + call t_startf ('radiation_final') + call radiation_final() + call t_stopf ('radiation_final') + call t_startf ('crm_physics_final') call crm_physics_final() call t_stopf ('crm_physics_final') From 63d1144e8f4e62f1103bdf2fba811f6a0dcb8865 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 15 Jan 2021 13:52:09 -0700 Subject: [PATCH 37/71] Remove duplicate aero optics to make MMF BFB again --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 205 ++++++++++-------- 1 file changed, 113 insertions(+), 92 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 8abd9f535690..b2f86a5f42aa 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -11,6 +11,7 @@ module radiation ! E3SM-specific modules that are used throughout this module. An effort was made ! to keep imports as local as possible, so we only load a few of these at the ! module (rather than the subroutine) level. + use iso_c_binding use shr_kind_mod, only: r8=>shr_kind_r8, cl=>shr_kind_cl use ppgrid, only: pcols, pver, pverp, begchunk, endchunk use cam_abortutils, only: endrun @@ -35,6 +36,16 @@ module radiation rrtmgp_get_max_temperature => get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts + use rrtmgpxx_interface, only: & + rrtmgpxx_initialize, rrtmgpxx_finalize, & + rrtmgpxx_run_sw, rrtmgpxx_run_lw, & + rrtmgpxx_get_min_temperature => get_min_temperature, & + rrtmgpxx_get_max_temperature => get_max_temperature, & + rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & + rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & + c_strarr, & + get_nband_sw, get_nband_lw, & + get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -69,6 +80,7 @@ module radiation radiation_nextsw_cday, &! calendar day of next radiation calculation radiation_do, &! query which radiation calcs are done this timestep radiation_init, &! calls radini + radiation_final, &! deallocate radiation_readnl, &! read radiation namelist radiation_tend ! moved from radctl.F90 @@ -170,6 +182,10 @@ module radiation 'CO ', 'CH4', 'O2 ', 'N2 ' & /) + ! Null-terminated C-compatible version of active gases for use with C++ + ! routines. + character(len=len(active_gases)+1), dimension(size(active_gases)), target :: active_gases_c + ! Stuff to generate random numbers for perturbation growth tests. This needs to ! be public module data because restart_physics needs to read it to write it to ! restart files (I think). Making this public module data may not be the best @@ -487,11 +503,30 @@ subroutine radiation_init(state) ! Setup the RRTMGP interface call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) + call rrtmgpxx_initialize( & + size(active_gases), c_strarr(active_gases, active_gases_c), & + trim(rrtmgp_coefficients_file_sw)//C_NULL_CHAR, & + trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & + ) ! Make sure number of bands in absorption coefficient files matches what we expect call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') + ! Make sure number of bands in absorption coefficient files matches what we expect + !call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') + !call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') + call assert(nswbands == get_nband_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') + call assert(nlwbands == get_nband_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') + + ! Check that gpoints are consistent after initialization + call assert(nswgpts == get_ngpt_sw(), 'nswgpts does not match RRTMGPXX absorption coefficient data') + call assert(nlwgpts == get_ngpt_lw(), 'nlwgpts does not match RRTMGPXX absorption coefficient data') + + ! Check that min and max temperatures are consistent + call assert(rrtmgp_get_min_temperature() == rrtmgpxx_get_min_temperature(), 'RRTMGP and RRTMGPXX min temperatures do not match.') + call assert(rrtmgp_get_max_temperature() == rrtmgpxx_get_max_temperature(), 'RRTMGP and RRTMGPXX max temperatures do not match.') + ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL nlev_rad = pver @@ -911,6 +946,9 @@ subroutine radiation_init(state) end subroutine radiation_init + subroutine radiation_final() + call rrtmgpxx_finalize() + end subroutine radiation_final subroutine perturbation_growth_init() @@ -1278,6 +1316,9 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & real(r8), dimension(pcols,pver,nswbands) :: liq_tau_bnd_sw, ice_tau_bnd_sw, snw_tau_bnd_sw real(r8), dimension(pcols,pver,nlwbands) :: liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw + integer, dimension(nswgpts) :: gpoint_bands_sw + integer, dimension(nlwgpts) :: gpoint_bands_lw + ! Loop variables integer :: icol, ilay @@ -1406,32 +1447,6 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & nday = count(day_indices(1:ncol) > 0) nnight = count(night_indices(1:ncol) > 0) - ! Initialize cloud optics objects - call handle_error(cld_optics_sw%alloc_2str( & - ncol, nlev_rad, k_dist_sw, name='cld_optics_sw' & - )) - call handle_error(cld_optics_sw%alloc_2str( & - ncol_tot, nlev_rad, k_dist_sw, name='cld_optics_sw' & - )) - cld_optics_sw%tau = 0 - cld_optics_sw%ssa = 0 - cld_optics_sw%g = 0 - - ! Initialize aerosol optics; passing only the wavenumber bounds for each - ! "band" rather than passing the full spectral discretization object, and - ! omitting the "g-point" mapping forces the optics to be indexed and - ! stored by band rather than by g-point. This is most consistent with our - ! treatment of aerosol optics in the model, and prevents us from having to - ! map bands to g-points ourselves since that will all be handled by the - ! private routines internal to the optics class. - call handle_error(aer_optics_sw%alloc_2str( & - ncol_tot, nlev_rad, k_dist_sw%get_band_lims_wavenumber(), & - name='aer_optics_sw' & - )) - aer_optics_sw%tau = 0 - aer_optics_sw%ssa = 0 - aer_optics_sw%g = 0 - ! Do aerosol optics; this was moved outside the CRM loop to ! optimize performance. The impact was estimated to be negligible. aer_tau_bnd_sw = 0 @@ -1584,36 +1599,14 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & end do ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state + call rrtmgpxx_get_gpoint_bands_sw(gpoint_bands_sw) call sample_cloud_optics_sw( & - ncol, pver, nswgpts, get_gpoint_bands_sw(), & + ncol, pver, nswgpts, gpoint_bands_sw, & state%pmid, cld, cldfsnow, & cld_tau_bnd_sw, cld_ssa_bnd_sw, cld_asm_bnd_sw, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw & ) call t_stopf('rad_cloud_optics_sw') - - ! Do aerosol optics - aer_tau_bnd_sw = 0._r8 - aer_ssa_bnd_sw = 0._r8 - aer_asm_bnd_sw = 0._r8 - if (do_aerosol_rad) then - call t_startf('rad_aerosol_optics_sw') - call set_aerosol_optics_sw( & - icall, state, pbuf, night_indices(1:nnight), is_cmip6_volc, & - aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw & - ) - ! Now reorder bands to be consistent with RRTMGP - ! TODO: fix the input files themselves! - do icol = 1,size(aer_tau_bnd_sw,1) - do ilay = 1,size(aer_tau_bnd_sw,2) - aer_tau_bnd_sw(icol,ilay,:) = reordered(aer_tau_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) - aer_ssa_bnd_sw(icol,ilay,:) = reordered(aer_ssa_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) - aer_asm_bnd_sw(icol,ilay,:) = reordered(aer_asm_bnd_sw(icol,ilay,:), rrtmg_to_rrtmgp_swbands) - end do - end do - call t_stopf('rad_aerosol_optics_sw') - - end if ! Check (and possibly clip) values before passing to RRTMGP driver call handle_error(clip_values(cld_tau_gpt_sw, 0._r8, huge(cld_tau_gpt_sw), trim(subname) // ' cld_tau_gpt_sw', tolerance=1e-10_r8)) call handle_error(clip_values(cld_ssa_gpt_sw, 0._r8, 1._r8, trim(subname) // ' cld_ssa_gpt_sw', tolerance=1e-10_r8)) @@ -1623,9 +1616,8 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & call handle_error(clip_values(aer_asm_bnd_sw, -1._r8, 1._r8, trim(subname) // ' aer_asm_bnd_sw', tolerance=1e-10_r8)) end if - ! Longwave cloud and aerosol optics + ! Longwave cloud optics if (radiation_do('lw')) then - ! Do cloud optics call t_startf('rad_cloud_optics_lw') cld_tau_gpt_lw = 0._r8 call get_cloud_optics_lw( & @@ -1633,24 +1625,14 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & lambdac, mu, dei, des, rei, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) + call rrtmgpxx_get_gpoint_bands_lw(gpoint_bands_lw) call sample_cloud_optics_lw( & - ncol, pver, nlwgpts, get_gpoint_bands_lw(), & + ncol, pver, nlwgpts, gpoint_bands_lw, & state%pmid, cld, cldfsnow, & cld_tau_bnd_lw, cld_tau_gpt_lw & ) call output_cloud_optics_lw(state, cld_tau_bnd_lw) call t_stopf('rad_cloud_optics_lw') - - ! Do aerosol optics - aer_tau_bnd_lw = 0._r8 - if (do_aerosol_rad) then - call t_startf('rad_aerosol_optics_lw') - call set_aerosol_optics_lw(icall, state, pbuf, is_cmip6_volc, aer_tau_bnd_lw) - call t_stopf('rad_aerosol_optics_lw') - end if - ! Check (and possibly clip) values before passing to RRTMGP driver - call handle_error(clip_values(cld_tau_gpt_lw, 0._r8, huge(cld_tau_gpt_lw), trim(subname) // ': cld_tau_gpt_lw', tolerance=1e-10_r8)) - call handle_error(clip_values(aer_tau_bnd_lw, 0._r8, huge(aer_tau_bnd_lw), trim(subname) // ': aer_tau_bnd_lw', tolerance=1e-10_r8)) end if ! Pack data @@ -1955,8 +1937,6 @@ subroutine radiation_driver_sw(ncol, & use perf_mod, only: t_startf, t_stopf use radiation_utils, only: calculate_heating_rate - use cam_optics, only: get_cloud_optics_sw, sample_cloud_optics_sw, & - set_aerosol_optics_sw ! Inputs integer, intent(in) :: ncol @@ -1976,10 +1956,18 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day real(r8), dimension(ncol,nlev_rad+1) :: pint_day real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day + real(r8), dimension(size(gas_names),ncol,nlev_rad) :: gas_vmr_rad real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day + real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad + real(r8), dimension(size(cld_ssa_gpt,1),size(cld_ssa_gpt,2)+1,size(cld_ssa_gpt,3)) :: cld_ssa_gpt_rad + real(r8), dimension(size(cld_asm_gpt,1),size(cld_asm_gpt,2)+1,size(cld_asm_gpt,3)) :: cld_asm_gpt_rad + real(r8), dimension(size(aer_tau_bnd,1),size(aer_tau_bnd,2)+1,size(aer_tau_bnd,3)) :: aer_tau_bnd_rad + real(r8), dimension(size(aer_ssa_bnd,1),size(aer_ssa_bnd,2)+1,size(aer_ssa_bnd,3)) :: aer_ssa_bnd_rad + real(r8), dimension(size(aer_asm_bnd,1),size(aer_asm_bnd,2)+1,size(aer_asm_bnd,3)) :: aer_asm_bnd_rad + ! Incoming solar radiation, scaled for solar zenith angle ! and earth-sun distance real(r8) :: solar_irradiance_by_gpt(ncol,nswgpts) @@ -2054,31 +2042,64 @@ subroutine radiation_driver_sw(ncol, & call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_day, do_direct=.true.) call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_day, do_direct=.true.) - ! Add a level above model top to optical properties! + ! Add an empty level above model top + ! TODO: combine with day compression above + cld_tau_gpt_rad = 0 + cld_ssa_gpt_rad = 0 + cld_asm_gpt_rad = 0 + cld_tau_gpt_rad(1:nday,ktop:kbot,:) = cld_tau_gpt_day(1:nday,1:pver,:) + cld_ssa_gpt_rad(1:nday,ktop:kbot,:) = cld_ssa_gpt_day(1:nday,1:pver,:) + cld_asm_gpt_rad(1:nday,ktop:kbot,:) = cld_asm_gpt_day(1:nday,1:pver,:) + aer_tau_bnd_rad = 0 + aer_ssa_bnd_rad = 0 + aer_asm_bnd_rad = 0 + aer_tau_bnd_rad(1:nday,ktop:kbot,:) = aer_tau_bnd_day(1:nday,:,:) + aer_ssa_bnd_rad(1:nday,ktop:kbot,:) = aer_ssa_bnd_day(1:nday,:,:) + aer_asm_bnd_rad(1:nday,ktop:kbot,:) = aer_asm_bnd_day(1:nday,:,:) + gas_vmr_rad(:,1:nday,1) = gas_vmr_day(:,1:nday,1) + gas_vmr_rad(:,1:nday,ktop:kbot) = gas_vmr_day(:,1:nday,1:pver) ! Do shortwave radiative transfer calculations call t_startf('rad_calculations_sw') +! call rrtmgp_run_sw( & +! size(active_gases), nday, nlev_rad, & +! gas_names, gas_vmr_day, & +! pmid_day(1:nday,1:nlev_rad), & +! tmid_day(1:nday,1:nlev_rad), & +! pint_day(1:nday,1:nlev_rad+1), & +! coszrs_day(1:nday), & +! albedo_dir_day(1:nswbands,1:nday), & +! albedo_dif_day(1:nswbands,1:nday), & +! cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & +! aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & +! fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, & +! fluxes_allsky_day%flux_dn_dir, & +! fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, & +! fluxes_allsky_day%bnd_flux_dn_dir, & +! fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, & +! fluxes_clrsky_day%flux_dn_dir, & +! fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, & +! fluxes_clrsky_day%bnd_flux_dn_dir, & +! tsi_scaling & +! ) call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & - gas_names, gas_vmr_day, & + gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & coszrs_day(1:nday), & albedo_dir_day(1:nswbands,1:nday), & albedo_dif_day(1:nswbands,1:nday), & - cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & - aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & - fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, & - fluxes_allsky_day%flux_dn_dir, & - fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, & - fluxes_allsky_day%bnd_flux_dn_dir, & - fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, & - fluxes_clrsky_day%flux_dn_dir, & - fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, & - fluxes_clrsky_day%bnd_flux_dn_dir, & + cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & + aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & + fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, fluxes_allsky_day%flux_dn_dir, & + fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & + fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & + fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) + call t_stopf('rad_calculations_sw') ! Expand fluxes from daytime-only arrays to full chunk arrays @@ -2112,7 +2133,7 @@ end subroutine radiation_driver_sw !---------------------------------------------------------------------------- - subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & + subroutine radiation_driver_lw(gas_names, gas_vmr, surface_emissivity, & pmid, tmid, pint, tint, & cld_tau_gpt, aer_tau_bnd, & fluxes_allsky, fluxes_clrsky) @@ -2121,7 +2142,7 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & character(len=*), intent(in) :: gas_names(:) real(r8), intent(in) :: gas_vmr(:,:,:) - real(r8), intent(in) :: emis_sfc(:,:) + real(r8), intent(in) :: surface_emissivity(:,:) real(r8), intent(in) :: pmid(:,:), tmid(:,:), pint(:,:), tint(:,:) real(r8), intent(in) :: cld_tau_gpt(:,:,:), aer_tau_bnd(:,:,:) type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky @@ -2136,28 +2157,28 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, emis_sfc, & ncol = size(pmid,1) nlev = size(pmid,2) - ! Add a level above model top - gas_vmr_rad(:,:,ktop:kbot) = gas_vmr(:,:,:) - gas_vmr_rad(:,:,1) = gas_vmr(:,:,1) + ! Add an empty level above model top cld_tau_gpt_rad = 0 + cld_tau_gpt_rad(:,ktop:kbot,:) = cld_tau_gpt(:,:,:) aer_tau_bnd_rad = 0 - cld_tau_gpt_rad(:,2:nlev,:) = cld_tau_gpt(:,1:pver,:) - aer_tau_bnd_rad(:,2:nlev,:) = aer_tau_bnd(:,1:pver,:) + aer_tau_bnd_rad(:,ktop:kbot,:) = aer_tau_bnd(:,:,:) + gas_vmr_rad(:,1:ncol,1) = gas_vmr(:,1:ncol,1) + gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Compute fluxes - call t_startf('rad_rrtmgp_run_lw') + call t_startf('rrtmgp_run_lw') call rrtmgp_run_lw( & - size(active_gases), ncol, nlev, & - gas_names, gas_vmr, & - emis_sfc, & - pmid, tmid, pint, tint, & - cld_tau_gpt_rad, aer_tau_bnd_rad, & + size(active_gases), ncol, nlev_rad, & + gas_names, gas_vmr_rad(:,1:ncol,1:nlev_rad), & + surface_emissivity(1:nlwbands,1:ncol), & + pmid(1:ncol,:), tmid(1:ncol,:), pint(1:ncol,:), tint(1:ncol,:), & + cld_tau_gpt_rad(1:ncol,:,:), aer_tau_bnd_rad(1:ncol,:,:), & fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) - call t_stopf('rad_rrtmgp_run_lw') + call t_stopf('rrtmgp_run_lw') end subroutine radiation_driver_lw From e2a07841704d785176793c7cd338f66bb3cad8df Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 15 Jan 2021 16:03:52 -0700 Subject: [PATCH 38/71] Call C++ versions of run_sw and run_lw and compare with F90 --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 86 +++++++++++-------- .../physics/rrtmgp/cpp/rrtmgpxx_interface.cpp | 37 +++++++- .../eam/src/physics/rrtmgp/radiation.F90 | 57 +++--------- 3 files changed, 92 insertions(+), 88 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index b2f86a5f42aa..81ea6bcf7d72 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -1960,6 +1960,7 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day + type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad real(r8), dimension(size(cld_ssa_gpt,1),size(cld_ssa_gpt,2)+1,size(cld_ssa_gpt,3)) :: cld_ssa_gpt_rad @@ -2060,28 +2061,7 @@ subroutine radiation_driver_sw(ncol, & gas_vmr_rad(:,1:nday,ktop:kbot) = gas_vmr_day(:,1:nday,1:pver) ! Do shortwave radiative transfer calculations - call t_startf('rad_calculations_sw') -! call rrtmgp_run_sw( & -! size(active_gases), nday, nlev_rad, & -! gas_names, gas_vmr_day, & -! pmid_day(1:nday,1:nlev_rad), & -! tmid_day(1:nday,1:nlev_rad), & -! pint_day(1:nday,1:nlev_rad+1), & -! coszrs_day(1:nday), & -! albedo_dir_day(1:nswbands,1:nday), & -! albedo_dif_day(1:nswbands,1:nday), & -! cld_tau_gpt_day(1:nday,1:pver,1:nswgpts), cld_ssa_gpt_day(1:nday,1:pver,1:nswgpts), cld_asm_gpt_day(1:nday,1:pver,1:nswgpts), & -! aer_tau_bnd_day(1:nday,1:pver,1:nswbands), aer_ssa_bnd_day(1:nday,1:pver,1:nswbands), aer_asm_bnd_day(1:nday,1:pver,1:nswbands), & -! fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, & -! fluxes_allsky_day%flux_dn_dir, & -! fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, & -! fluxes_allsky_day%bnd_flux_dn_dir, & -! fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, & -! fluxes_clrsky_day%flux_dn_dir, & -! fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, & -! fluxes_clrsky_day%bnd_flux_dn_dir, & -! tsi_scaling & -! ) + call t_startf('rad_rrtmgp_run_sw') call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & @@ -2099,8 +2079,39 @@ subroutine radiation_driver_sw(ncol, & fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) - - call t_stopf('rad_calculations_sw') + call t_stopf('rad_rrtmgp_run_sw') + call t_startf('rad_rrtmgpxx_run_sw') + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_cxx, do_direct=.true.) + call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) + call rrtmgpxx_run_sw( & + size(active_gases), nday, nlev_rad, & + c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & + pmid_day(1:nday,1:nlev_rad), & + tmid_day(1:nday,1:nlev_rad), & + pint_day(1:nday,1:nlev_rad+1), & + coszrs_day(1:nday), & + albedo_dir_day(1:nswbands,1:nday), & + albedo_dif_day(1:nswbands,1:nday), & + cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & + aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & + fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , fluxes_allsky_cxx%flux_dn_dir , & + fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & + fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , fluxes_clrsky_cxx%flux_dn_dir , & + fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net, fluxes_clrsky_cxx%bnd_flux_dn_dir, & + tsi_scaling & + ) + call t_stopf('rad_rrtmgpxx_run_sw') + ! Check fluxes + if (.true.) then + call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky_day%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky_day%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') + call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky_day%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky_day%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky_day%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') + call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky_day%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') + end if + call free_fluxes(fluxes_allsky_cxx) + call free_fluxes(fluxes_clrsky_cxx) ! Expand fluxes from daytime-only arrays to full chunk arrays call t_startf('rad_expand_fluxes_sw') @@ -2166,20 +2177,19 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, surface_emissivity, & gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Compute fluxes - call t_startf('rrtmgp_run_lw') - call rrtmgp_run_lw( & - size(active_gases), ncol, nlev_rad, & - gas_names, gas_vmr_rad(:,1:ncol,1:nlev_rad), & - surface_emissivity(1:nlwbands,1:ncol), & - pmid(1:ncol,:), tmid(1:ncol,:), pint(1:ncol,:), tint(1:ncol,:), & - cld_tau_gpt_rad(1:ncol,:,:), aer_tau_bnd_rad(1:ncol,:,:), & - fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & - fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & - fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & - fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & - ) - call t_stopf('rrtmgp_run_lw') - + call t_startf('rrtmgpxx_run_lw') + call rrtmgpxx_run_lw( & + size(active_gases), ncol, nlev_rad, & + c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & + pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & + surface_emissivity(1:nlwbands,1:ncol), & + cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & + fluxes_allsky%flux_up , fluxes_allsky%flux_dn , fluxes_allsky%flux_net , & + fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & + fluxes_clrsky%flux_up , fluxes_clrsky%flux_dn , fluxes_clrsky%flux_net , & + fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & + ) + call t_stopf('rrtmgpxx_run_lw') end subroutine radiation_driver_lw !---------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp index f70b136f84a1..e210701a0eb6 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp @@ -5,6 +5,7 @@ #include "mo_rte_lw.h" #include "mo_optical_props.h" #include "const.h" +#include "mo_fluxes_byband.h" using yakl::intrinsics::minval; using yakl::intrinsics::maxval; @@ -153,6 +154,14 @@ extern "C" void rrtmgpxx_run_sw ( auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); auto clrsky_flux_dn_dir = real2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + auto allsky_bnd_flux_up = real3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_dn = real3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_dn_dir = real3d("allsky_bnd_flux_dn_dir", allsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_net = real3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_up = real3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_dn = real3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_dn_dir = real3d("clrsky_bnd_flux_dn_dir", clrsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nswbands); // Populate gas concentrations object // TODO: clean this up. We could keep gas_concs in file scope, and then @@ -214,11 +223,15 @@ extern "C" void rrtmgpxx_run_sw ( // Do the clearsky calculation before adding in clouds // TODO: we need band-by-band fluxes too - FluxesBroadband fluxes_clrsky; + FluxesByband fluxes_clrsky; fluxes_clrsky.flux_up = clrsky_flux_up; fluxes_clrsky.flux_dn = clrsky_flux_dn; fluxes_clrsky.flux_dn_dir = clrsky_flux_dn_dir; fluxes_clrsky.flux_net = clrsky_flux_net; + fluxes_clrsky.bnd_flux_up = clrsky_bnd_flux_up; + fluxes_clrsky.bnd_flux_dn = clrsky_bnd_flux_dn; + fluxes_clrsky.bnd_flux_dn_dir = clrsky_bnd_flux_dn_dir; + fluxes_clrsky.bnd_flux_net = clrsky_bnd_flux_net; rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_clrsky); // Add in clouds @@ -233,11 +246,15 @@ extern "C" void rrtmgpxx_run_sw ( cloud_optics.increment(combined_optics); // Call SW flux driver - FluxesBroadband fluxes_allsky; + FluxesByband fluxes_allsky; fluxes_allsky.flux_up = allsky_flux_up; fluxes_allsky.flux_dn = allsky_flux_dn; fluxes_allsky.flux_dn_dir = allsky_flux_dn_dir; fluxes_allsky.flux_net = allsky_flux_net; + fluxes_allsky.bnd_flux_up = allsky_bnd_flux_up; + fluxes_allsky.bnd_flux_dn = allsky_bnd_flux_dn; + fluxes_allsky.bnd_flux_dn_dir = allsky_bnd_flux_dn_dir; + fluxes_allsky.bnd_flux_net = allsky_bnd_flux_net; rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_allsky); } @@ -269,6 +286,12 @@ extern "C" void rrtmgpxx_run_lw ( auto clrsky_flux_up = real2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + auto allsky_bnd_flux_up = real3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); + auto allsky_bnd_flux_dn = real3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); + auto allsky_bnd_flux_net = real3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_up = real3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_dn = real3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); // Populate gas concentrations string1d gas_names("gas_names", ngas); @@ -344,10 +367,13 @@ extern "C" void rrtmgpxx_run_lw ( aerosol_optics.increment(combined_optics); // Do the clearsky calculation before adding in clouds - FluxesBroadband fluxes_clrsky; + FluxesByband fluxes_clrsky; fluxes_clrsky.flux_up = clrsky_flux_up; fluxes_clrsky.flux_dn = clrsky_flux_dn; fluxes_clrsky.flux_net = clrsky_flux_net; + fluxes_clrsky.bnd_flux_up = clrsky_bnd_flux_up; + fluxes_clrsky.bnd_flux_dn = clrsky_bnd_flux_dn; + fluxes_clrsky.bnd_flux_net = clrsky_bnd_flux_net; rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_clrsky); // Add in clouds @@ -359,9 +385,12 @@ extern "C" void rrtmgpxx_run_lw ( cloud_optics.increment(combined_optics); // Call LW flux driver - FluxesBroadband fluxes_allsky; + FluxesByband fluxes_allsky; fluxes_allsky.flux_up = allsky_flux_up; fluxes_allsky.flux_dn = allsky_flux_dn; fluxes_allsky.flux_net = allsky_flux_net; + fluxes_allsky.bnd_flux_up = allsky_bnd_flux_up; + fluxes_allsky.bnd_flux_dn = allsky_bnd_flux_dn; + fluxes_allsky.bnd_flux_net = allsky_bnd_flux_net; rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_allsky); } diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 84d11030ba6f..f851a6c66680 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -41,9 +41,7 @@ module radiation rrtmgpxx_get_max_temperature => get_max_temperature, & rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & - c_strarr, & - get_nband_sw, get_nband_lw, & - get_ngpt_sw, get_ngpt_lw + c_strarr ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -502,16 +500,6 @@ subroutine radiation_init(state) trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & ) - ! Make sure number of bands in absorption coefficient files matches what we expect - !call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') - !call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') - call assert(nswbands == get_nband_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') - call assert(nlwbands == get_nband_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') - - ! Check that gpoints are consistent after initialization - call assert(nswgpts == get_ngpt_sw(), 'nswgpts does not match RRTMGPXX absorption coefficient data') - call assert(nlwgpts == get_ngpt_lw(), 'nlwgpts does not match RRTMGPXX absorption coefficient data') - ! Check that min and max temperatures are consistent call assert(rrtmgp_get_min_temperature() == rrtmgpxx_get_min_temperature(), 'RRTMGP and RRTMGPXX min temperatures do not match.') call assert(rrtmgp_get_max_temperature() == rrtmgpxx_get_max_temperature(), 'RRTMGP and RRTMGPXX max temperatures do not match.') @@ -1712,6 +1700,12 @@ subroutine radiation_driver_sw(ncol, & call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky_day%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky_day%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky_day%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') + call assert(all(abs(fluxes_allsky_cxx%bnd_flux_up - fluxes_allsky_day%bnd_flux_up) < 1e-5), 'F90 and CXX allsky_bnd_flux_up differs.') + call assert(all(abs(fluxes_allsky_cxx%bnd_flux_dn - fluxes_allsky_day%bnd_flux_dn) < 1e-5), 'F90 and CXX allsky_bnd_flux_dn differs.') + call assert(all(abs(fluxes_allsky_cxx%bnd_flux_net - fluxes_allsky_day%bnd_flux_net) < 1e-5), 'F90 and CXX allsky_bnd_flux_net differs.') + call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_up - fluxes_clrsky_day%bnd_flux_up) < 1e-5), 'F90 and CXX clrsky_bnd_flux_up differs.') + call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_dn - fluxes_clrsky_day%bnd_flux_dn) < 1e-5), 'F90 and CXX clrsky_bnd_flux_dn differs.') + call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_net - fluxes_clrsky_day%bnd_flux_net) < 1e-5), 'F90 and CXX clrsky_bnd_flux_net differs.') end if call free_fluxes(fluxes_allsky_cxx) call free_fluxes(fluxes_clrsky_cxx) @@ -1862,9 +1856,6 @@ subroutine radiation_driver_lw(ncol, & real(r8), dimension(size(gas_vmr, 1),ncol,nlev_rad) :: gas_vmr_rad - ! Fluxes from C++ interface for comparison - type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx - ! Set surface emissivity to 1 here. There is a note in the RRTMG ! implementation that this is treated in the land model, but the old ! RRTMG implementation also sets this to 1. This probably does not make @@ -1882,46 +1873,20 @@ subroutine radiation_driver_lw(ncol, & gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Do longwave radiative transfer calculations - call t_startf('rrtmgp_run_lw') - call rrtmgp_run_lw( & - size(active_gases), ncol, nlev_rad, & - gas_names, gas_vmr_rad(:,1:ncol,1:nlev_rad), & - surface_emissivity(1:nlwbands,1:ncol), & - pmid(1:ncol,:), tmid(1:ncol,:), pint(1:ncol,:), tint(1:ncol,:), & - cld_tau_gpt_rad(1:ncol,:,:), aer_tau_bnd_rad(1:ncol,:,:), & - fluxes_allsky%flux_up, fluxes_allsky%flux_dn, fluxes_allsky%flux_net, & - fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & - fluxes_clrsky%flux_up, fluxes_clrsky%flux_dn, fluxes_clrsky%flux_net, & - fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & - ) - call t_stopf('rrtmgp_run_lw') call t_startf('rrtmgpxx_run_lw') ! Try calling C++ version - call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_allsky_cxx) - call initialize_fluxes(ncol, nlev_rad+1, nlwbands, fluxes_clrsky_cxx) call rrtmgpxx_run_lw( & size(active_gases), ncol, nlev_rad, & c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & surface_emissivity(1:nlwbands,1:ncol), & cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & - fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , & - fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, & - fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , & - fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net & + fluxes_allsky%flux_up , fluxes_allsky%flux_dn , fluxes_allsky%flux_net , & + fluxes_allsky%bnd_flux_up, fluxes_allsky%bnd_flux_dn, fluxes_allsky%bnd_flux_net, & + fluxes_clrsky%flux_up , fluxes_clrsky%flux_dn , fluxes_clrsky%flux_net , & + fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) call t_stopf('rrtmgpxx_run_lw') - ! Check fluxes - if (.true.) then - call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') - end if - call free_fluxes(fluxes_allsky_cxx) - call free_fluxes(fluxes_clrsky_cxx) ! Calculate heating rates call calculate_heating_rate( & From b29a9a4cf4750e28cef18e76d2f17eb1640a45ac Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 18 Mar 2021 10:52:53 -0600 Subject: [PATCH 39/71] Use our own versions of file i/o that do not need netcdf-cxx4 --- .../physics/rrtmgp/cpp/mo_garand_atmos_io.cpp | 115 +++++++ .../physics/rrtmgp/cpp/mo_garand_atmos_io.h | 15 + .../rrtmgp/cpp/mo_load_cloud_coefficients.cpp | 107 +++++++ .../rrtmgp/cpp/mo_load_cloud_coefficients.h | 14 + .../rrtmgp/cpp/mo_load_coefficients.cpp | 118 ++++++++ .../physics/rrtmgp/cpp/mo_load_coefficients.h | 9 + .../src/physics/rrtmgp/cpp/simple_netcdf.hpp | 284 ++++++++++++++++++ 7 files changed, 662 insertions(+) create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp create mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h create mode 100644 components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp new file mode 100644 index 000000000000..6762454d0961 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp @@ -0,0 +1,115 @@ +#include "mo_garand_atmos_io.h" +#include "simple_netcdf.hpp" +#include + +// Read in the data, then use only the first column, and copy it to all of the model columns +// In the end, all model columns will be identical +void read_atmos(std::string input_file, real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, + GasConcs &gas_concs, real2d &col_dry, int ncol) { + simple_netcdf::SimpleNetCDF io; + io.open(input_file , NC_NOWRITE); + + int nlay = io.getDimSize("lay"); + int nlev = io.getDimSize("lev"); + + p_lay = real2d("p_lay",ncol,nlay); + t_lay = real2d("t_lay",ncol,nlay); + p_lev = real2d("p_lev",ncol,nlev); + t_lev = real2d("t_lev",ncol,nlev); + + real2d tmp2d; + // p_lay + io.read(tmp2d,"p_lay"); + // for (int ilay=1 ; ilay <= nlay ; ilay++) { + // for (int icol=1 ; icol <= ncol ; icol++) { + parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA (int ilay, int icol) { + p_lay(icol,ilay) = tmp2d(1,ilay); + }); + // t_lay + io.read(tmp2d,"t_lay"); + // for (int ilay=1 ; ilay <= nlay ; ilay++) { + // for (int icol=1 ; icol <= ncol ; icol++) { + parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA ( int ilay, int icol) { + t_lay(icol,ilay) = tmp2d(1,ilay); + }); + // p_lev + tmp2d = real2d(); // Reset tmp2d to avoid warnings about reallocating during file read + io.read(tmp2d,"p_lev"); + // for (int ilev=1 ; ilev <= nlev ; ilev++) { + // for (int icol=1 ; icol <= ncol ; icol++) { + parallel_for( Bounds<2>(nlev,ncol) , YAKL_LAMBDA ( int ilev, int icol) { + p_lev(icol,ilev) = tmp2d(1,ilev); + }); + // t_lev + io.read(tmp2d,"t_lev"); + // for (int ilev=1 ; ilev <= nlev ; ilev++) { + // for (int icol=1 ; icol <= ncol ; icol++) { + parallel_for( Bounds<2>(nlev,ncol) , YAKL_LAMBDA( int ilev, int icol) { + t_lev(icol,ilev) = tmp2d(1,ilev); + }); + + int ngas = 8; + string1d gas_names("gas_names",ngas); + gas_names(1) = std::string("h2o"); + gas_names(2) = std::string("co2"); + gas_names(3) = std::string("o3" ); + gas_names(4) = std::string("n2o"); + gas_names(5) = std::string("co" ); + gas_names(6) = std::string("ch4"); + gas_names(7) = std::string("o2" ); + gas_names(8) = std::string("n2" ); + + // Initialize GasConcs object with an "ncol" given from the calling program + gas_concs.init(gas_names,ncol,nlay); + + tmp2d = real2d(); // Reset the tmp2d variable + for (int igas=1 ; igas <= ngas ; igas++) { + std::string vmr_name = "vmr_"+gas_names(igas); + if ( ! io.varExists(vmr_name) ) { stoprun("ERROR: gas does not exist in input file"); } + // Read in 2-D varaible + io.read(tmp2d,vmr_name); + // Create 1-D variable with just the first column + real1d tmp1d("tmp1d",nlay); + // for (int i=1 ; i <= nlay ; i++) { + parallel_for( Bounds<1>(nlay) , YAKL_LAMBDA (int i) { + tmp1d(i) = tmp2d(1,i); + }); + // Call set_vmr with only the first column from the data file copied among all of the model columns + gas_concs.set_vmr( gas_names(igas) , tmp1d ); + } + + if ( io.varExists("col_dry") ) { + col_dry = real2d("col_dry",ncol,nlay); + tmp2d = real2d(); // Reset the tmp2d variable + io.read(tmp2d,"col_dry"); + // for (int ilay=1 ; ilay <= nlay ; ilay++) { + // for (int icol=1 ; icol <= ncol ; icol++) { + parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA( int ilay, int icol) { + col_dry(icol,ilay) = tmp2d(1,ilay); + }); + } + + io.close(); +} + + + +void write_sw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, real2d const &flux_dir, int ncol) { + simple_netcdf::SimpleNetCDF io; + io.open(fileName , NC_WRITE); + io.write(flux_up , "sw_flux_up_result" , {"col_new","lev"}); + io.write(flux_dn , "sw_flux_dn_result" , {"col_new","lev"}); + io.write(flux_dir , "sw_flux_dir_result" , {"col_new","lev"}); + io.close(); +} + + + +void write_lw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, int ncol) { + simple_netcdf::SimpleNetCDF io; + io.open(fileName , NC_WRITE); + io.write(flux_up , "lw_flux_up_result" , {"col_new","lev"}); + io.write(flux_dn , "lw_flux_dn_result" , {"col_new","lev"}); + io.close(); +} + diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h new file mode 100644 index 000000000000..933983f3b7bc --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h @@ -0,0 +1,15 @@ +#pragma once +#include "const.h" +#include "YAKL.h" +#include "mo_gas_concentrations.h" + +void read_atmos(std::string input_file, real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, + GasConcs &gas_concs, real2d &col_dry, int ncol); + + +void write_sw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, real2d const &flux_dir, int ncol); + + +void write_lw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, int ncol); + + diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp new file mode 100644 index 000000000000..1e9ead49f803 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp @@ -0,0 +1,107 @@ +#include "mo_load_cloud_coefficients.h" +#include "simple_netcdf.hpp" + +// read cloud optical property LUT coefficients from NetCDF file +void load_cld_lutcoeff(CloudOptics &cloud_spec, std::string cld_coeff_file) { + simple_netcdf::SimpleNetCDF io; + // Open cloud optical property coefficient file + io.open(cld_coeff_file , NC_NOWRITE); + + // Read LUT coefficient dimensions + int nband = io.getDimSize("nband"); + int nrghice = io.getDimSize("nrghice"); + int nsize_liq = io.getDimSize("nsize_liq"); + int nsize_ice = io.getDimSize("nsize_ice"); + + real2d band_lims_wvn("band_lims_wvn",2,nband); + io.read(band_lims_wvn,"bnd_limits_wavenumber"); + + // Read LUT constants + real radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac; + io.read(radliq_lwr , "radliq_lwr"); + io.read(radliq_upr , "radliq_upr"); + io.read(radliq_fac , "radliq_fac"); + io.read(radice_lwr , "radice_lwr"); + io.read(radice_upr , "radice_upr"); + io.read(radice_fac , "radice_fac"); + + // Allocate cloud property lookup table input arrays + real2d lut_extliq("lut_extliq",nsize_liq, nband); + real2d lut_ssaliq("lut_ssaliq",nsize_liq, nband); + real2d lut_asyliq("lut_asyliq",nsize_liq, nband); + real3d lut_extice("lut_extice",nsize_ice, nband, nrghice); + real3d lut_ssaice("lut_ssaice",nsize_ice, nband, nrghice); + real3d lut_asyice("lut_asyice",nsize_ice, nband, nrghice); + // Read LUT coefficients + io.read(lut_extliq , "lut_extliq"); + io.read(lut_ssaliq , "lut_ssaliq"); + io.read(lut_asyliq , "lut_asyliq"); + io.read(lut_extice , "lut_extice"); + io.read(lut_ssaice , "lut_ssaice"); + io.read(lut_asyice , "lut_asyice"); + + io.close(); + + cloud_spec.load(band_lims_wvn, radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice); +} + + + +// read cloud optical property Pade coefficients from NetCDF file +void load_cld_padecoeff(CloudOptics &cloud_spec, std::string cld_coeff_file) { + simple_netcdf::SimpleNetCDF io; + // Open cloud optical property coefficient file + io.open(cld_coeff_file , NC_NOWRITE); + + // Read Pade coefficient dimensions + int nband = io.getDimSize("nband"); + int nrghice = io.getDimSize("nrghice"); + int nsizereg = io.getDimSize("nsizereg"); + int ncoeff_ext = io.getDimSize("ncoeff_ext"); + int ncoeff_ssa_g = io.getDimSize("ncoeff_ssa_g"); + int nbound = io.getDimSize("nbound"); + + real2d band_lims_wvn("band_lims_wvn",2,nband); + io.read(band_lims_wvn, "bnd_limits_wavenumber"); + + // Allocate cloud property Pade coefficient input arrays + real3d pade_extliq("pade_extliq",nband, nsizereg, ncoeff_ext); + real3d pade_ssaliq("pade_ssaliq",nband, nsizereg, ncoeff_ssa_g); + real3d pade_asyliq("pade_asyliq",nband, nsizereg, ncoeff_ssa_g); + real4d pade_extice("pade_extice",nband, nsizereg, ncoeff_ext, nrghice); + real4d pade_ssaice("pade_ssaice",nband, nsizereg, ncoeff_ssa_g, nrghice); + real4d pade_asyice("pade_asyice",nband, nsizereg, ncoeff_ssa_g, nrghice); + io.read(pade_extliq, "pade_extliq"); + io.read(pade_ssaliq, "pade_ssaliq"); + io.read(pade_asyliq, "pade_asyliq"); + io.read(pade_extice, "pade_extice"); + io.read(pade_ssaice, "pade_ssaice"); + io.read(pade_asyice, "pade_asyice"); + + // Allocate cloud property Pade coefficient particle size boundary input arrays + real1d pade_sizreg_extliq("pade_sizreg_extliq",nbound); + real1d pade_sizreg_ssaliq("pade_sizreg_ssaliq",nbound); + real1d pade_sizreg_asyliq("pade_sizreg_asyliq",nbound); + real1d pade_sizreg_extice("pade_sizreg_extice",nbound); + real1d pade_sizreg_ssaice("pade_sizreg_ssaice",nbound); + real1d pade_sizreg_asyice("pade_sizreg_asyice",nbound); + + io.read(pade_sizreg_extliq, "pade_sizreg_extliq"); + io.read(pade_sizreg_ssaliq, "pade_sizreg_ssaliq"); + io.read(pade_sizreg_asyliq, "pade_sizreg_asyliq"); + io.read(pade_sizreg_extice, "pade_sizreg_extice"); + io.read(pade_sizreg_ssaice, "pade_sizreg_ssaice"); + io.read(pade_sizreg_asyice, "pade_sizreg_asyice"); + + io.close(); + + cloud_spec.load(band_lims_wvn, pade_extliq, pade_ssaliq, pade_asyliq, + pade_extice, pade_ssaice, pade_asyice, + pade_sizreg_extliq, pade_sizreg_ssaliq, pade_sizreg_asyliq, + pade_sizreg_extice, pade_sizreg_ssaice, pade_sizreg_asyice); +} + + + + diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h new file mode 100644 index 000000000000..771a4e41db3c --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h @@ -0,0 +1,14 @@ +#pragma once + +#include "const.h" +#include "mo_optical_props.h" +#include "mo_cloud_optics.h" + + +void load_cld_lutcoeff(CloudOptics &cloud_spec, std::string cld_coeff_file); + + +void load_cld_padecoeff(CloudOptics &cloud_spec, std::string cld_coeff_file); + + + diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp new file mode 100644 index 000000000000..1f5b05b2d828 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp @@ -0,0 +1,118 @@ +#include "mo_load_coefficients.h" +#include "simple_netcdf.hpp" + +// This code is part of RRTM for GCM Applications - Parallel (RRTMGP) +// +// Contacts: Robert Pincus and Eli Mlawer +// email: rrtmgp@aer.com +// +// Copyright 2015-2018, Atmospheric and Environmental Research and +// Regents of the University of Colorado. All right reserved. +// +// Use and duplication is permitted under the terms of the +// BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +// ------------------------------------------------------------------------------------------------- + +void load_and_init(GasOpticsRRTMGP &kdist, std::string filename, GasConcs const &available_gases) { + simple_netcdf::SimpleNetCDF io; + io.open(filename , NC_NOWRITE); + + // Read the many arrays + string1d gas_names; + string1d gas_minor; + string1d identifier_minor; + string1d minor_gases_lower; + string1d minor_gases_upper; + string1d scaling_gas_lower; + string1d scaling_gas_upper; + intHost3d key_species; + realHost2d band_lims; + intHost2d band2gpt; + real press_ref_trop; + real temp_ref_p; + real temp_ref_t; + realHost1d press_ref; + realHost1d temp_ref; + realHost3d vmr_ref; + realHost4d kmajor; + intHost2d minor_limits_gpt_lower; + intHost2d minor_limits_gpt_upper; + boolHost1d minor_scales_with_density_lower; + boolHost1d minor_scales_with_density_upper; + boolHost1d scale_by_complement_lower; + boolHost1d scale_by_complement_upper; + intHost1d kminor_start_lower; + intHost1d kminor_start_upper; + realHost3d kminor_lower; + realHost3d kminor_upper; + realHost3d rayl_lower; + realHost3d rayl_upper; + + // Read in strings + charHost2d tmp; + tmp = charHost2d(); io.read( tmp , "gas_names" ); gas_names = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "gas_minor" ); gas_minor = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "identifier_minor" ); identifier_minor = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "minor_gases_lower" ); minor_gases_lower = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "minor_gases_upper" ); minor_gases_upper = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "scaling_gas_lower" ); scaling_gas_lower = char2d_to_string1d(tmp); + tmp = charHost2d(); io.read( tmp , "scaling_gas_upper" ); scaling_gas_upper = char2d_to_string1d(tmp); + + io.read( key_species , "key_species" ); + io.read( band_lims , "bnd_limits_wavenumber" ); + io.read( band2gpt , "bnd_limits_gpt" ); + io.read( press_ref , "press_ref" ); + io.read( temp_ref , "temp_ref" ); + io.read( temp_ref_p , "absorption_coefficient_ref_P" ); + io.read( temp_ref_t , "absorption_coefficient_ref_T" ); + io.read( press_ref_trop , "press_ref_trop" ); + io.read( kminor_lower , "kminor_lower" ); + io.read( kminor_upper , "kminor_upper" ); + io.read( minor_limits_gpt_lower , "minor_limits_gpt_lower" ); + io.read( minor_limits_gpt_upper , "minor_limits_gpt_upper" ); + io.read( minor_scales_with_density_lower , "minor_scales_with_density_lower" ); + io.read( minor_scales_with_density_upper , "minor_scales_with_density_upper" ); + io.read( scale_by_complement_lower , "scale_by_complement_lower" ); + io.read( scale_by_complement_upper , "scale_by_complement_upper" ); + io.read( kminor_start_lower , "kminor_start_lower" ); + io.read( kminor_start_upper , "kminor_start_upper" ); + io.read( vmr_ref , "vmr_ref" ); + io.read( kmajor , "kmajor" ); + + if (io.varExists("rayl_lower")) { + io.read( rayl_lower , "rayl_lower" ); + io.read( rayl_upper , "rayl_upper" ); + } + + // Initialize the gas optics class with data. The calls look slightly different depending + // on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) + // gas_optics%load() returns a string; a non-empty string indicates an error. + if (io.varExists("totplnk")) { + // If there's a totplnk variable in the file, then it's a longwave (internal sources) type + realHost2d totplnk; + realHost4d planck_frac; + io.read( totplnk , "totplnk" ); + io.read( planck_frac , "plank_fraction" ); + kdist.load(available_gases, gas_names, key_species, band2gpt, band_lims, 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); + } else { + // Otherwise, it's a shortwave type + realHost1d solar_src; + io.read( solar_src , "solar_source" ); + kdist.load(available_gases, gas_names, key_species, band2gpt, band_lims, 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, rayl_lower, rayl_upper); + } + io.close(); +} + + diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h new file mode 100644 index 000000000000..b87ef3f6f5f9 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h @@ -0,0 +1,9 @@ +#pragma once + +#include "const.h" +#include "mo_gas_concentrations.h" +#include "mo_gas_optics_rrtmgp.h" +#include + +void load_and_init(GasOpticsRRTMGP &kdist, std::string filename, GasConcs const &available_gases); + diff --git a/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp b/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp new file mode 100644 index 000000000000..05496adf8884 --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp @@ -0,0 +1,284 @@ +#include +#include "YAKL.h" + +using namespace yakl; +namespace simple_netcdf { + + class SimpleNetCDF { + + protected: + + int ncid; + + public: + + // Constructor + SimpleNetCDF() {}; + + // Destructor + ~SimpleNetCDF() { + //close(); + }; + + void close() { + handle_error(nc_close(ncid)); + } + + void create(std::string filename, int mode=NC_CLOBBER) { + handle_error(nc_create(filename.c_str(), mode, &ncid)); + }; + + void open(std::string filename, int mode=NC_NOWRITE) { + handle_error(nc_open(filename.c_str(), mode, &ncid)); + }; + + void open(char *filename) { + handle_error(nc_open(filename, NC_NOWRITE, &ncid)); + } + + // NetCDF routines return an integer error code. Define a function + // here to abort program execution and throw an error code if we + // encounter a non-zero NetCDF return code. We will wrap our + // NetCDF calls with this function to handle these errors in a + // consistent way + void handle_error(int err) { + if (err) { + std::cout << "ERROR: " << nc_strerror(err) << std::endl; + abort(); + } + } + + void handle_error(int err, const char *file, int line) { + if (err) { + std::cout << "ERROR: " << nc_strerror(err) << " at line " << line << " in " << file << std::endl; + abort(); + } + } + + // Read a netCDF array to a YAKL array + template void read(Array &arr, std::string varName) { + + // Get variable ID + int varid; + handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); + + // Get variable dimension sizes + int ndims; + int dimids[NC_MAX_VAR_DIMS]; + nc_type vtype; + handle_error(nc_inq_var(ncid, varid, NULL, &vtype, &ndims, dimids, NULL), __FILE__, __LINE__); + std::vector dimSizes(ndims); + size_t dimsize; + for (int i = 0; i < ndims; i++) { + handle_error(nc_inq_dimlen(ncid, dimids[i], &dimsize), __FILE__, __LINE__); + dimSizes[i] = dimsize; + } + + // If style is fortran, we need to reverse array dims + if (myStyle == styleFortran) { + std::reverse(dimSizes.begin(), dimSizes.end()); + } + + // Allocate (or reshape) the yakl array + arr = Array(varName.c_str(),dimSizes); + + // Read variable data + if (myMem == memDevice) { + auto arrHost = arr.createHostCopy(); + if (std::is_same::value) { + // Create boolean array from integer arrays + Array tmp("tmp",dimSizes); + handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); + for (int i=0; i < arr.totElems(); i++) { arrHost.myData[i] = tmp.myData[i] == 1; } + } else { + // Need to be careful with floats; nc_get_var is overloaded on type, but we need + // to make sure we read floats from file with the float procedure, and doubles + // with that for doubles. The danger is if the user passes a yakl array here + // with type double, but tries to read type float from file. + // TODO: why does the YAKL implementation for this work fine, but this version + // calling nc_get_var directly does not? + if (vtype == NC_FLOAT) { + Array tmp("tmp",dimSizes); + handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); + for (int i=0; i < arr.totElems(); i++) { arrHost.myData[i] = tmp.myData[i]; } + } else { + handle_error(nc_get_var(ncid, varid, arrHost.data()), __FILE__, __LINE__); + } + } + arrHost.deep_copy_to(arr); + } else { + if (std::is_same::value) { + // Create boolean array from integer arrays + Array tmp("tmp",dimSizes); + handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); + for (int i=0; i < arr.totElems(); i++) { arr.myData[i] = tmp.myData[i] == 1; } + } else { + if (vtype == NC_FLOAT) { + Array tmp("tmp",dimSizes); + handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); + for (int i=0; i < arr.totElems(); i++) { arr.myData[i] = tmp.myData[i]; } + } else { + handle_error(nc_get_var(ncid, varid, arr.data()), __FILE__, __LINE__); + } + } + } + + } + + // Read a scalar type + template void read(T &arr , std::string varName) { + // Get variable ID + int varid; + handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); + + // Read data + handle_error(nc_get_var(ncid, varid, &arr), __FILE__, __LINE__); + } + + // Check if variable exists in file + bool varExists (std::string varName) { + int varid; + int ncerr = nc_inq_varid(ncid, varName.c_str(), &varid); + if (ncerr == 0) { + return true; + } else { + return false; + } + } + + bool dimExists (std::string dimName) { + int dimid; + int ncerr = nc_inq_dimid(ncid, dimName.c_str(), &dimid); + if (ncerr == 0) { + return true; + } else { + return false; + } + } + + size_t getDimSize(std::string dimName) { + // Get dimension ID + int dimid; + handle_error(nc_inq_dimid(ncid, dimName.c_str(), &dimid)); + + // Get dimension size + size_t dimSize; + handle_error(nc_inq_dimlen(ncid, dimid, &dimSize)); + + return dimSize; + } + + void addDim(std::string dimName, int dimSize, int *dimid) { + // Put file into define mode + int ncerr = nc_redef(ncid); + if ((ncerr != NC_NOERR) and (ncerr != NC_EINDEFINE)) { + handle_error(ncerr, __FILE__, __LINE__); + } + + // Define dimension + handle_error(nc_def_dim(ncid, dimName.c_str(), dimSize, dimid), __FILE__, __LINE__); + + // End define mode + handle_error(nc_enddef(ncid), __FILE__, __LINE__); + } + + void addVar(std::string varName, nc_type varType, int ndims, int dimids[], int *varid) { + // Put file into define mode + int ncerr = nc_redef(ncid); + if ((ncerr != NC_NOERR) and (ncerr != NC_EINDEFINE)) { + handle_error(ncerr, __FILE__, __LINE__); + } + + // Define variable + handle_error(nc_def_var(ncid, varName.c_str(), varType, ndims, dimids, varid), __FILE__, __LINE__); + + // End define mode + handle_error(nc_enddef(ncid), __FILE__, __LINE__); + } + + template void putVar(T const &arr, std::string varName) { + // Make sure file is not in define mode + int ncerr = nc_enddef(ncid); + if ((ncerr != NC_NOERR) and (ncerr != NC_ENOTINDEFINE)) { + handle_error(ncerr, __FILE__, __LINE__); + } + + // Get variable Id + int varid; + handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); + + // Write variable data + handle_error(nc_put_var(ncid, varid, arr), __FILE__, __LINE__); + } + + template + void write(Array const &arr, std::string varName, std::vector dimNames) { + + // Make sure length of dimension names is equal to rank of array + if (rank != dimNames.size()) { yakl_throw("dimNames.size() != Array rank"); } + + // Get dimension sizes + // Define dimensions if they do not exist and get dimension IDs + int dimids[rank]; + size_t dimSize; + int idim; + for (int i = 0; i < dimNames.size(); i++) { + // If style is Fortran, dimension ordering is reversed + if (myStyle == styleC) { + idim = i; + } else { + idim = rank - 1 - i; + } + int ncerr = nc_inq_dimid(ncid, dimNames[i].c_str(), &dimids[idim]); + if (ncerr == NC_NOERR) { + // check that size is correct + handle_error(nc_inq_dimlen(ncid, dimids[idim], &dimSize), __FILE__, __LINE__); + if (dimSize != arr.dimension[i]) { + yakl_throw("dimSize != arr.dimension[i]"); + } + } else { + addDim(dimNames[i], arr.dimension[i], &dimids[idim]); + } + } + + // Add variable if it does not exist + if (!varExists(varName)) { + int varid; + addVar(varName, getType(), rank, dimids, &varid); + } + + // Write data to file + putVar(arr.data(), varName); + } + + template void write(T arr, std::string varName) { + // If variable does not exist, try to add it + if (!varExists(varName)) { + int dimids[1] = {0}; + int varid; + addVar(varName, getType(), 0, dimids, &varid); + } + // Write to file + putVar(&arr, varName); + } + + // Determine nc_type corresponding to intrinsic type + template nc_type getType() const { + if ( std::is_same::value ) { return NC_CHAR; } + else if ( std::is_same::value ) { return NC_UBYTE; } + else if ( std::is_same::value ) { return NC_SHORT; } + else if ( std::is_same::value ) { return NC_USHORT; } + else if ( std::is_same::value ) { return NC_INT; } + else if ( std::is_same::value ) { return NC_UINT; } + else if ( std::is_same::value ) { return NC_INT64; } + else if ( std::is_same::value ) { return NC_UINT64; } + else if ( std::is_same::value ) { return NC_FLOAT; } + else if ( std::is_same::value ) { return NC_DOUBLE; } + else if ( std::is_same::value ) { return NC_STRING; } + else { yakl_throw("Invalid type"); } + return -1; + } + + }; // class SimpleNetCDF + +} // namespace simple_netcdf From 98431394532517e8d868d4ebe91b9ed4ddd25734 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 18 Mar 2021 10:56:38 -0600 Subject: [PATCH 40/71] Use CXX fluxes to affect MMF climate too --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 41 ++------------ .../eam/src/physics/rrtmgp/radiation.F90 | 53 ++----------------- 2 files changed, 8 insertions(+), 86 deletions(-) diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index 81ea6bcf7d72..f4e1b907c4f8 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -1960,7 +1960,6 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day - type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx real(r8), dimension(size(cld_tau_gpt,1),size(cld_tau_gpt,2)+1,size(cld_tau_gpt,3)) :: cld_tau_gpt_rad real(r8), dimension(size(cld_ssa_gpt,1),size(cld_ssa_gpt,2)+1,size(cld_ssa_gpt,3)) :: cld_ssa_gpt_rad @@ -2061,28 +2060,7 @@ subroutine radiation_driver_sw(ncol, & gas_vmr_rad(:,1:nday,ktop:kbot) = gas_vmr_day(:,1:nday,1:pver) ! Do shortwave radiative transfer calculations - call t_startf('rad_rrtmgp_run_sw') - call rrtmgp_run_sw( & - size(active_gases), nday, nlev_rad, & - gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & - pmid_day(1:nday,1:nlev_rad), & - tmid_day(1:nday,1:nlev_rad), & - pint_day(1:nday,1:nlev_rad+1), & - coszrs_day(1:nday), & - albedo_dir_day(1:nswbands,1:nday), & - albedo_dif_day(1:nswbands,1:nday), & - cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & - aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & - fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, fluxes_allsky_day%flux_dn_dir, & - fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & - fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & - fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & - tsi_scaling & - ) - call t_stopf('rad_rrtmgp_run_sw') call t_startf('rad_rrtmgpxx_run_sw') - call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_cxx, do_direct=.true.) - call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) call rrtmgpxx_run_sw( & size(active_gases), nday, nlev_rad, & c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & @@ -2094,24 +2072,13 @@ subroutine radiation_driver_sw(ncol, & albedo_dif_day(1:nswbands,1:nday), & cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & - fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , fluxes_allsky_cxx%flux_dn_dir , & - fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & - fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , fluxes_clrsky_cxx%flux_dn_dir , & - fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net, fluxes_clrsky_cxx%bnd_flux_dn_dir, & + fluxes_allsky_day%flux_up , fluxes_allsky_day%flux_dn , fluxes_allsky_day%flux_net , fluxes_allsky_day%flux_dn_dir , & + fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & + fluxes_clrsky_day%flux_up , fluxes_clrsky_day%flux_dn , fluxes_clrsky_day%flux_net , fluxes_clrsky_day%flux_dn_dir , & + fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) call t_stopf('rad_rrtmgpxx_run_sw') - ! Check fluxes - if (.true.) then - call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky_day%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky_day%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky_day%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky_day%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky_day%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky_day%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') - end if - call free_fluxes(fluxes_allsky_cxx) - call free_fluxes(fluxes_clrsky_cxx) ! Expand fluxes from daytime-only arrays to full chunk arrays call t_startf('rad_expand_fluxes_sw') diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index f851a6c66680..f29bad951e28 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -500,10 +500,6 @@ subroutine radiation_init(state) trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & ) - ! Check that min and max temperatures are consistent - call assert(rrtmgp_get_min_temperature() == rrtmgpxx_get_min_temperature(), 'RRTMGP and RRTMGPXX min temperatures do not match.') - call assert(rrtmgp_get_max_temperature() == rrtmgpxx_get_max_temperature(), 'RRTMGP and RRTMGPXX max temperatures do not match.') - ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL nlev_rad = pver @@ -1570,9 +1566,6 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(size(aer_ssa_bnd,1),size(aer_ssa_bnd,2)+1,size(aer_ssa_bnd,3)) :: aer_ssa_bnd_rad real(r8), dimension(size(aer_asm_bnd,1),size(aer_asm_bnd,2)+1,size(aer_asm_bnd,3)) :: aer_asm_bnd_rad - ! Fluxes from C++ interface for comparison - type(fluxes_t) :: fluxes_allsky_cxx, fluxes_clrsky_cxx - ! Scaling factor for total sky irradiance; used to account for orbital ! eccentricity, and could be used to scale total sky irradiance for different ! climates as well (i.e., paleoclimate simulations) @@ -1653,9 +1646,9 @@ subroutine radiation_driver_sw(ncol, & ! Do shortwave radiative transfer calculations call t_startf('rad_rrtmgp_run_sw') - call rrtmgp_run_sw( & + call rrtmgpxx_run_sw( & size(active_gases), nday, nlev_rad, & - gas_names, gas_vmr_rad(:,1:nday,1:nlev_rad), & + c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & @@ -1664,51 +1657,13 @@ subroutine radiation_driver_sw(ncol, & albedo_dif_day(1:nswbands,1:nday), & cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & - fluxes_allsky_day%flux_up, fluxes_allsky_day%flux_dn, fluxes_allsky_day%flux_net, fluxes_allsky_day%flux_dn_dir, & + fluxes_allsky_day%flux_up , fluxes_allsky_day%flux_dn , fluxes_allsky_day%flux_net , fluxes_allsky_day%flux_dn_dir , & fluxes_allsky_day%bnd_flux_up, fluxes_allsky_day%bnd_flux_dn, fluxes_allsky_day%bnd_flux_net, fluxes_allsky_day%bnd_flux_dn_dir, & - fluxes_clrsky_day%flux_up, fluxes_clrsky_day%flux_dn, fluxes_clrsky_day%flux_net, fluxes_clrsky_day%flux_dn_dir, & + fluxes_clrsky_day%flux_up , fluxes_clrsky_day%flux_dn , fluxes_clrsky_day%flux_net , fluxes_clrsky_day%flux_dn_dir , & fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) call t_stopf('rad_rrtmgp_run_sw') - call t_startf('rad_rrtmgpxx_run_sw') - call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_allsky_cxx, do_direct=.true.) - call initialize_fluxes(nday, nlev_rad+1, nswbands, fluxes_clrsky_cxx, do_direct=.true.) - call rrtmgpxx_run_sw( & - size(active_gases), nday, nlev_rad, & - c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & - pmid_day(1:nday,1:nlev_rad), & - tmid_day(1:nday,1:nlev_rad), & - pint_day(1:nday,1:nlev_rad+1), & - coszrs_day(1:nday), & - albedo_dir_day(1:nswbands,1:nday), & - albedo_dif_day(1:nswbands,1:nday), & - cld_tau_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_ssa_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), cld_asm_gpt_rad(1:nday,1:nlev_rad,1:nswgpts), & - aer_tau_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_ssa_bnd_rad(1:nday,1:nlev_rad,1:nswbands), aer_asm_bnd_rad(1:nday,1:nlev_rad,1:nswbands), & - fluxes_allsky_cxx%flux_up , fluxes_allsky_cxx%flux_dn , fluxes_allsky_cxx%flux_net , fluxes_allsky_cxx%flux_dn_dir , & - fluxes_allsky_cxx%bnd_flux_up, fluxes_allsky_cxx%bnd_flux_dn, fluxes_allsky_cxx%bnd_flux_net, fluxes_allsky_cxx%bnd_flux_dn_dir, & - fluxes_clrsky_cxx%flux_up , fluxes_clrsky_cxx%flux_dn , fluxes_clrsky_cxx%flux_net , fluxes_clrsky_cxx%flux_dn_dir , & - fluxes_clrsky_cxx%bnd_flux_up, fluxes_clrsky_cxx%bnd_flux_dn, fluxes_clrsky_cxx%bnd_flux_net, fluxes_clrsky_cxx%bnd_flux_dn_dir, & - tsi_scaling & - ) - call t_stopf('rad_rrtmgpxx_run_sw') - ! Check fluxes - if (.true.) then - call assert(all(abs(fluxes_allsky_cxx%flux_up - fluxes_allsky_day%flux_up) < 1e-5), 'F90 and CXX allsky_flux_up differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_dn - fluxes_allsky_day%flux_dn) < 1e-5), 'F90 and CXX allsky_flux_dn differs.') - call assert(all(abs(fluxes_allsky_cxx%flux_net - fluxes_allsky_day%flux_net) < 1e-5), 'F90 and CXX allsky_flux_net differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_up - fluxes_clrsky_day%flux_up) < 1e-5), 'F90 and CXX clrsky_flux_up differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_dn - fluxes_clrsky_day%flux_dn) < 1e-5), 'F90 and CXX clrsky_flux_dn differs.') - call assert(all(abs(fluxes_clrsky_cxx%flux_net - fluxes_clrsky_day%flux_net) < 1e-5), 'F90 and CXX clrsky_flux_net differs.') - call assert(all(abs(fluxes_allsky_cxx%bnd_flux_up - fluxes_allsky_day%bnd_flux_up) < 1e-5), 'F90 and CXX allsky_bnd_flux_up differs.') - call assert(all(abs(fluxes_allsky_cxx%bnd_flux_dn - fluxes_allsky_day%bnd_flux_dn) < 1e-5), 'F90 and CXX allsky_bnd_flux_dn differs.') - call assert(all(abs(fluxes_allsky_cxx%bnd_flux_net - fluxes_allsky_day%bnd_flux_net) < 1e-5), 'F90 and CXX allsky_bnd_flux_net differs.') - call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_up - fluxes_clrsky_day%bnd_flux_up) < 1e-5), 'F90 and CXX clrsky_bnd_flux_up differs.') - call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_dn - fluxes_clrsky_day%bnd_flux_dn) < 1e-5), 'F90 and CXX clrsky_bnd_flux_dn differs.') - call assert(all(abs(fluxes_clrsky_cxx%bnd_flux_net - fluxes_clrsky_day%bnd_flux_net) < 1e-5), 'F90 and CXX clrsky_bnd_flux_net differs.') - end if - call free_fluxes(fluxes_allsky_cxx) - call free_fluxes(fluxes_clrsky_cxx) ! Expand fluxes from daytime-only arrays to full chunk arrays call t_startf('rad_expand_fluxes_sw') From 9ed7a37e1a74837f1d42a99a07c559a1807bd5b9 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 18 Mar 2021 17:05:52 -0600 Subject: [PATCH 41/71] Make C++ and F90 versions compatible --- components/cmake/build_model.cmake | 11 +- components/eam/bld/configure | 3 + .../physics/rrtmgp/cpp/rrtmgp_interface.F90 | 184 ++++++++++++++++++ ...pxx_interface.cpp => rrtmgp_interface.cpp} | 58 +++--- .../rrtmgp/{ => f90}/rrtmgp_interface.F90 | 48 +++-- .../eam/src/physics/rrtmgp/radiation.F90 | 72 +++---- 6 files changed, 276 insertions(+), 100 deletions(-) create mode 100644 components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 rename components/eam/src/physics/rrtmgp/cpp/{rrtmgpxx_interface.cpp => rrtmgp_interface.cpp} (91%) rename components/eam/src/physics/rrtmgp/{ => f90}/rrtmgp_interface.F90 (93%) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 418eec69cf05..b5a1bdfde823 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -114,10 +114,13 @@ function(build_model COMP_CLASS COMP_NAME) ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp ${RRTMGPXX_BIN}) # Add files to the main E3SM build - #set(SOURCES ${SOURCES} cmake/atm/../../eam/src/physics/crm/rrtmgpxx/cpp_interface_mod.F90) - set(SOURCES ${SOURCES} - cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 - cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp + set(SOURCES ${SOURCES} cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 + cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp + cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp + cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp + cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp + cmake/atm/../../eam/src/physics/rrtmgp/external/cpp/extensions/fluxes_byband/mo_fluxes_byband_kernels.cpp + ) endif() endif() diff --git a/components/eam/bld/configure b/components/eam/bld/configure index 14fe6d9f8044..2236686ace89 100755 --- a/components/eam/bld/configure +++ b/components/eam/bld/configure @@ -2617,6 +2617,9 @@ sub write_filepath print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions\n"; print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions/rng\n"; print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/examples\n"; + if (not defined $opts{'rrtmgpxx'} ) { + print $fh "$camsrcdir/eam/src/physics/rrtmgp/f90\n"; + } } print $fh "$camsrcdir/eam/src/physics/cam\n"; diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 new file mode 100644 index 000000000000..4a87b4a2c13c --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 @@ -0,0 +1,184 @@ +! Module to bridge the gap between the Fortran and C++ implemenations of +! RRTMGP. Remove class references from function calls, and handle all of that +! here. This is necessary because radiation_tend will remain in F90 (to deal +! with E3SM data types), but we will switch to C++ for the underlying RRTMGP +! code. +module rrtmgp_interface + + use iso_c_binding + + implicit none + + private + + ! Make these module variables so that we do not have to provide access to + ! k_dist objects; this just makes it easier to switch between F90 and C++ + ! interfaces. + integer, public :: nswbands, nlwbands, nswgpts, nlwgpts + + public :: & + rrtmgp_initialize, rrtmgp_finalize, & + rrtmgp_run_sw, rrtmgp_run_lw, & + get_nband_sw, get_nband_lw, & + get_ngpt_sw, get_ngpt_lw, & + get_gpoint_bands_sw, get_gpoint_bands_lw, & + get_min_temperature, get_max_temperature, & + c_strarr + + interface + + function get_nband_sw() bind(C,name="get_nband_sw") + use iso_c_binding + implicit none + integer(c_int) :: get_nband_sw + end function + + function get_nband_lw() bind(C,name="get_nband_lw") + use iso_c_binding + implicit none + integer(c_int) :: get_nband_lw + end function + + function get_ngpt_sw() bind(C, name="get_ngpt_sw") + use iso_c_binding + implicit none + integer(c_int) :: get_ngpt_sw + end function + + function get_ngpt_lw() bind(C, name="get_ngpt_lw") + use iso_c_binding + implicit none + integer(c_int) :: get_ngpt_lw + end function + + function get_min_temperature() bind(C, name="get_min_temperature") + use iso_c_binding + implicit none + real(c_double) :: get_min_temperature + end function + + function get_max_temperature() bind(C, name="get_max_temperature") + use iso_c_binding + implicit none + real(c_double) :: get_max_temperature + end function + + subroutine get_gpoint_bands_sw(gpoint_bands) bind(C, name="get_gpoint_bands_sw") + use iso_c_binding + implicit none + integer(c_int), dimension(*) :: gpoint_bands + end subroutine + + subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") + use iso_c_binding + implicit none + integer(c_int), dimension(*) :: gpoint_bands + end subroutine + + subroutine rrtmgp_initialize_cxx(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgp_initialize_cxx") + use iso_c_binding + implicit none + integer(kind=c_int), value :: ngas + type(c_ptr), dimension(*) :: gas_names + character(kind=c_char) :: coefficients_file_sw(*) + character(kind=c_char) :: coefficients_file_lw(*) + end subroutine rrtmgp_initialize_cxx + + subroutine rrtmgp_finalize() bind(C, name="rrtmgp_finalize") + end subroutine rrtmgp_finalize + + subroutine rrtmgp_run_sw( & + ngas, ncol, nlev, & + gas_vmr, & + pmid, tmid, pint, coszrs, & + albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & + tsi_scaling & + ) bind(C, name="rrtmgp_run_sw") + use iso_c_binding + implicit none + integer(kind=c_int), value :: ngas, ncol, nlev + real(kind=c_double), dimension(*) :: & + gas_vmr, pmid, tmid, pint, coszrs, albedo_dir, albedo_dif, & + cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & + aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir + real(kind=c_double), value :: tsi_scaling + end subroutine rrtmgp_run_sw + + subroutine rrtmgp_run_lw ( & + ngas, ncol, nlev, & + gas_vmr, & + pmid, tmid, pint, tint, & + surface_emissivity, & + cld_tau, aer_tau, & + allsky_flux_up , allsky_flux_dn , allsky_flux_net, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_flux_up , clrsky_flux_dn , clrsky_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net & + ) bind(C, name="rrtmgp_run_lw") + use iso_c_binding + implicit none + integer(kind=c_int), value :: ngas, ncol, nlev + real(kind=c_double), dimension(*) :: & + gas_vmr, & + pmid, tmid, pint, tint, surface_emissivity, & + cld_tau, aer_tau, & + allsky_flux_up, allsky_flux_dn, allsky_flux_net, & + allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & + clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, & + clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net + end subroutine rrtmgp_run_lw + + end interface + +contains + + ! Need to wrap rrtmgp_initialize_cxx to make sure we pass c-style strings + subroutine rrtmgp_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) + implicit none + integer :: ngas + character(len=*), dimension(:) :: gas_names + character(len=*) :: coefficients_file_sw + character(len=*) :: coefficients_file_lw + ! Null-terminated C-compatible version gas names + character(len=len(gas_names)+1), dimension(size(gas_names)), target :: gas_names_c + call rrtmgp_initialize_cxx( & + ngas, c_strarr(gas_names, gas_names_c), & + trim(coefficients_file_sw)//C_NULL_CHAR, & + trim(coefficients_file_lw)//C_NULL_CHAR & + ) + end subroutine rrtmgp_initialize + + ! Utility function to convert F90 string arrays to C-compatible string + ! pointers; NOTE: str_c seems to need to be intent(out), or else the first + ! element in the pointer array is messed up for some reason. + function c_strarr(str, str_c) result(str_p) + use iso_c_binding + implicit none + character(len=*), dimension(:), intent(in) :: str + character(len=*), dimension(:), target, intent(out) :: str_c + type(c_ptr), dimension(size(str)) :: str_p + integer :: istr + do istr = 1,size(str) + str_c(istr) = trim(str(istr))//C_NULL_CHAR + str_p(istr) = c_loc(str_c(istr)) + end do + end function c_strarr + +! function c_string(str) result(str_c) +! implicit none +! use iso_c_binding +! character(len=*), intent(in) :: str +! character(kind=c_char) :: str_c +! str_c = trim(str)//C_NULL_CHAR +! end function c_string +end module rrtmgp_interface diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp similarity index 91% rename from components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp rename to components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index e210701a0eb6..5e41ddc839f1 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -19,10 +19,10 @@ extern "C" double get_min_temperature(); extern "C" double get_max_temperature(); extern "C" void get_gpoint_bands_sw(int *gpoint_bands); extern "C" void get_gpoint_bands_lw(int *gpoint_bands); -extern "C" void rrtmgpxx_finalize(); -extern "C" void rrtmgpxx_run_sw ( +extern "C" void rrtmgp_finalize(); +extern "C" void rrtmgp_run_sw ( int ngas, int ncol, int nlay, - char *gas_names_p[], double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, + double *gas_vmr_p, double *pmid_p , double *tmid_p , double *pint_p, double *coszrs_p , double *albedo_dir_p, double *albedo_dif_p, double *cld_tau_gpt_p, double *cld_ssa_gpt_p, double *cld_asm_gpt_p, double *aer_tau_bnd_p, double *aer_ssa_bnd_p, double *aer_asm_bnd_p, @@ -32,9 +32,9 @@ extern "C" void rrtmgpxx_run_sw ( double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p, double *clrsky_bnd_flux_dn_dir_p, double tsi_scaling ); -extern "C" void rrtmgpxx_run_lw ( +extern "C" void rrtmgp_run_lw ( int ngas, int ncol, int nlay, - char *gas_names_p[], double *gas_vmr_p , + double *gas_vmr_p , double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, double *emis_sfc_p , double *cld_tau_gpt_p , double *aer_tau_bnd_p , @@ -49,9 +49,9 @@ GasOpticsRRTMGP k_dist_sw; GasOpticsRRTMGP k_dist_lw; // Vector of strings to hold active gas names. -//string1d gas_names1d; +string1d active_gases; -extern "C" void rrtmgpxx_initialize(int ngas, char *gas_names[], char const *coefficients_file_sw, char const *coefficients_file_lw) { +extern "C" void rrtmgp_initialize_cxx(int ngas, char *gas_names[], char const *coefficients_file_sw, char const *coefficients_file_lw) { // First, make sure yakl has been initialized if (!yakl::isInitialized()) { yakl::init(); @@ -66,17 +66,17 @@ extern "C" void rrtmgpxx_initialize(int ngas, char *gas_names[], char const *coe // impossible from this initialization routine because I do not thing the // rad_cnst objects are setup yet. // the other tasks! - string1d gas_names1d("gas_names1d", ngas); + active_gases = string1d("active_gases", ngas); for (int igas=0; igas(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { + tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); + }); + gas_concs.set_vmr(active_gases(igas), tmp2d); } // Do gas optics @@ -258,9 +248,9 @@ extern "C" void rrtmgpxx_run_sw ( rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_allsky); } -extern "C" void rrtmgpxx_run_lw ( +extern "C" void rrtmgp_run_lw ( int ngas, int ncol, int nlay, - char *gas_names_p[] , double *gas_vmr_p , + double *gas_vmr_p , double *pmid_p , double *tmid_p , double *pint_p , double *tint_p, double *emis_sfc_p , double *cld_tau_gpt_p , double *aer_tau_bnd_p , @@ -294,12 +284,8 @@ extern "C" void rrtmgpxx_run_lw ( auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); // Populate gas concentrations - string1d gas_names("gas_names", ngas); - for (int igas = 1; igas<=ngas; igas++) { - gas_names(igas) = gas_names_p[igas-1]; - } GasConcs gas_concs; - gas_concs.init(gas_names, ncol, nlay); + gas_concs.init(active_gases, ncol, nlay); real2d tmp2d; tmp2d = real2d("tmp", ncol, nlay); for (int igas = 1; igas <= ngas; igas++) { @@ -308,7 +294,7 @@ extern "C" void rrtmgpxx_run_lw ( tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); } } - gas_concs.set_vmr(gas_names(igas), tmp2d); + gas_concs.set_vmr(active_gases(igas), tmp2d); } // Boundary conditions diff --git a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/f90/rrtmgp_interface.F90 similarity index 93% rename from components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 rename to components/eam/src/physics/rrtmgp/f90/rrtmgp_interface.F90 index 4fac2ab2e537..0f11d943f300 100644 --- a/components/eam/src/physics/rrtmgp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/f90/rrtmgp_interface.F90 @@ -31,10 +31,13 @@ module rrtmgp_interface ! interfaces. integer, public :: nswbands, nlwbands, nswgpts, nlwgpts + character(len=8), dimension(:), allocatable :: active_gases + public :: & - rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & + rrtmgp_initialize, rrtmgp_finalize, & + rrtmgp_run_sw, rrtmgp_run_lw, & get_nbnds_sw, get_nbnds_lw, & - get_ngpts_sw, get_ngpts_lw, & + get_ngpt_sw, get_ngpt_lw, & get_gpoint_bands_sw, get_gpoint_bands_lw, & get_min_temperature, get_max_temperature @@ -48,13 +51,13 @@ integer function get_nbnds_lw() get_nbnds_lw = k_dist_lw%get_nband() end function get_nbnds_lw - integer function get_ngpts_sw() - get_ngpts_sw = k_dist_sw%get_ngpt() - end function get_ngpts_sw + integer function get_ngpt_sw() + get_ngpt_sw = k_dist_sw%get_ngpt() + end function get_ngpt_sw - integer function get_ngpts_lw() - get_ngpts_lw = k_dist_lw%get_ngpt() - end function get_ngpts_lw + integer function get_ngpt_lw() + get_ngpt_lw = k_dist_lw%get_ngpt() + end function get_ngpt_lw subroutine get_gpoint_bands_sw(gpoint_bands) integer, intent(out), dimension(nswgpts) :: gpoint_bands @@ -66,10 +69,12 @@ subroutine get_gpoint_bands_lw(gpoint_bands) gpoint_bands = k_dist_lw%get_gpoint_bands() end subroutine get_gpoint_bands_lw - subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_file_lw) - character(len=*), intent(in) :: active_gases(:) + subroutine rrtmgp_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) + integer, intent(in) :: ngas + character(len=*), intent(in) :: gas_names(:) character(len=*), intent(in) :: coefficients_file_sw, coefficients_file_lw type(ty_gas_concs) :: available_gases + integer :: igas ! Read gas optics coefficients from file ! Need to initialize available_gases here! The only field of the ! available_gases type that is used int he kdist initialize is @@ -80,7 +85,7 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi ! rad_cnst objects are setup yet. ! the other tasks! ! TODO: This needs to be fixed to ONLY read in the data if masterproc, and then broadcast - call set_available_gases(active_gases, available_gases) + call set_available_gases(gas_names, available_gases) call load_and_init(k_dist_sw, coefficients_file_sw, available_gases) call load_and_init(k_dist_lw, coefficients_file_lw, available_gases) ! Set number of bands based on what we read in from input data @@ -89,11 +94,20 @@ subroutine rrtmgp_initialize(active_gases, coefficients_file_sw, coefficients_fi ! Number of gpoints depend on inputdata, so initialize here nswgpts = k_dist_sw%get_ngpt() nlwgpts = k_dist_lw%get_ngpt() + ! Set up list of active gases + allocate(active_gases(ngas)) + do igas = 1,ngas + active_gases(igas) = trim(gas_names(igas)) + end do end subroutine rrtmgp_initialize + subroutine rrtmgp_finalize() + deallocate(active_gases) + end subroutine rrtmgp_finalize + subroutine rrtmgp_run_sw( & ngas, ncol, nlev, & - gas_names, gas_vmr, & + gas_vmr, & pmid, tmid, pint, coszrs, & albedo_dir, albedo_dif, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & @@ -105,7 +119,6 @@ subroutine rrtmgp_run_sw( & tsi_scaling & ) integer, intent(in) :: ngas, ncol, nlev - character(len=*), dimension(:) :: gas_names real(wp), intent(in), dimension(:,:,:) :: gas_vmr real(wp), intent(in), dimension(:,:) :: & pmid, tmid, pint @@ -182,7 +195,7 @@ subroutine rrtmgp_run_sw( & ! Set gas concentrations call t_startf('rad_set_gases_sw') - call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + call set_gas_concentrations(ncol, active_gases, gas_vmr, gas_concentrations) call t_stopf('rad_set_gases_sw') call handle_error(rte_sw( & @@ -208,9 +221,9 @@ end subroutine rrtmgp_run_sw subroutine rrtmgp_run_lw( & ngas, ncol, nlev, & - gas_names, gas_vmr, & - surface_emissivity, & + gas_vmr, & pmid, tmid, pint, tint, & + surface_emissivity, & cld_tau_gpt, aer_tau_bnd, & allsky_flux_up, allsky_flux_dn, allsky_flux_net, & allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, & @@ -219,7 +232,6 @@ subroutine rrtmgp_run_lw( & ) integer, intent(in) :: ngas, ncol, nlev - character(len=*), intent(in), dimension(:) :: gas_names real(wp), intent(in), dimension(:,:,:) :: gas_vmr real(wp), intent(in), dimension(:,:) :: surface_emissivity real(wp), intent(in), dimension(:,:) :: pmid, tmid, pint, tint @@ -253,7 +265,7 @@ subroutine rrtmgp_run_lw( & ! Setup gas concentrations object call t_startf('rad_gas_concentrations_lw') - call set_gas_concentrations(ncol, gas_names, gas_vmr, gas_concentrations) + call set_gas_concentrations(ncol, active_gases, gas_vmr, gas_concentrations) call t_stopf('rad_gas_concentrations_lw') ! Populate RRTMGP optics diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index f29bad951e28..226eca0a0d08 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -28,20 +28,12 @@ module radiation ! RRTMGP interface to separate E3SM-specific data types from RRTMGP-specific ! data types, that may be in Fortran or C++ use rrtmgp_interface, only: & - rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & - rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & - rrtmgp_get_min_temperature => get_min_temperature, & - rrtmgp_get_max_temperature => get_max_temperature, & + rrtmgp_initialize, rrtmgp_finalize, & + rrtmgp_run_sw, rrtmgp_run_lw, & + get_min_temperature, & + get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - nswgpts, nlwgpts - use rrtmgpxx_interface, only: & - rrtmgpxx_initialize, rrtmgpxx_finalize, & - rrtmgpxx_run_sw, rrtmgpxx_run_lw, & - rrtmgpxx_get_min_temperature => get_min_temperature, & - rrtmgpxx_get_max_temperature => get_max_temperature, & - rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & - rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & - c_strarr + get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -175,9 +167,6 @@ module radiation 'H2O', 'CO2', 'O3 ', 'N2O', & 'CO ', 'CH4', 'O2 ', 'N2 ' & /) - ! Null-terminated C-compatible version of active gases for use with C++ - ! routines. - character(len=len(active_gases)+1), dimension(size(active_gases)), target :: active_gases_c ! Stuff to generate random numbers for perturbation growth tests. This needs to ! be public module data because restart_physics needs to read it to write it to @@ -198,6 +187,9 @@ module radiation ! Indices to pbuf fields integer :: cldfsnow_idx = 0 + ! These come from RRTMGP input data + integer :: nswgpts, nlwgpts + !============================================================================ contains @@ -493,12 +485,11 @@ subroutine radiation_init(state) call perturbation_growth_init() ! Setup the RRTMGP interface - call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) - call rrtmgpxx_initialize( & - size(active_gases), c_strarr(active_gases, active_gases_c), & - trim(rrtmgp_coefficients_file_sw)//C_NULL_CHAR, & - trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & - ) + call rrtmgp_initialize(size(active_gases), active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) + + ! Set number of gpoints in sw and lw based on input data read above + nswgpts = get_ngpt_sw() + nlwgpts = get_ngpt_lw() ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL @@ -887,7 +878,7 @@ subroutine radiation_init(state) end subroutine radiation_init subroutine radiation_final() - call rrtmgpxx_finalize() + call rrtmgp_finalize() end subroutine radiation_final subroutine perturbation_growth_init() @@ -1227,11 +1218,11 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! values to min/max specified call t_startf('rrtmgp_check_temperatures') call handle_error(clip_values( & - tmid(1:ncol,1:nlev_rad), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & + tmid(1:ncol,1:nlev_rad), get_min_temperature(), get_max_temperature(), & trim(subname) // ' tmid' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call handle_error(clip_values( & - tint(1:ncol,1:nlev_rad+1), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & + tint(1:ncol,1:nlev_rad+1), get_min_temperature(), get_max_temperature(), & trim(subname) // ' tint' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call t_stopf('rrtmgp_check_temperatures') @@ -1284,7 +1275,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & end do ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state - call rrtmgpxx_get_gpoint_bands_sw(gpoint_bands_sw) + call get_gpoint_bands_sw(gpoint_bands_sw) call sample_cloud_optics_sw( & ncol, pver, nswgpts, gpoint_bands_sw, & state%pmid, cld, cldfsnow, & @@ -1345,7 +1336,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! Call the shortwave radiation driver call radiation_driver_sw( & - ncol, active_gases, gas_vmr, & + ncol, gas_vmr, & pmid, pint, tmid, albedo_dir, albedo_dif, coszrs, & cld_tau_gpt_sw, cld_ssa_gpt_sw, cld_asm_gpt_sw, & aer_tau_bnd_sw, aer_ssa_bnd_sw, aer_asm_bnd_sw, & @@ -1393,7 +1384,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & lambdac, mu, dei, des, rei, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) - call rrtmgpxx_get_gpoint_bands_lw(gpoint_bands_lw) + call get_gpoint_bands_lw(gpoint_bands_lw) call sample_cloud_optics_lw( & ncol, pver, nlwgpts, gpoint_bands_lw, & state%pmid, cld, cldfsnow, & @@ -1425,7 +1416,7 @@ subroutine radiation_tend(state, ptend, pbuf, cam_out, cam_in, & ! Call the longwave radiation driver to calculate fluxes and heating rates call radiation_driver_lw( & - ncol, active_gases, gas_vmr, & + ncol, gas_vmr, & pmid, pint, tmid, tint, & cld_tau_gpt_lw, aer_tau_bnd_lw, & fluxes_allsky, fluxes_clrsky, qrl, qrlc & @@ -1517,7 +1508,7 @@ end subroutine radiation_tend !---------------------------------------------------------------------------- subroutine radiation_driver_sw(ncol, & - gas_names, gas_vmr, & + gas_vmr, & pmid, pint, tmid, albedo_dir, albedo_dif, coszrs, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & @@ -1531,7 +1522,6 @@ subroutine radiation_driver_sw(ncol, & integer, intent(in) :: ncol type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrs(:,:), qrsc(:,:) - character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr real(r8), intent(in), dimension(:,:) :: pmid, pint, tmid real(r8), intent(in), dimension(:,:) :: albedo_dir, albedo_dif @@ -1553,8 +1543,8 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day real(r8), dimension(ncol,nlev_rad+1) :: pint_day - real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day - real(r8), dimension(size(gas_names),ncol,nlev_rad) :: gas_vmr_rad + real(r8), dimension(size(gas_vmr, 1),ncol,pver) :: gas_vmr_day + real(r8), dimension(size(gas_vmr, 1),ncol,nlev_rad) :: gas_vmr_rad real(r8), dimension(ncol,nlev_rad-1,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,nlev_rad-1,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day @@ -1646,9 +1636,9 @@ subroutine radiation_driver_sw(ncol, & ! Do shortwave radiative transfer calculations call t_startf('rad_rrtmgp_run_sw') - call rrtmgpxx_run_sw( & + call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & - c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & + gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & @@ -1780,7 +1770,7 @@ end subroutine output_cloud_optics_lw !---------------------------------------------------------------------------- subroutine radiation_driver_lw(ncol, & - gas_names, gas_vmr, & + gas_vmr, & pmid, pint, tmid, tint, & cld_tau_gpt, aer_tau_bnd, & fluxes_allsky, fluxes_clrsky, qrl, qrlc) @@ -1792,7 +1782,6 @@ subroutine radiation_driver_lw(ncol, & integer, intent(in) :: ncol type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrl(:,:), qrlc(:,:) - character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr real(r8), intent(in), dimension(:,:) :: pmid, pint, tmid, tint real(r8), intent(in), dimension(:,:,:) :: cld_tau_gpt, aer_tau_bnd @@ -1828,11 +1817,10 @@ subroutine radiation_driver_lw(ncol, & gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Do longwave radiative transfer calculations - call t_startf('rrtmgpxx_run_lw') - ! Try calling C++ version - call rrtmgpxx_run_lw( & + call t_startf('rrtmgp_run_lw') + call rrtmgp_run_lw( & size(active_gases), ncol, nlev_rad, & - c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & + gas_vmr_rad(:,1:ncol,:), & pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & surface_emissivity(1:nlwbands,1:ncol), & cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & @@ -1841,7 +1829,7 @@ subroutine radiation_driver_lw(ncol, & fluxes_clrsky%flux_up , fluxes_clrsky%flux_dn , fluxes_clrsky%flux_net , & fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) - call t_stopf('rrtmgpxx_run_lw') + call t_stopf('rrtmgp_run_lw') ! Calculate heating rates call calculate_heating_rate( & From 4e7856c9e166a5a3763c435b0992e7c7070ece7c Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Tue, 23 Mar 2021 17:08:38 -0600 Subject: [PATCH 42/71] Make MMF interface consistent with E3SM --- .../eam/src/physics/crm/rrtmgp/radiation.F90 | 82 +++------ .../physics/rrtmgp/cpp/rrtmgp_interface.F90 | 3 + .../physics/rrtmgp/cpp/rrtmgpxx_interface.F90 | 170 ------------------ .../eam/src/physics/rrtmgp/radiation.F90 | 12 +- 4 files changed, 28 insertions(+), 239 deletions(-) delete mode 100644 components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 diff --git a/components/eam/src/physics/crm/rrtmgp/radiation.F90 b/components/eam/src/physics/crm/rrtmgp/radiation.F90 index f4e1b907c4f8..0e9ceea6edc8 100644 --- a/components/eam/src/physics/crm/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmgp/radiation.F90 @@ -30,22 +30,11 @@ module radiation ! here so that we can make the k_dist objects module data and only load them ! once. use rrtmgp_interface, only: & - rrtmgp_initialize, rrtmgp_run_sw, rrtmgp_run_lw, & - rrtmgp_nswbands => nswbands, rrtmgp_nlwbands => nlwbands, & - rrtmgp_get_min_temperature => get_min_temperature, & - rrtmgp_get_max_temperature => get_max_temperature, & + rrtmgp_initialize, rrtmgp_finalize, & + rrtmgp_run_sw, rrtmgp_run_lw, & + get_min_temperature, get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & nswgpts, nlwgpts - use rrtmgpxx_interface, only: & - rrtmgpxx_initialize, rrtmgpxx_finalize, & - rrtmgpxx_run_sw, rrtmgpxx_run_lw, & - rrtmgpxx_get_min_temperature => get_min_temperature, & - rrtmgpxx_get_max_temperature => get_max_temperature, & - rrtmgpxx_get_gpoint_bands_sw => get_gpoint_bands_sw, & - rrtmgpxx_get_gpoint_bands_lw => get_gpoint_bands_lw, & - c_strarr, & - get_nband_sw, get_nband_lw, & - get_ngpt_sw, get_ngpt_lw ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -502,30 +491,7 @@ subroutine radiation_init(state) call perturbation_growth_init() ! Setup the RRTMGP interface - call rrtmgp_initialize(active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) - call rrtmgpxx_initialize( & - size(active_gases), c_strarr(active_gases, active_gases_c), & - trim(rrtmgp_coefficients_file_sw)//C_NULL_CHAR, & - trim(rrtmgp_coefficients_file_lw)//C_NULL_CHAR & - ) - - ! Make sure number of bands in absorption coefficient files matches what we expect - call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') - call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') - - ! Make sure number of bands in absorption coefficient files matches what we expect - !call assert(nswbands == rrtmgp_nswbands, 'nswbands does not match absorption coefficient data') - !call assert(nlwbands == rrtmgp_nlwbands, 'nlwbands does not match absorption coefficient data') - call assert(nswbands == get_nband_sw(), 'nswbands does not match RRTMGPXX absorption coefficient data') - call assert(nlwbands == get_nband_lw(), 'nlwbands does not match RRTMGPXX absorption coefficient data') - - ! Check that gpoints are consistent after initialization - call assert(nswgpts == get_ngpt_sw(), 'nswgpts does not match RRTMGPXX absorption coefficient data') - call assert(nlwgpts == get_ngpt_lw(), 'nlwgpts does not match RRTMGPXX absorption coefficient data') - - ! Check that min and max temperatures are consistent - call assert(rrtmgp_get_min_temperature() == rrtmgpxx_get_min_temperature(), 'RRTMGP and RRTMGPXX min temperatures do not match.') - call assert(rrtmgp_get_max_temperature() == rrtmgpxx_get_max_temperature(), 'RRTMGP and RRTMGPXX max temperatures do not match.') + call rrtmgp_initialize(size(active_gases), active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL @@ -947,7 +913,7 @@ subroutine radiation_init(state) end subroutine radiation_init subroutine radiation_final() - call rrtmgpxx_finalize() + call rrtmgp_finalize() end subroutine radiation_final subroutine perturbation_growth_init() @@ -1554,11 +1520,11 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! values to min/max specified call t_startf('rad_check_temperatures') call handle_error(clip_values( & - tmid_col(1:ncol,1:nlev_rad), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & + tmid_col(1:ncol,1:nlev_rad), get_min_temperature(), get_max_temperature(), & trim(subname) // ' tmid' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call handle_error(clip_values( & - tint_col(1:ncol,1:nlev_rad+1), rrtmgp_get_min_temperature(), rrtmgp_get_max_temperature(), & + tint_col(1:ncol,1:nlev_rad+1), get_min_temperature(), get_max_temperature(), & trim(subname) // ' tint' & ), fatal=.false., warn=rrtmgp_enable_temperature_warnings) call t_stopf('rad_check_temperatures') @@ -1599,7 +1565,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & end do ! And now do the MCICA sampling to get cloud optical properties by ! gpoint/cloud state - call rrtmgpxx_get_gpoint_bands_sw(gpoint_bands_sw) + call get_gpoint_bands_sw(gpoint_bands_sw) call sample_cloud_optics_sw( & ncol, pver, nswgpts, gpoint_bands_sw, & state%pmid, cld, cldfsnow, & @@ -1625,7 +1591,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & lambdac, mu, dei, des, rei, & cld_tau_bnd_lw, liq_tau_bnd_lw, ice_tau_bnd_lw, snw_tau_bnd_lw & ) - call rrtmgpxx_get_gpoint_bands_lw(gpoint_bands_lw) + call get_gpoint_bands_lw(gpoint_bands_lw) call sample_cloud_optics_lw( & ncol, pver, nlwgpts, gpoint_bands_lw, & state%pmid, cld, cldfsnow, & @@ -1687,7 +1653,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Calculate shortwave fluxes call t_startf('rad_radiation_driver_sw') if (.true.) call radiation_driver_sw(ncol_tot, & - active_gases, vmr_all, & + vmr_all, & pmid, pint, tmid, albedo_dir_all, albedo_dif_all, coszrs_all, & cld_tau_gpt_sw_all, cld_ssa_gpt_sw_all, cld_asm_gpt_sw_all, & aer_tau_bnd_sw_all, aer_ssa_bnd_sw_all, aer_asm_bnd_sw_all, & @@ -1790,7 +1756,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & ! Calculate longwave fluxes call t_startf('rad_fluxes_lw') call radiation_driver_lw( & - active_gases, vmr_all(:,1:ncol_tot,1:pver), & + vmr_all(:,1:ncol_tot,1:pver), & surface_emissivity(1:nlwbands,1:ncol_tot), & pmid(1:ncol_tot,1:nlev_rad ), tmid(1:ncol_tot,1:nlev_rad ), & pint(1:ncol_tot,1:nlev_rad+1), tint(1:ncol_tot,1:nlev_rad+1), & @@ -1929,7 +1895,7 @@ subroutine radiation_tend(state_in,ptend, pbuf, cam_out, cam_in, & end subroutine radiation_tend subroutine radiation_driver_sw(ncol, & - gas_names, gas_vmr, & + gas_vmr, & pmid, pint, tmid, albedo_dir, albedo_dif, coszrs, & cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & @@ -1942,7 +1908,6 @@ subroutine radiation_driver_sw(ncol, & integer, intent(in) :: ncol type(fluxes_t), intent(inout) :: fluxes_allsky, fluxes_clrsky real(r8), intent(inout) :: qrs(:,:), qrsc(:,:) - character(len=*), intent(in), dimension(:) :: gas_names real(r8), intent(in), dimension(:,:,:) :: gas_vmr real(r8), intent(in), dimension(:,:) :: pmid, pint, tmid real(r8), intent(in), dimension(:,:) :: albedo_dir, albedo_dif @@ -1955,8 +1920,8 @@ subroutine radiation_driver_sw(ncol, & real(r8), dimension(nswbands,ncol) :: albedo_dir_day, albedo_dif_day real(r8), dimension(ncol,nlev_rad) :: pmid_day, tmid_day real(r8), dimension(ncol,nlev_rad+1) :: pint_day - real(r8), dimension(size(gas_names),ncol,pver) :: gas_vmr_day - real(r8), dimension(size(gas_names),ncol,nlev_rad) :: gas_vmr_rad + real(r8), dimension(size(gas_vmr, 1),ncol,pver) :: gas_vmr_day + real(r8), dimension(size(gas_vmr, 1),ncol,nlev_rad) :: gas_vmr_rad real(r8), dimension(ncol,pver,nswgpts) :: cld_tau_gpt_day, cld_ssa_gpt_day, cld_asm_gpt_day real(r8), dimension(ncol,pver,nswbands) :: aer_tau_bnd_day, aer_ssa_bnd_day, aer_asm_bnd_day type(fluxes_t) :: fluxes_allsky_day, fluxes_clrsky_day @@ -2060,10 +2025,10 @@ subroutine radiation_driver_sw(ncol, & gas_vmr_rad(:,1:nday,ktop:kbot) = gas_vmr_day(:,1:nday,1:pver) ! Do shortwave radiative transfer calculations - call t_startf('rad_rrtmgpxx_run_sw') - call rrtmgpxx_run_sw( & + call t_startf('rad_rrtmgp_run_sw') + call rrtmgp_run_sw( & size(active_gases), nday, nlev_rad, & - c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:nday,1:nlev_rad), & + gas_vmr_rad(:,1:nday,1:nlev_rad), & pmid_day(1:nday,1:nlev_rad), & tmid_day(1:nday,1:nlev_rad), & pint_day(1:nday,1:nlev_rad+1), & @@ -2078,7 +2043,7 @@ subroutine radiation_driver_sw(ncol, & fluxes_clrsky_day%bnd_flux_up, fluxes_clrsky_day%bnd_flux_dn, fluxes_clrsky_day%bnd_flux_net, fluxes_clrsky_day%bnd_flux_dn_dir, & tsi_scaling & ) - call t_stopf('rad_rrtmgpxx_run_sw') + call t_stopf('rad_rrtmgp_run_sw') ! Expand fluxes from daytime-only arrays to full chunk arrays call t_startf('rad_expand_fluxes_sw') @@ -2111,14 +2076,13 @@ end subroutine radiation_driver_sw !---------------------------------------------------------------------------- - subroutine radiation_driver_lw(gas_names, gas_vmr, surface_emissivity, & + subroutine radiation_driver_lw(gas_vmr, surface_emissivity, & pmid, tmid, pint, tint, & cld_tau_gpt, aer_tau_bnd, & fluxes_allsky, fluxes_clrsky) use perf_mod, only: t_startf, t_stopf - character(len=*), intent(in) :: gas_names(:) real(r8), intent(in) :: gas_vmr(:,:,:) real(r8), intent(in) :: surface_emissivity(:,:) real(r8), intent(in) :: pmid(:,:), tmid(:,:), pint(:,:), tint(:,:) @@ -2144,10 +2108,10 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, surface_emissivity, & gas_vmr_rad(:,1:ncol,ktop:kbot) = gas_vmr(:,1:ncol,:) ! Compute fluxes - call t_startf('rrtmgpxx_run_lw') - call rrtmgpxx_run_lw( & + call t_startf('rrtmgp_run_lw') + call rrtmgp_run_lw( & size(active_gases), ncol, nlev_rad, & - c_strarr(active_gases, active_gases_c), gas_vmr_rad(:,1:ncol,:), & + gas_vmr_rad(:,1:ncol,:), & pmid(1:ncol,1:nlev_rad), tmid(1:ncol,1:nlev_rad), pint(1:ncol,1:nlev_rad+1), tint(1:ncol,1:nlev_rad+1), & surface_emissivity(1:nlwbands,1:ncol), & cld_tau_gpt_rad(1:ncol,:,:) , aer_tau_bnd_rad(1:ncol,:,:) , & @@ -2156,7 +2120,7 @@ subroutine radiation_driver_lw(gas_names, gas_vmr, surface_emissivity, & fluxes_clrsky%flux_up , fluxes_clrsky%flux_dn , fluxes_clrsky%flux_net , & fluxes_clrsky%bnd_flux_up, fluxes_clrsky%bnd_flux_dn, fluxes_clrsky%bnd_flux_net & ) - call t_stopf('rrtmgpxx_run_lw') + call t_stopf('rrtmgp_run_lw') end subroutine radiation_driver_lw !---------------------------------------------------------------------------- diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 index 4a87b4a2c13c..2b0b338049c3 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 @@ -156,6 +156,9 @@ subroutine rrtmgp_initialize(ngas, gas_names, coefficients_file_sw, coefficients trim(coefficients_file_sw)//C_NULL_CHAR, & trim(coefficients_file_lw)//C_NULL_CHAR & ) + ! Set number of gpoints + nswgpts = get_ngpt_sw() + nlwgpts = get_ngpt_lw() end subroutine rrtmgp_initialize ! Utility function to convert F90 string arrays to C-compatible string diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 deleted file mode 100644 index 603d64c5fd89..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgpxx_interface.F90 +++ /dev/null @@ -1,170 +0,0 @@ -! Module to bridge the gap between the Fortran and C++ implemenations of -! RRTMGP. Remove class references from function calls, and handle all of that -! here. This is necessary because radiation_tend will remain in F90 (to deal -! with E3SM data types), but we will switch to C++ for the underlying RRTMGP -! code. -module rrtmgpxx_interface - - use iso_c_binding - - implicit none - - private - - ! Make these module variables so that we do not have to provide access to - ! k_dist objects; this just makes it easier to switch between F90 and C++ - ! interfaces. - integer, public :: nswbands, nlwbands, nswgpts, nlwgpts - - public :: & - rrtmgpxx_initialize, rrtmgpxx_finalize, & - rrtmgpxx_run_sw, rrtmgpxx_run_lw, & - get_nband_sw, get_nband_lw, & - get_ngpt_sw, get_ngpt_lw, & - get_gpoint_bands_sw, get_gpoint_bands_lw, & - get_min_temperature, get_max_temperature, & - c_strarr - - interface - - function get_nband_sw() bind(C,name="get_nband_sw") - use iso_c_binding - implicit none - integer(c_int) :: get_nband_sw - end function - - function get_nband_lw() bind(C,name="get_nband_lw") - use iso_c_binding - implicit none - integer(c_int) :: get_nband_lw - end function - - function get_ngpt_sw() bind(C, name="get_ngpt_sw") - use iso_c_binding - implicit none - integer(c_int) :: get_ngpt_sw - end function - - function get_ngpt_lw() bind(C, name="get_ngpt_lw") - use iso_c_binding - implicit none - integer(c_int) :: get_ngpt_lw - end function - - function get_min_temperature() bind(C, name="get_min_temperature") - use iso_c_binding - implicit none - real(c_double) :: get_min_temperature - end function - - function get_max_temperature() bind(C, name="get_max_temperature") - use iso_c_binding - implicit none - real(c_double) :: get_max_temperature - end function - - subroutine get_gpoint_bands_sw(gpoint_bands) bind(C, name="get_gpoint_bands_sw") - use iso_c_binding - implicit none - integer(c_int), dimension(*) :: gpoint_bands - end subroutine - - subroutine get_gpoint_bands_lw(gpoint_bands) bind(C, name="get_gpoint_bands_lw") - use iso_c_binding - implicit none - integer(c_int), dimension(*) :: gpoint_bands - end subroutine - - subroutine rrtmgpxx_initialize(ngas, gas_names, coefficients_file_sw, coefficients_file_lw) bind(C, name="rrtmgpxx_initialize") - use iso_c_binding - implicit none - integer(kind=c_int), value :: ngas - type(c_ptr), dimension(*) :: gas_names - character(kind=c_char) :: coefficients_file_sw(*) - character(kind=c_char) :: coefficients_file_lw(*) - end subroutine rrtmgpxx_initialize - - subroutine rrtmgpxx_finalize() bind(C, name="rrtmgpxx_finalize") - end subroutine rrtmgpxx_finalize - - subroutine rrtmgpxx_run_sw( & - ngas, ncol, nlev, & - gas_names, gas_vmr, & - pmid, tmid, pint, coszrs, & - albedo_dir, albedo_dif, & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir, & - tsi_scaling & - ) bind(C, name="rrtmgpxx_run_sw") - use iso_c_binding - implicit none - integer(kind=c_int), value :: ngas, ncol, nlev - type(c_ptr), dimension(*) :: gas_names - real(kind=c_double), dimension(*) :: & - gas_vmr, pmid, tmid, pint, coszrs, albedo_dir, albedo_dif, & - cld_tau_gpt, cld_ssa_gpt, cld_asm_gpt, & - aer_tau_bnd, aer_ssa_bnd, aer_asm_bnd, & - allsky_flux_up, allsky_flux_dn, allsky_flux_net, allsky_flux_dn_dir, & - allsky_bnd_flux_up, allsky_bnd_flux_dn, allsky_bnd_flux_net, allsky_bnd_flux_dn_dir, & - clrsky_flux_up, clrsky_flux_dn, clrsky_flux_net, clrsky_flux_dn_dir, & - clrsky_bnd_flux_up, clrsky_bnd_flux_dn, clrsky_bnd_flux_net, clrsky_bnd_flux_dn_dir - real(kind=c_double), value :: tsi_scaling - end subroutine rrtmgpxx_run_sw - - subroutine rrtmgpxx_run_lw ( & - ngas, ncol, nlev, & - gas_names, gas_vmr, & - pmid, tmid, pint, tint, & - surface_emissivity, & - cld_tau, aer_tau, & - allsky_flux_up_cxx , allsky_flux_dn_cxx , allsky_flux_net_cxx, & - allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, & - clrsky_flux_up_cxx , clrsky_flux_dn_cxx , clrsky_flux_net_cxx, & - clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx & - ) bind(C, name="rrtmgpxx_run_lw") - use iso_c_binding - implicit none - integer(kind=c_int), value :: ngas, ncol, nlev - type(c_ptr), dimension(*) :: gas_names - real(kind=c_double), dimension(*) :: & - gas_vmr, & - pmid, tmid, pint, tint, surface_emissivity, & - cld_tau, aer_tau, & - allsky_flux_up_cxx, allsky_flux_dn_cxx, allsky_flux_net_cxx, & - allsky_bnd_flux_up_cxx, allsky_bnd_flux_dn_cxx, allsky_bnd_flux_net_cxx, & - clrsky_flux_up_cxx, clrsky_flux_dn_cxx, clrsky_flux_net_cxx, & - clrsky_bnd_flux_up_cxx, clrsky_bnd_flux_dn_cxx, clrsky_bnd_flux_net_cxx - end subroutine rrtmgpxx_run_lw - - end interface - -contains - - ! Utility function to convert F90 string arrays to C-compatible string - ! pointers; NOTE: str_c seems to need to be intent(out), or else the first - ! element in the pointer array is messed up for some reason. - function c_strarr(str, str_c) result(str_p) - use iso_c_binding - implicit none - character(len=*), dimension(:), intent(in) :: str - character(len=*), dimension(:), target, intent(out) :: str_c - type(c_ptr), dimension(size(str)) :: str_p - integer :: istr - do istr = 1,size(str) - str_c(istr) = trim(str(istr))//C_NULL_CHAR - str_p(istr) = c_loc(str_c(istr)) - end do - end function c_strarr - -! function c_string(str) result(str_c) -! implicit none -! use iso_c_binding -! character(len=*), intent(in) :: str -! character(kind=c_char) :: str_c -! str_c = trim(str)//C_NULL_CHAR -! end function c_string -end module rrtmgpxx_interface diff --git a/components/eam/src/physics/rrtmgp/radiation.F90 b/components/eam/src/physics/rrtmgp/radiation.F90 index 226eca0a0d08..c7afa55ddc71 100644 --- a/components/eam/src/physics/rrtmgp/radiation.F90 +++ b/components/eam/src/physics/rrtmgp/radiation.F90 @@ -30,10 +30,9 @@ module radiation use rrtmgp_interface, only: & rrtmgp_initialize, rrtmgp_finalize, & rrtmgp_run_sw, rrtmgp_run_lw, & - get_min_temperature, & - get_max_temperature, & + get_min_temperature, get_max_temperature, & get_gpoint_bands_sw, get_gpoint_bands_lw, & - get_ngpt_sw, get_ngpt_lw + nswgpts, nlwgpts ! Use my assertion routines to perform sanity checks use assertions, only: assert, assert_valid, assert_range @@ -187,9 +186,6 @@ module radiation ! Indices to pbuf fields integer :: cldfsnow_idx = 0 - ! These come from RRTMGP input data - integer :: nswgpts, nlwgpts - !============================================================================ contains @@ -487,10 +483,6 @@ subroutine radiation_init(state) ! Setup the RRTMGP interface call rrtmgp_initialize(size(active_gases), active_gases, rrtmgp_coefficients_file_sw, rrtmgp_coefficients_file_lw) - ! Set number of gpoints in sw and lw based on input data read above - nswgpts = get_ngpt_sw() - nlwgpts = get_ngpt_lw() - ! Set number of levels used in radiation calculations #ifdef NO_EXTRA_RAD_LEVEL nlev_rad = pver From 5c4b9c782f33eddc3a0bfef2daa8b8e71cb22817 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Wed, 2 Jun 2021 19:05:28 -0400 Subject: [PATCH 43/71] Fix RRTMGPXX build --- components/cmake/build_model.cmake | 37 ++++++++++++------- .../physics/rrtmgp/cpp/mo_garand_atmos_io.cpp | 2 +- .../src/physics/rrtmgp/cpp/simple_netcdf.hpp | 2 +- 3 files changed, 26 insertions(+), 15 deletions(-) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index b5a1bdfde823..122906716537 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -108,20 +108,31 @@ function(build_model COMP_CLASS COMP_NAME) # Add rrtmgp++ source code if asked for if (USE_RRTMGPXX) message(STATUS "Building RRTMGPXX") - # Build rrtmgpxx as a library - set(RRTMGPXX_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgpxx) - add_subdirectory( - ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp - ${RRTMGPXX_BIN}) - # Add files to the main E3SM build - set(SOURCES ${SOURCES} cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 - cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp - cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp - cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp - cmake/atm/../../eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp - cmake/atm/../../eam/src/physics/rrtmgp/external/cpp/extensions/fluxes_byband/mo_fluxes_byband_kernels.cpp - + # Build the static rrtmgpxx library + set(RRTMGPXX_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgp) + add_subdirectory(${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp ${RRTMGPXX_BIN}) + # Build the interface code + set(RRTMGPXX_INTERFACE_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgp_interface) + add_subdirectory(${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/cpp ${RRTMGPXX_INTERFACE_BIN}) + # Interface code needs some additional headers + include_directories( + ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp/extensions/fluxes_byband + ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp/extensions/cloud_optics + ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/cpp ) + # Add the source files for the interface code to the main E3SM build + set(RRTMGPXX_F90 cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90) + set(SOURCES ${SOURCES} ${RRTMGPXX_F90} ${RRTMGPXX_CXX}) + # Set fortran compiler flags + set_source_files_properties(${RRTMGPXX_F90} PROPERTIES COMPILE_FLAGS "${CPPDEFS} ${FFLAGS}") + # Set YAKL and CPP flags for C++ source files + set_source_files_properties(${RRTMGPXX_CXX} PROPERTIES COMPILE_FLAGS "${YAKL_CXX_FLAGS}") + if ("${ARCH}" STREQUAL "CUDA") + # Set C++ source files to be treated like CUDA files by CMake + set_source_files_properties(${RRTMGPXX_CXX} PROPERTIES LANGUAGE CUDA) + # Include Nvidia cub + include_directories(${YAKL_CUB_HOME}) + endif() endif() endif() diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp index 6762454d0961..20274e961993 100644 --- a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp @@ -1,6 +1,6 @@ #include "mo_garand_atmos_io.h" #include "simple_netcdf.hpp" -#include +#include "netcdf.h" // Read in the data, then use only the first column, and copy it to all of the model columns // In the end, all model columns will be identical diff --git a/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp b/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp index 05496adf8884..3db4b39992b1 100644 --- a/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp +++ b/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp @@ -1,4 +1,4 @@ -#include +#include "netcdf.h" #include "YAKL.h" using namespace yakl; From 7931a7fecd456484cff3741e7a66cad340940d16 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Fri, 13 Aug 2021 12:25:48 -0400 Subject: [PATCH 44/71] Add dim args for RRTMGPXX changes --- components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index 5e41ddc839f1..ceb54a43e115 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -182,7 +182,7 @@ extern "C" void rrtmgp_run_sw ( auto pmid_host = pmid.createHostCopy(); bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); real2d toa_flux("toa_flux", ncol, nswgpts); - k_dist_sw.gas_optics(top_at_1, pmid, pint, tmid, gas_concs, combined_optics, toa_flux); + k_dist_sw.gas_optics(ncol, nlay, top_at_1, pmid, pint, tmid, gas_concs, combined_optics, toa_flux); // Apply TOA flux scaling parallel_for(Bounds<2>(nswgpts,ncol), YAKL_LAMBDA (int igpt, int icol) { @@ -332,7 +332,7 @@ extern "C" void rrtmgp_run_lw ( t_sfc(icol) = tint(icol,nlay+1); } //k_dist_lw.gas_optics(top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), real2d()); - k_dist_lw.gas_optics(top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), tint); + k_dist_lw.gas_optics(ncol, nlay, top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), tint); // Add in aerosol; we can define this by bands or gpoints. If we define by // bands, then internally when increment() is called it will map these to From 1a4410790474d0e3f699c08f2ef4b434b6d3ef6f Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Thu, 26 Aug 2021 00:11:12 -0400 Subject: [PATCH 45/71] Need to explicitly copy fluxes for GPU --- .../physics/rrtmgp/cpp/rrtmgp_interface.cpp | 112 ++++++++++++------ 1 file changed, 75 insertions(+), 37 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index ceb54a43e115..bcc12aa582ec 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -130,6 +130,7 @@ extern "C" void rrtmgp_run_sw ( double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p, double *clrsky_bnd_flux_dn_dir_p, double tsi_scaling ) { + // Wrap pointers in YAKL arrays int nswbands = k_dist_sw.get_nband(); int nswgpts = k_dist_sw.get_ngpt(); @@ -163,6 +164,7 @@ extern "C" void rrtmgp_run_sw ( auto clrsky_bnd_flux_dn_dir = real3d("clrsky_bnd_flux_dn_dir", clrsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nswbands); + // Populate gas concentrations object GasConcs gas_concs; gas_concs.init(active_gases, ncol, nlay); @@ -212,18 +214,27 @@ extern "C" void rrtmgp_run_sw ( aerosol_optics.increment(combined_optics); // Do the clearsky calculation before adding in clouds - // TODO: we need band-by-band fluxes too FluxesByband fluxes_clrsky; - fluxes_clrsky.flux_up = clrsky_flux_up; - fluxes_clrsky.flux_dn = clrsky_flux_dn; - fluxes_clrsky.flux_dn_dir = clrsky_flux_dn_dir; - fluxes_clrsky.flux_net = clrsky_flux_net; - fluxes_clrsky.bnd_flux_up = clrsky_bnd_flux_up; - fluxes_clrsky.bnd_flux_dn = clrsky_bnd_flux_dn; - fluxes_clrsky.bnd_flux_dn_dir = clrsky_bnd_flux_dn_dir; - fluxes_clrsky.bnd_flux_net = clrsky_bnd_flux_net; + fluxes_clrsky.flux_up = real2d("clrsky_flux_up", ncol, nlay+1); // clrsky_flux_up; + fluxes_clrsky.flux_dn = real2d("clrsky_flux_up", ncol, nlay+1); //clrsky_flux_dn; + fluxes_clrsky.flux_dn_dir = real2d("clrsky_flux_up", ncol, nlay+1); //clrsky_flux_dn_dir; + fluxes_clrsky.flux_net = real2d("clrsky_flux_up", ncol, nlay+1); //clrsky_flux_net; + fluxes_clrsky.bnd_flux_up = real3d("clrsky_flux_up", ncol, nlay+1, nswbands); //clrsky_bnd_flux_up; + fluxes_clrsky.bnd_flux_dn = real3d("clrsky_flux_up", ncol, nlay+1, nswbands); //clrsky_bnd_flux_dn; + fluxes_clrsky.bnd_flux_dn_dir = real3d("clrsky_flux_up", ncol, nlay+1, nswbands); //clrsky_bnd_flux_dn_dir; + fluxes_clrsky.bnd_flux_net = real3d("clrsky_flux_up", ncol, nlay+1, nswbands); //clrsky_bnd_flux_net; rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_clrsky); + // Copy fluxes back out of FluxesByband object + fluxes_clrsky.flux_up.deep_copy_to(clrsky_flux_up); + fluxes_clrsky.flux_dn.deep_copy_to(clrsky_flux_dn); + fluxes_clrsky.flux_dn_dir.deep_copy_to(clrsky_flux_dn_dir); + fluxes_clrsky.flux_net.deep_copy_to(clrsky_flux_net); + fluxes_clrsky.bnd_flux_up.deep_copy_to(clrsky_bnd_flux_up); + fluxes_clrsky.bnd_flux_dn.deep_copy_to(clrsky_bnd_flux_dn); + fluxes_clrsky.bnd_flux_dn_dir.deep_copy_to(clrsky_bnd_flux_dn_dir); + fluxes_clrsky.bnd_flux_net.deep_copy_to(clrsky_bnd_flux_net); + // Add in clouds OpticalProps2str cloud_optics; cloud_optics.alloc_2str(ncol, nlay, k_dist_sw); @@ -237,15 +248,26 @@ extern "C" void rrtmgp_run_sw ( // Call SW flux driver FluxesByband fluxes_allsky; - fluxes_allsky.flux_up = allsky_flux_up; - fluxes_allsky.flux_dn = allsky_flux_dn; - fluxes_allsky.flux_dn_dir = allsky_flux_dn_dir; - fluxes_allsky.flux_net = allsky_flux_net; - fluxes_allsky.bnd_flux_up = allsky_bnd_flux_up; - fluxes_allsky.bnd_flux_dn = allsky_bnd_flux_dn; - fluxes_allsky.bnd_flux_dn_dir = allsky_bnd_flux_dn_dir; - fluxes_allsky.bnd_flux_net = allsky_bnd_flux_net; + fluxes_allsky.flux_up = real2d("allsky_flux_up", ncol, nlay+1); // allsky_flux_up; + fluxes_allsky.flux_dn = real2d("allsky_flux_up", ncol, nlay+1); //allsky_flux_dn; + fluxes_allsky.flux_dn_dir = real2d("allsky_flux_up", ncol, nlay+1); //allsky_flux_dn_dir; + fluxes_allsky.flux_net = real2d("allsky_flux_up", ncol, nlay+1); //allsky_flux_net; + fluxes_allsky.bnd_flux_up = real3d("allsky_flux_up", ncol, nlay+1, nswbands); //allsky_bnd_flux_up; + fluxes_allsky.bnd_flux_dn = real3d("allsky_flux_up", ncol, nlay+1, nswbands); //allsky_bnd_flux_dn; + fluxes_allsky.bnd_flux_dn_dir = real3d("allsky_flux_up", ncol, nlay+1, nswbands); //allsky_bnd_flux_dn_dir; + fluxes_allsky.bnd_flux_net = real3d("allsky_flux_up", ncol, nlay+1, nswbands); //allsky_bnd_flux_net; rte_sw(combined_optics, top_at_1, coszrs, toa_flux, albedo_dir, albedo_dif, fluxes_allsky); + + // Copy fluxes back out of FluxesByband object + fluxes_allsky.flux_up.deep_copy_to(allsky_flux_up); + fluxes_allsky.flux_dn.deep_copy_to(allsky_flux_dn); + fluxes_allsky.flux_dn_dir.deep_copy_to(allsky_flux_dn_dir); + fluxes_allsky.flux_net.deep_copy_to(allsky_flux_net); + fluxes_allsky.bnd_flux_up.deep_copy_to(allsky_bnd_flux_up); + fluxes_allsky.bnd_flux_dn.deep_copy_to(allsky_bnd_flux_dn); + fluxes_allsky.bnd_flux_dn_dir.deep_copy_to(allsky_bnd_flux_dn_dir); + fluxes_allsky.bnd_flux_net.deep_copy_to(allsky_bnd_flux_net); + } extern "C" void rrtmgp_run_lw ( @@ -259,6 +281,7 @@ extern "C" void rrtmgp_run_lw ( double *clrsky_flux_up_p , double *clrsky_flux_dn_p , double *clrsky_flux_net_p , double *clrsky_bnd_flux_up_p, double *clrsky_bnd_flux_dn_p, double *clrsky_bnd_flux_net_p ) { + // Wrap pointers in YAKL arrays int nlwbands = k_dist_lw.get_nband(); int nlwgpts = k_dist_lw.get_ngpt(); @@ -283,17 +306,16 @@ extern "C" void rrtmgp_run_lw ( auto clrsky_bnd_flux_dn = real3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); + // Populate gas concentrations GasConcs gas_concs; gas_concs.init(active_gases, ncol, nlay); real2d tmp2d; tmp2d = real2d("tmp", ncol, nlay); for (int igas = 1; igas <= ngas; igas++) { - for (int icol = 1; icol <= ncol; icol++) { - for (int ilay = 1; ilay <= nlay; ilay++) { - tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); - } - } + parallel_for(Bounds<2>(nlay,ncol), YAKL_LAMBDA(int ilay, int icol) { + tmp2d(icol,ilay) = gas_vmr(igas,icol,ilay); + }); gas_concs.set_vmr(active_gases(igas), tmp2d); } @@ -328,10 +350,9 @@ extern "C" void rrtmgp_run_lw ( auto pmid_host = pmid.createHostCopy(); bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); real1d t_sfc("t_sfc", ncol); - for (int icol=1; icol<=ncol; icol++) { + parallel_for(Bounds<1>(ncol), YAKL_LAMBDA (int icol) { t_sfc(icol) = tint(icol,nlay+1); - } - //k_dist_lw.gas_optics(top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), real2d()); + }); k_dist_lw.gas_optics(ncol, nlay, top_at_1, pmid, pint, tmid, t_sfc, gas_concs, combined_optics, lw_sources, real2d(), tint); // Add in aerosol; we can define this by bands or gpoints. If we define by @@ -354,14 +375,22 @@ extern "C" void rrtmgp_run_lw ( // Do the clearsky calculation before adding in clouds FluxesByband fluxes_clrsky; - fluxes_clrsky.flux_up = clrsky_flux_up; - fluxes_clrsky.flux_dn = clrsky_flux_dn; - fluxes_clrsky.flux_net = clrsky_flux_net; - fluxes_clrsky.bnd_flux_up = clrsky_bnd_flux_up; - fluxes_clrsky.bnd_flux_dn = clrsky_bnd_flux_dn; - fluxes_clrsky.bnd_flux_net = clrsky_bnd_flux_net; + fluxes_clrsky.flux_up = real2d("clrsky_flux_up", ncol, nlay+1); // clrsky_flux_up; + fluxes_clrsky.flux_dn = real2d("clrsky_flux_up", ncol, nlay+1); //clrsky_flux_dn; + fluxes_clrsky.flux_net = real2d("clrsky_flux_up", ncol, nlay+1); //clrsky_flux_net; + fluxes_clrsky.bnd_flux_up = real3d("clrsky_flux_up", ncol, nlay+1, nlwbands); //clrsky_bnd_flux_up; + fluxes_clrsky.bnd_flux_dn = real3d("clrsky_flux_up", ncol, nlay+1, nlwbands); //clrsky_bnd_flux_dn; + fluxes_clrsky.bnd_flux_net = real3d("clrsky_flux_up", ncol, nlay+1, nlwbands); //clrsky_bnd_flux_net; rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_clrsky); + // Copy fluxes back out of FluxesByband object + fluxes_clrsky.flux_up.deep_copy_to(clrsky_flux_up); + fluxes_clrsky.flux_dn.deep_copy_to(clrsky_flux_dn); + fluxes_clrsky.flux_net.deep_copy_to(clrsky_flux_net); + fluxes_clrsky.bnd_flux_up.deep_copy_to(clrsky_bnd_flux_up); + fluxes_clrsky.bnd_flux_dn.deep_copy_to(clrsky_bnd_flux_dn); + fluxes_clrsky.bnd_flux_net.deep_copy_to(clrsky_bnd_flux_net); + // Add in clouds OpticalProps1scl cloud_optics; cloud_optics.alloc_1scl(ncol, nlay, k_dist_lw); @@ -372,11 +401,20 @@ extern "C" void rrtmgp_run_lw ( // Call LW flux driver FluxesByband fluxes_allsky; - fluxes_allsky.flux_up = allsky_flux_up; - fluxes_allsky.flux_dn = allsky_flux_dn; - fluxes_allsky.flux_net = allsky_flux_net; - fluxes_allsky.bnd_flux_up = allsky_bnd_flux_up; - fluxes_allsky.bnd_flux_dn = allsky_bnd_flux_dn; - fluxes_allsky.bnd_flux_net = allsky_bnd_flux_net; + fluxes_allsky.flux_up = real2d("flux_up", ncol, nlay+1); //allsky_flux_up; + fluxes_allsky.flux_dn = real2d("flux_dn", ncol, nlay+1); //allsky_flux_dn; + fluxes_allsky.flux_net = real2d("flux_net", ncol, nlay+1); //allsky_flux_net; + fluxes_allsky.bnd_flux_up = real3d("flux_up", ncol, nlay+1, nlwbands); //allsky_bnd_flux_up; + fluxes_allsky.bnd_flux_dn = real3d("flux_dn", ncol, nlay+1, nlwbands); //allsky_bnd_flux_dn; + fluxes_allsky.bnd_flux_net = real3d("flux_net", ncol, nlay+1, nlwbands); //allsky_bnd_flux_net; rte_lw(max_gauss_pts, gauss_Ds, gauss_wts, combined_optics, top_at_1, lw_sources, emis_sfc, fluxes_allsky); + + // Copy fluxes back out of FluxesByband object + fluxes_allsky.flux_up.deep_copy_to(allsky_flux_up); + fluxes_allsky.flux_dn.deep_copy_to(allsky_flux_dn); + fluxes_allsky.flux_net.deep_copy_to(allsky_flux_net); + fluxes_allsky.bnd_flux_up.deep_copy_to(allsky_bnd_flux_up); + fluxes_allsky.bnd_flux_dn.deep_copy_to(allsky_bnd_flux_dn); + fluxes_allsky.bnd_flux_net.deep_copy_to(allsky_bnd_flux_net); + } From df9c3ce17b97334372207ee14a0795efda39a7a1 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Thu, 26 Aug 2021 00:12:16 -0400 Subject: [PATCH 46/71] Fix cmake build for RRTMGPXX --- components/cmake/build_model.cmake | 14 +----- components/eam/bld/configure | 14 +++--- .../eam/src/physics/rrtmgp/cpp/CMakeLists.txt | 45 +++++++++++++++++++ 3 files changed, 54 insertions(+), 19 deletions(-) create mode 100644 components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 122906716537..990d4ade72cc 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -122,17 +122,7 @@ function(build_model COMP_CLASS COMP_NAME) ) # Add the source files for the interface code to the main E3SM build set(RRTMGPXX_F90 cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90) - set(SOURCES ${SOURCES} ${RRTMGPXX_F90} ${RRTMGPXX_CXX}) - # Set fortran compiler flags - set_source_files_properties(${RRTMGPXX_F90} PROPERTIES COMPILE_FLAGS "${CPPDEFS} ${FFLAGS}") - # Set YAKL and CPP flags for C++ source files - set_source_files_properties(${RRTMGPXX_CXX} PROPERTIES COMPILE_FLAGS "${YAKL_CXX_FLAGS}") - if ("${ARCH}" STREQUAL "CUDA") - # Set C++ source files to be treated like CUDA files by CMake - set_source_files_properties(${RRTMGPXX_CXX} PROPERTIES LANGUAGE CUDA) - # Include Nvidia cub - include_directories(${YAKL_CUB_HOME}) - endif() + set(SOURCES ${SOURCES} ${RRTMGPXX_F90}) endif() endif() @@ -278,7 +268,7 @@ function(build_model COMP_CLASS COMP_NAME) target_link_libraries(${TARGET_NAME} PRIVATE samxx) endif() if (USE_RRTMGPXX) - target_link_libraries(${TARGET_NAME} PRIVATE rrtmgp) + target_link_libraries(${TARGET_NAME} PRIVATE rrtmgp rrtmgp_interface) endif() endif() if (USE_KOKKOS) diff --git a/components/eam/bld/configure b/components/eam/bld/configure index 2236686ace89..16c6e0a58b9d 100755 --- a/components/eam/bld/configure +++ b/components/eam/bld/configure @@ -2610,14 +2610,14 @@ sub write_filepath print $fh "$camsrcdir/eam/src/physics/rrtmg/ext/rrtmg_sw\n"; } elsif ($rad eq 'rrtmgp') { print $fh "$camsrcdir/eam/src/physics/rrtmgp\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rte\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rte/kernels\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rrtmgp\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rrtmgp/kernels\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions/rng\n"; - print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/examples\n"; if (not defined $opts{'rrtmgpxx'} ) { + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rte\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rte/kernels\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rrtmgp\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/rrtmgp/kernels\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/extensions/rng\n"; + print $fh "$camsrcdir/eam/src/physics/rrtmgp/external/examples\n"; print $fh "$camsrcdir/eam/src/physics/rrtmgp/f90\n"; } } diff --git a/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt new file mode 100644 index 000000000000..9cdaaf89683a --- /dev/null +++ b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt @@ -0,0 +1,45 @@ +set (F90_SRC rrtmgp_interface.F90) +set (CXX_SRC + mo_garand_atmos_io.cpp + mo_load_cloud_coefficients.cpp + mo_load_coefficients.cpp + rrtmgp_interface.cpp + ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/fluxes_byband/mo_fluxes_byband_kernels.cpp +) +set (RRTMGPXX_HEADERS + simple_netcdf.hpp + mo_garand_atmos_io.h + mo_load_cloud_coefficients.h + mo_load_coefficients.h +) + +# Set compile flags for cxx source +if ("${YAKL_ARCH}" STREQUAL "CUDA") + message(STATUS "rrtmgp_interface flags: ${YAKL_CUDA_FLAGS}") + set_source_files_properties(${CXX_SRC} PROPERTIES LANGUAGE CUDA) + set_source_files_properties(${CXX_SRC} PROPERTIES COMPILE_FLAGS "-DYAKL_ARCH_CUDA --expt-extended-lambda --expt-relaxed-constexpr ${YAKL_CUDA_FLAGS}") +else () + message(STATUS "rrtmgp_interface flags: ${YAKL_CXX_FLAGS}") + set_source_files_properties(${CXX_SRC} PROPERTIES COMPILE_FLAGS "${YAKL_CXX_FLAGS}") +endif () + +# Add library for interface code +add_library(rrtmgp_interface STATIC ${CXX_SRC}) + +# Libraries to link +#find_library(NETCDF_C netcdf HINTS ${NetCDF_C_PATHS}/lib) +find_library( + NETCDF_C_LIBRARY NAMES netcdf libnetcdf + HINTS ${LIB_NETCDF} ${LIB_NETCDF_C} +) +target_link_libraries(rrtmgp_interface ${NETCDF_C_LIBRARY} rrtmgp yakl) + +# Where to find includes +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/rte) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/rrtmgp) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/cloud_optics) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/fluxes_byband) + +# Set fortran compiler flags +set_source_files_properties(${F90_SRC} PROPERTIES COMPILE_FLAGS "${CPPDEFS} ${FFLAGS}") From 4b8f3aa0809d4e6deccf3f769fa63fbb958230fe Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Fri, 27 Aug 2021 15:47:37 -0400 Subject: [PATCH 47/71] Fixes for new YAKL updates --- .../eam/src/physics/crm/samxx/accelerate_crm.cpp | 4 ++-- .../eam/src/physics/crm/samxx/advect2_mom_z.cpp | 4 ++-- .../eam/src/physics/crm/samxx/advect_scalar.cpp | 6 +++--- .../eam/src/physics/crm/samxx/advect_scalar2D.cpp | 12 ++++++------ .../eam/src/physics/crm/samxx/advect_scalar3D.cpp | 12 ++++++------ .../src/physics/crm/samxx/crm_variance_transport.cpp | 4 ++-- components/eam/src/physics/crm/samxx/crmsurface.cpp | 2 +- components/eam/src/physics/crm/samxx/damping.cpp | 4 ++-- components/eam/src/physics/crm/samxx/diagnose.cpp | 4 ++-- .../eam/src/physics/crm/samxx/diffuse_mom2D.cpp | 4 ++-- .../eam/src/physics/crm/samxx/diffuse_mom3D.cpp | 4 ++-- .../eam/src/physics/crm/samxx/diffuse_scalar.cpp | 6 +++--- .../eam/src/physics/crm/samxx/diffuse_scalar2D.cpp | 6 +++--- .../eam/src/physics/crm/samxx/diffuse_scalar3D.cpp | 6 +++--- components/eam/src/physics/crm/samxx/forcing.cpp | 2 +- components/eam/src/physics/crm/samxx/ice_fall.cpp | 4 ++-- components/eam/src/physics/crm/samxx/kurant.cpp | 2 +- .../eam/src/physics/crm/samxx/microphysics.cpp | 2 +- components/eam/src/physics/crm/samxx/post_icycle.cpp | 8 ++++---- .../eam/src/physics/crm/samxx/post_timeloop.cpp | 8 ++++---- .../eam/src/physics/crm/samxx/pre_timeloop.cpp | 2 +- components/eam/src/physics/crm/samxx/precip_proc.cpp | 2 +- components/eam/src/physics/crm/samxx/sgs.cpp | 2 +- .../src/physics/crm/samxx/test/cpp2d/CMakeLists.txt | 4 ++-- .../src/physics/crm/samxx/test/cpp3d/CMakeLists.txt | 4 ++-- components/eam/src/physics/crm/samxx/tke_full.cpp | 2 +- .../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp | 2 +- 27 files changed, 61 insertions(+), 61 deletions(-) diff --git a/components/eam/src/physics/crm/samxx/accelerate_crm.cpp b/components/eam/src/physics/crm/samxx/accelerate_crm.cpp index a5845acd952a..a8eccf6fc383 100644 --- a/components/eam/src/physics/crm/samxx/accelerate_crm.cpp +++ b/components/eam/src/physics/crm/samxx/accelerate_crm.cpp @@ -52,7 +52,7 @@ void accelerate_crm(int nstep, int nstop, bool &ceaseflag) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { // calculate tendency * dtn yakl::atomicAdd( tbaccel(k,icrm) , t(k,j+offy_s,i+offx_s,icrm) * crm_accel_coef ); yakl::atomicAdd( qtbaccel(k,icrm) , (qcl(k,j,i,icrm) + qci(k,j,i,icrm) + qv(k,j,i,icrm)) * crm_accel_coef ); @@ -144,7 +144,7 @@ void accelerate_crm(int nstep, int nstop, bool &ceaseflag) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (micro_field(idx_qt,k,j+offy_s,i+offx_s,icrm) < 0.0) { yakl::atomicAdd( qneg(k,icrm) , micro_field(idx_qt,k,j+offy_s,i+offx_s,icrm) ); } diff --git a/components/eam/src/physics/crm/samxx/advect2_mom_z.cpp b/components/eam/src/physics/crm/samxx/advect2_mom_z.cpp index f0610bb1e1c5..11c712253142 100644 --- a/components/eam/src/physics/crm/samxx/advect2_mom_z.cpp +++ b/components/eam/src/physics/crm/samxx/advect2_mom_z.cpp @@ -48,7 +48,7 @@ void advect2_mom_z() { // for (int j=0; j(nzm-1,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm-1,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real dz25=1.0/(4.0*dz(icrm)); int kb = k-1; real rhoi = dz25 * rhow(k+1,icrm); @@ -66,7 +66,7 @@ void advect2_mom_z() { // for (int j=0; j(nzm-1,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm-1,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real dz25=1.0/(4.0*dz(icrm)); int kb = k-1; real rhoi = dz25 * rhow(k+1,icrm); diff --git a/components/eam/src/physics/crm/samxx/advect_scalar.cpp b/components/eam/src/physics/crm/samxx/advect_scalar.cpp index 7780d8325c04..66f94a848fb5 100644 --- a/components/eam/src/physics/crm/samxx/advect_scalar.cpp +++ b/components/eam/src/physics/crm/samxx/advect_scalar.cpp @@ -39,7 +39,7 @@ void advect_scalar(real4d &f, real2d &fadv, real2d &flux) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(k,j+offy_s,i+offx_s,icrm)-f0(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fadv(k,icrm),tmp); }); @@ -87,7 +87,7 @@ void advect_scalar(real5d &f, int ind_f, real2d &fadv, real2d &flux) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(ind_f,k,j+offy_s,i+offx_s,icrm)-f0(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fadv(k,icrm),tmp); }); @@ -134,7 +134,7 @@ void advect_scalar(real5d &f, int ind_f, real3d &fadv, int ind_fadv, real3d &flu // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(ind_f,k,j+offy_s,i+offx_s,icrm)-f0(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fadv(ind_fadv,k,icrm),tmp); }); diff --git a/components/eam/src/physics/crm/samxx/advect_scalar2D.cpp b/components/eam/src/physics/crm/samxx/advect_scalar2D.cpp index 9cf19ed8daf2..1d529b9b67e6 100644 --- a/components/eam/src/physics/crm/samxx/advect_scalar2D.cpp +++ b/components/eam/src/physics/crm/samxx/advect_scalar2D.cpp @@ -94,7 +94,7 @@ void advect_scalar2D(real4d &f, real2d &flux) { // for (int k=0; k(nzm,nx+4,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (i >= 2 && i <= nx+1) { yakl::atomicAdd(flux(k,icrm),www(k,j,i,icrm)); } @@ -163,7 +163,7 @@ void advect_scalar2D(real4d &f, real2d &flux) { // for (int k=0; k(nzm,nx+1,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { int ib=i-1; uuu(k,j,i+offx_uuu,icrm) = pp2(uuu(k,j,i+offx_uuu,icrm))*min(1.0,min(mx(k,j,i+offx_m,icrm), mn(k,j,ib+offx_m,icrm))) - @@ -290,7 +290,7 @@ void advect_scalar2D(real5d &f, int ind_f, real2d &flux) { // for (int k=0; k(nzm,nx+4,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (i >= 2 && i <= nx+1) { yakl::atomicAdd(flux(k,icrm),www(k,j,i,icrm)); } @@ -362,7 +362,7 @@ void advect_scalar2D(real5d &f, int ind_f, real2d &flux) { // for (int k=0; k(nzm,nx+1,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { int ib=i-1; uuu(k,j,i+offx_uuu,icrm)= pp2(uuu(k,j,i+offx_uuu,icrm))*min(1.0,min(mx(k,j,i+offx_m,icrm), mn(k,j,ib+offx_m,icrm))) - pn2(uuu(k,j,i+offx_uuu,icrm))*min(1.0,min(mx(k,j,ib+offx_m,icrm),mn(k,j,i+offx_m,icrm))); @@ -486,7 +486,7 @@ void advect_scalar2D(real5d &f, int ind_f, real3d &flux, int ind_flux) { // for (int k=0; k(nzm,nx+4,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (i >= 2 && i <= nx+1) { yakl::atomicAdd(flux(ind_flux,k,icrm),www(k,j,i,icrm)); } @@ -557,7 +557,7 @@ void advect_scalar2D(real5d &f, int ind_f, real3d &flux, int ind_flux) { // for (int k=0; k(nzm,nx+1,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { int ib=i-1; uuu(k,j,i+offx_uuu,icrm)= pp2(uuu(k,j,i+offx_uuu,icrm))*min(1.0,min(mx(k,j,i+offx_m,icrm), mn(k,j,ib+offx_m,icrm))) - pn2(uuu(k,j,i+offx_uuu,icrm))*min(1.0,min(mx(k,j,ib+offx_m,icrm),mn(k,j,i+offx_m,icrm))); diff --git a/components/eam/src/physics/crm/samxx/advect_scalar3D.cpp b/components/eam/src/physics/crm/samxx/advect_scalar3D.cpp index 026d73d100cc..9e7b62403041 100644 --- a/components/eam/src/physics/crm/samxx/advect_scalar3D.cpp +++ b/components/eam/src/physics/crm/samxx/advect_scalar3D.cpp @@ -142,7 +142,7 @@ void advect_scalar3D(real4d &f, real2d &flux) { // for (int j=0; j(nzm,ny+4,nx+4,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+4,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (i >= 2 && i <= nx+1 && j >= 2 && j <= ny+1) { yakl::atomicAdd(flux(k,icrm),www(k,j,i,icrm)); } @@ -256,7 +256,7 @@ void advect_scalar3D(real4d &f, real2d &flux) { // for (int j=0; j(nzm,ny+1,nx+1,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+1,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (j <= ny-1) { int ib=i-1; uuu(k,j+offy_uuu,i+offx_uuu,icrm) = @@ -439,7 +439,7 @@ void advect_scalar3D(real5d &f, int ind_f, real2d &flux) { // for (int j=0; j(nzm,ny+4,nx+4,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+4,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (i >= 2 && i <= nx+1 && j >= 2 && j <= ny+1) { yakl::atomicAdd(flux(k,icrm),www(k,j,i,icrm)); } @@ -553,7 +553,7 @@ void advect_scalar3D(real5d &f, int ind_f, real2d &flux) { // for (int j=0; j(nzm,ny+1,nx+1,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+1,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (j <= ny-1) { int ib=i-1; uuu(k,j+offy_uuu,i+offx_uuu,icrm) = @@ -738,7 +738,7 @@ void advect_scalar3D(real5d &f, int ind_f, real3d &flux, int ind_flux) { // for (int j=0; j(nzm,ny+4,nx+4,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+4,nx+4,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (i >= 2 && i <= nx+1 && j >= 2 && j <= ny+1) { yakl::atomicAdd(flux(ind_flux,k,icrm),www(k,j,i,icrm)); } @@ -879,7 +879,7 @@ void advect_scalar3D(real5d &f, int ind_f, real3d &flux, int ind_flux) { // for (int j=0; j(nzm,ny+1,nx+1,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny+1,nx+1,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (j <= ny-1) { int ib=i-1; uuu(k,j+offy_uuu,i+offx_uuu,icrm) = diff --git a/components/eam/src/physics/crm/samxx/crm_variance_transport.cpp b/components/eam/src/physics/crm/samxx/crm_variance_transport.cpp index 237173d7a77a..b80727adfb31 100644 --- a/components/eam/src/physics/crm/samxx/crm_variance_transport.cpp +++ b/components/eam/src/physics/crm/samxx/crm_variance_transport.cpp @@ -129,7 +129,7 @@ void VT_diagnose() { // do j = 1,ny // do i = 1,nx // do icrm = 1,ncrms - parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { yakl::atomicAdd( t_mean(k,icrm) , t(k,j+offy_s,i+offx_s,icrm) ); yakl::atomicAdd( q_mean(k,icrm) , qv(k,j,i,icrm) + qcl(k,j,i,icrm) + qci(k,j,i,icrm) ); }); @@ -185,7 +185,7 @@ void VT_diagnose() { // do j = 1,ny // do i = 1,nx // do icrm = 1,ncrms - parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { yakl::atomicAdd( t_vt(k,icrm) , t_vt_pert(k,j,i,icrm) * t_vt_pert(k,j,i,icrm) ); yakl::atomicAdd( q_vt(k,icrm) , q_vt_pert(k,j,i,icrm) * q_vt_pert(k,j,i,icrm) ); }); diff --git a/components/eam/src/physics/crm/samxx/crmsurface.cpp b/components/eam/src/physics/crm/samxx/crmsurface.cpp index 2d45ea8c68b6..c31f92f2c39b 100644 --- a/components/eam/src/physics/crm/samxx/crmsurface.cpp +++ b/components/eam/src/physics/crm/samxx/crmsurface.cpp @@ -30,7 +30,7 @@ void crmsurface(real1d &bflx) { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { real tmp2 = (0.5*(u(0,j+offy_u,i+1+offx_u,icrm)+u(0,j+offy_u,i+offx_u,icrm))+ug); real tmp3 = (0.5*(v(0,j+YES3D+offy_v,i+offx_v,icrm)+v(0,j+offy_v,i+offx_v,icrm))+vg); real u_h0 = max(1.0,sqrt(tmp2*tmp2+tmp3*tmp3)); diff --git a/components/eam/src/physics/crm/samxx/damping.cpp b/components/eam/src/physics/crm/samxx/damping.cpp index 59366472f291..2e3264c9b9c2 100644 --- a/components/eam/src/physics/crm/samxx/damping.cpp +++ b/components/eam/src/physics/crm/samxx/damping.cpp @@ -39,7 +39,7 @@ void damping() { }); // for (int icrm=0; icrm(nzm,ncrms) , YAKL_LAMBDA (int k, int icrm) { + parallel_for( SimpleBounds<2>(nzm,ncrms) , YAKL_DEVICE_LAMBDA (int k, int icrm) { if(z(nzm-1,icrm)-z(k,icrm) < fractional_damp_depth*z(nzm-1,icrm)) { do_damping(k,icrm)=1; } else { @@ -75,7 +75,7 @@ void damping() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp; tmp = u(k,offy_u+j,offx_u+i,icrm)/( (real) nx * (real) ny ); diff --git a/components/eam/src/physics/crm/samxx/diagnose.cpp b/components/eam/src/physics/crm/samxx/diagnose.cpp index 2d0fed49e6f4..e780c6d795ce 100644 --- a/components/eam/src/physics/crm/samxx/diagnose.cpp +++ b/components/eam/src/physics/crm/samxx/diagnose.cpp @@ -61,7 +61,7 @@ void diagnose() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real coef1 = rho(k,icrm)*dz(icrm)*adz(k,icrm)*dtfactor; tabs(k,j,i,icrm) = t(k,j+offy_s,i+offx_s,icrm)-gamaz(k,icrm)+ fac_cond * (qcl(k,j,i,icrm)+qpl(k,j,i,icrm)) + fac_sub *(qci(k,j,i,icrm) + qpi(k,j,i,icrm)); @@ -115,7 +115,7 @@ void diagnose() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real coef1 = rho(k,icrm)*dz(icrm)*adz(k,icrm)*dtfactor; // Saturated water vapor path with respect to water. Can be used // with water vapor path (= pw) to compute column-average diff --git a/components/eam/src/physics/crm/samxx/diffuse_mom2D.cpp b/components/eam/src/physics/crm/samxx/diffuse_mom2D.cpp index e5db51be1448..5513eed38474 100644 --- a/components/eam/src/physics/crm/samxx/diffuse_mom2D.cpp +++ b/components/eam/src/physics/crm/samxx/diffuse_mom2D.cpp @@ -76,7 +76,7 @@ void diffuse_mom2D(real5d &tk) { // for (int k=0; k(nzm-1,nx,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm-1,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { int kc=k+1; real rdz=1.0/dz(icrm); real rdz2 = rdz*rdz * grdf_z(k,icrm); @@ -99,7 +99,7 @@ void diffuse_mom2D(real5d &tk) { // for (int i=0; i(nx,ncrms) , YAKL_LAMBDA (int i, int icrm) { + parallel_for( SimpleBounds<2>(nx,ncrms) , YAKL_DEVICE_LAMBDA (int i, int icrm) { real rdz=1.0/dz(icrm); real rdz2 = rdz*rdz * grdf_z(nzm-2,icrm); real tkz=rdz2*grdf_z(nzm-1,icrm)*tk(0,nzm-1,j+offy_d,i+offx_d,icrm); diff --git a/components/eam/src/physics/crm/samxx/diffuse_mom3D.cpp b/components/eam/src/physics/crm/samxx/diffuse_mom3D.cpp index b31a20456842..a31d7cda4368 100644 --- a/components/eam/src/physics/crm/samxx/diffuse_mom3D.cpp +++ b/components/eam/src/physics/crm/samxx/diffuse_mom3D.cpp @@ -121,7 +121,7 @@ void diffuse_mom3D(real5d &tk) { // for (int j=0; j(nzm-1,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm-1,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { int jb=j-1; int kc=k+1; int ib=i-1; @@ -149,7 +149,7 @@ void diffuse_mom3D(real5d &tk) { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { real rdz=1.0/dz(icrm); real rdz2 = rdz*rdz * grdf_z(nzm-2,icrm); real tkz=rdz2*grdf_z(nzm-1,icrm)*tk(0,nzm-1,j+offy_d,i+offx_d,icrm); diff --git a/components/eam/src/physics/crm/samxx/diffuse_scalar.cpp b/components/eam/src/physics/crm/samxx/diffuse_scalar.cpp index 891e00fd17a9..bd9595824e30 100644 --- a/components/eam/src/physics/crm/samxx/diffuse_scalar.cpp +++ b/components/eam/src/physics/crm/samxx/diffuse_scalar.cpp @@ -29,7 +29,7 @@ void diffuse_scalar(real5d &tkh, int ind_tkh, real4d &f, real3d &fluxb, real3d & // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(k,j+offy_s,i+offx_s,icrm)-df(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fdiff(k,icrm),tmp); }); @@ -64,7 +64,7 @@ void diffuse_scalar(real5d &tkh, int ind_tkh, real5d &f, int ind_f, real3d &flux // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(ind_f,k,j+offy_s,i+offx_s,icrm)-df(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fdiff(k,icrm),tmp); }); @@ -99,7 +99,7 @@ void diffuse_scalar(real5d &tkh, int ind_tkh, real5d &f, int ind_f, real4d &flux // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp = f(ind_f,k,j+offy_s,i+offx_s,icrm)-df(k,j+offy_s,i+offx_s,icrm); yakl::atomicAdd(fdiff(ind_fdiff,k,icrm),tmp); }); diff --git a/components/eam/src/physics/crm/samxx/diffuse_scalar2D.cpp b/components/eam/src/physics/crm/samxx/diffuse_scalar2D.cpp index 7392a9c04f7e..e6bf0eb74da6 100644 --- a/components/eam/src/physics/crm/samxx/diffuse_scalar2D.cpp +++ b/components/eam/src/physics/crm/samxx/diffuse_scalar2D.cpp @@ -59,7 +59,7 @@ void diffuse_scalar2D(real4d &field, real3d &fluxb, real3d &fluxt, real5d &tkh, // for (int k=0; k(nzm,nx,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); @@ -148,7 +148,7 @@ void diffuse_scalar2D(real5d &field, int ind_field, real3d &fluxb, real3d &fluxt // for (int k=0; k(nzm,nx,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); @@ -237,7 +237,7 @@ void diffuse_scalar2D(real5d &field, int ind_field, real4d &fluxb, int ind_fluxb // for (int k=0; k(nzm,nx,ncrms) , YAKL_LAMBDA (int k, int i, int icrm) { + parallel_for( SimpleBounds<3>(nzm,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); diff --git a/components/eam/src/physics/crm/samxx/diffuse_scalar3D.cpp b/components/eam/src/physics/crm/samxx/diffuse_scalar3D.cpp index a6e8b0bc7721..42a656bffada 100644 --- a/components/eam/src/physics/crm/samxx/diffuse_scalar3D.cpp +++ b/components/eam/src/physics/crm/samxx/diffuse_scalar3D.cpp @@ -82,7 +82,7 @@ void diffuse_scalar3D(real4d &field, real3d &fluxb, real3d &fluxt, real5d &tkh, // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); @@ -200,7 +200,7 @@ void diffuse_scalar3D(real5d &field, int ind_field, real3d &fluxb, real3d &fluxt // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); @@ -318,7 +318,7 @@ void diffuse_scalar3D(real5d &field, int ind_field, real4d &fluxb, int ind_fluxb // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if (k <= nzm-2) { int kc=k+1; real rhoi = rhow(kc,icrm)/adzw(kc,icrm); diff --git a/components/eam/src/physics/crm/samxx/forcing.cpp b/components/eam/src/physics/crm/samxx/forcing.cpp index 2373b4b4962c..589522a9c5c8 100644 --- a/components/eam/src/physics/crm/samxx/forcing.cpp +++ b/components/eam/src/physics/crm/samxx/forcing.cpp @@ -29,7 +29,7 @@ void forcing() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { t(k, j+offy_s, i+offx_s, icrm) = t(k, j+offy_s, i+offx_s, icrm) + ttend(k,icrm) * dtn; micro_field(index_water_vapor, k, j+offy_s, i+offx_s, icrm) = micro_field(index_water_vapor, k, j+offy_s, i+offx_s, icrm) + qtend(k,icrm) * dtn; diff --git a/components/eam/src/physics/crm/samxx/ice_fall.cpp b/components/eam/src/physics/crm/samxx/ice_fall.cpp index 70700524f7f1..796bfe00394e 100644 --- a/components/eam/src/physics/crm/samxx/ice_fall.cpp +++ b/components/eam/src/physics/crm/samxx/ice_fall.cpp @@ -30,7 +30,7 @@ void ice_fall() { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { for(int k=0; k < nzm; k++) { if(qcl(k,j,i,icrm)+qci(k,j,i,icrm) > 0.0 && tabs(k,j,i,icrm) < 273.15) { yakl::atomicMin(kmin(icrm),k); @@ -113,7 +113,7 @@ void ice_fall() { // for (int j=0; j(nz,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nz,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { if ( k >= max(0,kmin(icrm)-2) && k <= kmax(icrm) ) { real coef = dtn/(dz(icrm)*adz(k,icrm)*rho(k,icrm)); // The cloud ice increment is the difference of the fluxes. diff --git a/components/eam/src/physics/crm/samxx/kurant.cpp b/components/eam/src/physics/crm/samxx/kurant.cpp index a3b2ccea99b2..90b6a457aab3 100644 --- a/components/eam/src/physics/crm/samxx/kurant.cpp +++ b/components/eam/src/physics/crm/samxx/kurant.cpp @@ -30,7 +30,7 @@ void kurant () { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real tmp; tmp = fabs(w(k,j+offy_w,i+offx_w,icrm)); yakl::atomicMax(wm(k,icrm),tmp); diff --git a/components/eam/src/physics/crm/samxx/microphysics.cpp b/components/eam/src/physics/crm/samxx/microphysics.cpp index 8a68fda2fd46..d0e70671b3e8 100644 --- a/components/eam/src/physics/crm/samxx/microphysics.cpp +++ b/components/eam/src/physics/crm/samxx/microphysics.cpp @@ -200,7 +200,7 @@ void precip_fall(int hydro_type, real4d &omega) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { int kc=k+1; // Update precipitation mass fraction. // Note that fz is the total flux, including both the diff --git a/components/eam/src/physics/crm/samxx/post_icycle.cpp b/components/eam/src/physics/crm/samxx/post_icycle.cpp index a67575821efa..01549008ba07 100644 --- a/components/eam/src/physics/crm/samxx/post_icycle.cpp +++ b/components/eam/src/physics/crm/samxx/post_icycle.cpp @@ -64,7 +64,7 @@ void post_icycle() { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { for (int k=0; k(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { // Reduced radiation method allows for fewer radiation calculations // by collecting statistics and doing radiation over column groups int i_rad = i / (nx/crm_nx_rad); @@ -149,7 +149,7 @@ void post_icycle() { // for (int i=0; i(nzm+1,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm+1,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { int l=plev+1-(k+1); int kx; real qsat; @@ -177,7 +177,7 @@ void post_icycle() { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { if(cwp(j,i,icrm) > cwp_threshold) { yakl::atomicAdd(crm_output_cltot(icrm) , cttemp(j,i,icrm)); } diff --git a/components/eam/src/physics/crm/samxx/post_timeloop.cpp b/components/eam/src/physics/crm/samxx/post_timeloop.cpp index c41f0f86a51e..8bca651c2470 100644 --- a/components/eam/src/physics/crm/samxx/post_timeloop.cpp +++ b/components/eam/src/physics/crm/samxx/post_timeloop.cpp @@ -252,7 +252,7 @@ void post_timeloop() { // for (int i=0; i(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { int l = plev-(k+1); real tmp = (qpl(k,j,i,icrm)+qpi(k,j,i,icrm))*crm_input_pdel(l,icrm); @@ -384,7 +384,7 @@ void post_timeloop() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { int l = plev-(k+1); yakl::atomicAdd(crm_output_qc_mean(l,icrm) , qcl(k,j,i,icrm)); yakl::atomicAdd(crm_output_qi_mean(l,icrm) , qci(k,j,i,icrm)); @@ -430,7 +430,7 @@ void post_timeloop() { // for (int j=0; j(ny,nx,ncrms) , YAKL_LAMBDA (int j, int i, int icrm) { + parallel_for( SimpleBounds<3>(ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int j, int i, int icrm) { precsfc(j,i,icrm) = precsfc(j,i,icrm)*dz(icrm)/dt/((real) nstop); precssfc(j,i,icrm) = precssfc(j,i,icrm)*dz(icrm)/dt/((real) nstop); if (precsfc(j,i,icrm) > 10.0/86400.0) { @@ -467,7 +467,7 @@ void post_timeloop() { // for (int k=0; k(plev,ncrms) , YAKL_LAMBDA (int k, int icrm) { + parallel_for( SimpleBounds<2>(plev,ncrms) , YAKL_DEVICE_LAMBDA (int k, int icrm) { crm_output_mu_crm(k,icrm)=0.5*(mui_crm(k,icrm)+mui_crm(k+1,icrm)); crm_output_md_crm(k,icrm)=0.5*(mdi_crm(k,icrm)+mdi_crm(k+1,icrm)); crm_output_mu_crm(k,icrm)=crm_output_mu_crm(k,icrm)*ggr/100.0; //kg/m2/s --> mb/s diff --git a/components/eam/src/physics/crm/samxx/pre_timeloop.cpp b/components/eam/src/physics/crm/samxx/pre_timeloop.cpp index 8455b8bdfc38..026a2f345acf 100644 --- a/components/eam/src/physics/crm/samxx/pre_timeloop.cpp +++ b/components/eam/src/physics/crm/samxx/pre_timeloop.cpp @@ -349,7 +349,7 @@ void pre_timeloop() { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { t(k,j+offy_s,i+offx_s,icrm) = tabs(k,j,i,icrm)+gamaz(k,icrm)-fac_cond*qcl(k,j,i,icrm)-fac_sub*qci(k,j,i,icrm) - fac_cond*qpl(k,j,i,icrm)-fac_sub*qpi(k,j,i,icrm); diff --git a/components/eam/src/physics/crm/samxx/precip_proc.cpp b/components/eam/src/physics/crm/samxx/precip_proc.cpp index 3bcbecd9f4dc..7ac0082b1815 100644 --- a/components/eam/src/physics/crm/samxx/precip_proc.cpp +++ b/components/eam/src/physics/crm/samxx/precip_proc.cpp @@ -43,7 +43,7 @@ void precip_proc(real5d &q, int ind_q, real5d &qp, int ind_qp) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { //------- Autoconversion/accretion real omn, omp, omg, qcc, qii, autor, autos, accrr, qrr, accrcs, accris, qss, accrcg, accrig, tmp, qgg, dq, qsatt, qsat; diff --git a/components/eam/src/physics/crm/samxx/sgs.cpp b/components/eam/src/physics/crm/samxx/sgs.cpp index cee1a94dd0e0..36ceb0edc966 100644 --- a/components/eam/src/physics/crm/samxx/sgs.cpp +++ b/components/eam/src/physics/crm/samxx/sgs.cpp @@ -25,7 +25,7 @@ void kurant_sgs(real &cfl) { // for (int j=0; j(nzm,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { yakl::atomicMax( tkhmax(k,icrm) , sgs_field_diag(1,k,offy_d+j,offx_d+i,icrm) ); }); diff --git a/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt b/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt index db74ad723e66..5f56611c9145 100644 --- a/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt +++ b/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt @@ -13,7 +13,7 @@ add_executable(cpp2d ../dmdf.F90 ../cpp_driver.F90 target_link_libraries(cpp2d yakl ${NCFLAGS}) set_property(TARGET cpp2d APPEND PROPERTY COMPILE_FLAGS ${DEFS2D} ) -include(${YAKL_HOME}/process_cxx_source_files.cmake) -process_cxx_source_files("${CUDA_SRC}") +include(${YAKL_HOME}/yakl_utils.cmake) +yakl_process_cxx_source_files("${CUDA_SRC}") include_directories(${YAKL_BIN}) diff --git a/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt b/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt index fc399115c45d..d08c0635fa89 100644 --- a/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt +++ b/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt @@ -13,7 +13,7 @@ add_executable(cpp3d ../dmdf.F90 ../cpp_driver.F90 target_link_libraries(cpp3d yakl ${NCFLAGS}) set_property(TARGET cpp3d APPEND PROPERTY COMPILE_FLAGS ${DEFS3D} ) -include(${YAKL_HOME}/process_cxx_source_files.cmake) -process_cxx_source_files("${CUDA_SRC}") +include(${YAKL_HOME}/yakl_utils.cmake) +yakl_process_cxx_source_files("${CUDA_SRC}") include_directories(${YAKL_BIN}) diff --git a/components/eam/src/physics/crm/samxx/tke_full.cpp b/components/eam/src/physics/crm/samxx/tke_full.cpp index 9c1cadec0b95..e9fd6c00c05a 100644 --- a/components/eam/src/physics/crm/samxx/tke_full.cpp +++ b/components/eam/src/physics/crm/samxx/tke_full.cpp @@ -194,7 +194,7 @@ void tke_full(real5d &tke, int ind_tke, real5d &tk, int ind_tk, real5d &tkh, int // for (int j=0; j(nzm-1,ny,nx,ncrms) , YAKL_LAMBDA (int k, int j, int i, int icrm) { + parallel_for( SimpleBounds<4>(nzm-1,ny,nx,ncrms) , YAKL_DEVICE_LAMBDA (int k, int j, int i, int icrm) { real grd, Ce1, Ce2, cx, cy, cz, tkmax, smix, ratio, Cee, a_prod_sh, a_prod_bu, a_diss, tmp, buoy_sgs; diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index bcc12aa582ec..06c83fbe2f01 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -63,7 +63,7 @@ extern "C" void rrtmgp_initialize_cxx(int ngas, char *gas_names[], char const *c // available_gases%gas_name, which gives the name of each gas that would be // present in the ty_gas_concs object. So, we can just set this here, rather // than trying to fully populate the ty_gas_concs object here, which would be - // impossible from this initialization routine because I do not thing the + // impossible from this initialization routine because I do not think the // rad_cnst objects are setup yet. // the other tasks! active_gases = string1d("active_gases", ngas); From b516ae8f219a624acca2bf13a6f415bb349e2eed Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Thu, 9 Sep 2021 15:49:30 -0700 Subject: [PATCH 48/71] Add a testmod for RRTMGPXX --- .../testdefs/testmods_dirs/eam/rrtmgpxx/shell_commands | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 components/eam/cime_config/testdefs/testmods_dirs/eam/rrtmgpxx/shell_commands diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/rrtmgpxx/shell_commands b/components/eam/cime_config/testdefs/testmods_dirs/eam/rrtmgpxx/shell_commands new file mode 100644 index 000000000000..4a40336a89eb --- /dev/null +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/rrtmgpxx/shell_commands @@ -0,0 +1,2 @@ +#!/bin/bash +./xmlchange --append CAM_CONFIG_OPTS='-rad rrtmgp -rrtmgpxx' From 59a9c363a8edfa0538e562e0173c2bc737949d10 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 5 Oct 2021 00:29:39 -0400 Subject: [PATCH 49/71] Fix flux_avg for debug mode (again) --- components/eam/src/physics/cam/flux_avg.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/components/eam/src/physics/cam/flux_avg.F90 b/components/eam/src/physics/cam/flux_avg.F90 index 76dfcf3b205c..658cef003d43 100644 --- a/components/eam/src/physics/cam/flux_avg.F90 +++ b/components/eam/src/physics/cam/flux_avg.F90 @@ -76,11 +76,11 @@ subroutine flux_avg_init(cam_in, pbuf2d) ncol = get_ncols_p(lchnk) pbuf2d_chunk => pbuf_get_chunk(pbuf2d, lchnk) - call pbuf_set_field(pbuf2d_chunk, lhflx_idx, cam_in(lchnk)%lhf(:ncol)) - call pbuf_set_field(pbuf2d_chunk, shflx_idx, cam_in(lchnk)%shf(:ncol)) - call pbuf_set_field(pbuf2d_chunk, qflx_idx, cam_in(lchnk)%cflx(:ncol,1)) - call pbuf_set_field(pbuf2d_chunk, taux_idx, cam_in(lchnk)%wsx(:ncol)) - call pbuf_set_field(pbuf2d_chunk, tauy_idx, cam_in(lchnk)%wsy(:ncol)) + call pbuf_set_field(pbuf2d_chunk, lhflx_idx, cam_in(lchnk)%lhf(:)) + call pbuf_set_field(pbuf2d_chunk, shflx_idx, cam_in(lchnk)%shf(:)) + call pbuf_set_field(pbuf2d_chunk, qflx_idx, cam_in(lchnk)%cflx(:,1)) + call pbuf_set_field(pbuf2d_chunk, taux_idx, cam_in(lchnk)%wsx(:)) + call pbuf_set_field(pbuf2d_chunk, tauy_idx, cam_in(lchnk)%wsy(:)) call pbuf_set_field(pbuf2d_chunk, shflx_res_idx, 0.0_r8) call pbuf_set_field(pbuf2d_chunk, lhflx_res_idx, 0.0_r8) From 603c5d1ed8433e3c61bdb183744a8419a012fe8c Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Fri, 10 Sep 2021 18:19:42 -0400 Subject: [PATCH 50/71] Updating scripts for summit and a bit of the standalone build system --- .../crm/samxx/test/build/cmakescript.sh | 20 ++++++++++--------- .../crm/samxx/test/build/summit_cpu_gnu.sh | 13 ++++++++---- .../crm/samxx/test/build/summit_gpu.sh | 16 +++++++++------ .../crm/samxx/test/cpp2d/CMakeLists.txt | 4 ++-- .../crm/samxx/test/cpp3d/CMakeLists.txt | 4 ++-- 5 files changed, 34 insertions(+), 23 deletions(-) diff --git a/components/eam/src/physics/crm/samxx/test/build/cmakescript.sh b/components/eam/src/physics/crm/samxx/test/build/cmakescript.sh index db7ffa6b78a4..40b98c962b6a 100755 --- a/components/eam/src/physics/crm/samxx/test/build/cmakescript.sh +++ b/components/eam/src/physics/crm/samxx/test/build/cmakescript.sh @@ -140,15 +140,17 @@ unset CUDAFLAGS printf "FFLAGS: $FFLAGS\n\n" -cmake \ - -DCMAKE_Fortran_FLAGS="${FFLAGS} -I$NCHOME/include -I$NFHOME/include" \ - -DYAKL_CXX_FLAGS="${YAKL_CXX_FLAGS} -I$NCHOME/include -I$NFHOME/include" \ - -DNCFLAGS="$NCFLAGS" \ - -DDEFS2D="$DEFS2D" \ - -DDEFS3D="$DEFS3D" \ - -DYAKL_CUDA_FLAGS="${YAKL_CUDA_FLAGS}" \ - -DYAKL_HOME=${YAKL_HOME} \ - -DYAKL_ARCH="${YAKL_ARCH}" \ +cmake \ + -DCMAKE_Fortran_FLAGS="$FFLAGS" \ + -DNCFLAGS="$NCFLAGS" \ + -DDEFS2D="$DEFS2D" \ + -DDEFS3D="$DEFS3D" \ + -DYAKL_HOME=${YAKL_HOME} \ + -DYAKL_CXX_FLAGS="${YAKL_CXX_FLAGS}" \ + -DYAKL_CUDA_FLAGS="${YAKL_CUDA_FLAGS}" \ + -DYAKL_C_FLAGS="${YAKL_C_FLAGS}" \ + -DYAKL_F90_FLAGS="${YAKL_F90_FLAGS}" \ + -DYAKL_ARCH="${YAKL_ARCH}" \ .. diff --git a/components/eam/src/physics/crm/samxx/test/build/summit_cpu_gnu.sh b/components/eam/src/physics/crm/samxx/test/build/summit_cpu_gnu.sh index 3e22c1bec6d9..c69f6763b009 100644 --- a/components/eam/src/physics/crm/samxx/test/build/summit_cpu_gnu.sh +++ b/components/eam/src/physics/crm/samxx/test/build/summit_cpu_gnu.sh @@ -2,19 +2,24 @@ source $MODULESHOME/init/bash module purge -module load DefApps gcc/8.1.1 netcdf netcdf-fortran cmake python/3.7.0-anaconda3-5.3.0 +module load DefApps gcc netcdf-c netcdf-fortran cmake python/3.7.0-anaconda3-5.3.0 unset YAKL_ARCH unset NCRMS +unset CXXFLAGS +unset FFLAGS +unset FCLAGS -export NCHOME=${OLCF_NETCDF_ROOT} +export NCHOME=${OLCF_NETCDF_C_ROOT} export NFHOME=${OLCF_NETCDF_FORTRAN_ROOT} export NCRMS=42 export CC=mpicc export CXX=mpic++ export FC=mpif90 -export FFLAGS="-O3 -ffree-line-length-none" -export YAKL_CXX_FLAGS="-O3 -DUSE_ORIG_FFT" +export YAKL_F90_FLAGS="-O3 -ffree-line-length-none" +export FFLAGS="-O3 -ffree-line-length-none -I${OLCF_NETCDF_FORTRAN_ROOT}/include" +export YAKL_C_FLAGS="-O3" +export YAKL_CXX_FLAGS="-O3" export YAKL_HOME="`pwd`/../../../../../../../../externals/YAKL" diff --git a/components/eam/src/physics/crm/samxx/test/build/summit_gpu.sh b/components/eam/src/physics/crm/samxx/test/build/summit_gpu.sh index 04c3537fa417..370e5887c99c 100644 --- a/components/eam/src/physics/crm/samxx/test/build/summit_gpu.sh +++ b/components/eam/src/physics/crm/samxx/test/build/summit_gpu.sh @@ -2,21 +2,25 @@ source $MODULESHOME/init/bash module purge -module load DefApps gcc/8.1.1 cuda/10.1.105 netcdf netcdf-fortran cmake/3.14.2 python/3.7.0-anaconda3-5.3.0 +module load DefApps gcc cuda/11.4.0 netcdf-c netcdf-fortran cmake python/3.7.0-anaconda3-5.3.0 unset YAKL_ARCH unset NCRMS +unset CXXFLAGS +unset FFLAGS +unset FCLAGS -export NCHOME=${OLCF_NETCDF_ROOT} +export NCHOME=${OLCF_NETCDF_C_ROOT} export NFHOME=${OLCF_NETCDF_FORTRAN_ROOT} export NCRMS=42 export CC=mpicc export CXX=mpic++ export FC=mpif90 -export FFLAGS="-O3 -ffree-line-length-none" -export YAKL_CXX_FLAGS="-O3" -export YAKL_HOME="`pwd`/../../../../../../../../externals/YAKL" -export YAKL_ARCH="CUDA" +export YAKL_F90_FLAGS="-O3 -ffree-line-length-none" +export FFLAGS="-O3 -ffree-line-length-none -I${OLCF_NETCDF_FORTRAN_ROOT}/include" +export YAKL_C_FLAGS="-O3" export YAKL_CUDA_FLAGS="-arch sm_70 -O3 --use_fast_math" +export YAKL_ARCH="CUDA" +export YAKL_HOME="`pwd`/../../../../../../../../externals/YAKL" diff --git a/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt b/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt index 5f56611c9145..2de0e9c4d105 100644 --- a/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt +++ b/components/eam/src/physics/crm/samxx/test/cpp2d/CMakeLists.txt @@ -14,6 +14,6 @@ target_link_libraries(cpp2d yakl ${NCFLAGS}) set_property(TARGET cpp2d APPEND PROPERTY COMPILE_FLAGS ${DEFS2D} ) include(${YAKL_HOME}/yakl_utils.cmake) -yakl_process_cxx_source_files("${CUDA_SRC}") -include_directories(${YAKL_BIN}) +yakl_process_target(cpp2d) +include_directories(${CMAKE_CURRENT_BINARY_DIR}/../yakl) diff --git a/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt b/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt index d08c0635fa89..1ce4f6917ed4 100644 --- a/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt +++ b/components/eam/src/physics/crm/samxx/test/cpp3d/CMakeLists.txt @@ -14,6 +14,6 @@ target_link_libraries(cpp3d yakl ${NCFLAGS}) set_property(TARGET cpp3d APPEND PROPERTY COMPILE_FLAGS ${DEFS3D} ) include(${YAKL_HOME}/yakl_utils.cmake) -yakl_process_cxx_source_files("${CUDA_SRC}") -include_directories(${YAKL_BIN}) +yakl_process_target(cpp3d) +include_directories(${CMAKE_CURRENT_BINARY_DIR}/../yakl) From bea6c91c0dba624c2cb29fbc317fd0998ea2b690 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Fri, 24 Sep 2021 16:09:37 -0400 Subject: [PATCH 51/71] Fix some class references in kernels --- .../physics/rrtmgp/cpp/rrtmgp_interface.cpp | 32 ++++++++++++------- 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index 06c83fbe2f01..e51eb0d7066c 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -194,20 +194,23 @@ extern "C" void rrtmgp_run_sw ( // Add in aerosol // TODO: should we avoid allocating here? OpticalProps2str aerosol_optics; + auto &aerosol_optics_tau = aerosol_optics.tau; + auto &aerosol_optics_ssa = aerosol_optics.ssa; + auto &aerosol_optics_g = aerosol_optics.g ; if (true) { aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw); auto gpt_bnd = aerosol_optics.get_gpoint_bands(); parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); - aerosol_optics.ssa(icol,ilay,igpt) = aer_ssa_bnd(icol,ilay,gpt_bnd(igpt)); - aerosol_optics.g (icol,ilay,igpt) = aer_asm_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics_tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics_ssa(icol,ilay,igpt) = aer_ssa_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics_g (icol,ilay,igpt) = aer_asm_bnd(icol,ilay,gpt_bnd(igpt)); }); } else { aerosol_optics.alloc_2str(ncol, nlay, k_dist_sw.get_band_lims_wavenumber()); parallel_for(Bounds<3>(nswbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); - aerosol_optics.ssa(icol,ilay,ibnd) = aer_ssa_bnd(icol,ilay,ibnd); - aerosol_optics.g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); + aerosol_optics_tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); + aerosol_optics_ssa(icol,ilay,ibnd) = aer_ssa_bnd(icol,ilay,ibnd); + aerosol_optics_g (icol,ilay,ibnd) = aer_asm_bnd(icol,ilay,ibnd); }); } aerosol_optics.delta_scale(); @@ -238,10 +241,13 @@ extern "C" void rrtmgp_run_sw ( // Add in clouds OpticalProps2str cloud_optics; cloud_optics.alloc_2str(ncol, nlay, k_dist_sw); + auto &cloud_optics_tau = cloud_optics.tau; + auto &cloud_optics_ssa = cloud_optics.ssa; + auto &cloud_optics_g = cloud_optics.g ; parallel_for(Bounds<3>(nswgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { - cloud_optics.tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); - cloud_optics.ssa(icol,ilay,igpt) = cld_ssa_gpt(icol,ilay,igpt); - cloud_optics.g (icol,ilay,igpt) = cld_asm_gpt(icol,ilay,igpt); + cloud_optics_tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); + cloud_optics_ssa(icol,ilay,igpt) = cld_ssa_gpt(icol,ilay,igpt); + cloud_optics_g (icol,ilay,igpt) = cld_asm_gpt(icol,ilay,igpt); }); cloud_optics.delta_scale(); cloud_optics.increment(combined_optics); @@ -359,16 +365,17 @@ extern "C" void rrtmgp_run_lw ( // bands, then internally when increment() is called it will map these to // gpoints. Not sure if there is a beneift one way or another. OpticalProps1scl aerosol_optics; + auto &aerosol_optics_tau = aerosol_optics.tau; if (false) { aerosol_optics.alloc_1scl(ncol, nlay, k_dist_lw); auto gpt_bnd = aerosol_optics.get_gpoint_bands(); parallel_for(Bounds<3>(nlwgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); + aerosol_optics_tau(icol,ilay,igpt) = aer_tau_bnd(icol,ilay,gpt_bnd(igpt)); }); } else { aerosol_optics.alloc_1scl(ncol, nlay, k_dist_lw.get_band_lims_wavenumber()); parallel_for(Bounds<3>(nlwbands,nlay,ncol), YAKL_LAMBDA (int ibnd, int ilay, int icol) { - aerosol_optics.tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); + aerosol_optics_tau(icol,ilay,ibnd) = aer_tau_bnd(icol,ilay,ibnd); }); } aerosol_optics.increment(combined_optics); @@ -394,8 +401,9 @@ extern "C" void rrtmgp_run_lw ( // Add in clouds OpticalProps1scl cloud_optics; cloud_optics.alloc_1scl(ncol, nlay, k_dist_lw); + auto &cloud_optics_tau = cloud_optics.tau; parallel_for(Bounds<3>(nlwgpts,nlay,ncol) , YAKL_LAMBDA (int igpt, int ilay, int icol) { - cloud_optics.tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); + cloud_optics_tau(icol,ilay,igpt) = cld_tau_gpt(icol,ilay,igpt); }); cloud_optics.increment(combined_optics); From 1ef32013457aab0b88ca0c84a9e1d93ce9abb32b Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Mon, 4 Oct 2021 16:09:45 -0400 Subject: [PATCH 52/71] Fix CUDA_FLAGS for DEBUG=TRUE Adding -g to the CUDA_FLAGS in DEBUG=TRUE mode. Current stack trace for MMF rrtmgpxx on the GPU is a segfault during finalize with -DYAKL_DEBUG. --- cime_config/machines/config_compilers.xml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 223887cf81b6..0dd61bb738cd 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -1622,7 +1622,8 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} TRUE - -O3 -arch sm_70 --use_fast_math + -O3 -arch sm_70 --use_fast_math + -O0 -g -arch sm_70 --use_fast_math TRUE @@ -1845,7 +1846,8 @@ flags should be captured within MPAS CMake files. $ENV{PNETCDF_PATH} TRUE - -O3 -arch sm_70 --use_fast_math + -O3 -arch sm_70 --use_fast_math + -O0 -arch sm_70 --use_fast_math TRUE From 8b0d6102305474768cb2cbdc2d961baffddaa501 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Tue, 5 Oct 2021 10:21:04 -0400 Subject: [PATCH 53/71] Moving to latest YAKL, which no longer fails upon multiple calls to yakl::initialize and yakl::finalize --- externals/YAKL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/YAKL b/externals/YAKL index 9187f44aa3bc..e82ae9ccdf20 160000 --- a/externals/YAKL +++ b/externals/YAKL @@ -1 +1 @@ -Subproject commit 9187f44aa3bc7738f61f10225f8b5c3272cfa8f3 +Subproject commit e82ae9ccdf20f830ed3e6b8b0c60bd6fb14e87ca From 52c8c7b51b3814544bc06eefb073ec9035898dc3 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Tue, 5 Oct 2021 15:58:47 -0400 Subject: [PATCH 54/71] Wrapping data in host Arrays, then copying to device, then copying back at the end; for SW and LW --- .../physics/rrtmgp/cpp/rrtmgp_interface.cpp | 270 ++++++++++++++---- 1 file changed, 214 insertions(+), 56 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index e51eb0d7066c..23a63eff4c82 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -107,15 +107,17 @@ extern "C" double get_max_temperature() { } extern "C" void get_gpoint_bands_sw(int *gpoint_bands_p) { - auto gpoint_bands_sw = int1d("gpoint_bands", gpoint_bands_p, k_dist_sw.get_ngpt()); + auto gpoint_bands_sw = intHost1d("gpoint_bands", gpoint_bands_p, k_dist_sw.get_ngpt()); auto tmp = k_dist_sw.get_gpoint_bands(); tmp.deep_copy_to(gpoint_bands_sw); + yakl::fence(); } extern "C" void get_gpoint_bands_lw(int *gpoint_bands_p) { - auto gpoint_bands_lw = int1d("gpoint_bands", gpoint_bands_p, k_dist_lw.get_ngpt()); + auto gpoint_bands_lw = intHost1d("gpoint_bands", gpoint_bands_p, k_dist_lw.get_ngpt()); auto tmp = k_dist_lw.get_gpoint_bands(); tmp.deep_copy_to(gpoint_bands_lw); + yakl::fence(); } extern "C" void rrtmgp_run_sw ( @@ -133,36 +135,97 @@ extern "C" void rrtmgp_run_sw ( // Wrap pointers in YAKL arrays int nswbands = k_dist_sw.get_nband(); - int nswgpts = k_dist_sw.get_ngpt(); - auto gas_vmr = real3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); - auto pmid = real2d("pmid", pmid_p, ncol, nlay); - auto tmid = real2d("tmid", tmid_p, ncol, nlay); - auto pint = real2d("pint", pint_p, ncol, nlay+1); - auto coszrs = real1d("coszrs", coszrs_p, ncol); - auto albedo_dir = real2d("albedo_dir", albedo_dir_p, nswbands, ncol); - auto albedo_dif = real2d("albedo_dif", albedo_dif_p, nswbands, ncol); - auto cld_tau_gpt = real3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nswgpts); - auto cld_ssa_gpt = real3d("cld_ssa_gpt", cld_ssa_gpt_p, ncol, nlay, nswgpts); - auto cld_asm_gpt = real3d("cld_asm_gpt", cld_asm_gpt_p, ncol, nlay, nswgpts); - auto aer_tau_bnd = real3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nswbands); - auto aer_ssa_bnd = real3d("aer_ssa_bnd", aer_ssa_bnd_p, ncol, nlay, nswbands); - auto aer_asm_bnd = real3d("aer_asm_bnd", aer_asm_bnd_p, ncol, nlay, nswbands); - auto allsky_flux_up = real2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); - auto allsky_flux_dn = real2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); - auto allsky_flux_dn_dir = real2d("allsky_flux_dn_dir", allsky_flux_dn_dir_p, ncol, nlay+1); - auto allsky_flux_net = real2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); - auto clrsky_flux_up = real2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); - auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); - auto clrsky_flux_dn_dir = real2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); - auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); - auto allsky_bnd_flux_up = real3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nswbands); - auto allsky_bnd_flux_dn = real3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); - auto allsky_bnd_flux_dn_dir = real3d("allsky_bnd_flux_dn_dir", allsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); - auto allsky_bnd_flux_net = real3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nswbands); - auto clrsky_bnd_flux_up = real3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nswbands); - auto clrsky_bnd_flux_dn = real3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); - auto clrsky_bnd_flux_dn_dir = real3d("clrsky_bnd_flux_dn_dir", clrsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); - auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nswbands); + int nswgpts = k_dist_sw.get_ngpt(); + auto gas_vmr_host = realHost3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); + auto pmid_host = realHost2d("pmid", pmid_p, ncol, nlay); + auto tmid_host = realHost2d("tmid", tmid_p, ncol, nlay); + auto pint_host = realHost2d("pint", pint_p, ncol, nlay+1); + auto coszrs_host = realHost1d("coszrs", coszrs_p, ncol); + auto albedo_dir_host = realHost2d("albedo_dir", albedo_dir_p, nswbands, ncol); + auto albedo_dif_host = realHost2d("albedo_dif", albedo_dif_p, nswbands, ncol); + auto cld_tau_gpt_host = realHost3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nswgpts); + auto cld_ssa_gpt_host = realHost3d("cld_ssa_gpt", cld_ssa_gpt_p, ncol, nlay, nswgpts); + auto cld_asm_gpt_host = realHost3d("cld_asm_gpt", cld_asm_gpt_p, ncol, nlay, nswgpts); + auto aer_tau_bnd_host = realHost3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nswbands); + auto aer_ssa_bnd_host = realHost3d("aer_ssa_bnd", aer_ssa_bnd_p, ncol, nlay, nswbands); + auto aer_asm_bnd_host = realHost3d("aer_asm_bnd", aer_asm_bnd_p, ncol, nlay, nswbands); + auto allsky_flux_up_host = realHost2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); + auto allsky_flux_dn_host = realHost2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); + auto allsky_flux_dn_dir_host = realHost2d("allsky_flux_dn_dir", allsky_flux_dn_dir_p, ncol, nlay+1); + auto allsky_flux_net_host = realHost2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); + auto clrsky_flux_up_host = realHost2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); + auto clrsky_flux_dn_host = realHost2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); + auto clrsky_flux_dn_dir_host = realHost2d("clrsky_flux_dn_dir", clrsky_flux_dn_dir_p, ncol, nlay+1); + auto clrsky_flux_net_host = realHost2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + auto allsky_bnd_flux_up_host = realHost3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_dn_host = realHost3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_dn_dir_host = realHost3d("allsky_bnd_flux_dn_dir", allsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); + auto allsky_bnd_flux_net_host = realHost3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_up_host = realHost3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_dn_host = realHost3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_dn_dir_host = realHost3d("clrsky_bnd_flux_dn_dir", clrsky_bnd_flux_dn_dir_p, ncol, nlay+1, nswbands); + auto clrsky_bnd_flux_net_host = realHost3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nswbands); + + real3d gas_vmr ("gas_vmr", ngas, ncol, nlay); + real2d pmid ("pmid", ncol, nlay); + real2d tmid ("tmid", ncol, nlay); + real2d pint ("pint", ncol, nlay+1); + real1d coszrs ("coszrs", ncol); + real2d albedo_dir ("albedo_dir", nswbands, ncol); + real2d albedo_dif ("albedo_dif", nswbands, ncol); + real3d cld_tau_gpt ("cld_tau_gpt", ncol, nlay, nswgpts); + real3d cld_ssa_gpt ("cld_ssa_gpt", ncol, nlay, nswgpts); + real3d cld_asm_gpt ("cld_asm_gpt", ncol, nlay, nswgpts); + real3d aer_tau_bnd ("aer_tau_bnd", ncol, nlay, nswbands); + real3d aer_ssa_bnd ("aer_ssa_bnd", ncol, nlay, nswbands); + real3d aer_asm_bnd ("aer_asm_bnd", ncol, nlay, nswbands); + real2d allsky_flux_up ("allsky_flux_up", ncol, nlay+1); + real2d allsky_flux_dn ("allsky_flux_dn", ncol, nlay+1); + real2d allsky_flux_dn_dir ("allsky_flux_dn_dir", ncol, nlay+1); + real2d allsky_flux_net ("allsky_flux_net", ncol, nlay+1); + real2d clrsky_flux_up ("clrsky_flux_up", ncol, nlay+1); + real2d clrsky_flux_dn ("clrsky_flux_dn", ncol, nlay+1); + real2d clrsky_flux_dn_dir ("clrsky_flux_dn_dir", ncol, nlay+1); + real2d clrsky_flux_net ("clrsky_flux_net", ncol, nlay+1); + real3d allsky_bnd_flux_up ("allsky_bnd_flux_up", ncol, nlay+1, nswbands); + real3d allsky_bnd_flux_dn ("allsky_bnd_flux_dn", ncol, nlay+1, nswbands); + real3d allsky_bnd_flux_dn_dir("allsky_bnd_flux_dn_dir", ncol, nlay+1, nswbands); + real3d allsky_bnd_flux_net ("allsky_bnd_flux_net", ncol, nlay+1, nswbands); + real3d clrsky_bnd_flux_up ("clrsky_bnd_flux_up", ncol, nlay+1, nswbands); + real3d clrsky_bnd_flux_dn ("clrsky_bnd_flux_dn", ncol, nlay+1, nswbands); + real3d clrsky_bnd_flux_dn_dir("clrsky_bnd_flux_dn_dir", ncol, nlay+1, nswbands); + real3d clrsky_bnd_flux_net ("clrsky_bnd_flux_net", ncol, nlay+1, nswbands); + + // TODO: Only copy in the inputs + gas_vmr_host .deep_copy_to(gas_vmr ); + pmid_host .deep_copy_to(pmid ); + tmid_host .deep_copy_to(tmid ); + pint_host .deep_copy_to(pint ); + coszrs_host .deep_copy_to(coszrs ); + albedo_dir_host .deep_copy_to(albedo_dir ); + albedo_dif_host .deep_copy_to(albedo_dif ); + cld_tau_gpt_host .deep_copy_to(cld_tau_gpt ); + cld_ssa_gpt_host .deep_copy_to(cld_ssa_gpt ); + cld_asm_gpt_host .deep_copy_to(cld_asm_gpt ); + aer_tau_bnd_host .deep_copy_to(aer_tau_bnd ); + aer_ssa_bnd_host .deep_copy_to(aer_ssa_bnd ); + aer_asm_bnd_host .deep_copy_to(aer_asm_bnd ); + allsky_flux_up_host .deep_copy_to(allsky_flux_up ); + allsky_flux_dn_host .deep_copy_to(allsky_flux_dn ); + allsky_flux_dn_dir_host .deep_copy_to(allsky_flux_dn_dir ); + allsky_flux_net_host .deep_copy_to(allsky_flux_net ); + clrsky_flux_up_host .deep_copy_to(clrsky_flux_up ); + clrsky_flux_dn_host .deep_copy_to(clrsky_flux_dn ); + clrsky_flux_dn_dir_host .deep_copy_to(clrsky_flux_dn_dir ); + clrsky_flux_net_host .deep_copy_to(clrsky_flux_net ); + allsky_bnd_flux_up_host .deep_copy_to(allsky_bnd_flux_up ); + allsky_bnd_flux_dn_host .deep_copy_to(allsky_bnd_flux_dn ); + allsky_bnd_flux_dn_dir_host.deep_copy_to(allsky_bnd_flux_dn_dir); + allsky_bnd_flux_net_host .deep_copy_to(allsky_bnd_flux_net ); + clrsky_bnd_flux_up_host .deep_copy_to(clrsky_bnd_flux_up ); + clrsky_bnd_flux_dn_host .deep_copy_to(clrsky_bnd_flux_dn ); + clrsky_bnd_flux_dn_dir_host.deep_copy_to(clrsky_bnd_flux_dn_dir); + clrsky_bnd_flux_net_host .deep_copy_to(clrsky_bnd_flux_net ); // Populate gas concentrations object @@ -181,7 +244,6 @@ extern "C" void rrtmgp_run_sw ( // TODO: should we avoid allocating here? OpticalProps2str combined_optics; combined_optics.alloc_2str(ncol, nlay, k_dist_sw); - auto pmid_host = pmid.createHostCopy(); bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); real2d toa_flux("toa_flux", ncol, nswgpts); k_dist_sw.gas_optics(ncol, nlay, top_at_1, pmid, pint, tmid, gas_concs, combined_optics, toa_flux); @@ -274,6 +336,38 @@ extern "C" void rrtmgp_run_sw ( fluxes_allsky.bnd_flux_dn_dir.deep_copy_to(allsky_bnd_flux_dn_dir); fluxes_allsky.bnd_flux_net.deep_copy_to(allsky_bnd_flux_net); + // TODO: Only copy out the outputs + gas_vmr .deep_copy_to(gas_vmr_host ); + pmid .deep_copy_to(pmid_host ); + tmid .deep_copy_to(tmid_host ); + pint .deep_copy_to(pint_host ); + coszrs .deep_copy_to(coszrs_host ); + albedo_dir .deep_copy_to(albedo_dir_host ); + albedo_dif .deep_copy_to(albedo_dif_host ); + cld_tau_gpt .deep_copy_to(cld_tau_gpt_host ); + cld_ssa_gpt .deep_copy_to(cld_ssa_gpt_host ); + cld_asm_gpt .deep_copy_to(cld_asm_gpt_host ); + aer_tau_bnd .deep_copy_to(aer_tau_bnd_host ); + aer_ssa_bnd .deep_copy_to(aer_ssa_bnd_host ); + aer_asm_bnd .deep_copy_to(aer_asm_bnd_host ); + allsky_flux_up .deep_copy_to(allsky_flux_up_host ); + allsky_flux_dn .deep_copy_to(allsky_flux_dn_host ); + allsky_flux_dn_dir .deep_copy_to(allsky_flux_dn_dir_host ); + allsky_flux_net .deep_copy_to(allsky_flux_net_host ); + clrsky_flux_up .deep_copy_to(clrsky_flux_up_host ); + clrsky_flux_dn .deep_copy_to(clrsky_flux_dn_host ); + clrsky_flux_dn_dir .deep_copy_to(clrsky_flux_dn_dir_host ); + clrsky_flux_net .deep_copy_to(clrsky_flux_net_host ); + allsky_bnd_flux_up .deep_copy_to(allsky_bnd_flux_up_host ); + allsky_bnd_flux_dn .deep_copy_to(allsky_bnd_flux_dn_host ); + allsky_bnd_flux_dn_dir.deep_copy_to(allsky_bnd_flux_dn_dir_host); + allsky_bnd_flux_net .deep_copy_to(allsky_bnd_flux_net_host ); + clrsky_bnd_flux_up .deep_copy_to(clrsky_bnd_flux_up_host ); + clrsky_bnd_flux_dn .deep_copy_to(clrsky_bnd_flux_dn_host ); + clrsky_bnd_flux_dn_dir.deep_copy_to(clrsky_bnd_flux_dn_dir_host); + clrsky_bnd_flux_net .deep_copy_to(clrsky_bnd_flux_net_host ); + yakl::fence(); + } extern "C" void rrtmgp_run_lw ( @@ -290,28 +384,70 @@ extern "C" void rrtmgp_run_lw ( // Wrap pointers in YAKL arrays int nlwbands = k_dist_lw.get_nband(); - int nlwgpts = k_dist_lw.get_ngpt(); - auto gas_vmr = real3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); - auto pmid = real2d("pmid", pmid_p, ncol, nlay); - auto tmid = real2d("tmid", tmid_p, ncol, nlay); - auto pint = real2d("pint", pint_p, ncol, nlay+1); - auto tint = real2d("tint", tint_p, ncol, nlay+1); - auto emis_sfc = real2d("emis_sfc", emis_sfc_p, nlwbands, ncol); - auto cld_tau_gpt = real3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nlwgpts); - auto aer_tau_bnd = real3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nlwbands); - auto allsky_flux_up = real2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); - auto allsky_flux_dn = real2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); - auto allsky_flux_net = real2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); - auto clrsky_flux_up = real2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); - auto clrsky_flux_dn = real2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); - auto clrsky_flux_net = real2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); - auto allsky_bnd_flux_up = real3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); - auto allsky_bnd_flux_dn = real3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); - auto allsky_bnd_flux_net = real3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); - auto clrsky_bnd_flux_up = real3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); - auto clrsky_bnd_flux_dn = real3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); - auto clrsky_bnd_flux_net = real3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); - + int nlwgpts = k_dist_lw.get_ngpt(); + auto gas_vmr_host = realHost3d("gas_vmr", gas_vmr_p, ngas, ncol, nlay); + auto pmid_host = realHost2d("pmid", pmid_p, ncol, nlay); + auto tmid_host = realHost2d("tmid", tmid_p, ncol, nlay); + auto pint_host = realHost2d("pint", pint_p, ncol, nlay+1); + auto tint_host = realHost2d("tint", tint_p, ncol, nlay+1); + auto emis_sfc_host = realHost2d("emis_sfc", emis_sfc_p, nlwbands, ncol); + auto cld_tau_gpt_host = realHost3d("cld_tau_gpt", cld_tau_gpt_p, ncol, nlay, nlwgpts); + auto aer_tau_bnd_host = realHost3d("aer_tau_bnd", aer_tau_bnd_p, ncol, nlay, nlwbands); + auto allsky_flux_up_host = realHost2d("allsky_flux_up", allsky_flux_up_p, ncol, nlay+1); + auto allsky_flux_dn_host = realHost2d("allsky_flux_dn", allsky_flux_dn_p, ncol, nlay+1); + auto allsky_flux_net_host = realHost2d("allsky_flux_net", allsky_flux_net_p, ncol, nlay+1); + auto clrsky_flux_up_host = realHost2d("clrsky_flux_up", clrsky_flux_up_p, ncol, nlay+1); + auto clrsky_flux_dn_host = realHost2d("clrsky_flux_dn", clrsky_flux_dn_p, ncol, nlay+1); + auto clrsky_flux_net_host = realHost2d("clrsky_flux_net", clrsky_flux_net_p, ncol, nlay+1); + auto allsky_bnd_flux_up_host = realHost3d("allsky_bnd_flux_up", allsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); + auto allsky_bnd_flux_dn_host = realHost3d("allsky_bnd_flux_dn", allsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); + auto allsky_bnd_flux_net_host = realHost3d("allsky_bnd_flux_net", allsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_up_host = realHost3d("clrsky_bnd_flux_up", clrsky_bnd_flux_up_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_dn_host = realHost3d("clrsky_bnd_flux_dn", clrsky_bnd_flux_dn_p, ncol, nlay+1, nlwbands); + auto clrsky_bnd_flux_net_host = realHost3d("clrsky_bnd_flux_net", clrsky_bnd_flux_net_p, ncol, nlay+1, nlwbands); + + real3d gas_vmr ("gas_vmr", ngas, ncol, nlay); + real2d pmid ("pmid", ncol, nlay); + real2d tmid ("tmid", ncol, nlay); + real2d pint ("pint", ncol, nlay+1); + real2d tint ("tint", ncol, nlay+1); + real2d emis_sfc ("emis_sfc", nlwbands, ncol); + real3d cld_tau_gpt ("cld_tau_gpt", ncol, nlay, nlwgpts); + real3d aer_tau_bnd ("aer_tau_bnd", ncol, nlay, nlwbands); + real2d allsky_flux_up ("allsky_flux_up", ncol, nlay+1); + real2d allsky_flux_dn ("allsky_flux_dn", ncol, nlay+1); + real2d allsky_flux_net ("allsky_flux_net", ncol, nlay+1); + real2d clrsky_flux_up ("clrsky_flux_up", ncol, nlay+1); + real2d clrsky_flux_dn ("clrsky_flux_dn", ncol, nlay+1); + real2d clrsky_flux_net ("clrsky_flux_net", ncol, nlay+1); + real3d allsky_bnd_flux_up ("allsky_bnd_flux_up", ncol, nlay+1, nlwbands); + real3d allsky_bnd_flux_dn ("allsky_bnd_flux_dn", ncol, nlay+1, nlwbands); + real3d allsky_bnd_flux_net("allsky_bnd_flux_net", ncol, nlay+1, nlwbands); + real3d clrsky_bnd_flux_up ("clrsky_bnd_flux_up", ncol, nlay+1, nlwbands); + real3d clrsky_bnd_flux_dn ("clrsky_bnd_flux_dn", ncol, nlay+1, nlwbands); + real3d clrsky_bnd_flux_net("clrsky_bnd_flux_net", ncol, nlay+1, nlwbands); + + // TODO: Only copy in the inputs + gas_vmr_host .deep_copy_to(gas_vmr ); + pmid_host .deep_copy_to(pmid ); + tmid_host .deep_copy_to(tmid ); + pint_host .deep_copy_to(pint ); + tint_host .deep_copy_to(tint ); + emis_sfc_host .deep_copy_to(emis_sfc ); + cld_tau_gpt_host .deep_copy_to(cld_tau_gpt ); + aer_tau_bnd_host .deep_copy_to(aer_tau_bnd ); + allsky_flux_up_host .deep_copy_to(allsky_flux_up ); + allsky_flux_dn_host .deep_copy_to(allsky_flux_dn ); + allsky_flux_net_host .deep_copy_to(allsky_flux_net ); + clrsky_flux_up_host .deep_copy_to(clrsky_flux_up ); + clrsky_flux_dn_host .deep_copy_to(clrsky_flux_dn ); + clrsky_flux_net_host .deep_copy_to(clrsky_flux_net ); + allsky_bnd_flux_up_host .deep_copy_to(allsky_bnd_flux_up ); + allsky_bnd_flux_dn_host .deep_copy_to(allsky_bnd_flux_dn ); + allsky_bnd_flux_net_host.deep_copy_to(allsky_bnd_flux_net); + clrsky_bnd_flux_up_host .deep_copy_to(clrsky_bnd_flux_up ); + clrsky_bnd_flux_dn_host .deep_copy_to(clrsky_bnd_flux_dn ); + clrsky_bnd_flux_net_host.deep_copy_to(clrsky_bnd_flux_net); // Populate gas concentrations GasConcs gas_concs; @@ -353,7 +489,6 @@ extern "C" void rrtmgp_run_lw ( // Populate optical property objects OpticalProps1scl combined_optics; combined_optics.alloc_1scl(ncol, nlay, k_dist_lw); - auto pmid_host = pmid.createHostCopy(); bool top_at_1 = pmid_host(1, 1) < pmid_host (1, 2); real1d t_sfc("t_sfc", ncol); parallel_for(Bounds<1>(ncol), YAKL_LAMBDA (int icol) { @@ -425,4 +560,27 @@ extern "C" void rrtmgp_run_lw ( fluxes_allsky.bnd_flux_dn.deep_copy_to(allsky_bnd_flux_dn); fluxes_allsky.bnd_flux_net.deep_copy_to(allsky_bnd_flux_net); + // TODO: Only copy out the outputs + gas_vmr .deep_copy_to(gas_vmr_host ); + pmid .deep_copy_to(pmid_host ); + tmid .deep_copy_to(tmid_host ); + pint .deep_copy_to(pint_host ); + tint .deep_copy_to(tint_host ); + emis_sfc .deep_copy_to(emis_sfc_host ); + cld_tau_gpt .deep_copy_to(cld_tau_gpt_host ); + aer_tau_bnd .deep_copy_to(aer_tau_bnd_host ); + allsky_flux_up .deep_copy_to(allsky_flux_up_host ); + allsky_flux_dn .deep_copy_to(allsky_flux_dn_host ); + allsky_flux_net .deep_copy_to(allsky_flux_net_host ); + clrsky_flux_up .deep_copy_to(clrsky_flux_up_host ); + clrsky_flux_dn .deep_copy_to(clrsky_flux_dn_host ); + clrsky_flux_net .deep_copy_to(clrsky_flux_net_host ); + allsky_bnd_flux_up .deep_copy_to(allsky_bnd_flux_up_host ); + allsky_bnd_flux_dn .deep_copy_to(allsky_bnd_flux_dn_host ); + allsky_bnd_flux_net.deep_copy_to(allsky_bnd_flux_net_host); + clrsky_bnd_flux_up .deep_copy_to(clrsky_bnd_flux_up_host ); + clrsky_bnd_flux_dn .deep_copy_to(clrsky_bnd_flux_dn_host ); + clrsky_bnd_flux_net.deep_copy_to(clrsky_bnd_flux_net_host); + yakl::fence(); + } From ad0f95a98beb10ebdcce430de2a075663120b0a2 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Wed, 6 Oct 2021 11:10:14 -0400 Subject: [PATCH 55/71] Adding debug flags to CXXFLAGS for summit+gnu --- cime_config/machines/config_compilers.xml | 3 +++ components/eam/src/physics/rrtmgp/external | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 0dd61bb738cd..66039c0f3508 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -1567,6 +1567,9 @@ flags should be captured within MPAS CMake files. -O2 + + -O0 -g + -DHAVE_SLASHPROC diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index b9edc5e6eb7f..305acbdff89b 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit b9edc5e6eb7faa560e6a742fb390ac160ef2b188 +Subproject commit 305acbdff89bd132845945b75a48b7c7858fdc40 From 1d273139cd07cbc487e71ab04e6c619623c0deed Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Wed, 6 Oct 2021 12:10:44 -0400 Subject: [PATCH 56/71] Update to latest RRTMGP master with bugfix --- components/eam/src/physics/rrtmgp/external | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index 305acbdff89b..aa38fd8c5d16 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit 305acbdff89bd132845945b75a48b7c7858fdc40 +Subproject commit aa38fd8c5d160884d6ff0b49b02e6fec78ba5fd7 From 774e552c9bfc55aa3e5e968b0c200feab4a4fd33 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Thu, 7 Oct 2021 09:02:32 -0400 Subject: [PATCH 57/71] Getting rid of fast math in DEBUG CUDA_FLAGS, and adding -g to DEBUG CUDA_FLAGS --- cime_config/machines/config_compilers.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/machines/config_compilers.xml b/cime_config/machines/config_compilers.xml index 66039c0f3508..e97470892ed7 100644 --- a/cime_config/machines/config_compilers.xml +++ b/cime_config/machines/config_compilers.xml @@ -1626,7 +1626,7 @@ flags should be captured within MPAS CMake files. TRUE -O3 -arch sm_70 --use_fast_math - -O0 -g -arch sm_70 --use_fast_math + -O0 -g -arch sm_70 TRUE @@ -1850,7 +1850,7 @@ flags should be captured within MPAS CMake files. TRUE -O3 -arch sm_70 --use_fast_math - -O0 -arch sm_70 --use_fast_math + -O0 -g -arch sm_70 TRUE From 92413e0781b5ab16dd28d8e6fdab8d16bcddf67e Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Thu, 7 Oct 2021 09:17:10 -0400 Subject: [PATCH 58/71] Changing const.h to rrtmgp_const.h for rrtmgpxx --- components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h | 2 +- .../eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h | 2 +- components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h | 2 +- components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp | 2 +- components/eam/src/physics/rrtmgp/external | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h index 933983f3b7bc..6c0677c15a5c 100644 --- a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h +++ b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h @@ -1,5 +1,5 @@ #pragma once -#include "const.h" +#include "rrtmgp_const.h" #include "YAKL.h" #include "mo_gas_concentrations.h" diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h index 771a4e41db3c..df92b28a1be6 100644 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h @@ -1,6 +1,6 @@ #pragma once -#include "const.h" +#include "rrtmgp_const.h" #include "mo_optical_props.h" #include "mo_cloud_optics.h" diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h index b87ef3f6f5f9..76ef61abc8d3 100644 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h +++ b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h @@ -1,6 +1,6 @@ #pragma once -#include "const.h" +#include "rrtmgp_const.h" #include "mo_gas_concentrations.h" #include "mo_gas_optics_rrtmgp.h" #include diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index 23a63eff4c82..bcb4b6b00596 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -4,7 +4,7 @@ #include "mo_rte_sw.h" #include "mo_rte_lw.h" #include "mo_optical_props.h" -#include "const.h" +#include "rrtmgp_const.h" #include "mo_fluxes_byband.h" using yakl::intrinsics::minval; diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index aa38fd8c5d16..8b20eef79593 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit aa38fd8c5d160884d6ff0b49b02e6fec78ba5fd7 +Subproject commit 8b20eef795932a46e556a5e39b95c5a47d01bfde From 4b3a034252225b9f2c3dfd41e3bcf87d0bc2c755 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Thu, 7 Oct 2021 09:49:07 -0400 Subject: [PATCH 59/71] Removing unused declarations, and changing rrtmgp interface build system to use the new YAKL target-based approach --- .../eam/src/physics/rrtmgp/cpp/CMakeLists.txt | 13 +++---------- .../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp | 3 --- 2 files changed, 3 insertions(+), 13 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt index 9cdaaf89683a..6d34bf35a1e8 100644 --- a/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt +++ b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt @@ -13,19 +13,12 @@ set (RRTMGPXX_HEADERS mo_load_coefficients.h ) -# Set compile flags for cxx source -if ("${YAKL_ARCH}" STREQUAL "CUDA") - message(STATUS "rrtmgp_interface flags: ${YAKL_CUDA_FLAGS}") - set_source_files_properties(${CXX_SRC} PROPERTIES LANGUAGE CUDA) - set_source_files_properties(${CXX_SRC} PROPERTIES COMPILE_FLAGS "-DYAKL_ARCH_CUDA --expt-extended-lambda --expt-relaxed-constexpr ${YAKL_CUDA_FLAGS}") -else () - message(STATUS "rrtmgp_interface flags: ${YAKL_CXX_FLAGS}") - set_source_files_properties(${CXX_SRC} PROPERTIES COMPILE_FLAGS "${YAKL_CXX_FLAGS}") -endif () - # Add library for interface code add_library(rrtmgp_interface STATIC ${CXX_SRC}) +include(${YAKL_HOME}/yakl_utils.cmake) +yakl_process_target(rrtmgp_interface) + # Libraries to link #find_library(NETCDF_C netcdf HINTS ${NetCDF_C_PATHS}/lib) find_library( diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index bcb4b6b00596..5b2760604cae 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -7,9 +7,6 @@ #include "rrtmgp_const.h" #include "mo_fluxes_byband.h" -using yakl::intrinsics::minval; -using yakl::intrinsics::maxval; - // Prototypes extern "C" int get_nband_sw(); extern "C" int get_nband_lw(); From b18a910bf398ab802c9e3127a74b2239a3b3ebe0 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 7 Oct 2021 09:42:11 -0600 Subject: [PATCH 60/71] Add radiation_final to rrtmg interfaces --- components/eam/src/physics/rrtmg/radiation.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/components/eam/src/physics/rrtmg/radiation.F90 b/components/eam/src/physics/rrtmg/radiation.F90 index 5918638321c6..082c8a590f71 100644 --- a/components/eam/src/physics/rrtmg/radiation.F90 +++ b/components/eam/src/physics/rrtmg/radiation.F90 @@ -40,6 +40,7 @@ module radiation radiation_nextsw_cday, &! calendar day of next radiation calculation radiation_do, &! query which radiation calcs are done this timestep radiation_init, &! calls radini + radiation_final, &! deallocate radiation_readnl, &! read radiation namelist radiation_tend ! moved from radctl.F90 @@ -811,6 +812,13 @@ subroutine radiation_init(phys_state) end subroutine radiation_init +!=============================================================================== + + subroutine radiation_final() + ! Do any needed clean-up and deallocation before model exit. Empty for now + ! but required for consistency with RRTMGPXX interface. + end subroutine radiation_final + !=============================================================================== subroutine radiation_tend(state,ptend, pbuf, & From 347a11837949ed5506b286fb1a585528a6c79de5 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 7 Oct 2021 09:45:53 -0600 Subject: [PATCH 61/71] Remove netcdf-cxx4 from submodules --- .gitmodules | 3 --- 1 file changed, 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 20d66a97a286..315399033fc7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -52,6 +52,3 @@ [submodule "externals/mct"] path = externals/mct url = git@github.com:MCSclimate/MCT.git -[submodule "externals/netcdf-cxx4"] - path = externals/netcdf-cxx4 - url = git@github.com:Unidata/netcdf-cxx4.git From 131366c137dbfe0cd0f3ce304a514732c461d348 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 7 Oct 2021 13:35:25 -0600 Subject: [PATCH 62/71] Add radiation_final for CRM rrtmg --- components/eam/src/physics/crm/rrtmg/radiation.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/components/eam/src/physics/crm/rrtmg/radiation.F90 b/components/eam/src/physics/crm/rrtmg/radiation.F90 index 82e61bc6c4a1..8341e18a92e8 100644 --- a/components/eam/src/physics/crm/rrtmg/radiation.F90 +++ b/components/eam/src/physics/crm/rrtmg/radiation.F90 @@ -50,6 +50,7 @@ module radiation radiation_nextsw_cday, &! calendar day of next radiation calculation radiation_do, &! query which radiation calcs are done this timestep radiation_init, &! calls radini + radiation_final, &! deallocate radiation_readnl, &! read radiation namelist radiation_tend ! moved from radctl.F90 @@ -839,6 +840,13 @@ subroutine radiation_init(phys_state) end subroutine radiation_init +!=============================================================================== + + subroutine radiation_final() + ! Do any needed clean-up and deallocation before model exit. Empty for now + ! but required for consistency with RRTMGPXX interface. + end subroutine radiation_final + !=============================================================================== subroutine radiation_tend( state, ptend,pbuf, & From 62cbc03f5127e7b43c8b1d0d608e1646b39e22f1 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 7 Oct 2021 13:35:55 -0600 Subject: [PATCH 63/71] Update to latest RRTMGP master after rrtmgp_const fix --- components/eam/src/physics/rrtmgp/external | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/src/physics/rrtmgp/external b/components/eam/src/physics/rrtmgp/external index 8b20eef79593..bc2d53a53d55 160000 --- a/components/eam/src/physics/rrtmgp/external +++ b/components/eam/src/physics/rrtmgp/external @@ -1 +1 @@ -Subproject commit 8b20eef795932a46e556a5e39b95c5a47d01bfde +Subproject commit bc2d53a53d5580e2828c1a524e43a30d90162ff8 From e77b3dd686cf290a0ff5ea6da290ee02d5d9ba11 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Thu, 7 Oct 2021 14:47:29 -0600 Subject: [PATCH 64/71] Revert to RRTMGP I/O --- .../eam/src/physics/rrtmgp/cpp/CMakeLists.txt | 15 +- .../physics/rrtmgp/cpp/mo_garand_atmos_io.cpp | 115 ------- .../physics/rrtmgp/cpp/mo_garand_atmos_io.h | 15 - .../rrtmgp/cpp/mo_load_cloud_coefficients.cpp | 107 ------- .../rrtmgp/cpp/mo_load_cloud_coefficients.h | 14 - .../rrtmgp/cpp/mo_load_coefficients.cpp | 118 -------- .../physics/rrtmgp/cpp/mo_load_coefficients.h | 9 - .../src/physics/rrtmgp/cpp/simple_netcdf.hpp | 284 ------------------ 8 files changed, 5 insertions(+), 672 deletions(-) delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp delete mode 100644 components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h delete mode 100644 components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp diff --git a/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt index 6d34bf35a1e8..5415e410c64f 100644 --- a/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt +++ b/components/eam/src/physics/rrtmgp/cpp/CMakeLists.txt @@ -1,26 +1,19 @@ set (F90_SRC rrtmgp_interface.F90) set (CXX_SRC - mo_garand_atmos_io.cpp - mo_load_cloud_coefficients.cpp - mo_load_coefficients.cpp rrtmgp_interface.cpp ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/fluxes_byband/mo_fluxes_byband_kernels.cpp -) -set (RRTMGPXX_HEADERS - simple_netcdf.hpp - mo_garand_atmos_io.h - mo_load_cloud_coefficients.h - mo_load_coefficients.h + ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/examples/mo_load_coefficients.cpp + ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/examples/all-sky/mo_load_cloud_coefficients.cpp ) # Add library for interface code add_library(rrtmgp_interface STATIC ${CXX_SRC}) +# Set compile flags for RRTMGP sources (handles CUDA flags when needed) include(${YAKL_HOME}/yakl_utils.cmake) yakl_process_target(rrtmgp_interface) # Libraries to link -#find_library(NETCDF_C netcdf HINTS ${NetCDF_C_PATHS}/lib) find_library( NETCDF_C_LIBRARY NAMES netcdf libnetcdf HINTS ${LIB_NETCDF} ${LIB_NETCDF_C} @@ -33,6 +26,8 @@ target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/. target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/rrtmgp) target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/cloud_optics) target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/extensions/fluxes_byband) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/examples) +target_include_directories(rrtmgp_interface PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../external/cpp/examples/all-sky) # Set fortran compiler flags set_source_files_properties(${F90_SRC} PROPERTIES COMPILE_FLAGS "${CPPDEFS} ${FFLAGS}") diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp deleted file mode 100644 index 20274e961993..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.cpp +++ /dev/null @@ -1,115 +0,0 @@ -#include "mo_garand_atmos_io.h" -#include "simple_netcdf.hpp" -#include "netcdf.h" - -// Read in the data, then use only the first column, and copy it to all of the model columns -// In the end, all model columns will be identical -void read_atmos(std::string input_file, real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, real2d &col_dry, int ncol) { - simple_netcdf::SimpleNetCDF io; - io.open(input_file , NC_NOWRITE); - - int nlay = io.getDimSize("lay"); - int nlev = io.getDimSize("lev"); - - p_lay = real2d("p_lay",ncol,nlay); - t_lay = real2d("t_lay",ncol,nlay); - p_lev = real2d("p_lev",ncol,nlev); - t_lev = real2d("t_lev",ncol,nlev); - - real2d tmp2d; - // p_lay - io.read(tmp2d,"p_lay"); - // for (int ilay=1 ; ilay <= nlay ; ilay++) { - // for (int icol=1 ; icol <= ncol ; icol++) { - parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA (int ilay, int icol) { - p_lay(icol,ilay) = tmp2d(1,ilay); - }); - // t_lay - io.read(tmp2d,"t_lay"); - // for (int ilay=1 ; ilay <= nlay ; ilay++) { - // for (int icol=1 ; icol <= ncol ; icol++) { - parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA ( int ilay, int icol) { - t_lay(icol,ilay) = tmp2d(1,ilay); - }); - // p_lev - tmp2d = real2d(); // Reset tmp2d to avoid warnings about reallocating during file read - io.read(tmp2d,"p_lev"); - // for (int ilev=1 ; ilev <= nlev ; ilev++) { - // for (int icol=1 ; icol <= ncol ; icol++) { - parallel_for( Bounds<2>(nlev,ncol) , YAKL_LAMBDA ( int ilev, int icol) { - p_lev(icol,ilev) = tmp2d(1,ilev); - }); - // t_lev - io.read(tmp2d,"t_lev"); - // for (int ilev=1 ; ilev <= nlev ; ilev++) { - // for (int icol=1 ; icol <= ncol ; icol++) { - parallel_for( Bounds<2>(nlev,ncol) , YAKL_LAMBDA( int ilev, int icol) { - t_lev(icol,ilev) = tmp2d(1,ilev); - }); - - int ngas = 8; - string1d gas_names("gas_names",ngas); - gas_names(1) = std::string("h2o"); - gas_names(2) = std::string("co2"); - gas_names(3) = std::string("o3" ); - gas_names(4) = std::string("n2o"); - gas_names(5) = std::string("co" ); - gas_names(6) = std::string("ch4"); - gas_names(7) = std::string("o2" ); - gas_names(8) = std::string("n2" ); - - // Initialize GasConcs object with an "ncol" given from the calling program - gas_concs.init(gas_names,ncol,nlay); - - tmp2d = real2d(); // Reset the tmp2d variable - for (int igas=1 ; igas <= ngas ; igas++) { - std::string vmr_name = "vmr_"+gas_names(igas); - if ( ! io.varExists(vmr_name) ) { stoprun("ERROR: gas does not exist in input file"); } - // Read in 2-D varaible - io.read(tmp2d,vmr_name); - // Create 1-D variable with just the first column - real1d tmp1d("tmp1d",nlay); - // for (int i=1 ; i <= nlay ; i++) { - parallel_for( Bounds<1>(nlay) , YAKL_LAMBDA (int i) { - tmp1d(i) = tmp2d(1,i); - }); - // Call set_vmr with only the first column from the data file copied among all of the model columns - gas_concs.set_vmr( gas_names(igas) , tmp1d ); - } - - if ( io.varExists("col_dry") ) { - col_dry = real2d("col_dry",ncol,nlay); - tmp2d = real2d(); // Reset the tmp2d variable - io.read(tmp2d,"col_dry"); - // for (int ilay=1 ; ilay <= nlay ; ilay++) { - // for (int icol=1 ; icol <= ncol ; icol++) { - parallel_for( Bounds<2>(nlay,ncol) , YAKL_LAMBDA( int ilay, int icol) { - col_dry(icol,ilay) = tmp2d(1,ilay); - }); - } - - io.close(); -} - - - -void write_sw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, real2d const &flux_dir, int ncol) { - simple_netcdf::SimpleNetCDF io; - io.open(fileName , NC_WRITE); - io.write(flux_up , "sw_flux_up_result" , {"col_new","lev"}); - io.write(flux_dn , "sw_flux_dn_result" , {"col_new","lev"}); - io.write(flux_dir , "sw_flux_dir_result" , {"col_new","lev"}); - io.close(); -} - - - -void write_lw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, int ncol) { - simple_netcdf::SimpleNetCDF io; - io.open(fileName , NC_WRITE); - io.write(flux_up , "lw_flux_up_result" , {"col_new","lev"}); - io.write(flux_dn , "lw_flux_dn_result" , {"col_new","lev"}); - io.close(); -} - diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h b/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h deleted file mode 100644 index 6c0677c15a5c..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_garand_atmos_io.h +++ /dev/null @@ -1,15 +0,0 @@ -#pragma once -#include "rrtmgp_const.h" -#include "YAKL.h" -#include "mo_gas_concentrations.h" - -void read_atmos(std::string input_file, real2d &p_lay, real2d &t_lay, real2d &p_lev, real2d &t_lev, - GasConcs &gas_concs, real2d &col_dry, int ncol); - - -void write_sw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, real2d const &flux_dir, int ncol); - - -void write_lw_fluxes(std::string fileName, real2d const &flux_up, real2d const &flux_dn, int ncol); - - diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp deleted file mode 100644 index 1e9ead49f803..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.cpp +++ /dev/null @@ -1,107 +0,0 @@ -#include "mo_load_cloud_coefficients.h" -#include "simple_netcdf.hpp" - -// read cloud optical property LUT coefficients from NetCDF file -void load_cld_lutcoeff(CloudOptics &cloud_spec, std::string cld_coeff_file) { - simple_netcdf::SimpleNetCDF io; - // Open cloud optical property coefficient file - io.open(cld_coeff_file , NC_NOWRITE); - - // Read LUT coefficient dimensions - int nband = io.getDimSize("nband"); - int nrghice = io.getDimSize("nrghice"); - int nsize_liq = io.getDimSize("nsize_liq"); - int nsize_ice = io.getDimSize("nsize_ice"); - - real2d band_lims_wvn("band_lims_wvn",2,nband); - io.read(band_lims_wvn,"bnd_limits_wavenumber"); - - // Read LUT constants - real radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac; - io.read(radliq_lwr , "radliq_lwr"); - io.read(radliq_upr , "radliq_upr"); - io.read(radliq_fac , "radliq_fac"); - io.read(radice_lwr , "radice_lwr"); - io.read(radice_upr , "radice_upr"); - io.read(radice_fac , "radice_fac"); - - // Allocate cloud property lookup table input arrays - real2d lut_extliq("lut_extliq",nsize_liq, nband); - real2d lut_ssaliq("lut_ssaliq",nsize_liq, nband); - real2d lut_asyliq("lut_asyliq",nsize_liq, nband); - real3d lut_extice("lut_extice",nsize_ice, nband, nrghice); - real3d lut_ssaice("lut_ssaice",nsize_ice, nband, nrghice); - real3d lut_asyice("lut_asyice",nsize_ice, nband, nrghice); - // Read LUT coefficients - io.read(lut_extliq , "lut_extliq"); - io.read(lut_ssaliq , "lut_ssaliq"); - io.read(lut_asyliq , "lut_asyliq"); - io.read(lut_extice , "lut_extice"); - io.read(lut_ssaice , "lut_ssaice"); - io.read(lut_asyice , "lut_asyice"); - - io.close(); - - cloud_spec.load(band_lims_wvn, radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, - lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice); -} - - - -// read cloud optical property Pade coefficients from NetCDF file -void load_cld_padecoeff(CloudOptics &cloud_spec, std::string cld_coeff_file) { - simple_netcdf::SimpleNetCDF io; - // Open cloud optical property coefficient file - io.open(cld_coeff_file , NC_NOWRITE); - - // Read Pade coefficient dimensions - int nband = io.getDimSize("nband"); - int nrghice = io.getDimSize("nrghice"); - int nsizereg = io.getDimSize("nsizereg"); - int ncoeff_ext = io.getDimSize("ncoeff_ext"); - int ncoeff_ssa_g = io.getDimSize("ncoeff_ssa_g"); - int nbound = io.getDimSize("nbound"); - - real2d band_lims_wvn("band_lims_wvn",2,nband); - io.read(band_lims_wvn, "bnd_limits_wavenumber"); - - // Allocate cloud property Pade coefficient input arrays - real3d pade_extliq("pade_extliq",nband, nsizereg, ncoeff_ext); - real3d pade_ssaliq("pade_ssaliq",nband, nsizereg, ncoeff_ssa_g); - real3d pade_asyliq("pade_asyliq",nband, nsizereg, ncoeff_ssa_g); - real4d pade_extice("pade_extice",nband, nsizereg, ncoeff_ext, nrghice); - real4d pade_ssaice("pade_ssaice",nband, nsizereg, ncoeff_ssa_g, nrghice); - real4d pade_asyice("pade_asyice",nband, nsizereg, ncoeff_ssa_g, nrghice); - io.read(pade_extliq, "pade_extliq"); - io.read(pade_ssaliq, "pade_ssaliq"); - io.read(pade_asyliq, "pade_asyliq"); - io.read(pade_extice, "pade_extice"); - io.read(pade_ssaice, "pade_ssaice"); - io.read(pade_asyice, "pade_asyice"); - - // Allocate cloud property Pade coefficient particle size boundary input arrays - real1d pade_sizreg_extliq("pade_sizreg_extliq",nbound); - real1d pade_sizreg_ssaliq("pade_sizreg_ssaliq",nbound); - real1d pade_sizreg_asyliq("pade_sizreg_asyliq",nbound); - real1d pade_sizreg_extice("pade_sizreg_extice",nbound); - real1d pade_sizreg_ssaice("pade_sizreg_ssaice",nbound); - real1d pade_sizreg_asyice("pade_sizreg_asyice",nbound); - - io.read(pade_sizreg_extliq, "pade_sizreg_extliq"); - io.read(pade_sizreg_ssaliq, "pade_sizreg_ssaliq"); - io.read(pade_sizreg_asyliq, "pade_sizreg_asyliq"); - io.read(pade_sizreg_extice, "pade_sizreg_extice"); - io.read(pade_sizreg_ssaice, "pade_sizreg_ssaice"); - io.read(pade_sizreg_asyice, "pade_sizreg_asyice"); - - io.close(); - - cloud_spec.load(band_lims_wvn, pade_extliq, pade_ssaliq, pade_asyliq, - pade_extice, pade_ssaice, pade_asyice, - pade_sizreg_extliq, pade_sizreg_ssaliq, pade_sizreg_asyliq, - pade_sizreg_extice, pade_sizreg_ssaice, pade_sizreg_asyice); -} - - - - diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h deleted file mode 100644 index df92b28a1be6..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_cloud_coefficients.h +++ /dev/null @@ -1,14 +0,0 @@ -#pragma once - -#include "rrtmgp_const.h" -#include "mo_optical_props.h" -#include "mo_cloud_optics.h" - - -void load_cld_lutcoeff(CloudOptics &cloud_spec, std::string cld_coeff_file); - - -void load_cld_padecoeff(CloudOptics &cloud_spec, std::string cld_coeff_file); - - - diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp deleted file mode 100644 index 1f5b05b2d828..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.cpp +++ /dev/null @@ -1,118 +0,0 @@ -#include "mo_load_coefficients.h" -#include "simple_netcdf.hpp" - -// This code is part of RRTM for GCM Applications - Parallel (RRTMGP) -// -// Contacts: Robert Pincus and Eli Mlawer -// email: rrtmgp@aer.com -// -// Copyright 2015-2018, Atmospheric and Environmental Research and -// Regents of the University of Colorado. All right reserved. -// -// Use and duplication is permitted under the terms of the -// BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause -// ------------------------------------------------------------------------------------------------- - -void load_and_init(GasOpticsRRTMGP &kdist, std::string filename, GasConcs const &available_gases) { - simple_netcdf::SimpleNetCDF io; - io.open(filename , NC_NOWRITE); - - // Read the many arrays - string1d gas_names; - string1d gas_minor; - string1d identifier_minor; - string1d minor_gases_lower; - string1d minor_gases_upper; - string1d scaling_gas_lower; - string1d scaling_gas_upper; - intHost3d key_species; - realHost2d band_lims; - intHost2d band2gpt; - real press_ref_trop; - real temp_ref_p; - real temp_ref_t; - realHost1d press_ref; - realHost1d temp_ref; - realHost3d vmr_ref; - realHost4d kmajor; - intHost2d minor_limits_gpt_lower; - intHost2d minor_limits_gpt_upper; - boolHost1d minor_scales_with_density_lower; - boolHost1d minor_scales_with_density_upper; - boolHost1d scale_by_complement_lower; - boolHost1d scale_by_complement_upper; - intHost1d kminor_start_lower; - intHost1d kminor_start_upper; - realHost3d kminor_lower; - realHost3d kminor_upper; - realHost3d rayl_lower; - realHost3d rayl_upper; - - // Read in strings - charHost2d tmp; - tmp = charHost2d(); io.read( tmp , "gas_names" ); gas_names = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "gas_minor" ); gas_minor = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "identifier_minor" ); identifier_minor = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "minor_gases_lower" ); minor_gases_lower = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "minor_gases_upper" ); minor_gases_upper = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "scaling_gas_lower" ); scaling_gas_lower = char2d_to_string1d(tmp); - tmp = charHost2d(); io.read( tmp , "scaling_gas_upper" ); scaling_gas_upper = char2d_to_string1d(tmp); - - io.read( key_species , "key_species" ); - io.read( band_lims , "bnd_limits_wavenumber" ); - io.read( band2gpt , "bnd_limits_gpt" ); - io.read( press_ref , "press_ref" ); - io.read( temp_ref , "temp_ref" ); - io.read( temp_ref_p , "absorption_coefficient_ref_P" ); - io.read( temp_ref_t , "absorption_coefficient_ref_T" ); - io.read( press_ref_trop , "press_ref_trop" ); - io.read( kminor_lower , "kminor_lower" ); - io.read( kminor_upper , "kminor_upper" ); - io.read( minor_limits_gpt_lower , "minor_limits_gpt_lower" ); - io.read( minor_limits_gpt_upper , "minor_limits_gpt_upper" ); - io.read( minor_scales_with_density_lower , "minor_scales_with_density_lower" ); - io.read( minor_scales_with_density_upper , "minor_scales_with_density_upper" ); - io.read( scale_by_complement_lower , "scale_by_complement_lower" ); - io.read( scale_by_complement_upper , "scale_by_complement_upper" ); - io.read( kminor_start_lower , "kminor_start_lower" ); - io.read( kminor_start_upper , "kminor_start_upper" ); - io.read( vmr_ref , "vmr_ref" ); - io.read( kmajor , "kmajor" ); - - if (io.varExists("rayl_lower")) { - io.read( rayl_lower , "rayl_lower" ); - io.read( rayl_upper , "rayl_upper" ); - } - - // Initialize the gas optics class with data. The calls look slightly different depending - // on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) - // gas_optics%load() returns a string; a non-empty string indicates an error. - if (io.varExists("totplnk")) { - // If there's a totplnk variable in the file, then it's a longwave (internal sources) type - realHost2d totplnk; - realHost4d planck_frac; - io.read( totplnk , "totplnk" ); - io.read( planck_frac , "plank_fraction" ); - kdist.load(available_gases, gas_names, key_species, band2gpt, band_lims, 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); - } else { - // Otherwise, it's a shortwave type - realHost1d solar_src; - io.read( solar_src , "solar_source" ); - kdist.load(available_gases, gas_names, key_species, band2gpt, band_lims, 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, rayl_lower, rayl_upper); - } - io.close(); -} - - diff --git a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h b/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h deleted file mode 100644 index 76ef61abc8d3..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/mo_load_coefficients.h +++ /dev/null @@ -1,9 +0,0 @@ -#pragma once - -#include "rrtmgp_const.h" -#include "mo_gas_concentrations.h" -#include "mo_gas_optics_rrtmgp.h" -#include - -void load_and_init(GasOpticsRRTMGP &kdist, std::string filename, GasConcs const &available_gases); - diff --git a/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp b/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp deleted file mode 100644 index 3db4b39992b1..000000000000 --- a/components/eam/src/physics/rrtmgp/cpp/simple_netcdf.hpp +++ /dev/null @@ -1,284 +0,0 @@ -#include "netcdf.h" -#include "YAKL.h" - -using namespace yakl; -namespace simple_netcdf { - - class SimpleNetCDF { - - protected: - - int ncid; - - public: - - // Constructor - SimpleNetCDF() {}; - - // Destructor - ~SimpleNetCDF() { - //close(); - }; - - void close() { - handle_error(nc_close(ncid)); - } - - void create(std::string filename, int mode=NC_CLOBBER) { - handle_error(nc_create(filename.c_str(), mode, &ncid)); - }; - - void open(std::string filename, int mode=NC_NOWRITE) { - handle_error(nc_open(filename.c_str(), mode, &ncid)); - }; - - void open(char *filename) { - handle_error(nc_open(filename, NC_NOWRITE, &ncid)); - } - - // NetCDF routines return an integer error code. Define a function - // here to abort program execution and throw an error code if we - // encounter a non-zero NetCDF return code. We will wrap our - // NetCDF calls with this function to handle these errors in a - // consistent way - void handle_error(int err) { - if (err) { - std::cout << "ERROR: " << nc_strerror(err) << std::endl; - abort(); - } - } - - void handle_error(int err, const char *file, int line) { - if (err) { - std::cout << "ERROR: " << nc_strerror(err) << " at line " << line << " in " << file << std::endl; - abort(); - } - } - - // Read a netCDF array to a YAKL array - template void read(Array &arr, std::string varName) { - - // Get variable ID - int varid; - handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); - - // Get variable dimension sizes - int ndims; - int dimids[NC_MAX_VAR_DIMS]; - nc_type vtype; - handle_error(nc_inq_var(ncid, varid, NULL, &vtype, &ndims, dimids, NULL), __FILE__, __LINE__); - std::vector dimSizes(ndims); - size_t dimsize; - for (int i = 0; i < ndims; i++) { - handle_error(nc_inq_dimlen(ncid, dimids[i], &dimsize), __FILE__, __LINE__); - dimSizes[i] = dimsize; - } - - // If style is fortran, we need to reverse array dims - if (myStyle == styleFortran) { - std::reverse(dimSizes.begin(), dimSizes.end()); - } - - // Allocate (or reshape) the yakl array - arr = Array(varName.c_str(),dimSizes); - - // Read variable data - if (myMem == memDevice) { - auto arrHost = arr.createHostCopy(); - if (std::is_same::value) { - // Create boolean array from integer arrays - Array tmp("tmp",dimSizes); - handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); - for (int i=0; i < arr.totElems(); i++) { arrHost.myData[i] = tmp.myData[i] == 1; } - } else { - // Need to be careful with floats; nc_get_var is overloaded on type, but we need - // to make sure we read floats from file with the float procedure, and doubles - // with that for doubles. The danger is if the user passes a yakl array here - // with type double, but tries to read type float from file. - // TODO: why does the YAKL implementation for this work fine, but this version - // calling nc_get_var directly does not? - if (vtype == NC_FLOAT) { - Array tmp("tmp",dimSizes); - handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); - for (int i=0; i < arr.totElems(); i++) { arrHost.myData[i] = tmp.myData[i]; } - } else { - handle_error(nc_get_var(ncid, varid, arrHost.data()), __FILE__, __LINE__); - } - } - arrHost.deep_copy_to(arr); - } else { - if (std::is_same::value) { - // Create boolean array from integer arrays - Array tmp("tmp",dimSizes); - handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); - for (int i=0; i < arr.totElems(); i++) { arr.myData[i] = tmp.myData[i] == 1; } - } else { - if (vtype == NC_FLOAT) { - Array tmp("tmp",dimSizes); - handle_error(nc_get_var(ncid, varid, tmp.data()), __FILE__, __LINE__); - for (int i=0; i < arr.totElems(); i++) { arr.myData[i] = tmp.myData[i]; } - } else { - handle_error(nc_get_var(ncid, varid, arr.data()), __FILE__, __LINE__); - } - } - } - - } - - // Read a scalar type - template void read(T &arr , std::string varName) { - // Get variable ID - int varid; - handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); - - // Read data - handle_error(nc_get_var(ncid, varid, &arr), __FILE__, __LINE__); - } - - // Check if variable exists in file - bool varExists (std::string varName) { - int varid; - int ncerr = nc_inq_varid(ncid, varName.c_str(), &varid); - if (ncerr == 0) { - return true; - } else { - return false; - } - } - - bool dimExists (std::string dimName) { - int dimid; - int ncerr = nc_inq_dimid(ncid, dimName.c_str(), &dimid); - if (ncerr == 0) { - return true; - } else { - return false; - } - } - - size_t getDimSize(std::string dimName) { - // Get dimension ID - int dimid; - handle_error(nc_inq_dimid(ncid, dimName.c_str(), &dimid)); - - // Get dimension size - size_t dimSize; - handle_error(nc_inq_dimlen(ncid, dimid, &dimSize)); - - return dimSize; - } - - void addDim(std::string dimName, int dimSize, int *dimid) { - // Put file into define mode - int ncerr = nc_redef(ncid); - if ((ncerr != NC_NOERR) and (ncerr != NC_EINDEFINE)) { - handle_error(ncerr, __FILE__, __LINE__); - } - - // Define dimension - handle_error(nc_def_dim(ncid, dimName.c_str(), dimSize, dimid), __FILE__, __LINE__); - - // End define mode - handle_error(nc_enddef(ncid), __FILE__, __LINE__); - } - - void addVar(std::string varName, nc_type varType, int ndims, int dimids[], int *varid) { - // Put file into define mode - int ncerr = nc_redef(ncid); - if ((ncerr != NC_NOERR) and (ncerr != NC_EINDEFINE)) { - handle_error(ncerr, __FILE__, __LINE__); - } - - // Define variable - handle_error(nc_def_var(ncid, varName.c_str(), varType, ndims, dimids, varid), __FILE__, __LINE__); - - // End define mode - handle_error(nc_enddef(ncid), __FILE__, __LINE__); - } - - template void putVar(T const &arr, std::string varName) { - // Make sure file is not in define mode - int ncerr = nc_enddef(ncid); - if ((ncerr != NC_NOERR) and (ncerr != NC_ENOTINDEFINE)) { - handle_error(ncerr, __FILE__, __LINE__); - } - - // Get variable Id - int varid; - handle_error(nc_inq_varid(ncid, varName.c_str(), &varid), __FILE__, __LINE__); - - // Write variable data - handle_error(nc_put_var(ncid, varid, arr), __FILE__, __LINE__); - } - - template - void write(Array const &arr, std::string varName, std::vector dimNames) { - - // Make sure length of dimension names is equal to rank of array - if (rank != dimNames.size()) { yakl_throw("dimNames.size() != Array rank"); } - - // Get dimension sizes - // Define dimensions if they do not exist and get dimension IDs - int dimids[rank]; - size_t dimSize; - int idim; - for (int i = 0; i < dimNames.size(); i++) { - // If style is Fortran, dimension ordering is reversed - if (myStyle == styleC) { - idim = i; - } else { - idim = rank - 1 - i; - } - int ncerr = nc_inq_dimid(ncid, dimNames[i].c_str(), &dimids[idim]); - if (ncerr == NC_NOERR) { - // check that size is correct - handle_error(nc_inq_dimlen(ncid, dimids[idim], &dimSize), __FILE__, __LINE__); - if (dimSize != arr.dimension[i]) { - yakl_throw("dimSize != arr.dimension[i]"); - } - } else { - addDim(dimNames[i], arr.dimension[i], &dimids[idim]); - } - } - - // Add variable if it does not exist - if (!varExists(varName)) { - int varid; - addVar(varName, getType(), rank, dimids, &varid); - } - - // Write data to file - putVar(arr.data(), varName); - } - - template void write(T arr, std::string varName) { - // If variable does not exist, try to add it - if (!varExists(varName)) { - int dimids[1] = {0}; - int varid; - addVar(varName, getType(), 0, dimids, &varid); - } - // Write to file - putVar(&arr, varName); - } - - // Determine nc_type corresponding to intrinsic type - template nc_type getType() const { - if ( std::is_same::value ) { return NC_CHAR; } - else if ( std::is_same::value ) { return NC_UBYTE; } - else if ( std::is_same::value ) { return NC_SHORT; } - else if ( std::is_same::value ) { return NC_USHORT; } - else if ( std::is_same::value ) { return NC_INT; } - else if ( std::is_same::value ) { return NC_UINT; } - else if ( std::is_same::value ) { return NC_INT64; } - else if ( std::is_same::value ) { return NC_UINT64; } - else if ( std::is_same::value ) { return NC_FLOAT; } - else if ( std::is_same::value ) { return NC_DOUBLE; } - else if ( std::is_same::value ) { return NC_STRING; } - else { yakl_throw("Invalid type"); } - return -1; - } - - }; // class SimpleNetCDF - -} // namespace simple_netcdf From a02cd55f4754d65394da0786d5fc979d6cf0ef44 Mon Sep 17 00:00:00 2001 From: "Benjamin R. Hillman" Date: Fri, 8 Oct 2021 14:15:19 -0600 Subject: [PATCH 65/71] Removed unused commented out code --- components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 index 2b0b338049c3..f1b5e686e74c 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90 @@ -177,11 +177,4 @@ function c_strarr(str, str_c) result(str_p) end do end function c_strarr -! function c_string(str) result(str_c) -! implicit none -! use iso_c_binding -! character(len=*), intent(in) :: str -! character(kind=c_char) :: str_c -! str_c = trim(str)//C_NULL_CHAR -! end function c_string end module rrtmgp_interface From 7a846772287644fcd8e3a8c52681bd9713d1fac5 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 12 Oct 2021 16:22:50 -0400 Subject: [PATCH 66/71] Make RRTMGPXX default for all MMF compsets --- components/eam/cime_config/config_component.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/cime_config/config_component.xml b/components/eam/cime_config/config_component.xml index e66eca598d97..bc7b7e097124 100644 --- a/components/eam/cime_config/config_component.xml +++ b/components/eam/cime_config/config_component.xml @@ -57,7 +57,7 @@ -use_MMF -crm_adv MPDATA -nlev 60 -crm_nz 50 -crm_dx 2000 -crm_dt 10 -crm_nx 64 -crm_nx_rad 4 -crm_ny 1 -crm_ny_rad 1 - -rad rrtmgp + -rad rrtmgp -rrtmgpxx -crm sam -crm samxx -crm samomp From 9f8cdbf39881adf5fa0bec1aa98ff7b6e1a142b5 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 12 Oct 2021 16:24:33 -0400 Subject: [PATCH 67/71] Add RRTMGPXX test to E3SM integration --- cime_config/tests.py | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/tests.py b/cime_config/tests.py index e6efd4d4cfe8..83f1be921ce9 100644 --- a/cime_config/tests.py +++ b/cime_config/tests.py @@ -67,6 +67,7 @@ "SMS_Ln1.ne4_oQU240.F2010.eam-chem_pp", "SMS_D_Ln5.ne4_oQU240.F2010.eam-clubb_sp", "ERS_Ld5.ne4_oQU240.F2010.eam-rrtmgp", + "ERS_Ld5.ne4_oQU240.F2010.eam-rrtmgpxx", "REP_Ln5.ne4_oQU240.F2010", "SMS_Ld9.ne4pg2_oQU480.F2010.eam-thetahy_sl_pg2_mass", ) From 818546b078f9423bff2cb1fac14edbcf6845dfe8 Mon Sep 17 00:00:00 2001 From: Matt Norman Date: Tue, 19 Oct 2021 15:42:46 -0400 Subject: [PATCH 68/71] Upgrading to new YAKL with a new pool allocator that uses the avilable space more efficiently and turns off the pool for targets without a separate memory address space. --- externals/YAKL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/externals/YAKL b/externals/YAKL index e82ae9ccdf20..114146aac62b 160000 --- a/externals/YAKL +++ b/externals/YAKL @@ -1 +1 @@ -Subproject commit e82ae9ccdf20f830ed3e6b8b0c60bd6fb14e87ca +Subproject commit 114146aac62b9d1c42154cfdd9264ec67c051c4e From 475a9e3fe0b263afb69fc0fddc9b0ce0eba464b6 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Fri, 22 Oct 2021 14:00:43 -0400 Subject: [PATCH 69/71] Only copy to/from device as needed --- .../physics/rrtmgp/cpp/rrtmgp_interface.cpp | 58 +++++++++---------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp index 5b2760604cae..b6f64655636d 100644 --- a/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp +++ b/components/eam/src/physics/rrtmgp/cpp/rrtmgp_interface.cpp @@ -207,22 +207,22 @@ extern "C" void rrtmgp_run_sw ( aer_tau_bnd_host .deep_copy_to(aer_tau_bnd ); aer_ssa_bnd_host .deep_copy_to(aer_ssa_bnd ); aer_asm_bnd_host .deep_copy_to(aer_asm_bnd ); - allsky_flux_up_host .deep_copy_to(allsky_flux_up ); - allsky_flux_dn_host .deep_copy_to(allsky_flux_dn ); - allsky_flux_dn_dir_host .deep_copy_to(allsky_flux_dn_dir ); - allsky_flux_net_host .deep_copy_to(allsky_flux_net ); - clrsky_flux_up_host .deep_copy_to(clrsky_flux_up ); - clrsky_flux_dn_host .deep_copy_to(clrsky_flux_dn ); - clrsky_flux_dn_dir_host .deep_copy_to(clrsky_flux_dn_dir ); - clrsky_flux_net_host .deep_copy_to(clrsky_flux_net ); - allsky_bnd_flux_up_host .deep_copy_to(allsky_bnd_flux_up ); - allsky_bnd_flux_dn_host .deep_copy_to(allsky_bnd_flux_dn ); - allsky_bnd_flux_dn_dir_host.deep_copy_to(allsky_bnd_flux_dn_dir); - allsky_bnd_flux_net_host .deep_copy_to(allsky_bnd_flux_net ); - clrsky_bnd_flux_up_host .deep_copy_to(clrsky_bnd_flux_up ); - clrsky_bnd_flux_dn_host .deep_copy_to(clrsky_bnd_flux_dn ); - clrsky_bnd_flux_dn_dir_host.deep_copy_to(clrsky_bnd_flux_dn_dir); - clrsky_bnd_flux_net_host .deep_copy_to(clrsky_bnd_flux_net ); + //allsky_flux_up_host .deep_copy_to(allsky_flux_up ); + //allsky_flux_dn_host .deep_copy_to(allsky_flux_dn ); + //allsky_flux_dn_dir_host .deep_copy_to(allsky_flux_dn_dir ); + //allsky_flux_net_host .deep_copy_to(allsky_flux_net ); + //clrsky_flux_up_host .deep_copy_to(clrsky_flux_up ); + //clrsky_flux_dn_host .deep_copy_to(clrsky_flux_dn ); + //clrsky_flux_dn_dir_host .deep_copy_to(clrsky_flux_dn_dir ); + //clrsky_flux_net_host .deep_copy_to(clrsky_flux_net ); + //allsky_bnd_flux_up_host .deep_copy_to(allsky_bnd_flux_up ); + //allsky_bnd_flux_dn_host .deep_copy_to(allsky_bnd_flux_dn ); + //allsky_bnd_flux_dn_dir_host.deep_copy_to(allsky_bnd_flux_dn_dir); + //allsky_bnd_flux_net_host .deep_copy_to(allsky_bnd_flux_net ); + //clrsky_bnd_flux_up_host .deep_copy_to(clrsky_bnd_flux_up ); + //clrsky_bnd_flux_dn_host .deep_copy_to(clrsky_bnd_flux_dn ); + //clrsky_bnd_flux_dn_dir_host.deep_copy_to(clrsky_bnd_flux_dn_dir); + //clrsky_bnd_flux_net_host .deep_copy_to(clrsky_bnd_flux_net ); // Populate gas concentrations object @@ -334,19 +334,19 @@ extern "C" void rrtmgp_run_sw ( fluxes_allsky.bnd_flux_net.deep_copy_to(allsky_bnd_flux_net); // TODO: Only copy out the outputs - gas_vmr .deep_copy_to(gas_vmr_host ); - pmid .deep_copy_to(pmid_host ); - tmid .deep_copy_to(tmid_host ); - pint .deep_copy_to(pint_host ); - coszrs .deep_copy_to(coszrs_host ); - albedo_dir .deep_copy_to(albedo_dir_host ); - albedo_dif .deep_copy_to(albedo_dif_host ); - cld_tau_gpt .deep_copy_to(cld_tau_gpt_host ); - cld_ssa_gpt .deep_copy_to(cld_ssa_gpt_host ); - cld_asm_gpt .deep_copy_to(cld_asm_gpt_host ); - aer_tau_bnd .deep_copy_to(aer_tau_bnd_host ); - aer_ssa_bnd .deep_copy_to(aer_ssa_bnd_host ); - aer_asm_bnd .deep_copy_to(aer_asm_bnd_host ); + //gas_vmr .deep_copy_to(gas_vmr_host ); + //pmid .deep_copy_to(pmid_host ); + //tmid .deep_copy_to(tmid_host ); + //pint .deep_copy_to(pint_host ); + //coszrs .deep_copy_to(coszrs_host ); + //albedo_dir .deep_copy_to(albedo_dir_host ); + //albedo_dif .deep_copy_to(albedo_dif_host ); + //cld_tau_gpt .deep_copy_to(cld_tau_gpt_host ); + //cld_ssa_gpt .deep_copy_to(cld_ssa_gpt_host ); + //cld_asm_gpt .deep_copy_to(cld_asm_gpt_host ); + //aer_tau_bnd .deep_copy_to(aer_tau_bnd_host ); + //aer_ssa_bnd .deep_copy_to(aer_ssa_bnd_host ); + //aer_asm_bnd .deep_copy_to(aer_asm_bnd_host ); allsky_flux_up .deep_copy_to(allsky_flux_up_host ); allsky_flux_dn .deep_copy_to(allsky_flux_dn_host ); allsky_flux_dn_dir .deep_copy_to(allsky_flux_dn_dir_host ); From 8cf1f79fd5e39bce330e273340a2e3b9396c13ca Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Tue, 26 Oct 2021 14:17:51 -0500 Subject: [PATCH 70/71] Make sure rrtmgp_interface gets netcdf includes --- components/cmake/build_model.cmake | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/components/cmake/build_model.cmake b/components/cmake/build_model.cmake index 990d4ade72cc..574160c8e4ec 100644 --- a/components/cmake/build_model.cmake +++ b/components/cmake/build_model.cmake @@ -115,11 +115,17 @@ function(build_model COMP_CLASS COMP_NAME) set(RRTMGPXX_INTERFACE_BIN ${CMAKE_CURRENT_BINARY_DIR}/rrtmgp_interface) add_subdirectory(${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/cpp ${RRTMGPXX_INTERFACE_BIN}) # Interface code needs some additional headers - include_directories( + target_include_directories(rrtmgp_interface PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp/extensions/fluxes_byband ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/external/cpp/extensions/cloud_optics ${CMAKE_CURRENT_SOURCE_DIR}/../../eam/src/physics/rrtmgp/cpp ) + # The interface code needs to know about the NETCDF includes defined + # above. The easiest way I know of to do this is to pass all of the + # accumulated includes to the target. + # TODO: this can go away if the above NETCDF section is refactored to + # use find_library instead of appending to INCLDIR. + target_include_directories(rrtmgp_interface PRIVATE ${INCLDIR}) # Add the source files for the interface code to the main E3SM build set(RRTMGPXX_F90 cmake/atm/../../eam/src/physics/rrtmgp/cpp/rrtmgp_interface.F90) set(SOURCES ${SOURCES} ${RRTMGPXX_F90}) From 134922b1f0449bb124a96d214221c722f5c15a60 Mon Sep 17 00:00:00 2001 From: Benjamin Hillman Date: Fri, 29 Oct 2021 16:55:33 -0500 Subject: [PATCH 71/71] Explicitly use pool allocator for ESMT test Make sure we use the pool allocator for the ESMT test. This used to be the default in YAKL, but commit fcf7ba19 appears to have changed that behavior, and for some reason that is causing non-BFB behavior with this test. We do not understand why, but reverting this behavior should make this test BFB with master, and get the ESMT test to pass again on Chrysalis. --- .../testdefs/testmods_dirs/eam/mmf_use_ESMT/shell_commands | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/mmf_use_ESMT/shell_commands b/components/eam/cime_config/testdefs/testmods_dirs/eam/mmf_use_ESMT/shell_commands index 68b13734bd23..562829688b51 100644 --- a/components/eam/cime_config/testdefs/testmods_dirs/eam/mmf_use_ESMT/shell_commands +++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/mmf_use_ESMT/shell_commands @@ -1 +1 @@ -./xmlchange --append -id CAM_CONFIG_OPTS -val " -cppdefs ' -DMMF_ESMT -DMMF_USE_ESMT ' " +./xmlchange --append -id CAM_CONFIG_OPTS -val " -cppdefs ' -DMMF_ESMT -DMMF_USE_ESMT -DYAKL_SEPARATE_MEMORY_SPACE ' "