From 8063a01d9ea86e1076dafd44fd9cca35a4423614 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Tue, 26 Nov 2024 15:02:50 -0800 Subject: [PATCH 01/22] draft sza and earth-sun distance code --- schemes/musica/musica_ccpp.F90 | 24 +++- schemes/musica/musica_ccpp.meta | 42 ++++++ schemes/musica/musica_ccpp_util.F90 | 47 +++++++ schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 11 +- test/musica/CMakeLists.txt | 1 + test/musica/test_musica_api.F90 | 16 +++ to_be_ccppized/shr_orb_mod.F90 | 166 +++++++++++++++++++++++ 7 files changed, 298 insertions(+), 9 deletions(-) create mode 100644 to_be_ccppized/shr_orb_mod.F90 diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 3fc66299..3422bdb3 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -60,8 +60,10 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, & number_of_photolysis_wavelength_grid_sections, & - photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, errmsg, errcode) + photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & + standard_gravitational_acceleration, latitude, longitude, & + earth_eccentricity, earth_obliquity, perihelion_longitude, & + moving_vernal_equinox_longitude, calendar_day, 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 @@ -83,6 +85,14 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 + real(kind_phys), intent(in) :: latitude(:) ! radians (column) + real(kind_phys), intent(in) :: longitude(:) ! radians (column) + + real(kind_phys), intent(in) :: earth_eccentricity ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) + real(kind_phys), intent(in) :: earth_obliquity ! Earth's obliquity in radians + real(kind_phys), intent(in) :: perihelion_longitude ! Earth's mean perihelion longitude at the vernal equinox (radians) + real(kind_phys), intent(in) :: moving_vernal_equinox_longitude ! Earth's moving vernal equinox longitude of perihelion plus pi (radians) + real(kind_phys), intent(in) :: calendar_day ! fractional calendar day character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -91,8 +101,16 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & number_of_rate_parameters) :: rate_parameters ! various units + real(kind_phys), dimension(size(latitude)) :: solar_zenith_angle ! radians + real(kind_phys) :: earth_sun_distance ! AU integer :: i_elem + ! Calculate solar zenith angle and Earth-Sun distance + call calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & + latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & + moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & + errmsg, errcode) + ! Calculate photolysis rate constants using TUV-x call tuvx_run(temperature, dry_air_density, & geopotential_height_wrt_surface_at_midpoint, & @@ -103,6 +121,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & + solar_zenith_angle, & + earth_sun_distance, & rate_parameters, & errmsg, errcode) diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 2929d10f..8c8be4cd 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -165,6 +165,48 @@ type = real | kind = kind_phys dimensions = () intent = in +[ latitude ] + standard_name = latitude + units = radians + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent) + intent = in +[ longitude ] + standard_name = longitude + units = radians + type = real | kind = real_phys + dimensions = (horizontal_loop_extent) + intent = in +[ earth_eccentricity ] + standard_name = eccentricity_factor + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in +[ earth_obliquity ] + standard_name = obliquity + units = radians + type = real | kind = kind_phys + dimensions = () + intent = in +[ perihelion_longitude ] + standard_name = mean_longitude_of_perihelion_at_vernal_equinox + units = radians + type = real | kind = kind_phys + dimensions = () + intent = in +[ moving_vernal_equinox_longitude ] + standard_name = moving_vernal_equinox_longitude_perihelion_plus_pi + units = radians + type = real | kind = kind_phys + dimensions = () + intent = in +[ calendar_day ] + standard_name = fractional_calendar_days_on_end_of_current_timestep + units = 1 + type = real | kind = kind_phys + dimensions = () + intent = in [ errmsg ] standard_name = ccpp_error_message units = none diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/musica_ccpp_util.F90 index 5a4eda9c..b3211ab0 100644 --- a/schemes/musica/musica_ccpp_util.F90 +++ b/schemes/musica/musica_ccpp_util.F90 @@ -37,4 +37,51 @@ logical function has_error_occurred(error, error_message, error_code) end function has_error_occurred + !> Calculate the solar zenith angle and Earth-Sun distance + !> @param[in] calendar_day Calendar day, including fraction + !> @param[in] latitude Latitude in radians + !> @param[in] longitude Longitude in radians + !> @param[in] earth_eccentricity Earth's eccentricity factor (unitless) + !> @param[in] earth_obliquity Earth's obliquity in radians + !> @param[in] perihelion_longitude Earth's mean perihelion longitude at the vernal equinox (radians) + !> @param[in] moving_vernal_equinox_longitude Earth's moving vernal equinox longitude of perihelion plus pi (radians) + !> @param[out] solar_zenith_angle Solar zenith angle in radians + !> @param[out] earth_sun_distance Earth-Sun distance in AU + !> @param[out] errmsg Error message + !> @param[out] errcode Error code + subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & + latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & + moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & + errmsg, errcode) + use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz + use musica_util, only: error_t + + real(kind_phys), intent(in) :: calendar_day + real(kind_phys), intent(in) :: latitude(:) + real(kind_phys), intent(in) :: longitude(:) + real(kind_phys), intent(in) :: earth_eccentricity + real(kind_phys), intent(in) :: earth_obliquity + real(kind_phys), intent(in) :: perihelion_longitude + real(kind_phys), intent(in) :: moving_vernal_equinox_longitude + real(kind_phys), intent(out) :: solar_zenith_angle(:) + real(kind_phys), intent(out) :: earth_sun_distance + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + real(kind_phys) :: delta + integer :: i_lat + + errcode = 0 + errmsg = '' + + ! Calculate earth/orbit parameters + call shr_orb_decl(calendar_day, earth_eccentricity, earth_obliquity, & + perihelion_longitude, moving_vernal_equinox_longitude, & + delta, earth_sun_distance) + + ! Calculate solar zenith angle + solar_zenith_angle(:) = shr_orb_cosz(calendar_day, latitude(:), longitude(:), delta) + + end subroutine calculate_solar_zenith_angle_and_earth_sun_distance + end module musica_ccpp_util diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index a972b15d..245d3ead 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -304,6 +304,7 @@ subroutine tuvx_run(temperature, dry_air_density, & photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & + solar_zenith_angle, earth_sun_distance, & rate_parameters, errmsg, errcode) use musica_util, only: error_t use musica_ccpp_tuvx_height_grid, only: set_height_grid_values, calculate_heights @@ -323,6 +324,8 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 + real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians + real(kind_phys), intent(in) :: earth_sun_distance ! m real(kind_phys), intent(inout) :: rate_parameters(:,:,:) ! various units (column, layer, reaction) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -334,8 +337,6 @@ subroutine tuvx_run(temperature, dry_air_density, & number_of_photolysis_rate_constants) :: photolysis_rate_constants, & ! s-1 heating_rates ! K s-1 (TODO: check units) real(kind_phys) :: reciprocal_of_gravitational_acceleration ! s2 m-1 - real(kind_phys) :: solar_zenith_angle ! degrees - real(kind_phys) :: earth_sun_distance ! AU type(error_t) :: error integer :: i_col, i_level @@ -365,12 +366,8 @@ subroutine tuvx_run(temperature, dry_air_density, & surface_temperature(i_col), errmsg, errcode ) if (errcode /= 0) return - ! temporary values until these are available from the host model - solar_zenith_angle = 0.0_kind_phys - earth_sun_distance = 1.0_kind_phys - ! calculate photolysis rate constants and heating rates - call tuvx%run( solar_zenith_angle, earth_sun_distance, & + call tuvx%run( solar_zenith_angle(i_col), earth_sun_distance, & photolysis_rate_constants(:,:), heating_rates(:,:), & error ) if (has_error_occurred( error, errmsg, errcode )) return diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index 7cdba304..72b95963 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -29,6 +29,7 @@ target_sources(test_musica_api PUBLIC ${MUSICA_CCPP_SOURCES} ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 ${CCPP_SRC_PATH}/ccpp_hash_table.F90 ${CCPP_SRC_PATH}/ccpp_hashable.F90 diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index cc7272b9..bb0aa1e8 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -161,6 +161,8 @@ subroutine test_chapman() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m real(kind_phys), dimension(NUM_COLUMNS) :: surface_geopotential ! m2 s-2 real(kind_phys), dimension(NUM_COLUMNS) :: surface_temperature ! K + real(kind_phys), dimension(NUM_COLUMNS) :: latitude ! radians + real(kind_phys), dimension(NUM_COLUMNS) :: longitude ! radians real(kind_phys) :: surface_albedo ! unitless integer, parameter :: num_photolysis_wavelength_grid_sections = 8 ! (count) real(kind_phys), dimension(num_photolysis_wavelength_grid_sections+1) :: flux_data_photolysis_wavelength_interfaces ! nm @@ -181,6 +183,11 @@ subroutine test_chapman() integer :: i, j, k integer :: N2_index, O2_index, O_index, O1D_index, O3_index real(kind_phys) :: total_O, total_O_init + real(kind_phys) :: earth_eccentricity + real(kind_phys) :: earth_obliquity + real(kind_phys) :: perihelion_longitude + real(kind_phys) :: moving_vernal_equinox_longitude + real(kind_phys) :: calendar_day call get_wavelength_edges(photolysis_wavelength_grid_interfaces) solver_type = Rosenbrock @@ -206,6 +213,15 @@ subroutine test_chapman() (/ 1.5e13_kind_phys, 1.5e13_kind_phys, 1.4e13_kind_phys, 1.4e13_kind_phys, & 1.3e13_kind_phys, 1.2e13_kind_phys, 1.1e13_kind_phys, 1.0e13_kind_phys /) + ! Set conditions for one daytime and one nighttime column + latitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + longitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + earth_eccentricity = 0.0167_kind_phys + earth_obliquity = 0.4091_kind_phys + perihelion_longitude = 4.71238898038469_kind_phys + moving_vernal_equinox_longitude = 4.71238898038469_kind_phys + calendar_day = 365.5_kind_phys ! noon GMT Dec. 31st + filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/chapman/tuvx_micm_mapping.json' diff --git a/to_be_ccppized/shr_orb_mod.F90 b/to_be_ccppized/shr_orb_mod.F90 new file mode 100644 index 00000000..fa51b9f2 --- /dev/null +++ b/to_be_ccppized/shr_orb_mod.F90 @@ -0,0 +1,166 @@ +! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module shr_orb_mod + + use ccpp_kinds, only: kind_phys + + implicit none + + private + public :: shr_orb_decl, shr_orb_cosz + + ! This module contains the routines for computing the solar zenith angle and + ! Earth-Sun distance from https://github.com/ESCOMP/CESM_share + ! + ! This is a temporary module that will be replaced when a solution for + ! providing information calculated from CESM shared code is implemented for + ! CAM-SIMA. + ! + ! Code is included in the form present in ESCOMP/CESM_share. + + ! Dependencies from other parts of the shared code + integer, parameter :: SHR_KIND_R8 = kind_phys + real(SHR_KIND_R8), parameter :: SHR_CONST_PI = 3.14159265358979323846_SHARE_KIND_R8 ! pi + +contains + + !======================================================================= + + SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) + + !------------------------------------------------------------------------------- + ! + ! Compute earth/orbit parameters using formula suggested by + ! Duane Thresher. + ! + !---------------------------Code history---------------------------------------- + ! + ! Original version: Erik Kluzek + ! Date: Oct/1997 + ! + !------------------------------------------------------------------------------- + + !------------------------------Arguments-------------------------------- + real (SHR_KIND_R8),intent(in) :: calday ! Calendar day, including fraction + real (SHR_KIND_R8),intent(in) :: eccen ! Eccentricity + real (SHR_KIND_R8),intent(in) :: obliqr ! Earths obliquity in radians + real (SHR_KIND_R8),intent(in) :: lambm0 ! Mean long of perihelion at the + ! vernal equinox (radians) + real (SHR_KIND_R8),intent(in) :: mvelpp ! moving vernal equinox longitude + ! of perihelion plus pi (radians) + real (SHR_KIND_R8),intent(out) :: delta ! Solar declination angle in rad + real (SHR_KIND_R8),intent(out) :: eccf ! Earth-sun distance factor (ie. (1/r)**2) + + !---------------------------Local variables----------------------------- + real (SHR_KIND_R8),parameter :: dayspy = 365.0_SHR_KIND_R8 ! days per year + real (SHR_KIND_R8),parameter :: ve = 80.5_SHR_KIND_R8 ! Calday of vernal equinox + ! assumes Jan 1 = calday 1 + + real (SHR_KIND_R8) :: lambm ! Lambda m, mean long of perihelion (rad) + real (SHR_KIND_R8) :: lmm ! Intermediate argument involving lambm + real (SHR_KIND_R8) :: lamb ! Lambda, the earths long of perihelion + real (SHR_KIND_R8) :: invrho ! Inverse normalized sun/earth distance + real (SHR_KIND_R8) :: sinl ! Sine of lmm + + ! Compute eccentricity factor and solar declination using + ! day value where a round day (such as 213.0) refers to 0z at + ! Greenwich longitude. + ! + ! Use formulas from Berger, Andre 1978: Long-Term Variations of Daily + ! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci. + ! 35:2362-2367. + ! + ! To get the earths true longitude (position in orbit; lambda in Berger + ! 1978) which is necessary to find the eccentricity factor and declination, + ! must first calculate the mean longitude (lambda m in Berger 1978) at + ! the present day. This is done by adding to lambm0 (the mean longitude + ! at the vernal equinox, set as March 21 at noon, when lambda=0; in radians) + ! an increment (delta lambda m in Berger 1978) that is the number of + ! days past or before (a negative increment) the vernal equinox divided by + ! the days in a model year times the 2*pi radians in a complete orbit. + + lambm = lambm0 + (calday - ve)*2._SHR_KIND_R8*pi/dayspy + lmm = lambm - mvelpp + + ! The earths true longitude, in radians, is then found from + ! the formula in Berger 1978: + + sinl = sin(lmm) + lamb = lambm + eccen*(2._SHR_KIND_R8*sinl + eccen*(1.25_SHR_KIND_R8*sin(2._SHR_KIND_R8*lmm) & + & + eccen*((13.0_SHR_KIND_R8/12.0_SHR_KIND_R8)*sin(3._SHR_KIND_R8*lmm) - 0.25_SHR_KIND_R8*sinl))) + + ! Using the obliquity, eccentricity, moving vernal equinox longitude of + ! perihelion (plus), and earths true longitude, the declination (delta) + ! and the normalized earth/sun distance (rho in Berger 1978; actually inverse + ! rho will be used), and thus the eccentricity factor (eccf), can be + ! calculated from formulas given in Berger 1978. + + invrho = (1._SHR_KIND_R8 + eccen*cos(lamb - mvelpp)) / (1._SHR_KIND_R8 - eccen*eccen) + + ! Set solar declination and eccentricity factor + + delta = asin(sin(obliqr)*sin(lamb)) + eccf = invrho*invrho + + return + + END SUBROUTINE shr_orb_decl + + !======================================================================= + + real(SHR_KIND_R8) pure FUNCTION shr_orb_cosz(jday,lat,lon,declin,dt_avg,uniform_angle) + + !---------------------------------------------------------------------------- + ! + ! FUNCTION to return the cosine of the solar zenith angle. + ! Assumes 365.0 days/year. + ! + !--------------- Code History ----------------------------------------------- + ! + ! Original Author: Brian Kauffman + ! Date: Jan/98 + ! History: adapted from statement FUNCTION in share/orb_cosz.h + ! + !---------------------------------------------------------------------------- + + real (SHR_KIND_R8),intent(in) :: jday ! Julian cal day (1.xx to 365.xx) + real (SHR_KIND_R8),intent(in) :: lat ! Centered latitude (radians) + real (SHR_KIND_R8),intent(in) :: lon ! Centered longitude (radians) + real (SHR_KIND_R8),intent(in) :: declin ! Solar declination (radians) + real (SHR_KIND_R8),intent(in), optional :: dt_avg ! if present and set non-zero, then use in the + real (SHR_KIND_R8),intent(in), optional :: uniform_angle ! if present and true, apply uniform insolation + ! average cosz calculation + logical :: use_dt_avg + + !---------------------------------------------------------------------------- + + if ( constant_zenith_angle_deg >= 0 ) then + shr_orb_cosz = cos( constant_zenith_angle_deg * SHR_CONST_PI/180. ) + return + end if + + if (present(uniform_angle)) then + shr_orb_cosz = cos(uniform_angle) + return + end if + + ! perform the calculation of shr_orb_cosz + use_dt_avg = .false. + if (present(dt_avg)) then + if (dt_avg /= 0.0_shr_kind_r8) use_dt_avg = .true. + end if + ! If dt for the average cosz is specified, then call the shr_orb_avg_cosz + if (use_dt_avg) then + !shr_orb_cosz = shr_orb_avg_cosz(jday, lat, lon, declin, dt_avg) + write(*,*) 'shr_orb_cosz: shr_orb_avg_cosz not implemented' + shr_orb_cosz = -huge(0.0_SHR_KIND_R8) + else + shr_orb_cosz = sin(lat)*sin(declin) - cos(lat)*cos(declin) * & + cos((jday-floor(jday))*2.0_SHR_KIND_R8*pi + lon) + end if + + END FUNCTION shr_orb_cosz + + !======================================================================= + +end module shr_orb_mod \ No newline at end of file From 073eb1d022b76c634385d9238b9ee76a6ba27e46 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Tue, 26 Nov 2024 16:13:54 -0800 Subject: [PATCH 02/22] finish sza and earth-sun distance changes --- schemes/musica/musica_ccpp.F90 | 1 + schemes/musica/musica_ccpp.meta | 2 +- schemes/musica/musica_ccpp_util.F90 | 9 +++++--- test/musica/test_musica_api.F90 | 24 ++++++++++++++++++-- test/musica/tuvx/CMakeLists.txt | 5 +++++ to_be_ccppized/shr_orb_mod.F90 | 35 +++++------------------------ 6 files changed, 40 insertions(+), 36 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 3422bdb3..8797f14d 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -68,6 +68,7 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co 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_util, only: calculate_solar_zenith_angle_and_earth_sun_distance real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 8c8be4cd..add67d30 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -174,7 +174,7 @@ [ longitude ] standard_name = longitude units = radians - type = real | kind = real_phys + type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in [ earth_eccentricity ] diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/musica_ccpp_util.F90 index b3211ab0..0e0ce274 100644 --- a/schemes/musica/musica_ccpp_util.F90 +++ b/schemes/musica/musica_ccpp_util.F90 @@ -5,7 +5,7 @@ module musica_ccpp_util implicit none private - public :: has_error_occurred + public :: has_error_occurred, calculate_solar_zenith_angle_and_earth_sun_distance contains @@ -53,6 +53,7 @@ subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & errmsg, errcode) + use ccpp_kinds, only: kind_phys use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz use musica_util, only: error_t @@ -69,7 +70,7 @@ subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & integer, intent(out) :: errcode real(kind_phys) :: delta - integer :: i_lat + integer :: i_sza errcode = 0 errmsg = '' @@ -80,7 +81,9 @@ subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & delta, earth_sun_distance) ! Calculate solar zenith angle - solar_zenith_angle(:) = shr_orb_cosz(calendar_day, latitude(:), longitude(:), delta) + do i_sza = 1, size(solar_zenith_angle) + solar_zenith_angle(i_sza) = shr_orb_cosz(calendar_day, latitude(i_sza), longitude(i_sza), delta) + end do end subroutine calculate_solar_zenith_angle_and_earth_sun_distance diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index bb0aa1e8..5145e4c4 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -316,7 +316,9 @@ subroutine test_chapman() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, errmsg, errcode ) + standard_gravitational_acceleration, latitude, longitude, earth_eccentricity, & + earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & + calendar_day, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -386,6 +388,8 @@ subroutine test_terminator() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m real(kind_phys), dimension(NUM_COLUMNS) :: surface_geopotential ! m2 s-2 real(kind_phys), dimension(NUM_COLUMNS) :: surface_temperature ! K + real(kind_phys), dimension(NUM_COLUMNS) :: latitude ! radians + real(kind_phys), dimension(NUM_COLUMNS) :: longitude ! radians real(kind_phys) :: surface_albedo ! unitless integer, parameter :: num_photolysis_wavelength_grid_sections = 8 ! (count) real(kind_phys), dimension(num_photolysis_wavelength_grid_sections+1) :: flux_data_photolysis_wavelength_interfaces ! nm @@ -406,6 +410,11 @@ subroutine test_terminator() integer :: i, j, k integer :: Cl_index, Cl2_index real(kind_phys) :: total_Cl, total_Cl_init + real(kind_phys) :: earth_eccentricity + real(kind_phys) :: earth_obliquity + real(kind_phys) :: perihelion_longitude + real(kind_phys) :: moving_vernal_equinox_longitude + real(kind_phys) :: calendar_day call get_wavelength_edges(photolysis_wavelength_grid_interfaces) solver_type = Rosenbrock @@ -431,6 +440,15 @@ subroutine test_terminator() (/ 1.5e13_kind_phys, 1.5e13_kind_phys, 1.4e13_kind_phys, 1.4e13_kind_phys, & 1.3e13_kind_phys, 1.2e13_kind_phys, 1.1e13_kind_phys, 1.0e13_kind_phys /) + ! Set conditions for one daytime and one nighttime column + latitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + longitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + earth_eccentricity = 0.0167_kind_phys + earth_obliquity = 0.4091_kind_phys + perihelion_longitude = 4.71238898038469_kind_phys + moving_vernal_equinox_longitude = 4.71238898038469_kind_phys + calendar_day = 365.5_kind_phys ! noon GMT Dec. 31st + filename_of_micm_configuration = 'musica_configurations/terminator/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/terminator/tuvx_micm_mapping.json' @@ -513,7 +531,9 @@ subroutine test_terminator() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, errmsg, errcode ) + standard_gravitational_acceleration, latitude, longitude, earth_eccentricity, & + earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & + calendar_day, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index ecd179be..a4f685e9 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -6,6 +6,7 @@ target_sources(test_tuvx_height_grid ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_height_grid @@ -34,6 +35,7 @@ target_sources(test_tuvx_wavelength_grid ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_wavelength_grid @@ -63,6 +65,7 @@ target_sources(test_tuvx_temperature ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_temperature.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_temperature @@ -92,6 +95,7 @@ target_sources(test_tuvx_surface_albedo ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_surface_albedo.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_surface_albedo @@ -121,6 +125,7 @@ target_sources(test_tuvx_extraterrestrial_flux ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) diff --git a/to_be_ccppized/shr_orb_mod.F90 b/to_be_ccppized/shr_orb_mod.F90 index fa51b9f2..4ae7329d 100644 --- a/to_be_ccppized/shr_orb_mod.F90 +++ b/to_be_ccppized/shr_orb_mod.F90 @@ -20,8 +20,8 @@ module shr_orb_mod ! Dependencies from other parts of the shared code integer, parameter :: SHR_KIND_R8 = kind_phys - real(SHR_KIND_R8), parameter :: SHR_CONST_PI = 3.14159265358979323846_SHARE_KIND_R8 ! pi - + real(SHR_KIND_R8), parameter :: pi = 3.14159265358979323846_SHR_KIND_R8 ! pi + contains !======================================================================= @@ -108,7 +108,7 @@ END SUBROUTINE shr_orb_decl !======================================================================= - real(SHR_KIND_R8) pure FUNCTION shr_orb_cosz(jday,lat,lon,declin,dt_avg,uniform_angle) + real(SHR_KIND_R8) pure FUNCTION shr_orb_cosz(jday,lat,lon,declin) !---------------------------------------------------------------------------- ! @@ -127,37 +127,12 @@ real(SHR_KIND_R8) pure FUNCTION shr_orb_cosz(jday,lat,lon,declin,dt_avg,uniform_ real (SHR_KIND_R8),intent(in) :: lat ! Centered latitude (radians) real (SHR_KIND_R8),intent(in) :: lon ! Centered longitude (radians) real (SHR_KIND_R8),intent(in) :: declin ! Solar declination (radians) - real (SHR_KIND_R8),intent(in), optional :: dt_avg ! if present and set non-zero, then use in the - real (SHR_KIND_R8),intent(in), optional :: uniform_angle ! if present and true, apply uniform insolation - ! average cosz calculation - logical :: use_dt_avg !---------------------------------------------------------------------------- - if ( constant_zenith_angle_deg >= 0 ) then - shr_orb_cosz = cos( constant_zenith_angle_deg * SHR_CONST_PI/180. ) - return - end if - - if (present(uniform_angle)) then - shr_orb_cosz = cos(uniform_angle) - return - end if - ! perform the calculation of shr_orb_cosz - use_dt_avg = .false. - if (present(dt_avg)) then - if (dt_avg /= 0.0_shr_kind_r8) use_dt_avg = .true. - end if - ! If dt for the average cosz is specified, then call the shr_orb_avg_cosz - if (use_dt_avg) then - !shr_orb_cosz = shr_orb_avg_cosz(jday, lat, lon, declin, dt_avg) - write(*,*) 'shr_orb_cosz: shr_orb_avg_cosz not implemented' - shr_orb_cosz = -huge(0.0_SHR_KIND_R8) - else - shr_orb_cosz = sin(lat)*sin(declin) - cos(lat)*cos(declin) * & - cos((jday-floor(jday))*2.0_SHR_KIND_R8*pi + lon) - end if + shr_orb_cosz = sin(lat)*sin(declin) - cos(lat)*cos(declin) * & + cos((jday-floor(jday))*2.0_SHR_KIND_R8*pi + lon) END FUNCTION shr_orb_cosz From da7b2c6bc4c44b6ba6e05a597c622a5ec9104c76 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 27 Nov 2024 13:34:21 -0800 Subject: [PATCH 03/22] finish tests --- schemes/musica/musica_ccpp_util.F90 | 8 +++- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 53 ++++++++++++++-------- test/musica/CMakeLists.txt | 26 +++++++++++ test/musica/test_musica_api.F90 | 42 +++++++++++------ test/musica/test_musica_ccpp_util.F90 | 58 ++++++++++++++++++++++++ 5 files changed, 151 insertions(+), 36 deletions(-) create mode 100644 test/musica/test_musica_ccpp_util.F90 diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/musica_ccpp_util.F90 index 0e0ce274..8134ee01 100644 --- a/schemes/musica/musica_ccpp_util.F90 +++ b/schemes/musica/musica_ccpp_util.F90 @@ -2,11 +2,16 @@ ! SPDX-License-Identifier: Apache-2.0 module musica_ccpp_util + use ccpp_kinds, only: kind_phys + implicit none private public :: has_error_occurred, calculate_solar_zenith_angle_and_earth_sun_distance + real(kind_phys), parameter, public :: PI = 3.14159265358979323846_kind_phys + real(kind_phys), parameter, public :: DEGREE_TO_RADIAN = PI / 180.0_kind_phys + contains !> @brief Evaluate a MUSICA error for failure and convert to CCPP error data @@ -53,7 +58,6 @@ subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & errmsg, errcode) - use ccpp_kinds, only: kind_phys use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz use musica_util, only: error_t @@ -82,7 +86,7 @@ subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & ! Calculate solar zenith angle do i_sza = 1, size(solar_zenith_angle) - solar_zenith_angle(i_sza) = shr_orb_cosz(calendar_day, latitude(i_sza), longitude(i_sza), delta) + solar_zenith_angle(i_sza) = acos(shr_orb_cosz(calendar_day, latitude(i_sza), longitude(i_sza), delta)) end do end subroutine calculate_solar_zenith_angle_and_earth_sun_distance diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 245d3ead..9e68bc0b 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -13,6 +13,9 @@ module musica_ccpp_tuvx public :: tuvx_init, tuvx_run, tuvx_final + real(kind_phys), parameter :: MAX_SOLAR_ZENITH_ANGLE = 110.0_kind_phys ! degrees + real(kind_phys), parameter :: MIN_SOLAR_ZENITH_ANGLE = 0.0_kind_phys ! degrees + type(tuvx_t), pointer :: tuvx => null() type(grid_t), pointer :: height_grid => null() type(grid_t), pointer :: wavelength_grid => null() @@ -79,6 +82,7 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & use musica_tuvx, only: grid_map_t, profile_map_t, radiator_map_t use musica_util, only: error_t, configuration_t use musica_ccpp_namelist, only: filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_util, only: PI use musica_ccpp_tuvx_height_grid, & only: create_height_grid, height_grid_label, height_grid_unit use musica_ccpp_tuvx_wavelength_grid, & @@ -309,7 +313,7 @@ subroutine tuvx_run(temperature, dry_air_density, & use musica_util, only: error_t use musica_ccpp_tuvx_height_grid, only: set_height_grid_values, calculate_heights use musica_ccpp_tuvx_temperature, only: set_temperature_values - use musica_ccpp_util, only: has_error_occurred + use musica_ccpp_util, only: has_error_occurred, PI use musica_ccpp_tuvx_surface_albedo, only: set_surface_albedo_values use musica_ccpp_tuvx_extraterrestrial_flux, only: set_extraterrestrial_flux_values @@ -337,6 +341,7 @@ subroutine tuvx_run(temperature, dry_air_density, & number_of_photolysis_rate_constants) :: photolysis_rate_constants, & ! s-1 heating_rates ! K s-1 (TODO: check units) real(kind_phys) :: reciprocal_of_gravitational_acceleration ! s2 m-1 + real(kind_phys) :: solar_zenith_angle_degrees type(error_t) :: error integer :: i_col, i_level @@ -353,28 +358,36 @@ subroutine tuvx_run(temperature, dry_air_density, & if (errcode /= 0) return do i_col = 1, size(temperature, dim=1) - call calculate_heights( geopotential_height_wrt_surface_at_midpoint(i_col,:), & - geopotential_height_wrt_surface_at_interface(i_col,:), & - surface_geopotential(i_col), & - reciprocal_of_gravitational_acceleration, & - height_midpoints, height_interfaces ) - call set_height_grid_values( height_grid, height_midpoints, height_interfaces, & + + ! check if solar zenith angle is within the range to calculate photolysis rate constants + solar_zenith_angle_degrees = solar_zenith_angle(i_col) * 180.0_kind_phys / PI + if (solar_zenith_angle_degrees > MAX_SOLAR_ZENITH_ANGLE .or. & + solar_zenith_angle_degrees < MIN_SOLAR_ZENITH_ANGLE) then + photolysis_rate_constants(:,:) = 0.0_kind_phys + else + call calculate_heights( geopotential_height_wrt_surface_at_midpoint(i_col,:), & + geopotential_height_wrt_surface_at_interface(i_col,:), & + surface_geopotential(i_col), & + reciprocal_of_gravitational_acceleration, & + height_midpoints, height_interfaces ) + call set_height_grid_values( height_grid, height_midpoints, height_interfaces, & errmsg, errcode ) - if (errcode /= 0) return + if (errcode /= 0) return - call set_temperature_values( temperature_profile, temperature(i_col,:), & + call set_temperature_values( temperature_profile, temperature(i_col,:), & surface_temperature(i_col), errmsg, errcode ) - if (errcode /= 0) return - - ! calculate photolysis rate constants and heating rates - call tuvx%run( solar_zenith_angle(i_col), earth_sun_distance, & - photolysis_rate_constants(:,:), heating_rates(:,:), & - error ) - if (has_error_occurred( error, errmsg, errcode )) return - - ! filter out negative photolysis rate constants - photolysis_rate_constants(:,:) = & - max( photolysis_rate_constants(:,:), 0.0_kind_phys ) + if (errcode /= 0) return + + ! calculate photolysis rate constants and heating rates + call tuvx%run( solar_zenith_angle(i_col), earth_sun_distance, & + photolysis_rate_constants(:,:), heating_rates(:,:), & + error ) + if (has_error_occurred( error, errmsg, errcode )) return + + ! filter out negative photolysis rate constants + photolysis_rate_constants(:,:) = & + max( photolysis_rate_constants(:,:), 0.0_kind_phys ) + end if ! solar zenith angle check ! map photolysis rate constants to the host model's rate parameters and vertical grid do i_level = 1, size(rate_parameters, dim=2) diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index 72b95963..59ab6858 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -13,6 +13,32 @@ set(MUSICA_ENABLE_INSTALL OFF) FetchContent_MakeAvailable(musica) +# MUSICA utilities +add_executable(test_musica_ccpp_util test_musica_ccpp_util.F90) + +target_sources(test_musica_ccpp_util + PUBLIC + ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 +) + +target_link_libraries(test_musica_ccpp_util + PRIVATE + musica::musica-fortran +) + +set_target_properties(test_musica_ccpp_util + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_musica_ccpp_util + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + # --------------------------------------------------------- # Create a test for MUSICA CCPP wrapper # --------------------------------------------------------- diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 5145e4c4..d7f2f753 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -1,5 +1,6 @@ program run_test_musica_ccpp + use ccpp_kinds, only: kind_phys use musica_ccpp implicit none @@ -7,6 +8,8 @@ program run_test_musica_ccpp #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 + real(kind_phys), parameter :: DEGREE_TO_RADIAN = 3.14159265358979323846_kind_phys / 180.0_kind_phys + call test_chapman() call test_terminator() @@ -134,7 +137,6 @@ end subroutine get_wavelength_edges !> Tests the Chapman chemistry scheme subroutine test_chapman() use musica_micm, only: Rosenbrock, RosenbrockStandardOrder - use ccpp_kinds, only: kind_phys use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_micm, only: micm @@ -214,13 +216,14 @@ subroutine test_chapman() 1.3e13_kind_phys, 1.2e13_kind_phys, 1.1e13_kind_phys, 1.0e13_kind_phys /) ! Set conditions for one daytime and one nighttime column - latitude = (/ 0.0_kind_phys, 0.0_kind_phys /) - longitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + ! Greenwich, UK and Wellington, NZ + latitude = (/ 51.0_kind_phys, -41.0_kind_phys /) + longitude = (/ 0.0_kind_phys, 175.0_kind_phys /) earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 0.4091_kind_phys - perihelion_longitude = 4.71238898038469_kind_phys - moving_vernal_equinox_longitude = 4.71238898038469_kind_phys - calendar_day = 365.5_kind_phys ! noon GMT Dec. 31st + earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN + perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN + moving_vernal_equinox_longitude = 210.0_kind_phys * DEGREE_TO_RADIAN + calendar_day = 183.5_kind_phys ! noon GMT Jul 1 filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' @@ -353,6 +356,11 @@ subroutine test_chapman() ASSERT_NEAR(total_O, total_O_init, 1.0e-13) end do end do + do j = 1, NUM_LAYERS + ! O and O1D should be lower in the nighttime column + ASSERT(constituents(2,j,O_index) < constituents(1,j,O_index)) + ASSERT(constituents(2,j,O1D_index) < constituents(1,j,O1D_index)) + end do deallocate(constituent_props_ptr) @@ -361,7 +369,6 @@ end subroutine test_chapman !> Tests the simple Terminator chemistry scheme subroutine test_terminator() use musica_micm, only: Rosenbrock, RosenbrockStandardOrder - use ccpp_kinds, only: kind_phys use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_micm, only: micm @@ -441,13 +448,14 @@ subroutine test_terminator() 1.3e13_kind_phys, 1.2e13_kind_phys, 1.1e13_kind_phys, 1.0e13_kind_phys /) ! Set conditions for one daytime and one nighttime column - latitude = (/ 0.0_kind_phys, 0.0_kind_phys /) - longitude = (/ 0.0_kind_phys, 0.0_kind_phys /) + ! Greenwich, UK and Wellington, NZ + latitude = (/ 51.0_kind_phys, -41.0_kind_phys /) + longitude = (/ 0.0_kind_phys, 175.0_kind_phys /) earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 0.4091_kind_phys - perihelion_longitude = 4.71238898038469_kind_phys - moving_vernal_equinox_longitude = 4.71238898038469_kind_phys - calendar_day = 365.5_kind_phys ! noon GMT Dec. 31st + earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN + perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN + moving_vernal_equinox_longitude = 210.0_kind_phys * DEGREE_TO_RADIAN + calendar_day = 183.5_kind_phys ! noon GMT Jul 1 filename_of_micm_configuration = 'musica_configurations/terminator/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' @@ -562,6 +570,12 @@ subroutine test_terminator() ASSERT_NEAR(total_Cl, total_Cl_init, 1.0e-13) end do end do + do j = 1, NUM_LAYERS + ! Cl should be lower in the nighttime column + ASSERT(constituents(2,j,Cl_index) < constituents(1,j,Cl_index)) + ! Cl2 should be higher in the nighttime column + ASSERT(constituents(2,j,Cl2_index) > constituents(1,j,Cl2_index)) + end do deallocate(constituent_props_ptr) diff --git a/test/musica/test_musica_ccpp_util.F90 b/test/musica/test_musica_ccpp_util.F90 new file mode 100644 index 00000000..37e353f1 --- /dev/null +++ b/test/musica/test_musica_ccpp_util.F90 @@ -0,0 +1,58 @@ +! Copyright (C) 2024 National Science Foundation - National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +program test_musica_ccpp_util + + use ccpp_kinds, only: kind_phys + use musica_ccpp_util + + implicit none + +#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 + + call test_calculate_solar_zenith_angle_and_earth_sun_distance() + +contains + + subroutine test_calculate_solar_zenith_angle_and_earth_sun_distance() + use shr_orb_mod, only: shr_orb_decl + use musica_util, only: error_t + implicit none + + integer, parameter :: NUM_COLUMNS = 2 + real(kind_phys), dimension(NUM_COLUMNS) :: latitude + real(kind_phys), dimension(NUM_COLUMNS) :: longitude + real(kind_phys), dimension(NUM_COLUMNS) :: solar_zenith_angle + real(kind_phys) :: calendar_day + real(kind_phys) :: earth_eccentricity + real(kind_phys) :: earth_obliquity + real(kind_phys) :: perihelion_longitude + real(kind_phys) :: moving_vernal_equinox_longitude + real(kind_phys) :: earth_sun_distance + character(len=512) :: errmsg + integer :: errcode + + ! Greenwich, UK and Wellington, NZ (more or less) + latitude = (/ 51.5_kind_phys * DEGREE_TO_RADIAN, -41.3_kind_phys * DEGREE_TO_RADIAN /) + longitude = (/ 0.0_kind_phys * DEGREE_TO_RADIAN, 174.8_kind_phys * DEGREE_TO_RADIAN /) + calendar_day = 183.5_kind_phys ! noon GMT on July 1 + earth_eccentricity = 0.0167_kind_phys + earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN + perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN + moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN ! couldn't find a good value for this so I used what gave the correct SZA for Greenwich + + call calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & + latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & + moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & + errmsg, errcode) + + ! Check Earth-Sun distance is reasonable + ASSERT_NEAR( earth_sun_distance, 1.0, 0.05 ) + + ! Check solar zenith angles are reasonable (using approximate values from https://gml.noaa.gov/grad/solcalc/azel.html) + ASSERT_NEAR( solar_zenith_angle(1), 0.8792, 5.0 * DEGREE_TO_RADIAN ) ! noon GMT in Greenwich (light) + ASSERT( solar_zenith_angle(2) > 120.0 * DEGREE_TO_RADIAN ) ! noon GMT in Wellington (dark) + + end subroutine test_calculate_solar_zenith_angle_and_earth_sun_distance + +end program test_musica_ccpp_util \ No newline at end of file From 19a0cc2de1e37ed1a813d2795071e24ddd6d5bfc Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 27 Nov 2024 13:52:10 -0800 Subject: [PATCH 04/22] fix build script --- test/musica/tuvx/CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index 777cd6b0..c195bbb0 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -156,6 +156,8 @@ target_sources(test_tuvx_cloud_optics ${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 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) From 6538d52fe847950f1aa1c876f1f36309af772801 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 27 Nov 2024 14:04:49 -0800 Subject: [PATCH 05/22] formatting and test conditions --- schemes/musica/musica_ccpp.F90 | 4 ++-- test/musica/test_musica_api.F90 | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 5db298e7..0acb5441 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -75,9 +75,9 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, & number_of_photolysis_wavelength_grid_sections, & - photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & + photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, latitude, longitude, & + air_pressure_thickness, latitude, longitude, & earth_eccentricity, earth_obliquity, perihelion_longitude, & moving_vernal_equinox_longitude, calendar_day, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index f94a6a8b..1debe030 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -226,12 +226,12 @@ subroutine test_chapman() ! Set conditions for one daytime and one nighttime column ! Greenwich, UK and Wellington, NZ - latitude = (/ 51.0_kind_phys, -41.0_kind_phys /) - longitude = (/ 0.0_kind_phys, 175.0_kind_phys /) + latitude = (/ 51.5_kind_phys, -41.3_kind_phys /) + longitude = (/ 0.0_kind_phys, 174.8_kind_phys /) earth_eccentricity = 0.0167_kind_phys earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 210.0_kind_phys * DEGREE_TO_RADIAN + moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN calendar_day = 183.5_kind_phys ! noon GMT Jul 1 filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' @@ -487,12 +487,12 @@ subroutine test_terminator() ! Set conditions for one daytime and one nighttime column ! Greenwich, UK and Wellington, NZ - latitude = (/ 51.0_kind_phys, -41.0_kind_phys /) - longitude = (/ 0.0_kind_phys, 175.0_kind_phys /) + latitude = (/ 51.5_kind_phys, -41.3_kind_phys /) + longitude = (/ 0.0_kind_phys, 174.8_kind_phys /) earth_eccentricity = 0.0167_kind_phys earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 210.0_kind_phys * DEGREE_TO_RADIAN + moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN calendar_day = 183.5_kind_phys ! noon GMT Jul 1 filename_of_micm_configuration = 'musica_configurations/terminator/micm/config.json' From 47dc39803a211a3e99c43d17e1aa9ad94cf5342a Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 4 Dec 2024 14:44:56 -0800 Subject: [PATCH 06/22] address reviewer comments --- schemes/musica/musica_ccpp.F90 | 4 ++-- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 17 +++++++++-------- test/musica/test_musica_api.F90 | 16 ++++------------ 3 files changed, 15 insertions(+), 22 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 0acb5441..9ce8dad2 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -106,7 +106,6 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, level) real(kind_phys), intent(in) :: latitude(:) ! radians (column) real(kind_phys), intent(in) :: longitude(:) ! radians (column) - real(kind_phys), intent(in) :: earth_eccentricity ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) real(kind_phys), intent(in) :: earth_obliquity ! Earth's obliquity in radians real(kind_phys), intent(in) :: perihelion_longitude ! Earth's mean perihelion longitude at the vernal equinox (radians) @@ -140,9 +139,10 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & + cloud_area_fraction, & solar_zenith_angle, & earth_sun_distance, & - cloud_area_fraction, constituents, & + constituents, & air_pressure_thickness, rate_parameters, & errmsg, errcode) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index c564ec94..4d38b08a 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -419,8 +419,9 @@ subroutine tuvx_run(temperature, dry_air_density, & photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & + cloud_area_fraction, & solar_zenith_angle, earth_sun_distance, & - cloud_area_fraction, constituents, & + constituents, & air_pressure_thickness, rate_parameters, & errmsg, errcode) use musica_util, only: error_t @@ -442,9 +443,9 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 + real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! unitless (column, layer) real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians real(kind_phys), intent(in) :: earth_sun_distance ! m - real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! unitless (column, layer) real(kind_phys), intent(in) :: constituents(:,:,:) ! various (column, layer, constituent) real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, layer) real(kind_phys), intent(inout) :: rate_parameters(:,:,:) ! various units (column, layer, reaction) @@ -495,12 +496,12 @@ subroutine tuvx_run(temperature, dry_air_density, & surface_temperature(i_col), errmsg, errcode ) if (errcode /= 0) return - call set_cloud_optics_values( cloud_optics, cloud_area_fraction(i_col,:), & - air_pressure_thickness(i_col,:), & - constituents(i_col,:,index_cloud_liquid_water_content), & - reciprocal_of_gravitational_acceleration, & - errmsg, errcode ) - if (errcode /= 0) return + call set_cloud_optics_values( cloud_optics, cloud_area_fraction(i_col,:), & + air_pressure_thickness(i_col,:), & + constituents(i_col,:,index_cloud_liquid_water_content), & + reciprocal_of_gravitational_acceleration, & + errmsg, errcode ) + if (errcode /= 0) return ! calculate photolysis rate constants and heating rates call tuvx%run( solar_zenith_angle(i_col), earth_sun_distance, & diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 1debe030..a3dd427d 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -336,7 +336,8 @@ subroutine test_chapman() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, cloud_area_fraction, air_pressure_thickness, latitude, longitude, earth_eccentricity, & + standard_gravitational_acceleration, cloud_area_fraction, & + air_pressure_thickness, latitude, longitude, earth_eccentricity, & earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & calendar_day, errmsg, errcode ) if (errcode /= 0) then @@ -475,16 +476,6 @@ subroutine test_terminator() air_pressure_thickness(:,1) = (/ 900.0_kind_phys, 905.0_kind_phys /) air_pressure_thickness(:,2) = (/ 910.0_kind_phys, 915.0_kind_phys /) - ! Set conditions for one daytime and one nighttime column - ! Greenwich, UK and Wellington, NZ - latitude = (/ 51.0_kind_phys, -41.0_kind_phys /) - longitude = (/ 0.0_kind_phys, 175.0_kind_phys /) - earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN - perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 210.0_kind_phys * DEGREE_TO_RADIAN - calendar_day = 183.5_kind_phys ! noon GMT Jul 1 - ! Set conditions for one daytime and one nighttime column ! Greenwich, UK and Wellington, NZ latitude = (/ 51.5_kind_phys, -41.3_kind_phys /) @@ -585,7 +576,8 @@ subroutine test_terminator() geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & - standard_gravitational_acceleration, cloud_area_fraction, air_pressure_thickness, latitude, longitude, earth_eccentricity, & + standard_gravitational_acceleration, cloud_area_fraction, & + air_pressure_thickness, latitude, longitude, earth_eccentricity, & earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & calendar_day, errmsg, errcode ) if (errcode /= 0) then From d7220d6680940e3e9c62d027a321b8e2f895e760 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Tue, 10 Dec 2024 15:58:19 -0800 Subject: [PATCH 07/22] fix Dockerfile --- test/docker/Dockerfile.musica | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/docker/Dockerfile.musica b/test/docker/Dockerfile.musica index aa00a0da..f83ccdfb 100644 --- a/test/docker/Dockerfile.musica +++ b/test/docker/Dockerfile.musica @@ -87,7 +87,7 @@ ENV CCPP_STD_NAMES_PATH="lib/CCPPStandardNames" RUN cd atmospheric_physics/test \ && cmake -S . -B build \ - -D CMAKE_BUILD_TYPE={BUILD_TYPE} \ + -D CMAKE_BUILD_TYPE=${BUILD_TYPE} \ -D CCPP_ENABLE_MUSICA_TESTS=ON \ -D CCPP_ENABLE_MEMCHECK=ON \ && cmake --build ./build From 174190eb1f0ce1cf436ab3a14976fab763e3d1a5 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Tue, 10 Dec 2024 16:25:05 -0800 Subject: [PATCH 08/22] update to use solar zenith angle and earth-sun distance from host model --- schemes/musica/musica_ccpp.F90 | 23 ++--------- schemes/musica/musica_ccpp.meta | 38 ++---------------- schemes/musica/musica_ccpp_util.F90 | 51 +---------------------- test/musica/CMakeLists.txt | 26 ------------ test/musica/test_musica_api.F90 | 52 ++++++------------------ test/musica/test_musica_ccpp_util.F90 | 58 --------------------------- 6 files changed, 21 insertions(+), 227 deletions(-) delete mode 100644 test/musica/test_musica_ccpp_util.F90 diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 9ce8dad2..9a5871a1 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -77,14 +77,12 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co number_of_photolysis_wavelength_grid_sections, & photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, latitude, longitude, & - earth_eccentricity, earth_obliquity, perihelion_longitude, & - moving_vernal_equinox_longitude, calendar_day, errmsg, errcode) + air_pressure_thickness, solar_zenith_angle, & + earth_sun_distance, 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_util, only: calculate_solar_zenith_angle_and_earth_sun_distance real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K @@ -104,13 +102,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! unitless (column, level) real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, level) - real(kind_phys), intent(in) :: latitude(:) ! radians (column) - real(kind_phys), intent(in) :: longitude(:) ! radians (column) - real(kind_phys), intent(in) :: earth_eccentricity ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) - real(kind_phys), intent(in) :: earth_obliquity ! Earth's obliquity in radians - real(kind_phys), intent(in) :: perihelion_longitude ! Earth's mean perihelion longitude at the vernal equinox (radians) - real(kind_phys), intent(in) :: moving_vernal_equinox_longitude ! Earth's moving vernal equinox longitude of perihelion plus pi (radians) - real(kind_phys), intent(in) :: calendar_day ! fractional calendar day + real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians (column) + real(kind_phys), intent(in) :: earth_sun_distance ! AU character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -119,16 +112,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & number_of_rate_parameters) :: rate_parameters ! various units - real(kind_phys), dimension(size(latitude)) :: solar_zenith_angle ! radians - real(kind_phys) :: earth_sun_distance ! AU integer :: i_elem - ! Calculate solar zenith angle and Earth-Sun distance - call calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & - latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & - moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & - errmsg, errcode) - ! Calculate photolysis rate constants using TUV-x call tuvx_run(temperature, dry_air_density, & geopotential_height_wrt_surface_at_midpoint, & diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index bdb0102f..94c9d1b0 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -183,46 +183,16 @@ type = real | kind = kind_phys dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = in -[ latitude ] - standard_name = latitude +[ solar_zenith_angle ] + standard_name = solar_zenith_angle units = radians type = real | kind = kind_phys dimensions = (horizontal_loop_extent) intent = in -[ longitude ] - standard_name = longitude +[ earth_sun_distance ] + standard_name = earth_sun_distance units = radians type = real | kind = kind_phys - dimensions = (horizontal_loop_extent) - intent = in -[ earth_eccentricity ] - standard_name = eccentricity_factor - units = 1 - type = real | kind = kind_phys - dimensions = () - intent = in -[ earth_obliquity ] - standard_name = obliquity - units = radians - type = real | kind = kind_phys - dimensions = () - intent = in -[ perihelion_longitude ] - standard_name = mean_longitude_of_perihelion_at_vernal_equinox - units = radians - type = real | kind = kind_phys - dimensions = () - intent = in -[ moving_vernal_equinox_longitude ] - standard_name = moving_vernal_equinox_longitude_perihelion_plus_pi - units = radians - type = real | kind = kind_phys - dimensions = () - intent = in -[ calendar_day ] - standard_name = fractional_calendar_days_on_end_of_current_timestep - units = 1 - type = real | kind = kind_phys dimensions = () intent = in [ errmsg ] diff --git a/schemes/musica/musica_ccpp_util.F90 b/schemes/musica/musica_ccpp_util.F90 index 8134ee01..c87cce2f 100644 --- a/schemes/musica/musica_ccpp_util.F90 +++ b/schemes/musica/musica_ccpp_util.F90 @@ -7,7 +7,7 @@ module musica_ccpp_util implicit none private - public :: has_error_occurred, calculate_solar_zenith_angle_and_earth_sun_distance + public :: has_error_occurred real(kind_phys), parameter, public :: PI = 3.14159265358979323846_kind_phys real(kind_phys), parameter, public :: DEGREE_TO_RADIAN = PI / 180.0_kind_phys @@ -42,53 +42,4 @@ logical function has_error_occurred(error, error_message, error_code) end function has_error_occurred - !> Calculate the solar zenith angle and Earth-Sun distance - !> @param[in] calendar_day Calendar day, including fraction - !> @param[in] latitude Latitude in radians - !> @param[in] longitude Longitude in radians - !> @param[in] earth_eccentricity Earth's eccentricity factor (unitless) - !> @param[in] earth_obliquity Earth's obliquity in radians - !> @param[in] perihelion_longitude Earth's mean perihelion longitude at the vernal equinox (radians) - !> @param[in] moving_vernal_equinox_longitude Earth's moving vernal equinox longitude of perihelion plus pi (radians) - !> @param[out] solar_zenith_angle Solar zenith angle in radians - !> @param[out] earth_sun_distance Earth-Sun distance in AU - !> @param[out] errmsg Error message - !> @param[out] errcode Error code - subroutine calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & - latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & - moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & - errmsg, errcode) - use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz - use musica_util, only: error_t - - real(kind_phys), intent(in) :: calendar_day - real(kind_phys), intent(in) :: latitude(:) - real(kind_phys), intent(in) :: longitude(:) - real(kind_phys), intent(in) :: earth_eccentricity - real(kind_phys), intent(in) :: earth_obliquity - real(kind_phys), intent(in) :: perihelion_longitude - real(kind_phys), intent(in) :: moving_vernal_equinox_longitude - real(kind_phys), intent(out) :: solar_zenith_angle(:) - real(kind_phys), intent(out) :: earth_sun_distance - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode - - real(kind_phys) :: delta - integer :: i_sza - - errcode = 0 - errmsg = '' - - ! Calculate earth/orbit parameters - call shr_orb_decl(calendar_day, earth_eccentricity, earth_obliquity, & - perihelion_longitude, moving_vernal_equinox_longitude, & - delta, earth_sun_distance) - - ! Calculate solar zenith angle - do i_sza = 1, size(solar_zenith_angle) - solar_zenith_angle(i_sza) = acos(shr_orb_cosz(calendar_day, latitude(i_sza), longitude(i_sza), delta)) - end do - - end subroutine calculate_solar_zenith_angle_and_earth_sun_distance - end module musica_ccpp_util diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index fc9483a3..c907fb74 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -13,32 +13,6 @@ set(MUSICA_ENABLE_INSTALL OFF) FetchContent_MakeAvailable(musica) -# MUSICA utilities -add_executable(test_musica_ccpp_util test_musica_ccpp_util.F90) - -target_sources(test_musica_ccpp_util - PUBLIC - ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 - ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 -) - -target_link_libraries(test_musica_ccpp_util - PRIVATE - musica::musica-fortran -) - -set_target_properties(test_musica_ccpp_util - PROPERTIES - LINKER_LANGUAGE Fortran -) - -add_test( - NAME test_musica_ccpp_util - COMMAND $ - WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} -) - # --------------------------------------------------------- # Create a test for MUSICA CCPP wrapper # --------------------------------------------------------- diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index a3dd427d..2393a303 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -164,8 +164,6 @@ subroutine test_chapman() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m real(kind_phys), dimension(NUM_COLUMNS) :: surface_geopotential ! m2 s-2 real(kind_phys), dimension(NUM_COLUMNS) :: surface_temperature ! K - real(kind_phys), dimension(NUM_COLUMNS) :: latitude ! radians - real(kind_phys), dimension(NUM_COLUMNS) :: longitude ! radians real(kind_phys) :: surface_albedo ! unitless integer, parameter :: num_photolysis_wavelength_grid_sections = 8 ! (count) real(kind_phys), dimension(num_photolysis_wavelength_grid_sections+1) :: flux_data_photolysis_wavelength_interfaces ! nm @@ -180,6 +178,8 @@ subroutine test_chapman() NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: constituents ! kg kg-1 real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: initial_constituents ! kg kg-1 + real(kind_phys), dimension(NUM_COLUMNS) :: solar_zenith_angle ! radians + real(kind_phys) :: earth_sun_distance ! AU 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 @@ -190,11 +190,6 @@ subroutine test_chapman() integer :: i, j, k integer :: N2_index, O2_index, O_index, O1D_index, O3_index real(kind_phys) :: total_O, total_O_init - real(kind_phys) :: earth_eccentricity - real(kind_phys) :: earth_obliquity - real(kind_phys) :: perihelion_longitude - real(kind_phys) :: moving_vernal_equinox_longitude - real(kind_phys) :: calendar_day call get_wavelength_edges(photolysis_wavelength_grid_interfaces) solver_type = Rosenbrock @@ -223,16 +218,8 @@ subroutine test_chapman() cloud_area_fraction(:,2) = (/ 0.3_kind_phys, 0.4_kind_phys /) air_pressure_thickness(:,1) = (/ 900.0_kind_phys, 905.0_kind_phys /) air_pressure_thickness(:,2) = (/ 910.0_kind_phys, 915.0_kind_phys /) - - ! Set conditions for one daytime and one nighttime column - ! Greenwich, UK and Wellington, NZ - latitude = (/ 51.5_kind_phys, -41.3_kind_phys /) - longitude = (/ 0.0_kind_phys, 174.8_kind_phys /) - earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN - perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN - calendar_day = 183.5_kind_phys ! noon GMT Jul 1 + solar_zenith_angle = (/ 0.0_kind_phys, 2.1_kind_phys /) + earth_sun_distance = 1.04_kind_phys filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' @@ -337,9 +324,8 @@ subroutine test_chapman() surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, latitude, longitude, earth_eccentricity, & - earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & - calendar_day, errmsg, errcode ) + air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & + errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -416,8 +402,6 @@ subroutine test_terminator() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m real(kind_phys), dimension(NUM_COLUMNS) :: surface_geopotential ! m2 s-2 real(kind_phys), dimension(NUM_COLUMNS) :: surface_temperature ! K - real(kind_phys), dimension(NUM_COLUMNS) :: latitude ! radians - real(kind_phys), dimension(NUM_COLUMNS) :: longitude ! radians real(kind_phys) :: surface_albedo ! unitless integer, parameter :: num_photolysis_wavelength_grid_sections = 8 ! (count) real(kind_phys), dimension(num_photolysis_wavelength_grid_sections+1) :: flux_data_photolysis_wavelength_interfaces ! nm @@ -432,6 +416,8 @@ subroutine test_terminator() NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: constituents ! kg kg-1 real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: initial_constituents ! kg kg-1 + real(kind_phys), dimension(NUM_COLUMNS) :: solar_zenith_angle ! radians + real(kind_phys) :: earth_sun_distance ! AU 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 @@ -442,11 +428,6 @@ subroutine test_terminator() integer :: i, j, k integer :: Cl_index, Cl2_index real(kind_phys) :: total_Cl, total_Cl_init - real(kind_phys) :: earth_eccentricity - real(kind_phys) :: earth_obliquity - real(kind_phys) :: perihelion_longitude - real(kind_phys) :: moving_vernal_equinox_longitude - real(kind_phys) :: calendar_day call get_wavelength_edges(photolysis_wavelength_grid_interfaces) solver_type = Rosenbrock @@ -475,16 +456,8 @@ subroutine test_terminator() cloud_area_fraction(:,2) = (/ 0.3_kind_phys, 0.4_kind_phys /) air_pressure_thickness(:,1) = (/ 900.0_kind_phys, 905.0_kind_phys /) air_pressure_thickness(:,2) = (/ 910.0_kind_phys, 915.0_kind_phys /) - - ! Set conditions for one daytime and one nighttime column - ! Greenwich, UK and Wellington, NZ - latitude = (/ 51.5_kind_phys, -41.3_kind_phys /) - longitude = (/ 0.0_kind_phys, 174.8_kind_phys /) - earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN - perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN - calendar_day = 183.5_kind_phys ! noon GMT Jul 1 + solar_zenith_angle = (/ 0.0_kind_phys, 2.1_kind_phys /) + earth_sun_distance = 1.04_kind_phys filename_of_micm_configuration = 'musica_configurations/terminator/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' @@ -577,9 +550,8 @@ subroutine test_terminator() surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & - air_pressure_thickness, latitude, longitude, earth_eccentricity, & - earth_obliquity, perihelion_longitude, moving_vernal_equinox_longitude, & - calendar_day, errmsg, errcode ) + air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & + errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 diff --git a/test/musica/test_musica_ccpp_util.F90 b/test/musica/test_musica_ccpp_util.F90 deleted file mode 100644 index 37e353f1..00000000 --- a/test/musica/test_musica_ccpp_util.F90 +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (C) 2024 National Science Foundation - National Center for Atmospheric Research -! SPDX-License-Identifier: Apache-2.0 -program test_musica_ccpp_util - - use ccpp_kinds, only: kind_phys - use musica_ccpp_util - - implicit none - -#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 - - call test_calculate_solar_zenith_angle_and_earth_sun_distance() - -contains - - subroutine test_calculate_solar_zenith_angle_and_earth_sun_distance() - use shr_orb_mod, only: shr_orb_decl - use musica_util, only: error_t - implicit none - - integer, parameter :: NUM_COLUMNS = 2 - real(kind_phys), dimension(NUM_COLUMNS) :: latitude - real(kind_phys), dimension(NUM_COLUMNS) :: longitude - real(kind_phys), dimension(NUM_COLUMNS) :: solar_zenith_angle - real(kind_phys) :: calendar_day - real(kind_phys) :: earth_eccentricity - real(kind_phys) :: earth_obliquity - real(kind_phys) :: perihelion_longitude - real(kind_phys) :: moving_vernal_equinox_longitude - real(kind_phys) :: earth_sun_distance - character(len=512) :: errmsg - integer :: errcode - - ! Greenwich, UK and Wellington, NZ (more or less) - latitude = (/ 51.5_kind_phys * DEGREE_TO_RADIAN, -41.3_kind_phys * DEGREE_TO_RADIAN /) - longitude = (/ 0.0_kind_phys * DEGREE_TO_RADIAN, 174.8_kind_phys * DEGREE_TO_RADIAN /) - calendar_day = 183.5_kind_phys ! noon GMT on July 1 - earth_eccentricity = 0.0167_kind_phys - earth_obliquity = 23.5_kind_phys * DEGREE_TO_RADIAN - perihelion_longitude = 102.9_kind_phys * DEGREE_TO_RADIAN - moving_vernal_equinox_longitude = 182.7_kind_phys * DEGREE_TO_RADIAN ! couldn't find a good value for this so I used what gave the correct SZA for Greenwich - - call calculate_solar_zenith_angle_and_earth_sun_distance(calendar_day, & - latitude, longitude, earth_eccentricity, earth_obliquity, perihelion_longitude, & - moving_vernal_equinox_longitude, solar_zenith_angle, earth_sun_distance, & - errmsg, errcode) - - ! Check Earth-Sun distance is reasonable - ASSERT_NEAR( earth_sun_distance, 1.0, 0.05 ) - - ! Check solar zenith angles are reasonable (using approximate values from https://gml.noaa.gov/grad/solcalc/azel.html) - ASSERT_NEAR( solar_zenith_angle(1), 0.8792, 5.0 * DEGREE_TO_RADIAN ) ! noon GMT in Greenwich (light) - ASSERT( solar_zenith_angle(2) > 120.0 * DEGREE_TO_RADIAN ) ! noon GMT in Wellington (dark) - - end subroutine test_calculate_solar_zenith_angle_and_earth_sun_distance - -end program test_musica_ccpp_util \ No newline at end of file From 8c1a7ced50a61e46e7b3400a3d375712aeec2282 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 09:47:46 -0800 Subject: [PATCH 09/22] remove shr_orb_mod --- test/musica/CMakeLists.txt | 1 - test/musica/tuvx/CMakeLists.txt | 6 -- to_be_ccppized/shr_orb_mod.F90 | 141 -------------------------------- 3 files changed, 148 deletions(-) delete mode 100644 to_be_ccppized/shr_orb_mod.F90 diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index c907fb74..0d187cf4 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -30,7 +30,6 @@ target_sources(test_musica_api ${MUSICA_CCPP_SOURCES} ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 ${CCPP_SRC_PATH}/ccpp_hash_table.F90 ${CCPP_SRC_PATH}/ccpp_hashable.F90 diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index c195bbb0..10024759 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -6,7 +6,6 @@ target_sources(test_tuvx_height_grid ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_height_grid.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_height_grid @@ -35,7 +34,6 @@ target_sources(test_tuvx_wavelength_grid ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_wavelength_grid @@ -65,7 +63,6 @@ target_sources(test_tuvx_temperature ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_temperature.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_temperature @@ -95,7 +92,6 @@ target_sources(test_tuvx_surface_albedo ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_surface_albedo.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ) target_link_libraries(test_tuvx_surface_albedo @@ -125,7 +121,6 @@ target_sources(test_tuvx_extraterrestrial_flux ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) @@ -157,7 +152,6 @@ target_sources(test_tuvx_cloud_optics ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_cloud_optics.F90 ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 - ${TO_BE_CCPPIZED_SRC_PATH}/shr_orb_mod.F90 ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 ) diff --git a/to_be_ccppized/shr_orb_mod.F90 b/to_be_ccppized/shr_orb_mod.F90 deleted file mode 100644 index 4ae7329d..00000000 --- a/to_be_ccppized/shr_orb_mod.F90 +++ /dev/null @@ -1,141 +0,0 @@ -! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research -! SPDX-License-Identifier: Apache-2.0 -module shr_orb_mod - - use ccpp_kinds, only: kind_phys - - implicit none - - private - public :: shr_orb_decl, shr_orb_cosz - - ! This module contains the routines for computing the solar zenith angle and - ! Earth-Sun distance from https://github.com/ESCOMP/CESM_share - ! - ! This is a temporary module that will be replaced when a solution for - ! providing information calculated from CESM shared code is implemented for - ! CAM-SIMA. - ! - ! Code is included in the form present in ESCOMP/CESM_share. - - ! Dependencies from other parts of the shared code - integer, parameter :: SHR_KIND_R8 = kind_phys - real(SHR_KIND_R8), parameter :: pi = 3.14159265358979323846_SHR_KIND_R8 ! pi - -contains - - !======================================================================= - - SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) - - !------------------------------------------------------------------------------- - ! - ! Compute earth/orbit parameters using formula suggested by - ! Duane Thresher. - ! - !---------------------------Code history---------------------------------------- - ! - ! Original version: Erik Kluzek - ! Date: Oct/1997 - ! - !------------------------------------------------------------------------------- - - !------------------------------Arguments-------------------------------- - real (SHR_KIND_R8),intent(in) :: calday ! Calendar day, including fraction - real (SHR_KIND_R8),intent(in) :: eccen ! Eccentricity - real (SHR_KIND_R8),intent(in) :: obliqr ! Earths obliquity in radians - real (SHR_KIND_R8),intent(in) :: lambm0 ! Mean long of perihelion at the - ! vernal equinox (radians) - real (SHR_KIND_R8),intent(in) :: mvelpp ! moving vernal equinox longitude - ! of perihelion plus pi (radians) - real (SHR_KIND_R8),intent(out) :: delta ! Solar declination angle in rad - real (SHR_KIND_R8),intent(out) :: eccf ! Earth-sun distance factor (ie. (1/r)**2) - - !---------------------------Local variables----------------------------- - real (SHR_KIND_R8),parameter :: dayspy = 365.0_SHR_KIND_R8 ! days per year - real (SHR_KIND_R8),parameter :: ve = 80.5_SHR_KIND_R8 ! Calday of vernal equinox - ! assumes Jan 1 = calday 1 - - real (SHR_KIND_R8) :: lambm ! Lambda m, mean long of perihelion (rad) - real (SHR_KIND_R8) :: lmm ! Intermediate argument involving lambm - real (SHR_KIND_R8) :: lamb ! Lambda, the earths long of perihelion - real (SHR_KIND_R8) :: invrho ! Inverse normalized sun/earth distance - real (SHR_KIND_R8) :: sinl ! Sine of lmm - - ! Compute eccentricity factor and solar declination using - ! day value where a round day (such as 213.0) refers to 0z at - ! Greenwich longitude. - ! - ! Use formulas from Berger, Andre 1978: Long-Term Variations of Daily - ! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci. - ! 35:2362-2367. - ! - ! To get the earths true longitude (position in orbit; lambda in Berger - ! 1978) which is necessary to find the eccentricity factor and declination, - ! must first calculate the mean longitude (lambda m in Berger 1978) at - ! the present day. This is done by adding to lambm0 (the mean longitude - ! at the vernal equinox, set as March 21 at noon, when lambda=0; in radians) - ! an increment (delta lambda m in Berger 1978) that is the number of - ! days past or before (a negative increment) the vernal equinox divided by - ! the days in a model year times the 2*pi radians in a complete orbit. - - lambm = lambm0 + (calday - ve)*2._SHR_KIND_R8*pi/dayspy - lmm = lambm - mvelpp - - ! The earths true longitude, in radians, is then found from - ! the formula in Berger 1978: - - sinl = sin(lmm) - lamb = lambm + eccen*(2._SHR_KIND_R8*sinl + eccen*(1.25_SHR_KIND_R8*sin(2._SHR_KIND_R8*lmm) & - & + eccen*((13.0_SHR_KIND_R8/12.0_SHR_KIND_R8)*sin(3._SHR_KIND_R8*lmm) - 0.25_SHR_KIND_R8*sinl))) - - ! Using the obliquity, eccentricity, moving vernal equinox longitude of - ! perihelion (plus), and earths true longitude, the declination (delta) - ! and the normalized earth/sun distance (rho in Berger 1978; actually inverse - ! rho will be used), and thus the eccentricity factor (eccf), can be - ! calculated from formulas given in Berger 1978. - - invrho = (1._SHR_KIND_R8 + eccen*cos(lamb - mvelpp)) / (1._SHR_KIND_R8 - eccen*eccen) - - ! Set solar declination and eccentricity factor - - delta = asin(sin(obliqr)*sin(lamb)) - eccf = invrho*invrho - - return - - END SUBROUTINE shr_orb_decl - - !======================================================================= - - real(SHR_KIND_R8) pure FUNCTION shr_orb_cosz(jday,lat,lon,declin) - - !---------------------------------------------------------------------------- - ! - ! FUNCTION to return the cosine of the solar zenith angle. - ! Assumes 365.0 days/year. - ! - !--------------- Code History ----------------------------------------------- - ! - ! Original Author: Brian Kauffman - ! Date: Jan/98 - ! History: adapted from statement FUNCTION in share/orb_cosz.h - ! - !---------------------------------------------------------------------------- - - real (SHR_KIND_R8),intent(in) :: jday ! Julian cal day (1.xx to 365.xx) - real (SHR_KIND_R8),intent(in) :: lat ! Centered latitude (radians) - real (SHR_KIND_R8),intent(in) :: lon ! Centered longitude (radians) - real (SHR_KIND_R8),intent(in) :: declin ! Solar declination (radians) - - !---------------------------------------------------------------------------- - - ! perform the calculation of shr_orb_cosz - shr_orb_cosz = sin(lat)*sin(declin) - cos(lat)*cos(declin) * & - cos((jday-floor(jday))*2.0_SHR_KIND_R8*pi + lon) - - END FUNCTION shr_orb_cosz - - !======================================================================= - -end module shr_orb_mod \ No newline at end of file From 2a87a0c81d98b5be67cd1070fe8e33f21987b868 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 12:48:12 -0800 Subject: [PATCH 10/22] update musica namelist parameters --- schemes/musica/musica_ccpp.F90 | 12 ++++++++---- schemes/musica/musica_ccpp.meta | 10 +++++----- schemes/musica/musica_ccpp_namelist.xml | 22 +++++++++++++--------- test/musica/musica_ccpp_namelist.F90 | 3 ++- test/musica/test_musica_api.F90 | 10 ++-------- 5 files changed, 30 insertions(+), 27 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 9a5871a1..1fb99c24 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -14,18 +14,22 @@ module musica_ccpp !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html - subroutine musica_ccpp_register(micm_solver_type, number_of_grid_cells, & - constituent_props, errmsg, errcode) + subroutine musica_ccpp_register(horizontal_loop_extent, & + vertical_layer_dimension, constituent_props, errmsg, & + errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_namelist, only: micm_solver_type - integer, intent(in) :: micm_solver_type - integer, intent(in) :: number_of_grid_cells + integer, intent(in) :: horizontal_loop_extent + integer, intent(in) :: vertical_layer_dimension type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) + integer :: number_of_grid_cells + number_of_grid_cells = horizontal_loop_extent * vertical_layer_dimension call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, & errmsg, errcode) if (errcode /= 0) return diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 94c9d1b0..807ac20d 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -6,14 +6,14 @@ [ccpp-arg-table] name = musica_ccpp_register type = scheme -[ micm_solver_type ] - standard_name = micm_solver_type - units = none +[ horizontal_loop_extent ] + standard_name = horizontal_loop_extent + units = count type = integer dimensions = () intent = in -[ number_of_grid_cells ] - standard_name = number_of_grid_cells +[ vertical_layer_dimension ] + standard_name = vertical_layer_dimension units = count type = integer dimensions = () diff --git a/schemes/musica/musica_ccpp_namelist.xml b/schemes/musica/musica_ccpp_namelist.xml index 31999ef2..c36d1b81 100644 --- a/schemes/musica/musica_ccpp_namelist.xml +++ b/schemes/musica/musica_ccpp_namelist.xml @@ -75,16 +75,20 @@ units This is the CCPP unit specification of the variable (e.g., m s-1). --> -
- - integer - - - integer - -
- + + integer + musica_ccpp + musica_ccpp + micm_solver_type + none + + The type of MICM solver to use. + + + 1 + + char*512 musica_ccpp diff --git a/test/musica/musica_ccpp_namelist.F90 b/test/musica/musica_ccpp_namelist.F90 index d27cc754..0dcf3170 100644 --- a/test/musica/musica_ccpp_namelist.F90 +++ b/test/musica/musica_ccpp_namelist.F90 @@ -4,7 +4,8 @@ module musica_ccpp_namelist implicit none private - + + integer, public :: micm_solver_type = 1 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 2393a303..99b95892 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -136,7 +136,6 @@ end subroutine get_wavelength_edges !> Tests the Chapman chemistry scheme subroutine test_chapman() - use musica_micm, only: Rosenbrock, RosenbrockStandardOrder use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_micm, only: micm @@ -155,7 +154,6 @@ subroutine test_chapman() integer, parameter :: NUM_LAYERS = 2 integer, parameter :: NUM_WAVELENGTH_BINS = 102 integer :: NUM_GRID_CELLS = NUM_COLUMNS * NUM_LAYERS - integer :: solver_type = Rosenbrock integer :: errcode character(len=512) :: errmsg real(kind_phys) :: time_step = 60._kind_phys ! s @@ -192,7 +190,6 @@ subroutine test_chapman() real(kind_phys) :: total_O, total_O_init call get_wavelength_edges(photolysis_wavelength_grid_interfaces) - solver_type = Rosenbrock time_step = 60._kind_phys geopotential_height_wrt_surface_at_midpoint(1,:) = (/ 2000.0_kind_phys, 500.0_kind_phys /) geopotential_height_wrt_surface_at_midpoint(2,:) = (/ 2000.0_kind_phys, -500.0_kind_phys /) @@ -225,7 +222,7 @@ subroutine test_chapman() filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/chapman/tuvx_micm_mapping.json' - call musica_ccpp_register(solver_type, NUM_GRID_CELLS, constituent_props, errmsg, errcode) + call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -374,7 +371,6 @@ end subroutine test_chapman !> Tests the simple Terminator chemistry scheme subroutine test_terminator() - use musica_micm, only: Rosenbrock, RosenbrockStandardOrder use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_micm, only: micm @@ -393,7 +389,6 @@ subroutine test_terminator() integer, parameter :: NUM_LAYERS = 2 integer, parameter :: NUM_WAVELENGTH_BINS = 102 integer :: NUM_GRID_CELLS = NUM_COLUMNS * NUM_LAYERS - integer :: solver_type = Rosenbrock integer :: errcode character(len=512) :: errmsg real(kind_phys) :: time_step = 60._kind_phys ! s @@ -430,7 +425,6 @@ subroutine test_terminator() real(kind_phys) :: total_Cl, total_Cl_init call get_wavelength_edges(photolysis_wavelength_grid_interfaces) - solver_type = Rosenbrock time_step = 60._kind_phys geopotential_height_wrt_surface_at_midpoint(1,:) = (/ 2000.0_kind_phys, 500.0_kind_phys /) geopotential_height_wrt_surface_at_midpoint(2,:) = (/ 2000.0_kind_phys, -500.0_kind_phys /) @@ -463,7 +457,7 @@ subroutine test_terminator() filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/terminator/tuvx_micm_mapping.json' - call musica_ccpp_register(solver_type, NUM_GRID_CELLS, constituent_props, errmsg, errcode) + call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 From cbc590a6b23ea7937256482561fff0e9f7c6745c Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 13:40:41 -0800 Subject: [PATCH 11/22] recreate micm solver at init --- schemes/musica/micm/musica_ccpp_micm.F90 | 4 ++++ schemes/musica/musica_ccpp.F90 | 26 +++++++++++++++++------- schemes/musica/musica_ccpp.meta | 18 ++++++---------- test/musica/test_musica_api.F90 | 8 ++++---- 4 files changed, 33 insertions(+), 23 deletions(-) diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index d2c6044d..c2e40d95 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -38,6 +38,10 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & logical :: is_advected integer :: i, species_index + 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 (has_error_occurred(error, errmsg, errcode)) return diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 1fb99c24..36d79663 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -14,14 +14,11 @@ module musica_ccpp !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html - subroutine musica_ccpp_register(horizontal_loop_extent, & - vertical_layer_dimension, constituent_props, errmsg, & + 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 - integer, intent(in) :: horizontal_loop_extent - integer, intent(in) :: vertical_layer_dimension type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -29,7 +26,11 @@ subroutine musica_ccpp_register(horizontal_loop_extent, & type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) integer :: number_of_grid_cells - number_of_grid_cells = horizontal_loop_extent * vertical_layer_dimension + ! 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 know 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, & errmsg, errcode) if (errcode /= 0) return @@ -44,13 +45,16 @@ end subroutine musica_ccpp_register !> \section arg_table_musica_ccpp_init Argument Table !! \htmlinclude musica_ccpp_init.html - subroutine musica_ccpp_init(vertical_layer_dimension, vertical_interface_dimension, & + subroutine musica_ccpp_init(horizontal_loop_extent, vertical_layer_dimension, & + vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & constituent_props, errmsg, errcode) - use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t, ccpp_constituent_prop_ptr_t use ccpp_kinds, only : kind_phys use musica_ccpp_micm, only: micm + use musica_ccpp_namelist, only: micm_solver_type use musica_ccpp_util, only: has_error_occurred + integer, intent(in) :: horizontal_loop_extent ! (count) integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m @@ -58,6 +62,14 @@ subroutine musica_ccpp_init(vertical_layer_dimension, vertical_interface_dimensi character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + integer :: number_of_grid_cells + type(ccpp_constituent_properties_t), allocatable :: micm_species_props(:) + + ! 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_loop_extent * vertical_layer_dimension + call micm_register(micm_solver_type, number_of_grid_cells, micm_species_props, errmsg, errcode) call micm_init(errmsg, errcode) if (errcode /= 0) return call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 807ac20d..3d9ef96c 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -6,18 +6,6 @@ [ccpp-arg-table] name = musica_ccpp_register type = scheme -[ horizontal_loop_extent ] - standard_name = horizontal_loop_extent - units = count - type = integer - dimensions = () - intent = in -[ vertical_layer_dimension ] - standard_name = vertical_layer_dimension - units = count - type = integer - dimensions = () - intent = in [ constituent_props ] standard_name = dynamic_constituents_for_musica_ccpp units = none @@ -41,6 +29,12 @@ [ccpp-arg-table] name = musica_ccpp_init type = scheme +[ horizontal_loop_extent ] + standard_name = horizontal_loop_extent + units = count + type = integer + dimensions = () + intent = in [ vertical_layer_dimension ] standard_name = vertical_layer_dimension units = none diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 99b95892..ef567e95 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -222,7 +222,7 @@ subroutine test_chapman() filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/chapman/tuvx_micm_mapping.json' - call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) + call musica_ccpp_register(constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -264,7 +264,7 @@ subroutine test_chapman() call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) end do - call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & + call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & constituent_props_ptr, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) @@ -457,7 +457,7 @@ subroutine test_terminator() filename_of_tuvx_configuration = 'musica_configurations/terminator/tuvx/config.json' filename_of_tuvx_micm_mapping_configuration = 'musica_configurations/terminator/tuvx_micm_mapping.json' - call musica_ccpp_register(NUM_COLUMNS, NUM_LAYERS, constituent_props, errmsg, errcode) + call musica_ccpp_register(constituent_props, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -496,7 +496,7 @@ subroutine test_terminator() call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) end do - call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & + call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & constituent_props_ptr, errmsg, errcode) if (errcode /= 0) then write(*,*) trim(errmsg) From f797cc16a05864bd95212b88a6b8f8e651340ed0 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 16:02:41 -0800 Subject: [PATCH 12/22] update horizontal loop argument --- schemes/musica/musica_ccpp.F90 | 6 +++--- schemes/musica/musica_ccpp.meta | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 36d79663..117fc8b3 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -45,7 +45,7 @@ end subroutine musica_ccpp_register !> \section arg_table_musica_ccpp_init Argument Table !! \htmlinclude musica_ccpp_init.html - subroutine musica_ccpp_init(horizontal_loop_extent, vertical_layer_dimension, & + subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & constituent_props, errmsg, errcode) @@ -54,7 +54,7 @@ subroutine musica_ccpp_init(horizontal_loop_extent, vertical_layer_dimension, & use musica_ccpp_micm, only: micm use musica_ccpp_namelist, only: micm_solver_type use musica_ccpp_util, only: has_error_occurred - integer, intent(in) :: horizontal_loop_extent ! (count) + integer, intent(in) :: horizontal_dimension ! (count) integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m @@ -68,7 +68,7 @@ subroutine musica_ccpp_init(horizontal_loop_extent, vertical_layer_dimension, & ! 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_loop_extent * vertical_layer_dimension + number_of_grid_cells = horizontal_dimension * vertical_layer_dimension call micm_register(micm_solver_type, number_of_grid_cells, micm_species_props, errmsg, errcode) call micm_init(errmsg, errcode) if (errcode /= 0) return diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 3d9ef96c..ffdb707d 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -29,8 +29,8 @@ [ccpp-arg-table] name = musica_ccpp_init type = scheme -[ horizontal_loop_extent ] - standard_name = horizontal_loop_extent +[ horizontal_dimension ] + standard_name = horizontal_dimension units = count type = integer dimensions = () From 39da1388a13afbfc42224ffa41ebe1bf207054fe Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 16:06:59 -0800 Subject: [PATCH 13/22] update meta data --- schemes/musica/musica_ccpp.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index ffdb707d..c8364ccc 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -37,13 +37,13 @@ intent = in [ vertical_layer_dimension ] standard_name = vertical_layer_dimension - units = none + units = count type = integer dimensions = () intent = in [ vertical_interface_dimension ] standard_name = vertical_interface_dimension - units = none + units = count type = integer dimensions = () intent = in From e3c190e7afc1d7799bc33b1a8956082bf294a916 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Wed, 11 Dec 2024 16:58:05 -0800 Subject: [PATCH 14/22] create musica dependencies module --- schemes/musica/musica_ccpp.F90 | 3 - schemes/musica/musica_ccpp.meta | 10 +- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 3 - ...musica_ccpp_tuvx_extraterrestrial_flux.F90 | 7 +- test/musica/test_musica_api.F90 | 4 +- .../tuvx/test_tuvx_extraterrestrial_flux.F90 | 3 +- to_be_ccppized/musica_dependencies.F90 | 224 ++++++++++++++++++ to_be_ccppized/musica_dependencies.meta | 37 +++ 8 files changed, 269 insertions(+), 22 deletions(-) create mode 100644 to_be_ccppized/musica_dependencies.F90 create mode 100644 to_be_ccppized/musica_dependencies.meta diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 117fc8b3..8d460ba2 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -90,7 +90,6 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co constituents, geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, surface_geopotential, & surface_temperature, surface_albedo, & - number_of_photolysis_wavelength_grid_sections, & photolysis_wavelength_grid_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & air_pressure_thickness, solar_zenith_angle, & @@ -112,7 +111,6 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co real(kind_phys), intent(in) :: surface_geopotential(:) ! m2 s-2 real(kind_phys), intent(in) :: surface_temperature(:) ! K real(kind_phys), intent(in) :: surface_albedo ! unitless - integer, intent(in) :: number_of_photolysis_wavelength_grid_sections ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 @@ -136,7 +134,6 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & surface_albedo, & - number_of_photolysis_wavelength_grid_sections, & photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index c8364ccc..72a47743 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -141,23 +141,17 @@ units = None dimensions = () intent = in -[ number_of_photolysis_wavelength_grid_sections ] - standard_name = number_of_photolysis_wavelength_grid_sections - type = integer - units = None - dimensions = () - intent = in [ photolysis_wavelength_grid_interfaces ] standard_name = photolysis_wavelength_grid_interfaces type = real | kind = kind_phys units = nm - dimensions = (horizontal_loop_extent) + dimensions = (photolysis_wavelength_grid_interface_dimension) intent = in [ extraterrestrial_flux ] standard_name = extraterrestrial_radiation_flux type = real | kind = kind_phys units = photons cm-2 s-1 nm-1 - dimensions = (horizontal_loop_extent) + dimensions = (photolysis_wavelength_grid_section_dimension) intent = in [ standard_gravitational_acceleration ] standard_name = standard_gravitational_acceleration diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 4d38b08a..8d99b0d1 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -415,7 +415,6 @@ subroutine tuvx_run(temperature, dry_air_density, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & surface_albedo, & - number_of_photolysis_wavelength_grid_sections, & photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, & standard_gravitational_acceleration, & @@ -439,7 +438,6 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: surface_geopotential(:) ! m2 s-2 real(kind_phys), intent(in) :: surface_temperature(:) ! K real(kind_phys), intent(in) :: surface_albedo ! unitless - integer, intent(in) :: number_of_photolysis_wavelength_grid_sections ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 @@ -470,7 +468,6 @@ subroutine tuvx_run(temperature, dry_air_density, & if (errcode /= 0) return call set_extraterrestrial_flux_values( extraterrestrial_flux_profile, & - number_of_photolysis_wavelength_grid_sections, & photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, errmsg, errcode ) if (errcode /= 0) return diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 index c6cfddad..9554e88a 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 @@ -57,8 +57,8 @@ end function create_extraterrestrial_flux_profile ! width of the wavelength bins to get the TUV-x units of photon cm-2 s-1 ! ! TUV-x only uses mid-point values for extraterrestrial flux - subroutine set_extraterrestrial_flux_values(profile, num_photolysis_wavelength_grid_sections, & - photolysis_wavelength_grid_interfaces, extraterrestrial_flux, errmsg, errcode) + subroutine set_extraterrestrial_flux_values(profile, photolysis_wavelength_grid_interfaces, & + extraterrestrial_flux, errmsg, errcode) use musica_ccpp_util, only: has_error_occurred use musica_tuvx_profile, only: profile_t use musica_util, only: error_t @@ -66,7 +66,6 @@ subroutine set_extraterrestrial_flux_values(profile, num_photolysis_wavelength_g use ccpp_tuvx_utils, only: rebin type(profile_t), intent(inout) :: profile - integer, intent(in) :: num_photolysis_wavelength_grid_sections ! (count) real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! nm real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 character(len=*), intent(out) :: errmsg @@ -90,7 +89,7 @@ subroutine set_extraterrestrial_flux_values(profile, num_photolysis_wavelength_g end if ! Regrid normalized flux to TUV-x wavelength grid - call rebin( num_photolysis_wavelength_grid_sections, num_wavelength_bins_, & + call rebin( size(photolysis_wavelength_grid_interfaces), num_wavelength_bins_, & photolysis_wavelength_grid_interfaces, wavelength_grid_interfaces_, & extraterrestrial_flux, midpoints ) diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index ef567e95..6ed8b0e8 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -318,7 +318,7 @@ subroutine test_chapman() call musica_ccpp_run( time_step, temperature, pressure, dry_air_density, constituent_props_ptr, & constituents, geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, surface_geopotential, & - surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & + surface_temperature, surface_albedo, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & @@ -541,7 +541,7 @@ subroutine test_terminator() call musica_ccpp_run( time_step, temperature, pressure, dry_air_density, constituent_props_ptr, & constituents, geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, surface_geopotential, & - surface_temperature, surface_albedo, num_photolysis_wavelength_grid_sections, & + surface_temperature, surface_albedo, & flux_data_photolysis_wavelength_interfaces, extraterrestrial_flux, & standard_gravitational_acceleration, cloud_area_fraction, & air_pressure_thickness, solar_zenith_angle, earth_sun_distance, errmsg, & diff --git a/test/musica/tuvx/test_tuvx_extraterrestrial_flux.F90 b/test/musica/tuvx/test_tuvx_extraterrestrial_flux.F90 index 8a652027..dcb94696 100644 --- a/test/musica/tuvx/test_tuvx_extraterrestrial_flux.F90 +++ b/test/musica/tuvx/test_tuvx_extraterrestrial_flux.F90 @@ -48,8 +48,7 @@ subroutine test_update_extraterrestrial_flux() ASSERT(errcode == 0) ASSERT(associated(profile)) - call set_extraterrestrial_flux_values( profile, NUM_PHOTOLYSIS_WAVELENGTH_GRID_SECTIONS, & - photolysis_wavelength_grid_interfaces, & + call set_extraterrestrial_flux_values( profile, photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, errmsg, errcode ) ASSERT(errcode == 0) diff --git a/to_be_ccppized/musica_dependencies.F90 b/to_be_ccppized/musica_dependencies.F90 new file mode 100644 index 00000000..718a0335 --- /dev/null +++ b/to_be_ccppized/musica_dependencies.F90 @@ -0,0 +1,224 @@ +! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +module musica_dependencies + + implicit none + private + + ! This module is used to define the dependencies of the MUSICA scheme, until + ! they are available from the host model or other CCPP-compliant schemes. + + integer, protected :: photolysis_wavelength_grid_section_dimension = 102 + integer, protected :: photolysis_wavelength_grid_interface_dimension = & + photolysis_wavelength_grid_section_dimension + 1 + real(kind_phys), protected :: surface_albedo = 0.1_kind_phys + real(kind_phys), dimension(photolysis_wavelength_grid_interface_dimension), protected :: & + photolysis_wavelength_grid_interfaces = (/ & + 120.0e-9_kind_phys, & + 121.4e-9_kind_phys, & + 121.9e-9_kind_phys, & + 123.5e-9_kind_phys, & + 124.3e-9_kind_phys, & + 125.5e-9_kind_phys, & + 126.3e-9_kind_phys, & + 127.1e-9_kind_phys, & + 130.1e-9_kind_phys, & + 131.1e-9_kind_phys, & + 135.0e-9_kind_phys, & + 140.0e-9_kind_phys, & + 145.0e-9_kind_phys, & + 150.0e-9_kind_phys, & + 155.0e-9_kind_phys, & + 160.0e-9_kind_phys, & + 165.0e-9_kind_phys, & + 168.0e-9_kind_phys, & + 171.0e-9_kind_phys, & + 173.0e-9_kind_phys, & + 174.4e-9_kind_phys, & + 175.4e-9_kind_phys, & + 177.0e-9_kind_phys, & + 178.6e-9_kind_phys, & + 180.2e-9_kind_phys, & + 181.8e-9_kind_phys, & + 183.5e-9_kind_phys, & + 185.2e-9_kind_phys, & + 186.9e-9_kind_phys, & + 188.7e-9_kind_phys, & + 190.5e-9_kind_phys, & + 192.3e-9_kind_phys, & + 194.2e-9_kind_phys, & + 196.1e-9_kind_phys, & + 198.0e-9_kind_phys, & + 200.0e-9_kind_phys, & + 202.0e-9_kind_phys, & + 204.1e-9_kind_phys, & + 206.2e-9_kind_phys, & + 208.0e-9_kind_phys, & + 211.0e-9_kind_phys, & + 214.0e-9_kind_phys, & + 217.0e-9_kind_phys, & + 220.0e-9_kind_phys, & + 223.0e-9_kind_phys, & + 226.0e-9_kind_phys, & + 229.0e-9_kind_phys, & + 232.0e-9_kind_phys, & + 235.0e-9_kind_phys, & + 238.0e-9_kind_phys, & + 241.0e-9_kind_phys, & + 244.0e-9_kind_phys, & + 247.0e-9_kind_phys, & + 250.0e-9_kind_phys, & + 253.0e-9_kind_phys, & + 256.0e-9_kind_phys, & + 259.0e-9_kind_phys, & + 263.0e-9_kind_phys, & + 267.0e-9_kind_phys, & + 271.0e-9_kind_phys, & + 275.0e-9_kind_phys, & + 279.0e-9_kind_phys, & + 283.0e-9_kind_phys, & + 287.0e-9_kind_phys, & + 291.0e-9_kind_phys, & + 295.0e-9_kind_phys, & + 298.5e-9_kind_phys, & + 302.5e-9_kind_phys, & + 305.5e-9_kind_phys, & + 308.5e-9_kind_phys, & + 311.5e-9_kind_phys, & + 314.5e-9_kind_phys, & + 317.5e-9_kind_phys, & + 322.5e-9_kind_phys, & + 327.5e-9_kind_phys, & + 332.5e-9_kind_phys, & + 337.5e-9_kind_phys, & + 342.5e-9_kind_phys, & + 347.5e-9_kind_phys, & + 350.0e-9_kind_phys, & + 355.0e-9_kind_phys, & + 360.0e-9_kind_phys, & + 365.0e-9_kind_phys, & + 370.0e-9_kind_phys, & + 375.0e-9_kind_phys, & + 380.0e-9_kind_phys, & + 385.0e-9_kind_phys, & + 390.0e-9_kind_phys, & + 395.0e-9_kind_phys, & + 400.0e-9_kind_phys, & + 405.0e-9_kind_phys, & + 410.0e-9_kind_phys, & + 415.0e-9_kind_phys, & + 420.0e-9_kind_phys, & + 430.0e-9_kind_phys, & + 440.0e-9_kind_phys, & + 450.0e-9_kind_phys, & + 500.0e-9_kind_phys, & + 550.0e-9_kind_phys, & + 600.0e-9_kind_phys, & + 650.0e-9_kind_phys, & + 700.0e-9_kind_phys, & + 750.0e-9_kind_phys & + /) + + real(kind_phys), dimension(photolysis_wavelength_grid_section_dimension), protected :: & + extraterrestrial_flux = (/ & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + 1.0e14_kind_phys, & + /) \ No newline at end of file diff --git a/to_be_ccppized/musica_dependencies.meta b/to_be_ccppized/musica_dependencies.meta new file mode 100644 index 00000000..b05c6e0f --- /dev/null +++ b/to_be_ccppized/musica_dependencies.meta @@ -0,0 +1,37 @@ +[ccpp-table-properties] + name = musica_dependencies + type = module + +[ccpp-arg-table] + name = musica_dependencies + type = module +[ photolysis_wavelength_grid_section_dimension ] + standard_name = photolysis_wavelength_grid_section_dimension + units = count + type = integer + dimensions = () + protected = True +[ photolysis_wavelength_grid_interface_dimension ] + standard_name = photolysis_wavelength_grid_interface_dimension + units = count + type = integer + dimensions = () + protected = True +[ surface_albedo ] + standard_name = surface_albedo + units = none + type = real | kind = kind_phys + dimensions = () + protected = True +[ photolysis_wavelength_grid_interfaces ] + standard_name = photolysis_wavelength_grid_interfaces + units = m + type = real | kind = kind_phys + dimensions = (photolysis_wavelength_grid_interface_dimension) + protected = True +[ extraterrestrial_radiation_flux ] + standard_name = extraterrestrial_radiation_flux + units = count cm-2 s-1 nm-1 + type = real | kind = kind_phys + dimensions = (photolysis_wavelength_grid_section_dimension) + protected = True From 5122681ae4ffd95bd4e5f9155e36d4f7e98d413f Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 12 Dec 2024 10:38:14 -0800 Subject: [PATCH 15/22] modfy musica dependencies module to be a scheme --- .../musica/musica_ccpp_dependencies.F90 | 42 ++++++++++++++----- .../musica/musica_ccpp_dependencies.meta | 18 ++++---- test/musica/CMakeLists.txt | 36 +++++++++++++++- test/musica/test_musica_dependencies.F90 | 39 +++++++++++++++++ 4 files changed, 114 insertions(+), 21 deletions(-) rename to_be_ccppized/musica_dependencies.F90 => schemes/musica/musica_ccpp_dependencies.F90 (80%) rename to_be_ccppized/musica_dependencies.meta => schemes/musica/musica_ccpp_dependencies.meta (82%) create mode 100644 test/musica/test_musica_dependencies.F90 diff --git a/to_be_ccppized/musica_dependencies.F90 b/schemes/musica/musica_ccpp_dependencies.F90 similarity index 80% rename from to_be_ccppized/musica_dependencies.F90 rename to schemes/musica/musica_ccpp_dependencies.F90 index 718a0335..3444b410 100644 --- a/to_be_ccppized/musica_dependencies.F90 +++ b/schemes/musica/musica_ccpp_dependencies.F90 @@ -1,19 +1,36 @@ ! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research ! SPDX-License-Identifier: Apache-2.0 -module musica_dependencies +module musica_ccpp_dependencies + + use ccpp_kinds, only: kind_phys implicit none private + public :: musica_ccpp_dependencies_init + +contains + ! This module is used to define the dependencies of the MUSICA scheme, until ! they are available from the host model or other CCPP-compliant schemes. - integer, protected :: photolysis_wavelength_grid_section_dimension = 102 - integer, protected :: photolysis_wavelength_grid_interface_dimension = & - photolysis_wavelength_grid_section_dimension + 1 - real(kind_phys), protected :: surface_albedo = 0.1_kind_phys - real(kind_phys), dimension(photolysis_wavelength_grid_interface_dimension), protected :: & - photolysis_wavelength_grid_interfaces = (/ & + !> \section arg_table_musica_ccpp_dependencies_init Argument Table + !! \htmlinclude musica_ccpp_dependencies_init.html + subroutine musica_ccpp_dependencies_init(photolysis_wavelength_grid_section_dimension, & + photolysis_wavelength_grid_interface_dimension, & + surface_albedo, photolysis_wavelength_grid_interfaces, & + extraterrestrial_radiation_flux) + integer, intent(out) :: photolysis_wavelength_grid_section_dimension + integer, intent(out) :: photolysis_wavelength_grid_interface_dimension + real(kind_phys), intent(out) :: surface_albedo + real(kind_phys), allocatable, intent(out) :: photolysis_wavelength_grid_interfaces(:) + real(kind_phys), allocatable, intent(out) :: extraterrestrial_radiation_flux(:) + + photolysis_wavelength_grid_section_dimension = 102 + photolysis_wavelength_grid_interface_dimension = photolysis_wavelength_grid_section_dimension + 1 + surface_albedo = 0.1_kind_phys + + photolysis_wavelength_grid_interfaces = (/ & 120.0e-9_kind_phys, & 121.4e-9_kind_phys, & 121.9e-9_kind_phys, & @@ -119,8 +136,7 @@ module musica_dependencies 750.0e-9_kind_phys & /) - real(kind_phys), dimension(photolysis_wavelength_grid_section_dimension), protected :: & - extraterrestrial_flux = (/ & + extraterrestrial_radiation_flux = (/ & 1.0e14_kind_phys, & 1.0e14_kind_phys, & 1.0e14_kind_phys, & @@ -221,4 +237,10 @@ module musica_dependencies 1.0e14_kind_phys, & 1.0e14_kind_phys, & 1.0e14_kind_phys, & - /) \ No newline at end of file + 1.0e14_kind_phys, & + 1.0e14_kind_phys & + /) + + end subroutine musica_ccpp_dependencies_init + +end module musica_ccpp_dependencies \ No newline at end of file diff --git a/to_be_ccppized/musica_dependencies.meta b/schemes/musica/musica_ccpp_dependencies.meta similarity index 82% rename from to_be_ccppized/musica_dependencies.meta rename to schemes/musica/musica_ccpp_dependencies.meta index b05c6e0f..6e0caa91 100644 --- a/to_be_ccppized/musica_dependencies.meta +++ b/schemes/musica/musica_ccpp_dependencies.meta @@ -1,37 +1,37 @@ [ccpp-table-properties] - name = musica_dependencies - type = module + name = musica_ccpp_dependencies + type = scheme [ccpp-arg-table] - name = musica_dependencies - type = module + name = musica_ccpp_dependencies_init + type = scheme [ photolysis_wavelength_grid_section_dimension ] standard_name = photolysis_wavelength_grid_section_dimension units = count type = integer dimensions = () - protected = True + intent = out [ photolysis_wavelength_grid_interface_dimension ] standard_name = photolysis_wavelength_grid_interface_dimension units = count type = integer dimensions = () - protected = True + intent = out [ surface_albedo ] standard_name = surface_albedo units = none type = real | kind = kind_phys dimensions = () - protected = True + intent = out [ photolysis_wavelength_grid_interfaces ] standard_name = photolysis_wavelength_grid_interfaces units = m type = real | kind = kind_phys dimensions = (photolysis_wavelength_grid_interface_dimension) - protected = True + intent = out [ extraterrestrial_radiation_flux ] standard_name = extraterrestrial_radiation_flux units = count cm-2 s-1 nm-1 type = real | kind = kind_phys dimensions = (photolysis_wavelength_grid_section_dimension) - protected = True + intent = out diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index 0d187cf4..db20e881 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -61,6 +61,28 @@ add_custom_target( ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/configurations ${CMAKE_BINARY_DIR}/musica_configurations ) +# ---------------------------------------------------------- +# Create a test for the temporary MUSICA dependencies module +# ---------------------------------------------------------- + +add_executable(test_musica_dependencies test_musica_dependencies.F90) + +target_sources(test_musica_dependencies + PUBLIC + ${MUSICA_SRC_PATH}/musica_ccpp_dependencies.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 +) + +target_compile_options(test_musica_dependencies PRIVATE -ffree-line-length-none) + +add_test( + NAME test_musica_dependencies + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_musica_dependencies $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) + add_subdirectory(micm) add_subdirectory(tuvx) @@ -72,6 +94,8 @@ add_custom_target( copy_metadata_test_files ALL ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp.meta ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp_dependencies.meta + ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp_dependencies.F90 ${CMAKE_BINARY_DIR}/metadata_test ) @@ -81,10 +105,18 @@ add_test( --directory ${CMAKE_BINARY_DIR}/metadata_test ) -# Test metadata against the CCPP standard names +# Test musica scheme metadata against the CCPP standard names add_test( - NAME test_metadata_against_ccpp_standard_names + NAME test_musica_metadata_against_ccpp_standard_names COMMAND ${Python_EXECUTABLE} ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/tools/meta_stdname_check.py --metafile-loc ${CMAKE_BINARY_DIR}/metadata_test/musica_ccpp.meta --stdname-dict ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/standard_names.xml +) + +# Test musica scheme dependencies metadata against the CCPP standard names +add_test( + NAME test_musica_dependencies_metadata_against_ccpp_standard_names + COMMAND ${Python_EXECUTABLE} ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/tools/meta_stdname_check.py + --metafile-loc ${CMAKE_BINARY_DIR}/metadata_test/musica_ccpp_dependencies.meta + --stdname-dict ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/standard_names.xml ) \ No newline at end of file diff --git a/test/musica/test_musica_dependencies.F90 b/test/musica/test_musica_dependencies.F90 new file mode 100644 index 00000000..daefe55f --- /dev/null +++ b/test/musica/test_musica_dependencies.F90 @@ -0,0 +1,39 @@ +! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research +! SPDX-License-Identifier: Apache-2.0 +program test_musica_ccpp_dependencies + +#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_dependencies() + +contains + + subroutine test_dependencies() + + use ccpp_kinds, only: kind_phys + use musica_ccpp_dependencies, only: musica_ccpp_dependencies_init + + integer :: photolysis_wavelength_grid_section_dimension + integer :: photolysis_wavelength_grid_interface_dimension + real(kind_phys) :: surface_albedo + real(kind_phys), allocatable :: photolysis_wavelength_grid_interfaces(:) + real(kind_phys), allocatable :: extraterrestrial_flux(:) + + call musica_ccpp_dependencies_init(photolysis_wavelength_grid_section_dimension, & + photolysis_wavelength_grid_interface_dimension, & + surface_albedo, photolysis_wavelength_grid_interfaces, & + extraterrestrial_flux) + + ASSERT(size(photolysis_wavelength_grid_interfaces) == photolysis_wavelength_grid_interface_dimension) + ASSERT(size(extraterrestrial_flux) == photolysis_wavelength_grid_section_dimension) + ASSERT(photolysis_wavelength_grid_interface_dimension == photolysis_wavelength_grid_section_dimension + 1) + ASSERT(all(photolysis_wavelength_grid_interfaces > 1.0e-10)) + ASSERT(all(photolysis_wavelength_grid_interfaces < 1.0e-4)) + ASSERT(surface_albedo >= 0.0) + + end subroutine test_dependencies + +end program test_musica_ccpp_dependencies \ No newline at end of file From 89587af9dfad3bd5c50bead04137291c4817a7cb Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 12 Dec 2024 11:02:36 -0800 Subject: [PATCH 16/22] fix bug in et flux interpolation --- schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 index 9554e88a..568954e9 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_extraterrestrial_flux.F90 @@ -89,7 +89,7 @@ subroutine set_extraterrestrial_flux_values(profile, photolysis_wavelength_grid_ end if ! Regrid normalized flux to TUV-x wavelength grid - call rebin( size(photolysis_wavelength_grid_interfaces), num_wavelength_bins_, & + call rebin( size(photolysis_wavelength_grid_interfaces) - 1, num_wavelength_bins_, & photolysis_wavelength_grid_interfaces, wavelength_grid_interfaces_, & extraterrestrial_flux, midpoints ) From 50e0e905804ff415be8221c4aec519ab72d16989 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 12 Dec 2024 15:02:24 -0800 Subject: [PATCH 17/22] move musica dependencies to cam-sima --- schemes/musica/musica_ccpp_dependencies.F90 | 246 ------------------- schemes/musica/musica_ccpp_dependencies.meta | 37 --- test/musica/CMakeLists.txt | 32 --- test/musica/test_musica_dependencies.F90 | 39 --- 4 files changed, 354 deletions(-) delete mode 100644 schemes/musica/musica_ccpp_dependencies.F90 delete mode 100644 schemes/musica/musica_ccpp_dependencies.meta delete mode 100644 test/musica/test_musica_dependencies.F90 diff --git a/schemes/musica/musica_ccpp_dependencies.F90 b/schemes/musica/musica_ccpp_dependencies.F90 deleted file mode 100644 index 3444b410..00000000 --- a/schemes/musica/musica_ccpp_dependencies.F90 +++ /dev/null @@ -1,246 +0,0 @@ -! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research -! SPDX-License-Identifier: Apache-2.0 -module musica_ccpp_dependencies - - use ccpp_kinds, only: kind_phys - - implicit none - private - - public :: musica_ccpp_dependencies_init - -contains - - ! This module is used to define the dependencies of the MUSICA scheme, until - ! they are available from the host model or other CCPP-compliant schemes. - - !> \section arg_table_musica_ccpp_dependencies_init Argument Table - !! \htmlinclude musica_ccpp_dependencies_init.html - subroutine musica_ccpp_dependencies_init(photolysis_wavelength_grid_section_dimension, & - photolysis_wavelength_grid_interface_dimension, & - surface_albedo, photolysis_wavelength_grid_interfaces, & - extraterrestrial_radiation_flux) - integer, intent(out) :: photolysis_wavelength_grid_section_dimension - integer, intent(out) :: photolysis_wavelength_grid_interface_dimension - real(kind_phys), intent(out) :: surface_albedo - real(kind_phys), allocatable, intent(out) :: photolysis_wavelength_grid_interfaces(:) - real(kind_phys), allocatable, intent(out) :: extraterrestrial_radiation_flux(:) - - photolysis_wavelength_grid_section_dimension = 102 - photolysis_wavelength_grid_interface_dimension = photolysis_wavelength_grid_section_dimension + 1 - surface_albedo = 0.1_kind_phys - - photolysis_wavelength_grid_interfaces = (/ & - 120.0e-9_kind_phys, & - 121.4e-9_kind_phys, & - 121.9e-9_kind_phys, & - 123.5e-9_kind_phys, & - 124.3e-9_kind_phys, & - 125.5e-9_kind_phys, & - 126.3e-9_kind_phys, & - 127.1e-9_kind_phys, & - 130.1e-9_kind_phys, & - 131.1e-9_kind_phys, & - 135.0e-9_kind_phys, & - 140.0e-9_kind_phys, & - 145.0e-9_kind_phys, & - 150.0e-9_kind_phys, & - 155.0e-9_kind_phys, & - 160.0e-9_kind_phys, & - 165.0e-9_kind_phys, & - 168.0e-9_kind_phys, & - 171.0e-9_kind_phys, & - 173.0e-9_kind_phys, & - 174.4e-9_kind_phys, & - 175.4e-9_kind_phys, & - 177.0e-9_kind_phys, & - 178.6e-9_kind_phys, & - 180.2e-9_kind_phys, & - 181.8e-9_kind_phys, & - 183.5e-9_kind_phys, & - 185.2e-9_kind_phys, & - 186.9e-9_kind_phys, & - 188.7e-9_kind_phys, & - 190.5e-9_kind_phys, & - 192.3e-9_kind_phys, & - 194.2e-9_kind_phys, & - 196.1e-9_kind_phys, & - 198.0e-9_kind_phys, & - 200.0e-9_kind_phys, & - 202.0e-9_kind_phys, & - 204.1e-9_kind_phys, & - 206.2e-9_kind_phys, & - 208.0e-9_kind_phys, & - 211.0e-9_kind_phys, & - 214.0e-9_kind_phys, & - 217.0e-9_kind_phys, & - 220.0e-9_kind_phys, & - 223.0e-9_kind_phys, & - 226.0e-9_kind_phys, & - 229.0e-9_kind_phys, & - 232.0e-9_kind_phys, & - 235.0e-9_kind_phys, & - 238.0e-9_kind_phys, & - 241.0e-9_kind_phys, & - 244.0e-9_kind_phys, & - 247.0e-9_kind_phys, & - 250.0e-9_kind_phys, & - 253.0e-9_kind_phys, & - 256.0e-9_kind_phys, & - 259.0e-9_kind_phys, & - 263.0e-9_kind_phys, & - 267.0e-9_kind_phys, & - 271.0e-9_kind_phys, & - 275.0e-9_kind_phys, & - 279.0e-9_kind_phys, & - 283.0e-9_kind_phys, & - 287.0e-9_kind_phys, & - 291.0e-9_kind_phys, & - 295.0e-9_kind_phys, & - 298.5e-9_kind_phys, & - 302.5e-9_kind_phys, & - 305.5e-9_kind_phys, & - 308.5e-9_kind_phys, & - 311.5e-9_kind_phys, & - 314.5e-9_kind_phys, & - 317.5e-9_kind_phys, & - 322.5e-9_kind_phys, & - 327.5e-9_kind_phys, & - 332.5e-9_kind_phys, & - 337.5e-9_kind_phys, & - 342.5e-9_kind_phys, & - 347.5e-9_kind_phys, & - 350.0e-9_kind_phys, & - 355.0e-9_kind_phys, & - 360.0e-9_kind_phys, & - 365.0e-9_kind_phys, & - 370.0e-9_kind_phys, & - 375.0e-9_kind_phys, & - 380.0e-9_kind_phys, & - 385.0e-9_kind_phys, & - 390.0e-9_kind_phys, & - 395.0e-9_kind_phys, & - 400.0e-9_kind_phys, & - 405.0e-9_kind_phys, & - 410.0e-9_kind_phys, & - 415.0e-9_kind_phys, & - 420.0e-9_kind_phys, & - 430.0e-9_kind_phys, & - 440.0e-9_kind_phys, & - 450.0e-9_kind_phys, & - 500.0e-9_kind_phys, & - 550.0e-9_kind_phys, & - 600.0e-9_kind_phys, & - 650.0e-9_kind_phys, & - 700.0e-9_kind_phys, & - 750.0e-9_kind_phys & - /) - - extraterrestrial_radiation_flux = (/ & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys, & - 1.0e14_kind_phys & - /) - - end subroutine musica_ccpp_dependencies_init - -end module musica_ccpp_dependencies \ No newline at end of file diff --git a/schemes/musica/musica_ccpp_dependencies.meta b/schemes/musica/musica_ccpp_dependencies.meta deleted file mode 100644 index 6e0caa91..00000000 --- a/schemes/musica/musica_ccpp_dependencies.meta +++ /dev/null @@ -1,37 +0,0 @@ -[ccpp-table-properties] - name = musica_ccpp_dependencies - type = scheme - -[ccpp-arg-table] - name = musica_ccpp_dependencies_init - type = scheme -[ photolysis_wavelength_grid_section_dimension ] - standard_name = photolysis_wavelength_grid_section_dimension - units = count - type = integer - dimensions = () - intent = out -[ photolysis_wavelength_grid_interface_dimension ] - standard_name = photolysis_wavelength_grid_interface_dimension - units = count - type = integer - dimensions = () - intent = out -[ surface_albedo ] - standard_name = surface_albedo - units = none - type = real | kind = kind_phys - dimensions = () - intent = out -[ photolysis_wavelength_grid_interfaces ] - standard_name = photolysis_wavelength_grid_interfaces - units = m - type = real | kind = kind_phys - dimensions = (photolysis_wavelength_grid_interface_dimension) - intent = out -[ extraterrestrial_radiation_flux ] - standard_name = extraterrestrial_radiation_flux - units = count cm-2 s-1 nm-1 - type = real | kind = kind_phys - dimensions = (photolysis_wavelength_grid_section_dimension) - intent = out diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index db20e881..fbedfba3 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -61,28 +61,6 @@ add_custom_target( ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/configurations ${CMAKE_BINARY_DIR}/musica_configurations ) -# ---------------------------------------------------------- -# Create a test for the temporary MUSICA dependencies module -# ---------------------------------------------------------- - -add_executable(test_musica_dependencies test_musica_dependencies.F90) - -target_sources(test_musica_dependencies - PUBLIC - ${MUSICA_SRC_PATH}/musica_ccpp_dependencies.F90 - ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 -) - -target_compile_options(test_musica_dependencies PRIVATE -ffree-line-length-none) - -add_test( - NAME test_musica_dependencies - COMMAND $ - WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} -) - -add_memory_check_test(test_musica_dependencies $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) - add_subdirectory(micm) add_subdirectory(tuvx) @@ -94,8 +72,6 @@ add_custom_target( copy_metadata_test_files ALL ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp.meta ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp_dependencies.meta - ${CMAKE_CURRENT_SOURCE_DIR}/../../schemes/musica/musica_ccpp_dependencies.F90 ${CMAKE_BINARY_DIR}/metadata_test ) @@ -111,12 +87,4 @@ add_test( COMMAND ${Python_EXECUTABLE} ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/tools/meta_stdname_check.py --metafile-loc ${CMAKE_BINARY_DIR}/metadata_test/musica_ccpp.meta --stdname-dict ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/standard_names.xml -) - -# Test musica scheme dependencies metadata against the CCPP standard names -add_test( - NAME test_musica_dependencies_metadata_against_ccpp_standard_names - COMMAND ${Python_EXECUTABLE} ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/tools/meta_stdname_check.py - --metafile-loc ${CMAKE_BINARY_DIR}/metadata_test/musica_ccpp_dependencies.meta - --stdname-dict ${CMAKE_BINARY_DIR}/../$ENV{CCPP_STD_NAMES_PATH}/standard_names.xml ) \ No newline at end of file diff --git a/test/musica/test_musica_dependencies.F90 b/test/musica/test_musica_dependencies.F90 deleted file mode 100644 index daefe55f..00000000 --- a/test/musica/test_musica_dependencies.F90 +++ /dev/null @@ -1,39 +0,0 @@ -! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research -! SPDX-License-Identifier: Apache-2.0 -program test_musica_ccpp_dependencies - -#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_dependencies() - -contains - - subroutine test_dependencies() - - use ccpp_kinds, only: kind_phys - use musica_ccpp_dependencies, only: musica_ccpp_dependencies_init - - integer :: photolysis_wavelength_grid_section_dimension - integer :: photolysis_wavelength_grid_interface_dimension - real(kind_phys) :: surface_albedo - real(kind_phys), allocatable :: photolysis_wavelength_grid_interfaces(:) - real(kind_phys), allocatable :: extraterrestrial_flux(:) - - call musica_ccpp_dependencies_init(photolysis_wavelength_grid_section_dimension, & - photolysis_wavelength_grid_interface_dimension, & - surface_albedo, photolysis_wavelength_grid_interfaces, & - extraterrestrial_flux) - - ASSERT(size(photolysis_wavelength_grid_interfaces) == photolysis_wavelength_grid_interface_dimension) - ASSERT(size(extraterrestrial_flux) == photolysis_wavelength_grid_section_dimension) - ASSERT(photolysis_wavelength_grid_interface_dimension == photolysis_wavelength_grid_section_dimension + 1) - ASSERT(all(photolysis_wavelength_grid_interfaces > 1.0e-10)) - ASSERT(all(photolysis_wavelength_grid_interfaces < 1.0e-4)) - ASSERT(surface_albedo >= 0.0) - - end subroutine test_dependencies - -end program test_musica_ccpp_dependencies \ No newline at end of file From b920c7eadcbb55425dc9e460e1d9f58c215a2f72 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 12 Dec 2024 15:58:19 -0800 Subject: [PATCH 18/22] update metadata --- schemes/musica/musica_ccpp.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 72a47743..5ded04ed 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -144,13 +144,13 @@ [ photolysis_wavelength_grid_interfaces ] standard_name = photolysis_wavelength_grid_interfaces type = real | kind = kind_phys - units = nm + units = m dimensions = (photolysis_wavelength_grid_interface_dimension) intent = in [ extraterrestrial_flux ] standard_name = extraterrestrial_radiation_flux type = real | kind = kind_phys - units = photons cm-2 s-1 nm-1 + units = count cm-2 s-1 nm-1 dimensions = (photolysis_wavelength_grid_section_dimension) intent = in [ standard_gravitational_acceleration ] From 5582de2519ea20971b554e6eb4191d10646ba7a1 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Thu, 12 Dec 2024 16:51:53 -0800 Subject: [PATCH 19/22] fix meta data --- schemes/musica/musica_ccpp.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 5ded04ed..28919130 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -179,7 +179,7 @@ intent = in [ earth_sun_distance ] standard_name = earth_sun_distance - units = radians + units = AU type = real | kind = kind_phys dimensions = () intent = in From f82d4c0a378f32448155d418b0a5791e73d5f94f Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Fri, 13 Dec 2024 12:49:14 -0800 Subject: [PATCH 20/22] address reviewer comments --- schemes/musica/musica_ccpp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 8d460ba2..5a0596b7 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -28,7 +28,7 @@ subroutine musica_ccpp_register(constituent_props, errmsg, & ! 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 know at this point, so we set it to 1 and recreate + ! 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, & From 3aa99537a983b40b5cca1e8488fa50f6f37cd0ad Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Fri, 13 Dec 2024 13:41:10 -0800 Subject: [PATCH 21/22] address reviewer comments --- schemes/musica/musica_ccpp.F90 | 5 +++-- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 12 +++++++----- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 5a0596b7..4c79511f 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -130,6 +130,7 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co ! Calculate photolysis rate constants using TUV-x call tuvx_run(temperature, dry_air_density, & + constituents, & geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & @@ -138,10 +139,10 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co extraterrestrial_flux, & standard_gravitational_acceleration, & cloud_area_fraction, & + air_pressure_thickness, & solar_zenith_angle, & earth_sun_distance, & - constituents, & - air_pressure_thickness, rate_parameters, & + rate_parameters, & errmsg, errcode) ! Get the molar mass that is set in the call to instantiate() diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 8d99b0d1..6e95bde0 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -411,6 +411,7 @@ end subroutine tuvx_init !> Calculates photolysis rate constants for the current model conditions subroutine tuvx_run(temperature, dry_air_density, & + constituents, & geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & @@ -419,9 +420,10 @@ subroutine tuvx_run(temperature, dry_air_density, & extraterrestrial_flux, & standard_gravitational_acceleration, & cloud_area_fraction, & - solar_zenith_angle, earth_sun_distance, & - constituents, & - air_pressure_thickness, rate_parameters, & + air_pressure_thickness, & + solar_zenith_angle, & + earth_sun_distance, & + rate_parameters, & errmsg, errcode) use musica_util, only: error_t use musica_ccpp_tuvx_height_grid, only: set_height_grid_values, calculate_heights @@ -433,6 +435,7 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: temperature(:,:) ! K (column, layer) real(kind_phys), intent(in) :: dry_air_density(:,:) ! kg m-3 (column, layer) + real(kind_phys), intent(in) :: constituents(:,:,:) ! various (column, layer, constituent) real(kind_phys), intent(in) :: geopotential_height_wrt_surface_at_midpoint(:,:) ! m (column, layer) real(kind_phys), intent(in) :: geopotential_height_wrt_surface_at_interface(:,:) ! m (column, interface) real(kind_phys), intent(in) :: surface_geopotential(:) ! m2 s-2 @@ -442,10 +445,9 @@ subroutine tuvx_run(temperature, dry_air_density, & real(kind_phys), intent(in) :: extraterrestrial_flux(:) ! photons cm-2 s-1 nm-1 real(kind_phys), intent(in) :: standard_gravitational_acceleration ! m s-2 real(kind_phys), intent(in) :: cloud_area_fraction(:,:) ! unitless (column, layer) + real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, layer) real(kind_phys), intent(in) :: solar_zenith_angle(:) ! radians real(kind_phys), intent(in) :: earth_sun_distance ! m - real(kind_phys), intent(in) :: constituents(:,:,:) ! various (column, layer, constituent) - real(kind_phys), intent(in) :: air_pressure_thickness(:,:) ! Pa (column, layer) real(kind_phys), intent(inout) :: rate_parameters(:,:,:) ! various units (column, layer, reaction) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode From 5b7c25ca01d5cd5392dc954552fb62cf1794a604 Mon Sep 17 00:00:00 2001 From: Matt Dawson Date: Fri, 13 Dec 2024 14:44:13 -0800 Subject: [PATCH 22/22] use photons in units --- schemes/musica/musica_ccpp.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/schemes/musica/musica_ccpp.meta b/schemes/musica/musica_ccpp.meta index 28919130..cc018ec2 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -150,7 +150,7 @@ [ extraterrestrial_flux ] standard_name = extraterrestrial_radiation_flux type = real | kind = kind_phys - units = count cm-2 s-1 nm-1 + units = photons cm-2 s-1 nm-1 dimensions = (photolysis_wavelength_grid_section_dimension) intent = in [ standard_gravitational_acceleration ]