From 6c2f8fd3f588c78c560ac9c9f1200d5d0fb003e5 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 17 Apr 2025 09:57:07 -0700 Subject: [PATCH 01/11] Draft aerosol classes (#209) Adds an initial implementation of the abstract aerosol classes from CAM along with a stub aerosol model. closes #205 I'll leave this in draft while we iterate on the design. This makes a few modifications to the CAM aerosol classes' virtual functions including: - returning optical properties for all grid cells and wavelength bins - having the aerosol model state own its own data, as opposed to it being managed externally - specifying a wavelength grid for optical properties to be returned on This design should also support concurrent use of multiple aerosol models and/or multiple state objects for a single aerosol model instance. The best place to start reviewing this is probably in `test/musica/aerosol/mock_host.F90`, which shows how a simple host model might use the aerosol classes with a radiation package. @gold2718 - let me know if you think this structure will work for your use case. Feel free to request changes or submit PRs to my dev branch. We could also set up a meeting to discuss needs in more detail. Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? no If yes to the above question, describe how this code was validated with the new/modified features: n/a --------- Co-authored-by: Jiwon Gim <55209567+boulderdaze@users.noreply.github.com> --- .../aerosol/musica_ccpp_aerosol_model.F90 | 82 +++++++++ .../aerosol/musica_ccpp_aerosol_state.F90 | 15 ++ schemes/musica/aerosol_stub/README.md | 6 + .../musica_ccpp_stub_aerosol_model.F90 | 159 ++++++++++++++++++ .../musica_ccpp_stub_aerosol_state.F90 | 66 ++++++++ schemes/musica/util/musica_ccpp_grid.F90 | 148 ++++++++++++++++ .../musica/{ => util}/musica_ccpp_species.F90 | 0 .../musica/{ => util}/musica_ccpp_util.F90 | 0 test/musica/CMakeLists.txt | 6 + test/musica/README.md | 11 ++ test/musica/aerosol/CMakeLists.txt | 32 ++++ test/musica/aerosol/mock_host.F90 | 105 ++++++++++++ test/musica/aerosol_stub/CMakeLists.txt | 32 ++++ .../aerosol_stub/test_stub_aerosol_model.F90 | 99 +++++++++++ test/musica/tuvx/CMakeLists.txt | 18 +- test/musica/util/CMakeLists.txt | 32 ++++ test/musica/util/test_musica_grid.F90 | 106 ++++++++++++ 17 files changed, 908 insertions(+), 9 deletions(-) create mode 100644 schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 create mode 100644 schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 create mode 100644 schemes/musica/aerosol_stub/README.md create mode 100644 schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 create mode 100644 schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 create mode 100644 schemes/musica/util/musica_ccpp_grid.F90 rename schemes/musica/{ => util}/musica_ccpp_species.F90 (100%) rename schemes/musica/{ => util}/musica_ccpp_util.F90 (100%) create mode 100644 test/musica/README.md create mode 100644 test/musica/aerosol/CMakeLists.txt create mode 100644 test/musica/aerosol/mock_host.F90 create mode 100644 test/musica/aerosol_stub/CMakeLists.txt create mode 100644 test/musica/aerosol_stub/test_stub_aerosol_model.F90 create mode 100644 test/musica/util/CMakeLists.txt create mode 100644 test/musica/util/test_musica_grid.F90 diff --git a/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 b/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 new file mode 100644 index 00000000..31c15ce9 --- /dev/null +++ b/schemes/musica/aerosol/musica_ccpp_aerosol_model.F90 @@ -0,0 +1,82 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_aerosol_model + + implicit none + private + + public :: aerosol_model_t + + !> Defines the configuration of any aerosol package (using + !! any aerosol representation) based on user specification. These values are + !! set during initialization and do not vary during the simulation. + !! + !! Each aerosol package (e.g., MAM, CARMA, etc) must extend the abstract + !! aerosol_model_t class to define the details of their configuration. Any + !! package must implement each of the deferred procedures of the abstract + !! aerosol_model_t class, may include additional private data members and + !! type-bound procedures, and may override functions of the abstract class. + !! + !! Please see the musica_ccpp_stub_aerosol_model module for an example of how the + !! aerosol_model_t class can be extended for a specific aerosol package. + type, abstract :: aerosol_model_t + contains + procedure(aerosol_model_create_state), deferred :: create_state + procedure(aerosol_model_optical_properties), deferred :: optical_properties + end type aerosol_model_t + + abstract interface + + !> Returns a new instance of the aerosol state for the aerosol model. + !! The aerosol state is used to store the time-and-space varying aerosol + !! properties for the aerosol model. + !! @param this The aerosol model instance. + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The aerosol state instance. + function aerosol_model_create_state(this, number_of_columns, number_of_levels, & + error_message, error_code) result(aerosol_state) + use musica_ccpp_aerosol_state, only: aerosol_state_t + import :: aerosol_model_t + class(aerosol_model_t), intent(in) :: this + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + class(aerosol_state_t), pointer :: aerosol_state + end function aerosol_model_create_state + + !> Computes the optical properties of the aerosol for the given state and + !! wavelengths. + !! @param this The aerosol model instance. + !! @param state The aerosol state instance. + !! @param wavelengths The wavelengths at which to compute the optical properties. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @param extinction Parameterized specific extinction (m^2/kg) [column, level, wavelength]. + !! @param absorption Parameterized specific absorption (m^2/kg) [column, level, wavelength]. + !! @param scattering Single scattering albedo (unitless) [column, level, wavelength]. + !! @param asymmetry_factor Asymmetry factor (unitless) [column, level, wavelength]. + subroutine aerosol_model_optical_properties(this, state, wavelengths, & + error_message, error_code, extinction, absorption, scattering, & + asymmetry_factor) + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_grid, only: grid_t + import :: aerosol_model_t + class(aerosol_model_t), intent(in) :: this + class(aerosol_state_t), intent(in) :: state + class(grid_t), intent(in) :: wavelengths + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk), optional, intent(out) :: extinction(:,:,:) + real(rk), optional, intent(out) :: absorption(:,:,:) + real(rk), optional, intent(out) :: scattering(:,:,:) + real(rk), optional, intent(out) :: asymmetry_factor(:,:,:) + end subroutine aerosol_model_optical_properties + + end interface + +end module musica_ccpp_aerosol_model \ No newline at end of file diff --git a/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 b/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 new file mode 100644 index 00000000..be9a6754 --- /dev/null +++ b/schemes/musica/aerosol/musica_ccpp_aerosol_state.F90 @@ -0,0 +1,15 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_aerosol_state + + implicit none + private + + public :: aerosol_state_t + + !> Defines the state of an aerosol system according to + !! the aerosol representation of a specific aerosol package. + type, abstract :: aerosol_state_t + end type aerosol_state_t + +end module musica_ccpp_aerosol_state \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/README.md b/schemes/musica/aerosol_stub/README.md new file mode 100644 index 00000000..e70a329a --- /dev/null +++ b/schemes/musica/aerosol_stub/README.md @@ -0,0 +1,6 @@ +The stub aerosol model +====================== + +The files in this folder define a stub aerosol model, primarily for use during +development. Functions of the stub aerosol classes return values corresponding +to the absence of aerosols. \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 new file mode 100644 index 00000000..233b3399 --- /dev/null +++ b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_model.F90 @@ -0,0 +1,159 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_stub_aerosol_model + + use musica_ccpp_aerosol_model, only: aerosol_model_t + + implicit none + private + + public :: stub_aerosol_model_t, stub_aerosol_model_parameters_t, & + STUB_AEROSOL_INVALID_DIMENSION, STUB_AEROSOL_INVALID_STATE_TYPE + + !> @brief stub_aerosol_model_parameters_t defines the parameters for the + !! stub aerosol model. (This model assumes no aerosols are present in + !! the atmosphere, and therefore has no parameters.) + type :: stub_aerosol_model_parameters_t + end type stub_aerosol_model_parameters_t + + !> @brief stub_aerosol_model_t defines the configuration of a simplified + !! aerosol package, which assumes no aerosols are present in the + !! atmosphere. + type, extends(aerosol_model_t) :: stub_aerosol_model_t + contains + procedure :: create_state => stub_aerosol_model_create_state + procedure :: optical_properties => stub_aerosol_model_optical_properties + end type stub_aerosol_model_t + + interface stub_aerosol_model_t + module procedure stub_aerosol_model_constructor + end interface stub_aerosol_model_t + + integer, parameter :: STUB_AEROSOL_INVALID_DIMENSION = 1 + integer, parameter :: STUB_AEROSOL_INVALID_STATE_TYPE = 2 + +contains + + !> @brief Constructor for stub_aerosol_model_t + !! @param parameters The parameters for the stub aerosol model. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The stub aerosol model instance. + function stub_aerosol_model_constructor(parameters, error_message, & + error_code) result(model) + type(stub_aerosol_model_t), pointer :: model + class(stub_aerosol_model_parameters_t), intent(in) :: parameters + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + error_message = '' + error_code = 0 + allocate(model, stat=error_code, errmsg=error_message) + if (error_code == 0) then + error_message = '' + end if + end function stub_aerosol_model_constructor + + !> @brief Create a new aerosol state for the stub aerosol model. + !! @param this The stub aerosol model instance. + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @return The aerosol state instance. + function stub_aerosol_model_create_state(this, number_of_columns, & + number_of_levels, error_message, error_code) result(aerosol_state) + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_stub_aerosol_state, only: stub_aerosol_state_t + class(stub_aerosol_model_t), intent(in) :: this + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + class(aerosol_state_t), pointer :: aerosol_state + error_message = '' + error_code = 0 + ! Create a new aerosol state for the stub aerosol model + aerosol_state => stub_aerosol_state_t(number_of_columns, number_of_levels, & + error_message, error_code) + end function stub_aerosol_model_create_state + + !> @brief Compute the optical properties of the aerosol for the stub aerosol model. + !! @param this The stub aerosol model instance. + !! @param state The aerosol state instance. + !! @param wavelengths The wavelengths at which to compute the optical properties. + !! @param error_message The error message if an error occurs. + !! @param error_code The error code if an error occurs. + !! @param extinction Parameterized specific extinction (m^2/kg) [column, level, wavelength]. + !! @param absorption Parameterized specific absorption (m^2/kg) [column, level, wavelength]. + !! @param scattering Single scattering albedo (unitless) [column, level, wavelength]. + !! @param asymmetry_factor Asymmetry factor (unitless) [column, level, wavelength]. + subroutine stub_aerosol_model_optical_properties(this, state, wavelengths, & + error_message, error_code, extinction, absorption, scattering, & + asymmetry_factor) + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_grid, only: grid_t + use musica_ccpp_stub_aerosol_state, only: stub_aerosol_state_t + class(stub_aerosol_model_t), intent(in) :: this + class(aerosol_state_t), intent(in) :: state + class(grid_t), intent(in) :: wavelengths + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk), optional, intent(out) :: extinction(:,:,:) + real(rk), optional, intent(out) :: absorption(:,:,:) + real(rk), optional, intent(out) :: scattering(:,:,:) + real(rk), optional, intent(out) :: asymmetry_factor(:,:,:) + error_message = '' + error_code = 0 + select type(state) + class is (stub_aerosol_state_t) + ! Compute the optical properties of the aerosol + ! (This model assumes no aerosols are present in the atmosphere, + ! so the optical properties are set to zero.) + if (present(extinction)) then + if (size(extinction, 1) /= state%number_of_columns() .or. & + size(extinction, 2) /= state%number_of_levels() .or. & + size(extinction, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for extinction' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + extinction = 0.0_rk + end if + if (present(absorption)) then + if (size(absorption, 1) /= state%number_of_columns() .or. & + size(absorption, 2) /= state%number_of_levels() .or. & + size(absorption, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for absorption' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + absorption = 0.0_rk + end if + if (present(scattering)) then + if (size(scattering, 1) /= state%number_of_columns() .or. & + size(scattering, 2) /= state%number_of_levels() .or. & + size(scattering, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for scattering' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + scattering = 0.0_rk + end if + if (present(asymmetry_factor)) then + if (size(asymmetry_factor, 1) /= state%number_of_columns() .or. & + size(asymmetry_factor, 2) /= state%number_of_levels() .or. & + size(asymmetry_factor, 3) /= wavelengths%number_of_sections()) then + error_message = 'Invalid dimensions for asymmetry factor' + error_code = STUB_AEROSOL_INVALID_DIMENSION + return + end if + asymmetry_factor = 0.0_rk + end if + class default + error_message = 'Invalid aerosol state type' + error_code = STUB_AEROSOL_INVALID_STATE_TYPE + end select + end subroutine stub_aerosol_model_optical_properties + +end module musica_ccpp_stub_aerosol_model \ No newline at end of file diff --git a/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 new file mode 100644 index 00000000..d719add8 --- /dev/null +++ b/schemes/musica/aerosol_stub/musica_ccpp_stub_aerosol_state.F90 @@ -0,0 +1,66 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_stub_aerosol_state + + use musica_ccpp_aerosol_state, only: aerosol_state_t + + implicit none + private + + public :: stub_aerosol_state_t + + !> stub_aerosol_state_t defines the state of an aerosol system according to + !! the aerosol representation of the stub aerosol package. + type, extends(aerosol_state_t) :: stub_aerosol_state_t + integer :: number_of_columns_ = 0 !< The number of columns in the model grid + integer :: number_of_levels_ = 0 !< The number of levels in the model grid + contains + procedure :: number_of_columns => stub_aerosol_state_number_of_columns + procedure :: number_of_levels => stub_aerosol_state_number_of_levels + end type stub_aerosol_state_t + + interface stub_aerosol_state_t + module procedure stub_aerosol_state_constructor + end interface stub_aerosol_state_t + +contains + + !> @brief Constructor for stub_aerosol_state_t + !! @param number_of_columns The number of columns in the model grid. + !! @param number_of_levels The number of levels in the model grid. + !! @return The stub aerosol state instance. + function stub_aerosol_state_constructor(number_of_columns, number_of_levels, & + error_message, error_code) result(state) + type(stub_aerosol_state_t), pointer :: state + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_levels + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + error_message = '' + error_code = 0 + allocate(state, stat=error_code, errmsg=error_message) + if (error_code /= 0) return + error_message = '' + state%number_of_columns_ = number_of_columns + state%number_of_levels_ = number_of_levels + end function stub_aerosol_state_constructor + + !> @brief Returns the number of columns in the model grid. + !! @param this The stub aerosol state instance. + !! @return The number of columns in the model grid. + function stub_aerosol_state_number_of_columns(this) result(number_of_columns) + class(stub_aerosol_state_t), intent(in) :: this + integer :: number_of_columns + number_of_columns = this%number_of_columns_ + end function stub_aerosol_state_number_of_columns + + !> @brief Returns the number of levels in the model grid. + !! @param this The stub aerosol state instance. + !! @return The number of levels in the model grid. + function stub_aerosol_state_number_of_levels(this) result(number_of_levels) + class(stub_aerosol_state_t), intent(in) :: this + integer :: number_of_levels + number_of_levels = this%number_of_levels_ + end function stub_aerosol_state_number_of_levels + +end module musica_ccpp_stub_aerosol_state \ No newline at end of file diff --git a/schemes/musica/util/musica_ccpp_grid.F90 b/schemes/musica/util/musica_ccpp_grid.F90 new file mode 100644 index 00000000..e5cd6166 --- /dev/null +++ b/schemes/musica/util/musica_ccpp_grid.F90 @@ -0,0 +1,148 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_grid + + use ccpp_kinds, only: rk => kind_phys + + implicit none + private + + public :: grid_t, GRID_INVALID + + !> grid_t defines the dimensions for gridded data used in the model. + type :: grid_t + real(rk), allocatable :: interfaces_(:) !< Interfaces between grid sections + real(rk), allocatable :: centers_(:) !< Centers of grid sections + contains + procedure :: number_of_sections => grid_size + end type grid_t + + interface grid_t + module procedure grid_constructor_interfaces + module procedure grid_constructor_interfaces_centers + module procedure grid_constructor_evenly_spaced + end interface grid_t + + integer, parameter :: GRID_INVALID = 1 + +contains + + !> @brief Constructor for grid_t based on interfaces only + !> @param interfaces The interfaces between grid sections + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_interfaces(interfaces, error_message, error_code) & + result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: interfaces(:) + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + integer :: i + error_code = 0 + error_message = '' + do i = 1, size(interfaces)-1 + if (interfaces(i) >= interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Interfaces must be in increasing order' + return + end if + end do + grid%interfaces_ = interfaces + grid%centers_ = 0.5_rk * (grid%interfaces_(1:size(interfaces)-1) & + + grid%interfaces_(2:size(interfaces))) + end function grid_constructor_interfaces + + !> @brief Constructor for grid_t based on interfaces and centers + !> @param interfaces The interfaces between grid sections + !> @param centers The centers of grid sections + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_interfaces_centers(interfaces, centers, & + error_message, error_code) result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: interfaces(:) + real(rk), intent(in) :: centers(:) + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + integer :: i + error_code = 0 + error_message = '' + if (size(interfaces) /= size(centers)+1) then + error_code = GRID_INVALID + error_message = 'Invalid dimensions for grid_t interfaces/centers' + end if + do i = 1, size(interfaces)-1 + if (interfaces(i) >= interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Interfaces must be in increasing order' + return + end if + if (centers(i) < interfaces(i) .or. & + centers(i) > interfaces(i+1)) then + error_code = GRID_INVALID + error_message = 'Centers must be within grid interfaces' + return + end if + end do + grid%interfaces_ = interfaces + grid%centers_ = centers + end function grid_constructor_interfaces_centers + + !> @brief Constructor for grid_t based on evenly spaced centers + !> @param start The start of the grid + !> @param end The end of the grid + !> @param number_of_sections The number of sections in the grid + !> @param error_message The error message if an error occurs + !> @param error_code The error code if an error occurs + !> @return The grid_t instance + function grid_constructor_evenly_spaced(start, end, number_of_sections, & + error_message, error_code) result(grid) + type(grid_t) :: grid + real(rk), intent(in) :: start + real(rk), intent(in) :: end + integer, intent(in) :: number_of_sections + character(len=512), intent(out) :: error_message + integer, intent(out) :: error_code + real(rk) :: delta + integer :: i + error_code = 0 + error_message = '' + if (number_of_sections < 1) then + error_code = GRID_INVALID + error_message = 'Number of sections must be at least 1' + return + end if + if (start >= end) then + error_code = GRID_INVALID + error_message = 'The start of the grid must be less than the end of the grid' + return + end if + delta = (end - start) / real(number_of_sections) + allocate(grid%interfaces_(number_of_sections+1), stat=error_code) + if (error_code /= 0) then + error_message = 'Failed to allocate memory for grid interfaces' + return + end if + allocate(grid%centers_(number_of_sections), stat=error_code) + if (error_code /= 0) then + error_message = 'Failed to allocate memory for grid centers' + return + end if + grid%interfaces_ = (/ (start + real(i-1) * delta, & + i=1, number_of_sections+1) /) + grid%centers_ = (/ (start + real(i-1) * delta + 0.5_rk * delta, & + i=1, number_of_sections) /) + end function grid_constructor_evenly_spaced + + !> @brief Get the number of sections in the grid + !> @param this The grid_t instance + !> @return The number of sections + function grid_size(this) result(number_of_sections) + class(grid_t), intent(in) :: this + integer :: number_of_sections + number_of_sections = size(this%interfaces_) - 1 + end function grid_size + +end module musica_ccpp_grid \ No newline at end of file diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/util/musica_ccpp_species.F90 similarity index 100% rename from schemes/musica/musica_ccpp_species.F90 rename to schemes/musica/util/musica_ccpp_species.F90 diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/util/musica_ccpp_util.F90 similarity index 100% rename from schemes/musica/musica_ccpp_util.F90 rename to schemes/musica/util/musica_ccpp_util.F90 diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index 4db52ecb..4f273563 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -55,6 +55,9 @@ file(GLOB MUSICA_CCPP_SOURCES ${MUSICA_SRC_PATH}/*.F90 ${MUSICA_SRC_PATH}/micm/*.F90 ${MUSICA_SRC_PATH}/tuvx/*.F90 + ${MUSICA_SRC_PATH}/util/*.F90 + ${MUSICA_SRC_PATH}/aerosol/*.F90 + ${MUSICA_SRC_PATH}/aerosol_stub/*.F90 ) target_sources(test_musica_api @@ -109,5 +112,8 @@ add_test( add_memory_check_test(test_musica_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) +add_subdirectory(aerosol) +add_subdirectory(aerosol_stub) add_subdirectory(micm) add_subdirectory(tuvx) +add_subdirectory(util) diff --git a/test/musica/README.md b/test/musica/README.md new file mode 100644 index 00000000..7ffa815d --- /dev/null +++ b/test/musica/README.md @@ -0,0 +1,11 @@ +MUSICA tests for CAM-SIMA Physics +================================= + +To build and run the MUSICA tests for CAM-SIMA in a Docker container, from the +top-level folder run: + +``` +docker build -t atmos-phys . -f test/docker/Docker.musica +docker run -it atmos-phys bash +make test +``` \ No newline at end of file diff --git a/test/musica/aerosol/CMakeLists.txt b/test/musica/aerosol/CMakeLists.txt new file mode 100644 index 00000000..3d849447 --- /dev/null +++ b/test/musica/aerosol/CMakeLists.txt @@ -0,0 +1,32 @@ +# MUSICA integration test for the abstract aerosol model +add_executable(test_musica_aerosol_model_mock_host mock_host.F90) + +target_sources(test_musica_aerosol_model_mock_host + PUBLIC + ${MUSICA_CCPP_SOURCES} + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ../musica_ccpp_namelist.F90 +) + +target_link_libraries(test_musica_aerosol_model_mock_host + PRIVATE + musica-fortran musica yaml-cpp stdc++ netcdff +) + +set_target_properties(test_musica_aerosol_model_mock_host + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_musica_aerosol_model_mock_host + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_musica_aerosol_model_mock_host $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file diff --git a/test/musica/aerosol/mock_host.F90 b/test/musica/aerosol/mock_host.F90 new file mode 100644 index 00000000..34a43fc6 --- /dev/null +++ b/test/musica/aerosol/mock_host.F90 @@ -0,0 +1,105 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +program mock_host + + use musica_ccpp_aerosol_model, only: aerosol_model_t + use musica_ccpp_aerosol_state, only: aerosol_state_t + +#define ASSERT(x) if (.not.(x)) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: x"; stop 1; endif +#define ASSERT_NEAR( a, b, abs_error ) if( (abs(a - b) >= abs_error) .and. (abs(a - b) /= 0.0) ) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: a, b"; stop 1; endif + + implicit none + + class(aerosol_model_t), pointer :: aerosol_model => null() + class(aerosol_state_t), pointer :: aerosol_state => null() + integer, parameter :: NUMBER_OF_COLUMNS = 1 + integer, parameter :: NUMBER_OF_LEVELS = 2 + integer :: i_time_step + + call initialize_aerosol_model(aerosol_model, aerosol_state) + do i_time_step = 1, 10 + ! Do something with the aerosol model and state + call calculate_radiation(aerosol_model, aerosol_state) + ! Maybe do something else with the aerosol model and state + end do + call finalize(aerosol_model, aerosol_state) + +contains + + subroutine initialize_aerosol_model(aerosol_model, aerosol_state) + use musica_ccpp_stub_aerosol_model, only: stub_aerosol_model_t, & + stub_aerosol_model_parameters_t + + class(aerosol_model_t), pointer, intent(inout) :: aerosol_model + class(aerosol_state_t), pointer, intent(inout) :: aerosol_state + + type(stub_aerosol_model_parameters_t) :: parameters + character(len=512) :: error_message + integer :: error_code + + ! initialize the aerosol model + parameters = stub_aerosol_model_parameters_t() + aerosol_model => stub_aerosol_model_t(parameters, error_message, error_code) + ASSERT( error_code == 0 ) + + ! create an aerosol state for the host model grid + aerosol_state => aerosol_model%create_state(NUMBER_OF_COLUMNS, & + NUMBER_OF_LEVELS, error_message, error_code) + ASSERT( error_code == 0 ) + end subroutine initialize_aerosol_model + + subroutine calculate_radiation(aerosol_model, aerosol_state) + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_grid, only: grid_t + use musica_ccpp_aerosol_state, only: aerosol_state_t + + class(aerosol_model_t), pointer, intent(inout) :: aerosol_model + class(aerosol_state_t), pointer, intent(inout) :: aerosol_state + + integer, parameter :: SW_WAVELENGTH_BINS = 3 + integer, parameter :: LW_WAVELENGTH_BINS = 5 + type(grid_t) :: short_wavelengths, long_wavelengths + real(rk) :: sw_ext(1,2,3), sw_abs(1,2,3), sw_sca(1,2,3), sw_asym(1,2,3) + real(rk) :: lw_ext(1,2,5) + character(len=512) :: error_message + integer :: error_code + + ! define the shortwave and longwave wavelengths + short_wavelengths = grid_t([0.5_rk, 1.0_rk, 1.5_rk, 2.0_rk]) + long_wavelengths = grid_t([5.0_rk, 10.0_rk, 15.0_rk, 20.0_rk, 25.0_rk, 30.0_rk]) + + ! compute the shortwave optical properties + call aerosol_model%optical_properties(aerosol_state, short_wavelengths, & + error_message, error_code, & + extinction = sw_ext, & + absorption = sw_abs, & + scattering = sw_sca, & + asymmetry_factor = sw_asym) + ASSERT( error_code == 0 ) + ! Do something with the shortwave optical properties + + ! compute the longwave optical properties + call aerosol_model%optical_properties(aerosol_state, long_wavelengths, & + error_message, error_code, & + extinction = lw_ext) + ASSERT( error_code == 0 ) + ! Do something with the longwave optical properties + end subroutine calculate_radiation + + subroutine finalize(aerosol_model, aerosol_state) + + class(aerosol_model_t), pointer, intent(inout) :: aerosol_model + class(aerosol_state_t), pointer, intent(inout) :: aerosol_state + + ! Clean up + if (associated(aerosol_state)) then + deallocate(aerosol_state) + aerosol_state => null() + end if + if (associated(aerosol_model)) then + deallocate(aerosol_model) + aerosol_model => null() + end if + end subroutine finalize + +end program mock_host \ No newline at end of file diff --git a/test/musica/aerosol_stub/CMakeLists.txt b/test/musica/aerosol_stub/CMakeLists.txt new file mode 100644 index 00000000..57d3118f --- /dev/null +++ b/test/musica/aerosol_stub/CMakeLists.txt @@ -0,0 +1,32 @@ +# MUSICA stub aerosol model tests +add_executable(test_stub_aerosol_model test_stub_aerosol_model.F90) + +target_sources(test_stub_aerosol_model + PUBLIC + ${MUSICA_CCPP_SOURCES} + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ../musica_ccpp_namelist.F90 +) + +target_link_libraries(test_stub_aerosol_model + PRIVATE + musica-fortran musica yaml-cpp stdc++ netcdff +) + +set_target_properties(test_stub_aerosol_model + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_stub_aerosol_model + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_stub_aerosol_model $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file diff --git a/test/musica/aerosol_stub/test_stub_aerosol_model.F90 b/test/musica/aerosol_stub/test_stub_aerosol_model.F90 new file mode 100644 index 00000000..f5914154 --- /dev/null +++ b/test/musica/aerosol_stub/test_stub_aerosol_model.F90 @@ -0,0 +1,99 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +program test_stub_aerosol_model + + use musica_ccpp_stub_aerosol_model, only: stub_aerosol_model_t, & + stub_aerosol_model_parameters_t, & + STUB_AEROSOL_INVALID_DIMENSION + +#define ASSERT(x) if (.not.(x)) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: x"; stop 1; endif +#define ASSERT_NEAR( a, b, abs_error ) if( (abs(a - b) >= abs_error) .and. (abs(a - b) /= 0.0) ) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: a, b"; stop 1; endif + + implicit none + + call test_stub_aerosol_model_create_state() + call test_stub_aerosol_model_optical_properties() + +contains + + !> @brief Test the stub_aerosol_model_create_state function + subroutine test_stub_aerosol_model_create_state() + use musica_ccpp_aerosol_state, only: aerosol_state_t + use musica_ccpp_stub_aerosol_state, only: stub_aerosol_state_t + type(stub_aerosol_model_t), pointer :: model + type(stub_aerosol_model_parameters_t) :: parameters + class(aerosol_state_t), pointer :: state + character(len=512) :: error_message + integer :: error_code + parameters = stub_aerosol_model_parameters_t() + model => stub_aerosol_model_t(parameters, error_message, error_code) + ASSERT( error_code == 0 ) + state => model%create_state(1, 2, error_message, error_code) + ASSERT( error_code == 0 ) + select type(state) + type is (stub_aerosol_state_t) + ASSERT( state%number_of_columns() == 1 ) + ASSERT( state%number_of_levels() == 2 ) + class default + ASSERT(.false.) + end select + deallocate(model) + deallocate(state) + end subroutine test_stub_aerosol_model_create_state + + !> @brief Test the stub_aerosol_model_optical_properties function + subroutine test_stub_aerosol_model_optical_properties() + use ccpp_kinds, only: rk => kind_phys + use musica_ccpp_grid, only: grid_t + use musica_ccpp_aerosol_state, only: aerosol_state_t + type(stub_aerosol_model_t), pointer :: model + type(stub_aerosol_model_parameters_t) :: parameters + class(aerosol_state_t), pointer :: state + type(grid_t) :: wavelengths + real(rk) :: optical_properties(1,2,2) + real(rk) :: optical_properties_wrong_dims(1,2,5) + character(len=512) :: error_message + integer :: error_code + parameters = stub_aerosol_model_parameters_t() + model => stub_aerosol_model_t(parameters, error_message, error_code) + ASSERT( error_code == 0 ) + state => model%create_state(1, 2, error_message, error_code) + ASSERT( error_code == 0 ) + wavelengths = grid_t([0.5_rk, 1.0_rk, 1.5_rk]) + optical_properties = -999.0_rk + call model%optical_properties(state, wavelengths, error_message, & + error_code, extinction = optical_properties) + ASSERT( error_code == 0 ) + ASSERT( all( optical_properties == 0.0_rk ) ) + call model%optical_properties(state, wavelengths, error_message, & + error_code, extinction = optical_properties_wrong_dims) + ASSERT( error_code == STUB_AEROSOL_INVALID_DIMENSION ) + optical_properties = -999.0_rk + call model%optical_properties(state, wavelengths, error_message, & + error_code, absorption = optical_properties) + ASSERT( error_code == 0 ) + ASSERT( all( optical_properties == 0.0_rk ) ) + call model%optical_properties(state, wavelengths, error_message, & + error_code, absorption = optical_properties_wrong_dims) + ASSERT( error_code == STUB_AEROSOL_INVALID_DIMENSION ) + optical_properties = -999.0_rk + call model%optical_properties(state, wavelengths, error_message, & + error_code, scattering = optical_properties) + ASSERT( error_code == 0 ) + ASSERT( all( optical_properties == 0.0_rk ) ) + call model%optical_properties(state, wavelengths, error_message, & + error_code, scattering = optical_properties_wrong_dims) + ASSERT( error_code == STUB_AEROSOL_INVALID_DIMENSION ) + optical_properties = -999.0_rk + call model%optical_properties(state, wavelengths, error_message, & + error_code, asymmetry_factor = optical_properties) + ASSERT( error_code == 0 ) + ASSERT( all( optical_properties == 0.0_rk ) ) + call model%optical_properties(state, wavelengths, error_message, & + error_code, asymmetry_factor = optical_properties_wrong_dims) + ASSERT( error_code == STUB_AEROSOL_INVALID_DIMENSION ) + deallocate(model) + deallocate(state) + end subroutine test_stub_aerosol_model_optical_properties + +end program test_stub_aerosol_model \ No newline at end of file diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index c8571a9c..0242cad5 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -4,7 +4,7 @@ add_executable(test_tuvx_height_grid test_tuvx_height_grid.F90) target_sources(test_tuvx_height_grid PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -27,7 +27,7 @@ add_executable(test_tuvx_wavelength_grid test_tuvx_wavelength_grid.F90) target_sources(test_tuvx_wavelength_grid PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -51,7 +51,7 @@ target_sources(test_tuvx_temperature PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_temperature.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -75,7 +75,7 @@ target_sources(test_tuvx_surface_albedo PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_surface_albedo.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -99,7 +99,7 @@ target_sources(test_tuvx_extraterrestrial_flux PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -125,7 +125,7 @@ target_sources(test_tuvx_cloud_optics ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_cloud_optics.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -151,7 +151,7 @@ target_sources(test_tuvx_aerosol_optics ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_aerosol_optics.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -203,8 +203,8 @@ target_sources(test_tuvx_load_species PUBLIC ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_load_species.F90 ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_gas_species.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_species.F90 - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_species.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 ${CCPP_SRC_PATH}/ccpp_hash_table.F90 diff --git a/test/musica/util/CMakeLists.txt b/test/musica/util/CMakeLists.txt new file mode 100644 index 00000000..6484f1c9 --- /dev/null +++ b/test/musica/util/CMakeLists.txt @@ -0,0 +1,32 @@ +# MUSICA grid test +add_executable(test_musica_grid test_musica_grid.F90) + +target_sources(test_musica_grid + PUBLIC + ${MUSICA_CCPP_SOURCES} + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ../musica_ccpp_namelist.F90 +) + +target_link_libraries(test_musica_grid + PRIVATE + musica-fortran musica yaml-cpp stdc++ netcdff +) + +set_target_properties(test_musica_grid + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_musica_grid + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_musica_grid $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) diff --git a/test/musica/util/test_musica_grid.F90 b/test/musica/util/test_musica_grid.F90 new file mode 100644 index 00000000..a54ab746 --- /dev/null +++ b/test/musica/util/test_musica_grid.F90 @@ -0,0 +1,106 @@ +! Copyright (C) 2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +program test_musica_grid + + use musica_ccpp_grid, only: grid_t, GRID_INVALID + +#define ASSERT(x) if (.not.(x)) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: x"; stop 1; endif +#define ASSERT_NEAR( a, b, abs_error ) if( (abs(a - b) >= abs_error) .and. (abs(a - b) /= 0.0) ) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: a, b"; stop 1; endif + + implicit none + + call test_grid_constructor_interfaces() + call test_grid_constructor_interfaces_centers() + call test_grid_constructor_evenly_spaced() + +contains + + !> @brief Test the grid_constructor_interfaces function + subroutine test_grid_constructor_interfaces() + use ccpp_kinds, only: rk => kind_phys + type(grid_t) :: grid + real(rk) :: interfaces(3) + character(len=512) :: error + integer :: error_code + interfaces = [1.0_rk, 2.0_rk, 3.0_rk] + + ! Check for valid interfaces + grid = grid_t(interfaces, error, error_code) + ASSERT( error_code == 0 ) + ASSERT( size(grid%interfaces_) == 3 ) + ASSERT_NEAR( grid%interfaces_(1), 1.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(2), 2.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(3), 3.0_rk, 1.0e-6_rk ) + ASSERT( size(grid%centers_) == 2 ) + ASSERT_NEAR( grid%centers_(1), 1.5_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%centers_(2), 2.5_rk, 1.0e-6_rk ) + + ! Check for invalid interfaces + grid = grid_t([1.0_rk, 3.0_rk, 2.0_rk], error, error_code) + ASSERT( error_code == GRID_INVALID ) + end subroutine test_grid_constructor_interfaces + + !> @brief Test the grid_constructor_interfaces_centers function + subroutine test_grid_constructor_interfaces_centers() + use ccpp_kinds, only: rk => kind_phys + type(grid_t) :: grid + real(rk) :: interfaces(3) + real(rk) :: centers(2) + character(len=512) :: error + integer :: error_code + interfaces = [1.0_rk, 2.0_rk, 3.0_rk] + centers = [1.6_rk, 2.7_rk] + + ! Check for valid interfaces and centers + grid = grid_t(interfaces, centers, error, error_code) + ASSERT( error_code == 0 ) + ASSERT( size(grid%interfaces_) == 3 ) + ASSERT_NEAR( grid%interfaces_(1), 1.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(2), 2.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(3), 3.0_rk, 1.0e-6_rk ) + ASSERT( size(grid%centers_) == 2 ) + ASSERT_NEAR( grid%centers_(1), 1.6_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%centers_(2), 2.7_rk, 1.0e-6_rk ) + + ! Check for bad dimensions + grid = grid_t(interfaces, [1.5_rk], error, error_code) + ASSERT( error_code == GRID_INVALID) + + ! Check for invalid interfaces + grid = grid_t([1.0_rk, 3.0_rk, 2.0_rk], centers, error, error_code) + ASSERT( error_code == GRID_INVALID ) + + ! Check for invalid centers + grid = grid_t(interfaces, [1.5_rk, 1.9_rk], error, error_code) + ASSERT( error_code == GRID_INVALID ) + end subroutine test_grid_constructor_interfaces_centers + + !> @brief Test the grid_constructor_evenly_spaced function + subroutine test_grid_constructor_evenly_spaced() + use ccpp_kinds, only: rk => kind_phys + type(grid_t) :: grid + real(rk) :: start, end + integer :: number_of_sections + character(len=512) :: error + integer :: error_code + start = 1.0_rk + end = 3.0_rk + number_of_sections = 2 + + ! Check for valid start, end, and number of sections + grid = grid_t(start, end, number_of_sections, error, error_code) + ASSERT( error_code == 0 ) + ASSERT( size(grid%interfaces_) == 3 ) + ASSERT_NEAR( grid%interfaces_(1), 1.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(2), 2.0_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%interfaces_(3), 3.0_rk, 1.0e-6_rk ) + ASSERT( size(grid%centers_) == 2 ) + ASSERT_NEAR( grid%centers_(1), 1.5_rk, 1.0e-6_rk ) + ASSERT_NEAR( grid%centers_(2), 2.5_rk, 1.0e-6_rk ) + + ! Check for invalid start, end, and delta + grid = grid_t(3.0_rk, 1.0_rk, 1, error, error_code) + ASSERT( error_code == GRID_INVALID ) + end subroutine test_grid_constructor_evenly_spaced + +end program test_musica_grid \ No newline at end of file From 36f336e876ece9fcfcb97a29cf1785d172a5252d Mon Sep 17 00:00:00 2001 From: cacraigucar Date: Fri, 18 Apr 2025 10:26:06 -0600 Subject: [PATCH 02/11] Fix broken dme_adjust tests (#237) Originator(s):cacraig Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): - During CAM-SIMA regression testing, a number of issues were discovered. This PR fixes them - Needed to introduce a regression test for dme_adjust - Forgot to comment out dme_adjust in a couple of suites (see #222 ) - Inadvertently removed a scheme from TJ16 List all namelist files that were added or changed: N/A List all files eliminated and why: N/A List all files added and what they do: N/A List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) M schemes/conservation_adjust/check_energy/check_energy_chng.meta M schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta - Change relative location for dependencies due to introduction of a new subdirectory layer M suites/suite_cam4.xml M suites/suite_cam7.xml M suites/suite_kessler.xml M suites/suite_tj2016.xml - comment out and/or augment comment for dme_adjust (see #222) M test/test_suites/suite_dme_adjust.xml - Add diagnostics scheme so there are baselines for dme_adjust List all automated tests that failed, as well as an explanation for why they weren't fixed: N/A Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? N/A If yes to the above question, describe how this code was validated with the new/modified features: N/A --- .../conservation_adjust/check_energy/check_energy_chng.meta | 2 +- .../check_energy/check_energy_gmean/check_energy_gmean.meta | 2 +- suites/suite_cam4.xml | 4 +++- suites/suite_cam7.xml | 4 +++- suites/suite_kessler.xml | 1 + suites/suite_tj2016.xml | 2 ++ test/test_suites/suite_dme_adjust.xml | 1 + 7 files changed, 12 insertions(+), 4 deletions(-) diff --git a/schemes/conservation_adjust/check_energy/check_energy_chng.meta b/schemes/conservation_adjust/check_energy/check_energy_chng.meta index d673c9a1..b9bc0b9e 100644 --- a/schemes/conservation_adjust/check_energy/check_energy_chng.meta +++ b/schemes/conservation_adjust/check_energy/check_energy_chng.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = check_energy_chng type = scheme - dependencies = ../../../../data/cam_thermo.F90,../../../../data/cam_thermo_formula.F90 + dependencies = ../../../../../data/cam_thermo.F90,../../../../../data/cam_thermo_formula.F90 [ccpp-arg-table] diff --git a/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta b/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta index 9567f6ee..9cf4a5a0 100644 --- a/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta +++ b/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = check_energy_gmean type = scheme - dependencies = ../../../../../utils/gmean_mod.F90 + dependencies = ../../../../../../utils/gmean_mod.F90 [ccpp-arg-table] name = check_energy_gmean_run diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml index dec0a682..9c2c943b 100644 --- a/suites/suite_cam4.xml +++ b/suites/suite_cam4.xml @@ -155,7 +155,9 @@ check_energy_save_teout - dme_adjust + + + - dme_adjust + + + + + thermo_water_update + + + + char*512 + file_io_test + file_io_test + filename_of_rrtmgp_shortwave_coefficients + none + + A shortwave coefficients file for RRTMGP + (to use for testing CCPP File I/O capabilities). + + + ${SRCROOT}/src/physics/utils/rrtmgp-data/rrtmgp-gas-sw-g112.nc + + + diff --git a/test/test_suites/suite_file_io_test.xml b/test/test_suites/suite_file_io_test.xml new file mode 100644 index 00000000..211c47a1 --- /dev/null +++ b/test/test_suites/suite_file_io_test.xml @@ -0,0 +1,8 @@ + + + + + + file_io_test + + From bb7c61028c1d6ead2c09b2c58cfbbfb3c3638a51 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 16 May 2025 13:57:36 -0600 Subject: [PATCH 05/11] Break up file i/o object into explicit interfaces (#248) Originator(s): peverwhee Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): Unfortunately, due to inconsistent compiler support, this PR removes the fancy assumed rank parts of the file i/o object and replaces them with an interface for each dimension/type. List all namelist files that were added or changed: n/a List all files eliminated and why: n/a List all files added and what they do: n/a List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) M phys_utils/ccpp_io_reader.F90 - Break into dimension-specific interfaces List all automated tests that failed, as well as an explanation for why they weren't fixed: n/a Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? No If yes to the above question, describe how this code was validated with the new/modified features: --- phys_utils/ccpp_io_reader.F90 | 212 +++++++++++++++++++++++++++++++--- 1 file changed, 198 insertions(+), 14 deletions(-) diff --git a/phys_utils/ccpp_io_reader.F90 b/phys_utils/ccpp_io_reader.F90 index 2258784e..6f206736 100644 --- a/phys_utils/ccpp_io_reader.F90 +++ b/phys_utils/ccpp_io_reader.F90 @@ -9,11 +9,28 @@ module ccpp_io_reader contains procedure(open_file), deferred :: open_file procedure(close_file), deferred :: close_file - procedure(get_var_int), deferred :: get_var_int - procedure(get_var_real), deferred :: get_var_real - procedure(get_var_char), deferred :: get_var_char + procedure(get_var_int_0d), deferred :: get_var_int_0d + procedure(get_var_int_1d), deferred :: get_var_int_1d + procedure(get_var_int_2d), deferred :: get_var_int_2d + procedure(get_var_int_3d), deferred :: get_var_int_3d + procedure(get_var_int_4d), deferred :: get_var_int_4d + procedure(get_var_int_5d), deferred :: get_var_int_5d + procedure(get_var_real_0d), deferred :: get_var_real_0d + procedure(get_var_real_1d), deferred :: get_var_real_1d + procedure(get_var_real_2d), deferred :: get_var_real_2d + procedure(get_var_real_3d), deferred :: get_var_real_3d + procedure(get_var_real_4d), deferred :: get_var_real_4d + procedure(get_var_real_5d), deferred :: get_var_real_5d + procedure(get_var_char_0d), deferred :: get_var_char_0d + procedure(get_var_char_1d), deferred :: get_var_char_1d + procedure(get_var_char_2d), deferred :: get_var_char_2d + procedure(get_var_char_3d), deferred :: get_var_char_3d + procedure(get_var_char_4d), deferred :: get_var_char_4d + procedure(get_var_char_5d), deferred :: get_var_char_5d - generic :: get_var => get_var_int, get_var_real, get_var_char + generic :: get_var => get_var_int_0d, get_var_int_1d, get_var_int_2d, get_var_int_3d, get_var_int_4d, get_var_int_5d, & + get_var_real_0d, get_var_real_1d, get_var_real_2d, get_var_real_3d, get_var_real_4d, get_var_real_5d, & + get_var_char_0d, get_var_char_1d, get_var_char_2d, get_var_char_3d, get_var_char_4d, get_var_char_5d end type abstract_netcdf_reader_t interface @@ -38,37 +55,204 @@ subroutine close_file(this, errmsg, errcode) integer, intent(out) :: errcode !Error code end subroutine close_file - subroutine get_var_int(this, varname, var, errmsg, errcode) + ! ------------------------------------------------------------------ + ! Integer interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_int_0d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_0d + + subroutine get_var_int_1d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_1d + + subroutine get_var_int_2d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:)!Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_2d + + subroutine get_var_int_3d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_3d + + subroutine get_var_int_4d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_4d + + subroutine get_var_int_5d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + integer, pointer, intent(out) :: var(:,:,:,:,:) !Integer variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_int_5d + + ! ------------------------------------------------------------------ + ! Real interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_real_0d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_0d + + subroutine get_var_real_1d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_1d + + subroutine get_var_real_2d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys import abstract_netcdf_reader_t class(abstract_netcdf_reader_t), intent(in) :: this character(len=*), intent(in) :: varname - integer, pointer, intent(out) :: var(..) !Integer variable that file data will be read to. + real(kind_phys), pointer, intent(out) :: var(:,:)!Floating-point variable that file data will be read to. character(len=*), intent(out) :: errmsg !Error message integer, intent(out) :: errcode !Error code - end subroutine get_var_int + end subroutine get_var_real_2d + + subroutine get_var_real_3d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_3d + + subroutine get_var_real_4d(this, varname, var, errmsg, errcode) + use ccpp_kinds, only: kind_phys + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + real(kind_phys), pointer, intent(out) :: var(:,:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_4d - subroutine get_var_real(this, varname, var, errmsg, errcode) + subroutine get_var_real_5d(this, varname, var, errmsg, errcode) use ccpp_kinds, only: kind_phys import abstract_netcdf_reader_t class(abstract_netcdf_reader_t), intent(in) :: this character(len=*), intent(in) :: varname - real(kind_phys), pointer, intent(out) :: var(..) !Floating-point variable that file data will be read to. + real(kind_phys), pointer, intent(out) :: var(:,:,:,:,:) !Floating-point variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_real_5d + + ! ------------------------------------------------------------------ + ! Character interfaces + ! ------------------------------------------------------------------ + + subroutine get_var_char_0d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_0d + + subroutine get_var_char_1d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:) !Character variable that file data will be read to. character(len=*), intent(out) :: errmsg !Error message integer, intent(out) :: errcode !Error code - end subroutine get_var_real + end subroutine get_var_char_1d - subroutine get_var_char(this, varname, var, errmsg, errcode) + subroutine get_var_char_2d(this, varname, var, errmsg, errcode) import abstract_netcdf_reader_t class(abstract_netcdf_reader_t), intent(in) :: this character(len=*), intent(in) :: varname - character(len=:), pointer, intent(out) :: var(..) !Character variable that file data will be read to. + character(len=:), pointer, intent(out) :: var(:,:)!Character variable that file data will be read to. character(len=*), intent(out) :: errmsg !Error message integer, intent(out) :: errcode !Error code - end subroutine get_var_char - + end subroutine get_var_char_2d + + subroutine get_var_char_3d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_3d + + subroutine get_var_char_4d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_4d + + subroutine get_var_char_5d(this, varname, var, errmsg, errcode) + import abstract_netcdf_reader_t + + class(abstract_netcdf_reader_t), intent(in) :: this + character(len=*), intent(in) :: varname + character(len=:), pointer, intent(out) :: var(:,:,:,:,:) !Character variable that file data will be read to. + character(len=*), intent(out) :: errmsg !Error message + integer, intent(out) :: errcode !Error code + end subroutine get_var_char_5d + end interface end module ccpp_io_reader From b0284d4675c34f792e21ab316eb1db1ee96b07c4 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 28 May 2025 12:34:24 -0700 Subject: [PATCH 06/11] Update MUSICA library (#249) Originator(s): Matt Dawson Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): Updates to use the latest version of the MUSICA library. closes #246 - Uses new MICM state type for directly interacting with MICM state data, avoiding copies. - Allows use of vectorizable matrix with Rosenbrock or Backward Euler solver - Removes double creation of MICM solver now that the number of grid cells is only needed when creating a MICM state, instead of when the solver is created - Adds an integration test for an analytical chemistry system using various numbers of grid cells and both solver types. - Runs MUSICA tests on pushes to main and development, instead of just on PRs to be consistent with other unit testing List all namelist files that were added or changed: none List all files eliminated and why: none List all files added and what they do: test code and configuration files List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) musica scheme files and tests only List all automated tests that failed, as well as an explanation for why they weren't fixed: none Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? no If yes to the above question, describe how this code was validated with the new/modified features: --- .github/workflows/test.yaml | 8 +- schemes/musica/micm/musica_ccpp_micm.F90 | 173 ++++++++--- schemes/musica/micm/musica_ccpp_micm_util.F90 | 148 ++++++--- schemes/musica/musica_ccpp.F90 | 139 +++++---- schemes/musica/musica_ccpp.meta | 10 +- schemes/musica/musica_ccpp_namelist.xml | 6 +- schemes/musica/util/musica_ccpp_util.F90 | 12 +- test/docker/Dockerfile.musica | 2 +- test/docker/Dockerfile.musica.no_install | 2 +- test/musica/CMakeLists.txt | 10 +- test/musica/aerosol/CMakeLists.txt | 2 +- test/musica/aerosol_stub/CMakeLists.txt | 2 +- .../configuration/analytical/config.json | 6 + .../configuration/analytical/reactions.json | 71 +++++ .../configuration/analytical/species.json | 40 +++ .../configuration/micm_util/config.json | 6 + .../configuration/micm_util/reactions.json | 70 +++++ .../configuration/micm_util/species.json | 24 ++ test/musica/micm/CMakeLists.txt | 5 +- test/musica/micm/test_micm_mock_mods.F90 | 14 + test/musica/micm/test_micm_util.F90 | 88 ++++-- test/musica/musica_ccpp_namelist.F90 | 2 +- test/musica/test_musica_api.F90 | 280 +++++++++++++++++- test/musica/tuvx/CMakeLists.txt | 18 +- test/musica/tuvx/test_tuvx_gas_species.F90 | 5 +- test/musica/util/CMakeLists.txt | 2 +- 26 files changed, 928 insertions(+), 217 deletions(-) create mode 100644 test/musica/configuration/analytical/config.json create mode 100644 test/musica/configuration/analytical/reactions.json create mode 100644 test/musica/configuration/analytical/species.json create mode 100644 test/musica/configuration/micm_util/config.json create mode 100644 test/musica/configuration/micm_util/reactions.json create mode 100644 test/musica/configuration/micm_util/species.json create mode 100644 test/musica/micm/test_micm_mock_mods.F90 diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index f24b9a19..e4190b79 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -1,6 +1,12 @@ name: build -on: [pull_request,workflow_dispatch] +on: + push: + branches: + - main + - development + workflow_dispatch: + pull_request: jobs: test_musica_api: diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 457c1cb4..cc9f8f09 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -7,7 +7,9 @@ module musica_ccpp_micm use ccpp_kinds, only: kind_phys use musica_ccpp_util, only: has_error_occurred use musica_ccpp_namelist, only: filename_of_micm_configuration - use musica_micm, only: micm_t + use musica_micm, only: micm_t, solver_stats_t, Rosenbrock + use musica_state, only: conditions_t, state_t + use musica_util, only: mappings_t implicit none private @@ -15,21 +17,37 @@ module musica_ccpp_micm public :: micm_register, micm_init, micm_run, micm_final - type(micm_t), pointer, public :: micm => null( ) - integer, public :: number_of_rate_parameters = 0 + !> MICM solver. The solver will be configured for a specific chemical mechanism. + !! It then can be used to create and solve MICM states for the mechanism and a + !! given number of grid cells. + type(micm_t), pointer :: micm => null( ) + !> For optimal performance, the grid cells assigned to any particular MPI rank + !! are solved in sets of a fixed size specified at build time. If the total number + !! of grid cells is not evenly divisible by the set size, an additional state + !! is created to handle the residual grid cells. + !! If the number of grid cells is less than the optimal set size, only the first + !! state is created and used. + type(state_t), pointer :: state_1 => null( ) ! state for the optimal set of grid cells + type(state_t), pointer :: state_2 => null( ) ! state for the residual grid cells + integer :: number_of_grid_cells = 0 + + type(mappings_t), public, protected :: species_ordering + type(mappings_t), public, protected :: rate_parameters_ordering + + integer, parameter :: SOLVER_TYPE_ROSENBROCK = 1 + integer, parameter :: SOLVER_TYPE_BACKWARD_EULER = 3 + integer, parameter :: ONE_GRID_CELL = 1 contains !> Registers MICM constituent properties with the CCPP - subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & - micm_species, errmsg, errcode) + subroutine micm_register(solver_type, constituent_props, micm_species, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t use musica_util, only: error_t use iso_c_binding, only: c_int - integer(c_int), intent(in) :: solver_type - integer(c_int), intent(in) :: number_of_grid_cells + character(len=*), intent(in) :: solver_type type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) type(musica_species_t), allocatable, intent(out) :: micm_species(:) character(len=512), intent(out) :: errmsg @@ -41,17 +59,29 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & character(len=:), allocatable :: species_name logical :: is_advected integer :: number_of_species - integer :: i, species_index + integer :: i, species_index, solver_type_int + type(state_t), pointer :: state if (associated( micm )) then deallocate( micm ) micm => null() end if - micm => micm_t(trim(filename_of_micm_configuration), solver_type, & - number_of_grid_cells, error) + if (trim(solver_type) == 'Rosenbrock') then + solver_type_int = SOLVER_TYPE_ROSENBROCK + else if (trim(solver_type) == 'Backward Euler') then + solver_type_int = SOLVER_TYPE_BACKWARD_EULER + else + errmsg = "[MUSICA Error] Invalid solver type. Supported types: 'Rosenbrock', 'Backward Euler'." // & + " Got: '" // trim(solver_type) // "'." + errcode = 1 + return + end if + micm => micm_t(trim(filename_of_micm_configuration), solver_type_int, error) + if (has_error_occurred(error, errmsg, errcode)) return + state => micm%get_state(ONE_GRID_CELL, error) if (has_error_occurred(error, errmsg, errcode)) return - number_of_species = micm%species_ordering%size() + number_of_species = state%species_ordering%size() allocate(constituent_props(number_of_species), stat=errcode) if (errcode /= 0) then errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties." @@ -65,7 +95,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & end if do i = 1, number_of_species - associate( map => micm%species_ordering ) + associate( map => state%species_ordering ) species_name = map%name(i) species_index = map%index(i) @@ -99,51 +129,108 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & index_musica_species = species_index ) end associate ! map end do - number_of_rate_parameters = micm%user_defined_reaction_rates%size() + species_ordering = state%species_ordering + rate_parameters_ordering = state%rate_parameters_ordering + deallocate( state ) end subroutine micm_register !> Initializes MICM - subroutine micm_init(errmsg, errcode) + subroutine micm_init(n_grid_cells, errmsg, errcode) + use musica_util, only: error_t + + integer, intent(in) :: n_grid_cells character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + integer :: max_grid_cells, size_1, size_2 + type(error_t) :: error + errmsg = '' errcode = 0 + if (.not. associated( micm )) then + errmsg = "[MUSICA Error] MICM not registered. Call micm_register first." + errcode = 1 + return + end if + if (n_grid_cells <= 0) then + errmsg = "[MUSICA Error] Invalid number of grid cells." + errcode = 1 + return + end if + number_of_grid_cells = n_grid_cells + max_grid_cells = micm%get_maximum_number_of_grid_cells( ) + size_1 = min( number_of_grid_cells, max_grid_cells ) + size_2 = mod( number_of_grid_cells - size_1, max_grid_cells ) + state_1 => micm%get_state( size_1, error ) + if (has_error_occurred(error, errmsg, errcode)) return + if (size_2 > 0) then + state_2 => micm%get_state( size_2, error ) + if (has_error_occurred(error, errmsg, errcode)) return + end if + end subroutine micm_init !> Solves chemistry at the current time step subroutine micm_run(time_step, temperature, pressure, dry_air_density, & - user_defined_rate_parameters, constituents, errmsg, errcode) - use musica_micm, only: solver_stats_t - use musica_util, only: string_t, error_t - use iso_c_binding, only: c_double, c_loc - - real(kind_phys), intent(in) :: time_step ! s - real(kind_phys), target, intent(in) :: temperature(:,:) ! K - real(kind_phys), target, intent(in) :: pressure(:,:) ! Pa - real(kind_phys), target, intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), target, intent(in) :: user_defined_rate_parameters(:,:,:) ! various units - real(kind_phys), target, intent(inout) :: constituents(:,:,:) ! mol m-3 + rate_parameters, mixing_ratios, errmsg, errcode) + use musica_ccpp_micm_util, only: update_micm_state, extract_mixing_ratios_from_state + use musica_micm, only: solver_stats_t + use musica_util, only: string_t, error_t + use iso_c_binding, only: c_double, c_loc + + real(kind_phys), intent(in) :: time_step ! s + real(kind_phys), target, intent(in) :: temperature(:,:) ! K + real(kind_phys), target, intent(in) :: pressure(:,:) ! Pa + real(kind_phys), target, intent(in) :: dry_air_density(:,:) ! kg m-3 + real(kind_phys), target, intent(in) :: rate_parameters(:,:,:) ! various units + real(kind_phys), target, intent(inout) :: mixing_ratios(:,:,:) ! kg kg-1 character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables - type(string_t) :: solver_state - type(solver_stats_t) :: solver_stats - type(error_t) :: error - - call micm%solve(real(time_step, kind=c_double), & - c_loc(temperature), & - c_loc(pressure), & - c_loc(dry_air_density), & - c_loc(constituents), & - c_loc(user_defined_rate_parameters), & - solver_state, & - solver_stats, & - error) - if (has_error_occurred(error, errmsg, errcode)) return + integer :: max_cells, i_state, state_size, state_1_size, offset + type(state_t), pointer :: state + type(string_t) :: solver_state + type(solver_stats_t) :: solver_stats + type(error_t) :: error + + state_1_size = state_1%number_of_grid_cells + do i_state = 1, ceiling( real( number_of_grid_cells ) / state_1_size ) + + ! Determine which state to use for the current iteration + state_size = min( number_of_grid_cells - ( i_state - 1 ) * state_1_size, & + state_1_size ) + if ( state_size == state_1_size ) then + state => state_1 ! use the main state for the optimal number of grid cells + else + state => state_2 ! use the residual state for the remaining grid cells + if (.not. associated( state )) then + errmsg = "[MUSICA Error] Internal error. MICM residual state not initialized." + errcode = 1 + return + end if + if (state%number_of_grid_cells /= state_size) then + errmsg = "[MUSICA Error] Internal error. MICM residual state size mismatch." + errcode = 1 + return + end if + end if + offset = ( i_state - 1 ) * state_1_size ! number of grid cells already updated + + ! Update MICM state with the current conditions and mixing ratios + call update_micm_state( state, offset, temperature, pressure, dry_air_density, & + mixing_ratios, rate_parameters ) + + ! Solve the system + call micm%solve( time_step, state, solver_state, solver_stats, error ) + if (has_error_occurred(error, errmsg, errcode)) return + + ! Update the mixing ratios with the results + call extract_mixing_ratios_from_state( state, offset, mixing_ratios) + + end do end subroutine micm_run @@ -155,6 +242,14 @@ subroutine micm_final(errmsg, errcode) errmsg = '' errcode = 0 + if (associated( state_1 )) then + deallocate( state_1 ) + state_1 => null() + end if + if (associated( state_2 )) then + deallocate( state_2 ) + state_2 => null() + end if if (associated( micm )) then deallocate( micm ) micm => null() diff --git a/schemes/musica/micm/musica_ccpp_micm_util.F90 b/schemes/musica/micm/musica_ccpp_micm_util.F90 index fe9525eb..5322cb30 100644 --- a/schemes/musica/micm/musica_ccpp_micm_util.F90 +++ b/schemes/musica/micm/musica_ccpp_micm_util.F90 @@ -1,68 +1,120 @@ ! Copyright (C) 2024-2025 University Corporation for Atmospheric Research ! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_micm_util - implicit none + use ccpp_kinds, only: kind_phys + + implicit none private - public :: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio + + public :: update_micm_state, extract_mixing_ratios_from_state contains - ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) - subroutine convert_to_mol_per_cubic_meter(dry_air_density, molar_mass_arr, constituents) - use ccpp_kinds, only: kind_phys - - real(kind_phys), intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), intent(in) :: molar_mass_arr(:) ! kg mol-1 - real(kind_phys), intent(inout) :: constituents(:,:,:) ! in: kg kg-1 | out: mol m-3 - - ! local variables - integer :: num_columns, num_layers, num_constituents - integer :: i_column, i_layer, i_elem - real(kind_phys) :: val - - num_columns = size(constituents, dim=1) - num_layers = size(constituents, dim=2) - num_constituents = size(constituents, dim=3) - - do i_elem = 1, num_constituents - do i_layer = 1, num_layers - do i_column = 1, num_columns - val = constituents(i_column, i_layer, i_elem) * dry_air_density(i_column, i_layer) & - / molar_mass_arr(i_elem) - constituents(i_column, i_layer, i_elem) = val - end do + !> Populate a MICM state object with conditions from CCPP variables + !! + !! The state object is populated with data from the first grid cell that has not + !! yet been added to a MICM state. Indices for chemical species are mapped from + !! the CCPP constituent ordering to the MICM species ordering. Mass mixing ratios + !! are converted to number density (mol m-3) using the dry air density and + !! molecular weights of the species. + subroutine update_micm_state(state, state_data_offset, temperature, pressure, & + dry_air_mass_density, mixing_ratios, rate_parameters) + + use musica_ccpp_species, only: micm_indices_constituent_props, micm_molar_mass_array + use musica_ccpp_util, only: MOLAR_MASS_DRY_AIR + use musica_state, only: state_t + + type(state_t), intent(inout) :: state + integer, intent(in) :: state_data_offset ! number of grid cells already updated + real(kind_phys), target, contiguous, intent(in) :: temperature(:,:) ! K (column, layer) + real(kind_phys), target, contiguous, intent(in) :: pressure(:,:) ! Pa (column, layer) + real(kind_phys), target, contiguous, intent(in) :: dry_air_mass_density(:,:) ! kg m-3 (column, layer) + real(kind_phys), target, contiguous, intent(in) :: mixing_ratios(:,:,:) ! kg kg-1 (column, layer, species) + real(kind_phys), target, contiguous, intent(in) :: rate_parameters(:,:,:) ! various units (column, layer, parameter) + + integer :: i_cell, i_var, state_offset, n_cells, n_cells_total + real(kind_phys), pointer :: temperature_1D(:), pressure_1D(:), air_density_1D(:), & + species_1D(:), params_1D(:) + + ! get grid cell dimensions + n_cells = state%number_of_grid_cells + n_cells_total = size(temperature, 1) * size(temperature, 2) + + ! Update environmental conditions + ! collapse 2D arrays to 1D + ! (column, layer) -> (column*layer) + temperature_1D(1:n_cells_total) => temperature(:,:) + pressure_1D(1:n_cells_total) => pressure(:,:) + air_density_1D(1:n_cells_total) => dry_air_mass_density(:,:) + do i_cell = 1, n_cells + state%conditions(i_cell)%temperature = temperature_1D(i_cell + state_data_offset) + state%conditions(i_cell)%pressure = pressure_1D(i_cell + state_data_offset) + state%conditions(i_cell)%air_density = air_density_1D(i_cell + state_data_offset) / MOLAR_MASS_DRY_AIR + end do + + ! Update species concentrations + associate(cell_stride => state%species_strides%grid_cell, & + var_stride => state%species_strides%variable) + do i_var = 1, state%number_of_species + species_1D(1:n_cells_total) => mixing_ratios(:,:,micm_indices_constituent_props(i_var)) + do i_cell = 1, n_cells + state%concentrations( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) = & + species_1D(i_cell + state_data_offset) * state%conditions(i_cell)%air_density & + / micm_molar_mass_array(i_var) end do end do + end associate + + ! Update rate parameters + associate(cell_stride => state%rate_parameters_strides%grid_cell, & + var_stride => state%rate_parameters_strides%variable) + do i_var = 1, state%number_of_rate_parameters + params_1D(1:n_cells_total) => rate_parameters(:,:,i_var) + do i_cell = 1, n_cells + state%rate_parameters( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) = & + params_1D(i_cell + state_data_offset) + end do + end do + end associate + + end subroutine update_micm_state - end subroutine convert_to_mol_per_cubic_meter + !> Extract mixing ratios from a MICM state object + !! + !! Species concentrations are mapped from the MICM species ordering to the + !! CCPP constituent ordering. The concentrations are converted to mass mixing + !! ratios (kg kg-1) using the dry air density and molecular weights of the + !! species. + subroutine extract_mixing_ratios_from_state(state, state_data_offset, mixing_ratios) - ! Convert MICM unit to CAM-SIMA unit (mol m-3 -> kg kg-1) - subroutine convert_to_mass_mixing_ratio(dry_air_density, molar_mass_arr, constituents) - use ccpp_kinds, only: kind_phys + use musica_ccpp_species, only: micm_indices_constituent_props, micm_molar_mass_array + use musica_state, only: state_t - real(kind_phys), intent(in) :: dry_air_density(:,:) ! kg m-3 - real(kind_phys), intent(in) :: molar_mass_arr(:) ! kg mol-1 - real(kind_phys), intent(inout) :: constituents(:,:,:) ! in: mol m-3 | out: kg kg-1 + type(state_t), intent(in) :: state + integer, intent(in) :: state_data_offset ! number of grid cells already updated + real(kind_phys), target, contiguous, intent(inout) :: mixing_ratios(:,:,:) ! kg kg-1 (column, layer, species) - integer :: num_columns, num_layers, num_constituents - integer :: i_column, i_layer, i_elem - real(kind_phys) :: val + integer :: i_cell, i_var, state_offset, n_cells, n_cells_total + real(kind_phys), pointer :: species_1D(:) - num_columns = size(constituents, dim=1) - num_layers = size(constituents, dim=2) - num_constituents = size(constituents, dim=3) + ! get grid cell dimensions + n_cells = state%number_of_grid_cells + n_cells_total = size(mixing_ratios, 1) * size(mixing_ratios, 2) - do i_elem = 1, num_constituents - do i_layer = 1, num_layers - do i_column = 1, num_columns - val = constituents(i_column, i_layer, i_elem) / dry_air_density(i_column, i_layer) & - * molar_mass_arr(i_elem) - constituents(i_column, i_layer, i_elem) = val - end do + ! Update species mass mixing ratios + associate(cell_stride => state%species_strides%grid_cell, & + var_stride => state%species_strides%variable) + do i_var = 1, state%number_of_species + species_1D(1:n_cells_total) => mixing_ratios(:,:,micm_indices_constituent_props(i_var)) + do i_cell = 1, n_cells + species_1D(i_cell + state_data_offset) = & + state%concentrations( 1 + ( i_cell - 1 ) * cell_stride + ( i_var - 1 ) * var_stride ) & + * micm_molar_mass_array(i_var) / state%conditions(i_cell)%air_density end do end do + end associate - end subroutine convert_to_mass_mixing_ratio + end subroutine extract_mixing_ratios_from_state -end module musica_ccpp_micm_util \ No newline at end of file +end module musica_ccpp_micm_util diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index e7907d7f..bb86ed04 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -14,13 +14,17 @@ module musica_ccpp public :: musica_ccpp_register, musica_ccpp_init, musica_ccpp_run, musica_ccpp_final + integer :: number_of_micm_rate_parameters = -1 + + logical, public, protected :: do_tuvx = .false. + contains !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html subroutine musica_ccpp_register(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_ccpp_namelist, only: micm_solver_type + use musica_ccpp_namelist, only: micm_solver_type, filename_of_tuvx_configuration use musica_ccpp_species, only: musica_species_t, register_musica_species use musica_ccpp_tuvx_load_species, only: check_tuvx_species_initialization @@ -32,23 +36,23 @@ subroutine musica_ccpp_register(constituent_props, errmsg, errcode) type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) type(musica_species_t), allocatable :: micm_species(:) type(musica_species_t), allocatable :: tuvx_species(:) - integer :: number_of_grid_cells - - ! Temporary fix until the number of grid cells is only needed to create a MICM state - ! instead of when the solver is created. - ! The number of grid cells is not known at this point, so we set it to 1 and recreate - ! the solver when the number of grid cells is known at the init stage. - number_of_grid_cells = 1 - call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, & - micm_species, errmsg, errcode) + + call micm_register(micm_solver_type, constituent_props_subset, micm_species, & + errmsg, errcode) if (errcode /= 0) return constituent_props = constituent_props_subset deallocate(constituent_props_subset) - call tuvx_register(micm_species, tuvx_species, constituent_props_subset, & - errmsg, errcode) - if (errcode /= 0) return - constituent_props = [ constituent_props, constituent_props_subset ] + if (trim(filename_of_tuvx_configuration) /= "none") then + do_tuvx = .true. + call tuvx_register(micm_species, tuvx_species, constituent_props_subset, & + errmsg, errcode) + if (errcode /= 0) return + constituent_props = [ constituent_props, constituent_props_subset ] + else + do_tuvx = .false. + allocate(tuvx_species(0)) + end if call register_musica_species(micm_species, tuvx_species) call check_tuvx_species_initialization(errmsg, errcode) @@ -61,12 +65,12 @@ end subroutine musica_ccpp_register subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode) + constituent_props_ptr, molar_mass_dry_air__g_mol, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t, ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys - use musica_ccpp_micm, only: micm + use musica_ccpp_micm, only: rate_parameters_ordering use musica_ccpp_namelist, only: micm_solver_type - use musica_ccpp_util, only: has_error_occurred, m_to_nm + use musica_ccpp_util, only: has_error_occurred, m_to_nm, set_constants use musica_ccpp_species, only: initialize_musica_species_indices, initialize_molar_mass_array, & check_initialization, musica_species_t @@ -75,6 +79,7 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props_ptr(:) + real(kind_phys), intent(in) :: molar_mass_dry_air__g_mol ! g mol-1 character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -85,22 +90,32 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & real(kind_phys), dimension(size(photolysis_wavelength_grid_interfaces)) & :: photolysis_wavelength_grid_interfaces_nm ! nm - ! Temporary fix until the number of grid cells is only needed to create a MICM state - ! instead of when the solver is created. - ! Re-create the MICM solver with the correct number of grid cells number_of_grid_cells = horizontal_dimension * vertical_layer_dimension - call micm_register(micm_solver_type, number_of_grid_cells, constituent_props, & - micm_species, errmsg, errcode) - if (errcode /= 0) return - call micm_init(errmsg, errcode) - if (errcode /= 0) return - - photolysis_wavelength_grid_interfaces_nm(:) = photolysis_wavelength_grid_interfaces(:) * m_to_nm - call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & - photolysis_wavelength_grid_interfaces_nm, & - micm%user_defined_reaction_rates, errmsg, errcode) - if (errcode /= 0) return + call set_constants(molar_mass_dry_air__g_mol * 1.0e-3_kind_phys) ! kg mol-1 + + call micm_init(number_of_grid_cells, errmsg, errcode) + if (errcode /= 0) return + number_of_micm_rate_parameters = rate_parameters_ordering%size() + if (number_of_micm_rate_parameters < 0) then + errmsg = "MUSICA: Internal error: number_of_micm_rate_parameters < 0" + errcode = 1 + return + end if + + if (do_tuvx) then + if (size(photolysis_wavelength_grid_interfaces) < 2) then + errmsg = "MUSICA: Internal error: invalid photolysis_wavelength_grid_interfaces size." + errcode = 1 + return + end if + photolysis_wavelength_grid_interfaces_nm(:) = & + photolysis_wavelength_grid_interfaces(:) * m_to_nm + call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & + photolysis_wavelength_grid_interfaces_nm, & + rate_parameters_ordering, errmsg, errcode) + if (errcode /= 0) return + end if call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode) if (errcode /= 0) return @@ -128,11 +143,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_kinds, only: kind_phys - use musica_ccpp_micm, only: number_of_rate_parameters - use musica_ccpp_micm_util, only: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio - use musica_ccpp_species, only: number_of_micm_species, number_of_tuvx_species, & - micm_indices_constituent_props, tuvx_indices_constituent_props, micm_molar_mass_array, & - extract_subset_constituents, update_constituents + use musica_ccpp_species, only: number_of_tuvx_species, tuvx_indices_constituent_props, & + extract_subset_constituents real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K (column, layer) @@ -158,52 +170,37 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co ! local variables real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_rate_parameters) :: rate_parameters ! various units + number_of_micm_rate_parameters) :: rate_parameters ! various units real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_micm_species) :: constituents_micm_species ! kg kg-1 - real(kind_phys), dimension(size(constituents, dim=1), & - size(constituents, dim=2), & - number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 + number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 call extract_subset_constituents(tuvx_indices_constituent_props, constituents, & constituents_tuvx_species, errmsg, errcode) if (errcode /= 0) return ! Calculate photolysis rate constants using TUV-x - call tuvx_run(temperature, dry_air_density, & - constituents_tuvx_species, & - geopotential_height_wrt_surface_at_midpoint, & - geopotential_height_wrt_surface_at_interface, & - surface_geopotential, surface_temperature, & - surface_albedo, & - extraterrestrial_flux, & - standard_gravitational_acceleration, & - cloud_area_fraction, & - air_pressure_thickness, & - solar_zenith_angle, & - earth_sun_distance, & - rate_parameters, & - errmsg, errcode) - if (errcode /= 0) return - - call extract_subset_constituents(micm_indices_constituent_props, constituents, & - constituents_micm_species, errmsg, errcode) - if (errcode /= 0) return - - ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) - call convert_to_mol_per_cubic_meter(dry_air_density, micm_molar_mass_array, constituents_micm_species) + if (do_tuvx) then + call tuvx_run(temperature, dry_air_density, & + constituents_tuvx_species, & + geopotential_height_wrt_surface_at_midpoint, & + geopotential_height_wrt_surface_at_interface, & + surface_geopotential, surface_temperature, & + surface_albedo, & + extraterrestrial_flux, & + standard_gravitational_acceleration, & + cloud_area_fraction, & + air_pressure_thickness, & + solar_zenith_angle, & + earth_sun_distance, & + rate_parameters, & + errmsg, errcode) + if (errcode /= 0) return + end if ! Solve chemistry at the current time step call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, & - constituents_micm_species, errmsg, errcode) - if (errcode /= 0) return - - ! Convert MICM unit back to CAM-SIMA unit (mol m-3 -> kg kg-1) - call convert_to_mass_mixing_ratio(dry_air_density, micm_molar_mass_array, constituents_micm_species) - - call update_constituents(micm_indices_constituent_props, constituents_micm_species, & - constituents, errmsg, errcode) + constituents, errmsg, errcode) if (errcode /= 0) return end subroutine musica_ccpp_run diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 91ef574c..61401564 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -1,12 +1,12 @@ [ccpp-table-properties] name = musica_ccpp type = scheme - dependencies = musica_ccpp.F90,musica_ccpp_util.F90,musica_ccpp_species.F90 - dependencies = micm/musica_ccpp_micm.F90,micm/musica_ccpp_micm_util.F90 + dependencies = micm/musica_ccpp_micm_util.F90,micm/musica_ccpp_micm.F90 dependencies = tuvx/musica_ccpp_tuvx_aerosol_optics.F90,tuvx/musica_ccpp_tuvx_cloud_optics.F90,tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 dependencies = tuvx/musica_ccpp_tuvx_gas_species.F90,tuvx/musica_ccpp_tuvx_height_grid.F90,tuvx/musica_ccpp_tuvx_load_species.F90 dependencies = tuvx/musica_ccpp_tuvx_surface_albedo.F90,tuvx/musica_ccpp_tuvx_temperature.F90,tuvx/musica_ccpp_tuvx_wavelength_grid.F90 dependencies = tuvx/musica_ccpp_tuvx.F90 + dependencies = util/musica_ccpp_grid.F90,util/musica_ccpp_species.F90,util/musica_ccpp_util.F90 [ccpp-arg-table] name = musica_ccpp_register @@ -64,6 +64,12 @@ type = ccpp_constituent_prop_ptr_t dimensions = (number_of_ccpp_constituents) intent = in +[ molar_mass_dry_air__g_mol ] + standard_name = molecular_weight_of_dry_air + units = g mol-1 + type = real | kind = kind_phys + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/musica/musica_ccpp_namelist.xml b/schemes/musica/musica_ccpp_namelist.xml index af1e473b..8325678c 100644 --- a/schemes/musica/musica_ccpp_namelist.xml +++ b/schemes/musica/musica_ccpp_namelist.xml @@ -77,16 +77,16 @@ --> - integer + char*512 musica_ccpp musica_ccpp micm_solver_type none - The type of MICM solver to use. + The type of MICM solver to use. Options are "Rosenbrock" and "Backward Euler". - 1 + Rosenbrock diff --git a/schemes/musica/util/musica_ccpp_util.F90 b/schemes/musica/util/musica_ccpp_util.F90 index c0ba05e1..84c43ef4 100644 --- a/schemes/musica/util/musica_ccpp_util.F90 +++ b/schemes/musica/util/musica_ccpp_util.F90 @@ -7,16 +7,26 @@ module musica_ccpp_util implicit none private - public :: has_error_occurred + public :: has_error_occurred, set_constants real(kind_phys), parameter, public :: PI = 3.14159265358979323846_kind_phys real(kind_phys), parameter, public :: DEGREE_TO_RADIAN = PI / 180.0_kind_phys + real(kind_phys), public, protected :: MOLAR_MASS_DRY_AIR = -HUGE(1.0_kind_phys) ! kg mol-1 !> Conversion factor for wavelength interfaces from meters (CAM-SIMA) to nanometers (TUV-x) real(kind_phys), parameter, public :: m_to_nm = 1.0e9_kind_phys contains + !> @brief Set constants used for MUSICA components + !> @param[in] molar_mass_dry_air_in The molar mass of dry air (kg mol-1). + subroutine set_constants(molar_mass_dry_air_in) + + real(kind_phys), intent(in) :: molar_mass_dry_air_in + + MOLAR_MASS_DRY_AIR = molar_mass_dry_air_in + end subroutine set_constants + !> @brief Evaluate a MUSICA error for failure and convert to CCPP error data !> @param[in] error The error code to evaluate and convert. !> @param[out] error_message The CCPP error message. diff --git a/test/docker/Dockerfile.musica b/test/docker/Dockerfile.musica index 329bc174..a8423f4c 100644 --- a/test/docker/Dockerfile.musica +++ b/test/docker/Dockerfile.musica @@ -5,7 +5,7 @@ FROM ubuntu:22.04 -ARG MUSICA_GIT_TAG=cc39bb00d2220fc81c85b22d3ceea4a39bd2bacf +ARG MUSICA_GIT_TAG=72c3b398fa4713effc5648b29b8070cb432eebf2 ARG CAM_SIMA_CHEMISTRY_DATA_TAG=71ed143c54b0d5d6e3e70f3d05d413fddcf8d59e ARG USE_INSTALLED_MUSICA_LIB=ON ARG BUILD_TYPE=Debug diff --git a/test/docker/Dockerfile.musica.no_install b/test/docker/Dockerfile.musica.no_install index 577eda65..99fd06d5 100644 --- a/test/docker/Dockerfile.musica.no_install +++ b/test/docker/Dockerfile.musica.no_install @@ -8,7 +8,7 @@ FROM ubuntu:22.04 -ARG MUSICA_GIT_TAG=cc39bb00d2220fc81c85b22d3ceea4a39bd2bacf +ARG MUSICA_GIT_TAG=72c3b398fa4713effc5648b29b8070cb432eebf2 ARG CAM_SIMA_CHEMISTRY_DATA_TAG=71ed143c54b0d5d6e3e70f3d05d413fddcf8d59e ARG USE_INSTALLED_MUSICA_LIB=OFF ARG BUILD_TYPE=Debug diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index 2ac61ff8..ebf8d2cb 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -25,6 +25,12 @@ endif() find_package(Python REQUIRED) +# Copy configuration files to the build directory +add_custom_target(copy_musica_test_data ALL ${CMAKE_COMMAND} -E copy_directory + ${CMAKE_CURRENT_SOURCE_DIR}/configuration + ${CMAKE_BINARY_DIR}/test/musica/configuration +) + # Test metadata against the source code file(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/metadata_test) add_custom_target( @@ -76,7 +82,7 @@ target_sources(test_musica_api target_link_libraries(test_musica_api PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -103,7 +109,7 @@ target_sources(test_musica_species target_link_libraries(test_musica_species PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( diff --git a/test/musica/aerosol/CMakeLists.txt b/test/musica/aerosol/CMakeLists.txt index 3d849447..51910df4 100644 --- a/test/musica/aerosol/CMakeLists.txt +++ b/test/musica/aerosol/CMakeLists.txt @@ -15,7 +15,7 @@ target_sources(test_musica_aerosol_model_mock_host target_link_libraries(test_musica_aerosol_model_mock_host PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) set_target_properties(test_musica_aerosol_model_mock_host diff --git a/test/musica/aerosol_stub/CMakeLists.txt b/test/musica/aerosol_stub/CMakeLists.txt index 57d3118f..8a152e57 100644 --- a/test/musica/aerosol_stub/CMakeLists.txt +++ b/test/musica/aerosol_stub/CMakeLists.txt @@ -15,7 +15,7 @@ target_sources(test_stub_aerosol_model target_link_libraries(test_stub_aerosol_model PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) set_target_properties(test_stub_aerosol_model diff --git a/test/musica/configuration/analytical/config.json b/test/musica/configuration/analytical/config.json new file mode 100644 index 00000000..04d0ef28 --- /dev/null +++ b/test/musica/configuration/analytical/config.json @@ -0,0 +1,6 @@ +{ + "camp-files": [ + "species.json", + "reactions.json" + ] +} diff --git a/test/musica/configuration/analytical/reactions.json b/test/musica/configuration/analytical/reactions.json new file mode 100644 index 00000000..bc40d6cd --- /dev/null +++ b/test/musica/configuration/analytical/reactions.json @@ -0,0 +1,71 @@ +{ + "camp-data": [ + { + "type": "MECHANISM", + "name": "analytical test", + "reactions": [ + { + "type": "ARRHENIUS", + "A": 0.004, + "C": 50, + "reactants": { + "A": { + "qty": 1 + } + }, + "products": { + "B": { + "yield": 1 + } + } + }, + { + "type": "ARRHENIUS", + "A": 0.012, + "B": -2, + "C": 75, + "D": 50, + "E": 1.0e-6, + "reactants": { + "B": { + "qty": 1 + } + }, + "products": { + "C": { + "yield": 1 + } + } + }, + { + "type": "ARRHENIUS", + "A": 0.001, + "reactants": { + "D": { + "qty": 1 + } + }, + "products": { + "E": { + "yield": 1 + } + } + }, + { + "type": "ARRHENIUS", + "A": 0.002, + "reactants": { + "E": { + "qty": 1 + } + }, + "products": { + "F": { + "yield": 1 + } + } + } + ] + } + ] +} diff --git a/test/musica/configuration/analytical/species.json b/test/musica/configuration/analytical/species.json new file mode 100644 index 00000000..b834af4f --- /dev/null +++ b/test/musica/configuration/analytical/species.json @@ -0,0 +1,40 @@ +{ + "camp-data": [ + { + "name": "A", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.01802, + "__is advected": true + }, + { + "name": "B", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.02897, + "__is advected": true + }, + { + "name": "C", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.0319988, + "__is advected": true + }, + { + "name": "D", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.0479982, + "__is advected": true + }, + { + "name": "E", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.07254, + "__is advected": true + }, + { + "name": "F", + "type": "CHEM_SPEC", + "molecular weight [kg mol-1]": 0.082356, + "__is advected": true + } + ] +} diff --git a/test/musica/configuration/micm_util/config.json b/test/musica/configuration/micm_util/config.json new file mode 100644 index 00000000..04d0ef28 --- /dev/null +++ b/test/musica/configuration/micm_util/config.json @@ -0,0 +1,6 @@ +{ + "camp-files": [ + "species.json", + "reactions.json" + ] +} diff --git a/test/musica/configuration/micm_util/reactions.json b/test/musica/configuration/micm_util/reactions.json new file mode 100644 index 00000000..3a6c7102 --- /dev/null +++ b/test/musica/configuration/micm_util/reactions.json @@ -0,0 +1,70 @@ +{ + "camp-data": [ + { + "type": "MECHANISM", + "name": "analytical test", + "reactions": [ + { + "type": "ARRHENIUS", + "A": 0.001, + "reactants": { + "A": { + "qty": 1 + }, + "B": { + "qty": 1 + } + }, + "products": { + "C": { + "yield": 1 + }, + "D": { + "yield": 1 + } + } + }, + { + "type": "USER_DEFINED", + "MUSICA name": "user1", + "reactants": { + "A": { + "qty": 1 + }, + "B": { + "qty": 1 + } + }, + "products": { + "C": { + "yield": 1 + }, + "D": { + "yield": 1 + } + } + }, + { + "type": "USER_DEFINED", + "MUSICA name": "user2", + "reactants": { + "A": { + "qty": 1 + }, + "B": { + "qty": 1 + } + }, + "products": { + "C": { + "yield": 1 + }, + "D": { + "yield": 1 + } + } + } + ] + } + ] +} diff --git a/test/musica/configuration/micm_util/species.json b/test/musica/configuration/micm_util/species.json new file mode 100644 index 00000000..51e87e49 --- /dev/null +++ b/test/musica/configuration/micm_util/species.json @@ -0,0 +1,24 @@ +{ + "camp-data": [ + { + "name": "A", + "type": "CHEM_SPEC", + "__is advected": true + }, + { + "name": "B", + "type": "CHEM_SPEC", + "__is advected": true + }, + { + "name": "C", + "type": "CHEM_SPEC", + "__is advected": true + }, + { + "name": "D", + "type": "CHEM_SPEC", + "__is advected": true + } + ] +} diff --git a/test/musica/micm/CMakeLists.txt b/test/musica/micm/CMakeLists.txt index 6a8735be..f2733f1a 100644 --- a/test/musica/micm/CMakeLists.txt +++ b/test/musica/micm/CMakeLists.txt @@ -1,14 +1,15 @@ -add_executable(test_micm_util test_micm_util.F90) +add_executable(test_micm_util test_micm_util.F90 test_micm_mock_mods.F90) target_sources(test_micm_util PUBLIC ${MUSICA_SRC_PATH}/micm/musica_ccpp_micm_util.F90 + ${MUSICA_SRC_PATH}/util/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) target_link_libraries(test_micm_util PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( diff --git a/test/musica/micm/test_micm_mock_mods.F90 b/test/musica/micm/test_micm_mock_mods.F90 new file mode 100644 index 00000000..13ac3b28 --- /dev/null +++ b/test/musica/micm/test_micm_mock_mods.F90 @@ -0,0 +1,14 @@ +! Copyright (C) 2024-2025 University Corporation for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_ccpp_species + ! Mock module for testing + use ccpp_kinds, only: kind_phys + + implicit none + private + public :: micm_indices_constituent_props, micm_molar_mass_array + + integer, parameter :: micm_indices_constituent_props(4) = (/ 1, 2, 3, 4 /) + real(kind_phys), parameter :: micm_molar_mass_array(4) = & + (/ 200._kind_phys, 100._kind_phys, 150._kind_phys, 250._kind_phys /) +end module musica_ccpp_species diff --git a/test/musica/micm/test_micm_util.F90 b/test/musica/micm/test_micm_util.F90 index 02e2f865..1cf5d4da 100644 --- a/test/musica/micm/test_micm_util.F90 +++ b/test/musica/micm/test_micm_util.F90 @@ -14,48 +14,81 @@ program test_micm_util contains subroutine test_unit_conversion() - use ccpp_kinds, only: kind_phys - + use ccpp_kinds, only: kind_phys + use musica_ccpp_util, only: set_constants + use musica_micm, only: micm_t + use musica_state, only: state_t + use musica_util, only: error_t + use musica_ccpp_species, only: micm_molar_mass_array + + character(len=*), parameter :: filename_of_micm_configuration = "test/musica/configuration/micm_util/config.json" integer, parameter :: NUM_COLUMNS = 2 integer, parameter :: NUM_LAYERS = 2 - integer, parameter :: NUM_SPECIES = NUM_COLUMNS * NUM_LAYERS + integer, parameter :: NUM_CELLS = NUM_COLUMNS * NUM_LAYERS + integer, parameter :: NUM_SPECIES = 4 + integer, parameter :: NUM_RATE_PARAMETERS = 2 real, parameter :: ABS_ERROR = 1e-3 - real(kind_phys) :: dry_air_density(NUM_COLUMNS,NUM_LAYERS) - real(kind_phys) :: molar_mass_arr(NUM_SPECIES) - real(kind_phys) :: constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) - real(kind_phys) :: ccpp_constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) ! kg kg-1 - real(kind_phys) :: micm_constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) ! mol m-3 - integer :: i_column, i_layer, i_elem - - dry_air_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) - dry_air_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) - molar_mass_arr(:) = (/ 200._kind_phys, 200._kind_phys, 200._kind_phys, 200._kind_phys /) + real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 + real(kind_phys), target :: dry_air_mass_density(NUM_COLUMNS,NUM_LAYERS) ! kg m-3 + real(kind_phys), target :: pressure(NUM_COLUMNS,NUM_LAYERS) ! Pa + real(kind_phys), target :: temperature(NUM_COLUMNS,NUM_LAYERS) ! K + real(kind_phys), target :: constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) + real(kind_phys), target :: ccpp_constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) ! kg kg-1 + real(kind_phys), target :: micm_constituents(NUM_COLUMNS,NUM_LAYERS,NUM_SPECIES) ! mol m-3 + real(kind_phys), target :: rate_parameters(NUM_COLUMNS,NUM_LAYERS,NUM_RATE_PARAMETERS) ! various units + integer :: i_column, i_layer, i_elem, i_cell + type(micm_t), pointer :: micm + type(state_t), pointer :: state + type(error_t) :: error + + call set_constants(MOLAR_MASS_DRY_AIR) + + micm => micm_t(trim(filename_of_micm_configuration), NUM_CELLS, error) + ASSERT(error%is_success( )) + state => micm%get_state(NUM_CELLS, error) + + temperature(:,1) = (/ 200._kind_phys, 210._kind_phys /) + temperature(:,2) = (/ 220._kind_phys, 230._kind_phys /) + pressure(:,1) = (/ 1000._kind_phys, 1100._kind_phys /) + pressure(:,2) = (/ 1200._kind_phys, 1300._kind_phys /) + dry_air_mass_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) + dry_air_mass_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) constituents(1,1,:) = (/ 0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys /) constituents(1,2,:) = (/ 0.41_kind_phys, 0.42_kind_phys, 0.43_kind_phys, 0.44_kind_phys /) constituents(2,1,:) = (/ 0.21_kind_phys, 0.22_kind_phys, 0.23_kind_phys, 0.24_kind_phys /) constituents(2,2,:) = (/ 0.31_kind_phys, 0.32_kind_phys, 0.33_kind_phys, 0.34_kind_phys /) + rate_parameters(1,1,:) = (/ 0.1_kind_phys, 0.2_kind_phys /) + rate_parameters(1,2,:) = (/ 0.3_kind_phys, 0.4_kind_phys /) + rate_parameters(2,1,:) = (/ 0.5_kind_phys, 0.6_kind_phys /) + rate_parameters(2,2,:) = (/ 0.7_kind_phys, 0.8_kind_phys /) - ccpp_constituents(1,1,:) = (/ 0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys /) - ccpp_constituents(1,2,:) = (/ 0.41_kind_phys, 0.42_kind_phys, 0.43_kind_phys, 0.44_kind_phys /) - ccpp_constituents(2,1,:) = (/ 0.21_kind_phys, 0.22_kind_phys, 0.23_kind_phys, 0.24_kind_phys /) - ccpp_constituents(2,2,:) = (/ 0.31_kind_phys, 0.32_kind_phys, 0.33_kind_phys, 0.34_kind_phys /) - - micm_constituents(1,1,:) = (/ 1.750E-003_kind_phys, 3.500E-003_kind_phys, 5.250E-003_kind_phys, 7.000E-003_kind_phys /) - micm_constituents(1,2,:) = (/ 1.127E-002_kind_phys, 1.155E-002_kind_phys, 1.182E-002_kind_phys, 1.210E-002_kind_phys /) - micm_constituents(2,1,:) = (/ 4.725E-003_kind_phys, 4.949E-003_kind_phys, 5.175E-003_kind_phys, 5.400E-003_kind_phys /) - micm_constituents(2,2,:) = (/ 1.007E-002_kind_phys, 1.040E-002_kind_phys, 1.072E-002_kind_phys, 1.104E-002_kind_phys /) + ccpp_constituents(:,:,:) = constituents(:,:,:) + + ! Set the expected values for the constituents in mol m-3 + micm_constituents(:,:,1) = ccpp_constituents(:,:,1) * dry_air_mass_density(:,:) / ( MOLAR_MASS_DRY_AIR * micm_molar_mass_array(1) ) + micm_constituents(:,:,2) = ccpp_constituents(:,:,2) * dry_air_mass_density(:,:) / ( MOLAR_MASS_DRY_AIR * micm_molar_mass_array(2) ) + micm_constituents(:,:,3) = ccpp_constituents(:,:,3) * dry_air_mass_density(:,:) / ( MOLAR_MASS_DRY_AIR * micm_molar_mass_array(3) ) + micm_constituents(:,:,4) = ccpp_constituents(:,:,4) * dry_air_mass_density(:,:) / ( MOLAR_MASS_DRY_AIR * micm_molar_mass_array(4) ) - call convert_to_mol_per_cubic_meter(dry_air_density, molar_mass_arr, constituents) + call update_micm_state(state, 0, temperature, pressure, dry_air_mass_density, constituents, rate_parameters) do i_column = 1, NUM_COLUMNS do i_layer = 1, NUM_LAYERS + i_cell = i_column + (i_layer - 1) * NUM_COLUMNS + ASSERT_NEAR(state%conditions(i_cell)%temperature, temperature(i_column, i_layer), ABS_ERROR) + ASSERT_NEAR(state%conditions(i_cell)%pressure, pressure(i_column, i_layer), ABS_ERROR) + ASSERT_NEAR(state%conditions(i_cell)%air_density, dry_air_mass_density(i_column, i_layer) / MOLAR_MASS_DRY_AIR, ABS_ERROR) do i_elem = 1, NUM_SPECIES - ASSERT_NEAR(constituents(i_column, i_layer, i_elem), micm_constituents(i_column, i_layer, i_elem), ABS_ERROR) + ASSERT_NEAR(state%concentrations(1 + (i_cell-1)*state%species_strides%grid_cell + (i_elem-1)*state%species_strides%variable), micm_constituents(i_column, i_layer, i_elem), ABS_ERROR) + end do + do i_elem = 1, NUM_RATE_PARAMETERS + ASSERT_NEAR(state%rate_parameters(1 + (i_cell-1)*state%rate_parameters_strides%grid_cell + (i_elem-1)*state%rate_parameters_strides%variable), rate_parameters(i_column, i_layer, i_elem), ABS_ERROR) end do end do end do - call convert_to_mass_mixing_ratio(dry_air_density, molar_mass_arr, constituents) + constituents(:,:,:) = -HUGE(1.0_kind_phys) + call extract_mixing_ratios_from_state(state, 0, constituents) do i_column = 1, NUM_COLUMNS do i_layer = 1, NUM_LAYERS @@ -65,6 +98,9 @@ subroutine test_unit_conversion() end do end do + deallocate(state) + deallocate(micm) + end subroutine test_unit_conversion -end program test_micm_util \ No newline at end of file +end program test_micm_util diff --git a/test/musica/musica_ccpp_namelist.F90 b/test/musica/musica_ccpp_namelist.F90 index 1b689b6c..8ddb475a 100644 --- a/test/musica/musica_ccpp_namelist.F90 +++ b/test/musica/musica_ccpp_namelist.F90 @@ -8,7 +8,7 @@ module musica_ccpp_namelist private - integer, public :: micm_solver_type = 1 + character(len=250), public :: micm_solver_type = 'Rosenbrock' character(len=250), public :: filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' character(len=250), public :: filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' character(len=250), public :: filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/chapman/tuvx_micm_mapping.json' diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 44f03136..1da95bb1 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -15,6 +15,18 @@ program run_test_musica_ccpp endif real(kind_phys), parameter :: DEGREE_TO_RADIAN = 3.14159265358979323846_kind_phys / 180.0_kind_phys + real(kind_phys), parameter :: AVOGADRO = 6.02214179e23_kind_phys ! mol-1 + real(kind_phys), parameter :: GAS_CONSTANT = 8.31446261815324_kind_phys ! J K-1 mol-1 + real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 + real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR__G_MOL = MOLAR_MASS_DRY_AIR * 1.0e3_kind_phys ! g mol-1 + + type :: ArrheniusReaction + real(kind_phys) :: A_ = 1.0 + real(kind_phys) :: B_ = 0.0 + real(kind_phys) :: C_ = 0.0 + real(kind_phys) :: D_ = 300.0 + real(kind_phys) :: E_ = 0.0 + end type ArrheniusReaction write(*,*) "[MUSICA Test] Running the Chapman test" call test_chapman() @@ -24,14 +36,32 @@ program run_test_musica_ccpp call test_terminator() write(*,*) "[MUSICA Test] Ends the Terminator test" + write(*,*) "[MUSICA Test] Running the Analytical test with Rosenbrock solver" + call test_rosenbrock() + write(*,*) "[MUSICA Test] Ends the Analytical test with Rosenbrock solver" + + write(*,*) "[MUSICA Test] Running the Analytical test with Backward Euler solver" + call test_backward_euler() + write(*,*) "[MUSICA Test] Ends the Analytical test with Backward Euler solver" + contains + !> Calculate the rate constant for an Arrhenius reaction + function calculate_arrhenius( reaction, temperature, pressure ) result( rate ) + type(ArrheniusReaction), intent(in) :: reaction + real(kind_phys), intent(in) :: temperature + real(kind_phys), intent(in) :: pressure + real(kind_phys) :: rate + rate = reaction%A_ * exp( reaction%C_ / temperature ) & + * (temperature / reaction%D_) ** reaction%B_ & + * (1.0 + reaction%E_ * pressure) + end function calculate_arrhenius + !> Tests the Chapman chemistry scheme subroutine test_chapman() use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use ccpp_const_utils, only: ccpp_const_get_idx - use musica_ccpp_micm, only: micm use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration @@ -154,7 +184,7 @@ subroutine test_chapman() end do call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode) + constituent_props_ptr, MOLAR_MASS_DRY_AIR__G_MOL, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -280,7 +310,6 @@ subroutine test_terminator() use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use ccpp_const_utils, only: ccpp_const_get_idx - use musica_ccpp_micm, only: micm use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration @@ -402,7 +431,7 @@ subroutine test_terminator() end do call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode) + constituent_props_ptr, MOLAR_MASS_DRY_AIR__G_MOL, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -516,4 +545,245 @@ subroutine test_terminator() end subroutine test_terminator -end program run_test_musica_ccpp \ No newline at end of file + subroutine get_index_and_molar_mass(constituent_props, species_name, index, molar_mass) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use ccpp_const_utils, only: ccpp_const_get_idx + + type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) + character(len=*), intent(in) :: species_name + integer, intent(out) :: index + real(kind_phys), intent(out) :: molar_mass + + character(len=512) :: errmsg + integer :: errcode + + call ccpp_const_get_idx( constituent_props, species_name, index, errmsg, errcode ) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + call constituent_props(index)%molar_mass(molar_mass, errcode, errmsg) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + end subroutine get_index_and_molar_mass + + subroutine test_analytical(number_of_columns, number_of_layers, test_accuracy) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t, & + ccpp_constituent_properties_t + use ccpp_const_utils, only: ccpp_const_get_idx + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 + + integer, intent(in) :: number_of_columns + integer, intent(in) :: number_of_layers + real(kind_phys), intent(in) :: test_accuracy ! Relative tolrance for checking results + + integer, parameter :: NUM_SPECIES = 6 + integer :: NUM_GRID_CELLS + + integer :: errcode + character(len=512) :: errmsg + real(kind_phys) :: time_step = 60._kind_phys ! s + real(kind_phys), dimension(number_of_columns,number_of_layers) :: temperature ! K + real(kind_phys), dimension(number_of_columns,number_of_layers) :: pressure ! Pa + real(kind_phys), dimension(number_of_columns,number_of_layers) :: air_density ! mol m-3 + real(kind_phys), dimension(number_of_columns,number_of_layers) :: dry_air_mass_density ! kg m-3 + real(kind_phys), dimension(number_of_columns,number_of_layers,NUM_SPECIES) :: constituents ! kg kg-1 + real(kind_phys), dimension(number_of_columns,number_of_layers,NUM_SPECIES) :: initial_constituents ! kg kg-1 + type(ccpp_constituent_prop_ptr_t), allocatable :: constituent_props_ptr(:) + type(ccpp_constituent_properties_t), allocatable, target :: constituent_props(:) + type(ccpp_constituent_properties_t), pointer :: const_prop + character(len=512) :: species_name, units + character(len=:), allocatable :: micm_species_name + integer :: i, j + integer :: A_index, B_index, C_index, D_index, E_index, F_index + real(kind_phys) :: A_MW, B_MW, C_MW, D_MW, E_MW, F_MW + type(ArrheniusReaction) :: arr1, arr2, arr3, arr4 + real(kind_phys) :: initial_A, initial_C, initial_D, initial_F + real(kind_phys) :: A, B, C, D, E, F + real(kind_phys) :: k1, k2, k3, k4 + real(kind_phys) :: dummy_array_1D(1), dummy_array_2D(1,1) + + NUM_GRID_CELLS = number_of_columns * number_of_layers + dummy_array_1D = -HUGE(0.0_kind_phys) + dummy_array_2D = -HUGE(0.0_kind_phys) + + filename_of_micm_configuration = 'test/musica/configuration/analytical/config.json' + filename_of_tuvx_configuration = 'none' + filename_of_tuvx_micm_mapping_configuration = 'none' + + ! MUSICA registration + call musica_ccpp_register(constituent_props, errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + ASSERT(allocated(constituent_props)) + ASSERT(size(constituent_props) == NUM_SPECIES) + allocate(constituent_props_ptr(size(constituent_props))) + do i = 1, size(constituent_props) + const_prop => constituent_props(i) + call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) + end do + + ! Get indices and molar masses for chemical species + call get_index_and_molar_mass(constituent_props_ptr, "A", A_index, A_MW) + call get_index_and_molar_mass(constituent_props_ptr, "B", B_index, B_MW) + call get_index_and_molar_mass(constituent_props_ptr, "C", C_index, C_MW) + call get_index_and_molar_mass(constituent_props_ptr, "D", D_index, D_MW) + call get_index_and_molar_mass(constituent_props_ptr, "E", E_index, E_MW) + call get_index_and_molar_mass(constituent_props_ptr, "F", F_index, F_MW) + + ! Check that the molar masses are correct + ASSERT_NEAR(A_MW, 0.01802_kind_phys, 1.0e-5_kind_phys) + ASSERT_NEAR(B_MW, 0.02897_kind_phys, 1.0e-5_kind_phys) + ASSERT_NEAR(C_MW, 0.0319988_kind_phys, 1.0e-5_kind_phys) + ASSERT_NEAR(D_MW, 0.0479982_kind_phys, 1.0e-5_kind_phys) + ASSERT_NEAR(E_MW, 0.07254_kind_phys, 1.0e-5_kind_phys) + ASSERT_NEAR(F_MW, 0.082356_kind_phys, 1.0e-5_kind_phys) + + ! MUSICA initialization + call musica_ccpp_init(number_of_columns, number_of_layers, number_of_layers+1, & + dummy_array_1D, constituent_props_ptr, MOLAR_MASS_DRY_AIR__G_MOL, & + errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + do i = 1, number_of_layers + do j = 1, number_of_columns + temperature(j,i) = 250.0_kind_phys + 100.0_kind_phys * (i-1) / number_of_columns + 10.0_kind_phys * (j-1) / number_of_layers + pressure(j,i) = 10000.0_kind_phys + 100000.0_kind_phys * (i-1) / number_of_columns + 10000.0_kind_phys * (j-1) / number_of_layers + air_density(j,i) = pressure(j,i) / (GAS_CONSTANT * temperature(j,i)) + dry_air_mass_density(j,i) = air_density(j,i) * MOLAR_MASS_DRY_AIR + constituents(j,i,A_index) = 0.75 + 0.1_kind_phys * (i-1) / number_of_columns + 0.01_kind_phys * (j-1) / number_of_layers - 0.05 + constituents(j,i,B_index) = 0.0_kind_phys + constituents(j,i,C_index) = 0.4_kind_phys + 0.1_kind_phys * (i-1) / number_of_columns + 0.01_kind_phys * (j-1) / number_of_layers - 0.05 + constituents(j,i,D_index) = 0.8_kind_phys + 0.1_kind_phys * (i-1) / number_of_columns + 0.01_kind_phys * (j-1) / number_of_layers - 0.05 + constituents(j,i,E_index) = 0.0_kind_phys + constituents(j,i,F_index) = 0.1_kind_phys + 0.1_kind_phys * (i-1) / number_of_columns + 0.01_kind_phys * (j-1) / number_of_layers - 0.05 + end do + end do + initial_constituents(:,:,:) = constituents(:,:,:) + + ! Convert to kg kg-1 for CAM-SIMA + do i = 1, number_of_columns + do j = 1, number_of_layers + constituents(i,j,A_index) = constituents(i,j,A_index) / dry_air_mass_density(i,j) * A_MW + constituents(i,j,B_index) = constituents(i,j,B_index) / dry_air_mass_density(i,j) * B_MW + constituents(i,j,C_index) = constituents(i,j,C_index) / dry_air_mass_density(i,j) * C_MW + constituents(i,j,D_index) = constituents(i,j,D_index) / dry_air_mass_density(i,j) * D_MW + constituents(i,j,E_index) = constituents(i,j,E_index) / dry_air_mass_density(i,j) * E_MW + constituents(i,j,F_index) = constituents(i,j,F_index) / dry_air_mass_density(i,j) * F_MW + end do + end do + + ! MUSICA run for one time step + call musica_ccpp_run( time_step, temperature, pressure, dry_air_mass_density, constituent_props_ptr, & + constituents, dummy_array_2D, dummy_array_2D, dummy_array_1D, dummy_array_1D, & + dummy_array_1D, dummy_array_1D, -HUGE(0.0_kind_phys), dummy_array_2D, & + dummy_array_2D, dummy_array_1D, -HUGE(0.0_kind_phys), errmsg, errcode ) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + ! Convert back to mol m-3 for analytical check + do i = 1, number_of_columns + do j = 1, number_of_layers + constituents(i,j,A_index) = constituents(i,j,A_index) * dry_air_mass_density(i,j) / A_MW + constituents(i,j,B_index) = constituents(i,j,B_index) * dry_air_mass_density(i,j) / B_MW + constituents(i,j,C_index) = constituents(i,j,C_index) * dry_air_mass_density(i,j) / C_MW + constituents(i,j,D_index) = constituents(i,j,D_index) * dry_air_mass_density(i,j) / D_MW + constituents(i,j,E_index) = constituents(i,j,E_index) * dry_air_mass_density(i,j) / E_MW + constituents(i,j,F_index) = constituents(i,j,F_index) * dry_air_mass_density(i,j) / F_MW + end do + end do + + ! Check the results + arr1%A_ = 0.004_kind_phys + arr1%C_ = 50.0_kind_phys + arr2%A_ = 0.012_kind_phys + arr2%B_ = -2.0_kind_phys + arr2%C_ = 75.0_kind_phys + arr2%D_ = 50.0_kind_phys + arr2%E_ = 1.0e-6_kind_phys + arr3%A_ = 0.001_kind_phys + arr4%A_ = 0.002_kind_phys + + do i = 1, number_of_columns + do j = 1, number_of_layers + initial_A = initial_constituents(i,j,A_index) + initial_C = initial_constituents(i,j,C_index) + initial_D = initial_constituents(i,j,D_index) + initial_F = initial_constituents(i,j,F_index) + k1 = calculate_arrhenius( arr1, temperature(i,j), pressure(i,j) ) + k2 = calculate_arrhenius( arr2, temperature(i,j), pressure(i,j) ) + k3 = calculate_arrhenius( arr3, temperature(i,j), pressure(i,j) ) + k4 = calculate_arrhenius( arr4, temperature(i,j), pressure(i,j) ) + A = initial_A * exp( -k1 * time_step ) + B = initial_A * (k1 / (k2 - k1)) * & + (exp( -k1 * time_step ) - exp( -k2 * time_step )) + C = initial_C + initial_A * & + (1.0 + (k1 * exp(-k2 * time_step) - k2 * exp(-k1 * time_step)) / (k2 - k1)) + D = initial_D * exp( -k3 * time_step ) + E = initial_D * (k3 / (k4 - k3)) * & + (exp( -k3 * time_step ) - exp(-k4 * time_step )) + F = initial_F + initial_D * & + (1.0 + (k3 * exp(-k4 * time_step) - k4 * exp(-k3 * time_step)) / (k4 - k3)) + + ! Check that the results are correct + ASSERT_NEAR(constituents(i,j,A_index), A, test_accuracy) + ASSERT_NEAR(constituents(i,j,B_index), B, test_accuracy) + ASSERT_NEAR(constituents(i,j,C_index), C, test_accuracy) + ASSERT_NEAR(constituents(i,j,D_index), D, test_accuracy) + ASSERT_NEAR(constituents(i,j,E_index), E, test_accuracy) + ASSERT_NEAR(constituents(i,j,F_index), F, test_accuracy) + end do + end do + + ! Clean up + call musica_ccpp_final(errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + end subroutine test_analytical + + !> Check with Rosenbrock Solver + subroutine test_rosenbrock() + use musica_ccpp_namelist, only : micm_solver_type + + real(kind_phys) :: test_accuracy = 5.0e-3_kind_phys + + micm_solver_type = "Rosenbrock" + call test_analytical(1, 1, test_accuracy) + call test_analytical(2, 5, test_accuracy) + call test_analytical(5, 2, test_accuracy) + call test_analytical(128, 128, test_accuracy) + call test_analytical(160, 200, test_accuracy) + end subroutine test_rosenbrock + + !> Check with Backward Euler Solver + subroutine test_backward_euler() + use musica_ccpp_namelist, only : micm_solver_type + + real(kind_phys) :: test_accuracy = 0.1_kind_phys + + micm_solver_type = "Backward Euler" + call test_analytical(1, 1, test_accuracy) + call test_analytical(2, 5, test_accuracy) + call test_analytical(5, 2, test_accuracy) + call test_analytical(128, 128, test_accuracy) + call test_analytical(160, 200, test_accuracy) + end subroutine test_backward_euler + +end program run_test_musica_ccpp diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index 49873b1a..2172fca7 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -10,7 +10,7 @@ target_sources(test_tuvx_height_grid target_link_libraries(test_tuvx_height_grid PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -33,7 +33,7 @@ target_sources(test_tuvx_wavelength_grid target_link_libraries(test_tuvx_wavelength_grid PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -57,7 +57,7 @@ target_sources(test_tuvx_temperature target_link_libraries(test_tuvx_temperature PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -81,7 +81,7 @@ target_sources(test_tuvx_surface_albedo target_link_libraries(test_tuvx_surface_albedo PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -106,7 +106,7 @@ target_sources(test_tuvx_extraterrestrial_flux target_link_libraries(test_tuvx_extraterrestrial_flux PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -132,7 +132,7 @@ target_sources(test_tuvx_cloud_optics target_link_libraries(test_tuvx_cloud_optics PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -157,7 +157,7 @@ target_sources(test_tuvx_aerosol_optics target_link_libraries(test_tuvx_aerosol_optics PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -186,7 +186,7 @@ target_sources(test_tuvx_gas_species target_link_libraries(test_tuvx_gas_species PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( @@ -215,7 +215,7 @@ target_sources(test_tuvx_load_species target_link_libraries(test_tuvx_load_species PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) add_test( diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 index f47ecc6a..ba47d8d1 100644 --- a/test/musica/tuvx/test_tuvx_gas_species.F90 +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -270,10 +270,11 @@ subroutine test_initialize_tuvx_species() use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration - use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, MOLAR_MASS_DRY_AIR use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED use musica_test_data, only: get_wavelength_edges + real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR__G_MOL = MOLAR_MASS_DRY_AIR * 1.0e3_kind_phys ! g mol-1 integer, parameter :: NUM_COLUMNS = 2 integer, parameter :: NUM_LAYERS = 2 integer, parameter :: NUM_WAVELENGTH_BINS = 102 @@ -322,7 +323,7 @@ subroutine test_initialize_tuvx_species() end do call musica_ccpp_init( NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode ) + constituent_props_ptr, MOLAR_MASS_DRY_AIR__G_MOL, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 diff --git a/test/musica/util/CMakeLists.txt b/test/musica/util/CMakeLists.txt index 6484f1c9..f3a27b4a 100644 --- a/test/musica/util/CMakeLists.txt +++ b/test/musica/util/CMakeLists.txt @@ -15,7 +15,7 @@ target_sources(test_musica_grid target_link_libraries(test_musica_grid PRIVATE - musica-fortran musica yaml-cpp stdc++ netcdff + musica-fortran musica mechanism_configuration yaml-cpp stdc++ netcdff ) set_target_properties(test_musica_grid From e05850ede0571c5c950ed86e4d73e1bab46a348a Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 13 Jun 2025 11:50:48 -0600 Subject: [PATCH 07/11] fix invalid horizontal dimensions (#251) Originator(s): peverwhee Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): The newest framework tag has checking for proper horizontal dimensions (depending on the phase), so this just fixes two instances of the incorrect horizontal dimension being used. List all namelist files that were added or changed: n/a List all files eliminated and why: n/a List all files added and what they do: n/a List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) M schemes/sima_diagnostics/check_energy_fix_diagnostics.meta M schemes/tropopause_find/tropopause_find.meta - replace horizontal_dimension with horizontal_loop_extent in run phase List all automated tests that failed, as well as an explanation for why they weren't fixed: Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? no If yes to the above question, describe how this code was validated with the new/modified features: --- schemes/sima_diagnostics/check_energy_fix_diagnostics.meta | 2 +- schemes/tropopause_find/tropopause_find.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta index c5811a27..1288ee9b 100644 --- a/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta +++ b/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta @@ -25,7 +25,7 @@ standard_name = vertically_integrated_total_energy_using_dycore_energy_formula_at_start_of_physics_timestep units = J m-2 type = real | kind = kind_phys - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) intent = in [ te_cur_dyn ] standard_name = vertically_integrated_total_energy_using_dycore_energy_formula diff --git a/schemes/tropopause_find/tropopause_find.meta b/schemes/tropopause_find/tropopause_find.meta index bc0978e1..a34f9df0 100644 --- a/schemes/tropopause_find/tropopause_find.meta +++ b/schemes/tropopause_find/tropopause_find.meta @@ -115,7 +115,7 @@ standard_name = tropopause_air_pressure_from_tropopause_climatology_dataset units = Pa type = real | kind = kind_phys - dimensions = (horizontal_dimension, number_of_time_slices_in_tropopause_climatology_dataset) + dimensions = (horizontal_loop_extent, number_of_time_slices_in_tropopause_climatology_dataset) intent = in [ tropp_days ] standard_name = tropopause_calendar_days_from_tropopause_climatology From e4cd7f23b124761015b3723f51912a1d5f8c79d2 Mon Sep 17 00:00:00 2001 From: Kuan-Chih Wang Date: Tue, 17 Jun 2025 04:02:55 +0800 Subject: [PATCH 08/11] Add YSU orographic gravity wave drag scheme (#232) ### Originator(s): kuanchihwang ### Descriptions (include the issue title, and the keyword ['closes', 'fixes', 'resolves'] followed by the issue number): This PR introduces the new *EXPERIMENTAL* "convection-permitting" physics suite. YSU orographic gravity wave drag scheme is the first physics scheme to be ported and included. YSU orographic gravity wave drag scheme is part of MMM physics, which is brought in as an external dependency (i.e., git submodule) and is shared between MMM models (e.g., MPAS, WRF). However, due to the significant architectural and design differences between CAM-SIMA and MMM models, a CCPP-compliant compatibility layer is implemented to transparently convert procedure calls between CCPP physics caps and MMM physics. This design decision is also influenced by the request of MMM scientists. The MMM physics repository will only house the "primary schemes", while their associated "interstitial schemes" as well as metadata files will be brought here. Therefore, CCPP physics caps will not interface MMM physics directly, but will do so through the compatibility layer instead. ### List all namelist files that were added or changed: None ### List all files eliminated and why: None ### List all files added and what they do: ``` A .gitmodules A schemes/mmm/mmm_physics * Add MMM physics as git submodule A schemes/mmm/bl_gwdo_compat.F90 A schemes/mmm/bl_gwdo_compat.meta * Add compatibility layer for YSU orographic gravity wave drag scheme A schemes/mmm/ccpp_kind_types.F90 A schemes/mmm/mmm_physics_compat.F90 A schemes/mmm/mmm_physics_compat.meta * Add compatibility layer for MMM physics A schemes/mmm/CMakeLists.txt * Enable CMake to build MMM physics compatibility layer A test/test_suites/suite_convection_permitting.xml * Add suite definition file for the new "convection-permitting" physics suite A test/unit-test/tests/mmm/CMakeLists.txt A test/unit-test/tests/mmm/mmm_physics_compat_tests.pf * Enable testing for MMM physics compatibility layer ``` ### List all existing files that have been modified, and describe the changes: ``` M test/unit-test/CMakeLists.txt M test/unit-test/tests/CMakeLists.txt * Enable testing for MMM physics compatibility layer ``` ### List all automated tests that failed, as well as an explanation for why they were not fixed: None ### Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? Answer-changing for the convection-permitting physics suite due to a newly added physics scheme. Nothing is changed for the rest. ### If yes to the above question, describe how this code was validated with the new/modified features: The convection-permitting physics suite is considered an experimental feature. There is no baseline available to validate against because it has never been implemented in CAM-SIMA as well as CAM before. --- .gitmodules | 6 + schemes/mmm/CMakeLists.txt | 29 ++ schemes/mmm/bl_gwdo_compat.F90 | 197 +++++++++ schemes/mmm/bl_gwdo_compat.meta | 413 ++++++++++++++++++ schemes/mmm/ccpp_kind_types.F90 | 11 + schemes/mmm/mmm_physics | 1 + schemes/mmm/mmm_physics_compat.F90 | 88 ++++ schemes/mmm/mmm_physics_compat.meta | 141 ++++++ .../suite_convection_permitting.xml | 18 + test/unit-test/CMakeLists.txt | 3 +- test/unit-test/tests/CMakeLists.txt | 1 + test/unit-test/tests/mmm/CMakeLists.txt | 8 + .../tests/mmm/mmm_physics_compat_tests.pf | 124 ++++++ 13 files changed, 1039 insertions(+), 1 deletion(-) create mode 100644 .gitmodules create mode 100644 schemes/mmm/CMakeLists.txt create mode 100644 schemes/mmm/bl_gwdo_compat.F90 create mode 100644 schemes/mmm/bl_gwdo_compat.meta create mode 100644 schemes/mmm/ccpp_kind_types.F90 create mode 160000 schemes/mmm/mmm_physics create mode 100644 schemes/mmm/mmm_physics_compat.F90 create mode 100644 schemes/mmm/mmm_physics_compat.meta create mode 100644 test/test_suites/suite_convection_permitting.xml create mode 100644 test/unit-test/tests/mmm/CMakeLists.txt create mode 100644 test/unit-test/tests/mmm/mmm_physics_compat_tests.pf diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..aa99bf1b --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "mmm-physics"] + path = schemes/mmm/mmm_physics + url = https://github.com/NCAR/MMM-physics.git + fxtag = 20240626-MPASv8.2 + fxrequired = AlwaysRequired + fxDONOTUSEurl = https://github.com/NCAR/MMM-physics.git diff --git a/schemes/mmm/CMakeLists.txt b/schemes/mmm/CMakeLists.txt new file mode 100644 index 00000000..e52c1192 --- /dev/null +++ b/schemes/mmm/CMakeLists.txt @@ -0,0 +1,29 @@ +cmake_minimum_required(VERSION 3.20) + +# `mmm_physics_compat` has not been integrated into the CMake build of any top level projects yet, +# and this CMakeLists.txt file is currently for unit testing purposes only. +# Making a change to this CMakeLists.txt file will not impact the build of a parent project at this time. +project(mmm_physics_compat + VERSION + 0.1.0 + DESCRIPTION + "MMM physics compatibility layer for CCPP" + LANGUAGES + Fortran +) + +add_library(mmm_physics_compat) +target_sources(mmm_physics_compat + PRIVATE + ../../test/unit-test/include/ccpp_kinds.F90 + ccpp_kind_types.F90 + mmm_physics_compat.F90 +) +target_compile_options(mmm_physics_compat + PRIVATE + $<$,$>:-fbacktrace -fcheck=all -std=f2018 -Wall -Wextra -Wpedantic> +) +target_include_directories(mmm_physics_compat + INTERFACE + ${CMAKE_CURRENT_BINARY_DIR} +) diff --git a/schemes/mmm/bl_gwdo_compat.F90 b/schemes/mmm/bl_gwdo_compat.F90 new file mode 100644 index 00000000..0a5d7a9b --- /dev/null +++ b/schemes/mmm/bl_gwdo_compat.F90 @@ -0,0 +1,197 @@ +!> This module contains interstitial schemes that are specific to YSU orographic gravity wave drag scheme, +!> which is part of MMM physics. +module bl_gwdo_compat + implicit none + + private + public :: bl_gwdo_compat_pre_init + public :: bl_gwdo_compat_pre_run + public :: bl_gwdo_compat_run + public :: bl_gwdo_diagnostics_init + public :: bl_gwdo_diagnostics_run +contains + !> \section arg_table_bl_gwdo_compat_pre_init Argument Table + !! \htmlinclude bl_gwdo_compat_pre_init.html + pure subroutine bl_gwdo_compat_pre_init( & + omega, rearth, & + dxmeter, sina, cosa, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: omega(:), rearth + real(kind_phys), intent(out) :: dxmeter(:), sina(:), cosa(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! These variables do not change with time. Set them just once at model initialization for better performance. + + ! The "bl_gwdo" physics scheme needs grid sizes in meters. This is trivial for models with regular grids like WRF, + ! but not so straightforward for models with unstructured grids like CAM-SIMA. Here, the square root of cell area is used. + dxmeter(:) = sqrt(omega(:) * (rearth ** 2)) + + ! The "bl_gwdo" physics scheme was originally designed to be used with regional models like WRF, where the positive X and + ! Y directions may not always point to the east and north, respectively. This is no longer the case for global models like + ! CAM-SIMA. + + ! The angle of rotation from east to X is zero. + sina(:) = 0.0_kind_phys + cosa(:) = 1.0_kind_phys + end subroutine bl_gwdo_compat_pre_init + + !> \section arg_table_bl_gwdo_compat_pre_run Argument Table + !! \htmlinclude bl_gwdo_compat_pre_run.html + pure subroutine bl_gwdo_compat_pre_run( & + u, v, & + uproj, vproj, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: u(:, :), v(:, :) + real(kind_phys), intent(out) :: uproj(:, :), vproj(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! The "bl_gwdo" physics scheme was originally designed to be used with regional models like WRF, where the positive X and + ! Y directions may not always point to the east and north, respectively. This is no longer the case for global models like + ! CAM-SIMA. + + ! X and Y winds are just eastward and northward winds, respectively. + uproj(:, :) = u(:, :) + vproj(:, :) = v(:, :) + end subroutine bl_gwdo_compat_pre_run + + !> \section arg_table_bl_gwdo_compat_run Argument Table + !! \htmlinclude bl_gwdo_compat_run.html + subroutine bl_gwdo_compat_run( & + sina, cosa, & + rublten, rvblten, & + dtaux3d, dtauy3d, & + dusfcg, dvsfcg, & + uproj, vproj, & + t1, q1, & + prsi, prsl, prslk, zl, & + var, oc1, & + oa2d1, oa2d2, & + oa2d3, oa2d4, & + ol2d1, ol2d2, & + ol2d3, ol2d4, & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter, deltim, & + its, ite, kte, kme, & + errmsg, errflg) + use bl_gwdo, only: bl_gwdo_run + use ccpp_kinds, only: kind_phys + + integer, intent(in) :: & + its, ite, kte, kme + real(kind_phys), intent(in) :: & + sina(:), cosa(:), & + uproj(:, :), vproj(:, :), & + t1(:, :), q1(:, :), & + prsi(:, :), prsl(:, :), prslk(:, :), zl(:, :), & + var(:), oc1(:), & + oa2d1(:), oa2d2(:), & + oa2d3(:), oa2d4(:), & + ol2d1(:), ol2d2(:), & + ol2d3(:), ol2d4(:), & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter(:), deltim + real(kind_phys), intent(inout) :: & + rublten(:, :), rvblten(:, :) + real(kind_phys), intent(out) :: & + dtaux3d(:, :), dtauy3d(:, :), & + dusfcg(:), dvsfcg(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! All members of MMM physics expect vertical indexes to be in ascending order from bottom to top of atmosphere, + ! which is the exact opposite to CAM-SIMA. + ! + ! For all variables with a vertical dimension, they must be flipped upside down. + ! This can be achieved by the `associate` construct with array bounds remapping so that the actual array bounds + ! stays intact elsewhere. + associate ( & + rublten_r => rublten(:, size(rublten, 2):1:-1), & + rvblten_r => rvblten(:, size(rvblten, 2):1:-1), & + dtaux3d_r => dtaux3d(:, size(dtaux3d, 2):1:-1), & + dtauy3d_r => dtauy3d(:, size(dtauy3d, 2):1:-1), & + uproj_r => uproj(:, size(uproj, 2):1:-1), & + vproj_r => vproj(:, size(vproj, 2):1:-1), & + t1_r => t1(:, size(t1, 2):1:-1), & + q1_r => q1(:, size(q1, 2):1:-1), & + prsi_r => prsi(:, size(prsi, 2):1:-1), & + prsl_r => prsl(:, size(prsl, 2):1:-1), & + prslk_r => prslk(:, size(prslk, 2):1:-1), & + zl_r => zl(:, size(zl, 2):1:-1)) + call bl_gwdo_run( & + sina, cosa, & + rublten_r, rvblten_r, & + dtaux3d_r, dtauy3d_r, & + dusfcg, dvsfcg, & + uproj_r, vproj_r, & + t1_r, q1_r, & + prsi_r, prsl_r, prslk_r, zl_r, & + var, oc1, & + oa2d1, oa2d2, & + oa2d3, oa2d4, & + ol2d1, ol2d2, & + ol2d3, ol2d4, & + g_, cp_, rd_, rv_, fv_, pi_, & + dxmeter, deltim, & + its, ite, kte, kme, & + errmsg, errflg) + end associate + end subroutine bl_gwdo_compat_run + + !> \section arg_table_bl_gwdo_diagnostics_init Argument Table + !! \htmlinclude bl_gwdo_diagnostics_init.html + subroutine bl_gwdo_diagnostics_init( & + errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! The "bl_gwdo" physics scheme makes a distinction between X/Y winds and eastward/northward winds. See + ! the "bl_gwdo_compat_pre" interstitial scheme for details. However, here we just refer to its diagnostics as + ! eastward/northward to make them more familiar to CAM-SIMA users. + call history_add_field('bl_gwdo_dtaux3d', 'tendency_of_eastward_wind_due_to_orographic_gwd', 'lev', 'avg', 'm s-2') + call history_add_field('bl_gwdo_dtauy3d', 'tendency_of_northward_wind_due_to_orographic_gwd', 'lev', 'avg', 'm s-2') + call history_add_field('bl_gwdo_dusfcg', 'atmosphere_eastward_stress_due_to_orographic_gwd', horiz_only, 'avg', 'Pa') + call history_add_field('bl_gwdo_dvsfcg', 'atmosphere_northward_stress_due_to_orographic_gwd', horiz_only, 'avg', 'Pa') + end subroutine bl_gwdo_diagnostics_init + + !> \section arg_table_bl_gwdo_diagnostics_run Argument Table + !! \htmlinclude bl_gwdo_diagnostics_run.html + subroutine bl_gwdo_diagnostics_run( & + dtaux3d, dtauy3d, dusfcg, dvsfcg, & + errmsg, errflg) + use cam_history, only: history_out_field + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: dtaux3d(:, :), dtauy3d(:, :), dusfcg(:), dvsfcg(:) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + call history_out_field('bl_gwdo_dtaux3d', dtaux3d) + call history_out_field('bl_gwdo_dtauy3d', dtauy3d) + call history_out_field('bl_gwdo_dusfcg', dusfcg) + call history_out_field('bl_gwdo_dvsfcg', dvsfcg) + end subroutine bl_gwdo_diagnostics_run +end module bl_gwdo_compat diff --git a/schemes/mmm/bl_gwdo_compat.meta b/schemes/mmm/bl_gwdo_compat.meta new file mode 100644 index 00000000..f154a5f7 --- /dev/null +++ b/schemes/mmm/bl_gwdo_compat.meta @@ -0,0 +1,413 @@ +[ccpp-table-properties] + name = bl_gwdo_compat_pre + type = scheme + +[ccpp-arg-table] + name = bl_gwdo_compat_pre_init + type = scheme +[ omega ] + standard_name = cell_angular_area + units = sr + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = in +[ rearth ] + standard_name = radius_of_earth + units = m + type = real | kind = kind_phys + dimensions = () + intent = in +[ dxmeter ] + standard_name = characteristic_grid_lengthscale + units = m + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ sina ] + standard_name = sine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ cosa ] + standard_name = cosine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = bl_gwdo_compat_pre_run + type = scheme +[ u ] + standard_name = eastward_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ v ] + standard_name = northward_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ uproj ] + standard_name = x_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ vproj ] + standard_name = y_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = bl_gwdo_compat + type = scheme + dependencies = ccpp_kind_types.F90, mmm_physics/bl_gwdo.F90 + +[ccpp-arg-table] + name = bl_gwdo_compat_run + type = scheme +[ sina ] + standard_name = sine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ cosa ] + standard_name = cosine_of_angle_of_rotation_from_east_to_x + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ dtaux3d ] + standard_name = tendency_of_x_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ dtauy3d ] + standard_name = tendency_of_y_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ dusfcg ] + standard_name = atmosphere_x_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ dvsfcg ] + standard_name = atmosphere_y_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = out +[ uproj ] + standard_name = x_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ vproj ] + standard_name = y_wind + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ t1 ] + standard_name = air_temperature + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ q1 ] + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ prsi ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ prsl ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prslk ] + standard_name = dimensionless_exner_function + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ zl ] + standard_name = geopotential_height + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ var ] + standard_name = standard_deviation_of_subgrid_orography + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oc1 ] + standard_name = convexity_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d1 ] + standard_name = eastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d2 ] + standard_name = northward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d3 ] + standard_name = northeastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ oa2d4 ] + standard_name = southeastward_asymmetry_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d1 ] + standard_name = eastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d2 ] + standard_name = northward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d3 ] + standard_name = northeastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ ol2d4 ] + standard_name = southeastward_dimensionless_effective_length_of_subgrid_orography + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ g_ ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ cp_ ] + standard_name = specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rd_ ] + standard_name = gas_constant_of_dry_air + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ rv_ ] + standard_name = gas_constant_of_water_vapor + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ fv_ ] + standard_name = ratio_of_water_vapor_to_dry_air_gas_constants_minus_one + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ pi_ ] + standard_name = pi_constant + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ dxmeter ] + standard_name = characteristic_grid_lengthscale + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ deltim ] + standard_name = timestep_for_physics + units = s + type = real | kind = kind_phys + dimensions = () + intent = in +[ its ] + standard_name = horizontal_loop_begin + units = count + type = integer + dimensions = () + intent = in +[ ite ] + standard_name = horizontal_loop_end + units = count + type = integer + dimensions = () + intent = in +[ kte ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ kme ] + standard_name = vertical_interface_dimension + units = count + type = integer + dimensions = () + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = bl_gwdo_diagnostics + type = scheme + +[ccpp-arg-table] + name = bl_gwdo_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = bl_gwdo_diagnostics_run + type = scheme +[ dtaux3d ] + standard_name = tendency_of_x_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ dtauy3d ] + standard_name = tendency_of_y_wind_due_to_orographic_gwd + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ dusfcg ] + standard_name = atmosphere_x_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ dvsfcg ] + standard_name = atmosphere_y_stress_due_to_orographic_gwd + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/mmm/ccpp_kind_types.F90 b/schemes/mmm/ccpp_kind_types.F90 new file mode 100644 index 00000000..555453cd --- /dev/null +++ b/schemes/mmm/ccpp_kind_types.F90 @@ -0,0 +1,11 @@ +!> The mere existence of this module is to satisfy the misdirected dependency of MMM physics, +!> which inexplicably depends on `ccpp_kind_types` instead of `ccpp_kinds`. +module ccpp_kind_types + use ccpp_kinds, only: kind_phys + + implicit none + + private + public :: kind_phys +contains +end module ccpp_kind_types diff --git a/schemes/mmm/mmm_physics b/schemes/mmm/mmm_physics new file mode 160000 index 00000000..0ea59b1c --- /dev/null +++ b/schemes/mmm/mmm_physics @@ -0,0 +1 @@ +Subproject commit 0ea59b1cd673006ee7a9a9958c533a6a0e354243 diff --git a/schemes/mmm/mmm_physics_compat.F90 b/schemes/mmm/mmm_physics_compat.F90 new file mode 100644 index 00000000..4ef5f048 --- /dev/null +++ b/schemes/mmm/mmm_physics_compat.F90 @@ -0,0 +1,88 @@ +!> This module contains interstitial schemes that are specific to MMM physics. +module mmm_physics_compat + implicit none + + private + public :: mmm_physics_accumulate_tendencies_timestep_init + public :: mmm_physics_accumulate_tendencies_run + public :: geopotential_height_wrt_sfc_to_msl_run +contains + !> \section arg_table_mmm_physics_accumulate_tendencies_timestep_init Argument Table + !! \htmlinclude mmm_physics_accumulate_tendencies_timestep_init.html + pure subroutine mmm_physics_accumulate_tendencies_timestep_init( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(out) :: dudt(:, :), dvdt(:, :) + real(kind_phys), intent(out) :: rublten(:, :), rvblten(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Zero out tendencies at the beginning of each time step. + + ! Tendencies for feeding back to CAM-SIMA. + dudt(:, :) = 0.0_kind_phys + dvdt(:, :) = 0.0_kind_phys + + ! Tendencies generated by MMM physics. + rublten(:, :) = 0.0_kind_phys + rvblten(:, :) = 0.0_kind_phys + end subroutine mmm_physics_accumulate_tendencies_timestep_init + + !> \section arg_table_mmm_physics_accumulate_tendencies_run Argument Table + !! \htmlinclude mmm_physics_accumulate_tendencies_run.html + pure subroutine mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(inout) :: dudt(:, :), dvdt(:, :) + real(kind_phys), intent(inout) :: rublten(:, :), rvblten(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! Accumulate tendencies for feeding back to CAM-SIMA. + dudt(:, :) = dudt(:, :) + rublten(:, :) + dvdt(:, :) = dvdt(:, :) + rvblten(:, :) + + ! After the accumulation, zero out tendencies generated by MMM physics so that this subroutine is idempotent. + rublten(:, :) = 0.0_kind_phys + rvblten(:, :) = 0.0_kind_phys + end subroutine mmm_physics_accumulate_tendencies_run + + !> \section arg_table_geopotential_height_wrt_sfc_to_msl_run Argument Table + !! \htmlinclude geopotential_height_wrt_sfc_to_msl_run.html + pure subroutine geopotential_height_wrt_sfc_to_msl_run( & + ncol, & + gravit, phis, zmsfc, & + zmmsl, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: gravit, phis(:), zmsfc(:, :) + real(kind_phys), intent(out) :: zmmsl(:, :) + character(*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i + + errmsg = '' + errflg = 0 + + ! Convert geopotential height wrt surface to geopotential height wrt mean sea level, in accordance with + ! its normal definition. + do i = 1, ncol + zmmsl(i, :) = phis(i) / gravit + zmsfc(i, :) + end do + end subroutine geopotential_height_wrt_sfc_to_msl_run +end module mmm_physics_compat diff --git a/schemes/mmm/mmm_physics_compat.meta b/schemes/mmm/mmm_physics_compat.meta new file mode 100644 index 00000000..36669f15 --- /dev/null +++ b/schemes/mmm/mmm_physics_compat.meta @@ -0,0 +1,141 @@ +[ccpp-table-properties] + name = mmm_physics_accumulate_tendencies + type = scheme + +[ccpp-arg-table] + name = mmm_physics_accumulate_tendencies_timestep_init + type = scheme +[ dudt ] + standard_name = tendency_of_eastward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ dvdt ] + standard_name = tendency_of_northward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = mmm_physics_accumulate_tendencies_run + type = scheme +[ dudt ] + standard_name = tendency_of_eastward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ dvdt ] + standard_name = tendency_of_northward_wind + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rublten ] + standard_name = tendency_of_x_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ rvblten ] + standard_name = tendency_of_y_wind_due_to_pbl_processes + units = m s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = inout +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out + +# ---------- + +[ccpp-table-properties] + name = geopotential_height_wrt_sfc_to_msl + type = scheme + +[ccpp-arg-table] + name = geopotential_height_wrt_sfc_to_msl_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ gravit ] + standard_name = standard_gravitational_acceleration + units = m s-2 + type = real | kind = kind_phys + dimensions = () + intent = in +[ phis ] + standard_name = surface_geopotential + units = m2 s-2 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ zmsfc ] + standard_name = geopotential_height_wrt_surface + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ zmmsl ] + standard_name = geopotential_height + units = m + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=* + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/test/test_suites/suite_convection_permitting.xml b/test/test_suites/suite_convection_permitting.xml new file mode 100644 index 00000000..8bd916f7 --- /dev/null +++ b/test/test_suites/suite_convection_permitting.xml @@ -0,0 +1,18 @@ + + + + + calc_exner + geopotential_height_wrt_sfc_to_msl + bl_gwdo_compat_pre + bl_gwdo_compat + bl_gwdo_diagnostics + mmm_physics_accumulate_tendencies + apply_tendency_of_eastward_wind + apply_tendency_of_northward_wind + sima_state_diagnostics + + + sima_tend_diagnostics + + diff --git a/test/unit-test/CMakeLists.txt b/test/unit-test/CMakeLists.txt index 49d17506..728e7a1f 100644 --- a/test/unit-test/CMakeLists.txt +++ b/test/unit-test/CMakeLists.txt @@ -41,8 +41,9 @@ add_library(phys_utils ${PHYS_UTILS_SRC}) target_compile_options(phys_utils PRIVATE -ffree-line-length-none) target_include_directories(phys_utils PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) +add_subdirectory(../../schemes/mmm mmm) + if(ATMOSPHERIC_PHYSICS_ENABLE_TESTS OR ATMOSPHERIC_PHYSICS_ENABLE_CODE_COVERAGE) enable_testing() add_subdirectory(tests) endif() - diff --git a/test/unit-test/tests/CMakeLists.txt b/test/unit-test/tests/CMakeLists.txt index 705189f1..d425a177 100644 --- a/test/unit-test/tests/CMakeLists.txt +++ b/test/unit-test/tests/CMakeLists.txt @@ -1,2 +1,3 @@ add_subdirectory(utilities) add_subdirectory(phys_utils) +add_subdirectory(mmm) diff --git a/test/unit-test/tests/mmm/CMakeLists.txt b/test/unit-test/tests/mmm/CMakeLists.txt new file mode 100644 index 00000000..69528847 --- /dev/null +++ b/test/unit-test/tests/mmm/CMakeLists.txt @@ -0,0 +1,8 @@ +add_pfunit_ctest(mmm_physics_compat_tests + TEST_SOURCES + mmm_physics_compat_tests.pf + OTHER_SOURCES + ../../include/ccpp_kinds.F90 + LINK_LIBRARIES + mmm_physics_compat +) diff --git a/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf b/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf new file mode 100644 index 00000000..bdd7b21e --- /dev/null +++ b/test/unit-test/tests/mmm/mmm_physics_compat_tests.pf @@ -0,0 +1,124 @@ +@test +subroutine test_mmm_physics_accumulate_tendencies_timestep_init() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: mmm_physics_accumulate_tendencies_timestep_init + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: dudt(ncol, pver), dvdt(ncol, pver) + real(kind_phys) :: rublten(ncol, pver), rvblten(ncol, pver) + character(100) :: errmsg + integer :: errflg + + dudt(:, :) = huge(0.0_kind_phys) + dvdt(:, :) = huge(0.0_kind_phys) + rublten(:, :) = huge(0.0_kind_phys) + rvblten(:, :) = huge(0.0_kind_phys) + + call mmm_physics_accumulate_tendencies_timestep_init( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Everything should be zeroed out. + @assertEqual(0.0_kind_phys, dudt) + @assertEqual(0.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_mmm_physics_accumulate_tendencies_timestep_init + +@test +subroutine test_mmm_physics_accumulate_tendencies_run() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: mmm_physics_accumulate_tendencies_run + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: dudt(ncol, pver), dvdt(ncol, pver) + real(kind_phys) :: rublten(ncol, pver), rvblten(ncol, pver) + character(100) :: errmsg + integer :: errflg + + dudt(:, :) = 0.0_kind_phys + dvdt(:, :) = 0.0_kind_phys + rublten(:, :) = 1.0_kind_phys + rvblten(:, :) = 1.0_kind_phys + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Should accumulate MMM tendencies into CAM-SIMA ones. + @assertEqual(1.0_kind_phys, dudt) + @assertEqual(1.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) + + rublten(:, :) = 2.0_kind_phys + rvblten(:, :) = 2.0_kind_phys + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Should accumulate MMM tendencies into CAM-SIMA ones. + @assertEqual(3.0_kind_phys, dudt) + @assertEqual(3.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + call mmm_physics_accumulate_tendencies_run( & + dudt, dvdt, & + rublten, rvblten, & + errmsg, errflg) + + ! Consecutive calls should be idempotent. + @assertEqual(3.0_kind_phys, dudt) + @assertEqual(3.0_kind_phys, dvdt) + @assertEqual(0.0_kind_phys, rublten) + @assertEqual(0.0_kind_phys, rvblten) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_mmm_physics_accumulate_tendencies_run + +@test +subroutine test_geopotential_height_wrt_sfc_to_msl_run() + use ccpp_kinds, only: kind_phys + use funit + use mmm_physics_compat, only: geopotential_height_wrt_sfc_to_msl_run + + integer, parameter :: ncol = 100, pver = 10 + real(kind_phys) :: gravit, phis(ncol), zmsfc(ncol, pver) + real(kind_phys) :: zmmsl(ncol, pver) + character(100) :: errmsg + integer :: errflg + + gravit = 9.8_kind_phys + phis(:) = 98.0_kind_phys + zmsfc(:, :) = 10.0_kind_phys + zmmsl(:, :) = huge(0.0_kind_phys) + + call geopotential_height_wrt_sfc_to_msl_run( & + ncol, & + gravit, phis, zmsfc, & + zmmsl, & + errmsg, errflg) + + ! Should compute geopotential height wrt mean sea level correctly. + @assertEqual(20.0_kind_phys, zmmsl) + @assertEqual('', errmsg) + @assertEqual(0, errflg) +end subroutine test_geopotential_height_wrt_sfc_to_msl_run From 4a31043bb8bd6179db3b59db4895b0563b78af88 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Mon, 16 Jun 2025 17:49:27 -0400 Subject: [PATCH 09/11] Phase 2 of rk_stratiform CCPPization: diagnostic schemes (#234) Originator(s): @jimmielin Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): - Closes #190 completes conversion of rk_stratiform microphysics to CCPP List all namelist files that were added or changed: N/A List all files eliminated and why: N/A List all files added and what they do: ``` A schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 A schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta A schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 A schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta - cldfrc diagnostic schemes, - including split out shallow/deep convective cloud cover in convective_cloud_cover scheme A schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 A schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta A schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 A schemes/sima_diagnostics/rk_stratiform_diagnostics.meta - RK diagnostic schemes ``` List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) ``` M schemes/cloud_fraction/compute_cloud_fraction.meta M schemes/cloud_fraction/convective_cloud_cover.meta M schemes/hack_shallow/hack_convect_shallow.meta M schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 M schemes/rasch_kristjansson/cloud_particle_sedimentation.meta M schemes/rasch_kristjansson/prognostic_cloud_water.F90 M schemes/rasch_kristjansson/prognostic_cloud_water.meta M schemes/rasch_kristjansson/rk_stratiform.meta - update with assigned standard names - minor cleanup of unused variables ``` List all automated tests that failed, as well as an explanation for why they weren't fixed: N/A Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? N/A - SIMA diagnostics only If yes to the above question, describe how this code was validated with the new/modified features: N/A --- doc/NamesNotInDictionary.txt | 635 +++++++++++++++++- .../compute_cloud_fraction.meta | 10 +- .../convective_cloud_cover.meta | 6 +- .../hack_shallow/hack_convect_shallow.meta | 2 +- .../cloud_particle_sedimentation.F90 | 7 +- .../cloud_particle_sedimentation.meta | 6 +- .../prognostic_cloud_water.F90 | 21 +- .../prognostic_cloud_water.meta | 42 +- schemes/rasch_kristjansson/rk_stratiform.F90 | 10 +- schemes/rasch_kristjansson/rk_stratiform.meta | 58 +- ...oud_particle_sedimentation_diagnostics.F90 | 84 +++ ...ud_particle_sedimentation_diagnostics.meta | 77 +++ .../compute_cloud_fraction_diagnostics.F90 | 57 ++ .../compute_cloud_fraction_diagnostics.meta | 41 ++ .../convect_shallow_diagnostics.F90 | 1 - .../convective_cloud_cover_diagnostics.F90 | 63 ++ .../convective_cloud_cover_diagnostics.meta | 53 ++ .../rk_stratiform_diagnostics.F90 | 327 +++++++++ .../rk_stratiform_diagnostics.meta | 371 ++++++++++ suites/suite_cam4.xml | 86 ++- test/test_suites/suite_rasch_kristjansson.xml | 15 +- 21 files changed, 1861 insertions(+), 111 deletions(-) create mode 100644 schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta create mode 100644 schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta create mode 100644 schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta create mode 100644 schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 create mode 100644 schemes/sima_diagnostics/rk_stratiform_diagnostics.meta diff --git a/doc/NamesNotInDictionary.txt b/doc/NamesNotInDictionary.txt index fd11ee07..ef98dec9 100644 --- a/doc/NamesNotInDictionary.txt +++ b/doc/NamesNotInDictionary.txt @@ -1,15 +1,36 @@ ####################### Date/time of when script was run: -2025-02-13 20:35:20.393146 +2025-06-16 17:08:09.244285 ####################### Non-dictionary standard names found in the following metadata files: -------------------------- +atmospheric_physics/schemes/sima_diagnostics/sima_tend_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_evap_tendency_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_deep_convection - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_deep_convection - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water @@ -18,6 +39,8 @@ atmospheric_physics/schemes/sima_diagnostics/zm_evap_tendency_diagnostics.meta atmospheric_physics/schemes/sima_diagnostics/check_energy_gmean_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - flag_for_energy_global_means_output - global_mean_heating_rate_correction_for_energy_conservation - global_mean_vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep @@ -25,14 +48,58 @@ atmospheric_physics/schemes/sima_diagnostics/check_energy_gmean_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - deep_convective_cloud_area_fraction + - shallow_convective_cloud_area_fraction + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_tendency_diagnostics.meta + - ccpp_constituent_properties + - ccpp_constituent_tendencies + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/convect_shallow_diagnostics.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_constituent_properties - ccpp_constituent_tendencies + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - frozen_precipitation_flux_at_interface_due_to_shallow_convection + - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - liquid_water_static_energy_flux_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - number_of_ccpp_constituents + - precipitation_flux_at_interface_due_to_shallow_convection + - pressure_at_cloud_base_for_all_convection + - pressure_at_cloud_top_for_all_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_shallow_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - total_water_flux_due_to_shallow_convection + - vertical_index_at_cloud_base_for_all_convection + - vertical_index_at_cloud_top_for_all_convection -------------------------- atmospheric_physics/schemes/sima_diagnostics/check_energy_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - cumulative_total_energy_boundary_flux_using_physics_energy_formula - cumulative_total_water_boundary_flux - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula @@ -46,20 +113,72 @@ atmospheric_physics/schemes/sima_diagnostics/sima_state_diagnostics.meta - air_pressure_at_interface - air_pressure_of_dry_air_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - geopotential_height_wrt_surface_at_interface - ln_air_pressure_at_interface - ln_air_pressure_of_dry_air_at_interface - surface_air_pressure -------------------------- +atmospheric_physics/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta + + - accretion_of_cloud_ice_by_snow + - accretion_of_cloud_liquid_water_by_rain + - accretion_of_cloud_liquid_water_by_snow + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_area_fraction_from_relative_humidity_method + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - mass_fraction_of_ice_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - precipitation_production_due_to_microphysics + - rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_evaporation_of_falling_snow_due_to_microphysics + - rate_of_evaporation_of_precipitation_due_to_microphysics + - relative_importance_of_cloud_ice_autoconversion + - relative_importance_of_cloud_liquid_water_autoconversion + - relative_importance_of_rain_accreting_cloud_liquid_water + - relative_importance_of_snow_accreting_cloud_ice + - relative_importance_of_snow_accreting_cloud_liquid_water + - stratiform_rain_and_snow_flux_at_interface + - stratiform_snow_flux_at_interface + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/rayleigh_friction_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_convr_tendency_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water -------------------------- atmospheric_physics/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - vertically_integrated_total_energy_using_dycore_energy_formula - vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep @@ -67,8 +186,17 @@ atmospheric_physics/schemes/sima_diagnostics/check_energy_fix_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/kessler_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/tropopause_diagnostics.meta + - ccpp_error_code + - ccpp_error_message - tropopause_air_pressure - tropopause_air_pressure_from_climatological_method - tropopause_air_pressure_from_cold_point_method @@ -95,12 +223,29 @@ atmospheric_physics/schemes/sima_diagnostics/tropopause_diagnostics.meta -------------------------- +atmospheric_physics/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + - stratiform_cloud_area_fraction + +-------------------------- + +atmospheric_physics/schemes/sima_diagnostics/zm_momtran_tendency_diagnostics.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/sima_diagnostics/zm_diagnostics.meta - atmosphere_convective_mass_flux_due_to_deep_convection - atmosphere_downdraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - - detrainment_of_cloud_liquid_due_to_deep_convection + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection - frozen_precipitation_flux_at_interface_due_to_deep_convection - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - in_cloud_eastward_wind_in_downdraft_due_to_deep_convection @@ -124,9 +269,12 @@ atmospheric_physics/schemes/sima_diagnostics/zm_diagnostics.meta atmospheric_physics/schemes/tj2016/tj2016_precip.meta + - ccpp_error_code + - ccpp_error_message - gas_constant_of_water_vapor - lwe_large_scale_precipitation_rate_at_surface - ratio_of_water_vapor_to_dry_air_molecular_weights + - scheme_name - sum_of_sigma_pressure_hybrid_coordinate_a_coefficient_and_sigma_pressure_hybrid_coordinate_b_coefficient -------------------------- @@ -134,12 +282,15 @@ atmospheric_physics/schemes/tj2016/tj2016_precip.meta atmospheric_physics/schemes/tj2016/tj2016_sfc_pbl_hs.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - eddy_heat_diffusivity - eddy_momentum_diffusivity - gas_constant_of_water_vapor - ln_air_pressure_at_interface - pi_constant - ratio_of_water_vapor_to_dry_air_molecular_weights + - scheme_name - sum_of_sigma_pressure_hybrid_coordinate_a_coefficient_and_sigma_pressure_hybrid_coordinate_b_coefficient - surface_air_pressure - surface_eastward_wind_stress @@ -152,12 +303,176 @@ atmospheric_physics/schemes/tj2016/tj2016_sfc_pbl_hs.meta -------------------------- +atmospheric_physics/schemes/cloud_fraction/convective_cloud_cover.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_error_code + - ccpp_error_message + - deep_convective_cloud_area_fraction + - flag_for_cloud_area_fraction_to_use_shallow_convection_calculated_cloud_area_fraction + - shallow_convective_cloud_area_fraction + - shallow_convective_cloud_area_fraction_from_shallow_convection + - tunable_parameter_for_deep_convection_1_for_cloud_fraction + - tunable_parameter_for_deep_convection_2_for_cloud_fraction + - tunable_parameter_for_shallow_convection_1_for_cloud_fraction + - tunable_parameter_for_shallow_convection_2_for_cloud_fraction + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + +atmospheric_physics/schemes/cloud_fraction/compute_cloud_fraction.meta + + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_area_fraction_from_relative_humidity_method + - control_for_ice_cloud_fraction + - deep_convective_cloud_area_fraction + - do_ice_cloud_fraction_for_cloud_fraction + - do_no_stratification_based_cloud_fraction + - do_relative_humidity_perturbation_for_cloud_fraction + - do_vavrus_freeze_dry_adjustment_for_cloud_fraction + - freezing_point_of_water + - lwe_surface_snow_depth_over_land + - ocean_area_fraction + - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - reference_temperature_lapse_rate + - relative_humidity_threshold_for_cloud_formation + - shallow_convective_cloud_area_fraction + - stratiform_cloud_area_fraction + - stratiform_cloud_ice_area_fraction + - stratiform_cloud_liquid_area_fraction + - surface_air_pressure + - tunable_parameter_for_adjustment_to_minimum_relative_humidity_for_low_stable_clouds_for_land_without_snow_cover_for_cloud_fraction + - tunable_parameter_for_bottom_pressure_bound_for_mid_level_liquid_stratus_for_cloud_fraction + - tunable_parameter_for_critical_relative_humidity_for_ice_clouds_for_cloud_fraction_using_wilson_and_ballard_scheme + - tunable_parameter_for_minimum_relative_humidity_for_high_stable_clouds_for_cloud_fraction + - tunable_parameter_for_minimum_relative_humidity_for_low_stable_clouds_for_cloud_fraction + - tunable_parameter_for_top_pressure_bound_for_mid_level_clouds_for_cloud_fraction + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + atmospheric_physics/schemes/cloud_fraction/cloud_fraction_fice.meta + - ccpp_error_code + - ccpp_error_message - freezing_point_of_water - mass_fraction_of_ice_content_within_stratiform_cloud - mass_fraction_of_snow_content_within_stratiform_cloud - - vertical_layer_index_of_troposphere_cloud_top + - vertical_layer_index_of_cloud_fraction_top + +-------------------------- + +atmospheric_physics/schemes/cloud_fraction/set_cloud_fraction_top.meta + + - ccpp_error_code + - ccpp_error_message + - vertical_layer_index_of_cloud_fraction_top + - vertical_layer_index_of_troposphere_cloud_physics_top + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/convect_shallow_sum_to_deep.meta + + - atmosphere_convective_mass_flux_due_to_all_convection + - atmosphere_convective_mass_flux_due_to_deep_convection + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_error_code + - ccpp_error_message + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - pressure_at_cloud_base_for_all_convection + - pressure_at_cloud_top_for_all_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - vertical_index_at_cloud_base_for_all_convection + - vertical_index_at_cloud_base_for_shallow_convection + - vertical_index_at_cloud_top_for_all_convection + - vertical_index_at_cloud_top_for_shallow_convection + - vertical_index_at_top_of_deep_convection_for_convective_columns + - vertical_index_of_deep_convection_launch_level_for_convective_columns + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - vertically_integrated_cloud_liquid_water_tendency_due_to_shallow_convection_to_be_applied_later_in_time_loop + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/hack_convect_shallow.meta + + - atmosphere_convective_mass_flux_due_to_shallow_convection + - ccpp_constituent_properties + - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - characteristic_adjustment_time_for_shallow_convection + - convective_water_vapor_wrt_moist_air_and_condensed_water_perturbation_due_to_pbl_eddies + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - flag_for_cloud_area_fraction_to_use_shallow_convection_calculated_cloud_area_fraction + - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - liquid_water_static_energy_flux_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - net_liquid_and_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column + - number_of_ccpp_constituents + - rain_water_autoconversion_coefficient_for_shallow_convection + - reference_pressure_at_interface + - scheme_name + - shallow_convective_cloud_area_fraction_from_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + - total_water_flux_due_to_shallow_convection + - vertical_index_at_cloud_base_for_shallow_convection + - vertical_index_at_cloud_top_for_shallow_convection + - vertical_layer_index_of_cloud_fraction_top + - vertically_integrated_cloud_liquid_water_tendency_due_to_shallow_convection_to_be_applied_later_in_time_loop + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/set_shallow_conv_fluxes_to_general.meta + + - lwe_precipitation_rate_at_surface_due_to_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection_excluding_subcloud_evaporation + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection_excluding_subcloud_evaporation + +-------------------------- + +atmospheric_physics/schemes/hack_shallow/set_general_conv_fluxes_to_shallow.meta + + - frozen_precipitation_flux_at_interface_due_to_convection + - frozen_precipitation_flux_at_interface_due_to_shallow_convection + - lwe_frozen_precipitation_rate_at_surface_due_to_convection + - lwe_frozen_precipitation_rate_at_surface_due_to_shallow_convection + - lwe_precipitation_rate_at_surface_due_to_convection + - lwe_precipitation_rate_at_surface_due_to_shallow_convection + - net_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column + - precipitation_flux_at_interface_due_to_convection + - precipitation_flux_at_interface_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_shallow_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_convection + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_shallow_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_convection + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_convection + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_shallow_convection + +-------------------------- + +atmospheric_physics/schemes/kessler/kessler_update.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/kessler/kessler.meta + + - ccpp_error_code + - ccpp_error_message + - scheme_name -------------------------- @@ -165,12 +480,42 @@ atmospheric_physics/schemes/dry_adiabatic_adjust/dadadj.meta - air_pressure_at_interface - binary_indicator_for_dry_adiabatic_adjusted_grid_cell + - ccpp_error_code + - ccpp_error_message - number_of_iterations_for_dry_adiabatic_adjustment_algorithm_convergence - number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs + - scheme_name - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water -------------------------- +atmospheric_physics/schemes/thermo_water_update/thermo_water_update.meta + + - ccpp_constituents + - specific_heat_of_air_used_in_dycore + - total_energy_formula_for_dycore + +-------------------------- + +atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_options.meta + + - cape_threshold_for_zhang_mcfarlane_deep_convection_scheme + - cloud_condensate_to_precipitation_autoconversion_coefficient_over_land_for_zhang_mcfarlane_deep_convection_scheme + - cloud_condensate_to_precipitation_autoconversion_coefficient_over_ocean_for_zhang_mcfarlane_deep_convection_scheme + - deep_convective_adjustment_timescale_for_zhang_mcfarlane_deep_convection_scheme + - entrainment_rate_for_cape_for_zhang_mcfarlane_deep_convection_scheme + - flag_for_no_deep_convection_in_pbl + - flag_for_well_mixed_pbl_parcel_property_for_zhang_mcfarlane_deep_convection_scheme + - fraction_of_pbl_depth_mixed_for_initial_zhang_mcfarlane_parcel_properties + - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_downdraft_for_zhang_mcfarlane_deep_convection_scheme + - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_updraft_for_zhang_mcfarlane_deep_convection_scheme + - number_of_negative_buoyancy_layers_allowed_before_convection_top_for_zhang_mcfarlane_deep_convection_scheme + - parcel_temperature_perturbation_for_zhang_mcfarlane_deep_convection_scheme + - tunable_evaporation_efficiency_over_land_for_zhang_mcfarlane_deep_convection_scheme + - tunable_evaporation_efficiency_over_ocean_for_zhang_mcfarlane_deep_convection_scheme + +-------------------------- + atmospheric_physics/schemes/zhang_mcfarlane/set_deep_conv_fluxes_to_general.meta - lwe_precipitation_rate_at_surface_due_to_convection @@ -187,6 +532,8 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - ccpp_error_code + - ccpp_error_message - current_timestep_number - flag_for_momentum_transport_by_zhang_mcfarlane_deep_convection_scheme - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns @@ -200,6 +547,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta - momentum_transport_parameter_for_vertical_pressure_gradient_force_for_updraft_for_zhang_mcfarlane_deep_convection_scheme - pressure_thickness_for_deep_convection_for_convective_columns - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - scheme_name - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_updraft_pressure_gradient_term - tendency_of_northward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term @@ -211,6 +559,8 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_momtran.meta atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_evap.meta + - ccpp_error_code + - ccpp_error_message - cloud_area_fraction - freezing_point_of_water - frozen_precipitation_flux_at_interface_due_to_convection @@ -219,6 +569,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_evap.meta - lwe_precipitation_rate_at_surface_due_to_convection - mass_fraction_of_snow_content_within_stratiform_cloud - precipitation_flux_at_interface_due_to_convection + - scheme_name - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_and_melting_of_frozen_precipitation_due_to_convection - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_due_to_convection - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_convection @@ -240,18 +591,22 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - cape_threshold_for_zhang_mcfarlane_deep_convection_scheme + - ccpp_error_code + - ccpp_error_message - cloud_condensate_to_precipitation_autoconversion_coefficient_over_land_for_zhang_mcfarlane_deep_convection_scheme - cloud_condensate_to_precipitation_autoconversion_coefficient_over_ocean_for_zhang_mcfarlane_deep_convection_scheme - convective_temperature_perturbation_due_to_pbl_eddies - deep_convective_adjustment_timescale_for_zhang_mcfarlane_deep_convection_scheme - detrainment_mass_flux_due_to_deep_convection - - detrainment_of_cloud_ice_due_to_deep_convection - - detrainment_of_cloud_liquid_due_to_deep_convection + - detrainment_of_cloud_ice_wrt_moist_air_and_condensed_water_due_to_deep_convection + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_deep_convection - entrainment_rate_for_cape_for_zhang_mcfarlane_deep_convection_scheme - flag_for_no_deep_convection_in_pbl - flag_for_well_mixed_pbl_parcel_property_for_zhang_mcfarlane_deep_convection_scheme + - fraction_of_pbl_depth_mixed_for_initial_zhang_mcfarlane_parcel_properties - freezing_point_of_water - gas_constant_of_water_vapor + - geopotential_height_wrt_surface_at_interface - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_deep_convection - index_of_last_column_of_gathered_deep_convection_arrays @@ -265,6 +620,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns - ratio_of_water_vapor_to_dry_air_molecular_weights - reference_pressure_at_interface + - scheme_name - specific_heat_of_liquid_water_at_constant_pressure - specific_heat_of_water_vapor_at_constant_pressure - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation @@ -275,7 +631,7 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_convr.meta - vertical_index_at_top_of_deep_convection_for_convective_columns - vertical_index_of_deep_convection_launch_level_for_convective_columns - vertically_integrated_cloud_ice_tendency_due_to_all_convection_to_be_applied_later_in_time_loop - - vertically_integrated_cloud_liquid_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop - zhang_mcfarlane_convective_available_potential_energy -------------------------- @@ -308,44 +664,246 @@ atmospheric_physics/schemes/zhang_mcfarlane/zm_conv_convtran.meta - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - ccpp_constituent_properties - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - current_timestep_number - flag_for_tracer_transport_by_zhang_mcfarlane_deep_scheme - fraction_of_water_insoluble_convectively_transported_species - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns - index_of_first_column_of_gathered_deep_convection_arrays - index_of_last_column_of_gathered_deep_convection_arrays + - number_of_ccpp_constituents - pressure_thickness_for_deep_convection_for_convective_columns - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - scheme_name - vertical_index_at_top_of_deep_convection_for_convective_columns - vertical_index_of_deep_convection_launch_level_for_convective_columns -------------------------- +atmospheric_physics/schemes/utilities/to_be_ccppized_temporary.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + atmospheric_physics/schemes/utilities/geopotential_temp.meta - air_pressure_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - geopotential_height_wrt_surface_at_interface - ln_air_pressure_at_interface + - number_of_ccpp_constituents + +-------------------------- + +atmospheric_physics/schemes/utilities/state_converters.meta + + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/utilities/qneg.meta + + - ccpp_constituent_minimum_values + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - number_of_ccpp_constituents + - scheme_name -------------------------- atmospheric_physics/schemes/utilities/physics_tendency_updaters.meta - ccpp_constituent_tendencies + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + +-------------------------- + +atmospheric_physics/schemes/utilities/static_energy.meta + + - ccpp_error_code + - ccpp_error_message -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_save_teout.meta +atmospheric_physics/schemes/rasch_kristjansson/rk_stratiform.meta + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep + - deep_convective_cloud_area_fraction + - detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection + - freezing_point_of_water + - latent_heat_of_fusion_of_water_at_0c + - lwe_large_scale_precipitation_rate_at_surface + - lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - lwe_stratiform_precipitation_rate_at_surface + - lwe_surface_snow_depth_over_land + - mass_fraction_of_ice_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - ocean_area_fraction + - rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - rate_of_evaporation_of_precipitation_due_to_microphysics + - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - reference_temperature_lapse_rate + - relative_humidity_divided_by_cloud_area_fraction_perturbation + - relative_humidity_threshold_for_cloud_formation + - sea_ice_area_fraction + - shallow_convective_cloud_area_fraction + - smoothed_land_area_fraction + - stratiform_cloud_water_surface_flux_due_to_sedimentation + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - surface_air_pressure + - tendency_of_air_temperature_not_due_to_microphysics + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - vertical_layer_index_of_cloud_fraction_top + - vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep + +-------------------------- + +atmospheric_physics/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta + + - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - freezing_point_of_water + - latent_heat_of_fusion_of_water_at_0c + - lwe_surface_snow_depth_over_land + - magnitude_of_vertical_pressure_velocity_of_cloud_ice_due_to_sedimentation + - magnitude_of_vertical_pressure_velocity_of_cloud_liquid_water_due_to_sedimentation + - ocean_area_fraction + - sea_ice_area_fraction + - smoothed_land_area_fraction + - stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + - stratiform_rain_flux_at_surface_due_to_sedimentation + - tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - tunable_parameter_for_autoconversion_of_cold_ice_for_rk_microphysics + - tunable_parameter_for_ice_fall_velocity_for_rk_microphysics + +-------------------------- + +atmospheric_physics/schemes/rasch_kristjansson/prognostic_cloud_water.meta + + - accretion_of_cloud_ice_by_snow + - accretion_of_cloud_liquid_water_by_rain + - accretion_of_cloud_liquid_water_by_snow + - ccpp_error_code + - ccpp_error_message + - cloud_area_fraction + - density_of_dry_air_at_stp + - flag_for_relative_humidity_threshold_for_cloud_formation_in_polar_stratosphere_for_rk_microphysics + - freezing_point_of_water + - gas_constant_of_water_vapor + - geopotential_height_wrt_surface_at_interface + - latent_heat_of_fusion_of_water_at_0c + - latitude_degrees_north + - lwe_snow_precipitation_rate_at_surface_due_to_microphysics + - lwe_stratiform_precipitation_rate_at_surface + - lwe_surface_snow_depth_over_land + - mass_fraction_of_ice_content_within_stratiform_cloud + - mass_fraction_of_snow_content_within_stratiform_cloud + - net_condensation_rate_due_to_microphysics + - pi_constant + - precipitation_production_due_to_microphysics + - rate_of_evaporation_of_falling_snow_due_to_microphysics + - rate_of_evaporation_of_precipitation_due_to_microphysics + - ratio_of_water_vapor_to_dry_air_molecular_weights + - relative_humidity_divided_by_cloud_area_fraction_perturbation + - relative_humidity_threshold_for_cloud_formation + - relative_humidity_threshold_for_cloud_formation_in_polar_stratosphere_for_rk_microphysics + - relative_importance_of_cloud_ice_autoconversion + - relative_importance_of_cloud_liquid_water_autoconversion + - relative_importance_of_rain_accreting_cloud_liquid_water + - relative_importance_of_snow_accreting_cloud_ice + - relative_importance_of_snow_accreting_cloud_liquid_water + - sea_ice_area_fraction + - smoothed_land_area_fraction + - snow_production_due_to_microphysics + - stratiform_rain_and_snow_flux_at_interface + - stratiform_snow_flux_at_interface + - tendency_of_air_temperature_not_due_to_microphysics + - tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + - tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_snow_autoconversion + - tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics + - tropopause_vertical_layer_index + - tunable_parameter_for_autoconversion_of_cold_ice_for_rk_microphysics + - tunable_parameter_for_autoconversion_of_warm_ice_for_rk_microphysics + - tunable_parameter_for_cloud_water_autoconversion_for_rk_microphysics + - tunable_parameter_for_precipitation_evaporation_for_rk_microphysics + - vertical_layer_index_of_troposphere_cloud_physics_top + +-------------------------- + +atmospheric_physics/schemes/conservation_adjust/dme_adjust/dme_adjust.meta + + - air_pressure_at_interface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message + - is_moist_basis_dycore + - ln_air_pressure_at_interface + - number_of_ccpp_constituents + - surface_air_pressure + - total_ice_water_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + - total_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + - water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_before_physics + +-------------------------- + +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_save_teout.meta + + - ccpp_error_code + - ccpp_error_message - vertically_integrated_total_energy_using_dycore_energy_formula - vertically_integrated_total_energy_using_dycore_energy_formula_at_end_of_physics_timestep -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_chng.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_chng.meta - air_pressure_of_dry_air_at_interface - air_temperature_at_start_of_physics_timestep + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - cumulative_total_energy_boundary_flux_using_physics_energy_formula - cumulative_total_water_boundary_flux - flag_for_energy_conservation_warning @@ -356,7 +914,9 @@ atmospheric_physics/schemes/check_energy/check_energy_chng.meta - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - net_water_vapor_fluxes_through_top_and_bottom_of_atmosphere_column - number_of_atmosphere_columns_with_significant_energy_or_water_imbalances + - number_of_ccpp_constituents - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula + - scheme_name - specific_heat_of_air_used_in_dycore - total_energy_formula_for_dycore - total_energy_formula_for_physics @@ -370,40 +930,52 @@ atmospheric_physics/schemes/check_energy/check_energy_chng.meta -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_zero_fluxes.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_zero_fluxes.meta + - ccpp_error_code + - ccpp_error_message - net_liquid_and_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column - net_lwe_ice_fluxes_through_top_and_bottom_of_atmosphere_column - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column - net_water_vapor_fluxes_through_top_and_bottom_of_atmosphere_column + - scheme_name -------------------------- -atmospheric_physics/schemes/check_energy/dycore_energy_consistency_adjust.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/dycore_energy_consistency_adjust.meta + - ccpp_error_code + - ccpp_error_message - flag_for_dycore_energy_consistency_adjustment - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_scaling.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_scaling.meta + - ccpp_error_code + - ccpp_error_message - ratio_of_specific_heat_of_air_used_in_physics_energy_formula_to_specific_heat_of_air_used_in_dycore_energy_formula - specific_heat_of_air_used_in_dycore -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_fix.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_fix.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - global_mean_heating_rate_correction_for_energy_conservation - net_sensible_heat_flux_through_top_and_bottom_of_atmosphere_column + - scheme_name -------------------------- -atmospheric_physics/schemes/check_energy/check_energy_gmean/check_energy_gmean.meta +atmospheric_physics/schemes/conservation_adjust/check_energy/check_energy_gmean/check_energy_gmean.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - global_mean_air_pressure_at_top_of_atmosphere_model - global_mean_heating_rate_correction_for_energy_conservation - global_mean_surface_air_pressure @@ -418,10 +990,14 @@ atmospheric_physics/schemes/check_energy/check_energy_gmean/check_energy_gmean.m atmospheric_physics/schemes/tropopause_find/tropopause_find.meta - air_pressure_at_interface + - ccpp_error_code + - ccpp_error_message - fill_value_for_diagnostic_output - fractional_calendar_days_on_end_of_current_timestep + - geopotential_height_wrt_surface_at_interface - pi_constant - ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + - scheme_name - tropopause_air_pressure - tropopause_air_pressure_from_chemical_method - tropopause_air_pressure_from_climatological_method @@ -454,21 +1030,54 @@ atmospheric_physics/schemes/tropopause_find/tropopause_find.meta -------------------------- +atmospheric_physics/schemes/held_suarez/held_suarez_1994.meta + + - ccpp_error_code + - ccpp_error_message + - scheme_name + +-------------------------- + +atmospheric_physics/schemes/rayleigh_friction/rayleigh_friction.meta + + - ccpp_error_code + - ccpp_error_message + - center_vertical_layer_for_rayleigh_friction + - model_top_decay_time_for_rayleigh_friction + - number_of_vertical_layers_for_rayleigh_friction + +-------------------------- + atmospheric_physics/schemes/musica/musica_ccpp.meta - blackbody_temperature_at_surface + - ccpp_constituent_properties + - ccpp_constituents + - ccpp_error_code + - ccpp_error_message - cloud_area_fraction - dynamic_constituents_for_musica_ccpp - earth_sun_distance - extraterrestrial_radiation_flux + - geopotential_height_wrt_surface_at_interface - photolysis_wavelength_grid_interfaces - solar_zenith_angle - surface_albedo_due_to_UV_and_VIS_direct -------------------------- +atmospheric_physics/test/test_schemes/file_io_test.meta + + - ccpp_error_code + - ccpp_error_message + - filename_of_rrtmgp_shortwave_coefficients + +-------------------------- + atmospheric_physics/test/test_schemes/initialize_constituents.meta + - ccpp_error_code + - ccpp_error_message - dynamic_constituents_for_initialize_constituents ####################### diff --git a/schemes/cloud_fraction/compute_cloud_fraction.meta b/schemes/cloud_fraction/compute_cloud_fraction.meta index c314e2cf..590bf42e 100644 --- a/schemes/cloud_fraction/compute_cloud_fraction.meta +++ b/schemes/cloud_fraction/compute_cloud_fraction.meta @@ -225,13 +225,13 @@ dimensions = (horizontal_loop_extent) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -273,7 +273,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ rhcloud ] - standard_name = cloud_area_fraction_from_relative_humidity_method_tbd + standard_name = cloud_area_fraction_from_relative_humidity_method units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -285,7 +285,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -303,7 +303,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ relhum ] - standard_name = relative_humidity_for_prognostic_cloud_water_tbd + standard_name = relative_humidity units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/cloud_fraction/convective_cloud_cover.meta b/schemes/cloud_fraction/convective_cloud_cover.meta index 7340b8f6..d368ecb5 100644 --- a/schemes/cloud_fraction/convective_cloud_cover.meta +++ b/schemes/cloud_fraction/convective_cloud_cover.meta @@ -82,7 +82,7 @@ dimensions = () intent = in [ shfrc ] - standard_name = shallow_convective_cloud_area_fraction + standard_name = shallow_convective_cloud_area_fraction_from_shallow_convection units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -100,13 +100,13 @@ dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/hack_shallow/hack_convect_shallow.meta b/schemes/hack_shallow/hack_convect_shallow.meta index ac0f88ea..3b90a151 100644 --- a/schemes/hack_shallow/hack_convect_shallow.meta +++ b/schemes/hack_shallow/hack_convect_shallow.meta @@ -79,7 +79,7 @@ dimensions = () intent = out [ shfrc ] - standard_name = shallow_convective_cloud_area_fraction + standard_name = shallow_convective_cloud_area_fraction_from_shallow_convection units = fraction type = real | kind = kind_phys dimensions = (horizontal_dimension, vertical_layer_dimension) diff --git a/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 b/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 index 5732856a..3c7f4ff6 100644 --- a/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 +++ b/schemes/rasch_kristjansson/cloud_particle_sedimentation.F90 @@ -146,7 +146,7 @@ subroutine cloud_particle_sedimentation_run( & real(kind_phys), intent(out) :: wvtend(:,:) ! water vapor tendency [kg kg-1 s-1] -- to apply wv tendency real(kind_phys), intent(out) :: htend(:,:) ! heating rate [J kg-1 s-1] -- to apply s tendency real(kind_phys), intent(out) :: sfliq(:) ! surface flux of liquid (rain) [kg m-2 s-1] - real(kind_phys), intent(out) :: sfice(:) ! lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics [m s-1] + real(kind_phys), intent(out) :: sfice(:) ! stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] character(len=512), intent(out) :: errmsg ! error message integer, intent(out) :: errflg ! error flag @@ -361,7 +361,7 @@ subroutine cloud_particle_sedimentation_run( & sfliq(:ncol) = fxliq(:ncol, pverp)/(dtime*gravit) sfice(:ncol) = fxice(:ncol, pverp)/(dtime*gravit) - ! Convert lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics from kg m-2 s-1 to precip units m s-1 + ! Convert stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation from kg m-2 s-1 to precip units m s-1 sfice(:ncol) = sfice(:ncol)/1000._kind_phys end subroutine cloud_particle_sedimentation_run @@ -390,7 +390,6 @@ subroutine getflx(ncol, pver, pverp, & integer :: i, k real(kind_phys) :: psi(ncol, pverp) real(kind_phys) :: fdot(ncol, pverp) - real(kind_phys) :: xx(ncol) real(kind_phys) :: fxdot(ncol) real(kind_phys) :: fxdd(ncol) real(kind_phys) :: psistar(ncol) @@ -457,7 +456,6 @@ subroutine cfint2(ncol, pverp, & real(kind_phys) :: c2 real(kind_phys) :: c3 real(kind_phys) :: xx - real(kind_phys) :: xinf real(kind_phys) :: psi1, psi2, psi3, psim real(kind_phys) :: cfint real(kind_phys) :: cfnew @@ -551,7 +549,6 @@ subroutine cfdotmc(ncol, pver, pverp, x, f, fdot) real(kind_phys), intent(out) :: fdot(ncol, pverp) ! derivative at nodes integer :: i, k - real(kind_phys) :: a, b, c ! work var real(kind_phys) :: s(ncol, pverp) ! first divided differences at nodes real(kind_phys) :: sh(ncol, pverp) ! first divided differences between nodes real(kind_phys) :: d(ncol, pverp) ! second divided differences at nodes diff --git a/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta b/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta index 4b318031..cbe8705c 100644 --- a/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta +++ b/schemes/rasch_kristjansson/cloud_particle_sedimentation.meta @@ -193,13 +193,13 @@ dimensions = (horizontal_loop_extent) intent = in [ pvliq ] - standard_name = vertical_velocity_of_cloud_liquid_water_due_to_sedimentation_tbd + standard_name = magnitude_of_vertical_pressure_velocity_of_cloud_liquid_water_due_to_sedimentation units = Pa s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out [ pvice ] - standard_name = vertical_velocity_of_cloud_ice_due_to_sedimentation_tbd + standard_name = magnitude_of_vertical_pressure_velocity_of_cloud_ice_due_to_sedimentation units = Pa s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_interface_dimension) @@ -238,7 +238,7 @@ dimensions = (horizontal_loop_extent) intent = out [ sfice ] - standard_name = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation units = m s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) diff --git a/schemes/rasch_kristjansson/prognostic_cloud_water.F90 b/schemes/rasch_kristjansson/prognostic_cloud_water.F90 index b2484d6b..d2f4d117 100644 --- a/schemes/rasch_kristjansson/prognostic_cloud_water.F90 +++ b/schemes/rasch_kristjansson/prognostic_cloud_water.F90 @@ -26,7 +26,6 @@ module prognostic_cloud_water real(kind_phys) :: rhonot ! air density at surface [g cm-3] real(kind_phys) :: rhos ! assumed snow density [g cm-3] real(kind_phys) :: rhow ! water density [g cm-3] - real(kind_phys) :: rhoi ! ice density [g cm-3] real(kind_phys) :: esi ! Collection efficiency for ice by snow [1] real(kind_phys) :: esw ! Collection efficiency for water by snow [1] real(kind_phys) :: t0 ! Approx. freezing temperature [K] @@ -120,10 +119,9 @@ subroutine prognostic_cloud_water_init( & rhonot = rhodair/1000.0_kind_phys ! convert from kg m-3 to g cm-3 - ! assumed densities of snow, water, ice [g cm-3] + ! assumed densities of snow, water [g cm-3] rhos = 0.1_kind_phys rhow = 1._kind_phys - rhoi = 1._kind_phys esi = 1._kind_phys esw = 0.1_kind_phys @@ -292,7 +290,7 @@ subroutine prognostic_cloud_water_run( & real(kind_phys), intent(out) :: qme(:,:) ! Rate of condensation-evaporation of condensate (net_condensation_rate_due_to_microphysics) [kg kg-1 s-1] real(kind_phys), intent(out) :: prodprec(:,:) ! Conversion rate of condensate to precip (precipitation_production_due_to_microphysics) [kg kg-1 s-1] real(kind_phys), intent(out) :: prodsnow(:,:) ! Snow production rate (ignored in RK?) [kg kg-1 s-1] - real(kind_phys), intent(out) :: evapprec(:,:) ! Falling precipitation evaporation rate (precipitation_evaporation_due_to_microphysics) [kg kg-1 s-1] -- & combined to apply q(wv) tendency + real(kind_phys), intent(out) :: evapprec(:,:) ! Falling precipitation evaporation rate (rate_of_evaporation_of_precipitation_due_to_microphysics) [kg kg-1 s-1] -- & combined to apply q(wv) tendency real(kind_phys), intent(out) :: evapsnow(:,:) ! Falling snow evaporation rate [kg kg-1 s-1] real(kind_phys), intent(out) :: evapheat(:,:) ! heating rate due to evaporation of precipitation [J kg-1 s-1] real(kind_phys), intent(out) :: prfzheat(:,:) ! heating rate due to freezing of precipitation [J kg-1 s-1] @@ -320,6 +318,7 @@ subroutine prognostic_cloud_water_run( & integer, intent(out) :: errflg ! error flag ! Local variables + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] integer :: i, k, l ! Iteration index [1] integer :: iter ! # of iterations for precipitation calculation [1] logical :: error_found ! Flag for error detection [flag] @@ -378,11 +377,9 @@ subroutine prognostic_cloud_water_run( & real(kind_phys) :: mincld ! Minimum cloud fraction [1] real(kind_phys) :: cpohl ! Ratio of specific heat to latent heat [K-1] real(kind_phys) :: hlocp ! Ratio of latent heat to specific heat [K] - real(kind_phys) :: clrh2o ! Ratio of latent heat to water vapor gas constant [K] real(kind_phys) :: dto2 ! Half timestep [s] ! Work variables - real(kind_phys) :: denom ! Denominator work variable [1] real(kind_phys) :: dqsdt ! Change in saturation specific humidity with temperature [kg kg-1 K-1] real(kind_phys) :: gamma(ncol) ! Temperature derivative of saturation specific humidity [kg kg-1 K-1] real(kind_phys) :: qtl(ncol) ! Saturation tendency [kg kg-1 s-1] @@ -400,7 +397,6 @@ subroutine prognostic_cloud_water_run( & errflg = 0 error_found = .false. - clrh2o = latvap/rh2o cpohl = cpair/latvap hlocp = latvap/cpair dto2 = 0.5_kind_phys * deltat @@ -845,8 +841,8 @@ subroutine prognostic_cloud_water_run( & ! ! If this conversion is removed in the future, the metadata needs to ! be updated. - precip(:ncol) = precip(:ncol)/1000._kind_phys - snowab(:ncol) = snowab(:ncol)/1000._kind_phys + precip(:ncol) = precip(:ncol)/rhofw + snowab(:ncol) = snowab(:ncol)/rhofw end subroutine prognostic_cloud_water_run ! Calculate the conversion of condensate to precipitate @@ -898,7 +894,6 @@ subroutine findmcnew( & integer :: ncols ! Number of active columns for microphysics (different from ncol!!) [count] integer :: ind(ncol) ! Active column indices [index] real(kind_phys) :: capn ! Local cloud particle number concentration [cm-3] - real(kind_phys) :: capnoice ! Cloud particle concentration excluding sea ice [cm-3] real(kind_phys) :: cldloc(ncol) ! Non-zero cloud fraction [1] real(kind_phys) :: cldpr(ncol) ! Cloud fraction for precipitation [1] real(kind_phys) :: totmr(ncol) ! In-cloud total water mixing ratio [kg kg-1] @@ -920,11 +915,7 @@ subroutine findmcnew( & real(kind_phys) :: rhocgs ! Air density in CGS units [g cm-3] real(kind_phys) :: r3l ! Cloud droplet volume radius [m] real(kind_phys) :: icrit ! Ice autoconversion threshold [kg kg-1] - real(kind_phys) :: wsi ! Sea ice weight factor [1] real(kind_phys) :: wt ! Ice fraction weight [1] - real(kind_phys) :: wland ! Land fraction weight [1] - real(kind_phys) :: wp ! Pressure dependence weight [1] - real(kind_phys) :: ftot ! Total fraction for conversion processes [1] real(kind_phys) :: con1 ! Work constant for radius calculation [m] real(kind_phys) :: con2 ! Work constant for density ratios [1] real(kind_phys) :: csacx ! Constant used for snow accreting liquid or ice [??] @@ -1119,8 +1110,6 @@ subroutine findmcnew( & fsacw(i) = 0._kind_phys fsaci(i) = 0._kind_phys endif - - ftot = fwaut(i)+fsaut(i)+fracw(i)+fsacw(i)+fsaci(i) end do end subroutine findmcnew diff --git a/schemes/rasch_kristjansson/prognostic_cloud_water.meta b/schemes/rasch_kristjansson/prognostic_cloud_water.meta index 6f59d935..c821416c 100644 --- a/schemes/rasch_kristjansson/prognostic_cloud_water.meta +++ b/schemes/rasch_kristjansson/prognostic_cloud_water.meta @@ -190,7 +190,7 @@ dimensions = (horizontal_loop_extent) intent = in [ ttend ] - standard_name = tendency_of_air_temperature_not_due_to_microphysics_tbd + standard_name = tendency_of_air_temperature_not_due_to_microphysics units = K s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -202,7 +202,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qtend ] - standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -214,7 +214,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ ltend ] - standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -256,13 +256,13 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhdfda ] - standard_name = derivative_of_relative_humidity_wrt_cloud_fraction_tbd + standard_name = relative_humidity_divided_by_cloud_area_fraction_perturbation units = percent type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -304,31 +304,31 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapprec ] - standard_name = precipitation_evaporation_due_to_microphysics + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapsnow ] - standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics_tbd + standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ evapheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_evaporation_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ prfzheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_freezing_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ meltheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_phase_change_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -346,19 +346,19 @@ dimensions = (horizontal_loop_extent) intent = out [ ice2pr ] - standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ liq2pr ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ liq2snow ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_conversion_to_snow_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -376,49 +376,49 @@ dimensions = (horizontal_loop_extent, vertical_interface_dimension) intent = out [ pracwo ] - standard_name = accretion_of_cloud_liquid_water_by_rain_tbd + standard_name = accretion_of_cloud_liquid_water_by_rain units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ psacwo ] - standard_name = accretion_of_cloud_liquid_water_by_snow_tbd + standard_name = accretion_of_cloud_liquid_water_by_snow units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ psacio ] - standard_name = accretion_of_cloud_ice_by_snow_tbd + standard_name = accretion_of_cloud_ice_by_snow units = s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fwaut ] - standard_name = relative_importance_of_liquid_autoconversion_tbd + standard_name = relative_importance_of_cloud_liquid_water_autoconversion units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsaut ] - standard_name = relative_importance_of_ice_autoconversion_tbd + standard_name = relative_importance_of_cloud_ice_autoconversion units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fracw ] - standard_name = relative_importance_of_rain_accreting_liquid_tbd + standard_name = relative_importance_of_rain_accreting_cloud_liquid_water units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsacw ] - standard_name = relative_importance_of_snow_accreting_liquid_tbd + standard_name = relative_importance_of_snow_accreting_cloud_liquid_water units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ fsaci ] - standard_name = relative_importance_of_snow_accreting_ice_tbd + standard_name = relative_importance_of_snow_accreting_cloud_ice units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/rasch_kristjansson/rk_stratiform.F90 b/schemes/rasch_kristjansson/rk_stratiform.F90 index 64da34dd..ec2021e0 100644 --- a/schemes/rasch_kristjansson/rk_stratiform.F90 +++ b/schemes/rasch_kristjansson/rk_stratiform.F90 @@ -89,21 +89,23 @@ subroutine rk_stratiform_sedimentation_run( & ! Input arguments integer, intent(in) :: ncol real(kind_phys), intent(in) :: sfliq(:) ! stratiform_rain_flux_at_surface_due_to_sedimentation [kg m-2 s-1] - real(kind_phys), intent(in) :: snow_sed(:) ! sfice = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics [m s-1] + real(kind_phys), intent(in) :: snow_sed(:) ! sfice = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] ! Output arguments real(kind_phys), intent(out) :: prec_sed(:) ! stratiform_cloud_water_surface_flux_due_to_sedimentation [m s-1] real(kind_phys), intent(out) :: prec_str(:) ! lwe_large_scale_precipitation_rate_at_surface [m s-1] real(kind_phys), intent(out) :: snow_str(:) ! lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics [m s-1] - character(len=512), intent(out) :: errmsg ! error message - integer, intent(out) :: errflg ! error flag + character(len=512), intent(out) :: errmsg ! error message + integer, intent(out) :: errflg ! error flag + + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] errmsg = '' errflg = 0 ! Convert rain flux to precip units from mass units ! and create cloud water surface flux (rain + snow) - prec_sed(:ncol) = sfliq(:ncol)/1000._kind_phys + snow_sed(:ncol) + prec_sed(:ncol) = sfliq(:ncol)/rhofw + snow_sed(:ncol) ! Start accumulation of precipitation and snow flux [m s-1] prec_str(:ncol) = 0._kind_phys + prec_sed(:ncol) diff --git a/schemes/rasch_kristjansson/rk_stratiform.meta b/schemes/rasch_kristjansson/rk_stratiform.meta index f994c28b..f1ffe7f1 100644 --- a/schemes/rasch_kristjansson/rk_stratiform.meta +++ b/schemes/rasch_kristjansson/rk_stratiform.meta @@ -49,19 +49,19 @@ intent = in advected = true [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -99,7 +99,7 @@ dimensions = (horizontal_loop_extent) intent = in [ snow_sed ] - standard_name = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation units = m s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent) @@ -290,13 +290,13 @@ dimensions = (horizontal_loop_extent) intent = in [ shallowcu ] - standard_name = shallow_convective_cloud_area_fraction_tbd + standard_name = shallow_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ deepcu ] - standard_name = deep_convective_cloud_area_fraction_tbd + standard_name = deep_convective_cloud_area_fraction units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -332,19 +332,19 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ relhum ] - standard_name = relative_humidity_for_prognostic_cloud_water_tbd + standard_name = relative_humidity units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ rhu00 ] - standard_name = relative_humidity_threshold_for_prognostic_cloud_water_tbd + standard_name = relative_humidity_threshold_for_cloud_formation units = fraction type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = inout [ rhdfda ] - standard_name = derivative_of_relative_humidity_wrt_cloud_fraction_tbd + standard_name = relative_humidity_divided_by_cloud_area_fraction_perturbation units = percent type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -412,37 +412,37 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qtend ] - standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ ttend ] - standard_name = tendency_of_air_temperature_not_due_to_microphysics_tbd + standard_name = tendency_of_air_temperature_not_due_to_microphysics units = K s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ ltend ] - standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics_tbd + standard_name = tendency_of_cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_not_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -510,7 +510,7 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ repartht ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_repartitioning_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -592,43 +592,43 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ evapheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_evaporation_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ prfzheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_freezing_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ meltheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_phase_change_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ repartht ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_precipitation_repartitioning_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ evapprec ] - standard_name = precipitation_evaporation_due_to_microphysics + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ ice2pr ] - standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ liq2pr ] - standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_microphysics_tbd + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -658,19 +658,19 @@ dimensions = (horizontal_loop_extent) intent = inout [ cmeheat ] - standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_evaporation_within_stratiform_cloud_tbd + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation units = J kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ cmeice ] - standard_name = rate_of_condensation_evaporation_of_cloud_ice_within_stratiform_cloud_tbd + standard_name = rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ cmeliq ] - standard_name = rate_of_condensation_evaporation_of_cloud_liquid_water_within_stratiform_cloud_tbd + standard_name = rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water units = kg kg-1 s-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) @@ -759,19 +759,19 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ qcwat ] - standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ tcwat ] - standard_name = air_temperature_at_end_of_microphysics + standard_name = air_temperature_on_previous_timestep units = K type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ lcwat ] - standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_at_end_of_microphysics + standard_name = cloud_water_mixing_ratio_wrt_moist_air_and_condensed_water_on_previous_timestep units = kg kg-1 type = real | kind = kind_phys dimensions = (horizontal_loop_extent, vertical_layer_dimension) diff --git a/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 new file mode 100644 index 00000000..cd89a833 --- /dev/null +++ b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.F90 @@ -0,0 +1,84 @@ +! Diagnostics for RK stratiform - cloud particle sedimentation +module cloud_particle_sedimentation_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: cloud_particle_sedimentation_diagnostics_init + public :: cloud_particle_sedimentation_diagnostics_run + +contains + + !> \section arg_table_cloud_particle_sedimentation_diagnostics_init Argument Table + !! \htmlinclude cloud_particle_sedimentation_diagnostics_init.html + subroutine cloud_particle_sedimentation_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('DQSED', 'tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('DISED', 'tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('DLSED', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_sedimentation', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('HSED', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_sedimentation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('PRECSED', 'stratiform_cloud_water_surface_flux_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + call history_add_field('SNOWSED', 'stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + call history_add_field('RAINSED', 'stratiform_rain_flux_at_surface_due_to_sedimentation', horiz_only, 'inst', 'm s-1') + + end subroutine cloud_particle_sedimentation_diagnostics_init + + !> \section arg_table_cloud_particle_sedimentation_diagnostics_run Argument Table + !! \htmlinclude cloud_particle_sedimentation_diagnostics_run.html + subroutine cloud_particle_sedimentation_diagnostics_run( & + ncol, & + wvtend, icetend, liqtend, htend, & + snow_sed, sfliq, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + integer, intent(in) :: ncol + real(kind_phys), intent(in) :: wvtend(:,:) ! water vapor tendency -- to apply wv tendency + real(kind_phys), intent(in) :: icetend(:,:) ! ice condensate tendency -- to apply cldice tendency + real(kind_phys), intent(in) :: liqtend(:,:) ! liquid condensate tendency -- to apply cldliq tendency + real(kind_phys), intent(in) :: htend(:,:) ! heating rate [J kg-1 s-1] -- to apply s tendency + + real(kind_phys), intent(in) :: snow_sed(:) ! stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation [m s-1] + real(kind_phys), intent(in) :: sfliq(:) ! stratiform_rain_flux_at_surface_due_to_sedimentation [kg m-2 s-1] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + real(kind_phys), parameter :: rhofw = 1000._kind_phys ! density of fresh water [kg m-3] + real(kind_phys) :: prec_sed(ncol) + + ! repeat computation of prec_sed here for diagnostics [m s-1] + prec_sed(:ncol) = sfliq(:ncol)/rhofw + snow_sed(:ncol) + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('DQSED' , wvtend) + call history_out_field('DISED' , icetend) + call history_out_field('DLSED' , liqtend) + call history_out_field('HSED' , htend) + + call history_out_field('PRECSED', prec_sed) ! calculated as m s-1 + call history_out_field('SNOWSED', snow_sed) ! already in m s-1 + call history_out_field('RAINSED', sfliq/rhofw) ! convert from kg m-2 s-1 to m s-1 (precip units) for output + + end subroutine cloud_particle_sedimentation_diagnostics_run + +end module cloud_particle_sedimentation_diagnostics diff --git a/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta new file mode 100644 index 00000000..b638b250 --- /dev/null +++ b/schemes/sima_diagnostics/cloud_particle_sedimentation_diagnostics.meta @@ -0,0 +1,77 @@ +[ccpp-table-properties] + name = cloud_particle_sedimentation_diagnostics + type = scheme + +[ccpp-arg-table] + name = cloud_particle_sedimentation_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = cloud_particle_sedimentation_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ wvtend ] + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ icetend ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ liqtend ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ htend ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ snow_sed ] + standard_name = stratiform_lwe_cloud_ice_surface_flux_due_to_sedimentation + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ sfliq ] + standard_name = stratiform_rain_flux_at_surface_due_to_sedimentation + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 new file mode 100644 index 00000000..74a69996 --- /dev/null +++ b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.F90 @@ -0,0 +1,57 @@ +! Diagnostics for cloud fraction +module compute_cloud_fraction_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: compute_cloud_fraction_diagnostics_init + public :: compute_cloud_fraction_diagnostics_run + +contains + + !> \section arg_table_compute_cloud_fraction_diagnostics_init Argument Table + !! \htmlinclude compute_cloud_fraction_diagnostics_init.html + subroutine compute_cloud_fraction_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('CLDST', 'stratiform_cloud_area_fraction', 'lev', 'avg', 'fraction') + + end subroutine compute_cloud_fraction_diagnostics_init + + !> \section arg_table_compute_cloud_fraction_diagnostics_run Argument Table + !! \htmlinclude compute_cloud_fraction_diagnostics_run.html + subroutine compute_cloud_fraction_diagnostics_run( & + cldst, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: cldst(:,:) + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('CLDST', cldst) + + end subroutine compute_cloud_fraction_diagnostics_run + +end module compute_cloud_fraction_diagnostics diff --git a/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta new file mode 100644 index 00000000..e0167a72 --- /dev/null +++ b/schemes/sima_diagnostics/compute_cloud_fraction_diagnostics.meta @@ -0,0 +1,41 @@ +[ccpp-table-properties] + name = compute_cloud_fraction_diagnostics + type = scheme + +[ccpp-arg-table] + name = compute_cloud_fraction_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = compute_cloud_fraction_diagnostics_run + type = scheme +[ cldst ] + standard_name = stratiform_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 b/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 index 1504a1c9..b3ec2971 100644 --- a/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 +++ b/schemes/sima_diagnostics/convect_shallow_diagnostics.F90 @@ -1,5 +1,4 @@ ! Diagnostics for shallow convection and merged deep + shallow convection -! Haipeng Lin, December 2024 module convect_shallow_diagnostics use ccpp_kinds, only: kind_phys diff --git a/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 new file mode 100644 index 00000000..fedcded9 --- /dev/null +++ b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.F90 @@ -0,0 +1,63 @@ +! Diagnostics for cloud fraction - convective cloud cover +module convective_cloud_cover_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: convective_cloud_cover_diagnostics_init + public :: convective_cloud_cover_diagnostics_run + +contains + + !> \section arg_table_convective_cloud_cover_diagnostics_init Argument Table + !! \htmlinclude convective_cloud_cover_diagnostics_init.html + subroutine convective_cloud_cover_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables: + + errmsg = '' + errflg = 0 + + ! History add field calls + call history_add_field('SH_CLD', 'shallow_convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + call history_add_field('DP_CLD', 'deep_convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + call history_add_field('CONCLD', 'convective_cloud_area_fraction', 'lev', 'avg', 'fraction') + + end subroutine convective_cloud_cover_diagnostics_init + + !> \section arg_table_convective_cloud_cover_diagnostics_run Argument Table + !! \htmlinclude convective_cloud_cover_diagnostics_run.html + subroutine convective_cloud_cover_diagnostics_run( & + shallowcu, deepcu, concld, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: shallowcu(:, :) ! Shallow convective cloud fraction [fraction] + real(kind_phys), intent(in) :: deepcu(:, :) ! Deep convective cloud fraction [fraction] + real(kind_phys), intent(in) :: concld(:, :) ! Convective cloud cover [fraction] + + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('SH_CLD', shallowcu) + call history_out_field('DP_CLD', deepcu) + call history_out_field('CONCLD', concld) + + end subroutine convective_cloud_cover_diagnostics_run + +end module convective_cloud_cover_diagnostics diff --git a/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta new file mode 100644 index 00000000..85796f3f --- /dev/null +++ b/schemes/sima_diagnostics/convective_cloud_cover_diagnostics.meta @@ -0,0 +1,53 @@ +[ccpp-table-properties] + name = convective_cloud_cover_diagnostics + type = scheme + +[ccpp-arg-table] + name = convective_cloud_cover_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = convective_cloud_cover_diagnostics_run + type = scheme +[ shallowcu ] + standard_name = shallow_convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ deepcu ] + standard_name = deep_convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ concld ] + standard_name = convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 b/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 new file mode 100644 index 00000000..90c37cb0 --- /dev/null +++ b/schemes/sima_diagnostics/rk_stratiform_diagnostics.F90 @@ -0,0 +1,327 @@ +! Diagnostics for RK stratiform - miscellaneous interstitial schemes +module rk_stratiform_diagnostics + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: rk_stratiform_diagnostics_init + public :: rk_stratiform_cloud_fraction_perturbation_diagnostics_run + public :: rk_stratiform_condensate_repartioning_diagnostics_run + public :: rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + public :: rk_stratiform_cloud_optical_properties_diagnostics_run + +contains + + !> \section arg_table_rk_stratiform_diagnostics_init Argument Table + !! \htmlinclude rk_stratiform_diagnostics_init.html + subroutine rk_stratiform_diagnostics_init(errmsg, errflg) + use cam_history, only: history_add_field + use cam_history_support, only: horiz_only + + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! There is one initialization scheme for all RK diagnostics + ! but there are separate run phases for diagnostics + ! pertaining to each interstitial scheme. See RK SDF file. + + errmsg = '' + errflg = 0 + + ! rk_stratiform_cloud_fraction_perturbation_diagnostics + call history_add_field('AST', 'cloud_area_fraction', 'lev', 'avg', 'fraction') + + ! rk_stratiform_condensate_repartioning_diagnostics + call history_add_field('FICE', 'mass_fraction_of_ice_content_within_stratiform_cloud', 'lev', 'avg', 'fraction') + call history_add_field('REPARTICE', 'tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('REPARTLIQ', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('HREPART', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning', 'lev', 'avg', 'J kg-1 s-1') + + ! rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + call history_add_field('FWAUT', 'relative_importance_of_cloud_liquid_water_autoconversion', 'lev', 'avg', 'fraction') + call history_add_field('FSAUT', 'relative_importance_of_cloud_ice_autoconversion', 'lev', 'avg', 'fraction') + call history_add_field('FRACW', 'relative_importance_of_rain_accreting_cloud_liquid_water', 'lev', 'avg', 'fraction') + call history_add_field('FSACW', 'relative_importance_of_snow_accreting_cloud_liquid_water', 'lev', 'avg', 'fraction') + call history_add_field('FSACI', 'relative_importance_of_snow_accreting_cloud_ice', 'lev', 'avg', 'fraction') + call history_add_field('PCSNOW', 'lwe_snow_precipitation_rate_at_surface_due_to_microphysics', horiz_only, 'avg', 'fraction') + call history_add_field('CME', 'net_condensation_rate_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') ! qme. + call history_add_field('CMEICE', 'rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('CMELIQ', 'rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('ICE2PR', 'tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('LIQ2PR', 'tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion', 'lev', 'avg', 'kg kg-1 s-1') + + call history_add_field('HPROGCLD', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_microphysics', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HEVAP', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HMELT', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HCME', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation', 'lev', 'avg', 'J kg-1 s-1') + call history_add_field('HFREEZ', 'tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation', 'lev', 'avg', 'J kg-1 s-1') + + call history_add_field('PRODPREC', 'precipitation_production_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('EVAPPREC', 'rate_of_evaporation_of_precipitation_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + call history_add_field('EVAPSNOW', 'rate_of_evaporation_of_falling_snow_due_to_microphysics', 'lev', 'avg', 'kg kg-1 s-1') + + ! ... for COSP/CFMIP + call history_add_field('LS_FLXPRC', 'stratiform_rain_and_snow_flux_at_interface', 'ilev', 'avg', 'kg m-2 s-1') + call history_add_field('LS_FLXSNW', 'stratiform_snow_flux_at_interface', 'ilev', 'avg', 'kg m-2 s-1') + call history_add_field('PRACWO', 'accretion_of_cloud_liquid_water_by_rain', 'lev', 'avg', 's-1') + call history_add_field('PSACWO', 'accretion_of_cloud_liquid_water_by_snow', 'lev', 'avg', 's-1') + call history_add_field('PSACIO', 'accretion_of_cloud_ice_by_snow', 'lev', 'avg', 's-1') + + call history_add_field('CLDLIQSTR', 'stratiform_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDICESTR', 'stratiform_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDLIQCON', 'convective_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('CLDICECON', 'convective_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + + ! rk_stratiform_cloud_optical_properties_diagnostics + call history_add_field('IWC', 'stratiform_cloud_ice_water_content', 'lev', 'avg', 'kg m-3') + call history_add_field('LWC', 'stratiform_cloud_liquid_water_content', 'lev', 'avg', 'kg m-3') + call history_add_field('ICIMR', 'in_cloud_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + call history_add_field('ICWMR', 'in_cloud_cloud_liquid_mixing_ratio_wrt_moist_air_and_condensed_water', 'lev', 'avg', 'kg kg-1') + + call history_add_field('REI', 'effective_radius_of_stratiform_cloud_ice_particle', 'lev', 'avg', 'um') + call history_add_field('REL', 'effective_radius_of_stratiform_cloud_liquid_water_particle', 'lev', 'avg', 'um') + + + end subroutine rk_stratiform_diagnostics_init + + !> \section arg_table_rk_stratiform_cloud_fraction_perturbation_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_cloud_fraction_perturbation_diagnostics_run.html + subroutine rk_stratiform_cloud_fraction_perturbation_diagnostics_run( & + cloud, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: cloud(:, :) ! cloud_area_fraction [fraction] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('AST', cloud) + + end subroutine rk_stratiform_cloud_fraction_perturbation_diagnostics_run + + !> \section arg_table_rk_stratiform_condensate_repartioning_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_condensate_repartioning_diagnostics_run.html + subroutine rk_stratiform_condensate_repartioning_diagnostics_run( & + fice, tend_cldice, tend_cldliq, repartht, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + real(kind_phys), intent(in) :: fice(:,:) ! mass_fraction_of_ice_content_within_stratiform_cloud [fraction] + real(kind_phys), intent(in) :: tend_cldice(:,:) ! tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1] + real(kind_phys), intent(in) :: tend_cldliq(:,:) ! tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1] + real(kind_phys), intent(in) :: repartht(:,:) ! [J kg-1 s-1] + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('FICE', fice) + call history_out_field('REPARTICE', tend_cldice) + call history_out_field('REPARTLIQ', tend_cldliq) + call history_out_field('HREPART', repartht) + + end subroutine rk_stratiform_condensate_repartioning_diagnostics_run + + !> \section arg_table_rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run.html + subroutine rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run( & + ncol, pver, & + cloud, concld, & + cldliq, cldice, & + fwaut, fsaut, fracw, fsacw, fsaci, & + snow_pcw, cme, cmeice, cmeliq, ice2pr, liq2pr, & + tend_s, & + evapheat, meltheat, cmeheat, prfzheat, & + prodprec, evapprec, evapsnow, & + lsflxprc, lsflxsnw, & + pracwo, psacwo, psacio, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input parameters + integer, intent(in) :: ncol + integer, intent(in) :: pver + real(kind_phys), intent(in) :: cloud(:,:) ! cloud_area_fraction [fraction] + real(kind_phys), intent(in) :: concld(:,:) ! convective_cloud_area_fraction [fraction] + real(kind_phys), intent(in) :: cldliq(:,:) ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: cldice(:,:) ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + + real(kind_phys), intent(in) :: fwaut(:,:) + real(kind_phys), intent(in) :: fsaut(:,:) + real(kind_phys), intent(in) :: fracw(:,:) + real(kind_phys), intent(in) :: fsacw(:,:) + real(kind_phys), intent(in) :: fsaci(:,:) + + real(kind_phys), intent(in) :: snow_pcw(:) + real(kind_phys), intent(in) :: cme(:,:) + real(kind_phys), intent(in) :: cmeice(:,:) + real(kind_phys), intent(in) :: cmeliq(:,:) + real(kind_phys), intent(in) :: ice2pr(:,:) + real(kind_phys), intent(in) :: liq2pr(:,:) + + real(kind_phys), intent(in) :: tend_s(:,:) + real(kind_phys), intent(in) :: evapheat(:,:) + real(kind_phys), intent(in) :: meltheat(:,:) + real(kind_phys), intent(in) :: cmeheat(:,:) + real(kind_phys), intent(in) :: prfzheat(:,:) + + real(kind_phys), intent(in) :: prodprec(:,:) + real(kind_phys), intent(in) :: evapprec(:,:) + real(kind_phys), intent(in) :: evapsnow(:,:) + real(kind_phys), intent(in) :: lsflxprc(:,:) + real(kind_phys), intent(in) :: lsflxsnw(:,:) + real(kind_phys), intent(in) :: pracwo(:,:) + real(kind_phys), intent(in) :: psacwo(:,:) + real(kind_phys), intent(in) :: psacio(:,:) + + ! CCPP error handling variables + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys) :: cldliqstr(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldicestr(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldliqcon(ncol, pver) ! [kg kg-1] + real(kind_phys) :: cldicecon(ncol, pver) ! [kg kg-1] + integer :: i, k + + errmsg = '' + errflg = 0 + + ! History out field calls + call history_out_field('FWAUT', fwaut) + call history_out_field('FSAUT', fsaut) + call history_out_field('FRACW', fracw) + call history_out_field('FSACW', fsacw) + call history_out_field('FSACI', fsaci) + + call history_out_field('PCSNOW', snow_pcw) + call history_out_field('CME', cme) + call history_out_field('CMEICE', cmeice) + call history_out_field('CMELIQ', cmeliq) + call history_out_field('ICE2PR', ice2pr) + call history_out_field('LIQ2PR', liq2pr) + + call history_out_field('HPROGCLD', tend_s) + call history_out_field('HEVAP', evapheat) + call history_out_field('HMELT', meltheat) + call history_out_field('HCME', cmeheat) + call history_out_field('HFREEZ', prfzheat) + + call history_out_field('PRODPREC', prodprec) + call history_out_field('EVAPPREC', evapprec) + call history_out_field('EVAPSNOW', evapsnow) + + call history_out_field('LS_FLXPRC', lsflxprc) + call history_out_field('LS_FLXSNW', lsflxsnw) + call history_out_field('PRACWO', pracwo) + call history_out_field('PSACWO', psacwo) + call history_out_field('PSACIO', psacio) + + ! Derived diagnostics -- mass mixing ratio for stratiform or convective cloud liquid / cloud ice + cldliqstr(:,:) = 0._kind_phys + cldicestr(:,:) = 0._kind_phys + cldliqcon(:,:) = 0._kind_phys + cldicecon(:,:) = 0._kind_phys + do k = 1, pver + do i = 1, ncol + if(cloud(i,k) > 0._kind_phys) then + ! convective mass mixing ratios + cldliqcon(i,k) = cldliq(i,k)/cloud(i,k) * concld(i,k) + cldicecon(i,k) = cldice(i,k)/cloud(i,k) * concld(i,k) + + ! stratiform (large-scale) mass mixing ratios + cldliqstr(i,k) = cldliq(i,k)/cloud(i,k) * (cloud(i,k) - concld(i,k)) + cldicestr(i,k) = cldice(i,k)/cloud(i,k) * (cloud(i,k) - concld(i,k)) + endif + enddo + enddo + + call history_out_field('CLDLIQCON', cldliqcon) + call history_out_field('CLDICECON', cldicecon) + + call history_out_field('CLDLIQSTR', cldliqstr) + call history_out_field('CLDICESTR', cldicestr) + + end subroutine rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + + !> \section arg_table_rk_stratiform_cloud_optical_properties_diagnostics_run Argument Table + !! \htmlinclude rk_stratiform_cloud_optical_properties_diagnostics_run.html + subroutine rk_stratiform_cloud_optical_properties_diagnostics_run( & + ncol, pver, & + rair, & + pmid, & + t, & + cldice, cldliq, & + rhcloud, & + rel, rei, & + errmsg, errflg) + + use cam_history, only: history_out_field + + ! Input arguments + integer, intent(in) :: ncol + integer, intent(in) :: pver + real(kind_phys), intent(in) :: rair + real(kind_phys), intent(in) :: pmid(:,:) ! air_pressure [Pa] + real(kind_phys), intent(in) :: t(:,:) ! air_temperature [K] + real(kind_phys), intent(in) :: cldliq(:,:) ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: cldice(:,:) ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys), intent(in) :: rhcloud(:,:) ! cloud_area_fraction_from_relative_humidity_method [fraction] + real(kind_phys), intent(in) :: rel(:,:) ! effective_radius_of_stratiform_cloud_liquid_water_particle [um] + real(kind_phys), intent(in) :: rei(:,:) ! effective_radius_of_stratiform_cloud_ice_particle [um] + + ! Output arguments + character(len=512), intent(out) :: errmsg ! error message + integer, intent(out) :: errflg ! error flag + + ! Temporaries for diagnostic output. + real(kind_phys) :: iwc(ncol,pver) ! stratiform_cloud_ice_water_content [kg m-3] + real(kind_phys) :: lwc(ncol,pver) ! stratiform_cloud_liquid_water_content [kg m-3] + real(kind_phys) :: icimr(ncol,pver) ! in_cloud_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + real(kind_phys) :: icwmr(ncol,pver) ! in_cloud_cloud_liquid_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1] + + integer :: i, k + + + ! Prognostic cloud water diagnostics + ! needs updated cloud fraction + do k = 1, pver + do i = 1, ncol + iwc(i,k) = cldice(i,k)*pmid(i,k)/(rair*t(i,k)) + lwc(i,k) = cldliq(i,k)*pmid(i,k)/(rair*t(i,k)) + icimr(i,k) = cldice(i,k) / max(0.01_kind_phys, rhcloud(i,k)) + icwmr(i,k) = cldliq(i,k) / max(0.01_kind_phys, rhcloud(i,k)) + end do + end do + + call history_out_field('IWC', iwc) + call history_out_field('LWC', lwc) + call history_out_field('ICIMR', icimr) + call history_out_field('ICWMR', icwmr) + + ! Cloud optical properties + call history_out_field('REL', rel) + call history_out_field('REI', rei) + + end subroutine rk_stratiform_cloud_optical_properties_diagnostics_run + + +end module rk_stratiform_diagnostics diff --git a/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta b/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta new file mode 100644 index 00000000..9346b7d2 --- /dev/null +++ b/schemes/sima_diagnostics/rk_stratiform_diagnostics.meta @@ -0,0 +1,371 @@ +[ccpp-table-properties] + name = rk_stratiform_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_diagnostics_init + type = scheme +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_cloud_fraction_perturbation_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_cloud_fraction_perturbation_diagnostics_run + type = scheme +[ cloud ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_condensate_repartioning_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_condensate_repartioning_diagnostics_run + type = scheme +[ fice ] + standard_name = mass_fraction_of_ice_content_within_stratiform_cloud + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_cldice ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_cldliq ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ repartht ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_cloud_ice_and_cloud_liquid_repartitioning + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_prognostic_cloud_water_tendencies_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ cloud ] + standard_name = cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ concld ] + standard_name = convective_cloud_area_fraction + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldliq ] + standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ cldice ] + standard_name = cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in + advected = true +[ fwaut ] + standard_name = relative_importance_of_cloud_liquid_water_autoconversion + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsaut ] + standard_name = relative_importance_of_cloud_ice_autoconversion + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fracw ] + standard_name = relative_importance_of_rain_accreting_cloud_liquid_water + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsacw ] + standard_name = relative_importance_of_snow_accreting_cloud_liquid_water + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ fsaci ] + standard_name = relative_importance_of_snow_accreting_cloud_ice + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ snow_pcw ] + standard_name = lwe_snow_precipitation_rate_at_surface_due_to_microphysics + units = m s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ cme ] + standard_name = net_condensation_rate_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeice ] + standard_name = rate_of_condensation_minus_evaporation_for_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeliq ] + standard_name = rate_of_condensation_minus_evaporation_for_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ ice2pr ] + standard_name = tendency_of_cloud_ice_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_ice_to_snow_autoconversion + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ liq2pr ] + standard_name = tendency_of_cloud_liquid_water_mixing_ratio_wrt_to_moist_air_and_condensed_water_due_to_liquid_to_rain_autoconversion + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ tend_s ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_evaporation_of_precipitation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ meltheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_snow_melt + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cmeheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_condensation_minus_evaporation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prfzheat ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_freezing_of_precipitation + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ prodprec ] + standard_name = precipitation_production_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapprec ] + standard_name = rate_of_evaporation_of_precipitation_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ evapsnow ] + standard_name = rate_of_evaporation_of_falling_snow_due_to_microphysics + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ lsflxprc ] + standard_name = stratiform_rain_and_snow_flux_at_interface + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ lsflxsnw ] + standard_name = stratiform_snow_flux_at_interface + units = kg m-2 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_interface_dimension) + intent = in +[ pracwo ] + standard_name = accretion_of_cloud_liquid_water_by_rain + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ psacwo ] + standard_name = accretion_of_cloud_liquid_water_by_snow + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ psacio ] + standard_name = accretion_of_cloud_ice_by_snow + units = s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out + +[ccpp-table-properties] + name = rk_stratiform_cloud_optical_properties_diagnostics + type = scheme + +[ccpp-arg-table] + name = rk_stratiform_cloud_optical_properties_diagnostics_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in +[ pver ] + standard_name = vertical_layer_dimension + units = count + type = integer + dimensions = () + intent = in +[ rair ] + standard_name = gas_constant_of_dry_air + units = J kg-1 K-1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ t ] + standard_name = air_temperature + units = K + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldice ] + standard_name = cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ cldliq ] + standard_name = cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rhcloud ] + standard_name = cloud_area_fraction_from_relative_humidity_method + units = fraction + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rel ] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle + units = um + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ rei ] + standard_name = effective_radius_of_stratiform_cloud_ice_particle + units = um + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ errmsg ] + standard_name = ccpp_error_message + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_code + units = 1 + type = integer + dimensions = () + intent = out diff --git a/suites/suite_cam4.xml b/suites/suite_cam4.xml index 9c2c943b..7c3fc7f8 100644 --- a/suites/suite_cam4.xml +++ b/suites/suite_cam4.xml @@ -5,8 +5,8 @@ CAM4 PHYSICS SUITE Deep convection ZM Shallow convection Hack - Macrophysics RK (not implemented) - Microphysics RK (not implemented) + Macrophysics RK + Microphysics RK Radiation RRTMGP (not implemented) Chemistry None (not implemented) Vertical Diffusion HB (not implemented) @@ -127,8 +127,88 @@ check_energy_chng + + tropopause_find + + + rk_stratiform_diagnostics + + + rk_stratiform_check_qtlcwat + + + cloud_particle_sedimentation + cloud_particle_sedimentation_diagnostics + apply_constituent_tendencies + apply_heating_rate + qneg + geopotential_temp + rk_stratiform_sedimentation + + + rk_stratiform_detrain_convective_condensate + apply_constituent_tendencies + qneg + geopotential_temp + + + convective_cloud_cover + convective_cloud_cover_diagnostics + compute_cloud_fraction + rk_stratiform_cloud_fraction_perturbation + rk_stratiform_cloud_fraction_perturbation_diagnostics + + + rk_stratiform_external_forcings + + + cloud_fraction_fice + + + prognostic_cloud_water + + + rk_stratiform_condensate_repartioning + rk_stratiform_condensate_repartioning_diagnostics + apply_constituent_tendencies + qneg + geopotential_temp + + + rk_stratiform_prognostic_cloud_water_tendencies + rk_stratiform_prognostic_cloud_water_tendencies_diagnostics + apply_constituent_tendencies + apply_heating_rate + qneg + geopotential_temp + + + compute_cloud_fraction + compute_cloud_fraction_diagnostics + + + rk_stratiform_cloud_optical_properties + rk_stratiform_cloud_optical_properties_diagnostics + + + rk_stratiform_save_qtlcwat sima_state_diagnostics diff --git a/test/test_suites/suite_rasch_kristjansson.xml b/test/test_suites/suite_rasch_kristjansson.xml index 1281df89..b76ffb2b 100644 --- a/test/test_suites/suite_rasch_kristjansson.xml +++ b/test/test_suites/suite_rasch_kristjansson.xml @@ -23,7 +23,7 @@ cloud_particle_sedimentation - + cloud_particle_sedimentation_diagnostics apply_constituent_tendencies apply_heating_rate qneg @@ -45,10 +45,10 @@ relative humidity derivative used in the prognostic_cloud_water scheme. --> convective_cloud_cover - + convective_cloud_cover_diagnostics compute_cloud_fraction rk_stratiform_cloud_fraction_perturbation - + rk_stratiform_cloud_fraction_perturbation_diagnostics @@ -67,7 +67,7 @@ repartition heating from change in cloud ice is determined here, but only the constituent tendencies are applied in the repartitioning step. --> rk_stratiform_condensate_repartioning - + rk_stratiform_condensate_repartioning_diagnostics apply_constituent_tendencies qneg geopotential_temp @@ -76,7 +76,7 @@ repartition heating determined in condensate_repartitioning scheme is applied here, together with other heating fluxes from prognostic_cloud_water. --> rk_stratiform_prognostic_cloud_water_tendencies - + rk_stratiform_prognostic_cloud_water_tendencies_diagnostics apply_constituent_tendencies apply_heating_rate qneg @@ -84,13 +84,14 @@ compute_cloud_fraction - + compute_cloud_fraction_diagnostics rk_stratiform_cloud_optical_properties - + rk_stratiform_cloud_optical_properties_diagnostics rk_stratiform_save_qtlcwat + From 2b66267fe263d9268effeaa1d47e3c03e6121d74 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 18 Jun 2025 11:02:48 -0700 Subject: [PATCH 10/11] Update MUSICA suite (#252) Originator(s): Matt Dawson Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): - Updates the MUSICA suite file to include diagnostics so we can include chemical species in the output files. - Updates the MICM wrapper to output warnings to the log file when the solver fails. - Updates to the latest version of the MUSICA library List all namelist files that were added or changed: none List all files eliminated and why: none List all files added and what they do: none List all existing files that have been modified, and describe the changes: (Helpful git command: `git diff --name-status development...`) | File | Description | | ------------------------------------- | ------------------------------------------------------------------------ | | test/musica/test_musica_api.F90 | Introduce `STDOUT` constant and update calls to `musica_ccpp_run` to pass log unit | | test/docker/Dockerfile.musica.no_install | Bump `MUSICA_GIT_TAG` and switch `BUILD_TYPE` to Release | | test/docker/Dockerfile.musica | Bump `MUSICA_GIT_TAG` and switch `BUILD_TYPE` to Release | | suites/suite_musica.xml | Add `sima_state_diagnostics` scheme and a comment for state diagnostics | | schemes/musica/musica_ccpp.meta | Define new `log_output_unit` parameter in metadata | | schemes/musica/musica_ccpp.F90 | Add `log_output_unit` argument to `musica_ccpp_run` interface | | schemes/musica/micm/musica_ccpp_micm.F90 | Add `log_output_unit` to `micm_run` and emit solver failure warnings | List all automated tests that failed, as well as an explanation for why they weren't fixed: none Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? It should only affect answers for chemistry If yes to the above question, describe how this code was validated with the new/modified features: --------- Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- schemes/musica/micm/musica_ccpp_micm.F90 | 10 +++++++++- schemes/musica/musica_ccpp.F90 | 5 +++-- schemes/musica/musica_ccpp.meta | 6 ++++++ suites/suite_musica.xml | 3 +++ test/docker/Dockerfile.musica | 4 ++-- test/docker/Dockerfile.musica.no_install | 4 ++-- test/musica/test_musica_api.F90 | 12 +++++++----- 7 files changed, 32 insertions(+), 12 deletions(-) diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index cc9f8f09..1cfb694b 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -174,7 +174,7 @@ end subroutine micm_init !> Solves chemistry at the current time step subroutine micm_run(time_step, temperature, pressure, dry_air_density, & - rate_parameters, mixing_ratios, errmsg, errcode) + rate_parameters, mixing_ratios, log_output_unit, errmsg, errcode) use musica_ccpp_micm_util, only: update_micm_state, extract_mixing_ratios_from_state use musica_micm, only: solver_stats_t use musica_util, only: string_t, error_t @@ -186,6 +186,7 @@ subroutine micm_run(time_step, temperature, pressure, dry_air_density, & real(kind_phys), target, intent(in) :: dry_air_density(:,:) ! kg m-3 real(kind_phys), target, intent(in) :: rate_parameters(:,:,:) ! various units real(kind_phys), target, intent(inout) :: mixing_ratios(:,:,:) ! kg kg-1 + integer, intent(in) :: log_output_unit ! file unit for logging output character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -226,6 +227,13 @@ subroutine micm_run(time_step, temperature, pressure, dry_air_density, & ! Solve the system call micm%solve( time_step, state, solver_state, solver_stats, error ) if (has_error_occurred(error, errmsg, errcode)) return + if (solver_state%get_char_array() /= "Converged") then + write(log_output_unit,*) & + "[MUSICA Warning] MICM solver failure: '" // & + trim(solver_state%get_char_array()) // "'. For grid cells ", & + (i_state - 1) * state_1_size + 1, " to ", i_state * state_1_size, & + " of ", number_of_grid_cells + end if ! Update the mixing ratios with the results call extract_mixing_ratios_from_state( state, offset, mixing_ratios) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index bb86ed04..5dc114bc 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -140,7 +140,7 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co surface_temperature, surface_albedo, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & air_pressure_thickness, solar_zenith_angle, earth_sun_distance, & - errmsg, errcode) + log_output_unit, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_kinds, only: kind_phys use musica_ccpp_species, only: number_of_tuvx_species, tuvx_indices_constituent_props, & @@ -164,6 +164,7 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, layer) real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians (column) real(kind_phys), intent(in) :: earth_sun_distance ! AU + integer, intent(in) :: log_output_unit ! file unit number for logging character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -200,7 +201,7 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co ! Solve chemistry at the current time step call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, & - constituents, errmsg, errcode) + constituents, log_output_unit, errmsg, errcode) if (errcode /= 0) return end subroutine musica_ccpp_run diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 61401564..62d45a08 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -188,6 +188,12 @@ type = real | kind = kind_phys dimensions = () intent = in +[ log_output_unit ] + standard_name = log_output_unit + units = 1 + type = integer + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/suites/suite_musica.xml b/suites/suite_musica.xml index e32ea549..d433c83b 100644 --- a/suites/suite_musica.xml +++ b/suites/suite_musica.xml @@ -4,5 +4,8 @@ calc_dry_air_ideal_gas_density musica_ccpp + + + sima_state_diagnostics diff --git a/test/docker/Dockerfile.musica b/test/docker/Dockerfile.musica index a8423f4c..d73fc5de 100644 --- a/test/docker/Dockerfile.musica +++ b/test/docker/Dockerfile.musica @@ -5,10 +5,10 @@ FROM ubuntu:22.04 -ARG MUSICA_GIT_TAG=72c3b398fa4713effc5648b29b8070cb432eebf2 +ARG MUSICA_GIT_TAG=25fff7ae42d146bf3f83ad5ac18b3caac8701ddd ARG CAM_SIMA_CHEMISTRY_DATA_TAG=71ed143c54b0d5d6e3e70f3d05d413fddcf8d59e ARG USE_INSTALLED_MUSICA_LIB=ON -ARG BUILD_TYPE=Debug +ARG BUILD_TYPE=Release RUN apt update \ && apt install -y sudo \ diff --git a/test/docker/Dockerfile.musica.no_install b/test/docker/Dockerfile.musica.no_install index 99fd06d5..b683a21a 100644 --- a/test/docker/Dockerfile.musica.no_install +++ b/test/docker/Dockerfile.musica.no_install @@ -8,10 +8,10 @@ FROM ubuntu:22.04 -ARG MUSICA_GIT_TAG=72c3b398fa4713effc5648b29b8070cb432eebf2 +ARG MUSICA_GIT_TAG=25fff7ae42d146bf3f83ad5ac18b3caac8701ddd ARG CAM_SIMA_CHEMISTRY_DATA_TAG=71ed143c54b0d5d6e3e70f3d05d413fddcf8d59e ARG USE_INSTALLED_MUSICA_LIB=OFF -ARG BUILD_TYPE=Debug +ARG BUILD_TYPE=Release RUN apt update \ && apt install -y sudo \ diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 1da95bb1..172263bb 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -20,6 +20,8 @@ program run_test_musica_ccpp real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR__G_MOL = MOLAR_MASS_DRY_AIR * 1.0e3_kind_phys ! g mol-1 + integer, parameter :: STDOUT = 6 + type :: ArrheniusReaction real(kind_phys) :: A_ = 1.0 real(kind_phys) :: B_ = 0.0 @@ -255,8 +257,8 @@ subroutine test_chapman() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, extraterrestrial_radiation_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & - errcode ) + air_pressure_thickness, solar_zenith_angle, earth_sun_distance, STDOUT, & + errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -496,8 +498,8 @@ subroutine test_terminator() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, extraterrestrial_radiation_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & - errcode ) + air_pressure_thickness, solar_zenith_angle, earth_sun_distance, STDOUT, & + errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -689,7 +691,7 @@ subroutine test_analytical(number_of_columns, number_of_layers, test_accuracy) call musica_ccpp_run( time_step, temperature, pressure, dry_air_mass_density, constituent_props_ptr, & constituents, dummy_array_2D, dummy_array_2D, dummy_array_1D, dummy_array_1D, & dummy_array_1D, dummy_array_1D, -HUGE(0.0_kind_phys), dummy_array_2D, & - dummy_array_2D, dummy_array_1D, -HUGE(0.0_kind_phys), errmsg, errcode ) + dummy_array_2D, dummy_array_1D, -HUGE(0.0_kind_phys), STDOUT, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 From a40ab9e4c3daa15c3095b662cb104995510f1c63 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 23 Jun 2025 09:30:11 -0600 Subject: [PATCH 11/11] RRTMGP longwave Fortran modules (#230) Originator(s): peverwhee Description (include issue title and the keyword ['closes', 'fixes', 'resolves'] and issue number): **Brings in CCPP-ized longwave Fortran modules for RRTMGP.** The order of the schemes in the SDF will eventually be: - rrtmgp_lw_gas_optics_data - rrtmgp_pre - tropopause_find (already CCPP-ized) - rrtmgp_inputs - rrtmgp_lw_cloud_optics - rrtmgp_lw_mcica_subcol_gen - LW diagnostics subcycle: - rrtmgp_lw_gas_optics_pre - rrtmgp_lw_gas_optics - rrtmgp_lw_main - rrtmgp_lw_diagnostics (does not exist yet) - rrtmgp_dry_static_energy_tendency - calculate_net_heating - rrtmgp_post addresses #154 List all namelist files that were added or changed: n/a List all files eliminated and why: n/a **List all files added and what they do:** A phys_utils/atmos_phys_string_utils.F90 - string utils functionality for atmospheric_physics (to_lower and to_upper for now A schemes/rrtmgp/objects/ccpp_fluxes.F90 A schemes/rrtmgp/objects/ccpp_fluxes.meta A schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 A schemes/rrtmgp/objects/ccpp_fluxes_byband.meta A schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 A schemes/rrtmgp/objects/ccpp_gas_concentrations.meta A schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 A schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta A schemes/rrtmgp/objects/ccpp_optical_props.F90 A schemes/rrtmgp/objects/ccpp_optical_props.meta A schemes/rrtmgp/objects/ccpp_source_functions.F90 A schemes/rrtmgp/objects/ccpp_source_functions.meta - RRTMGP object wrappers and corresponding metadata A schemes/rrtmgp/rrtmgp_inputs.F90 - CCPP-ized core rrtmgp_set_state from rrtmgp_inputs.F90 in CAM (setting up the LW and SW inputs) - SIMA-specific interstitial A schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 - CCPP-ized longwave cloud optics (rrtmgp_set_cloud_lw from rrtmgp_inputs in CAM) - SIMA-specific scheme (CAM does not use the built-in RRTMGP cloud optics) A schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 - CCPP-ized longwave gas optics calculation (rrtmgp_set_gases_lw from rrtmgp_inputs in CAM) - This scheme will be shared with NOAA A schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 - CCPP-ized longwave gas optics initialization/load (contains only an "init" phase) - Basically the CCPP-ized version of coefs_init from radiation.F90 in CAM (LW) - This scheme will be shared with NOAA - Is separate from rrtmgp_lw_gas_optics.F90 because init has to come before cloud_optics_init and run has to come after cloud_optics_run A schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 - CCPP-ized prep for gas optics calculation (rrtmgp_lw_gas_optics) - SIMA-specific interstitial A schemes/rrtmgp/rrtmgp_lw_main.F90 - CCPP-ized interface to the RTE LW calculation - This scheme will be shared with NOAA A schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 - CCPP-ized module for McICA subcolumn generation - SIMA-specific, non-portable scheme (depends on shr_RandNum_mod.F90) A schemes/rrtmgp/rrtmgp_post.F90 - CCPP-ized post-SW and LW calculations and object clean-up - SIMA-specific interstitial A schemes/rrtmgp/rrtmgp_pre.F90 - CCPP-ized pre-SW and LW calculations and object allocation/initialization - SIMA-specific interstitial A schemes/rrtmgp/utils/calculate_net_heating.F90 - CCPP-ized radheat.F90 from CAM A schemes/rrtmgp/utils/radiation_tools.F90 - This is a duplicate of the radiation_tools.F90 in ccpp-physics/physics/Radiation/ - The only routine we're currently using is check_error_msg - Will be removed when we bring in ccpp-physics - Will be shared with NOAA A schemes/rrtmgp/utils/radiation_utils.F90 - Non-ccpp-ized routines used by both shortwave and longwave - SIMA-specific A schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 - CCPP-ized scheme to calculate dry static energy tendency (qrl and qrs) List all existing files that have been modified, and describe the changes: n/a (Helpful git command: `git diff --name-status development...`) List all automated tests that failed, as well as an explanation for why they weren't fixed: Is this an answer-changing PR? If so, is it a new physics package, algorithm change, tuning change, etc? b4b in CAM If yes to the above question, describe how this code was validated with the new/modified features: --------- Co-authored-by: Courtney Peverley --- phys_utils/atmos_phys_rad_utils.F90 | 33 + phys_utils/atmos_phys_string_utils.F90 | 60 ++ schemes/rrtmgp/objects/ccpp_fluxes.F90 | 11 + schemes/rrtmgp/objects/ccpp_fluxes.meta | 8 + schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 | 11 + .../rrtmgp/objects/ccpp_fluxes_byband.meta | 8 + .../objects/ccpp_gas_concentrations.F90 | 11 + .../objects/ccpp_gas_concentrations.meta | 8 + .../rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 | 11 + .../objects/ccpp_gas_optics_rrtmgp.meta | 8 + schemes/rrtmgp/objects/ccpp_optical_props.F90 | 18 + .../rrtmgp/objects/ccpp_optical_props.meta | 16 + .../rrtmgp/objects/ccpp_source_functions.F90 | 11 + .../rrtmgp/objects/ccpp_source_functions.meta | 8 + schemes/rrtmgp/rrtmgp_inputs.F90 | 627 ++++++++++++++++++ schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 | 395 +++++++++++ schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 | 91 +++ schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 | 102 +++ schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 | 182 +++++ schemes/rrtmgp/rrtmgp_lw_main.F90 | 251 +++++++ schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 | 194 ++++++ schemes/rrtmgp/rrtmgp_post.F90 | 153 +++++ schemes/rrtmgp/rrtmgp_pre.F90 | 402 +++++++++++ .../rrtmgp/utils/calculate_net_heating.F90 | 66 ++ schemes/rrtmgp/utils/radiation_tools.F90 | 98 +++ schemes/rrtmgp/utils/radiation_utils.F90 | 205 ++++++ .../rrtmgp_dry_static_energy_tendency.F90 | 62 ++ test/unit-test/CMakeLists.txt | 2 + .../unit-test/tests/phys_utils/CMakeLists.txt | 2 + .../tests/phys_utils/test_atmos_rad_utils.pf | 41 ++ .../phys_utils/test_atmos_string_utils.pf | 103 +++ 31 files changed, 3198 insertions(+) create mode 100644 phys_utils/atmos_phys_rad_utils.F90 create mode 100644 phys_utils/atmos_phys_string_utils.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes.meta create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_fluxes_byband.meta create mode 100644 schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_gas_concentrations.meta create mode 100644 schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta create mode 100644 schemes/rrtmgp/objects/ccpp_optical_props.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_optical_props.meta create mode 100644 schemes/rrtmgp/objects/ccpp_source_functions.F90 create mode 100644 schemes/rrtmgp/objects/ccpp_source_functions.meta create mode 100644 schemes/rrtmgp/rrtmgp_inputs.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_main.F90 create mode 100644 schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 create mode 100644 schemes/rrtmgp/rrtmgp_post.F90 create mode 100644 schemes/rrtmgp/rrtmgp_pre.F90 create mode 100644 schemes/rrtmgp/utils/calculate_net_heating.F90 create mode 100644 schemes/rrtmgp/utils/radiation_tools.F90 create mode 100644 schemes/rrtmgp/utils/radiation_utils.F90 create mode 100644 schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 create mode 100644 test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf create mode 100644 test/unit-test/tests/phys_utils/test_atmos_string_utils.pf diff --git a/phys_utils/atmos_phys_rad_utils.F90 b/phys_utils/atmos_phys_rad_utils.F90 new file mode 100644 index 00000000..50d2e116 --- /dev/null +++ b/phys_utils/atmos_phys_rad_utils.F90 @@ -0,0 +1,33 @@ +module atmos_phys_rad_utils + ! Radiation utility functions + + implicit none + private + + public :: is_visible + +contains + + pure logical function is_visible(wavenumber) + ! Returns true if the provided wavenumber is above the visible threshold + use ccpp_kinds, only: kind_phys + + ! Wavenumber is in the visible if it is above the visible threshold + ! wavenumber, and in the infrared if it is below the threshold + ! This function doesn't distinquish between visible and UV. + + ! wavenumber in inverse cm (cm^-1) + real(kind_phys), intent(in) :: wavenumber + + ! Set threshold between visible and infrared to 0.7 micron, or 14286 cm^-1 + real(kind_phys), parameter :: visible_wavenumber_threshold = 14286._kind_phys ! cm^-1 + + if (wavenumber > visible_wavenumber_threshold) then + is_visible = .true. + else + is_visible = .false. + end if + + end function is_visible + +end module atmos_phys_rad_utils diff --git a/phys_utils/atmos_phys_string_utils.F90 b/phys_utils/atmos_phys_string_utils.F90 new file mode 100644 index 00000000..f7431f87 --- /dev/null +++ b/phys_utils/atmos_phys_string_utils.F90 @@ -0,0 +1,60 @@ +module atmos_phys_string_utils + ! String utils + + implicit none + private + + public :: to_lower + public :: to_upper + +contains + + pure function to_lower(input_string) result(lowercase_string) + ! Return 'input_string' in all lower case + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: lowercase_string + ! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: upper_to_lower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + upper_to_lower = iachar("a") - iachar("A") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + upper_to_lower) + lowercase_string(i:i) = ctmp + end do + + end function to_lower + +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- + + pure function to_upper(input_string) result(uppercase_string) + ! Return 'input_string' in all upper case + character(len=*), intent(in) :: input_string + character(len=len(input_string)) :: uppercase_string + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: lower_to_upper ! integer to convert case + character(len=1) :: ctmp ! Character temporary + !----------------------------------------------------------------------- + lower_to_upper = iachar("A") - iachar("a") + + do i = 1, len(input_string) + ctmp = input_string(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + lower_to_upper) + uppercase_string(i:i) = ctmp + end do + + end function to_upper + +end module atmos_phys_string_utils diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.F90 b/schemes/rrtmgp/objects/ccpp_fluxes.F90 new file mode 100644 index 00000000..062f55e3 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.F90 @@ -0,0 +1,11 @@ +module ccpp_fluxes + ! CCPP wrapper for ty_fluxes_broadband DDT from RRTMGP + use mo_fluxes, only: ty_fluxes_broadband + + !> \section arg_table_ty_fluxes_broadband_ccpp Argument Table + !! \htmlinclude ty_fluxes_broadband_ccpp.html + type, public :: ty_fluxes_broadband_ccpp + type(ty_fluxes_broadband) :: fluxes + end type + +end module ccpp_fluxes diff --git a/schemes/rrtmgp/objects/ccpp_fluxes.meta b/schemes/rrtmgp/objects/ccpp_fluxes.meta new file mode 100644 index 00000000..9ee8e981 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_fluxes_broadband_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_fluxes.F90 + +[ccpp-arg-table] + name = ty_fluxes_broadband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 new file mode 100644 index 00000000..67c2bddb --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.F90 @@ -0,0 +1,11 @@ +module ccpp_fluxes_byband + ! CCPP wrapper for ty_fluxes_byband DDT from RRTMGP + use mo_fluxes_byband, only: ty_fluxes_byband + + !> \section arg_table_ty_fluxes_byband_ccpp Argument Table + !! \htmlinclude ty_fluxes_byband_ccpp.html + type, public :: ty_fluxes_byband_ccpp + type(ty_fluxes_byband) :: fluxes + end type + +end module ccpp_fluxes_byband diff --git a/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta new file mode 100644 index 00000000..43b7ed45 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_fluxes_byband.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_fluxes_byband_ccpp + type = ddt +# dependencies = /path/to/ext/extensions/mo_fluxes_byband.F90 + +[ccpp-arg-table] + name = ty_fluxes_byband_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 new file mode 100644 index 00000000..3b3dd96e --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_concentrations + ! CCPP wrapper for ty_gas_concs DDT from RRTMGP + use mo_gas_concentrations, only: ty_gas_concs + + !> \section arg_table_ty_gas_concs_ccpp Argument Table + !! \htmlinclude ty_gas_concs_ccpp.html + type, public :: ty_gas_concs_ccpp + type(ty_gas_concs) :: gas_concs + end type + +end module ccpp_gas_concentrations diff --git a/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta new file mode 100644 index 00000000..209221c0 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_concentrations.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_gas_concs_ccpp + type = ddt +# dependencies = /path/to/ext/gas-optics/mo_gas_concentrations.F90 + +[ccpp-arg-table] + name = ty_gas_concs_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 new file mode 100644 index 00000000..158da748 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.F90 @@ -0,0 +1,11 @@ +module ccpp_gas_optics_rrtmgp + ! CCPP wrapper for ty_gas_optics_rrtmgp DDT from RRTMGP + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + + !> \section arg_table_ty_gas_optics_rrtmgp_ccpp Argument Table + !! \htmlinclude ty_gas_optics_rrtmgp_ccpp.html + type, public :: ty_gas_optics_rrtmgp_ccpp + type(ty_gas_optics_rrtmgp) :: gas_props + end type + +end module ccpp_gas_optics_rrtmgp diff --git a/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta new file mode 100644 index 00000000..e1e0df46 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_gas_optics_rrtmgp.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt +# dependencies = /path/to/ext/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 + +[ccpp-arg-table] + name = ty_gas_optics_rrtmgp_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.F90 b/schemes/rrtmgp/objects/ccpp_optical_props.F90 new file mode 100644 index 00000000..2e28c582 --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.F90 @@ -0,0 +1,18 @@ +module ccpp_optical_props + ! CCPP wrapper for ty_optical_props_* DDTs from RRTMGP + use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str + + !> \section arg_table_ty_optical_props_1scl_ccpp Argument Table + !! \htmlinclude ty_optical_props_1scl_ccpp.html + type, public :: ty_optical_props_1scl_ccpp + type(ty_optical_props_1scl) :: optical_props + end type + + !> \section arg_table_ty_optical_props_2str_ccpp Argument Table + !! \htmlinclude ty_optical_props_2str_ccpp.html + type, public :: ty_optical_props_2str_ccpp + type(ty_optical_props_2str) :: optical_props + end type + +end module ccpp_optical_props diff --git a/schemes/rrtmgp/objects/ccpp_optical_props.meta b/schemes/rrtmgp/objects/ccpp_optical_props.meta new file mode 100644 index 00000000..f14b163a --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_optical_props.meta @@ -0,0 +1,16 @@ +[ccpp-table-properties] + name = ty_optical_props_1scl_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_optical_props.F90 + +[ccpp-arg-table] + name = ty_optical_props_1scl_ccpp + type = ddt + +[ccpp-table-properties] + name = ty_optical_props_2str_ccpp + type = ddt + +[ccpp-arg-table] + name = ty_optical_props_2str_ccpp + type = ddt diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.F90 b/schemes/rrtmgp/objects/ccpp_source_functions.F90 new file mode 100644 index 00000000..56e65e3d --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.F90 @@ -0,0 +1,11 @@ +module ccpp_source_functions + ! CCPP wrapper for ty_source_func_lw DDT from RRTMGP + use mo_source_functions, only: ty_source_func_lw + + !> \section arg_table_ty_source_func_lw_ccpp Argument Table + !! \htmlinclude ty_source_func_lw_ccpp.html + type, public :: ty_source_func_lw_ccpp + type(ty_source_func_lw) :: sources + end type + +end module ccpp_source_functions diff --git a/schemes/rrtmgp/objects/ccpp_source_functions.meta b/schemes/rrtmgp/objects/ccpp_source_functions.meta new file mode 100644 index 00000000..03a0bbee --- /dev/null +++ b/schemes/rrtmgp/objects/ccpp_source_functions.meta @@ -0,0 +1,8 @@ +[ccpp-table-properties] + name = ty_source_func_lw_ccpp + type = ddt +# dependencies = /path/to/ext/rte-frontend/mo_source_functions.F90 + +[ccpp-arg-table] + name = ty_source_func_lw_ccpp + type = ddt diff --git a/schemes/rrtmgp/rrtmgp_inputs.F90 b/schemes/rrtmgp/rrtmgp_inputs.F90 new file mode 100644 index 00000000..c2b69468 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_inputs.F90 @@ -0,0 +1,627 @@ +module rrtmgp_inputs + + implicit none + private + + public :: rrtmgp_inputs_init + public :: rrtmgp_inputs_run + + contains +!> \section arg_table_rrtmgp_inputs_init Argument Table +!! \htmlinclude rrtmgp_inputs_init.html +!! + subroutine rrtmgp_inputs_init(ktopcam, ktoprad, nlaycam, sw_low_bounds, sw_high_bounds, nswbands, & + pref_edge, nlay, pver, pverp, kdist_sw, kdist_lw, qrl, is_first_step, use_rad_dt_cosz, & + timestep_size, nstep, iradsw, dt_avg, irad_always, is_first_restart_step, is_root, & + nlwbands, nradgas, gasnamelength, iulog, idx_sw_diag, idx_nir_diag, idx_uv_diag, & + idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, nlayp, & + nextsw_cday, current_cal_day, band2gpt_sw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use radiation_utils, only: radiation_utils_init, get_sw_spectral_boundaries_ccpp + + ! Inputs + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nradgas ! Number of radiatively active gases + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative). + integer, intent(in) :: timestep_size ! Timestep size (s) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: iulog ! Logging unit + integer, intent(in) :: gasnamelength ! Length of all of the gas_list entries + real(kind_phys), intent(in) :: current_cal_day ! Current calendar day + real(kind_phys), dimension(:), intent(in) :: pref_edge ! Reference pressures (interfaces) (Pa) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + logical, intent(in) :: is_first_step ! Flag for whether this is the first timestep (.true. = yes) + logical, intent(in) :: is_first_restart_step ! Flag for whether this is the first restart step (.true. = yes) + logical, intent(in) :: use_rad_dt_cosz ! Use adjusted radiation timestep for cosz calculation + logical, intent(in) :: is_root ! Flag for whether this is the root task + + ! Outputs + integer, intent(out) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(out) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(out) :: nlaycam ! Number of vertical layers in CAM. Is either equal to nlay + ! or is 1 less than nlay if "extra layer" is used in the radiation calculations + integer, intent(out) :: nlay ! Number of vertical layers in radiation calculation + integer, intent(out) :: nlayp ! Number of vertical interfaces in radiation calculations (nlay + 1) + ! Indices to specific bands for diagnostic output and COSP input + integer, intent(out) :: idx_sw_diag ! Index of band containing 500-nm wave + integer, intent(out) :: idx_nir_diag ! Index of band containing 1000-nm wave + integer, intent(out) :: idx_uv_diag ! Index of band containing 400-nm wave + integer, intent(out) :: idx_sw_cloudsim ! Index of band for shortwave cosp diagnostics + integer, intent(out) :: idx_lw_diag ! Index of band containing 1000-cm-1 wave (H2O window) + integer, intent(out) :: idx_lw_cloudsim ! Index of band for longwave cosp diagnostics + + integer, intent(out) :: nswgpts ! Number of shortwave g-points + integer, intent(out) :: nlwgpts ! Number of longwave g-points + integer, dimension(:,:), intent(out) :: band2gpt_sw ! Array for converting shortwave band limits to g-points + real(kind_phys), intent(out) :: nextsw_cday ! The next calendar day during which the shortwave radiation calculation will be performed + real(kind_phys), dimension(:), intent(out) :: sw_low_bounds ! Lower bounds of shortwave bands + real(kind_phys), dimension(:), intent(out) :: sw_high_bounds ! Upper bounds of shortwave bands + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave radiative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: irad_always ! Number of time steps to execute radiation continuously + real(kind_phys), intent(inout) :: dt_avg ! averaging time interval for zenith angle + + ! Local variables + real(kind_phys), target :: wavenumber_low_shortwave(nswbands) + real(kind_phys), target :: wavenumber_high_shortwave(nswbands) + real(kind_phys), target :: wavenumber_low_longwave(nlwbands) + real(kind_phys), target :: wavenumber_high_longwave(nlwbands) + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Number of layers in radiation calculation is capped by the number of + ! pressure interfaces below 1 Pa. When the entire model atmosphere is + ! below 1 Pa then an extra layer is added to the top of the model for + ! the purpose of the radiation calculation. + nlay = count( pref_edge(:) > 1._kind_phys ) ! pascals (0.01 mbar) + nlayp = nlay + 1 + + if (nlay == pverp) then + ! Top model interface is below 1 Pa. RRTMGP is active in all model layers plus + ! 1 extra layer between model top and 1 Pa. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + else if (nlay == (pverp-1)) then + ! Special case nlay == (pverp-1) -- topmost interface outside bounds (CAM MT config), treat as if it is ok. + ktopcam = 1 + ktoprad = 2 + nlaycam = pver + nlay = nlay+1 ! reassign the value so later code understands to treat this case like nlay==pverp + if (is_root) then + write(iulog,*) 'RADIATION_INIT: Special case of 1 model interface at p < 1Pa. Top layer will be INCLUDED in radiation calculation.' + write(iulog,*) 'RADIATION_INIT: nlay = ',nlay, ' same as pverp: ',nlay==pverp + end if + else + ! nlay < pverp. nlay layers are used in radiation calcs, and they are + ! all CAM layers. + ktopcam = pver - nlay + 1 + ktoprad = 1 + nlaycam = nlay + end if + + ! Set the sw/lw band boundaries in radconstants. Also sets + ! indicies of specific bands for diagnostic output and COSP input. + call set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + call radiation_utils_init(nswbands, nlwbands, wavenumber_low_shortwave, wavenumber_high_shortwave, & + wavenumber_low_longwave, wavenumber_high_longwave, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! Initialize the SW band boundaries + call get_sw_spectral_boundaries_ccpp(sw_low_bounds, sw_high_bounds, 'cm^-1', errmsg, errflg) + if (errflg /= 0) then + return + end if + + if (is_first_step) then + qrl = 0._kind_phys + end if + + ! Set the radiation timestep for cosz calculations if requested using + ! the adjusted iradsw value from radiation + if (use_rad_dt_cosz) then + dt_avg = iradsw*timestep_size + end if + + ! "irad_always" is number of time steps to execute radiation continuously from + ! start of initial OR restart run + if (irad_always > 0) then + irad_always = irad_always + nstep + end if + + ! Surface components to get radiation computed today + if (.not. is_first_restart_step) then + nextsw_cday = current_cal_day + end if + + end subroutine rrtmgp_inputs_init + +!> \section arg_table_rrtmgp_inputs_run Argument Table +!! \htmlinclude rrtmgp_inputs_run.html +!! + subroutine rrtmgp_inputs_run(dosw, dolw, snow_associated, graupel_associated, & + pmid, pint, t, nday, idxday, cldfprime, & + coszrs, kdist_sw, t_sfc, emis_sfc, t_rad, pmid_rad, & + pint_rad, t_day, pmid_day, pint_day, coszrs_day, & + alb_dir, alb_dif, lwup, stebol, ncol, ktopcam, ktoprad, & + nswbands, asdir, asdif, sw_low_bounds, sw_high_bounds, & + aldir, aldif, nlay, pverp, pver, cld, cldfsnow, & + cldfgrau, graupel_in_rad, gasnamelength, gaslist_lc, & + gas_concs_lw, aer_lw, atm_optics_lw, kdist_lw, & + sources_lw, aer_sw, atm_optics_sw, gas_concs_sw, & + errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use atmos_phys_rad_utils, only: is_visible + ! Inputs + logical, intent(in) :: graupel_in_rad ! Flag to include graupel in radiation calculation + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of vertical layers + integer, intent(in) :: pverp ! Number of vertical interfaces + integer, intent(in) :: nlay ! Number of vertical layers used in radiation calculation + integer, intent(in) :: nswbands ! Number of shortwave bands + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: gasnamelength ! Length of gases in gas_list + integer, intent(in) :: nday ! Number of daylight columns + logical, intent(in) :: dosw ! Flag for performing the shortwave calculation + logical, intent(in) :: dolw ! Flag for performing the longwave calculation + logical, intent(in) :: snow_associated ! Flag for whether the cloud snow fraction argument should be used + logical, intent(in) :: graupel_associated ! Flag for whether the cloud graupel fraction argument should be used + integer, dimension(:), intent(in) :: idxday ! Indices of daylight columns + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Air pressure at midpoint (Pa) + real(kind_phys), dimension(:,:), intent(in) :: pint ! Air pressure at interface (Pa) + real(kind_phys), dimension(:,:), intent(in) :: t ! Air temperature (K) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq+ice) + real(kind_phys), dimension(:), intent(in) :: sw_low_bounds ! Lower bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: sw_high_bounds ! Upper bounds for shortwave bands + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine of solar senith angle (radians) + real(kind_phys), dimension(:), intent(in) :: lwup ! Longwave up flux (W m-2) + real(kind_phys), dimension(:), intent(in) :: asdir ! Shortwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: asdif ! Shortwave diffuse albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldir ! Longwave direct albedo (fraction) + real(kind_phys), dimension(:), intent(in) :: aldif ! Longwave diffuse albedo (fraction) + real(kind_phys), intent(in) :: stebol ! Stefan-Boltzmann constant (W m-2 K-4) + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw ! Shortwave gas optics object + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + character(len=*), dimension(:), intent(in) :: gaslist_lc ! Radiatively active gases + ! Outputs + real(kind_phys), dimension(:,:), intent(out) :: t_rad ! Air temperature with radiation indexing (K) + real(kind_phys), dimension(:,:), intent(out) :: pmid_rad ! Midpoint pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pint_rad ! Interface pressure with radiation indexing (Pa) + real(kind_phys), dimension(:,:), intent(out) :: t_day ! Air temperature of daylight columns (K) + real(kind_phys), dimension(:,:), intent(out) :: pint_day ! Interface pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: pmid_day ! Midpoint pressure of daylight columns (Pa) + real(kind_phys), dimension(:,:), intent(out) :: emis_sfc ! Surface emissivity (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dir ! Surface albedo due to UV and VIS direct (fraction) + real(kind_phys), dimension(:,:), intent(out) :: alb_dif ! Surface albedo due to IR diffused (fraction) + real(kind_phys), dimension(:,:), intent(out) :: cldfprime ! modified cloud fraciton + + real(kind_phys), dimension(:), intent(out) :: t_sfc ! Surface temperature (K) + real(kind_phys), dimension(:), intent(out) :: coszrs_day ! Cosine of solar zenith angle for daylight columns (radians) + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_lw ! Gas concentrations object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: atm_optics_lw ! Atmosphere optical properties object for longwave radiation + type(ty_optical_props_1scl_ccpp), intent(out) :: aer_lw ! Aerosol optical properties object for longwave radiation + type(ty_source_func_lw_ccpp), intent(out) :: sources_lw ! Longwave sources object for longwave radiation + type(ty_gas_concs_ccpp), intent(out) :: gas_concs_sw ! Gas concentrations object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: atm_optics_sw ! Atmosphere optical properties object for shortwave radiation + type(ty_optical_props_2str_ccpp), intent(out) :: aer_sw ! Aerosol optical properties object for shortwave radiation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + real(kind_phys) :: tref_min + real(kind_phys) :: tref_max + integer :: idx, kdx, iband + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dosw .and. .not. dolw) then + return + end if + + ! RRTMGP set state + t_sfc = sqrt(sqrt(lwup(:)/stebol)) ! Surface temp set based on longwave up flux. + + ! Set surface emissivity to 1.0. + ! The land model *does* have its own surface emissivity, but is not spectrally resolved. + ! The LW upward flux is calculated with that land emissivity, and the "radiative temperature" + ! t_sfc is derived from that flux. We assume, therefore, that the emissivity is unity + ! to be consistent with t_sfc. + emis_sfc(:,:) = 1._kind_phys + + ! Level ordering is the same for both CAM and RRTMGP (top to bottom) + t_rad(:,ktoprad:) = t(:,ktopcam:) + pmid_rad(:,ktoprad:) = pmid(:,ktopcam:) + pint_rad(:,ktoprad:) = pint(:,ktopcam:) + + ! Add extra layer values if needed. + if (nlay == pverp) then + t_rad(:,1) = t(:,1) + ! The top reference pressure from the RRTMGP coefficients datasets is 1.005183574463 Pa + ! Set the top of the extra layer just below that. + pint_rad(:,1) = 1.01_kind_phys + + ! next interface down in LT will always be > 1Pa + ! but in MT we apply adjustment to have it be 1.02 Pa if it was too high + where (pint_rad(:,2) <= pint_rad(:,1)) pint_rad(:,2) = pint_rad(:,1)+0.01_kind_phys + + ! set the highest pmid (in the "extra layer") to the midpoint (guarantees > 1Pa) + pmid_rad(:,1) = pint_rad(:,1) + 0.5_kind_phys * (pint_rad(:,2) - pint_rad(:,1)) + + ! For case of CAM MT, also ensure pint_rad(:,2) > pint_rad(:,1) & pmid_rad(:,2) > max(pmid_rad(:,1), min_pressure) + where (pmid_rad(:,2) <= kdist_sw%gas_props%get_press_min()) pmid_rad(:,2) = pint_rad(:,2) + 0.01_kind_phys + else + ! nlay < pverp, thus the 1 Pa level is within a CAM layer. Assuming the top interface of + ! this layer is at a pressure < 1 Pa, we need to adjust the top of this layer so that it + ! is within the valid pressure range of RRTMGP (otherwise RRTMGP issues an error). Then + ! set the midpoint pressure halfway between the interfaces. + pint_rad(:,1) = 1.01_kind_phys + pmid_rad(:,1) = 0.5_kind_phys * (pint_rad(:,1) + pint_rad(:,2)) + end if + + ! Limit temperatures to be within the limits of RRTMGP validity. + tref_min = kdist_sw%gas_props%get_temp_min() + tref_max = kdist_sw%gas_props%get_temp_max() + t_rad = merge(t_rad, tref_min, t_rad > tref_min) + t_rad = merge(t_rad, tref_max, t_rad < tref_max) + + ! Construct arrays containing only daylight columns + do idx = 1, nday + t_day(idx,:) = t_rad(idxday(idx),:) + pmid_day(idx,:) = pmid_rad(idxday(idx),:) + pint_day(idx,:) = pint_rad(idxday(idx),:) + coszrs_day(idx) = coszrs(idxday(idx)) + end do + ! Assign albedos to the daylight columns (from E3SM implementation) + ! Albedos are imported from the surface models as broadband (visible, and near-IR), + ! and we need to map these to appropriate narrower bands used in RRTMGP. Bands + ! are categorized broadly as "visible/UV" or "infrared" based on wavenumber. + ! Loop over bands, and determine for each band whether it is broadly in the + ! visible or infrared part of the spectrum based on a dividing line of + ! 0.7 micron, or 14286 cm^-1 + do iband = 1,nswbands + if (is_visible(sw_low_bounds(iband)) .and. & + is_visible(sw_high_bounds(iband))) then + + ! Entire band is in the visible + do idx = 1, nday + alb_dir(iband,idx) = asdir(idxday(idx)) + alb_dif(iband,idx) = asdif(idxday(idx)) + end do + + else if (.not.is_visible(sw_low_bounds(iband)) .and. & + .not.is_visible(sw_high_bounds(iband))) then + ! Entire band is in the longwave (near-infrared) + do idx = 1, nday + alb_dir(iband,idx) = aldir(idxday(idx)) + alb_dif(iband,idx) = aldif(idxday(idx)) + end do + else + ! Band straddles the visible to near-infrared transition, so we take + ! the albedo to be the average of the visible and near-infrared + ! broadband albedos + do idx = 1, nday + alb_dir(iband,idx) = 0.5_kind_phys * (aldir(idxday(idx)) + asdir(idxday(idx))) + alb_dif(iband,idx) = 0.5_kind_phys * (aldif(idxday(idx)) + asdif(idxday(idx))) + end do + end if + end do + ! Strictly enforce albedo bounds + where (alb_dir < 0) + alb_dir = 0.0_kind_phys + end where + where (alb_dir > 1) + alb_dir = 1.0_kind_phys + end where + where (alb_dif < 0) + alb_dif = 0.0_kind_phys + end where + where (alb_dif > 1) + alb_dif = 1.0_kind_phys + end where + + ! modified cloud fraction + ! Compute modified cloud fraction, cldfprime. + ! 1. initialize as cld + ! 2. modify for snow. use max(cld, cldfsnow) + ! 3. modify for graupel if graupel_in_rad is true. + ! use max(cldfprime, cldfgrau) + if (snow_associated) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cld(idx,kdx), cldfsnow(idx,kdx)) + end do + end do + else + cldfprime(:,:) = cld(:,:) + end if + + if (graupel_associated .and. graupel_in_rad) then + do kdx = 1, pver + do idx = 1, ncol + cldfprime(idx,kdx) = max(cldfprime(idx,kdx), cldfgrau(idx,kdx)) + end do + end do + end if + + ! If no daylight columns, can't create empty RRTMGP objects + if (dosw .and. nday > 0) then + ! Initialize object for gas concentrations. + errmsg = gas_concs_sw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + ! Allocates arrays for properties represented on g-points. + errmsg = atm_optics_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for SW aerosol optics. Allocates arrays + ! for properties represented by band. + errmsg = aer_sw%optical_props%alloc_2str(nday, nlay, kdist_sw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + if (dolw) then + ! Initialize object for gas concentrations + errmsg = gas_concs_lw%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for combined gas + aerosol + cloud optics. + errmsg = atm_optics_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for LW aerosol optics. + errmsg = aer_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props%get_band_lims_wavenumber()) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + ! Initialize object for Planck sources. + errmsg = sources_lw%sources%alloc(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + end if + + end subroutine rrtmgp_inputs_run + +!========================================================================================= +! HELPER FUNCTIONS ! +!========================================================================================= + subroutine set_wavenumber_bands(kdist_sw, kdist_lw, nswbands, nlwbands, idx_sw_diag, idx_nir_diag, & + idx_uv_diag, idx_sw_cloudsim, idx_lw_diag, idx_lw_cloudsim, nswgpts, nlwgpts, & + wavenumber_low_shortwave, wavenumber_high_shortwave, wavenumber_low_longwave, & + wavenumber_high_longwave, band2gpt_sw, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_kinds, only: kind_phys + ! Set the low and high limits of the wavenumber grid for sw and lw. + ! Values come from RRTMGP coefficients datasets, and are stored in the + ! kdist objects. + ! + ! Set band indices for bands containing specific wavelengths. + + ! Arguments + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_sw + type(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw + integer, intent(in) :: nswbands + integer, intent(in) :: nlwbands + + integer, intent(out) :: idx_sw_diag + integer, intent(out) :: idx_nir_diag + integer, intent(out) :: idx_uv_diag + integer, intent(out) :: idx_sw_cloudsim + integer, intent(out) :: idx_lw_diag + integer, intent(out) :: idx_lw_cloudsim + integer, intent(out) :: nswgpts + integer, intent(out) :: nlwgpts + integer, dimension(:,:), intent(out) :: band2gpt_sw + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_shortwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_low_longwave + real(kind_phys), dimension(:), intent(out) :: wavenumber_high_longwave + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: istat + real(kind_phys), allocatable :: values(:,:) + character(len=256) :: alloc_errmsg + + character(len=*), parameter :: sub = 'set_wavenumber_bands' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + ! Check that number of sw/lw bands in gas optics files matches the parameters. + if (kdist_sw%gas_props%get_nband() /= nswbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of sw bands in file, ', kdist_sw%gas_props%get_nband(), & + ", doesn't match parameter nswbands= ", nswbands + errflg = 1 + return + end if + if (kdist_lw%gas_props%get_nband() /= nlwbands) then + write(errmsg,'(a, a,i4,a,i4)') sub, ': ERROR: number of lw bands in file, ', kdist_lw%gas_props%get_nband(), & + ", doesn't match parameter nlwbands= ", nlwbands + errflg = 1 + return + end if + + nswgpts = kdist_sw%gas_props%get_ngpt() + nlwgpts = kdist_lw%gas_props%get_ngpt() + + ! SW band bounds in cm^-1 + allocate( values(2,nswbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nswbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_sw%gas_props%get_band_lims_wavenumber() + wavenumber_low_shortwave = values(1,:) + wavenumber_high_shortwave = values(2,:) + + ! First and last g-point for each SW band: + band2gpt_sw = kdist_sw%gas_props%get_band_lims_gpoint() + + ! Indices into specific bands + call get_band_index_by_value('sw', 500.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 1000.0_kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_nir_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 400._kind_phys, 'nm', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_uv_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('sw', 0.67_kind_phys, 'micron', nswbands, & + wavenumber_low_shortwave, wavenumber_high_shortwave, idx_sw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + deallocate(values) + + ! LW band bounds in cm^-1 + allocate( values(2,nlwbands), stat=istat, errmsg=alloc_errmsg ) + if (istat/=0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating array: values(2,nlwbands); message - ', alloc_errmsg + errflg = 1 + return + end if + values = kdist_lw%gas_props%get_band_lims_wavenumber() + wavenumber_low_longwave = values(1,:) + wavenumber_high_longwave = values(2,:) + + ! Indices into specific bands + call get_band_index_by_value('lw', 1000.0_kind_phys, 'cm^-1', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_diag, errmsg, errflg) + if (errflg /= 0) then + return + end if + call get_band_index_by_value('lw', 10.5_kind_phys, 'micron', nlwbands, & + wavenumber_low_longwave, wavenumber_high_longwave, idx_lw_cloudsim, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine set_wavenumber_bands + +!========================================================================================= + + subroutine get_band_index_by_value(swlw, targetvalue, units, nbnds, wavenumber_low, & + wavenumber_high, ans, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! Find band index for requested wavelength/wavenumber. + + character(len=*), intent(in) :: swlw ! sw or lw bands + real(kind_phys), intent(in) :: targetvalue + character(len=*), intent(in) :: units ! units of targetvalue + integer, intent(in) :: nbnds + real(kind_phys), dimension(:), intent(in) :: wavenumber_low + real(kind_phys), dimension(:), intent(in) :: wavenumber_high + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(out) :: ans + + ! local + real(kind_phys) :: tgt + integer :: idx + + character(len=*), parameter :: sub = 'get_band_index_by_value' + !---------------------------------------------------------------------------- + + ! Initialize error variables + errflg = 0 + errmsg = '' + if (trim(swlw) /= 'sw' .and. trim(swlw) /= 'lw') then + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: type of bands not recognized: ', swlw + errflg = 1 + return + end if + + ! band info is in cm^-1 but target value may be other units, + ! so convert targetvalue to cm^-1 + select case (units) + case ('inv_cm','cm^-1','cm-1') + tgt = targetvalue + case('m','meter','meters') + tgt = 1.0_kind_phys / (targetvalue * 1.e2_kind_phys) + case('nm','nanometer','nanometers') + tgt = 1.0_kind_phys / (targetvalue * 1.e-7_kind_phys) + case('um','micrometer','micrometers','micron','microns') + tgt = 1.0_kind_phys / (targetvalue * 1.e-4_kind_phys) + case('cm','centimeter','centimeters') + tgt = 1._kind_phys/targetvalue + case default + write(errmsg,'(a,a)') 'rrtmgp_inputs: get_band_index_by_value: units not recognized: ', units + errflg = 1 + return + end select + + ! now just loop through the array + ans = 0 + do idx = 1,nbnds + if ((tgt > wavenumber_low(idx)) .and. (tgt <= wavenumber_high(idx))) then + ans = idx + exit + end if + end do + + if (ans == 0) then + write(errmsg,'(f10.3,a,a)') targetvalue, ' ', trim(units) + errflg = 1 + end if + + end subroutine get_band_index_by_value + +end module rrtmgp_inputs diff --git a/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 new file mode 100644 index 00000000..256085d7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,395 @@ +! PEVERWHEE - dependencies = interpolate_data +!> \file rrtmgp_lw_cloud_optics.F90 +!! + +!> This module contains two routines: The first initializes data and functions +!! needed to compute the longwave cloud radiative properties in RRTMGP. The second routine +!! is a ccpp scheme within the "radiation loop", where the shortwave optical properties +!! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL +!! cloud types visible to RRTMGP. +module rrtmgp_lw_cloud_optics + use ccpp_kinds, only: kind_phys + + implicit none + private + public :: rrtmgp_lw_cloud_optics_init + public :: rrtmgp_lw_cloud_optics_run + + real(kind_phys), allocatable :: abs_lw_liq(:,:,:) + real(kind_phys), allocatable :: abs_lw_ice(:,:) + real(kind_phys), allocatable :: g_mu(:) + real(kind_phys), allocatable :: g_d_eff(:) + real(kind_phys), allocatable :: g_lambda(:,:) + real(kind_phys) :: tiny + integer :: nmu + integer :: nlambda + integer :: n_g_d + + +contains + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_init Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_init.html +!! + subroutine rrtmgp_lw_cloud_optics_init(nmu_in, nlambda_in, n_g_d_in, & + abs_lw_liq_in, abs_lw_ice_in, nlwbands, g_mu_in, g_lambda_in, & + g_d_eff_in, tiny_in, errmsg, errflg) + ! Inputs + integer, intent(in) :: nmu_in ! Number of mu samples on grid + integer, intent(in) :: nlambda_in ! Number of lambda scale samples on grid + integer, intent(in) :: n_g_d_in ! Number of radiative effective diameter samples on grid + integer, intent(in) :: nlwbands ! Number of longwave bands + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq_in ! Longwave mass specific absorption for in-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice_in ! Longwave mass specific absorption for in-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: g_lambda_in ! lambda scale samples on grid + real(kind_phys), dimension(:), intent(in) :: g_mu_in ! Mu samples on grid + real(kind_phys), dimension(:), intent(in) :: g_d_eff_in ! Radiative effective diameter samples on grid + real(kind_phys), intent(in) :: tiny_in ! Definition of what "tiny" means + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_init' + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Set module-level variables + nmu = nmu_in + nlambda = nlambda_in + n_g_d = n_g_d_in + tiny = tiny_in + ! Allocate module-level-variables + allocate(abs_lw_liq(nmu,nlambda,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_liq, message: ', alloc_errmsg + return + end if + allocate(abs_lw_ice(n_g_d,nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating abs_lw_ice, message: ', alloc_errmsg + return + end if + allocate(g_mu(nmu), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_mu, message: ', alloc_errmsg + return + end if + allocate(g_lambda(nmu,nlambda), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_lambda, message: ', alloc_errmsg + return + end if + allocate(g_d_eff(n_g_d), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR allocating g_d_eff, message: ', alloc_errmsg + return + end if + + abs_lw_liq = abs_lw_liq_in + abs_lw_ice = abs_lw_ice_in + g_mu = g_mu_in + g_lambda = g_lambda_in + g_d_eff = g_d_eff_in + + end subroutine rrtmgp_lw_cloud_optics_init + + ! ###################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_run() + ! ###################################################################################### +!> \section arg_table_rrtmgp_lw_cloud_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_cloud_optics_run.html +!! + subroutine rrtmgp_lw_cloud_optics_run(dolw, ncol, nlay, nlaycam, cld, cldfsnow, cldfgrau, & + cldfprime, kdist_lw, cloud_lw, lamc, pgam, iclwpth, iciwpth, & + dei, icswpth, des, icgrauwpth, degrau, nlwbands, do_snow, do_graupel, pver, & + ktopcam, tauc, cldf, cld_lw_abs, snow_lw_abs, grau_lw_abs, errmsg, errflg) + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + ! Compute combined cloud optical properties + ! Create MCICA stochastic arrays for cloud LW optical properties + ! Initialize optical properties object (cloud_lw) and load with MCICA columns + + ! Inputs + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers in radiation + integer, intent(in) :: nlaycam ! Number of model layers in radiation + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: pver ! Total number of vertical layers + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + real(kind_phys), dimension(:,:), intent(in) :: cld ! Cloud fraction (liq + ice) + real(kind_phys), dimension(:,:), intent(in) :: cldfsnow ! Cloud fraction of just "snow clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfgrau ! Cloud fraction of just "graupel clouds" + real(kind_phys), dimension(:,:), intent(in) :: cldfprime ! Modified cloud fraction + real(kind_phys), dimension(:,:), intent(in) :: lamc ! Prognosed value of lambda for cloud + real(kind_phys), dimension(:,:), intent(in) :: pgam ! Prognosed value of mu for cloud + real(kind_phys), dimension(:,:), intent(in) :: iclwpth ! In-cloud liquid water path + real(kind_phys), dimension(:,:), intent(in) :: iciwpth ! In-cloud ice water path + real(kind_phys), dimension(:,:), intent(in) :: icswpth ! In-cloud snow water path + real(kind_phys), dimension(:,:), intent(in) :: icgrauwpth ! In-cloud graupel water path + real(kind_phys), dimension(:,:), intent(in) :: dei ! Mean effective radius for ice cloud + real(kind_phys), dimension(:,:), intent(in) :: des ! Mean effective radius for snow + real(kind_phys), dimension(:,:), intent(in) :: degrau ! Mean effective radius for graupel + logical, intent(in) :: do_snow ! Flag for whether cldfsnow is present + logical, intent(in) :: do_graupel ! Flag for whether cldfgrau is present + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist_lw ! Longwave gas optics object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(out) :: cloud_lw ! Longwave cloud optics object + real(kind_phys), dimension(:,:), intent(out) :: cldf ! Subset cloud fraction + real(kind_phys), dimension(:,:,:), intent(out) :: cld_lw_abs ! Cloud absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: snow_lw_abs ! Snow absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: grau_lw_abs ! Graupel absorption optics depth (LW) + real(kind_phys), dimension(:,:,:), intent(out) :: tauc ! Cloud optical depth + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx, kdx + + ! cloud radiative parameters are "in cloud" not "in cell" + real(kind_phys) :: liq_lw_abs(nlwbands, ncol, pver) ! liquid absorption optics depth (LW) + real(kind_phys) :: ice_lw_abs(nlwbands, ncol, pver) ! ice absorption optics depth (LW) + real(kind_phys) :: c_cld_lw_abs(nlwbands, ncol, pver) ! combined cloud absorption optics depth (LW) + + character(len=*), parameter :: sub = 'rrtmgp_lw_cloud_optics_run' + !-------------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + ! If not doing longwave, no need to proceed + if (.not. dolw) then + return + end if + + cldf = 0._kind_phys + tauc = 0._kind_phys + + ! Combine the cloud optical properties. + + ! gammadist liquid optics + call liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, g_mu, g_lambda, iclwpth, & + abs_lw_liq, liq_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + ! Mitchell ice optics + call interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, ice_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + + cld_lw_abs(:,:,:) = liq_lw_abs(:,:,:) + ice_lw_abs(:,:,:) + + ! add in snow + if (do_snow) then + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icswpth, des, & + n_g_d, g_d_eff, abs_lw_ice, snow_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfsnow(idx,kdx)*snow_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + else + c_cld_lw_abs(:,:,:) = cld_lw_abs(:,:,:) + end if + + ! add in graupel + if (do_graupel) then + call interpolate_ice_optics_lw(ncol, pver, nlwbands, icgrauwpth, degrau, n_g_d, & + g_d_eff, abs_lw_ice, grau_lw_abs, errmsg, errflg) + if (errflg /= 0) then + return + end if + do idx = 1, ncol + do kdx = 1, pver + if (cldfprime(idx,kdx) > 0._kind_phys) then + c_cld_lw_abs(:,idx,kdx) = ( cldfgrau(idx,kdx)*grau_lw_abs(:,idx,kdx) & + + cld(idx,kdx)*c_cld_lw_abs(:,idx,kdx) )/cldfprime(idx,kdx) + else + c_cld_lw_abs(:,idx,kdx) = 0._kind_phys + end if + end do + end do + end if + + ! Extract just the layers of CAM where RRTMGP does calculations + + ! Subset "chunk" data so just the number of CAM layers in the + ! radiation calculation are used by MCICA to produce subcolumns + cldf = cldfprime(:, ktopcam:) + tauc = c_cld_lw_abs(:, :, ktopcam:) + + ! Enforce tauc >= 0. + tauc = merge(tauc, 0.0_kind_phys, tauc > 0.0_kind_phys) + + errmsg =cloud_lw%optical_props%alloc_1scl(ncol, nlay, kdist_lw%gas_props) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end subroutine rrtmgp_lw_cloud_optics_run + +!============================================================================== + + subroutine liquid_cloud_get_rad_props_lw(ncol, pver, nmu, nlambda, nlwbands, lamc, pgam, & + g_mu, g_lambda, iclwpth, abs_lw_liq, abs_od, errmsg, errflg) + ! Inputs + integer, intent(in) :: ncol + integer, intent(in) :: pver + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:,:), intent(in) :: lamc + real(kind_phys), dimension(:,:), intent(in) :: pgam + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:), intent(in) :: g_lambda + real(kind_phys), dimension(:,:), intent(in) :: iclwpth + ! Outputs + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer lwband, idx, kdx + + ! Set error variables + errflg = 0 + errmsg = '' + + abs_od = 0._kind_phys + + do kdx = 1,pver + do idx = 1,ncol + if(lamc(idx,kdx) > 0._kind_phys) then ! This seems to be the clue for no cloud from microphysics formulation + call gam_liquid_lw(nlwbands, nmu, nlambda, iclwpth(idx,kdx), lamc(idx,kdx), pgam(idx,kdx), abs_lw_liq, & + g_mu, g_lambda, abs_od(1:nlwbands,idx,kdx), errmsg, errflg) + else + abs_od(1:nlwbands,idx,kdx) = 0._kind_phys + endif + enddo + enddo + + end subroutine liquid_cloud_get_rad_props_lw + +!============================================================================== + + subroutine gam_liquid_lw(nlwbands, nmu, nlambda, clwptn, lamc, pgam, abs_lw_liq, g_mu, g_lambda, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_finish + use radiation_utils, only: get_mu_lambda_weights_ccpp + ! Inputs + integer, intent(in) :: nlwbands + integer, intent(in) :: nmu + integer, intent(in) :: nlambda + real(kind_phys), intent(in) :: clwptn ! cloud water liquid path new (in cloud) (in g/m^2)? + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + real(kind_phys), dimension(:,:,:), intent(in) :: abs_lw_liq + real(kind_phys), dimension(:), intent(in) :: g_mu + real(kind_phys), dimension(:,:) , intent(in) :: g_lambda + ! Outputs + real(kind_phys), dimension(:), intent(out) :: abs_od + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + integer :: lwband ! sw band index + + type(interp_type) :: mu_wgts + type(interp_type) :: lambda_wgts + + if (clwptn < tiny) then + abs_od = 0._kind_phys + return + endif + + call get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, mu_wgts, lambda_wgts, errmsg, errflg) + if (errflg /= 0) then + return + end if + + do lwband = 1, nlwbands + call lininterp(abs_lw_liq(:,:,lwband), nmu, nlambda, & + abs_od(lwband:lwband), 1, mu_wgts, lambda_wgts) + enddo + + abs_od = clwptn * abs_od + + call lininterp_finish(mu_wgts) + call lininterp_finish(lambda_wgts) + + end subroutine gam_liquid_lw + +!============================================================================== + + subroutine interpolate_ice_optics_lw(ncol, pver, nlwbands, iciwpth, dei, & + n_g_d, g_d_eff, abs_lw_ice, abs_od, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp, lininterp_init, & + lininterp_finish, extrap_method_bndry + + integer, intent(in) :: ncol + integer, intent(in) :: n_g_d + integer, intent(in) :: pver + integer, intent(in) :: nlwbands + real(kind_phys), dimension(:), intent(in) :: g_d_eff + real(kind_phys), dimension(:,:), intent(in) :: iciwpth + real(kind_phys), dimension(:,:), intent(in) :: dei + real(kind_phys), dimension(:,:), intent(in) :: abs_lw_ice + real(kind_phys), dimension(:,:,:), intent(out) :: abs_od + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + type(interp_type) :: dei_wgts + + integer :: idx, kdx, lwband + real(kind_phys) :: absor(nlwbands) + + ! Set error variables + errflg = 0 + errmsg = '' + + do kdx = 1,pver + do idx = 1,ncol + ! if ice water path is too small, OD := 0 + if( iciwpth(idx,kdx) < tiny .or. dei(idx,kdx) == 0._kind_phys) then + abs_od (:,idx,kdx) = 0._kind_phys + else + ! for each cell interpolate to find weights in g_d_eff grid. + call lininterp_init(g_d_eff, n_g_d, dei(idx:idx,kdx), 1, & + extrap_method_bndry, dei_wgts) + ! interpolate into grid and extract radiative properties + do lwband = 1, nlwbands + call lininterp(abs_lw_ice(:,lwband), n_g_d, & + absor(lwband:lwband), 1, dei_wgts) + enddo + abs_od(:,idx,kdx) = iciwpth(idx,kdx) * absor + where(abs_od(:,idx,kdx) > 50.0_kind_phys) abs_od(:,idx,kdx) = 50.0_kind_phys + call lininterp_finish(dei_wgts) + endif + enddo + enddo + + end subroutine interpolate_ice_optics_lw + +!============================================================================== + +end module rrtmgp_lw_cloud_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 new file mode 100644 index 00000000..6812b895 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,91 @@ +!> \file rrtmgp_lw_gas_optics.F90 +!! + +!> This module contains a run routine to compute gas optics during the radiation subcycle +module rrtmgp_lw_gas_optics + + implicit none + private + + public :: rrtmgp_lw_gas_optics_run + +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_run.html +!! + subroutine rrtmgp_lw_gas_optics_run(dolw, iter_num, ncol, rrtmgp_phys_blksz, p_lay, p_lev, t_lay, tsfg, & + gas_concs, lw_optical_props_clrsky, sources, t_lev, include_interface_temp, lw_gas_props, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + ! Inputs + logical, intent(in) :: dolw !< Flag for whether to perform longwave calculation + logical, intent(in) :: include_interface_temp !< Flag for whether to include interface temperature in calculation + integer, intent(in) :: iter_num !< Subcycle iteration number + integer, intent(in) :: ncol !< Total number of columns + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + real(kind_phys), dimension(:,:), intent(in) :: p_lay !< Air pressure at midpoints [Pa] + real(kind_phys), dimension(:,:), intent(in) :: p_lev !< Air pressure at interfaces [Pa] + real(kind_phys), dimension(:,:), intent(in) :: t_lay !< Air temperature at midpoints [K] + real(kind_phys), dimension(:), intent(in) :: tsfg !< Surface skin temperature [K] + real(kind_phys), dimension(:,:), intent(in) :: t_lev !< Air temperature at interfaces [K] + type(ty_gas_concs_ccpp), intent(in) :: gas_concs !< RRTMGP gas concentrations object + + ! Outputs + type(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clearsky optical properties + type(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< RRTMGP gas optics object + type(ty_source_func_lw_ccpp), intent(inout) :: sources !< Longwave sources object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: iCol, iCol2 + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2= min(iCol + rrtmgp_phys_blksz - 1, ncol) + + if (include_interface_temp) then + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volume mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev(iCol:iCol2,:)) ! IN - Temperature @ layer-interfaces (K) (optional) + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + else + errmsg = lw_gas_props%gas_props%gas_optics(& + p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) + tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + gas_concs%gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky%optical_props, & ! OUT - RRTMGP DDT: longwave optical properties + sources%sources) ! OUT - RRTMGP DDT: source functions + call check_error_msg('rrtmgp_lw_main_gas_optics', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + end if + + end subroutine rrtmgp_lw_gas_optics_run + +end module rrtmgp_lw_gas_optics diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 new file mode 100644 index 00000000..46097c67 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_data.F90 @@ -0,0 +1,102 @@ +!> \file rrtmgp_lw_gas_optics_data.F90 +!! + +!> This module contains an init routine to initialize the gas optics object +!> with data read in from file on the host side +module rrtmgp_lw_gas_optics_data + + implicit none + private + public :: rrtmgp_lw_gas_optics_data_init + + +contains +!> \section arg_table_rrtmgp_lw_gas_optics_data_init Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_data_init.html +!! + subroutine rrtmgp_lw_gas_optics_data_init(kdist, available_gases, gas_names, & + key_species, band2gpt, band_lims_wavenum, press_ref, press_ref_trop, & + temp_ref, temp_ref_p, temp_ref_t, vmr_ref, kmajor, kminor_lower, & + kminor_upper, gas_minor, identifier_minor, minor_gases_lower, & + minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, scale_by_complement_lower, & + scale_by_complement_upper, kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, optimal_angle_fit, & + errmsg, errflg) + use machine, only: kind_phys + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use radiation_tools, only: check_error_msg + use mo_rte_kind, only: wl + + ! Inputs + class(ty_gas_concs_ccpp), intent(in) :: available_gases ! Gas concentrations object + character(len=*), dimension(:), intent(in) :: gas_names ! Names of absorbing gases + character(len=*), dimension(:), intent(in) :: gas_minor ! Name of absorbing minor gas + character(len=*), dimension(:), intent(in) :: identifier_minor ! Unique string identifying minor gas + character(len=*), dimension(:), intent(in) :: minor_gases_lower ! Names of minor absorbing gases in lower atmosphere + character(len=*), dimension(:), intent(in) :: minor_gases_upper ! Names of minor absorbing gases in upper atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_lower ! Absorption also depends on the concentration of this gas in the lower atmosphere + character(len=*), dimension(:), intent(in) :: scaling_gas_upper ! Absorption also depends on the concentration of this gas in the upper atmosphere + integer, dimension(:,:,:), intent(in) :: key_species ! Key species pair for each band + integer, dimension(:,:), intent(in) :: band2gpt ! Array for converting shortwave band limits to g-points + integer, dimension(:,:), intent(in) :: minor_limits_gpt_lower ! Beginning and ending gpoint for each minor interval in lower atmosphere + integer, dimension(:,:), intent(in) :: minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:), intent(in) :: kminor_start_lower ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_lower" + integer, dimension(:), intent(in) :: kminor_start_upper ! Starting index in the [1,nContributors] vector for a contributor given by "minor_gases_upper" + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_lower ! Density scaling is applied to minor absorption coefficients in the lower atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_lower ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the lower atmosphere + logical(wl), dimension(:), intent(in) :: minor_scales_with_density_upper ! Density scaling is applied to minor absorption coefficients in the upper atmosphere + logical(wl), dimension(:), intent(in) :: scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) in the upper atmosphere + real(kind_phys), dimension(:,:,:,:), intent(in) :: kmajor ! Stored absorption coefficients due to major absorbing gases + real(kind_phys), dimension(:,:,:,:), intent(in) :: planck_frac ! Fraction of band-integrated Planck energy associated with each g-point + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_lower ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: kminor_upper ! Transformed from [nTemp x nEta x nGpt x nAbsorbers] array to [nTemp x nEta x nContributors] array + real(kind_phys), dimension(:,:,:), intent(in) :: vmr_ref ! Volume mixing ratios for reference atmosphere + real(kind_phys), dimension(:,:), intent(in) :: band_lims_wavenum ! Beginning and ending wavenumber for each band [cm-1] + real(kind_phys), dimension(:,:), intent(in) :: totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:), intent(in) :: optimal_angle_fit ! Coefficients for linear fit used in longwave optimal angle RT calculation + real(kind_phys), dimension(:), intent(in) :: press_ref ! Pressures for reference atmosphere [Pa] + real(kind_phys), dimension(:), intent(in) :: temp_ref ! Temperatures for reference atmosphere [K] + real(kind_phys), intent(in) :: press_ref_trop ! Reference pressure separating the lower and upper atmosphere [Pa] + real(kind_phys), intent(in) :: temp_ref_p ! Standard spectroscopic reference pressure [Pa] + real(kind_phys), intent(in) :: temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_lower ! Stored coefficients due to rayleigh scattering contribution in lower part of atmosphere + real(kind_phys), dimension(:,:,:), allocatable, intent(in) :: rayl_upper ! Stored coefficients due to rayleigh scattering contribution in upper part of atmosphere + + ! Outputs + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: kdist ! RRTMGP gas optics object + character(len=*), intent(out) :: errmsg ! CCPP error message + integer, intent(out) :: errflg ! CCPP error code + + ! Initialize error variables + errmsg = '' + errflg = 0 + + ! Initialize the gas optics object with data. + errmsg = kdist%gas_props%load( & + available_gases%gas_concs, gas_names, key_species, & + band2gpt, band_lims_wavenum, & + press_ref, press_ref_trop, temp_ref, & + temp_ref_p, temp_ref_t, vmr_ref, & + kmajor, kminor_lower, kminor_upper, & + gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, & + totplnk, planck_frac, rayl_lower, rayl_upper, & + optimal_angle_fit) + + if (len_trim(errmsg) > 0) then + errflg = 1 + end if + call check_error_msg('rrtmgp_lw_gas_optics_init_load', errmsg) + + end subroutine rrtmgp_lw_gas_optics_data_init + +end module rrtmgp_lw_gas_optics_data diff --git a/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 new file mode 100644 index 00000000..c9796cda --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_gas_optics_pre.F90 @@ -0,0 +1,182 @@ +module rrtmgp_lw_gas_optics_pre + + implicit none + private + + public :: rrtmgp_lw_gas_optics_pre_run + +contains + +!> \section arg_table_rrtmgp_lw_gas_optics_pre_run Argument Table +!! \htmlinclude rrtmgp_lw_gas_optics_pre_run.html +!! + subroutine rrtmgp_lw_gas_optics_pre_run(rad_const_array, pmid, pint, nlay, ncol, gaslist, idxday, & + pverp, ktoprad, ktopcam, dolw, nradgas, gas_concs, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + + ! Set gas vmr for the gases in the radconstants module's gaslist. + + character(len=*), intent(in) :: gaslist(:) ! Radiatively active gases + integer, intent(in) :: nlay ! Number of layers in radiation calculation + integer, intent(in) :: ncol ! Total number of columns + integer, intent(in) :: pverp ! Total number of layer interfaces + integer, intent(in) :: idxday(:) ! Indices of daylight columns + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: ktopcam ! Index in CAM arrays of top level (layer or interface) at which RRTMGP is active + integer, intent(in) :: nradgas ! Number of radiatively active gases + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculaion + real(kind_phys), intent(in) :: pmid(:,:) ! Air pressure at midpoints [Pa] + real(kind_phys), intent(in) :: pint(:,:) ! Air pressure at interfaces [Pa] + real(kind_phys), intent(in) :: rad_const_array(:,:,:) ! array of radiatively-active constituent vmrs + ! last index corresponds to index in gaslist + + type(ty_gas_concs_ccpp), intent(inout) :: gas_concs ! the result is VMR inside gas_concs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, gas_idx, idx(ncol) + integer :: istat + real(kind_phys) :: gas_mmr(ncol, pverp-1) + real(kind_phys) :: gas_vmr(ncol, nlay) + real(kind_phys) :: mmr(ncol, nlay) + real(kind_phys) :: massratio + character(len=256) :: alloc_errmsg + + ! For ozone profile above model + real(kind_phys) :: P_top, P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff + + character(len=*), parameter :: sub = 'rrtmgp_lw_gas_optics_pre_run' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. dolw) then + return + end if + + ! set the column indices; just count for longwave + do i = 1, ncol + idx(i) = i + end do + + do gas_idx = 1, nradgas + + ! grab mass mixing ratio of gas + gas_mmr = rad_const_array(:,:,gas_idx) + + do i = 1, ncol + mmr(i,ktoprad:) = gas_mmr(idx(i),ktopcam:) + end do + + ! If an extra layer is being used, copy mmr from the top layer of CAM to the extra layer. + if (nlay == pverp) then + mmr(:,1) = mmr(:,2) + end if + + ! special case: H2O is specific humidity, not mixing ratio. Use r = q/(1-q): + if (gaslist(gas_idx) == 'H2O') then + mmr = mmr / (1._kind_phys - mmr) + end if + + ! convert MMR to VMR, multipy by ratio of dry air molar mas to gas molar mass. + call get_molar_mass_ratio(gaslist(gas_idx), massratio, errmsg, errflg) + if (errflg /= 0) then + return + end if + gas_vmr = mmr * massratio + + ! special case: Setting O3 in the extra layer: + ! + ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone + ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at + ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning + ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels. + + if ((gaslist(gas_idx) == 'O3') .and. (nlay == pverp)) then + P_top = 50.0_kind_phys + do i = 1, ncol + P_int = pint(idx(i),1) ! pressure (Pa) at upper interface of CAM + P_mid = pmid(idx(i),1) ! pressure (Pa) at midpoint of top layer of CAM + alpha = log(P_int/P_top) + beta = log(P_mid/P_int)/log(P_mid/P_top) + + a = ( (1._kind_phys + alpha) * exp(-alpha) - 1._kind_phys ) / alpha + b = 1._kind_phys - exp(-alpha) + + if (alpha .gt. 0) then ! only apply where top level is below 80 km + chi_mid = gas_vmr(i,1) ! molar mixing ratio of O3 at midpoint of top layer + chi_0 = chi_mid / (1._kind_phys + beta) + chi_eff = chi_0 * (a + b) + gas_vmr(i,1) = chi_eff + end if + end do + end if + + errmsg = gas_concs%gas_concs%set_vmr(gaslist(gas_idx), gas_vmr) + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + + end do + + end subroutine rrtmgp_lw_gas_optics_pre_run + +!========================================================================================= + + subroutine get_molar_mass_ratio(gas_name, massratio, errmsg, errflg) + use ccpp_kinds, only: kind_phys + + ! return the molar mass ratio of dry air to gas based on gas_name + + character(len=*), intent(in) :: gas_name + real(kind_phys), intent(out) :: massratio + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: amdw = 1.607793_kind_phys ! Molecular weight of dry air / water vapor + real(kind_phys), parameter :: amdc = 0.658114_kind_phys ! Molecular weight of dry air / carbon dioxide + real(kind_phys), parameter :: amdo = 0.603428_kind_phys ! Molecular weight of dry air / ozone + real(kind_phys), parameter :: amdm = 1.805423_kind_phys ! Molecular weight of dry air / methane + real(kind_phys), parameter :: amdn = 0.658090_kind_phys ! Molecular weight of dry air / nitrous oxide + real(kind_phys), parameter :: amdo2 = 0.905140_kind_phys ! Molecular weight of dry air / oxygen + real(kind_phys), parameter :: amdc1 = 0.210852_kind_phys ! Molecular weight of dry air / CFC11 + real(kind_phys), parameter :: amdc2 = 0.239546_kind_phys ! Molecular weight of dry air / CFC12 + + character(len=*), parameter :: sub='get_molar_mass_ratio' + !---------------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + select case (trim(gas_name)) + case ('H2O') + massratio = amdw + case ('CO2') + massratio = amdc + case ('O3') + massratio = amdo + case ('CH4') + massratio = amdm + case ('N2O') + massratio = amdn + case ('O2') + massratio = amdo2 + case ('CFC11') + massratio = amdc1 + case ('CFC12') + massratio = amdc2 + case default + write(errmsg, '(a,a,a)') sub, ': Invalid gas: ', trim(gas_name) + errflg = 1 + end select + +end subroutine get_molar_mass_ratio + + +end module rrtmgp_lw_gas_optics_pre diff --git a/schemes/rrtmgp/rrtmgp_lw_main.F90 b/schemes/rrtmgp/rrtmgp_lw_main.F90 new file mode 100644 index 00000000..cadbc7f7 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_main.F90 @@ -0,0 +1,251 @@ +!> \file rrtmgp_lw_main.F90 +!! + +!> This module contains the call to the RRTMGP-LW radiation routine +module rrtmgp_lw_main + implicit none + private + + public rrtmgp_lw_main_run +contains + +!> \section arg_table_rrtmgp_lw_main_run Argument Table +!! \htmlinclude rrtmgp_lw_main_run.html +!! + subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, doGP_lwscat, use_LW_jacobian, use_LW_optimal_angles, & + nGauss_angles, nCol, iter_num, rrtmgp_phys_blksz, lw_optical_props_clrsky, & + lw_optical_props_clouds, top_at_1, sources, sfc_emiss_byband, lw_gas_props, & + aerlw, fluxlwUP_jac, lw_Ds, flux_clrsky, flux_allsky, errmsg, errflg) + use machine, only: kind_phys + use mo_rte_lw, only: rte_lw + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use radiation_tools, only: check_error_msg + + ! Inputs + logical, intent(in) :: doLWrad !< Flag to perform longwave calculation + logical, intent(in) :: doLWclrsky !< Flag to compute clear-sky fluxes + logical, intent(in) :: doGP_lwscat !< Flag to include scattering in clouds + logical, intent(in) :: use_LW_jacobian !< Flag to compute Jacobian + logical, intent(in) :: use_LW_optimal_angles !< Flag to compute and use optimal angles + logical, intent(in) :: top_at_1 !< Flag for vertical ordering convention + + integer, target, intent(in) :: nGauss_angles !< Number of gaussian quadrature angles used + integer, intent(in) :: nCol !< Number of horizontal points + integer, intent(in) :: iter_num !< Radiation subcycle iteration number + integer, intent(in) :: rrtmgp_phys_blksz !< Number of horizontal points to process at once + + real(kind_phys), dimension(:,:), intent(in) :: sfc_emiss_byband !< Surface emissivity by band + class(ty_source_func_lw_ccpp), intent(in) :: sources !< Longwave sources object + + ! Outputs + real(kind_phys), dimension(:,:), target, intent(inout) :: fluxlwUP_jac !< Surface temperature flux Jacobian [W m-2 K-1] + class(ty_fluxes_byband_ccpp), intent(inout) :: flux_allsky !< All-sky flux [W m-2] + class(ty_fluxes_broadband_ccpp), intent(inout) :: flux_clrsky !< Clear-sky flux [W m-2] + class(ty_optical_props_1scl_ccpp), intent(inout) :: aerlw !< Aerosol optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clrsky !< Clear-sky optical properties object + class(ty_optical_props_1scl_ccpp), intent(inout) :: lw_optical_props_clouds !< Cloud optical properties object + + class(ty_gas_optics_rrtmgp_ccpp), intent(inout) :: lw_gas_props !< Gas optical properties object + + real(kind_phys), dimension(:,:), target, intent(out) :: lw_Ds !< 1/cos of transport angle per column, g-point + character(len=*), intent(out) :: errmsg !< CCPP error message + integer, intent(out) :: errflg !< CCPP error flag + + ! Local variables + integer :: iCol, iCol2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + iCol = ((iter_num - 1) * rrtmgp_phys_blksz) + 1 + iCol2 = min(iCol + rrtmgp_phys_blksz - 1, nCol) + + ! ################################################################################### + ! + ! Compute clear-sky fluxes (gaseous+aerosol) (optional) + ! + ! ################################################################################### + ! Increment + errmsg = aerlw%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_aerosol_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + ! Call RTE solver + if (doLWclrsky) then + if (use_lw_optimal_angles) then + errmsg = lw_gas_props%gas_props%compute_optimal_angles(lw_optical_props_clrsky%optical_props,lw_Ds) + call check_error_msg('rrtmgp_lw_main_opt_angle', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + lw_Ds = lw_Ds) ! IN - 1/cos of transport angle per column and g-point + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky%fluxes) ! OUT - Fluxes + end if + end if + call check_error_msg('rrtmgp_lw_main_lw_rte_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + end if + + ! ################################################################################### + ! + ! All-sky fluxes (clear-sky + clouds + precipitation) + ! *Note* CCPP does not allow for polymorphic types, they are ambiguous to the CCPP + ! framework. rte-rrtmgp uses polymorphic types extensively, for example, querying the + ! type to determine physics configuration/pathway/etc... + ! + ! The logic in the code below is to satisfy the polymorphishm in the rte-rrtmgp code. + ! The rte-rrtmgp "increment" procedures are utilized to provide the correct type to the + ! rte solver (rte_lw). Rte_lw queries the type to determine if scattering is to be + ! included in the calculation. The increment procedures are called so that the correct + ! optical properties are inherited. + ! + ! ################################################################################### + + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Increment + errmsg = lw_optical_props_clrsky%optical_props%increment(lw_optical_props_clouds%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clouds%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + ! No scattering in LW clouds. + else + ! Increment + errmsg = lw_optical_props_clouds%optical_props%increment(lw_optical_props_clrsky%optical_props) + call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + if (use_LW_jacobian) then + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + flux_up_Jac = fluxlwUP_jac) ! OUT - surface temperature flux (upward) Jacobian (W m-2 K-1) + end if + else + if (nGauss_angles > 1) then + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles) ! IN - Number of angles in Gaussian quadrature + else + errmsg = rte_lw( & + lw_optical_props_clrsky%optical_props, & ! IN - optical-properties + top_at_1, & ! IN - vertical ordering flag + sources%sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky%fluxes) ! OUT - Fluxes + end if + end if + end if + call check_error_msg('rrtmgp_lw_main_lw_rte_allsky', errmsg) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_lw_main_run +end module rrtmgp_lw_main diff --git a/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 new file mode 100644 index 00000000..0d39ce1f --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_lw_mcica_subcol_gen.F90 @@ -0,0 +1,194 @@ +module rrtmgp_lw_mcica_subcol_gen +! PEVERWHEE - dependencies = shr_RandNum_mod + +!---------------------------------------------------------------------------------------- +! +! Purpose: Create McICA stochastic arrays for lw cloud optical properties. +! Input cloud optical properties directly: cloud optical depth, single +! scattering albedo and asymmetry parameter. Output will be stochastic +! arrays of these variables. (longwave scattering is not yet available) +! +! Original code: From RRTMG, with the following copyright notice, +! based on Raisanen et al., QJRMS, 2004: +! -------------------------------------------------------------------------- +! | | +! | Copyright 2006-2007, Atmospheric & Environmental Research, Inc. (AER). | +! | This software may be used, copied, or redistributed as long as it is | +! | not sold and this copyright notice is reproduced on each copy made. | +! | This model is provided as is without any express or implied warranties. | +! | (http://www.rtweb.aer.com/) | +! | | +! -------------------------------------------------------------------------- +! This code is a refactored version of code originally in the files +! rrtmgp_lw_mcica_subcol_gen.F90 and mcica_subcol_gen_sw.F90 +! +! Uses the KISS random number generator. +! +! Overlap assumption: maximum-random. +! +!---------------------------------------------------------------------------------------- + +implicit none +private +save + +public :: rrtmgp_lw_mcica_subcol_gen_run + +!======================================================================================== +contains +!======================================================================================== + +!> +!> \section arg_table_rrtmgp_lw_mcica_subcol_gen_run Argument Table +!! \htmlinclude rrtmgp_lw_mcica_subcol_gen_run.html +subroutine rrtmgp_lw_mcica_subcol_gen_run( & + dolw, ktoprad, kdist, nbnd, ngpt, ncol, pver, nver, & + changeseed, pmid, cldfrac, tauc, cloud_lw, & + errmsg, errflg ) + use ccpp_kinds, only: kind_phys + use shr_RandNum_mod, only: ShrKissRandGen + use ccpp_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_ccpp + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + + ! Arrays use CAM vertical index convention: index increases from top to bottom. + ! This index ordering is assumed in the maximum-random overlap algorithm which starts + ! at the top of a column and marches down, with each layer depending on the state + ! of the layer above it. + ! + ! For GCM mode, changeseed must be offset between LW and SW by at least the + ! number of subcolumns + + ! arguments + class(ty_gas_optics_rrtmgp_ccpp), intent(in) :: kdist ! Gas optics object + logical, intent(in) :: dolw ! Flag for whether to perform longwave calculation + integer, intent(in) :: ktoprad ! Index in RRTMGP array corresponding to top layer or interface of CAM arrays + integer, intent(in) :: nbnd ! Number of spectral bands + integer, intent(in) :: ngpt ! Number of subcolumns (g-point intervals) + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: pver ! Number of model layers + integer, intent(in) :: nver ! Number of layers in radiation calculation + integer, intent(in) :: changeseed ! If the subcolumn generator is called multiple times, + ! permute the seed between each call. + real(kind_phys), dimension(:,:), intent(in) :: pmid ! Layer pressures at midpoints (Pa) + real(kind_phys), dimension(:,:), intent(in) :: cldfrac ! Layer cloud fraction + real(kind_phys), dimension(:,:,:), intent(in) :: tauc ! Cloud optical depth + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optics object + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + integer :: idx, isubcol, kdx, ndx + + real(kind_phys), parameter :: cldmin = 1.0e-80_kind_phys ! min cloud fraction + real(kind_phys) :: cldf(ncol,nver) ! cloud fraction clipped to cldmin + + type(ShrKissRandGen) :: kiss_gen ! KISS RNG object + integer :: kiss_seed(ncol,4) + real(kind_phys) :: rand_num_1d(ncol,1) ! random number (kissvec) + real(kind_phys) :: rand_num(ncol,nver) ! random number (kissvec) + + real(kind_phys) :: cdf(ngpt,ncol,nver) ! random numbers + logical :: iscloudy(ngpt,ncol,nver) ! flag that says whether a gridbox is cloudy + real(kind_phys) :: taucmcl(ngpt,ncol,nver) + !------------------------------------------------------------------------------------------ + + ! Set error variables + errflg = 0 + errmsg = '' + + ! If we're not doing longwave this timestep, no need to proceed + if (.not. dolw) then + return + end if + + ! clip cloud fraction + cldf(:,:) = cldfrac(:,:) + where (cldf(:,:) < cldmin) + cldf(:,:) = 0._kind_phys + end where + + ! Create a seed that depends on the state of the columns. + ! Use pmid from bottom four layers. + do idx = 1, ncol + kiss_seed(idx,1) = (pmid(idx,pver) - int(pmid(idx,pver))) * 1000000000 + kiss_seed(idx,2) = (pmid(idx,pver-1) - int(pmid(idx,pver-1))) * 1000000000 + kiss_seed(idx,3) = (pmid(idx,pver-2) - int(pmid(idx,pver-2))) * 1000000000 + kiss_seed(idx,4) = (pmid(idx,pver-3) - int(pmid(idx,pver-3))) * 1000000000 + end do + + ! create the RNG object + kiss_gen = ShrKissRandGen(kiss_seed) + + ! Advance randum number generator by changeseed values + do idx = 1, changeSeed + call kiss_gen%random(rand_num_1d) + end do + + ! Generate random numbers in each subcolumn at every level + do isubcol = 1,ngpt + call kiss_gen%random(rand_num) + cdf(isubcol,:,:) = rand_num(:,:) + enddo + + ! Maximum-Random overlap + ! i) pick a random number for top layer. + ! ii) walk down the column: + ! - if the layer above is cloudy, use the same random number as in the layer above + ! - if the layer above is clear, use a new random number + + do kdx = 2, nver + do idx = 1, ncol + do isubcol = 1, ngpt + if (cdf(isubcol,idx,kdx-1) > 1._kind_phys - cldf(idx,kdx-1) ) then + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx-1) + else + cdf(isubcol,idx,kdx) = cdf(isubcol,idx,kdx) * (1._kind_phys - cldf(idx,kdx-1)) + end if + end do + end do + end do + + do kdx = 1, nver + iscloudy(:,:,kdx) = (cdf(:,:,kdx) >= 1._kind_phys - spread(cldf(:,kdx), dim=1, nCopies=ngpt) ) + end do + + ! -- generate subcolumns for homogeneous clouds ----- + ! where there is a cloud, set the subcolumn cloud properties; + ! incoming tauc should be in-cloud quantites and not grid-averaged quantities + do kdx = 1,nver + do idx = 1,ncol + do isubcol = 1,ngpt + if (iscloudy(isubcol,idx,kdx) .and. (cldf(idx,kdx) > 0._kind_phys) ) then + ndx = kdist%gas_props%convert_gpt2band(isubcol) + taucmcl(isubcol,idx,kdx) = tauc(ndx,idx,kdx) + else + taucmcl(isubcol,idx,kdx) = 0._kind_phys + end if + end do + end do + end do + + call kiss_gen%finalize() + + ! If there is an extra layer in the radiation then this initialization + ! will provide zero optical depths there + cloud_lw%optical_props%tau = 0.0_kind_phys + + ! Set the properties on g-points + do idx = 1, ngpt + cloud_lw%optical_props%tau(:,ktoprad:,idx) = taucmcl(idx,:,:) + end do + + ! validate checks that: tau > 0 + errmsg = cloud_lw%optical_props%validate() + if (len_trim(errmsg) > 0) then + errflg = 1 + return + end if + +end subroutine rrtmgp_lw_mcica_subcol_gen_run + + +end module rrtmgp_lw_mcica_subcol_gen + diff --git a/schemes/rrtmgp/rrtmgp_post.F90 b/schemes/rrtmgp/rrtmgp_post.F90 new file mode 100644 index 00000000..f7794296 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_post.F90 @@ -0,0 +1,153 @@ +module rrtmgp_post + + implicit none + private + + public :: rrtmgp_post_run + +contains +!> \section arg_table_rrtmgp_post_run Argument Table +!! \htmlinclude rrtmgp_post_run.html +!! +subroutine rrtmgp_post_run(qrs_prime, qrl_prime, fsns, pdel, atm_optics_sw, cloud_sw, aer_sw, & + fsw, fswc, sources_lw, cloud_lw, aer_lw, flw, flwc, qrs, qrl, netsw, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp, ty_optical_props_2str_ccpp + use ccpp_source_functions, only: ty_source_func_lw_ccpp + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness [Pa] + real(kind_phys), dimension(:), intent(in) :: fsns ! Surface net shortwave flux [W m-2] + real(kind_phys), dimension(:,:), intent(in) :: qrs_prime ! Shortwave heating rate [J kg-1 s-1] + real(kind_phys), dimension(:,:), intent(in) :: qrl_prime ! Longwave heating rate [J kg-1 s-1] + type(ty_optical_props_2str_ccpp), intent(inout) :: atm_optics_sw ! Atmosphere optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: aer_lw ! Aerosol optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: aer_sw ! Aerosol optical properties object (shortwave) + type(ty_optical_props_1scl_ccpp), intent(inout) :: cloud_lw ! Cloud optical properties object (longwave) + type(ty_optical_props_2str_ccpp), intent(inout) :: cloud_sw ! Cloud optical properties object (shortwave) + type(ty_fluxes_broadband_ccpp), intent(inout) :: fswc ! Shortwave clear-sky flux object + type(ty_fluxes_broadband_ccpp), intent(inout) :: flwc ! Longwave clear-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: fsw ! Shortwave all-sky flux object + type(ty_fluxes_byband_ccpp), intent(inout) :: flw ! Longwave all-sky flux object + type(ty_source_func_lw_ccpp), intent(inout) :: sources_lw ! Longwave sources object + real(kind_phys), dimension(:,:), intent(out) :: qrs ! Shortwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] + real(kind_phys), dimension(:,:), intent(out) :: qrl ! Longwave heating rate adjusted by air pressure thickness [J Pa kg-1 s-1] + real(kind_phys), dimension(:), intent(out) :: netsw ! Net shortwave flux to be sent to coupler [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Set error varaibles + errflg = 0 + errmsg = '' + ! The radiative heating rates are maintained across multiple physics timesteps + ! as Q*dp (for energy conservation). + qrs(:,:) = qrs_prime(:,:) * pdel(:,:) + qrl(:,:) = qrl_prime(:,:) * pdel(:,:) + + ! Set the netsw to be sent to the coupler + netsw(:) = fsns(:) + + call free_optics_sw(atm_optics_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(cloud_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_sw(aer_sw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_fluxes_byband(fsw) + call free_fluxes_broadband(fswc) + + call sources_lw%sources%finalize() + call free_optics_lw(cloud_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_optics_lw(aer_lw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call free_fluxes_byband(flw) + call free_fluxes_broadband(flwc) + +end subroutine rrtmgp_post_run + + !========================================================================================= + +subroutine free_optics_sw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_2str_ccpp + + type(ty_optical_props_2str_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + errmsg = optics%optical_props%finalize_2str() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + call optics%optical_props%finalize() + +end subroutine free_optics_sw + +!========================================================================================= + +subroutine free_optics_lw(optics, errmsg, errflg) + use ccpp_optical_props, only: ty_optical_props_1scl_ccpp + + type(ty_optical_props_1scl_ccpp), intent(inout) :: optics + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = optics%optical_props%finalize_1scl() + if (len_trim(errmsg) /= 0) then + errflg = 1 + return + end if + + call optics%optical_props%finalize() + +end subroutine free_optics_lw + +!========================================================================================= + +subroutine free_fluxes_broadband(fluxes) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + +end subroutine free_fluxes_broadband + +!========================================================================================= + +subroutine free_fluxes_byband(fluxes) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + + if (associated(fluxes%fluxes%flux_up)) deallocate(fluxes%fluxes%flux_up) + if (associated(fluxes%fluxes%flux_dn)) deallocate(fluxes%fluxes%flux_dn) + if (associated(fluxes%fluxes%flux_net)) deallocate(fluxes%fluxes%flux_net) + if (associated(fluxes%fluxes%flux_dn_dir)) deallocate(fluxes%fluxes%flux_dn_dir) + + if (associated(fluxes%fluxes%bnd_flux_up)) deallocate(fluxes%fluxes%bnd_flux_up) + if (associated(fluxes%fluxes%bnd_flux_dn)) deallocate(fluxes%fluxes%bnd_flux_dn) + if (associated(fluxes%fluxes%bnd_flux_net)) deallocate(fluxes%fluxes%bnd_flux_net) + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) deallocate(fluxes%fluxes%bnd_flux_dn_dir) + +end subroutine free_fluxes_byband + +end module rrtmgp_post diff --git a/schemes/rrtmgp/rrtmgp_pre.F90 b/schemes/rrtmgp/rrtmgp_pre.F90 new file mode 100644 index 00000000..ea87d6d2 --- /dev/null +++ b/schemes/rrtmgp/rrtmgp_pre.F90 @@ -0,0 +1,402 @@ +module rrtmgp_pre + + implicit none + private + + public :: rrtmgp_pre_init + public :: rrtmgp_pre_timestep_init + public :: rrtmgp_pre_run + public :: radiation_do_ccpp ! Public because it needs to be accessed elsewhere in CAM + +CONTAINS + +!> \section arg_table_rrtmgp_pre_init Argument Table +!! \htmlinclude rrtmgp_pre_init.html +!! + subroutine rrtmgp_pre_init(nradgas, gaslist, available_gases, gaslist_lc, errmsg, errflg) + use ccpp_gas_concentrations, only: ty_gas_concs_ccpp + use atmos_phys_string_utils, only: to_lower + integer, intent(in) :: nradgas ! Number of radiatively active gases + character(len=*), intent(in) :: gaslist(:) ! List of radiatively active gases + type(ty_gas_concs_ccpp), intent(inout) :: available_gases ! Gas concentrations object + character(len=*), intent(out) :: gaslist_lc(:) ! Lowercase verison of radiatively active gas list + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Create lowercase version of the gaslist for RRTMGP. The ty_gas_concs_ccpp objects + ! work with CAM's uppercase names, but other objects that get input from the gas + ! concs objects don't work. + do idx = 1, nradgas + gaslist_lc(idx) = to_lower(gaslist(idx)) + end do + + errmsg = available_gases%gas_concs%init(gaslist_lc) + if (len_trim(errmsg) /= 0) then + errflg = 1 + end if + + end subroutine rrtmgp_pre_init + +!> \section arg_table_rrtmgp_pre_timestep_init Argument Table +!! \htmlinclude rrtmgp_pre_timestep_init.html +!! + subroutine rrtmgp_pre_timestep_init(nstep, dtime, iradsw, irad_always, offset, errmsg, errflg) + integer, intent(in) :: nstep ! Current timestep number + integer, intent(in) :: dtime ! Timestep size + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(out) :: offset ! Offset for next SW radiation timestep + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + + logical :: dosw_next + integer :: nstepsw_next + + ! Get timestep of next radiation calculation + dosw_next = .false. + nstepsw_next = nstep + offset = 0 + do while (.not. dosw_next) + nstepsw_next = nstepsw_next + 1 + offset = offset + dtime + call radiation_do_ccpp('sw', nstepsw_next, iradsw, irad_always, dosw_next, errmsg, errflg) + if (errflg /= 0) then + return + end if + end do + + end subroutine rrtmgp_pre_timestep_init + +!> \section arg_table_rrtmgp_pre_run Argument Table +!! \htmlinclude rrtmgp_pre_run.html +!! + subroutine rrtmgp_pre_run(coszrs, nstep, dtime, iradsw, iradlw, irad_always, ncol, & + next_cday, idxday, nday, idxnite, nnite, dosw, dolw, nlay, nlwbands, & + nswbands, spectralflux, nextsw_cday, fsw, fswc, flw, flwc, errmsg, errflg) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + ! Inputs + real(kind_phys), dimension(:), intent(in) :: coszrs ! Cosine solar zenith angle + real(kind_phys), intent(in) :: next_cday ! The calendar day of the next timestep + integer, intent(in) :: dtime ! Timestep size [s] + integer, intent(in) :: nstep ! Timestep number + integer, intent(in) :: iradsw ! Freq. of shortwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: iradlw ! Freq. of longwave radiation calc in time steps (positive) or hours (negative) + integer, intent(in) :: irad_always ! Number of time steps to execute radiation continuously + integer, intent(in) :: ncol ! Number of columns + integer, intent(in) :: nlay ! Number of vertical layers + integer, intent(in) :: nlwbands ! Number of longwave bands + integer, intent(in) :: nswbands ! Number of shortwave bands + logical, intent(in) :: spectralflux ! Flag to calculate fluxes (up and down) per band + ! Outputs + real(kind_phys), intent(inout) :: nextsw_cday ! The next calendar day during which calculation will be performed + class(ty_fluxes_broadband_ccpp), intent(out) :: fswc ! Clear-sky shortwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: fsw ! All-sky shortwave flux object + class(ty_fluxes_broadband_ccpp), intent(out) :: flwc ! Clear-sky longwave flux object + class(ty_fluxes_byband_ccpp), intent(out) :: flw ! All-sky longwave flux object + integer, intent(out) :: nday ! Number of daylight columns + integer, intent(out) :: nnite ! Number of nighttime columns + integer, dimension(:), intent(out) :: idxday ! Indices of daylight columns + integer, dimension(:), intent(out) :: idxnite ! Indices of nighttime columns + logical, intent(out) :: dosw ! Flag to do shortwave calculation + logical, intent(out) :: dolw ! Flag to do longwave calculation + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: idx + + ! Set error variables + errflg = 0 + errmsg = '' + + ! Gather night/day column indices. + nday = 0 + nnite = 0 + do idx = 1, ncol + if ( coszrs(idx) > 0.0_kind_phys ) then + nday = nday + 1 + idxday(nday) = idx + else + nnite = nnite + 1 + idxnite(nnite) = idx + end if + end do + + ! Determine if we're going to do longwave and/or shortwave this timestep + call radiation_do_ccpp('sw', nstep, iradsw, irad_always, dosw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call radiation_do_ccpp('lw', nstep, iradlw, irad_always, dolw, errmsg, errflg) + if (errflg /= 0) then + return + end if + + ! determine if next radiation time-step not equal to next time-step + if (nstep >= 1) then + if (next_cday /= nextsw_cday) nextsw_cday = -1._kind_phys + end if + + ! Allocate the flux arrays and init to zero. + call initialize_rrtmgp_fluxes_byband(nday, nlay+1, nswbands, nswbands, spectralflux, fsw, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(nday, nlay+1, nswbands, nswbands, spectralflux, fswc, errmsg, errflg, do_direct=.true.) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_byband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flw, errmsg, errflg) + if (errflg /= 0) then + return + end if + call initialize_rrtmgp_fluxes_broadband(ncol, nlay+1, nlwbands, nswbands, spectralflux, flwc, errmsg, errflg) + if (errflg /= 0) then + return + end if + + end subroutine rrtmgp_pre_run + +!================================================================================================ + +subroutine radiation_do_ccpp(op, nstep, irad, irad_always, radiation_do, errmsg, errflg) + + ! Return radiation_do set to .true. if the specified operation is done this timestep. + + character(len=*), intent(in) :: op ! name of operation + integer, intent(in) :: nstep + integer, intent(in) :: irad + integer, intent(in) :: irad_always + integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + logical, intent(out) :: radiation_do ! return value + + !----------------------------------------------------------------------- + + ! Set error variables + errflg = 0 + errmsg = '' + + select case (op) + case ('sw') ! do a shortwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case ('lw') ! do a longwave heating calc this timestep? + radiation_do = nstep == 0 .or. irad == 1 & + .or. (mod(nstep-1,irad) == 0 .and. nstep /= 1) & + .or. nstep <= irad_always + case default + errflg = 1 + errmsg = 'radiation_do_ccpp: unknown operation:'//op + end select + +end subroutine radiation_do_ccpp + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_broadband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Initialize + call reset_fluxes_broadband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_broadband + +!========================================================================================= + +subroutine initialize_rrtmgp_fluxes_byband(ncol, nlevels, nbands, nswbands, spectralflux, fluxes, errmsg, errflg, do_direct) + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + ! Allocate flux arrays and set values to zero. + + ! Arguments + integer, intent(in) :: ncol, nlevels, nbands, nswbands + logical, intent(in) :: spectralflux + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + logical, optional, intent(in) :: do_direct + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + logical :: do_direct_local + character(len=256) :: alloc_errmsg + character(len=*), parameter :: sub = 'initialize_rrtmgp_fluxes_byband' + !---------------------------------------------------------------------------- + + if (present(do_direct)) then + do_direct_local = .true. + else + do_direct_local = .false. + end if + + ! Broadband fluxes + allocate(fluxes%fluxes%flux_up(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_dn(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%flux_net(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%flux_dn_dir(ncol, nlevels), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + + ! Fluxes by band always needed for SW. Only allocate for LW + ! when spectralflux is true. + if (nbands == nswbands .or. spectralflux) then + allocate(fluxes%fluxes%bnd_flux_up(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_up". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_dn(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn". Message: ', & + alloc_errmsg + return + end if + allocate(fluxes%fluxes%bnd_flux_net(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_net". Message: ', & + alloc_errmsg + return + end if + if (do_direct_local) then + allocate(fluxes%fluxes%bnd_flux_dn_dir(ncol, nlevels, nbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg, '(a,a,a)') sub, ': ERROR: failed to allocate "fluxes%fluxes%bnd_flux_dn_dir". Message: ', & + alloc_errmsg + return + end if + end if + end if + + ! Initialize + call reset_fluxes_byband(fluxes) + +end subroutine initialize_rrtmgp_fluxes_byband + +!========================================================================================= + +subroutine reset_fluxes_broadband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes, only: ty_fluxes_broadband_ccpp + + ! Reset flux arrays to zero. + + class(ty_fluxes_broadband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + +end subroutine reset_fluxes_broadband + +!========================================================================================= + +subroutine reset_fluxes_byband(fluxes) + use ccpp_kinds, only: kind_phys + use ccpp_fluxes_byband, only: ty_fluxes_byband_ccpp + + ! Reset flux arrays to zero. + + class(ty_fluxes_byband_ccpp), intent(inout) :: fluxes + !---------------------------------------------------------------------------- + + ! Reset broadband fluxes + fluxes%fluxes%flux_up(:,:) = 0._kind_phys + fluxes%fluxes%flux_dn(:,:) = 0._kind_phys + fluxes%fluxes%flux_net(:,:) = 0._kind_phys + if (associated(fluxes%fluxes%flux_dn_dir)) fluxes%fluxes%flux_dn_dir(:,:) = 0._kind_phys + + ! Reset band-by-band fluxes + if (associated(fluxes%fluxes%bnd_flux_up)) fluxes%fluxes%bnd_flux_up(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn)) fluxes%fluxes%bnd_flux_dn(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_net)) fluxes%fluxes%bnd_flux_net(:,:,:) = 0._kind_phys + if (associated(fluxes%fluxes%bnd_flux_dn_dir)) fluxes%fluxes%bnd_flux_dn_dir(:,:,:) = 0._kind_phys + +end subroutine reset_fluxes_byband + +!========================================================================================= + +end module rrtmgp_pre diff --git a/schemes/rrtmgp/utils/calculate_net_heating.F90 b/schemes/rrtmgp/utils/calculate_net_heating.F90 new file mode 100644 index 00000000..89f2f26a --- /dev/null +++ b/schemes/rrtmgp/utils/calculate_net_heating.F90 @@ -0,0 +1,66 @@ +module calculate_net_heating +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +implicit none +private + +! Public interfaces +public :: calculate_net_heating_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_calculate_net_heating_run Argument Table +!! \htmlinclude calculate_net_heating_run.html +!! +subroutine calculate_net_heating_run(ncol, rad_heat, qrl_prime, qrs_prime, fsns, fsnt, & + flns, flnt, is_offline_dyn, net_flx, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys + + ! Arguments + integer, intent(in) :: ncol ! horizontal dimension + real(kind_phys), intent(in) :: qrl_prime(:,:) ! longwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: qrs_prime(:,:) ! shortwave heating [J kg-1 s-1] + real(kind_phys), intent(in) :: fsns(:) ! Surface solar absorbed flux [W m-2] + real(kind_phys), intent(in) :: fsnt(:) ! Net column abs solar flux at model top [W m-2] + real(kind_phys), intent(in) :: flns(:) ! Srf longwave cooling (up-down) flux [W m-2] + real(kind_phys), intent(in) :: flnt(:) ! Net outgoing lw flux at model top [W m-2] + logical, intent(in) :: is_offline_dyn ! is offline dycore + real(kind_phys), intent(inout) :: rad_heat(:,:) ! radiative heating [J kg-1 s-1] + real(kind_phys), intent(out) :: net_flx(:) ! net boundary flux [W m-2] + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Local variables + integer :: idx + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + if (.not. is_offline_dyn) then + rad_heat(:,:) = (qrs_prime(:,:) + qrl_prime(:,:)) + end if + + do idx = 1, ncol + net_flx(idx) = fsnt(idx) - fsns(idx) - flnt(idx) + flns(idx) + end do + +end subroutine calculate_net_heating_run + +!================================================================================================ +end module calculate_net_heating diff --git a/schemes/rrtmgp/utils/radiation_tools.F90 b/schemes/rrtmgp/utils/radiation_tools.F90 new file mode 100644 index 00000000..e941a346 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_tools.F90 @@ -0,0 +1,98 @@ +!>\file radiation_tools.F90 +!! + +!> This module contains tools for radiation +module radiation_tools + use machine, only: & + kind_phys ! Working type + implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP +contains + +!> + subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) + ! Inputs + integer, intent(in) :: & + nCol,nLev + real(kind_phys),intent(in) :: & + minP + real(kind_phys),dimension(nCol),intent(in) :: & + tsfc + real(kind_phys),dimension(nCol,nLev),intent(in) :: & + p_lay,t_lay + real(kind_phys),dimension(nCol,nLev+1),intent(in) :: & + p_lev + + ! Outputs + real(kind_phys),dimension(nCol,nLev+1),intent(out) :: & + t_lev + + ! Local + integer :: iCol,iLay, iSFC, iTOA + logical :: top_at_1 + real(kind_phys), dimension(nCol,nLev) :: tem2da, tem2db + + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + if (iTOA .eq. 1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(minP, p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) + else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(minP, p_lev(iCol,iTOA)) ) + enddo + + t_lev(1:NCOL,1) = tsfc(1:NCOL) + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo + t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) + endif + + end subroutine cmp_tlev + +!> + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg + +end module radiation_tools diff --git a/schemes/rrtmgp/utils/radiation_utils.F90 b/schemes/rrtmgp/utils/radiation_utils.F90 new file mode 100644 index 00000000..d0e40893 --- /dev/null +++ b/schemes/rrtmgp/utils/radiation_utils.F90 @@ -0,0 +1,205 @@ +module radiation_utils + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: radiation_utils_init + public :: get_sw_spectral_boundaries_ccpp + public :: get_lw_spectral_boundaries_ccpp + public :: get_mu_lambda_weights_ccpp + + real(kind_phys), allocatable :: wavenumber_low_shortwave(:) + real(kind_phys), allocatable :: wavenumber_high_shortwave(:) + real(kind_phys), allocatable :: wavenumber_low_longwave(:) + real(kind_phys), allocatable :: wavenumber_high_longwave(:) + integer :: nswbands + integer :: nlwbands + logical :: wavenumber_boundaries_set = .false. + +contains + + subroutine radiation_utils_init(nswbands_in, nlwbands_in, low_shortwave, high_shortwave, & + low_longwave, high_longwave, errmsg, errflg) + integer, intent(in) :: nswbands_in ! Number of shortwave bands + integer, intent(in) :: nlwbands_in ! Number of longwave bands + real(kind_phys), intent(in) :: low_shortwave(:) ! Low range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: high_shortwave(:) ! High range values for shortwave bands (cm-1) + real(kind_phys), intent(in) :: low_longwave(:) ! Low range values for longwave bands (cm-1) + real(kind_phys), intent(in) :: high_longwave(:) ! High range values for longwave bands (cm-1) + integer, intent(out) :: errflg + character(len=*),intent(out) :: errmsg + ! Local variables + character(len=256) :: alloc_errmsg + + errflg = 0 + errmsg = '' + nswbands = nswbands_in + nlwbands = nlwbands_in + allocate(wavenumber_low_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_shortwave(nswbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_shortwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_low_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_low_longwave, message: ', & + alloc_errmsg + end if + allocate(wavenumber_high_longwave(nlwbands), stat=errflg, errmsg=alloc_errmsg) + if (errflg /= 0) then + write(errmsg,'(a,a)') 'radiation_utils_init: failed to allocate wavenumber_high_longwave, message: ', & + alloc_errmsg + end if + + wavenumber_low_shortwave = low_shortwave + wavenumber_high_shortwave = high_shortwave + wavenumber_low_longwave = low_longwave + wavenumber_high_longwave = high_longwave + + wavenumber_boundaries_set = .true. + + end subroutine radiation_utils_init + +!========================================================================================= + + subroutine get_sw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each shortwave band in the units requested + + character(len=*), intent(in) :: units ! requested units + real(kind_phys), dimension(:), intent(out) :: low_boundaries ! low range bounds for shortwave bands in requested units + real(kind_phys), dimension(:), intent(out) :: high_boundaries ! high range bounds for shortwave bands in requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_sw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_shortwave + high_boundaries = wavenumber_high_shortwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_shortwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_shortwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_shortwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_shortwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_shortwave + high_boundaries = 1._kind_phys/wavenumber_low_shortwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + + end subroutine get_sw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_lw_spectral_boundaries_ccpp(low_boundaries, high_boundaries, units, errmsg, errflg) + + ! provide spectral boundaries of each longwave band in the units requested + + character(len=*), intent(in) :: units ! requested units + real(kind_phys), intent(out) :: low_boundaries(nlwbands) ! low range bounds for longwave bands in requested units + real(kind_phys), intent(out) :: high_boundaries(nlwbands) ! high range bounds for longwave bands in requested units + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + character(len=*), parameter :: sub = 'get_lw_spectral_boundaries_ccpp' + !---------------------------------------------------------------------------- + + ! Set error variables + errmsg = '' + errflg = 0 + + if (.not. wavenumber_boundaries_set) then + write(errmsg,'(a,a)') sub, ': ERROR, wavenumber boundaries not set.' + end if + + select case (units) + case ('inv_cm','cm^-1','cm-1') + low_boundaries = wavenumber_low_longwave + high_boundaries = wavenumber_high_longwave + case('m','meter','meters') + low_boundaries = 1.e-2_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e-2_kind_phys/wavenumber_low_longwave + case('nm','nanometer','nanometers') + low_boundaries = 1.e7_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e7_kind_phys/wavenumber_low_longwave + case('um','micrometer','micrometers','micron','microns') + low_boundaries = 1.e4_kind_phys/wavenumber_high_longwave + high_boundaries = 1.e4_kind_phys/wavenumber_low_longwave + case('cm','centimeter','centimeters') + low_boundaries = 1._kind_phys/wavenumber_high_longwave + high_boundaries = 1._kind_phys/wavenumber_low_longwave + case default + write(errmsg, '(a,a,a)') sub, ': ERROR, requested spectral units not recognized: ', units + errflg = 1 + end select + +end subroutine get_lw_spectral_boundaries_ccpp + +!========================================================================================= + +subroutine get_mu_lambda_weights_ccpp(nmu, nlambda, g_mu, g_lambda, lamc, pgam, & + mu_wgts, lambda_wgts, errmsg, errflg) + use interpolate_data, only: interp_type, lininterp_init, lininterp, & + extrap_method_bndry + ! Get mu and lambda interpolation weights + integer, intent(in) :: nmu ! number of mu values + integer, intent(in) :: nlambda ! number of lambda values + real(kind_phys), intent(in) :: g_mu(:) ! mu values + real(kind_phys), intent(in) :: g_lambda(:,:) ! lambda table + real(kind_phys), intent(in) :: lamc ! prognosed value of lambda for cloud + real(kind_phys), intent(in) :: pgam ! prognosed value of mu for cloud + ! Output interpolation weights. Caller is responsible for freeing these. + type(interp_type), intent(out) :: mu_wgts ! mu interpolation weights + type(interp_type), intent(out) :: lambda_wgts ! lambda interpolation weights + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: ilambda + real(kind_phys) :: g_lambda_interp(nlambda) + + ! Set error variables + errmsg = '' + errflg = 0 + + ! Make interpolation weights for mu. + ! (Put pgam in a temporary array for this purpose.) + call lininterp_init(g_mu, nmu, [pgam], 1, extrap_method_bndry, mu_wgts) + + ! Use mu weights to interpolate to a row in the lambda table. + do ilambda = 1, nlambda + call lininterp(g_lambda(:,ilambda), nmu, & + g_lambda_interp(ilambda:ilambda), 1, mu_wgts) + end do + + ! Make interpolation weights for lambda. + call lininterp_init(g_lambda_interp, nlambda, [lamc], 1, & + extrap_method_bndry, lambda_wgts) + +end subroutine get_mu_lambda_weights_ccpp + +!========================================================================================= + +end module radiation_utils diff --git a/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 new file mode 100644 index 00000000..f2d80ea2 --- /dev/null +++ b/schemes/rrtmgp/utils/rrtmgp_dry_static_energy_tendency.F90 @@ -0,0 +1,62 @@ +module rrtmgp_dry_static_energy_tendency +!----------------------------------------------------------------------- +! +! Purpose: Provide an interface to convert shortwave and longwave +! radiative heating terms into net heating. +! +! This module provides a hook to allow incorporating additional +! radiative terms (eUV heating and nonLTE longwave cooling). +! +! Original version: B.A. Boville +!----------------------------------------------------------------------- + +implicit none +private + +! Public interfaces +public :: rrtmgp_dry_static_energy_tendency_run + +!=============================================================================== +contains +!=============================================================================== + +!> \section arg_table_rrtmgp_dry_static_energy_tendency_run Argument Table +!! \htmlinclude rrtmgp_dry_static_energy_tendency_run.html +!! +subroutine rrtmgp_dry_static_energy_tendency_run(pdel, calc_sw_heat, calc_lw_heat, & + qrs, qrl, qrs_prime, qrl_prime, errmsg, errflg) +!----------------------------------------------------------------------- +! Compute net radiative heating from qrs and qrl, and the associated net +! boundary flux. +!----------------------------------------------------------------------- + use ccpp_kinds, only: kind_phys + + ! Arguments + real(kind_phys), dimension(:,:), intent(in) :: pdel ! Layer thickness + logical, intent(in) :: calc_sw_heat ! Flag to calculate net shortwave heating + logical, intent(in) :: calc_lw_heat ! Flag to calculate net longwave heating + real(kind_phys), dimension(:,:), intent(in) :: qrs ! shortwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) + real(kind_phys), dimension(:,:), intent(in) :: qrl ! longwave heating rate adjusted by air pressure thickness (J Pa kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrs_prime ! shortwave heating rate (J kg-1 s-1) + real(kind_phys), dimension(:,:), intent(out) :: qrl_prime ! longwave heating rate (J kg-1 s-1) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + !----------------------------------------------------------------------- + ! Set error variables + errmsg = '' + errflg = 0 + + if (calc_sw_heat) then + qrs_prime(:,:) = qrs(:,:) / pdel(:,:) + end if + + if (calc_lw_heat) then + qrl_prime(:,:) = qrl(:,:) / pdel(:,:) + end if + +end subroutine rrtmgp_dry_static_energy_tendency_run + +!================================================================================================ +end module rrtmgp_dry_static_energy_tendency diff --git a/test/unit-test/CMakeLists.txt b/test/unit-test/CMakeLists.txt index 728e7a1f..c3287718 100644 --- a/test/unit-test/CMakeLists.txt +++ b/test/unit-test/CMakeLists.txt @@ -34,6 +34,8 @@ target_include_directories(utilities PUBLIC ${CMAKE_CURRENT_BINARY_DIR}) set(PHYS_UTILS_SRC ../../phys_utils/atmos_phys_pbl_utils.F90 + ../../phys_utils/atmos_phys_string_utils.F90 + ../../phys_utils/atmos_phys_rad_utils.F90 include/ccpp_kinds.F90 ) diff --git a/test/unit-test/tests/phys_utils/CMakeLists.txt b/test/unit-test/tests/phys_utils/CMakeLists.txt index 5e3020cc..17499a47 100644 --- a/test/unit-test/tests/phys_utils/CMakeLists.txt +++ b/test/unit-test/tests/phys_utils/CMakeLists.txt @@ -1,4 +1,6 @@ add_pfunit_ctest(phys_utils_tests TEST_SOURCES test_atmos_pbl_utils.pf + TEST_SOURCES test_atmos_string_utils.pf + TEST_SOURCES test_atmos_rad_utils.pf LINK_LIBRARIES phys_utils ) diff --git a/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf new file mode 100644 index 00000000..9d615967 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_rad_utils.pf @@ -0,0 +1,41 @@ +@test +subroutine wavenumber_is_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 15555._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.true., output_logical) +end subroutine wavenumber_is_visible + +@test +subroutine wavenumber_is_not_visible() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 823._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_not_visible + +@test +subroutine wavenumber_is_on_the_cusp() + use funit + use atmos_phys_rad_utils, only : is_visible + use ccpp_kinds, only : kind_phys + + real(kind_phys), parameter :: test_wavenumber = 14286._kind_phys + logical :: output_logical + + output_logical = is_visible(test_wavenumber) + + @assertEqual(.false., output_logical) +end subroutine wavenumber_is_on_the_cusp diff --git a/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf new file mode 100644 index 00000000..890d0c64 --- /dev/null +++ b/test/unit-test/tests/phys_utils/test_atmos_string_utils.pf @@ -0,0 +1,103 @@ +@test +subroutine mixed_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('mixed case string', output_string) +end subroutine mixed_case_to_lower_case + +@test +subroutine lower_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_lower(test_string) + + @assertEqual(' lower case string', output_string) +end subroutine lower_case_to_lower_case + +@test +subroutine upper_case_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('upper case string', output_string) +end subroutine upper_case_to_lower_case + +@test +subroutine non_letters_to_lower_case() + use funit + use atmos_phys_string_utils, only : to_lower + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_lower(test_string) + + @assertEqual('string with 3 non-letters!', output_string) +end subroutine non_letters_to_lower_case + +@test +subroutine mixed_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'Mixed Case StrinG' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('MIXED CASE STRING', output_string) +end subroutine mixed_case_to_upper_case + +@test +subroutine lower_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = ' lower case string' + character(len=18) :: output_string + + output_string = to_upper(test_string) + + @assertEqual(' LOWER CASE STRING', output_string) +end subroutine lower_case_to_upper_case + +@test +subroutine upper_case_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'UPPER CASE STRING' + character(len=17) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('UPPER CASE STRING', output_string) +end subroutine upper_case_to_upper_case + +@test +subroutine non_letters_to_upper_case() + use funit + use atmos_phys_string_utils, only : to_upper + + character(len=*), parameter :: test_string = 'string with 3 NON-letters!' + character(len=26) :: output_string + + output_string = to_upper(test_string) + + @assertEqual('STRING WITH 3 NON-LETTERS!', output_string) +end subroutine non_letters_to_upper_case