From 438ba64fc6bd593bb32049067c671c56dc3a805b Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Mon, 16 Dec 2024 17:25:34 -0700 Subject: [PATCH 01/18] musica species array --- schemes/musica/micm/musica_ccpp_micm.F90 | 29 ++- .../musica/musica_ccpp_load_tuvx_species.F90 | 184 ++++++++++++++++++ 2 files changed, 208 insertions(+), 5 deletions(-) create mode 100644 schemes/musica/musica_ccpp_load_tuvx_species.F90 diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index c2e40d95..1fe67818 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -19,8 +19,9 @@ module musica_ccpp_micm !> Registers MICM constituent properties with the CCPP subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & - errmsg, errcode) + musica_species, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t use musica_micm, only: Rosenbrock, RosenbrockStandardOrder use musica_util, only: error_t use iso_c_binding, only: c_int @@ -28,6 +29,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & integer(c_int), intent(in) :: solver_type integer(c_int), intent(in) :: number_of_grid_cells type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) + type(musica_species_t), allocatable, intent(out) :: musica_species(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -36,6 +38,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & real(kind=kind_phys) :: molar_mass character(len=:), allocatable :: species_name logical :: is_advected + integer :: number_of_species integer :: i, species_index if (associated( micm )) then @@ -46,16 +49,23 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & number_of_grid_cells, error) if (has_error_occurred(error, errmsg, errcode)) return - allocate(constituent_props(micm%species_ordering%size()), stat=errcode) + number_of_species = micm%species_ordering%size() + allocate(constituent_props(number_of_species), stat=errcode) if (errcode /= 0) then errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties." return end if - do i = 1, micm%species_ordering%size() + allocate(musica_species(number_of_species), stat=errcode) + if (errcode /= 0) then + errmsg = "[MUSICA Error] Failed to allocate memory for musica species." + return + end if + + do i = 1, number_of_species associate( map => micm%species_ordering ) species_name = map%name(i) - species_index = map%index(i) + species_index = map%index(i) ! TODO(jiwon): is this index not in sequence? molar_mass = micm%get_species_property_double(species_name, & "molecular weight [kg mol-1]", & @@ -66,7 +76,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & error) if (has_error_occurred(error, errmsg, errcode)) return - call constituent_props(species_index)%instantiate( & + call constituent_props(i)%instantiate( & std_name = species_name, & long_name = species_name, & units = 'kg kg-1', & @@ -78,6 +88,15 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & errcode = errcode, & errmsg = errmsg) if (errcode /= 0) return + + ! create musica_species_t + musica_species(species_index) = musica_species_t( & + name = species_name, & + unit = 'kg kg-1', & + molar_mass = molar_mass, & + index_musica_species = species_index ) + + write(*,*) " [micm register] species_index: ", species_index ! jiwon end associate ! map end do number_of_rate_parameters = micm%user_defined_reaction_rates%size() diff --git a/schemes/musica/musica_ccpp_load_tuvx_species.F90 b/schemes/musica/musica_ccpp_load_tuvx_species.F90 new file mode 100644 index 00000000..93f5f0c7 --- /dev/null +++ b/schemes/musica/musica_ccpp_load_tuvx_species.F90 @@ -0,0 +1,184 @@ +module muscia_ccpp_load_tuvx_species + use musica_ccpp_species + + implicit none + private + + public :: configure_tuvx_species +contains +call configure_tuvx_species(constituent_props, musica_species, tuvx_specific_species, & +errmsg, errcode) + ! Add constituent props and then create musica_species + ! This is another reason in favor of moving all mechanism parsing of open atmos; + ! you could choose to do this and it would be valid. For micm, we always want + ! a full mechanism becauase that's what we need + subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specific_species, & + errmsg, errcode) + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t + use musica_util, only: error_t + + type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) + type(musica_species_t), allocatable, intent(inout) :: musica_species(:) + type(musica_species_t), allocatable, intent(inout) :: tuvx_specific_species(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + integer :: num_new_species = 4 + integer :: num_registered_species = size(musica_species) + type(ccpp_constituent_properties_t) :: temp_constituent_props(num_new_species) + type(musica_species_t) :: temp_musica_species(num_new_species) + type(musica_species_t) :: copy_musica_species(num_registered_species) + logical :: is_O2_registered = .false. + logical :: is_O3_registered = .false. + logical :: is_dry_air_registered = .false. + integer :: i_new, i_registered + + character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LABEL = & + 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' + character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LONG_NAME = & + 'cloud water mass mixing ratio with respect to moist air plus all airborne condensates' + character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_UNITS = 'kg kg-1' + real(kind_phys), parameter :: CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS = 0.018_kind_phys ! kg mol-1 + real(kind_phys), parameter :: SCALE_HEIGHT_DRY_AIR = 8.01_kind_phys ! km + real(kind_phys), parameter :: SCALE_HEIGHT_O2 = 7.0_kind_phys ! km + real(kind_phys), parameter :: SCALE_HEIGHT_O3 = 7.0_kind_phys ! km + !> Molar mass value of dry air is obtained from 'CAM-SIMA/src/utils/std_atm_profile.F90' + ! TODO(jiwon) - how to make this an input argument? + real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 + real(kind_phys), parameter :: MOLAR_MASS_O2 = 0.0319988_kind_phys ! kg mol-1 + real(kind_phys), parameter :: MOLAR_MASS_O3 = 0.0479982_kind_phys ! kg mol-1 + + ! Register cloud liquid water content needed for cloud optics calculations + i_new = 1 + call temp_constituent_props(i_new)%instantiate( & + std_name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & + long_name = CLOUD_LIQUID_WATER_CONTENT_LONG_NAME, & + units = CLOUD_LIQUID_WATER_CONTENT_UNITS, & + vertical_dim = "vertical_layer_dimension", & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS, & + advected = .true., & + errcode = errcode, & + errmsg = errmsg ) + if (errcode /= 0) return + + temp_musica_species(i_new) = musica_species_t( & + name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & + unit = CLOUD_LIQUID_WATER_CONTENT_UNITS, & + molar_mass = CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS, & + index_musica_species = num_registered_species + i_new ) + + ! Add gas species - dry air, O2, O3 - to be profiled + ! iterate through all the registered species to + ! check if the species is already registered and if so + ! update scale_height + do i_registered = 1, num_registered_species + if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit + + if (musica_species(i)%name == "dry_air") then + is_dry_air_registered = .true. + musica_species(i_registered)%profiled = .true. + musica_species(i_registered)%scale_height = SCALE_HEIGHT_DRY_AIR + else if ( musica_species(i_registered)%name == "O2" ) then + is_O2_registered = .true. + musica_species(i_registered)%profiled = .true. + musica_species(i_registered)%scale_height = SCALE_HEIGHT_O2 + else if (musica_species(i)%name == "O3") then + is_O3_registered = .true. + musica_species(i_registered)%profiled = .true. + musica_species(i_registered)%scale_height = SCALE_HEIGHT_O3 + end if + end do + + if (.not. is_dry_air_registered) then + i_new = i_new + 1 + + call constituent_props(i_new)%instantiate( & + std_name = 'dry_air', & + long_name = 'dry_air', & + units = 'kg kg-1', & + vertical_dim = "vertical_layer_dimension", & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = MOLAR_MASS_DRY_AIR, & + advected = .false., & + errcode = errcode, & + errmsg = errmsg ) + if (errcode /= 0) return + + temp_musica_species(i_new) = musica_species_t( & + name = 'dry_air', & + unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_AIR, & ! kg mol-1 + index_musica_species = num_registered_species + i_new, & + profiled = .true., & + scale_height = SCALE_HEIGHT_DRY_AIR ) + end if + + if (.not. is_O2_registered) then + i_new = i_new + 1 + + call constituent_props(i_new)%instantiate( & + std_name = 'O2', & + long_name = 'O2', & + units = 'kg kg-1', & + vertical_dim = "vertical_layer_dimension", & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = MOLAR_MASS_O2, & + advected = .false., & + errcode = errcode, & + errmsg = errmsg ) + if (errcode /= 0) return + + temp_musica_species(i_new) = musica_species_t( & + name = 'O2', & + unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_O2, & ! kg mol-1 + index_musica_species = num_registered_species + i_new, & + profiled = .true., & + scale_height = SCALE_HEIGHT_O2 ) + end if + + if (.not. is_O3_registered) then + i_new = i_new + 1 + + call constituent_props(i_new)%instantiate( & + std_name = 'O3', & + long_name = 'O3', & + units = 'kg kg-1', & + vertical_dim = "vertical_layer_dimension", & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = MOLAR_MASS_O3, & + advected = .false., & + errcode = errcode, & + errmsg = errmsg ) + if (errcode /= 0) return + + temp_musica_species(i_new) = musica_species_t( & + name = 'O3', & + unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_O3, & ! kg mol-1 + index_musica_species = num_registered_species + i_new, & + profiled = .true., & + scale_height = SCALE_HEIGHT_O3 ) + end if + + allocate( constituent_props( size(i_new) ) ) + constituent_props(:) = temp_musica_species(1:i_new) + + if (i_new > 0 ) then + copy_musica_species = musica_species + deallocate( musica_species ) + allocate( musica_species( num_registered_species + i_new )) + musica_species = [ copy_musica_species, temp_musica_species ] + end if + + end subroutine configure_tuvx_species + +end module muscia_ccpp_load_tuvx_species From fe24069ea2d25060d7d8f4b54a528492b5922921 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 18 Dec 2024 10:52:40 -0700 Subject: [PATCH 02/18] add function to extract constituents for musica --- schemes/musica/micm/musica_ccpp_micm.F90 | 12 +- schemes/musica/musica_ccpp.F90 | 91 +++--- .../musica/musica_ccpp_load_tuvx_species.F90 | 192 +++++++----- schemes/musica/musica_ccpp_species.F90 | 296 ++++++++++++++++++ schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 84 ++--- 5 files changed, 490 insertions(+), 185 deletions(-) create mode 100644 schemes/musica/musica_ccpp_species.F90 diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 1fe67818..08f6eefe 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -19,7 +19,7 @@ module musica_ccpp_micm !> Registers MICM constituent properties with the CCPP subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & - musica_species, errmsg, errcode) + micm_species, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t use musica_micm, only: Rosenbrock, RosenbrockStandardOrder @@ -29,7 +29,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & integer(c_int), intent(in) :: solver_type integer(c_int), intent(in) :: number_of_grid_cells type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) - type(musica_species_t), allocatable, intent(out) :: musica_species(:) + type(musica_species_t), allocatable, intent(out) :: micm_species(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -56,9 +56,9 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & return end if - allocate(musica_species(number_of_species), stat=errcode) + allocate(micm_species(number_of_species), stat=errcode) if (errcode /= 0) then - errmsg = "[MUSICA Error] Failed to allocate memory for musica species." + errmsg = "[MUSICA Error] Failed to allocate memory for micm species." return end if @@ -89,8 +89,8 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & errmsg = errmsg) if (errcode /= 0) return - ! create musica_species_t - musica_species(species_index) = musica_species_t( & + ! Species are ordered to match the sequence of the MICM state array + micm_species(species_index) = musica_species_t( & name = species_name, & unit = 'kg kg-1', & molar_mass = molar_mass, & diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 4c79511f..a045e23d 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -14,16 +14,20 @@ module musica_ccpp !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html - subroutine musica_ccpp_register(constituent_props, errmsg, & - errcode) + subroutine musica_ccpp_register(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_namelist, only: micm_solver_type + use musica_ccpp_species, only: musica_species_t, register_musica_species, & + check_tuvx_species_initialization type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + ! local variables type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:) + type(musica_species_t), allocatable :: micm_species(:) + type(musica_species_t), allocatable :: tuvx_species(:) integer :: number_of_grid_cells ! Temporary fix until the number of grid cells is only needed to create a MICM state @@ -32,15 +36,20 @@ subroutine musica_ccpp_register(constituent_props, errmsg, & ! 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) + micm_species, errmsg, errcode) if (errcode /= 0) return constituent_props = constituent_props_subset deallocate(constituent_props_subset) - call tuvx_register(constituent_props_subset, errmsg, errcode) + call tuvx_register(micm_species, tuvx_species, constituent_props_subset, & + errmsg, errcode) if (errcode /= 0) return constituent_props = [ constituent_props, constituent_props_subset ] + call register_musica_species(micm_species, tuvx_species) + call check_tuvx_species_initialization(errmsg, errcode) + if (errcode /= 0) return + end subroutine musica_ccpp_register !> \section arg_table_musica_ccpp_init Argument Table @@ -50,10 +59,13 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & photolysis_wavelength_grid_interfaces, & constituent_props, errmsg, errcode) 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 + 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 + use musica_ccpp_species, only: initialize_musica_species_indices, initialize_molar_mass_array, & + check_initialization + integer, intent(in) :: horizontal_dimension ! (count) integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) @@ -73,9 +85,15 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & call micm_init(errmsg, errcode) if (errcode /= 0) return call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & - photolysis_wavelength_grid_interfaces, & - micm%user_defined_reaction_rates, & - constituent_props, errmsg, errcode) + photolysis_wavelength_grid_interfaces, & + micm%user_defined_reaction_rates, errmsg, errcode) + if (errcode /= 0) return + + call initialize_musica_species_indices(constituent_props, errmsg, errcode) + if (errcode /= 0) return + call initialize_molar_mass_array(constituent_props, errmsg, errcode) + if (errcode /= 0) return + call check_initialization(errmsg, errcode) if (errcode /= 0) return end subroutine musica_ccpp_init @@ -98,6 +116,8 @@ 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_species, only: number_of_micm_species, number_of_tuvx_species, & + micm_molar_mass_array, extract_subset_constituents, update_constituents real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K @@ -122,15 +142,22 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co integer, intent(out) :: errcode ! local variables - real(kind_phys), dimension(size(constituents, dim=3)) :: molar_mass_arr ! kg mol-1 real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_rate_parameters) :: rate_parameters ! various units - integer :: i_elem + number_of_micm_species) :: constituents_micm_species ! kg kg-1 + real(kind_phys), dimension(size(constituents, dim=1), & + size(constituents, dim=2), & + number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 + real(kind_phys), dimension(size(constituents, dim=1), & + size(constituents, dim=2), & + number_of_rate_parameters) :: rate_parameters ! various units + + call extract_subset_constituents(constituents, constituents_tuvx_species, errcode, errmsg) + if (errcode /= 0) return ! Calculate photolysis rate constants using TUV-x call tuvx_run(temperature, dry_air_density, & - constituents, & + constituents_tuvx_species, & geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & @@ -145,43 +172,35 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co rate_parameters, & errmsg, errcode) - ! Get the molar mass that is set in the call to instantiate() - do i_elem = 1, size(molar_mass_arr) - call constituent_props(i_elem)%molar_mass(molar_mass_arr(i_elem), errcode, errmsg) - if (errcode /= 0) then - errmsg = "[MUSICA Error] Unable to get molar mass." - return - end if - end do - - ! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison - ! this code will be deleted when the framework does the check - do i_elem = 1, size(molar_mass_arr) - if (molar_mass_arr(i_elem) <= 0) then - errcode = 1 - errmsg = "[MUSICA Error] Molar mass must be greater than zero." - return - end if - end do + call update_constituents(constituents_tuvx_species, constituents, errmsg, errcode) + if (errcode /= 0) return + + call extract_subset_constituents(constituents, constituents_micm_species, errcode, errmsg) + if (errcode /= 0) return ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) - call convert_to_mol_per_cubic_meter(dry_air_density, molar_mass_arr, constituents) + call convert_to_mol_per_cubic_meter(dry_air_density, micm_molar_mass_array, constituents_micm_species) ! Solve chemistry at the current time step call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, & - constituents, errmsg, errcode) + constituents_micm_species, errmsg, errcode) ! Convert MICM unit back to CAM-SIMA unit (mol m-3 -> kg kg-1) - call convert_to_mass_mixing_ratio(dry_air_density, molar_mass_arr, constituents) + call convert_to_mass_mixing_ratio(dry_air_density, micm_molar_mass_array, constituents_micm_species) + call update_constituents(constituents_micm_species, constituents, errmsg, errcode) + if (errcode /= 0) return + end subroutine musica_ccpp_run !> \section arg_table_musica_ccpp_final Argument Table !! \htmlinclude musica_ccpp_final.html subroutine musica_ccpp_final(errmsg, errcode) + use musica_ccpp_species, only: cleanup_musica_species character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + call cleanup_musica_species() call tuvx_final(errmsg, errcode) call micm_final(errmsg, errcode) diff --git a/schemes/musica/musica_ccpp_load_tuvx_species.F90 b/schemes/musica/musica_ccpp_load_tuvx_species.F90 index 93f5f0c7..d434e37a 100644 --- a/schemes/musica/musica_ccpp_load_tuvx_species.F90 +++ b/schemes/musica/musica_ccpp_load_tuvx_species.F90 @@ -1,58 +1,63 @@ module muscia_ccpp_load_tuvx_species - use musica_ccpp_species + use musica_ccpp_species, only: MUSICA_INT_UNASSIGNED implicit none private public :: configure_tuvx_species + + integer, protected, public :: index_cloud_liquid_water_content = MUSICA_INT_UNASSIGNED + integer, protected, public :: index_dry_air = MUSICA_INT_UNASSIGNED + integer, protected, public :: index_O2 = MUSICA_INT_UNASSIGNED + integer, protected, public :: index_O3 = MUSICA_INT_UNASSIGNED + + ! Constants + ! Clould liquid water + character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_LABEL = & + 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' + character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_LONG_NAME = & + 'cloud water mass mixing ratio with respect to moist air plus all airborne condensates' + character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_UNITS = 'kg kg-1' + real(kind_phys), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS = 0.018_kind_phys ! kg mol-1 + ! Gas species - dry air, O2, O3 + character(len=*), parameter, public :: TUVX_GAS_SPECIES_UNITS = 'molecule cm-3' + real(kind_phys), parameter, public :: SCALE_HEIGHT_DRY_AIR = 8.01_kind_phys ! km + real(kind_phys), parameter, public :: SCALE_HEIGHT_O2 = 7.0_kind_phys ! km + real(kind_phys), parameter, public :: SCALE_HEIGHT_O3 = 7.0_kind_phys ! km + !> Molar mass value of dry air is obtained from 'CAM-SIMA/src/utils/std_atm_profile.F90' + real(kind_phys), parameter, public :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 + real(kind_phys), parameter, public :: MOLAR_MASS_O2 = 0.0319988_kind_phys ! kg mol-1 + real(kind_phys), parameter, public :: MOLAR_MASS_O3 = 0.0479982_kind_phys ! kg mol-1 + contains -call configure_tuvx_species(constituent_props, musica_species, tuvx_specific_species, & -errmsg, errcode) - ! Add constituent props and then create musica_species + + ! Add constituent props and then create micm_species ! This is another reason in favor of moving all mechanism parsing of open atmos; ! you could choose to do this and it would be valid. For micm, we always want ! a full mechanism becauase that's what we need - subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specific_species, & + subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, & errmsg, errcode) - use ccpp_kinds, only: kind_phys use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t use musica_util, only: error_t - type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) - type(musica_species_t), allocatable, intent(inout) :: musica_species(:) - type(musica_species_t), allocatable, intent(inout) :: tuvx_specific_species(:) - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + type(musica_species_t), intent(in) :: micm_species(:) + type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) + type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode ! local variables integer :: num_new_species = 4 - integer :: num_registered_species = size(musica_species) + integer :: num_registered_species = size(micm_species) type(ccpp_constituent_properties_t) :: temp_constituent_props(num_new_species) - type(musica_species_t) :: temp_musica_species(num_new_species) - type(musica_species_t) :: copy_musica_species(num_registered_species) + logical :: is_dry_air_registered = .false. logical :: is_O2_registered = .false. logical :: is_O3_registered = .false. - logical :: is_dry_air_registered = .false. - integer :: i_new, i_registered - - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LABEL = & - 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LONG_NAME = & - 'cloud water mass mixing ratio with respect to moist air plus all airborne condensates' - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_UNITS = 'kg kg-1' - real(kind_phys), parameter :: CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS = 0.018_kind_phys ! kg mol-1 - real(kind_phys), parameter :: SCALE_HEIGHT_DRY_AIR = 8.01_kind_phys ! km - real(kind_phys), parameter :: SCALE_HEIGHT_O2 = 7.0_kind_phys ! km - real(kind_phys), parameter :: SCALE_HEIGHT_O3 = 7.0_kind_phys ! km - !> Molar mass value of dry air is obtained from 'CAM-SIMA/src/utils/std_atm_profile.F90' - ! TODO(jiwon) - how to make this an input argument? - real(kind_phys), parameter :: MOLAR_MASS_DRY_AIR = 0.0289644_kind_phys ! kg mol-1 - real(kind_phys), parameter :: MOLAR_MASS_O2 = 0.0319988_kind_phys ! kg mol-1 - real(kind_phys), parameter :: MOLAR_MASS_O3 = 0.0479982_kind_phys ! kg mol-1 + integer :: i_new, i_registered, i_tuvx_species ! Register cloud liquid water content needed for cloud optics calculations - i_new = 1 + i_new = 1 call temp_constituent_props(i_new)%instantiate( & std_name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & long_name = CLOUD_LIQUID_WATER_CONTENT_LONG_NAME, & @@ -66,12 +71,6 @@ subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specif errmsg = errmsg ) if (errcode /= 0) return - temp_musica_species(i_new) = musica_species_t( & - name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & - unit = CLOUD_LIQUID_WATER_CONTENT_UNITS, & - molar_mass = CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS, & - index_musica_species = num_registered_species + i_new ) - ! Add gas species - dry air, O2, O3 - to be profiled ! iterate through all the registered species to ! check if the species is already registered and if so @@ -79,25 +78,24 @@ subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specif do i_registered = 1, num_registered_species if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit - if (musica_species(i)%name == "dry_air") then + if (micm_species(i)%name == "dry_air") then is_dry_air_registered = .true. - musica_species(i_registered)%profiled = .true. - musica_species(i_registered)%scale_height = SCALE_HEIGHT_DRY_AIR - else if ( musica_species(i_registered)%name == "O2" ) then + micm_species(i_registered)%profiled = .true. + micm_species(i_registered)%scale_height = SCALE_HEIGHT_DRY_AIR + else if ( micm_species(i_registered)%name == "O2" ) then is_O2_registered = .true. - musica_species(i_registered)%profiled = .true. - musica_species(i_registered)%scale_height = SCALE_HEIGHT_O2 - else if (musica_species(i)%name == "O3") then + micm_species(i_registered)%profiled = .true. + micm_species(i_registered)%scale_height = SCALE_HEIGHT_O2 + else if (micm_species(i)%name == "O3") then is_O3_registered = .true. - musica_species(i_registered)%profiled = .true. - musica_species(i_registered)%scale_height = SCALE_HEIGHT_O3 + micm_species(i_registered)%profiled = .true. + micm_species(i_registered)%scale_height = SCALE_HEIGHT_O3 end if end do if (.not. is_dry_air_registered) then i_new = i_new + 1 - - call constituent_props(i_new)%instantiate( & + call temp_constituent_props(i_new)%instantiate( & std_name = 'dry_air', & long_name = 'dry_air', & units = 'kg kg-1', & @@ -109,20 +107,11 @@ subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specif errcode = errcode, & errmsg = errmsg ) if (errcode /= 0) return - - temp_musica_species(i_new) = musica_species_t( & - name = 'dry_air', & - unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit - molar_mass = MOLAR_MASS_DRY_AIR, & ! kg mol-1 - index_musica_species = num_registered_species + i_new, & - profiled = .true., & - scale_height = SCALE_HEIGHT_DRY_AIR ) end if if (.not. is_O2_registered) then i_new = i_new + 1 - - call constituent_props(i_new)%instantiate( & + call temp_constituent_props(i_new)%instantiate( & std_name = 'O2', & long_name = 'O2', & units = 'kg kg-1', & @@ -134,20 +123,11 @@ subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specif errcode = errcode, & errmsg = errmsg ) if (errcode /= 0) return - - temp_musica_species(i_new) = musica_species_t( & - name = 'O2', & - unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit - molar_mass = MOLAR_MASS_DRY_O2, & ! kg mol-1 - index_musica_species = num_registered_species + i_new, & - profiled = .true., & - scale_height = SCALE_HEIGHT_O2 ) end if if (.not. is_O3_registered) then i_new = i_new + 1 - - call constituent_props(i_new)%instantiate( & + call temp_constituent_props(i_new)%instantiate( & std_name = 'O3', & long_name = 'O3', & units = 'kg kg-1', & @@ -159,26 +139,68 @@ subroutine configure_tuvx_species(constituent_props, musica_species, tuvx_specif errcode = errcode, & errmsg = errmsg ) if (errcode /= 0) return - - temp_musica_species(i_new) = musica_species_t( & - name = 'O3', & - unit = "molecule cm-3", & ! TUVX profile unit, which can be different from molar mass unit - molar_mass = MOLAR_MASS_DRY_O3, & ! kg mol-1 - index_musica_species = num_registered_species + i_new, & - profiled = .true., & - scale_height = SCALE_HEIGHT_O3 ) end if - allocate( constituent_props( size(i_new) ) ) - constituent_props(:) = temp_musica_species(1:i_new) + allocate(tuvx_species(num_new_species)) + i_tuvx_species = 1 + index_cloud_liquid_water_content = i_tuvx_species + tuvx_species(i_tuvx_species) = musica_species_t( & + name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & + unit = CLOUD_LIQUID_WATER_CONTENT_UNITS, & + molar_mass = CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS, & + index_musica_species = i_tuvx_species ) + + i_tuvx_species = i_tuvx_species + 1 + index_dry_air = i_tuvx_species + tuvx_species(i_tuvx_species) = musica_species_t( & + name = 'dry_air', & + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_AIR, & ! kg mol-1 + index_musica_species = i_tuvx_species, & + profiled = .true., & + scale_height = SCALE_HEIGHT_DRY_AIR ) + + i_tuvx_species = i_tuvx_species + 1 + index_O2 = i_tuvx_species + tuvx_species(i_tuvx_species) = musica_species_t( & + name = 'O2', & + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_O2, & ! kg mol-1 + index_musica_species = i_tuvx_species, & + profiled = .true., & + scale_height = SCALE_HEIGHT_O2 ) + + i_tuvx_species = i_tuvx_species + 1 + index_O3 = i_tuvx_species + tuvx_species(i_tuvx_species) = musica_species_t( & + name = 'O3', & + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + molar_mass = MOLAR_MASS_DRY_O3, & ! kg mol-1 + index_musica_species = i_tuvx_species, & + profiled = .true., & + scale_height = SCALE_HEIGHT_O3 ) + + allocate( constituent_props(i_new) ) + constituent_props(:) = temp_constituent_props(1:i_new) - if (i_new > 0 ) then - copy_musica_species = musica_species - deallocate( musica_species ) - allocate( musica_species( num_registered_species + i_new )) - musica_species = [ copy_musica_species, temp_musica_species ] + end subroutine configure_tuvx_species + + subroutine check_tuvx_species_initialization(errmsg, errcode) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + errmsg = '' + errcode = 0 + + if ((index_cloud_liquid_water_content == MUSICA_INT_UNASSIGNED) .or. & + (index_dry_air == MUSICA_INT_UNASSIGNED) .or. & + (index_O2 == MUSICA_INT_UNASSIGNED) .or. & + (index_O3== MUSICA_INT_UNASSIGNED)) then + errmsg = "[MUSICA Error] TUV-x species index (or indices) has not been initialized." + errcode = 1 + return end if - end subroutine configure_tuvx_species + end subroutine check_tuvx_species_initialization end module muscia_ccpp_load_tuvx_species diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 new file mode 100644 index 00000000..2f5d6e4e --- /dev/null +++ b/schemes/musica/musica_ccpp_species.F90 @@ -0,0 +1,296 @@ +module musica_ccpp_species + ! This module owns musica species + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: cleanup_musica_species, register_musica_species, initialize_musica_species_indices, & + initialize_molar_mass_array, extract_subset_constituents, update_constituents + + integer, parameter, public :: MUSICA_INT_UNASSIGNED = -99999 + + ! Species are ordered to match the sequence of the MICM state array + type(musica_species_t), allocatable, protected, public :: micm_species_set(:) ! index should match with the MICM state array + type(musica_species_t), allocatable, protected, public :: tuvx_species_set(:) + integer, allocatable, protected, public :: micm_indices_constituent_props(:) + integer, allocatable, protected, public :: tuvx_indices_constituent_props(:) + real(kind_phys), allocatable, protected, public :: micm_molar_mass_array(:) ! kg mol-1 + integer, protected, public :: number_of_micm_species = MUSICA_INT_UNASSIGNED + integer, protected, public :: number_of_tuvx_speceis = MUSICA_INT_UNASSIGNED + + !> Definition of the gas species type + type, public :: musica_species_t + character(len=:), allocatable :: name + character(len=:), allocatable :: unit + real(kind_phys) :: molar_mass ! kg mol-1 + integer :: index_musica_species = MUSICA_INT_UNASSIGNED + integer :: index_constituent_props = MUSICA_INT_UNASSIGNED + logical :: profiled = .false. ! optional + real(kind_phys) :: scale_height = 0.0_kind_phys ! km, optional + end type musica_species_t + + type, public :: musica_species_ptr_t + type(musica_species_t), pointer :: species + end type musica_species_ptr_t + +contains + + !> Constructor for gas_species_t object + function species_t_constructor(name, molar_mass, index_musica_species, & + index_constituent_props) result( this ) + + character(len=*), intent(in) :: name + real(kind_phys), intent(in) :: molar_mass ! kg mol-1 + integer, intent(in) :: index_musica_species + integer, intent(in) :: index_constituent_props + type(gas_species_t) :: this + index_musica_species + this%name = name + this%molar_mass = molar_mass + this%index_musica_species = index_musica_species + this%index_constituent_props = index_constituent_props + + end function species_t_constructor + + !> Constructor for gas_species_t object + function species_profiled_t_constructor(name, unit, molar_mass, scale_height, & + index_musica_species, index_constituent_props) result( this ) + + character(len=*), intent(in) :: name + character(len=*), intent(in) :: unit + real(kind_phys), intent(in) :: molar_mass ! kg mol-1 + real(kind_phys), intent(in) :: scale_height ! km + integer, intent(in) :: index_musica_species + integer, intent(in) :: index_constituent_props + type(gas_species_t) :: this + + this%name = name + this%unit = unit + this%molar_mass = molar_mass + this%scale_height = scale_height + this%index_musica_species = index_musica_species + this%index_constituent_props = index_constituent_props + + end function species_profiled_t_constructor + + subroutine cleanup_musica_species() + + if (allocated( micm_species_set )) deallocate( micm_species_set ) + if (allocated( micm_indices_constituent_props )) deallocate( micm_indices_constituent_props ) + if (allocated( tuvx_species_set )) deallocate( tuvx_species_set ) + if (allocated( tuvx_indices_constituent_props )) deallocate( tuvx_indices_constituent_props ) + if (allocated( micm_molar_mass_array )) deallocate( micm_molar_mass_array ) + + end subroutine cleanup_musica_species + + subroutine register_musica_species(micm_species, tuvx_species) + type(musica_species_t), intent(in) :: micm_species(:) + type(musica_species_t), intent(in) :: tuvx_species(:) + + number_of_micm_species = size(micm_species) + allocate( micm_species_set( number_of_micm_species ) ) + micm_species_set = micm_species + number_of_micm_species = size(micm_species) + allocate( tuvx_elements_set( size(tuvx_species)) ) + tuvx_species_set = tuvx_species + + end subroutine register_musica_species + + !> Retrieve the species indices from the constituents array and store them + subroutine find_musica_species_indices(constituent_props, musica_species_set, & + indices_constituent_props, errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + + type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) + type(musica_species_t), intent(inout) :: musica_species_set(:) + integer, intent(inout) :: indices_constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + integer :: i_elem, index_species + + do i_elem = 1, size(musica_species_set) + call ccpp_const_get_idx(constituent_props, musica_species_set(i_elem)%name, & + musica_species_set(i_elem)%index_constituent_props, errmsg, errcode) + if (errcode /= 0) return + + index_species = musica_species_set(i_elem)%index_constituent_props + if (index_species == MUSICA_INT_UNASSIGNED) then + errmsg = "[MUSICA Error] Unable to find index for ", musica_species_set(i_elem)%name + errcode = 1 + return + end if + indices_constituent_props(i_elem) = index_species + end do + + end subroutine find_musica_species_indices + + !> Initialize arrays to store the species indices of the CCPP constituents + subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + + type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + if (.not. allocated( micm_species_set ) .or. + .not. allocated( tuvx_species_set )) then + errmsg = "[MUSICA Error] The MUSICA species set(s) are not allocated." + errcode = 1 + return + end if + + allocate( micm_indices_constituent_props( size(micm_species_set) ) ) + call find_musica_species_indices(constituent_props, micm_species_set, & + micm_indices_constituent_props, errmsg, errcode) + if (errcode /= 0) return + + allocate( tvux_indices_constituent_props( size(tuvx_species_set) ) ) + call find_musica_species_indices(constituent_props, tuvx_species_set, & + tuvx_indices_constituent_props, errmsg, errcode) + if (errcode /= 0) return + + end subroutine initialize_musica_species_indices + + subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + + type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + integer :: i_elem, index_species + + if (.not. allocated( micm_species_set )) then + errmsg = "[MUSICA Error] The MICM species set is not allocated." + errcode = 1 + return + end if + + allocate( micm_molar_mass_array( size(micm_species_set) ) ) + do i_elem = 1, size(micm_species_set) + call constituent_props( micm_species_set(i_elem)%index_constituent_props ) & + %molar_mass( micm_molar_mass_array(i_elem), errcode, errmsg ) + if (errcode /= 0) then + errmsg = "[MUSICA Error] Unable to get molar mass for ", micm_species_set(i_elem)%name + return + end if + end do + + ! Ask if this has been implemented + ! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison + ! this code will be deleted when the framework does the check + do i_elem = 1, size(micm_molar_mass_array) + if (micm_molar_mass_array(i_elem) <= 0) then + errcode = 1 + errmsg = "[MUSICA Error] Molar mass must be greater than zero for ", & + micm_species_set(i_elem)%name + return + end if + end do + + end subroutine initialize_molar_mass_array + + !> Extract sub-constituents array using the indices from constituents array + subroutine extract_subset_constituents(constituents, subset_constituents, errmsg, errcode) + + real(kind_phys), intent(in) :: constituents(:,:,:) ! kg kg-1 + real(kind_phys), intent(inout) :: subset_constituents(:,:,:) ! kg kg-1 + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + integer :: i_elem + + if ( size(subset_constituents, dim=3) == number_of_micm_species ) then + do i_elem = 1, number_of_micm_species + subset_constituents(:,:,i_elem) = constituents(:,:,micm_indices_constituent_props(i_elem)) + end do + else if ( size(subset_constituents, dim=3) == number_of_tuvx_species ) then + do i_elem = 1, number_of_tuvx_species + subset_constituents(:,:,i_elem) = constituents(:,:,tuvx_indices_constituent_props(i_elem)) + end do + else + errmsg = "[MUSICA Error] The given dimension for the constituents & + doesn't match the size of any species array." + errcode = 1 + return + end if + + end subroutine extract_subset_constituents + + subroutine update_constituents(subset_constituents, constituents, errmsg, errcode) + + real(kind_phys), intent(in) :: subset_constituents(:,:,:) ! kg kg-1 + real(kind_phys), intent(inout) :: constituents(:,:,:) ! kg kg-1 + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + integer :: i_elem + + if ( size(subset_constituents, dim=3) == number_of_micm_species ) then + do i_elem = 1, number_of_micm_species + constituents(:,:,micm_indices_constituent_props(i_elem)) = subset_constituents(:,:,i_elem) + end do + else if ( size(subset_constituents, dim=3) == number_of_tuvx_species ) then + do i_elem = 1, number_of_tuvx_species + constituents(:,:,tuvx_indices_constituent_props(i_elem)) = subset_constituents(:,:,i_elem) + end do + else + errmsg = "[MUSICA Error] The given dimension for the constituents & + doesn't match the size of any species array." + errcode = 1 + return + end if + + end subroutine update_constituents + + subroutine check_initialization(errmsg, errcode) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + if (.not. allocated( micm_species_set )) then + errmsg = "[MUSICA Error] MICM species set has not been allocated." + errcode = 1 + return + end if + if (.not. allocated( micm_indices_constituent_props )) then + errmsg = "[MUSICA Error] MICM species indices array has not been allocated." + errcode = 1 + return + end if + if (.not. allocated( tuvx_species_set )) then + errmsg = "[MUSICA Error] TUV-X species set has not been allocated." + errcode = 1 + return + end if + + if (.not. allocated( tuvx_indices_constituent_props )) then + errmsg = "[MUSICA Error] TUV-X species indices array has not been allocated." + errcode = 1 + return + end if + if (.not. allocated( micm_molar_mass_array )) then + errmsg = "[MUSICA Error] MICM molar mass array has not been allocated." + errcode = 1 + return + end if + if (number_of_micm_species == MUSICA_INT_UNASSIGNED) then + errmsg = "[MUSICA Error] The 'number_of_micm_species' variable has not been initialized." + errcode = 1 + return + end if + if (number_of_tuvx_speceis == MUSICA_INT_UNASSIGNED) then + errmsg = "[MUSICA Error] The 'number_of_tuvx_species' variable has not been initialized." + errcode = 1 + return + end if + + end subroutine check_initialization + +end module musica_ccpp_species \ No newline at end of file diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 6e95bde0..58ab1267 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -26,14 +26,6 @@ module musica_ccpp_tuvx type(index_mappings_t), pointer :: photolysis_rate_constants_mapping => null( ) integer, parameter :: DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS = 0 integer :: number_of_photolysis_rate_constants = DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS - integer, parameter :: DEFAULT_INDEX_NOT_FOUND = -1 - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LABEL = & - 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_LONG_NAME = & - 'Cloud water mass mixing ratio with respect to moist air plus all airborne condensates' - character(len=*), parameter :: CLOUD_LIQUID_WATER_CONTENT_UNITS = 'kg kg-1' - real(kind_phys), parameter :: CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS = 0.018_kind_phys ! kg mol-1 - integer :: index_cloud_liquid_water_content = DEFAULT_INDEX_NOT_FOUND contains @@ -92,33 +84,21 @@ subroutine cleanup_tuvx_resources() end subroutine cleanup_tuvx_resources !> Registers constituent properties with the CCPP needed by TUV-x - subroutine tuvx_register(constituent_props, errmsg, errcode) - use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_util, only: error_t - + subroutine tuvx_register(constituent_props, musica_species, tuvx_specific_species, & + errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t + use musica_ccpp_load_tuvx_species, only: configure_tuvx_species + use musica_util, only: error_t + + type(musica_species_t), intent(in) :: micm_species(:) + type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - allocate(constituent_props(1), stat=errcode) - if (errcode /= 0) then - errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties." - return - end if - - ! Register cloud liquid water content needed for cloud optics calculations - call constituent_props(1)%instantiate( & - std_name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & - long_name = CLOUD_LIQUID_WATER_CONTENT_LONG_NAME, & - units = CLOUD_LIQUID_WATER_CONTENT_UNITS, & - vertical_dim = "vertical_layer_dimension", & - default_value = 0.0_kind_phys, & - min_value = 0.0_kind_phys, & - molar_mass = CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS, & - advected = .true., & - errcode = errcode, & - errmsg = errmsg & - ) + call configure_tuvx_species(micm_species, tuvx_species, constituent_props, & + errmsg, errcode) if (errcode /= 0) return end subroutine tuvx_register @@ -126,8 +106,7 @@ end subroutine tuvx_register !> Initializes TUV-x subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & wavelength_grid_interfaces, micm_rate_parameter_ordering, & - constituent_props, errmsg, errcode) - use ccpp_const_utils, only: ccpp_const_get_idx + errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t use musica_tuvx, only: grid_map_t, profile_map_t, radiator_map_t use musica_util, only: error_t, configuration_t @@ -151,7 +130,6 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & integer, intent(in) :: vertical_interface_dimension ! (count) real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m type(mappings_t), intent(in) :: micm_rate_parameter_ordering ! index mappings for MICM rate parameters - type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -163,16 +141,6 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & type(mappings_t), pointer :: photolysis_rate_constants_ordering type(error_t) :: error - ! Get needed indices in constituents array - call ccpp_const_get_idx(constituent_props, CLOUD_LIQUID_WATER_CONTENT_LABEL, & - index_cloud_liquid_water_content, errmsg, errcode) - if (errcode /= 0) return - if (index_cloud_liquid_water_content == DEFAULT_INDEX_NOT_FOUND) then - errmsg = "[MUSICA Error] Unable to find index for cloud liquid water content." - errcode = 1 - return - end if - grids => grid_map_t( error ) if (has_error_occurred( error, errmsg, errcode )) return @@ -411,7 +379,7 @@ end subroutine tuvx_init !> Calculates photolysis rate constants for the current model conditions subroutine tuvx_run(temperature, dry_air_density, & - constituents, & + constituents_tuvx_species, & geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & @@ -425,17 +393,18 @@ subroutine tuvx_run(temperature, dry_air_density, & 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 - use musica_ccpp_tuvx_temperature, only: set_temperature_values - 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 - use musica_ccpp_tuvx_cloud_optics, only: set_cloud_optics_values + 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, PI + use musica_ccpp_tuvx_surface_albedo, only: set_surface_albedo_values + use musica_ccpp_tuvx_extraterrestrial_flux, only: set_extraterrestrial_flux_values + use musica_ccpp_tuvx_cloud_optics, only: set_cloud_optics_values + use musica_ccpp_load_tuvx_species, only: index_cloud_liquid_water_content 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) :: constituents_tuvx_species(:,:,:) ! 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 @@ -486,7 +455,7 @@ subroutine tuvx_run(temperature, dry_air_density, & geopotential_height_wrt_surface_at_interface(i_col,:), & surface_geopotential(i_col), & reciprocal_of_gravitational_acceleration, & - height_midpoints, height_interfaces ) + height_midpoints, height_interfaces ) call set_height_grid_values( height_grid, height_midpoints, height_interfaces, & errmsg, errcode ) if (errcode /= 0) return @@ -496,10 +465,9 @@ subroutine tuvx_run(temperature, dry_air_density, & 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 ) + air_pressure_thickness(i_col,:), & + constituents_tuvx_species(i_col,:,index_cloud_liquid_water_content), & + reciprocal_of_gravitational_acceleration, errmsg, errcode ) if (errcode /= 0) return ! calculate photolysis rate constants and heating rates From 2c8178c70363afd8f7c998aa33505dc864f989a3 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 18 Dec 2024 14:03:08 -0700 Subject: [PATCH 03/18] fix compiler errors --- schemes/musica/musica_ccpp.F90 | 62 ++++++++-------- .../musica/musica_ccpp_load_tuvx_species.F90 | 49 +++++++------ schemes/musica/musica_ccpp_species.F90 | 72 ++++++++----------- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 40 +++++------ 4 files changed, 110 insertions(+), 113 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index a045e23d..20629fd9 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -15,10 +15,10 @@ module musica_ccpp !> \section arg_table_musica_ccpp_register Argument Table !! \htmlinclude musica_ccpp_register.html subroutine musica_ccpp_register(constituent_props, errmsg, errcode) - use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_ccpp_namelist, only: micm_solver_type - use musica_ccpp_species, only: musica_species_t, register_musica_species, & - check_tuvx_species_initialization + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_namelist, only: micm_solver_type + use musica_ccpp_species, only: musica_species_t, register_musica_species + use musica_ccpp_load_tuvx_species, only: check_tuvx_species_initialization type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg @@ -57,31 +57,35 @@ end subroutine musica_ccpp_register subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & vertical_interface_dimension, & photolysis_wavelength_grid_interfaces, & - constituent_props, errmsg, errcode) - use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t, ccpp_constituent_prop_ptr_t + constituent_props_ptr, errmsg, errcode) + use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t, ccpp_constituent_properties_t use ccpp_kinds, only: kind_phys use musica_ccpp_micm, only: micm use musica_ccpp_namelist, only: micm_solver_type use musica_ccpp_util, only: has_error_occurred use musica_ccpp_species, only: initialize_musica_species_indices, initialize_molar_mass_array, & - check_initialization + check_initialization, musica_species_t 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 - type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) + type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props_ptr(:) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - integer :: number_of_grid_cells - type(ccpp_constituent_properties_t), allocatable :: micm_species_props(:) + ! local variables + type(ccpp_constituent_properties_t), allocatable :: constituent_props(:) + type(musica_species_t), allocatable :: micm_species(:) + integer :: number_of_grid_cells ! Temporary fix until the number of grid cells is only needed to create a MICM state ! instead of when the solver is created. ! Re-create the MICM solver with the correct number of grid cells number_of_grid_cells = horizontal_dimension * vertical_layer_dimension - call micm_register(micm_solver_type, number_of_grid_cells, micm_species_props, errmsg, errcode) + ! TODO(jiwon) - have to clean up before this gets called again + call micm_register(micm_solver_type, number_of_grid_cells, constituent_props, & + micm_species, errmsg, errcode) call micm_init(errmsg, errcode) if (errcode /= 0) return call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & @@ -89,9 +93,9 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & micm%user_defined_reaction_rates, errmsg, errcode) if (errcode /= 0) return - call initialize_musica_species_indices(constituent_props, errmsg, errcode) + call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode) if (errcode /= 0) return - call initialize_molar_mass_array(constituent_props, errmsg, errcode) + call initialize_molar_mass_array(constituent_props_ptr, errmsg, errcode) if (errcode /= 0) return call check_initialization(errmsg, errcode) if (errcode /= 0) return @@ -152,30 +156,30 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co size(constituents, dim=2), & number_of_rate_parameters) :: rate_parameters ! various units - call extract_subset_constituents(constituents, constituents_tuvx_species, errcode, errmsg) + call extract_subset_constituents(constituents, constituents_tuvx_species, errmsg, errcode) if (errcode /= 0) return ! Calculate photolysis rate constants using TUV-x - call tuvx_run(temperature, dry_air_density, & - constituents_tuvx_species, & - geopotential_height_wrt_surface_at_midpoint, & - geopotential_height_wrt_surface_at_interface, & - surface_geopotential, surface_temperature, & - surface_albedo, & - photolysis_wavelength_grid_interfaces, & - extraterrestrial_flux, & - standard_gravitational_acceleration, & - cloud_area_fraction, & - air_pressure_thickness, & - solar_zenith_angle, & - earth_sun_distance, & - rate_parameters, & + call tuvx_run(temperature, dry_air_density, & + constituents_tuvx_species, & + geopotential_height_wrt_surface_at_midpoint, & + geopotential_height_wrt_surface_at_interface, & + surface_geopotential, surface_temperature, & + surface_albedo, & + photolysis_wavelength_grid_interfaces, & + extraterrestrial_flux, & + standard_gravitational_acceleration, & + cloud_area_fraction, & + air_pressure_thickness, & + solar_zenith_angle, & + earth_sun_distance, & + rate_parameters, & errmsg, errcode) call update_constituents(constituents_tuvx_species, constituents, errmsg, errcode) if (errcode /= 0) return - call extract_subset_constituents(constituents, constituents_micm_species, errcode, errmsg) + call extract_subset_constituents(constituents, constituents_micm_species, errmsg, errcode) if (errcode /= 0) return ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) diff --git a/schemes/musica/musica_ccpp_load_tuvx_species.F90 b/schemes/musica/musica_ccpp_load_tuvx_species.F90 index d434e37a..6369b00b 100644 --- a/schemes/musica/musica_ccpp_load_tuvx_species.F90 +++ b/schemes/musica/musica_ccpp_load_tuvx_species.F90 @@ -1,10 +1,11 @@ -module muscia_ccpp_load_tuvx_species +module musica_ccpp_load_tuvx_species + use ccpp_kinds, only: kind_phys use musica_ccpp_species, only: MUSICA_INT_UNASSIGNED implicit none private - public :: configure_tuvx_species + public :: configure_tuvx_species, check_tuvx_species_initialization integer, protected, public :: index_cloud_liquid_water_content = MUSICA_INT_UNASSIGNED integer, protected, public :: index_dry_air = MUSICA_INT_UNASSIGNED @@ -41,20 +42,22 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, use musica_ccpp_species, only: musica_species_t use musica_util, only: error_t - type(musica_species_t), intent(in) :: micm_species(:) - type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) - type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + type(musica_species_t), intent(inout) :: micm_species(:) + type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) + type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode ! local variables integer :: num_new_species = 4 - integer :: num_registered_species = size(micm_species) - type(ccpp_constituent_properties_t) :: temp_constituent_props(num_new_species) + integer :: num_micm_species + type(ccpp_constituent_properties_t) :: temp_constituent_props(4) logical :: is_dry_air_registered = .false. logical :: is_O2_registered = .false. logical :: is_O3_registered = .false. - integer :: i_new, i_registered, i_tuvx_species + integer :: i_new, i_species, i_tuvx_species + + num_micm_species = size(micm_species) ! Register cloud liquid water content needed for cloud optics calculations i_new = 1 @@ -75,21 +78,21 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, ! iterate through all the registered species to ! check if the species is already registered and if so ! update scale_height - do i_registered = 1, num_registered_species + do i_species = 1, num_micm_species if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit - if (micm_species(i)%name == "dry_air") then + if ( micm_species(i_species)%name == "dry_air" ) then is_dry_air_registered = .true. - micm_species(i_registered)%profiled = .true. - micm_species(i_registered)%scale_height = SCALE_HEIGHT_DRY_AIR - else if ( micm_species(i_registered)%name == "O2" ) then + micm_species(i_species)%profiled = .true. + micm_species(i_species)%scale_height = SCALE_HEIGHT_DRY_AIR + else if ( micm_species(i_species)%name == "O2" ) then is_O2_registered = .true. - micm_species(i_registered)%profiled = .true. - micm_species(i_registered)%scale_height = SCALE_HEIGHT_O2 - else if (micm_species(i)%name == "O3") then + micm_species(i_species)%profiled = .true. + micm_species(i_species)%scale_height = SCALE_HEIGHT_O2 + else if ( micm_species(i_species)%name == "O3" ) then is_O3_registered = .true. - micm_species(i_registered)%profiled = .true. - micm_species(i_registered)%scale_height = SCALE_HEIGHT_O3 + micm_species(i_species)%profiled = .true. + micm_species(i_species)%scale_height = SCALE_HEIGHT_O3 end if end do @@ -165,7 +168,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, tuvx_species(i_tuvx_species) = musica_species_t( & name = 'O2', & unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit - molar_mass = MOLAR_MASS_DRY_O2, & ! kg mol-1 + molar_mass = MOLAR_MASS_O2, & ! kg mol-1 index_musica_species = i_tuvx_species, & profiled = .true., & scale_height = SCALE_HEIGHT_O2 ) @@ -175,7 +178,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, tuvx_species(i_tuvx_species) = musica_species_t( & name = 'O3', & unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit - molar_mass = MOLAR_MASS_DRY_O3, & ! kg mol-1 + molar_mass = MOLAR_MASS_O3, & ! kg mol-1 index_musica_species = i_tuvx_species, & profiled = .true., & scale_height = SCALE_HEIGHT_O3 ) @@ -203,4 +206,4 @@ subroutine check_tuvx_species_initialization(errmsg, errcode) end subroutine check_tuvx_species_initialization -end module muscia_ccpp_load_tuvx_species +end module musica_ccpp_load_tuvx_species diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index 2f5d6e4e..9d7998ef 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -7,19 +7,11 @@ module musica_ccpp_species private public :: cleanup_musica_species, register_musica_species, initialize_musica_species_indices, & - initialize_molar_mass_array, extract_subset_constituents, update_constituents + initialize_molar_mass_array, extract_subset_constituents, update_constituents, & + check_initialization integer, parameter, public :: MUSICA_INT_UNASSIGNED = -99999 - ! Species are ordered to match the sequence of the MICM state array - type(musica_species_t), allocatable, protected, public :: micm_species_set(:) ! index should match with the MICM state array - type(musica_species_t), allocatable, protected, public :: tuvx_species_set(:) - integer, allocatable, protected, public :: micm_indices_constituent_props(:) - integer, allocatable, protected, public :: tuvx_indices_constituent_props(:) - real(kind_phys), allocatable, protected, public :: micm_molar_mass_array(:) ! kg mol-1 - integer, protected, public :: number_of_micm_species = MUSICA_INT_UNASSIGNED - integer, protected, public :: number_of_tuvx_speceis = MUSICA_INT_UNASSIGNED - !> Definition of the gas species type type, public :: musica_species_t character(len=:), allocatable :: name @@ -31,32 +23,28 @@ module musica_ccpp_species real(kind_phys) :: scale_height = 0.0_kind_phys ! km, optional end type musica_species_t + interface musica_species_t + procedure species_t_constructor + end interface musica_species_t + type, public :: musica_species_ptr_t type(musica_species_t), pointer :: species end type musica_species_ptr_t -contains - - !> Constructor for gas_species_t object - function species_t_constructor(name, molar_mass, index_musica_species, & - index_constituent_props) result( this ) - - character(len=*), intent(in) :: name - real(kind_phys), intent(in) :: molar_mass ! kg mol-1 - integer, intent(in) :: index_musica_species - integer, intent(in) :: index_constituent_props - type(gas_species_t) :: this - index_musica_species - this%name = name - this%molar_mass = molar_mass - this%index_musica_species = index_musica_species - this%index_constituent_props = index_constituent_props + ! Species are ordered to match the sequence of the MICM state array + type(musica_species_t), allocatable, protected, public :: micm_species_set(:) ! index should match with the MICM state array + type(musica_species_t), allocatable, protected, public :: tuvx_species_set(:) + integer, allocatable, protected, public :: micm_indices_constituent_props(:) + integer, allocatable, protected, public :: tuvx_indices_constituent_props(:) + real(kind_phys), allocatable, protected, public :: micm_molar_mass_array(:) ! kg mol-1 + integer, protected, public :: number_of_micm_species = MUSICA_INT_UNASSIGNED + integer, protected, public :: number_of_tuvx_species = MUSICA_INT_UNASSIGNED - end function species_t_constructor +contains - !> Constructor for gas_species_t object - function species_profiled_t_constructor(name, unit, molar_mass, scale_height, & - index_musica_species, index_constituent_props) result( this ) + !> Constructor for musica_species_t object + function species_t_constructor(name, unit, molar_mass, scale_height, & + index_musica_species, index_constituent_props) result( this ) character(len=*), intent(in) :: name character(len=*), intent(in) :: unit @@ -64,7 +52,7 @@ function species_profiled_t_constructor(name, unit, molar_mass, scale_height, & real(kind_phys), intent(in) :: scale_height ! km integer, intent(in) :: index_musica_species integer, intent(in) :: index_constituent_props - type(gas_species_t) :: this + type(musica_species_t) :: this this%name = name this%unit = unit @@ -73,7 +61,7 @@ function species_profiled_t_constructor(name, unit, molar_mass, scale_height, & this%index_musica_species = index_musica_species this%index_constituent_props = index_constituent_props - end function species_profiled_t_constructor + end function species_t_constructor subroutine cleanup_musica_species() @@ -92,8 +80,9 @@ subroutine register_musica_species(micm_species, tuvx_species) number_of_micm_species = size(micm_species) allocate( micm_species_set( number_of_micm_species ) ) micm_species_set = micm_species - number_of_micm_species = size(micm_species) - allocate( tuvx_elements_set( size(tuvx_species)) ) + + number_of_tuvx_species = size(tuvx_species) + allocate( tuvx_species_set( number_of_tuvx_species ) ) tuvx_species_set = tuvx_species end subroutine register_musica_species @@ -102,6 +91,7 @@ end subroutine register_musica_species subroutine find_musica_species_indices(constituent_props, musica_species_set, & indices_constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t + use ccpp_const_utils, only: ccpp_const_get_idx type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) type(musica_species_t), intent(inout) :: musica_species_set(:) @@ -119,7 +109,7 @@ subroutine find_musica_species_indices(constituent_props, musica_species_set, & index_species = musica_species_set(i_elem)%index_constituent_props if (index_species == MUSICA_INT_UNASSIGNED) then - errmsg = "[MUSICA Error] Unable to find index for ", musica_species_set(i_elem)%name + errmsg = "[MUSICA Error] Unable to find index for " // musica_species_set(i_elem)%name errcode = 1 return end if @@ -136,7 +126,7 @@ subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode - if (.not. allocated( micm_species_set ) .or. + if (.not. allocated( micm_species_set ) .or. & .not. allocated( tuvx_species_set )) then errmsg = "[MUSICA Error] The MUSICA species set(s) are not allocated." errcode = 1 @@ -148,7 +138,7 @@ subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) micm_indices_constituent_props, errmsg, errcode) if (errcode /= 0) return - allocate( tvux_indices_constituent_props( size(tuvx_species_set) ) ) + allocate( tuvx_indices_constituent_props( size(tuvx_species_set) ) ) call find_musica_species_indices(constituent_props, tuvx_species_set, & tuvx_indices_constituent_props, errmsg, errcode) if (errcode /= 0) return @@ -176,7 +166,7 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) call constituent_props( micm_species_set(i_elem)%index_constituent_props ) & %molar_mass( micm_molar_mass_array(i_elem), errcode, errmsg ) if (errcode /= 0) then - errmsg = "[MUSICA Error] Unable to get molar mass for ", micm_species_set(i_elem)%name + errmsg = "[MUSICA Error] Unable to get molar mass for " // micm_species_set(i_elem)%name return end if end do @@ -187,8 +177,8 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) do i_elem = 1, size(micm_molar_mass_array) if (micm_molar_mass_array(i_elem) <= 0) then errcode = 1 - errmsg = "[MUSICA Error] Molar mass must be greater than zero for ", & - micm_species_set(i_elem)%name + errmsg = "[MUSICA Error] Molar mass must be greater than zero for " & + // micm_species_set(i_elem)%name return end if end do @@ -285,7 +275,7 @@ subroutine check_initialization(errmsg, errcode) errcode = 1 return end if - if (number_of_tuvx_speceis == MUSICA_INT_UNASSIGNED) then + if (number_of_tuvx_species == MUSICA_INT_UNASSIGNED) then errmsg = "[MUSICA Error] The 'number_of_tuvx_species' variable has not been initialized." errcode = 1 return diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 58ab1267..dd7927ee 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -84,18 +84,18 @@ subroutine cleanup_tuvx_resources() end subroutine cleanup_tuvx_resources !> Registers constituent properties with the CCPP needed by TUV-x - subroutine tuvx_register(constituent_props, musica_species, tuvx_specific_species, & + subroutine tuvx_register(micm_species, tuvx_species, constituent_props, & errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t use musica_ccpp_load_tuvx_species, only: configure_tuvx_species use musica_util, only: error_t - type(musica_species_t), intent(in) :: micm_species(:) - type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) - type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + type(musica_species_t), intent(inout) :: micm_species(:) + type(musica_species_t), allocatable, intent(out) :: tuvx_species(:) + type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode call configure_tuvx_species(micm_species, tuvx_species, constituent_props, & errmsg, errcode) @@ -378,20 +378,20 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & end subroutine tuvx_init !> Calculates photolysis rate constants for the current model conditions - subroutine tuvx_run(temperature, dry_air_density, & - constituents_tuvx_species, & - geopotential_height_wrt_surface_at_midpoint, & - geopotential_height_wrt_surface_at_interface, & - surface_geopotential, surface_temperature, & - surface_albedo, & - photolysis_wavelength_grid_interfaces, & - extraterrestrial_flux, & - standard_gravitational_acceleration, & - cloud_area_fraction, & - air_pressure_thickness, & - solar_zenith_angle, & - earth_sun_distance, & - rate_parameters, & + subroutine tuvx_run(temperature, dry_air_density, & + constituents_tuvx_species, & + geopotential_height_wrt_surface_at_midpoint, & + geopotential_height_wrt_surface_at_interface, & + surface_geopotential, surface_temperature, & + surface_albedo, & + photolysis_wavelength_grid_interfaces, & + extraterrestrial_flux, & + standard_gravitational_acceleration, & + cloud_area_fraction, & + 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 From 8aa49c5d9189050dcbbeb2e48ae0470a99cde6ab Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 18 Dec 2024 14:08:24 -0700 Subject: [PATCH 04/18] update metadata name --- 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 cc018ec2..32bba4a1 100644 --- a/schemes/musica/musica_ccpp.meta +++ b/schemes/musica/musica_ccpp.meta @@ -53,7 +53,7 @@ type = real | kind = kind_phys dimensions = (photolysis_wavelength_grid_interface_dimension) intent = in -[ constituent_props ] +[ constituent_props_ptr ] standard_name = ccpp_constituent_properties units = None type = ccpp_constituent_prop_ptr_t From 9dabc6f2515e63e3d9b4175001b15aeb32bb9e24 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 18 Dec 2024 18:43:59 -0700 Subject: [PATCH 05/18] add setting gas species --- .../musica/musica_ccpp_load_tuvx_species.F90 | 27 ++-- schemes/musica/musica_ccpp_species.F90 | 6 - schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 92 ++++++++++- .../tuvx/musica_ccpp_tuvx_gas_species.F90 | 147 ++++++++++++++++++ .../tuvx/musica_ccpp_tuvx_height_grid.F90 | 12 +- test/musica/test_musica_api.F90 | 12 +- test/musica/tuvx/test_tuvx_height_grid.F90 | 11 +- to_be_ccppized/ccpp_tuvx_utils.F90 | 2 +- 8 files changed, 278 insertions(+), 31 deletions(-) create mode 100644 schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 diff --git a/schemes/musica/musica_ccpp_load_tuvx_species.F90 b/schemes/musica/musica_ccpp_load_tuvx_species.F90 index 6369b00b..b8a1668e 100644 --- a/schemes/musica/musica_ccpp_load_tuvx_species.F90 +++ b/schemes/musica/musica_ccpp_load_tuvx_species.F90 @@ -21,6 +21,9 @@ module musica_ccpp_load_tuvx_species character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_UNITS = 'kg kg-1' real(kind_phys), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_MOLAR_MASS = 0.018_kind_phys ! kg mol-1 ! Gas species - dry air, O2, O3 + character(len=*), parameter, public :: DRY_AIR_LABEL = 'air' + character(len=*), parameter, public :: O2_LABEL = 'O2' + character(len=*), parameter, public :: O3_LABEL = 'O3' character(len=*), parameter, public :: TUVX_GAS_SPECIES_UNITS = 'molecule cm-3' real(kind_phys), parameter, public :: SCALE_HEIGHT_DRY_AIR = 8.01_kind_phys ! km real(kind_phys), parameter, public :: SCALE_HEIGHT_O2 = 7.0_kind_phys ! km @@ -81,15 +84,15 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, do i_species = 1, num_micm_species if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit - if ( micm_species(i_species)%name == "dry_air" ) then + if ( micm_species(i_species)%name == DRY_AIR_LABEL ) then is_dry_air_registered = .true. micm_species(i_species)%profiled = .true. micm_species(i_species)%scale_height = SCALE_HEIGHT_DRY_AIR - else if ( micm_species(i_species)%name == "O2" ) then + else if ( micm_species(i_species)%name == O2_LABEL ) then is_O2_registered = .true. micm_species(i_species)%profiled = .true. micm_species(i_species)%scale_height = SCALE_HEIGHT_O2 - else if ( micm_species(i_species)%name == "O3" ) then + else if ( micm_species(i_species)%name == O3_LABEL ) then is_O3_registered = .true. micm_species(i_species)%profiled = .true. micm_species(i_species)%scale_height = SCALE_HEIGHT_O3 @@ -99,8 +102,8 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, if (.not. is_dry_air_registered) then i_new = i_new + 1 call temp_constituent_props(i_new)%instantiate( & - std_name = 'dry_air', & - long_name = 'dry_air', & + std_name = DRY_AIR_LABEL, & + long_name = DRY_AIR_LABEL, & units = 'kg kg-1', & vertical_dim = "vertical_layer_dimension", & default_value = 0.0_kind_phys, & @@ -115,8 +118,8 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, if (.not. is_O2_registered) then i_new = i_new + 1 call temp_constituent_props(i_new)%instantiate( & - std_name = 'O2', & - long_name = 'O2', & + std_name = O2_LABEL, & + long_name = O2_LABEL, & units = 'kg kg-1', & vertical_dim = "vertical_layer_dimension", & default_value = 0.0_kind_phys, & @@ -131,8 +134,8 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, if (.not. is_O3_registered) then i_new = i_new + 1 call temp_constituent_props(i_new)%instantiate( & - std_name = 'O3', & - long_name = 'O3', & + std_name = O3_LABEL, & + long_name = O3_LABEL, & units = 'kg kg-1', & vertical_dim = "vertical_layer_dimension", & default_value = 0.0_kind_phys, & @@ -156,7 +159,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, i_tuvx_species = i_tuvx_species + 1 index_dry_air = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & - name = 'dry_air', & + name = DRY_AIR_LABEL, & unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit molar_mass = MOLAR_MASS_DRY_AIR, & ! kg mol-1 index_musica_species = i_tuvx_species, & @@ -166,7 +169,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, i_tuvx_species = i_tuvx_species + 1 index_O2 = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & - name = 'O2', & + name = O2_LABEL, & unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit molar_mass = MOLAR_MASS_O2, & ! kg mol-1 index_musica_species = i_tuvx_species, & @@ -176,7 +179,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, i_tuvx_species = i_tuvx_species + 1 index_O3 = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & - name = 'O3', & + name = O3_LABEL, & unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit molar_mass = MOLAR_MASS_O3, & ! kg mol-1 index_musica_species = i_tuvx_species, & diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index 9d7998ef..5871be99 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -1,6 +1,4 @@ module musica_ccpp_species - ! This module owns musica species - use ccpp_kinds, only: kind_phys implicit none @@ -27,10 +25,6 @@ module musica_ccpp_species procedure species_t_constructor end interface musica_species_t - type, public :: musica_species_ptr_t - type(musica_species_t), pointer :: species - end type musica_species_ptr_t - ! Species are ordered to match the sequence of the MICM state array type(musica_species_t), allocatable, protected, public :: micm_species_set(:) ! index should match with the MICM state array type(musica_species_t), allocatable, protected, public :: tuvx_species_set(:) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index dd7927ee..d28fc245 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -22,6 +22,9 @@ module musica_ccpp_tuvx type(profile_t), pointer :: temperature_profile => null() type(profile_t), pointer :: surface_albedo_profile => null() type(profile_t), pointer :: extraterrestrial_flux_profile => null() + type(profile_t), pointer :: dry_air_profile => null() + type(profile_t), pointer :: O2_profile => null() + type(profile_t), pointer :: O3_profile => null() type(radiator_t), pointer :: cloud_optics => null() type(index_mappings_t), pointer :: photolysis_rate_constants_mapping => null( ) integer, parameter :: DEFAULT_NUM_PHOTOLYSIS_RATE_CONSTANTS = 0 @@ -43,7 +46,7 @@ subroutine reset_tuvx_map_state( grids, profiles, radiators ) end subroutine reset_tuvx_map_state - !> This is a helper subroutine created to deallocate objects associated with TUV-x + !> Deallocates objects associated with TUV-x subroutine cleanup_tuvx_resources() if (associated( height_grid )) then @@ -71,6 +74,21 @@ subroutine cleanup_tuvx_resources() extraterrestrial_flux_profile => null() end if + if (associated( dry_air_profile )) then + deallocate( dry_air_profile ) + dry_air_profile => null() + end if + + if (associated( O2_profile )) then + deallocate( O2_profile ) + O2_profile => null() + end if + + if (associated( O3_profile )) then + deallocate( O3_profile ) + O3_profile => null() + end if + if (associated( cloud_optics )) then deallocate( cloud_optics ) cloud_optics => null() @@ -123,6 +141,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & use musica_ccpp_tuvx_extraterrestrial_flux, & only: create_extraterrestrial_flux_profile, extraterrestrial_flux_label, & extraterrestrial_flux_unit + use musica_ccpp_tuvx_gas_species, & + only: create_dry_air_profile, create_O2_profile, create_O3_profile use musica_ccpp_tuvx_cloud_optics, & only: create_cloud_optics_radiator, cloud_optics_label @@ -224,6 +244,48 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & return end if + dry_air_profile => create_dry_air_profile( height_grid, errmsg, errcode ) + if (errcode /= 0) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + endif + + call profiles%add( dry_air_profile, error ) + if (has_error_occurred( error, errmsg, errcode )) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + + O2_profile => create_O2_profile( height_grid, errmsg, errcode ) + if (errcode /= 0) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + endif + + call profiles%add( O2_profile, error ) + if (has_error_occurred( error, errmsg, errcode )) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + + O3_profile => create_O3_profile( height_grid, errmsg, errcode ) + if (errcode /= 0) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + endif + + call profiles%add( O3_profile, error ) + if (has_error_occurred( error, errmsg, errcode )) then + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + radiators => radiator_map_t( error ) if (has_error_occurred( error, errmsg, errcode )) then call reset_tuvx_map_state( grids, profiles, null() ) @@ -379,7 +441,7 @@ end subroutine tuvx_init !> Calculates photolysis rate constants for the current model conditions subroutine tuvx_run(temperature, dry_air_density, & - constituents_tuvx_species, & + constituents, & geopotential_height_wrt_surface_at_midpoint, & geopotential_height_wrt_surface_at_interface, & surface_geopotential, surface_temperature, & @@ -400,11 +462,13 @@ subroutine tuvx_run(temperature, dry_air_density, & use musica_ccpp_tuvx_surface_albedo, only: set_surface_albedo_values use musica_ccpp_tuvx_extraterrestrial_flux, only: set_extraterrestrial_flux_values use musica_ccpp_tuvx_cloud_optics, only: set_cloud_optics_values - use musica_ccpp_load_tuvx_species, only: index_cloud_liquid_water_content + use musica_ccpp_load_tuvx_species, only: index_cloud_liquid_water_content, & + index_dry_air, index_O2, index_O3 + use musica_ccpp_tuvx_gas_species, only: set_gas_species_values 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_tuvx_species(:,:,:) ! various (column, layer, constituent) + real(kind_phys), intent(in) :: constituents(:,:,:) ! kg kg-1 (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 @@ -424,6 +488,7 @@ subroutine tuvx_run(temperature, dry_air_density, & ! local variables real(kind_phys), dimension(size(geopotential_height_wrt_surface_at_midpoint, dim = 2)) :: height_midpoints real(kind_phys), dimension(size(geopotential_height_wrt_surface_at_interface, dim = 2)) :: height_interfaces + real(kind_phys), dimension(size(height_interfaces)) :: height_deltas ! km real(kind_phys), dimension(size(rate_parameters, dim=2)+2, & number_of_photolysis_rate_constants) :: photolysis_rate_constants, & ! s-1 heating_rates ! K s-1 (TODO: check units) @@ -457,7 +522,7 @@ subroutine tuvx_run(temperature, dry_air_density, & reciprocal_of_gravitational_acceleration, & height_midpoints, height_interfaces ) call set_height_grid_values( height_grid, height_midpoints, height_interfaces, & - errmsg, errcode ) + height_deltas, errmsg, errcode ) if (errcode /= 0) return call set_temperature_values( temperature_profile, temperature(i_col,:), & @@ -466,10 +531,25 @@ subroutine tuvx_run(temperature, dry_air_density, & call set_cloud_optics_values( cloud_optics, cloud_area_fraction(i_col,:), & air_pressure_thickness(i_col,:), & - constituents_tuvx_species(i_col,:,index_cloud_liquid_water_content), & + constituents(i_col,:,index_cloud_liquid_water_content), & reciprocal_of_gravitational_acceleration, errmsg, errcode ) if (errcode /= 0) return + call set_gas_species_values( dry_air_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_dry_air), height_deltas, index_dry_air, & + errmsg, errcode) + if (errcode /= 0) return + + call set_gas_species_values( O2_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_O2), height_deltas, index_O2, & + errmsg, errcode) + if (errcode /= 0) return + + call set_gas_species_values( O3_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_O3), height_deltas, index_O3, & + 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(:,:), & diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 new file mode 100644 index 00000000..7588fe0b --- /dev/null +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 @@ -0,0 +1,147 @@ +module musica_ccpp_tuvx_gas_species + use ccpp_kinds, only: kind_phys + + implicit none + + private + public :: create_dry_air_profile, create_O2_profile, create_O3_profile, & + set_gas_species_values + + !> Conversion factor from km to cm + real(kind_phys), parameter, public :: km_to_cm = 1.0e5 + !> Conversion factor from m3 to cm3 + real(kind_phys), parameter, public :: m_3_to_cm_3 = 1.0e6 + +contains + + !> Creates a TUV-x dry air profile + function create_dry_air_profile(height_grid, errmsg, errcode) & + result(profile) + use musica_ccpp_util, only: has_error_occurred + use musica_tuvx_grid, only: grid_t + use musica_tuvx_profile, only: profile_t + use musica_util, only: error_t + use musica_ccpp_species, only: tuvx_species_set + use musica_ccpp_load_tuvx_species, only: index_dry_air + + type(grid_t), intent(in) :: height_grid + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode + type(profile_t), pointer :: profile + + ! local variables + type(error_t) :: error + + profile => profile_t( tuvx_species_set(index_dry_air)%name, & + tuvx_species_set(index_dry_air)%unit, & + height_grid, error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + end function create_dry_air_profile + + !> Creates a TUV-x O2 profile + function create_O2_profile(height_grid, errmsg, errcode) & + result(profile) + use musica_ccpp_util, only: has_error_occurred + use musica_tuvx_grid, only: grid_t + use musica_tuvx_profile, only: profile_t + use musica_util, only: error_t + use musica_ccpp_species, only: tuvx_species_set + use musica_ccpp_load_tuvx_species, only: index_O2 + + type(grid_t), intent(in) :: height_grid + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode + type(profile_t), pointer :: profile + + ! local variables + type(error_t) :: error + + profile => profile_t( tuvx_species_set(index_O2)%name, & + tuvx_species_set(index_O2)%unit, & + height_grid, error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + end function create_O2_profile + + !> Creates a TUV-x O3 profile + function create_O3_profile(height_grid, errmsg, errcode) & + result(profile) + use musica_ccpp_util, only: has_error_occurred + use musica_tuvx_grid, only: grid_t + use musica_tuvx_profile, only: profile_t + use musica_util, only: error_t + use musica_ccpp_species, only: tuvx_species_set + use musica_ccpp_load_tuvx_species, only: index_O3 + + type(grid_t), intent(in) :: height_grid + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode + type(profile_t), pointer :: profile + + ! local variables + type(error_t) :: error + + profile => profile_t( tuvx_species_set(index_O3)%name, & + tuvx_species_set(index_O3)%unit, & + height_grid, error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + end function create_O3_profile + + !> Sets the species concentrations in the vertical layer + subroutine set_gas_species_values(profile, dry_air_density, constituents, & + height_deltas, index_species, errmsg, errcode) + use musica_ccpp_util, only: has_error_occurred + use musica_ccpp_species, only: tuvx_species_set + use musica_ccpp_load_tuvx_species, only: O3_LABEL + use musica_tuvx_profile, only: profile_t + use musica_util, only: error_t + + type(profile_t), intent(inout) :: profile + real(kind_phys), intent(in) :: dry_air_density(:) + real(kind_phys), intent(in) :: constituents(:) ! kg kg-1 + real(kind_phys), intent(in) :: height_deltas(:) ! km, change in height in each vertical layer + integer, intent(in) :: index_species + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errcode + + ! local variables + type(error_t) :: error + integer :: num_vertical_levels + real(kind_phys) :: constituent_mol_per_cm_3(size(constituents)) ! mol cm-3 + real(kind_phys) :: interfaces(size(constituents) + 2) + real(kind_phys) :: densities(size(constituents) + 1) + real(kind_phys) :: molar_mass + + molar_mass = tuvx_species_set(index_species)%molar_mass + constituent_mol_per_cm_3(:) = constituents(:) * dry_air_density(:) / molar_mass / m_3_to_cm_3 + + num_vertical_levels = size(constituents) + interfaces(1) = constituent_mol_per_cm_3(num_vertical_levels) + interfaces(2:num_vertical_levels+1) = constituent_mol_per_cm_3(num_vertical_levels:1:-1) + interfaces(num_vertical_levels+2) = constituent_mol_per_cm_3(1) + + if (tuvx_species_set(index_species)%name == O3_LABEL) then + densities(:) = height_deltas(:) * km_to_cm & + * ( interfaces(1:num_vertical_levels+1) & + + interfaces(2:num_vertical_levels+2) ) * 0.5_kind_phys + else + densities(:) = height_deltas(:) * km_to_cm & + * sqrt(interfaces(1:num_vertical_levels+1)) & + * sqrt(interfaces(2:num_vertical_levels+2)) + end if + + call profile%set_edge_values( interfaces, error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + call profile%set_layer_densities( densities, error) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + call profile%calculate_exo_layer_density( & + tuvx_species_set(index_species)%scale_height, error ) + if ( has_error_occurred( error, errmsg, errcode ) ) return + + end subroutine set_gas_species_values + +end module musica_ccpp_tuvx_gas_species \ No newline at end of file diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 index cff0d2a2..2fc38b97 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 @@ -83,8 +83,9 @@ function create_height_grid(vertical_layer_dimension, vertical_interface_dimensi end function create_height_grid !> Sets TUV-x height grid values from the host-model height grid + ! and calculates the change in height for each vertical layer subroutine set_height_grid_values(height_grid, host_midpoints, & - host_interfaces, errmsg, errcode) + host_interfaces, height_deltas, errmsg, errcode) use ccpp_kinds, only: kind_phys use musica_ccpp_util, only: has_error_occurred use musica_tuvx_grid, only: grid_t @@ -93,6 +94,7 @@ subroutine set_height_grid_values(height_grid, host_midpoints, & type(grid_t), intent(inout) :: height_grid real(kind_phys), intent(in) :: host_midpoints(:) ! km real(kind_phys), intent(in) :: host_interfaces(:) ! km + real(kind_phys), intent(inout) :: height_deltas(:) ! km character(len=*), intent(out) :: errmsg integer, intent(out) :: errcode @@ -117,6 +119,12 @@ subroutine set_height_grid_values(height_grid, host_midpoints, & n_host_midpoints = size(host_midpoints) n_host_interfaces = size(host_interfaces) + if ( size(height_deltas) /= n_host_interfaces ) then + errmsg = "[MUSICA Error] Invalid size of TUV-x height deltas." + errcode = 1 + return + end if + interfaces(1) = host_interfaces(n_host_interfaces) interfaces(2:n_host_interfaces) = host_midpoints(n_host_midpoints:1:-1) interfaces(n_host_interfaces+1) = host_interfaces(1) @@ -127,6 +135,8 @@ subroutine set_height_grid_values(height_grid, host_midpoints, & midpoints(n_host_midpoints+1) = 0.5_kind_phys * & ( interfaces(n_host_interfaces) + interfaces(n_host_interfaces+1) ) + height_deltas(:) = interfaces(2:size(interfaces)) - interfaces(1:size(interfaces)-1) + call height_grid%set_edges( interfaces, error ) if ( has_error_occurred( error, errmsg, errcode ) ) return diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 6ed8b0e8..06d62cee 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -10,7 +10,7 @@ program run_test_musica_ccpp real(kind_phys), parameter :: DEGREE_TO_RADIAN = 3.14159265358979323846_kind_phys / 180.0_kind_phys - call test_chapman() + ! call test_chapman() call test_terminator() contains @@ -382,6 +382,7 @@ subroutine test_terminator() integer, parameter :: NUM_SPECIES = 2 integer, parameter :: NUM_TUVX_CONSTITUENTS = 1 + integer, parameter :: NUM_TUVX_ONLY_GAS_SPECIES = 3 ! This test requires that the number of grid cells = 4, which is the default ! vector dimension for MICM. This restriction will be removed once ! https://github.com/NCAR/musica/issues/217 is finished. @@ -463,7 +464,7 @@ subroutine test_terminator() stop 3 endif ASSERT(allocated(constituent_props)) - ASSERT(size(constituent_props) == NUM_SPECIES+NUM_TUVX_CONSTITUENTS) + ASSERT(size(constituent_props) == NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) do i = 1, size(constituent_props) ASSERT(constituent_props(i)%is_instantiated(errcode, errmsg)) ASSERT(errcode == 0) @@ -475,8 +476,11 @@ subroutine test_terminator() ASSERT(errcode == 0) tmp_bool = (trim(species_name) == "Cl" .and. molar_mass == 0.035453_kind_phys .and. is_advected) .or. & (trim(species_name) == "Cl2" .and. molar_mass == 0.070906_kind_phys .and. is_advected) .or. & - (trim(species_name) == "cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water" & - .and. molar_mass == 0.018_kind_phys .and. is_advected) + (trim(species_name) == "cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water" & + .and. molar_mass == 0.018_kind_phys .and. is_advected) .or. & + (trim(species_name) == "dry_air" .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) .or. & + (trim(species_name) == "O2" .and. molar_mass == 0.0319988_kind_phys .and. .not. is_advected) .or. & + (trim(species_name) == "O3" .and. molar_mass == 0.0479982_kind_phys .and. .not. is_advected) ASSERT(tmp_bool) call constituent_props(i)%units(units, errcode, errmsg) if (errcode /= 0) then diff --git a/test/musica/tuvx/test_tuvx_height_grid.F90 b/test/musica/tuvx/test_tuvx_height_grid.F90 index 6da26960..c18ce338 100644 --- a/test/musica/tuvx/test_tuvx_height_grid.F90 +++ b/test/musica/tuvx/test_tuvx_height_grid.F90 @@ -25,14 +25,19 @@ subroutine test_create_height_grid() real(kind_phys) :: host_interfaces(NUM_HOST_INTERFACES) = [250.3_kind_phys, 150.2_kind_phys, 50.1_kind_phys] real(kind_phys) :: expected_midpoints(NUM_HOST_MIDPOINTS+1) = [(100.6 + 50.1) * 0.5, 150.2, (250.3 + 200.8) * 0.5] real(kind_phys) :: expected_interfaces(NUM_HOST_INTERFACES+1) = [50.1_kind_phys, 100.6_kind_phys, 200.8_kind_phys, 250.3_kind_phys] + real(kind_phys) :: expected_height_deltas(NUM_HOST_INTERFACES) real(kind_phys) :: midpoints(NUM_HOST_MIDPOINTS+1) real(kind_phys) :: interfaces(NUM_HOST_INTERFACES+1) + real(kind_phys) :: height_deltas(NUM_HOST_INTERFACES) type(grid_t), pointer :: height_grid => null() type(error_t) :: error character(len=512) :: errmsg integer :: errcode integer :: i + expected_height_deltas(:) = expected_interfaces(2:size(expected_interfaces)) & + - expected_interfaces(1:size(expected_interfaces)-1) + height_grid => create_height_grid(-1, 0, errmsg, errcode) ASSERT(errcode == 1) ASSERT(.not. associated(height_grid)) @@ -47,12 +52,16 @@ subroutine test_create_height_grid() ASSERT(associated(height_grid)) call set_height_grid_values(height_grid, host_midpoints, host_interfaces, & - errmsg, errcode) + height_deltas, errmsg, errcode) ASSERT(errcode == 0) ASSERT(height_grid%number_of_sections(error) == NUM_HOST_MIDPOINTS + 1) ASSERT(error%is_success()) + do i = 1, size(height_deltas) + ASSERT_NEAR(height_deltas(i), expected_height_deltas(i), ABS_ERROR) + end do + call height_grid%get_midpoints(midpoints, error) ASSERT(error%is_success()) do i = 1, size(midpoints) diff --git a/to_be_ccppized/ccpp_tuvx_utils.F90 b/to_be_ccppized/ccpp_tuvx_utils.F90 index 837801bc..e7329d56 100644 --- a/to_be_ccppized/ccpp_tuvx_utils.F90 +++ b/to_be_ccppized/ccpp_tuvx_utils.F90 @@ -10,7 +10,7 @@ module ccpp_tuvx_utils contains !> Regrids normalized flux data to match a specified wavelength grid - !! This function is copied from CAM/src/chemistry/utils/mo_util.F90 + ! This function is copied from CAM/src/chemistry/utils/mo_util.F90 subroutine rebin( source_dimension, target_dimension, source_coordinates, & target_coordinates, source, target ) use ccpp_kinds, only: kind_phys From f74a4a3d94c6b85828b230548e1e7aff462d12fe Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Thu, 19 Dec 2024 10:56:21 -0700 Subject: [PATCH 06/18] rename module for loading tuvx --- schemes/musica/musica_ccpp.F90 | 2 +- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 4 ++-- schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 | 8 ++++---- .../musica_ccpp_tuvx_load_species.F90} | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) rename schemes/musica/{musica_ccpp_load_tuvx_species.F90 => tuvx/musica_ccpp_tuvx_load_species.F90} (99%) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 20629fd9..86150794 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -18,7 +18,7 @@ subroutine musica_ccpp_register(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_namelist, only: micm_solver_type use musica_ccpp_species, only: musica_species_t, register_musica_species - use musica_ccpp_load_tuvx_species, only: check_tuvx_species_initialization + use musica_ccpp_tuvx_load_species, only: check_tuvx_species_initialization type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:) character(len=512), intent(out) :: errmsg diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index d28fc245..38ccd5c7 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -106,7 +106,7 @@ subroutine tuvx_register(micm_species, tuvx_species, constituent_props, & errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t - use musica_ccpp_load_tuvx_species, only: configure_tuvx_species + use musica_ccpp_tuvx_load_species, only: configure_tuvx_species use musica_util, only: error_t type(musica_species_t), intent(inout) :: micm_species(:) @@ -462,7 +462,7 @@ subroutine tuvx_run(temperature, dry_air_density, & use musica_ccpp_tuvx_surface_albedo, only: set_surface_albedo_values use musica_ccpp_tuvx_extraterrestrial_flux, only: set_extraterrestrial_flux_values use musica_ccpp_tuvx_cloud_optics, only: set_cloud_optics_values - use musica_ccpp_load_tuvx_species, only: index_cloud_liquid_water_content, & + use musica_ccpp_tuvx_load_species, only: index_cloud_liquid_water_content, & index_dry_air, index_O2, index_O3 use musica_ccpp_tuvx_gas_species, only: set_gas_species_values diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 index 7588fe0b..83ae0e2a 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 @@ -22,7 +22,7 @@ function create_dry_air_profile(height_grid, errmsg, errcode) & use musica_tuvx_profile, only: profile_t use musica_util, only: error_t use musica_ccpp_species, only: tuvx_species_set - use musica_ccpp_load_tuvx_species, only: index_dry_air + use musica_ccpp_tuvx_load_species, only: index_dry_air type(grid_t), intent(in) :: height_grid character(len=*), intent(out) :: errmsg @@ -47,7 +47,7 @@ function create_O2_profile(height_grid, errmsg, errcode) & use musica_tuvx_profile, only: profile_t use musica_util, only: error_t use musica_ccpp_species, only: tuvx_species_set - use musica_ccpp_load_tuvx_species, only: index_O2 + use musica_ccpp_tuvx_load_species, only: index_O2 type(grid_t), intent(in) :: height_grid character(len=*), intent(out) :: errmsg @@ -72,7 +72,7 @@ function create_O3_profile(height_grid, errmsg, errcode) & use musica_tuvx_profile, only: profile_t use musica_util, only: error_t use musica_ccpp_species, only: tuvx_species_set - use musica_ccpp_load_tuvx_species, only: index_O3 + use musica_ccpp_tuvx_load_species, only: index_O3 type(grid_t), intent(in) :: height_grid character(len=*), intent(out) :: errmsg @@ -94,7 +94,7 @@ subroutine set_gas_species_values(profile, dry_air_density, constituents, & height_deltas, index_species, errmsg, errcode) use musica_ccpp_util, only: has_error_occurred use musica_ccpp_species, only: tuvx_species_set - use musica_ccpp_load_tuvx_species, only: O3_LABEL + use musica_ccpp_tuvx_load_species, only: O3_LABEL use musica_tuvx_profile, only: profile_t use musica_util, only: error_t diff --git a/schemes/musica/musica_ccpp_load_tuvx_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 similarity index 99% rename from schemes/musica/musica_ccpp_load_tuvx_species.F90 rename to schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index b8a1668e..7bbfb698 100644 --- a/schemes/musica/musica_ccpp_load_tuvx_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -1,4 +1,4 @@ -module musica_ccpp_load_tuvx_species +module musica_ccpp_tuvx_load_species use ccpp_kinds, only: kind_phys use musica_ccpp_species, only: MUSICA_INT_UNASSIGNED @@ -209,4 +209,4 @@ subroutine check_tuvx_species_initialization(errmsg, errcode) end subroutine check_tuvx_species_initialization -end module musica_ccpp_load_tuvx_species +end module musica_ccpp_tuvx_load_species From e9c9bc2c241f0376e889adfb2d0f55effbc5274a Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Thu, 19 Dec 2024 19:16:08 -0700 Subject: [PATCH 07/18] add tuvx gas species test --- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 12 +- test/musica/tuvx/CMakeLists.txt | 33 ++ test/musica/tuvx/test_tuvx_gas_species.F90 | 354 +++++++++++++++++++++ 3 files changed, 393 insertions(+), 6 deletions(-) create mode 100644 test/musica/tuvx/test_tuvx_gas_species.F90 diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 38ccd5c7..34d15ea3 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -146,12 +146,12 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & use musica_ccpp_tuvx_cloud_optics, & only: create_cloud_optics_radiator, cloud_optics_label - integer, intent(in) :: vertical_layer_dimension ! (count) - integer, intent(in) :: vertical_interface_dimension ! (count) - real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m - type(mappings_t), intent(in) :: micm_rate_parameter_ordering ! index mappings for MICM rate parameters - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + integer, intent(in) :: vertical_layer_dimension ! (count) + integer, intent(in) :: vertical_interface_dimension ! (count) + real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m + type(mappings_t), intent(in) :: micm_rate_parameter_ordering ! index mappings for MICM rate parameters + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode ! local variables type(grid_map_t), pointer :: grids diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index 10024759..a875ec69 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -172,3 +172,36 @@ add_test( ) add_memory_check_test(test_tuvx_cloud_optics $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) + +# TUV-x gas species profiles +add_executable(test_tuvx_gas_species test_tuvx_gas_species.F90) + +target_sources(test_tuvx_gas_species + PUBLIC + ${MUSICA_CCPP_SOURCES} + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/../musica_ccpp_namelist.F90 +) + +target_link_libraries(test_tuvx_gas_species + PRIVATE + musica::musica-fortran +) + +set_target_properties(test_tuvx_gas_species + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_tuvx_gas_species + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_tuvx_gas_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 new file mode 100644 index 00000000..e365f32f --- /dev/null +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -0,0 +1,354 @@ +program test_tuvx_gas_species_profile + + use musica_ccpp_tuvx_gas_species + + 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_create_gas_species_profile() + call test_initialize_tuvx_species() + +contains + + !> Returns the wavelength edges used in the CAM-Chem photolysis rate constant lookup table + !! These are the values that will be used in CAM-SIMA and correspond to the wavelength + !! bins used in the CAM-Chem photolysis rate constant lookup table. + !! + !! We're using the actual values here because several of the TS1/TSMLT photolysis + !! rate constant configurations are sensitive to the wavelength grid. + subroutine get_wavelength_edges(edges) + use ccpp_kinds, only: kind_phys + + real(kind_phys), dimension(:), intent(out) :: edges + + edges = (/ & + 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 & + /) + + end subroutine get_wavelength_edges + + subroutine test_create_gas_species_profile() + 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_tuvx, only: grid_t, profile_t + use musica_ccpp, only: musica_ccpp_register, musica_ccpp_final + use musica_ccpp_tuvx_height_grid, only: create_height_grid + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, & + MOLAR_MASS_DRY_AIR, MOLAR_MASS_O2, MOLAR_MASS_O3, & + SCALE_HEIGHT_DRY_AIR, SCALE_HEIGHT_O2, SCALE_HEIGHT_O3 + use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED + + integer, parameter :: NUM_COLUMNS = 2 + integer, parameter :: NUM_LAYERS = 2 + integer, parameter :: NUM_TUVX_SPECIES = 4 + type(ccpp_constituent_properties_t), allocatable, & + target :: constituent_props(:) + type(grid_t), pointer :: height_grid => null() + type(profile_t), pointer :: dry_air_profile => null() + type(profile_t), pointer :: O2_profile => null() + type(profile_t), pointer :: O3_profile => null() + real(kind_phys) :: dry_air_density(NUM_COLUMNS,NUM_LAYERS) ! kg m-3 + real(kind_phys) :: constituents(NUM_COLUMNS,NUM_LAYERS, NUM_TUVX_SPECIES) + real(kind_phys) :: height_deltas(NUM_LAYERS) ! km + integer :: errcode + character(len=512) :: errmsg + character(len=50) :: name, unit + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica + logical :: tmp_bool + integer :: i_elem, i_col, i, j, k + + 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' + + dry_air_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) + dry_air_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) + height_deltas(:) = (/ 0.5_kind_phys, 1.5_kind_phys /) + + ! Initialize the constituents array with real values between 0 and 1 + do k = 1, 4 + do j = 1, 2 + do i = 1, 2 + constituents(i, j, k) = (i + j + k) * 0.1_kind_phys + end do + end do + end do + + call musica_ccpp_register(constituent_props, errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + height_grid => create_height_grid( NUM_LAYERS, NUM_LAYERS + 1 , errmsg, errcode ) + ASSERT(errcode == 0) + ASSERT(associated(height_grid)) + + dry_air_profile => create_dry_air_profile( height_grid, errmsg, errcode ) + ASSERT(errcode == 0) + ASSERT(associated(dry_air_profile)) + + O2_profile => create_O2_profile( height_grid, errmsg, errcode ) + ASSERT(errcode == 0) + ASSERT(associated(O2_profile)) + + O3_profile => create_O3_profile( height_grid, errmsg, errcode ) + ASSERT(errcode == 0) + ASSERT(associated(O3_profile)) + + do i_col = 1, NUM_COLUMNS + call set_gas_species_values( dry_air_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_dry_air), height_deltas, index_dry_air, & + errmsg, errcode) + ASSERT(errcode == 0) + + call set_gas_species_values( O2_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_O2), height_deltas, index_O2, & + errmsg, errcode) + ASSERT(errcode == 0) + + call set_gas_species_values( O3_profile, dry_air_density(i_col,:), & + constituents(i_col,:,index_O3), height_deltas, index_O3, & + errmsg, errcode) + ASSERT(errcode == 0) + end do + + ! The gas species index starts at 2 because index 1 is reserved for cloud liquid + do i_elem = 2, size(tuvx_species_set) + name = tuvx_species_set(i_elem)%name + unit = tuvx_species_set(i_elem)%unit + molar_mass = tuvx_species_set(i_elem)%molar_mass + scale_height = tuvx_species_set(i_elem)%scale_height + index_musica = tuvx_species_set(i_elem)%index_musica_species + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_DRY_AIR .and. & + scale_height == SCALE_HEIGHT_DRY_AIR .and. index_musica == 2) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O2 .and. & + scale_height == SCALE_HEIGHT_O2 .and. index_musica == 3) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O3 .and. & + scale_height == SCALE_HEIGHT_O3 .and. index_musica == 4) + ASSERT(tmp_bool) + end do + + deallocate( dry_air_profile ) + deallocate( O2_profile ) + deallocate( O3_profile ) + deallocate( height_grid ) + + call musica_ccpp_final(errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + end subroutine test_create_gas_species_profile + + subroutine test_initialize_tuvx_species() + 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_tuvx, only: grid_t, profile_t + use musica_ccpp, only: musica_ccpp_register, musica_ccpp_init, musica_ccpp_final + use musica_ccpp_tuvx_height_grid, only: create_height_grid + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, & + MOLAR_MASS_DRY_AIR, MOLAR_MASS_O2, MOLAR_MASS_O3, & + SCALE_HEIGHT_DRY_AIR, SCALE_HEIGHT_O2, SCALE_HEIGHT_O3 + use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED + + integer, parameter :: NUM_COLUMNS = 2 + integer, parameter :: NUM_LAYERS = 2 + integer, parameter :: NUM_WAVELENGTH_BINS = 102 + integer, parameter :: NUM_TUVX_SPECIES = 4 + real(kind_phys) :: photolysis_wavelength_grid_interfaces(NUM_WAVELENGTH_BINS+1) ! m + type(ccpp_constituent_properties_t), allocatable, & + target :: constituent_props(:) + type(ccpp_constituent_prop_ptr_t), allocatable :: constituent_props_ptr(:) + type(ccpp_constituent_properties_t), pointer :: const_prop + real(kind_phys) :: dry_air_density(NUM_COLUMNS,NUM_LAYERS) ! kg m-3 + real(kind_phys) :: constituents(NUM_COLUMNS,NUM_LAYERS, NUM_TUVX_SPECIES) + integer :: errcode + character(len=512) :: errmsg + character(len=50) :: name, unit + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica, index_constituent_props + logical :: tmp_bool, has_profile + integer :: i_elem, i_col, i, j, k + + 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' + + dry_air_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) + dry_air_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) + call get_wavelength_edges(photolysis_wavelength_grid_interfaces) + do k = 1, 4 + do j = 1, 2 + do i = 1, 2 + constituents(i, j, k) = (i + j + k) * 0.1_kind_phys + end do + end do + end do + + call musica_ccpp_register(constituent_props, errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + allocate(constituent_props_ptr(size(constituent_props))) + do i = 1, size(constituent_props) + const_prop => constituent_props(i) + call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) + end do + + 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) + stop 3 + endif + + ! The gas species index starts at 2 because index 1 is reserved for cloud liquid + do i_elem = 2, size(tuvx_species_set) + name = tuvx_species_set(i_elem)%name + unit = tuvx_species_set(i_elem)%unit + molar_mass = tuvx_species_set(i_elem)%molar_mass + scale_height = tuvx_species_set(i_elem)%scale_height + index_musica = tuvx_species_set(i_elem)%index_musica_species + index_constituent_props = tuvx_species_set(i_elem)%index_constituent_props + has_profile = tuvx_species_set(i_elem)%profiled + + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_DRY_AIR .and. & + scale_height == SCALE_HEIGHT_DRY_AIR .and. index_musica == 2 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + .and. has_profile .eqv. .true.) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O2 .and. & + scale_height == SCALE_HEIGHT_O2 .and. index_musica == 3 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + .and. has_profile .eqv. .true.) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O3 .and. & + scale_height == SCALE_HEIGHT_O3 .and. index_musica == 4 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + .and. has_profile .eqv. .true.) + ASSERT(tmp_bool) + end do + + call musica_ccpp_final(errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + + end subroutine test_initialize_tuvx_species + +end program test_tuvx_gas_species_profile \ No newline at end of file From 6cf6d98c95c55fafee33e21f2294c5e71c4955bd Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Fri, 20 Dec 2024 12:01:12 -0700 Subject: [PATCH 08/18] update integration test --- test/musica/test_musica_api.F90 | 68 +++++++++++++--------- test/musica/tuvx/test_tuvx_gas_species.F90 | 6 +- 2 files changed, 45 insertions(+), 29 deletions(-) diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 06d62cee..99cddfe9 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -10,7 +10,7 @@ program run_test_musica_ccpp real(kind_phys), parameter :: DEGREE_TO_RADIAN = 3.14159265358979323846_kind_phys / 180.0_kind_phys - ! call test_chapman() + call test_chapman() call test_terminator() contains @@ -136,17 +136,19 @@ end subroutine get_wavelength_edges !> Tests the Chapman chemistry scheme subroutine test_chapman() - use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t - use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_ccpp_micm, only: micm - use musica_ccpp_namelist, only: filename_of_micm_configuration, & - filename_of_tuvx_configuration, & - filename_of_tuvx_micm_mapping_configuration + 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 + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 implicit none - integer, parameter :: NUM_SPECIES = 5 - integer, parameter :: NUM_TUVX_CONSTITUENTS = 1 + integer, parameter :: NUM_SPECIES = 5 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 1 + integer, parameter :: NUM_TUVX_ONLY_GAS_SPECIES = 1 ! This test requires that the number of grid cells = 4, which is the default ! vector dimension for MICM. This restriction will be removed once ! https://github.com/NCAR/musica/issues/217 is finished. @@ -173,9 +175,9 @@ subroutine test_chapman() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS) :: cloud_area_fraction ! unitless real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS) :: air_pressure_thickness ! Pa real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & - NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: constituents ! kg kg-1 + NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) :: constituents ! kg kg-1 real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & - NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: initial_constituents ! kg kg-1 + NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) :: 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(:) @@ -228,7 +230,7 @@ subroutine test_chapman() stop 3 endif ASSERT(allocated(constituent_props)) - ASSERT(size(constituent_props) == NUM_SPECIES+NUM_TUVX_CONSTITUENTS) + ASSERT(size(constituent_props) == NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) do i = 1, size(constituent_props) ASSERT(constituent_props(i)%is_instantiated(errcode, errmsg)) ASSERT(errcode == 0) @@ -244,7 +246,8 @@ subroutine test_chapman() (trim(species_name) == "O3" .and. molar_mass == 0.0479982_kind_phys .and. is_advected) .or. & (trim(species_name) == "N2" .and. molar_mass == 0.0280134_kind_phys .and. is_advected) .or. & (trim(species_name) == "cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water" .and. & - molar_mass == 0.018_kind_phys .and. is_advected) + molar_mass == 0.018_kind_phys .and. is_advected) .or. & + (trim(species_name) == "air" .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) ASSERT(tmp_bool) call constituent_props(i)%units(units, errcode, errmsg) if (errcode /= 0) then @@ -304,6 +307,11 @@ subroutine test_chapman() constituents(j,k,NUM_SPECIES+1) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) end do end do + do j = 1, NUM_COLUMNS + do k = 1, NUM_LAYERS + constituents(j,k,NUM_SPECIES+index_dry_air) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) + end do + end do initial_constituents(:,:,:) = constituents(:,:,:) write(*,*) "[MUSICA INFO] Initial Time Step" @@ -371,18 +379,18 @@ end subroutine test_chapman !> Tests the simple Terminator chemistry scheme subroutine test_terminator() - use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t - use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t - use musica_ccpp_micm, only: micm - use musica_ccpp_namelist, only: filename_of_micm_configuration, & - filename_of_tuvx_configuration, & - filename_of_tuvx_micm_mapping_configuration - + 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 + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 implicit none - integer, parameter :: NUM_SPECIES = 2 - integer, parameter :: NUM_TUVX_CONSTITUENTS = 1 - integer, parameter :: NUM_TUVX_ONLY_GAS_SPECIES = 3 + integer, parameter :: NUM_SPECIES = 2 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 1 + integer, parameter :: NUM_TUVX_ONLY_GAS_SPECIES = 3 ! This test requires that the number of grid cells = 4, which is the default ! vector dimension for MICM. This restriction will be removed once ! https://github.com/NCAR/musica/issues/217 is finished. @@ -409,9 +417,9 @@ subroutine test_terminator() real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS) :: cloud_area_fraction ! unitless real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS) :: air_pressure_thickness ! Pa real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & - NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: constituents ! kg kg-1 + NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) :: constituents ! kg kg-1 real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS, & - NUM_SPECIES+NUM_TUVX_CONSTITUENTS) :: initial_constituents ! kg kg-1 + NUM_SPECIES+NUM_TUVX_CONSTITUENTS+NUM_TUVX_ONLY_GAS_SPECIES) :: 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(:) @@ -478,7 +486,7 @@ subroutine test_terminator() (trim(species_name) == "Cl2" .and. molar_mass == 0.070906_kind_phys .and. is_advected) .or. & (trim(species_name) == "cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water" & .and. molar_mass == 0.018_kind_phys .and. is_advected) .or. & - (trim(species_name) == "dry_air" .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) .or. & + (trim(species_name) == "air" .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) .or. & (trim(species_name) == "O2" .and. molar_mass == 0.0319988_kind_phys .and. .not. is_advected) .or. & (trim(species_name) == "O3" .and. molar_mass == 0.0479982_kind_phys .and. .not. is_advected) ASSERT(tmp_bool) @@ -531,6 +539,14 @@ subroutine test_terminator() constituents(j,k,NUM_SPECIES+1) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) end do end do + ! set concentrations for TUV-x gas species + do j = 1, NUM_COLUMNS + do k = 1, NUM_LAYERS + constituents(j,k,NUM_SPECIES+index_dry_air) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) + constituents(j,k,NUM_SPECIES+index_O2) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) + constituents(j,k,NUM_SPECIES+index_O3) = 1.0e-3_kind_phys * (1.0 + 0.1 * (j-1) + 0.01 * (k-1)) + end do + end do initial_constituents(:,:,:) = constituents(:,:,:) write(*,*) "[MUSICA INFO] Initial Time Step" diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 index e365f32f..79b82346 100644 --- a/test/musica/tuvx/test_tuvx_gas_species.F90 +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -333,13 +333,13 @@ subroutine test_initialize_tuvx_species() tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_DRY_AIR .and. & scale_height == SCALE_HEIGHT_DRY_AIR .and. index_musica == 2 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & - .and. has_profile .eqv. .true.) .or. & + .and. has_profile) .or. & (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O2 .and. & scale_height == SCALE_HEIGHT_O2 .and. index_musica == 3 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & - .and. has_profile .eqv. .true.) .or. & + .and. has_profile) .or. & (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O3 .and. & scale_height == SCALE_HEIGHT_O3 .and. index_musica == 4 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & - .and. has_profile .eqv. .true.) + .and. has_profile) ASSERT(tmp_bool) end do From ac380771a0556d825e0e353acbcc1312cdb79587 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Sun, 22 Dec 2024 12:43:33 -0700 Subject: [PATCH 09/18] fix the error in test load tuvx species --- .../tuvx/musica_ccpp_tuvx_load_species.F90 | 11 +- test/musica/test_musica_api.F90 | 5 + test/musica/tuvx/CMakeLists.txt | 36 +- test/musica/tuvx/test_tuvx_gas_species.F90 | 33 +- test/musica/tuvx/test_tuvx_load_species.F90 | 339 ++++++++++++++++++ 5 files changed, 400 insertions(+), 24 deletions(-) create mode 100644 test/musica/tuvx/test_tuvx_load_species.F90 diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index 7bbfb698..fe7a4b39 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -61,9 +61,12 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, integer :: i_new, i_species, i_tuvx_species num_micm_species = size(micm_species) + is_dry_air_registered = .false. + is_O2_registered = .false. + is_O3_registered = .false. ! Register cloud liquid water content needed for cloud optics calculations - i_new = 1 + i_new = 1 call temp_constituent_props(i_new)%instantiate( & std_name = CLOUD_LIQUID_WATER_CONTENT_LABEL, & long_name = CLOUD_LIQUID_WATER_CONTENT_LONG_NAME, & @@ -147,6 +150,9 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, if (errcode /= 0) return end if + allocate( constituent_props(i_new) ) + constituent_props(:) = temp_constituent_props(1:i_new) + allocate(tuvx_species(num_new_species)) i_tuvx_species = 1 index_cloud_liquid_water_content = i_tuvx_species @@ -186,9 +192,6 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, profiled = .true., & scale_height = SCALE_HEIGHT_O3 ) - allocate( constituent_props(i_new) ) - constituent_props(:) = temp_constituent_props(1:i_new) - end subroutine configure_tuvx_species subroutine check_tuvx_species_initialization(errmsg, errcode) diff --git a/test/musica/test_musica_api.F90 b/test/musica/test_musica_api.F90 index 99cddfe9..76af8099 100644 --- a/test/musica/test_musica_api.F90 +++ b/test/musica/test_musica_api.F90 @@ -10,8 +10,13 @@ program run_test_musica_ccpp real(kind_phys), parameter :: DEGREE_TO_RADIAN = 3.14159265358979323846_kind_phys / 180.0_kind_phys + write(*,*) "[MUSICA Test] Running the Chapman test" call test_chapman() + write(*,*) "[MUSICA Test] Ends the Chapman test" + + write(*,*) "[MUSICA Test] Running the Terminator test" call test_terminator() + write(*,*) "[MUSICA Test] Ends the Terminator test" contains diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index a875ec69..c82ba2d4 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -204,4 +204,38 @@ add_test( WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} ) -add_memory_check_test(test_tuvx_gas_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file +add_memory_check_test(test_tuvx_gas_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) + +# Configure TUV-x species/constituents +add_executable(test_tuvx_load_species test_tuvx_load_species.F90) + +target_sources(test_tuvx_load_species + PUBLIC + ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_load_species.F90 + ${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_gas_species.F90 + ${MUSICA_SRC_PATH}/musica_ccpp_species.F90 + ${MUSICA_SRC_PATH}/musica_ccpp_util.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 +) + +target_link_libraries(test_tuvx_load_species + PRIVATE + musica::musica-fortran +) + +set_target_properties(test_tuvx_load_species + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_tuvx_load_species + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_tuvx_load_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 index 79b82346..89b60f30 100644 --- a/test/musica/tuvx/test_tuvx_gas_species.F90 +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -141,9 +141,7 @@ subroutine test_create_gas_species_profile() use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration - use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, & - MOLAR_MASS_DRY_AIR, MOLAR_MASS_O2, MOLAR_MASS_O3, & - SCALE_HEIGHT_DRY_AIR, SCALE_HEIGHT_O2, SCALE_HEIGHT_O3 + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED integer, parameter :: NUM_COLUMNS = 2 @@ -230,12 +228,12 @@ subroutine test_create_gas_species_profile() molar_mass = tuvx_species_set(i_elem)%molar_mass scale_height = tuvx_species_set(i_elem)%scale_height index_musica = tuvx_species_set(i_elem)%index_musica_species - tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_DRY_AIR .and. & - scale_height == SCALE_HEIGHT_DRY_AIR .and. index_musica == 2) .or. & - (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O2 .and. & - scale_height == SCALE_HEIGHT_O2 .and. index_musica == 3) .or. & - (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O3 .and. & - scale_height == SCALE_HEIGHT_O3 .and. index_musica == 4) + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0289644_kind_phys .and. & + scale_height == 8.01_kind_phys .and. index_musica == 2) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0319988_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 3) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0479982_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 4) ASSERT(tmp_bool) end do @@ -262,9 +260,7 @@ subroutine test_initialize_tuvx_species() use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration - use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, & - MOLAR_MASS_DRY_AIR, MOLAR_MASS_O2, MOLAR_MASS_O3, & - SCALE_HEIGHT_DRY_AIR, SCALE_HEIGHT_O2, SCALE_HEIGHT_O3 + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED integer, parameter :: NUM_COLUMNS = 2 @@ -330,15 +326,14 @@ subroutine test_initialize_tuvx_species() index_musica = tuvx_species_set(i_elem)%index_musica_species index_constituent_props = tuvx_species_set(i_elem)%index_constituent_props has_profile = tuvx_species_set(i_elem)%profiled - - tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_DRY_AIR .and. & - scale_height == SCALE_HEIGHT_DRY_AIR .and. index_musica == 2 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0289644_kind_phys .and. & + scale_height == 8.01_kind_phys .and. index_musica == 2 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & .and. has_profile) .or. & - (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O2 .and. & - scale_height == SCALE_HEIGHT_O2 .and. index_musica == 3 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0319988_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 3 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & .and. has_profile) .or. & - (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == MOLAR_MASS_O3 .and. & - scale_height == SCALE_HEIGHT_O3 .and. index_musica == 4 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0479982_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 4 .and. index_constituent_props /= MUSICA_INT_UNASSIGNED & .and. has_profile) ASSERT(tmp_bool) end do diff --git a/test/musica/tuvx/test_tuvx_load_species.F90 b/test/musica/tuvx/test_tuvx_load_species.F90 new file mode 100644 index 00000000..203a7dc6 --- /dev/null +++ b/test/musica/tuvx/test_tuvx_load_species.F90 @@ -0,0 +1,339 @@ +program test_tuvx_load_species + + use musica_ccpp_tuvx_load_species + + 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_configure_shared_gas_species_tuvx_micm() + call test_configure_partial_shared_gas_species() + call test_configure_no_shared_gas_species() + +contains + + subroutine test_configure_shared_gas_species_tuvx_micm() + ! There are three gas species required for TUV-x: dry air, O2, and O3. + ! This test focuses on configuring MUSICA species and constituent properties + ! when the MICM species include all of these. Cloud liquid water content is the only component specific to TUVX. + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t, MUSICA_INT_UNASSIGNED + use musica_util, only: error_t + + integer, parameter :: NUM_MICM_SPECIES = 6 + integer, parameter :: NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX = 3 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 4 + type(musica_species_t) :: micm_species(NUM_MICM_SPECIES) + type(musica_species_t), allocatable :: tuvx_species(:) + type(ccpp_constituent_properties_t) :: micm_constituent_props(NUM_MICM_SPECIES) + type(ccpp_constituent_properties_t), allocatable :: tuvx_constituent_props(:) + character(len=512) :: errmsg + integer :: errcode + real(kind_phys) :: molar_mass_group(NUM_MICM_SPECIES) = & + [0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys, 0.5_kind_phys, 0.6_kind_phys] + integer :: i_species + character(len=512) :: species_names(NUM_MICM_SPECIES) + character(len=512) :: name, unit, species_name + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica, index_constituent_props + logical :: is_advected, tmp_bool, has_profile + + species_names(1) = 'N2' + species_names(2) = 'O2' ! shared species + species_names(3) = 'FOO' + species_names(4) = 'O1D' + species_names(5) = 'air' ! shared species + species_names(6) = 'O3' ! shared species + + do i_species = 1, NUM_MICM_SPECIES + call micm_constituent_props(i_species)%instantiate( & + std_name = trim(species_names(i_species)), & + long_name = trim(species_names(i_species)), & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = molar_mass_group(i_species), & + advected = .true., & + errcode = errcode, & + errmsg = errmsg) + + micm_species(i_species) = musica_species_t( & + name = species_names(i_species), & + unit = 'kg kg-1', & + molar_mass = molar_mass_group(i_species), & + index_musica_species = i_species ) + end do + + call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(allocated(tuvx_constituent_props)) + ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) + ASSERT(tuvx_constituent_props(1)%is_instantiated(errcode, errmsg)) + call tuvx_constituent_props(1)%standard_name(species_name, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(1)%molar_mass(molar_mass, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(1)%is_advected(is_advected, errcode, errmsg) + ASSERT(errcode == 0) + tmp_bool = (trim(species_name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + molar_mass == 0.018_kind_phys .and. is_advected) + ASSERT(tmp_bool) + + ASSERT(allocated(tuvx_species)) + ASSERT(size(tuvx_species) == NUM_TUVX_CONSTITUENTS) + do i_species = 1, size(tuvx_species) + name = tuvx_species(i_species)%name + unit = tuvx_species(i_species)%unit + molar_mass = tuvx_species(i_species)%molar_mass + scale_height = tuvx_species(i_species)%scale_height + index_musica = tuvx_species(i_species)%index_musica_species + index_constituent_props = tuvx_species(i_species)%index_constituent_props + has_profile = tuvx_species(i_species)%profiled + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0289644_kind_phys .and. & + scale_height == 8.01_kind_phys .and. index_musica == 2 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0319988_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 3 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0479982_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 4 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + trim(unit) == 'kg kg-1' .and. molar_mass == 0.018_kind_phys .and. & + scale_height == 0.0_kind_phys .and. index_musica == 1 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. .not. has_profile) + ASSERT(tmp_bool) + end do + + do i_species = 1, size(tuvx_species) + call tuvx_species(i_species)%deallocate() + end do + deallocate(tuvx_species) + deallocate(tuvx_constituent_props) + + end subroutine test_configure_shared_gas_species_tuvx_micm + + subroutine test_configure_partial_shared_gas_species() + ! This test case applies when some gas species are registered in MICM. + ! It checks which species are already registered and which are not, + ! adding only the new species to the constituent properties. + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t, MUSICA_INT_UNASSIGNED + use musica_util, only: error_t + + integer, parameter :: NUM_MICM_SPECIES = 6 + integer, parameter :: NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX = 2 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 4 + type(musica_species_t) :: micm_species(NUM_MICM_SPECIES) + type(musica_species_t), allocatable :: tuvx_species(:) + type(ccpp_constituent_properties_t) :: micm_constituent_props(NUM_MICM_SPECIES) + type(ccpp_constituent_properties_t), allocatable :: tuvx_constituent_props(:) + character(len=512) :: errmsg + integer :: errcode + real(kind_phys) :: molar_mass_group(NUM_MICM_SPECIES) = & + [0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys, 0.5_kind_phys, 0.6_kind_phys] + integer :: i_species + character(len=512) :: species_names(NUM_MICM_SPECIES) + character(len=512) :: name, unit, species_name + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica, index_constituent_props + logical :: is_advected, tmp_bool, has_profile + + species_names(1) = 'N2' + species_names(2) = 'O2' ! shared species + species_names(3) = 'FOO' + species_names(4) = 'O1D' + species_names(5) = 'BAZ' + species_names(6) = 'O3' ! shared species + + do i_species = 1, NUM_MICM_SPECIES + call micm_constituent_props(i_species)%instantiate( & + std_name = trim(species_names(i_species)), & + long_name = trim(species_names(i_species)), & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = molar_mass_group(i_species), & + advected = .true., & + errcode = errcode, & + errmsg = errmsg) + + micm_species(i_species) = musica_species_t( & + name = species_names(i_species), & + unit = 'kg kg-1', & + molar_mass = molar_mass_group(i_species), & + index_musica_species = i_species ) + end do + + call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(allocated(tuvx_constituent_props)) + write(*,*) "size(tuvx_constituent_props): ", size(tuvx_constituent_props) + ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) + do i_species = 1, size(tuvx_constituent_props) + ASSERT(tuvx_constituent_props(i_species)%is_instantiated(errcode, errmsg)) + call tuvx_constituent_props(i_species)%standard_name(species_name, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%molar_mass(molar_mass, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%is_advected(is_advected, errcode, errmsg) + ASSERT(errcode == 0) + tmp_bool = (trim(species_name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + molar_mass == 0.018_kind_phys .and. is_advected) .or. & + (trim(species_name) == 'air' .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) + ASSERT(tmp_bool) + end do + + ASSERT(allocated(tuvx_species)) + ASSERT(size(tuvx_species) == NUM_TUVX_CONSTITUENTS) + do i_species = 1, size(tuvx_species) + name = tuvx_species(i_species)%name + unit = tuvx_species(i_species)%unit + molar_mass = tuvx_species(i_species)%molar_mass + scale_height = tuvx_species(i_species)%scale_height + index_musica = tuvx_species(i_species)%index_musica_species + index_constituent_props = tuvx_species(i_species)%index_constituent_props + has_profile = tuvx_species(i_species)%profiled + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0289644_kind_phys .and. & + scale_height == 8.01_kind_phys .and. index_musica == 2 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0319988_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 3 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0479982_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 4 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + trim(unit) == 'kg kg-1' .and. molar_mass == 0.018_kind_phys .and. & + scale_height == 0.0_kind_phys .and. index_musica == 1 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. .not. has_profile) + ASSERT(tmp_bool) + end do + + do i_species = 1, size(tuvx_species) + call tuvx_species(i_species)%deallocate() + end do + deallocate(tuvx_species) + deallocate(tuvx_constituent_props) + + end subroutine test_configure_partial_shared_gas_species + + subroutine test_configure_no_shared_gas_species() + ! This test case applies when there are no shared species between MICM and TUV-x. + ! All configured components are added to the constituent properties. + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t, MUSICA_INT_UNASSIGNED + use musica_util, only: error_t + + integer, parameter :: NUM_MICM_SPECIES = 6 + integer, parameter :: NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX = 0 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 4 + type(musica_species_t) :: micm_species(NUM_MICM_SPECIES) + type(musica_species_t), allocatable :: tuvx_species(:) + type(ccpp_constituent_properties_t) :: micm_constituent_props(NUM_MICM_SPECIES) + type(ccpp_constituent_properties_t), allocatable :: tuvx_constituent_props(:) + character(len=512) :: errmsg + integer :: errcode + real(kind_phys) :: molar_mass_group(NUM_MICM_SPECIES) = & + [0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys, 0.5_kind_phys, 0.6_kind_phys] + integer :: i_species + character(len=512) :: species_names(NUM_MICM_SPECIES) + character(len=512) :: name, unit, species_name + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica, index_constituent_props + logical :: is_advected, tmp_bool, has_profile + + species_names(1) = 'N2' + species_names(2) = 'BAR' + species_names(3) = 'FOO' + species_names(4) = 'O1D' + species_names(5) = 'BAZ' + species_names(6) = 'BOB' + + do i_species = 1, NUM_MICM_SPECIES + call micm_constituent_props(i_species)%instantiate( & + std_name = trim(species_names(i_species)), & + long_name = trim(species_names(i_species)), & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = molar_mass_group(i_species), & + advected = .true., & + errcode = errcode, & + errmsg = errmsg) + + micm_species(i_species) = musica_species_t( & + name = species_names(i_species), & + unit = 'kg kg-1', & + molar_mass = molar_mass_group(i_species), & + index_musica_species = i_species ) + end do + + call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(allocated(tuvx_constituent_props)) + ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) + do i_species = 1, size(tuvx_constituent_props) + ASSERT(tuvx_constituent_props(i_species)%is_instantiated(errcode, errmsg)) + call tuvx_constituent_props(i_species)%standard_name(species_name, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%molar_mass(molar_mass, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%is_advected(is_advected, errcode, errmsg) + ASSERT(errcode == 0) + tmp_bool = (trim(species_name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + molar_mass == 0.018_kind_phys .and. is_advected) .or. & + (trim(species_name) == 'air' .and. molar_mass == 0.0289644_kind_phys .and. .not. is_advected) .or. & + (trim(species_name) == 'O2' .and. molar_mass == 0.0319988_kind_phys .and. .not. is_advected) .or. & + (trim(species_name) == 'O3' .and. molar_mass == 0.0479982_kind_phys .and. .not. is_advected) + ASSERT(tmp_bool) + end do + + ASSERT(allocated(tuvx_species)) + ASSERT(size(tuvx_species) == NUM_TUVX_CONSTITUENTS) + do i_species = 1, size(tuvx_species) + name = tuvx_species(i_species)%name + unit = tuvx_species(i_species)%unit + molar_mass = tuvx_species(i_species)%molar_mass + scale_height = tuvx_species(i_species)%scale_height + index_musica = tuvx_species(i_species)%index_musica_species + index_constituent_props = tuvx_species(i_species)%index_constituent_props + has_profile = tuvx_species(i_species)%profiled + tmp_bool = (trim(name) == 'air' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0289644_kind_phys .and. & + scale_height == 8.01_kind_phys .and. index_musica == 2 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O2' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0319988_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 3 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'O3' .and. trim(unit) == 'molecule cm-3' .and. molar_mass == 0.0479982_kind_phys .and. & + scale_height == 7.0_kind_phys .and. index_musica == 4 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. has_profile) .or. & + (trim(name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + trim(unit) == 'kg kg-1' .and. molar_mass == 0.018_kind_phys .and. & + scale_height == 0.0_kind_phys .and. index_musica == 1 .and. index_constituent_props == MUSICA_INT_UNASSIGNED & + .and. .not. has_profile) + ASSERT(tmp_bool) + end do + + do i_species = 1, size(tuvx_species) + call tuvx_species(i_species)%deallocate() + end do + deallocate(tuvx_species) + deallocate(tuvx_constituent_props) + + end subroutine test_configure_no_shared_gas_species + +end program test_tuvx_load_species \ No newline at end of file From a9f6c6d96e6f1d1a7de1c417daa9bee4570012dd Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Sun, 22 Dec 2024 18:33:15 -0700 Subject: [PATCH 10/18] add musica species test --- schemes/musica/micm/musica_ccpp_micm.F90 | 2 +- schemes/musica/musica_ccpp.F90 | 18 +- schemes/musica/musica_ccpp_species.F90 | 101 ++++++--- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 33 ++- test/musica/CMakeLists.txt | 39 +++- test/musica/test_musica_species.F90 | 218 ++++++++++++++++++++ test/musica/tuvx/test_tuvx_load_species.F90 | 21 ++ 7 files changed, 384 insertions(+), 48 deletions(-) create mode 100644 test/musica/test_musica_species.F90 diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 08f6eefe..96e8629f 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -76,7 +76,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & error) if (has_error_occurred(error, errmsg, errcode)) return - call constituent_props(i)%instantiate( & + call constituent_props(species_index)%instantiate( & std_name = species_name, & long_name = species_name, & units = 'kg kg-1', & diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 86150794..4f558db2 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -121,7 +121,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co use musica_ccpp_micm, only: number_of_rate_parameters use musica_ccpp_micm_util, only: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio use musica_ccpp_species, only: number_of_micm_species, number_of_tuvx_species, & - micm_molar_mass_array, extract_subset_constituents, update_constituents + micm_indices_constituent_props, tuvx_indices_constituent_props, micm_molar_mass_array, & + extract_subset_constituents, update_constituents real(kind_phys), intent(in) :: time_step ! s real(kind_phys), target, intent(in) :: temperature(:,:) ! K @@ -156,7 +157,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co size(constituents, dim=2), & number_of_rate_parameters) :: rate_parameters ! various units - call extract_subset_constituents(constituents, constituents_tuvx_species, errmsg, errcode) + call extract_subset_constituents(tuvx_indices_constituent_props, constituents, & + constituents_tuvx_species, errmsg, errcode) if (errcode /= 0) return ! Calculate photolysis rate constants using TUV-x @@ -176,10 +178,11 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co rate_parameters, & errmsg, errcode) - call update_constituents(constituents_tuvx_species, constituents, errmsg, errcode) + call update_constituents(tuvx_indices_constituent_props, constituents_tuvx_species, & + constituents, errmsg, errcode) if (errcode /= 0) return - - call extract_subset_constituents(constituents, constituents_micm_species, errmsg, errcode) + call extract_subset_constituents(micm_indices_constituent_props, constituents, & + constituents_micm_species, errmsg, errcode) if (errcode /= 0) return ! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3) @@ -192,7 +195,8 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co ! Convert MICM unit back to CAM-SIMA unit (mol m-3 -> kg kg-1) call convert_to_mass_mixing_ratio(dry_air_density, micm_molar_mass_array, constituents_micm_species) - call update_constituents(constituents_micm_species, constituents, errmsg, errcode) + call update_constituents(micm_indices_constituent_props, constituents_micm_species, & + constituents, errmsg, errcode) if (errcode /= 0) return end subroutine musica_ccpp_run @@ -210,4 +214,4 @@ subroutine musica_ccpp_final(errmsg, errcode) end subroutine musica_ccpp_final -end module musica_ccpp +end module musica_ccpp \ No newline at end of file diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index 5871be99..c8b55ce6 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -14,11 +14,14 @@ module musica_ccpp_species type, public :: musica_species_t character(len=:), allocatable :: name character(len=:), allocatable :: unit - real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: molar_mass = 0.0_kind_phys ! kg mol-1 integer :: index_musica_species = MUSICA_INT_UNASSIGNED integer :: index_constituent_props = MUSICA_INT_UNASSIGNED logical :: profiled = .false. ! optional real(kind_phys) :: scale_height = 0.0_kind_phys ! km, optional + contains + ! Deallocates the member objects + procedure :: deallocate => musica_species_t_deallocate end type musica_species_t interface musica_species_t @@ -26,7 +29,7 @@ module musica_ccpp_species end interface musica_species_t ! Species are ordered to match the sequence of the MICM state array - type(musica_species_t), allocatable, protected, public :: micm_species_set(:) ! index should match with the MICM state array + type(musica_species_t), allocatable, protected, public :: micm_species_set(:) type(musica_species_t), allocatable, protected, public :: tuvx_species_set(:) integer, allocatable, protected, public :: micm_indices_constituent_props(:) integer, allocatable, protected, public :: tuvx_indices_constituent_props(:) @@ -39,7 +42,6 @@ module musica_ccpp_species !> Constructor for musica_species_t object function species_t_constructor(name, unit, molar_mass, scale_height, & index_musica_species, index_constituent_props) result( this ) - character(len=*), intent(in) :: name character(len=*), intent(in) :: unit real(kind_phys), intent(in) :: molar_mass ! kg mol-1 @@ -57,11 +59,38 @@ function species_t_constructor(name, unit, molar_mass, scale_height, & end function species_t_constructor + !> Deallocates memory associated with this musica species object + subroutine musica_species_t_deallocate(this) + class(musica_species_t), intent(inout) :: this + + if (allocated(this%name)) deallocate(this%name) + if (allocated(this%unit)) deallocate(this%unit) + this%molar_mass = 0.0_kind_phys + this%index_musica_species = MUSICA_INT_UNASSIGNED + this%index_constituent_props = MUSICA_INT_UNASSIGNED + this%profiled = .false. + this%scale_height = 0.0_kind_phys + + end subroutine musica_species_t_deallocate + subroutine cleanup_musica_species() + integer :: i + + if (allocated( micm_species_set )) then + do i = 1, size(micm_species_set) + call micm_species_set(i)%deallocate() + end do + deallocate( micm_species_set ) + end if + + if (allocated( tuvx_species_set )) then + do i = 1, size(tuvx_species_set) + call tuvx_species_set(i)%deallocate() + end do + deallocate( tuvx_species_set ) + end if - if (allocated( micm_species_set )) deallocate( micm_species_set ) if (allocated( micm_indices_constituent_props )) deallocate( micm_indices_constituent_props ) - if (allocated( tuvx_species_set )) deallocate( tuvx_species_set ) if (allocated( tuvx_indices_constituent_props )) deallocate( tuvx_indices_constituent_props ) if (allocated( micm_molar_mass_array )) deallocate( micm_molar_mass_array ) @@ -90,8 +119,8 @@ subroutine find_musica_species_indices(constituent_props, musica_species_set, & type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:) type(musica_species_t), intent(inout) :: musica_species_set(:) integer, intent(inout) :: indices_constituent_props(:) - character(len=512), intent(out) :: errmsg - integer, intent(out) :: errcode + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode ! local variables integer :: i_elem, index_species @@ -139,6 +168,8 @@ subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) end subroutine initialize_musica_species_indices + !> Iterate through the constituent property array to populate the molar mass array, + ! storing molar mass values in a sequence that matches the order of the MICM state array subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t @@ -180,64 +211,68 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) end subroutine initialize_molar_mass_array !> Extract sub-constituents array using the indices from constituents array - subroutine extract_subset_constituents(constituents, subset_constituents, errmsg, errcode) - + subroutine extract_subset_constituents(indices_constituent_props, constituents, & + subset_constituents, errmsg, errcode) + integer, intent(in) :: indices_constituent_props(:) real(kind_phys), intent(in) :: constituents(:,:,:) ! kg kg-1 real(kind_phys), intent(inout) :: subset_constituents(:,:,:) ! kg kg-1 character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables - integer :: i_elem + integer :: i - if ( size(subset_constituents, dim=3) == number_of_micm_species ) then - do i_elem = 1, number_of_micm_species - subset_constituents(:,:,i_elem) = constituents(:,:,micm_indices_constituent_props(i_elem)) - end do - else if ( size(subset_constituents, dim=3) == number_of_tuvx_species ) then - do i_elem = 1, number_of_tuvx_species - subset_constituents(:,:,i_elem) = constituents(:,:,tuvx_indices_constituent_props(i_elem)) - end do - else + errmsg = '' + errcode = 0 + + if (size(subset_constituents, dim=3) /= size(indices_constituent_props)) then errmsg = "[MUSICA Error] The given dimension for the constituents & - doesn't match the size of any species array." + doesn't match the size of species indices array." errcode = 1 return end if - end subroutine extract_subset_constituents + do i = 1, size(indices_constituent_props) + subset_constituents(:,:,i) = constituents(:,:,indices_constituent_props(i)) + end do - subroutine update_constituents(subset_constituents, constituents, errmsg, errcode) + end subroutine extract_subset_constituents + subroutine update_constituents(indices_constituent_props, subset_constituents, & + constituents, errmsg, errcode) + integer, intent(in) :: indices_constituent_props(:) real(kind_phys), intent(in) :: subset_constituents(:,:,:) ! kg kg-1 real(kind_phys), intent(inout) :: constituents(:,:,:) ! kg kg-1 character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode ! local variables - integer :: i_elem + integer :: i - if ( size(subset_constituents, dim=3) == number_of_micm_species ) then - do i_elem = 1, number_of_micm_species - constituents(:,:,micm_indices_constituent_props(i_elem)) = subset_constituents(:,:,i_elem) - end do - else if ( size(subset_constituents, dim=3) == number_of_tuvx_species ) then - do i_elem = 1, number_of_tuvx_species - constituents(:,:,tuvx_indices_constituent_props(i_elem)) = subset_constituents(:,:,i_elem) - end do - else + errmsg = '' + errcode = 0 + + if (size(subset_constituents, dim=3) /= size(indices_constituent_props)) then errmsg = "[MUSICA Error] The given dimension for the constituents & - doesn't match the size of any species array." + doesn't match the size of species indices array." errcode = 1 return end if + do i= 1, size(indices_constituent_props) + constituents(:,:,indices_constituent_props(i)) = subset_constituents(:,:,i) + end do + + end subroutine update_constituents subroutine check_initialization(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode + errmsg = '' + errcode = 0 + if (.not. allocated( micm_species_set )) then errmsg = "[MUSICA Error] MICM species set has not been allocated." errcode = 1 diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index 34d15ea3..c80979b5 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -145,6 +145,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & only: create_dry_air_profile, create_O2_profile, create_O3_profile use musica_ccpp_tuvx_cloud_optics, & only: create_cloud_optics_radiator, cloud_optics_label + use musica_ccpp_tuvx_load_species, & + only: DRY_AIR_LABEL, O2_LABEL, O3_LABEL, TUVX_GAS_SPECIES_UNITS integer, intent(in) :: vertical_layer_dimension ! (count) integer, intent(in) :: vertical_interface_dimension ! (count) @@ -384,6 +386,33 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, & return end if + dry_air_profile => profiles%get( DRY_AIR_LABEL, TUVX_GAS_SPECIES_UNITS, error ) + if (has_error_occurred( error, errmsg, errcode )) then + deallocate( tuvx ) + tuvx => null() + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + + O2_profile => profiles%get( O2_LABEL, TUVX_GAS_SPECIES_UNITS, error ) + if (has_error_occurred( error, errmsg, errcode )) then + deallocate( tuvx ) + tuvx => null() + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + + O3_profile => profiles%get( O3_LABEL, TUVX_GAS_SPECIES_UNITS, error ) + if (has_error_occurred( error, errmsg, errcode )) then + deallocate( tuvx ) + tuvx => null() + call reset_tuvx_map_state( grids, profiles, null() ) + call cleanup_tuvx_resources() + return + end if + radiators => tuvx%get_radiators( error ) if (has_error_occurred( error, errmsg, errcode )) then deallocate( tuvx ) @@ -503,8 +532,8 @@ subroutine tuvx_run(temperature, dry_air_density, & call set_surface_albedo_values( surface_albedo_profile, surface_albedo, errmsg, errcode ) if (errcode /= 0) return - call set_extraterrestrial_flux_values( extraterrestrial_flux_profile, & - photolysis_wavelength_grid_interfaces, & + call set_extraterrestrial_flux_values( extraterrestrial_flux_profile, & + photolysis_wavelength_grid_interfaces, & extraterrestrial_flux, errmsg, errcode ) if (errcode /= 0) return diff --git a/test/musica/CMakeLists.txt b/test/musica/CMakeLists.txt index fbedfba3..f060ac59 100644 --- a/test/musica/CMakeLists.txt +++ b/test/musica/CMakeLists.txt @@ -13,10 +13,7 @@ set(MUSICA_ENABLE_INSTALL OFF) FetchContent_MakeAvailable(musica) -# --------------------------------------------------------- -# Create a test for MUSICA CCPP wrapper -# --------------------------------------------------------- - +# MUSICA CCPP API test add_executable(test_musica_api test_musica_api.F90 musica_ccpp_namelist.F90) file(GLOB MUSICA_CCPP_SOURCES @@ -87,4 +84,36 @@ 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 -) \ No newline at end of file +) + +# MUSICA species test +add_executable(test_musica_species test_musica_species.F90 musica_ccpp_namelist.F90) + +target_sources(test_musica_species + PUBLIC + ${MUSICA_CCPP_SOURCES} + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_const_utils.F90 + ${TO_BE_CCPPIZED_SRC_PATH}/ccpp_tuvx_utils.F90 + ${CCPP_SRC_PATH}/ccpp_constituent_prop_mod.F90 + ${CCPP_SRC_PATH}/ccpp_hash_table.F90 + ${CCPP_SRC_PATH}/ccpp_hashable.F90 + ${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90 +) + +target_link_libraries(test_musica_species + PRIVATE + musica::musica-fortran +) + +set_target_properties(test_musica_species + PROPERTIES + LINKER_LANGUAGE Fortran +) + +add_test( + NAME test_musica_species + COMMAND $ + WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY} +) + +add_memory_check_test(test_musica_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) \ No newline at end of file diff --git a/test/musica/test_musica_species.F90 b/test/musica/test_musica_species.F90 new file mode 100644 index 00000000..3287c2e2 --- /dev/null +++ b/test/musica/test_musica_species.F90 @@ -0,0 +1,218 @@ +program test_musica_species + + use musica_ccpp_species + + 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_register_musica_species() + call test_initialize_musica_species_indices_and_molar_mass() + call test_extract_and_update_subset_constituents() + +contains + + subroutine test_register_musica_species() + use ccpp_kinds, only: kind_phys + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t + use musica_ccpp_species, only: musica_species_t + use musica_ccpp_tuvx_load_species, & + only: configure_tuvx_species, check_tuvx_species_initialization + + integer, parameter :: NUM_MICM_SPECIES = 6 + integer, parameter :: NUM_TUVX_CONSTITUENTS = 4 + type(musica_species_t) :: micm_species(NUM_MICM_SPECIES) + type(musica_species_t), allocatable :: tuvx_species(:) + type(ccpp_constituent_properties_t) :: micm_constituent_props(NUM_MICM_SPECIES) + type(ccpp_constituent_properties_t), allocatable :: tuvx_constituent_props(:) + character(len=512) :: errmsg + integer :: errcode + real(kind_phys) :: molar_mass_group(NUM_MICM_SPECIES) = & + [0.1_kind_phys, 0.2_kind_phys, 0.3_kind_phys, 0.4_kind_phys, 0.5_kind_phys, 0.6_kind_phys] + integer :: i_species + character(len=512) :: species_names(NUM_MICM_SPECIES) + + species_names(1) = 'N2' + species_names(2) = 'O2' ! shared species + species_names(3) = 'FOO' + species_names(4) = 'O1D' + species_names(5) = 'BAZ' + species_names(6) = 'O3' ! shared species + + do i_species = 1, NUM_MICM_SPECIES + call micm_constituent_props(i_species)%instantiate( & + std_name = trim(species_names(i_species)), & + long_name = trim(species_names(i_species)), & + units = 'kg kg-1', & + vertical_dim = 'vertical_layer_dimension', & + default_value = 0.0_kind_phys, & + min_value = 0.0_kind_phys, & + molar_mass = molar_mass_group(i_species), & + advected = .true., & + errcode = errcode, & + errmsg = errmsg) + + micm_species(i_species) = musica_species_t( & + name = species_names(i_species), & + unit = 'kg kg-1', & + molar_mass = molar_mass_group(i_species), & + index_musica_species = i_species ) + end do + + call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode) + ASSERT(errcode == 0) + + call register_musica_species(micm_species, tuvx_species) + ASSERT(allocated(micm_species_set)) + ASSERT(allocated(tuvx_species_set)) + ASSERT(number_of_micm_species == NUM_MICM_SPECIES) + ASSERT(number_of_tuvx_species == NUM_TUVX_CONSTITUENTS) + + call check_tuvx_species_initialization(errmsg, errcode) + ASSERT(errcode == 0) + + do i_species = 1, size(micm_species) + call micm_species(i_species)%deallocate() + end do + do i_species = 1, size(tuvx_species) + call tuvx_species(i_species)%deallocate() + end do + deallocate(tuvx_species) + deallocate(tuvx_constituent_props) + + call cleanup_musica_species() + + end subroutine test_register_musica_species + + subroutine test_initialize_musica_species_indices_and_molar_mass() + use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t, ccpp_constituent_prop_ptr_t + use musica_ccpp, only: musica_ccpp_register + use musica_ccpp_namelist, only: filename_of_micm_configuration, & + filename_of_tuvx_configuration, & + filename_of_tuvx_micm_mapping_configuration + + type(ccpp_constituent_properties_t), allocatable, target :: constituent_props(:) + type(ccpp_constituent_prop_ptr_t), allocatable :: constituent_props_ptr(:) + type(ccpp_constituent_properties_t), pointer :: const_prop + character(len=512) :: errmsg + integer :: errcode + integer :: i + + 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' + + call musica_ccpp_register(constituent_props, errmsg, errcode) + if (errcode /= 0) then + write(*,*) trim(errmsg) + stop 3 + endif + ASSERT(allocated(constituent_props)) + + allocate(constituent_props_ptr(size(constituent_props))) + do i = 1, size(constituent_props) + const_prop => constituent_props(i) + call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) + end do + + call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(allocated(micm_indices_constituent_props)) + ASSERT(allocated(tuvx_indices_constituent_props)) + + call initialize_molar_mass_array(constituent_props_ptr, errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(allocated(micm_molar_mass_array)) + + do i = 1, size(micm_species_set) + ASSERT(micm_species_set(i)%index_musica_species == i) + ASSERT(micm_species_set(i)%index_constituent_props == micm_indices_constituent_props(i)) + ASSERT(micm_species_set(i)%molar_mass == micm_molar_mass_array(i)) + end do + + do i = 1, size(tuvx_species_set) + ASSERT(tuvx_species_set(i)%index_musica_species == i) + ASSERT(tuvx_species_set(i)%index_constituent_props == tuvx_indices_constituent_props(i)) + end do + + call check_initialization(errmsg, errcode) + ASSERT(errcode == 0) + + call cleanup_musica_species() + + end subroutine test_initialize_musica_species_indices_and_molar_mass + + + subroutine test_extract_and_update_subset_constituents() + use ccpp_kinds, only: kind_phys + + integer, parameter :: NUM_COLUMNS = 3 + integer, parameter :: NUM_LAYERS = 3 + integer, parameter :: NUM_SPECIES = 5 + integer, parameter :: NUM_SUBSET_SPECIES = 3 + integer :: indices_array(NUM_SUBSET_SPECIES) = [2, 4, 5] + real(kind_phys) :: constituents(NUM_COLUMNS, NUM_LAYERS, NUM_SPECIES) + real(kind_phys) :: subset_constituents(NUM_COLUMNS, NUM_LAYERS, NUM_SUBSET_SPECIES) + real(kind_phys) :: expected_constituents(NUM_COLUMNS, NUM_LAYERS, NUM_SPECIES) + real(kind_phys) :: expected_subset_constituents(NUM_COLUMNS, NUM_LAYERS, NUM_SUBSET_SPECIES) + character(len=512) :: errmsg + integer :: errcode + integer :: i, j, k + + ! Initialize the arrays (example values) + constituents = reshape([1.0, 2.0, 3.0, 4.0, 5.0, & + 6.0, 7.0, 8.0, 9.0, 10.0, & + 11.0, 12.0, 13.0, 14.0, 15.0, & + 16.0, 17.0, 18.0, 19.0, 20.0, & + 21.0, 22.0, 23.0, 24.0, 25.0, & + 26.0, 27.0, 28.0, 29.0, 30.0, & + 31.0, 32.0, 33.0, 34.0, 35.0, & + 36.0, 37.0, 38.0, 39.0, 40.0, & + 41.0, 42.0, 43.0, 44.0, 45.0, & + 46.0, 47.0, 48.0, 49.0, 50.0], shape(constituents)) + expected_constituents(:,:,:) = constituents(:,:,:) + do k = 1, NUM_SUBSET_SPECIES + do j = 1, NUM_LAYERS + do i = 1, NUM_COLUMNS + expected_subset_constituents(i,j,k) = constituents(i,j,indices_array(k)) + end do + end do + end do + + call extract_subset_constituents(indices_array, constituents, & + subset_constituents, errmsg, errcode) + ASSERT(errcode == 0) + do k = 1, NUM_SUBSET_SPECIES + do j = 1, NUM_LAYERS + do i = 1, NUM_COLUMNS + ASSERT(expected_subset_constituents(i,j,k) == subset_constituents(i,j,k)) + end do + end do + end do + + do k = 1, NUM_SUBSET_SPECIES + do j = 1, NUM_LAYERS + do i = 1, NUM_COLUMNS + subset_constituents(i,j,k) = subset_constituents(i,j,k) + 100.0_kind_phys + expected_constituents(i,j,indices_array(k)) = & + expected_constituents(i,j,indices_array(k)) + 100.0_kind_phys + end do + end do + end do + + call update_constituents(indices_array, subset_constituents, & + constituents, errmsg, errcode) + ASSERT(errcode == 0) + do k = 1, NUM_SPECIES + do j = 1, NUM_LAYERS + do i = 1, NUM_COLUMNS + ASSERT(expected_constituents(i,j,k) == constituents(i,j,k)) + end do + end do + end do + + end subroutine test_extract_and_update_subset_constituents + +end program test_musica_species \ No newline at end of file diff --git a/test/musica/tuvx/test_tuvx_load_species.F90 b/test/musica/tuvx/test_tuvx_load_species.F90 index 203a7dc6..a091f26d 100644 --- a/test/musica/tuvx/test_tuvx_load_species.F90 +++ b/test/musica/tuvx/test_tuvx_load_species.F90 @@ -110,6 +110,13 @@ subroutine test_configure_shared_gas_species_tuvx_micm() ASSERT(tmp_bool) end do + call check_tuvx_species_initialization(errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(index_cloud_liquid_water_content == 1) + ASSERT(index_dry_air == 2) + ASSERT(index_O2 == 3) + ASSERT(index_O3 == 4) + do i_species = 1, size(tuvx_species) call tuvx_species(i_species)%deallocate() end do @@ -219,6 +226,13 @@ subroutine test_configure_partial_shared_gas_species() ASSERT(tmp_bool) end do + call check_tuvx_species_initialization(errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(index_cloud_liquid_water_content == 1) + ASSERT(index_dry_air == 2) + ASSERT(index_O2 == 3) + ASSERT(index_O3 == 4) + do i_species = 1, size(tuvx_species) call tuvx_species(i_species)%deallocate() end do @@ -328,6 +342,13 @@ subroutine test_configure_no_shared_gas_species() ASSERT(tmp_bool) end do + call check_tuvx_species_initialization(errmsg, errcode) + ASSERT(errcode == 0) + ASSERT(index_cloud_liquid_water_content == 1) + ASSERT(index_dry_air == 2) + ASSERT(index_O2 == 3) + ASSERT(index_O3 == 4) + do i_species = 1, size(tuvx_species) call tuvx_species(i_species)%deallocate() end do From 32ffdeb1f1288debe0ef4f1854f2004e8964355b Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Sun, 22 Dec 2024 18:44:48 -0700 Subject: [PATCH 11/18] update cam sima date commit --- test/docker/Dockerfile.musica | 2 +- test/docker/Dockerfile.musica.no_install | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/docker/Dockerfile.musica b/test/docker/Dockerfile.musica index f83ccdfb..f09f7d4e 100644 --- a/test/docker/Dockerfile.musica +++ b/test/docker/Dockerfile.musica @@ -6,7 +6,7 @@ FROM ubuntu:22.04 ARG MUSICA_GIT_TAG=326b5119768d5be9654baf96ae3bd6a1b757fdc8 -ARG CAM_SIMA_CHEMISTRY_DATA_TAG=abc7cacbec3d33d5c0ed5bb79a157e93b42c45c0 +ARG CAM_SIMA_CHEMISTRY_DATA_TAG=d3a93a77e08b7a2a1e0864fb18c2be7c61d1d32f ARG BUILD_TYPE=Debug RUN apt update \ diff --git a/test/docker/Dockerfile.musica.no_install b/test/docker/Dockerfile.musica.no_install index 5baec757..f461965c 100644 --- a/test/docker/Dockerfile.musica.no_install +++ b/test/docker/Dockerfile.musica.no_install @@ -9,7 +9,7 @@ FROM ubuntu:22.04 ARG MUSICA_GIT_TAG=326b5119768d5be9654baf96ae3bd6a1b757fdc8 -ARG CAM_SIMA_CHEMISTRY_DATA_TAG=abc7cacbec3d33d5c0ed5bb79a157e93b42c45c0 +ARG CAM_SIMA_CHEMISTRY_DATA_TAG=d3a93a77e08b7a2a1e0864fb18c2be7c61d1d32f ARG BUILD_TYPE=Debug RUN apt update \ From 7d9215446e55039ec083e480a3d5aa806a85b7d3 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Sun, 22 Dec 2024 18:53:57 -0700 Subject: [PATCH 12/18] clean up comments --- schemes/musica/micm/musica_ccpp_micm.F90 | 4 +--- schemes/musica/musica_ccpp.F90 | 1 - schemes/musica/musica_ccpp_species.F90 | 1 - 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 96e8629f..9c2079be 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -65,7 +65,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & do i = 1, number_of_species associate( map => micm%species_ordering ) species_name = map%name(i) - species_index = map%index(i) ! TODO(jiwon): is this index not in sequence? + species_index = map%index(i) molar_mass = micm%get_species_property_double(species_name, & "molecular weight [kg mol-1]", & @@ -95,8 +95,6 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & unit = 'kg kg-1', & molar_mass = molar_mass, & index_musica_species = species_index ) - - write(*,*) " [micm register] species_index: ", species_index ! jiwon end associate ! map end do number_of_rate_parameters = micm%user_defined_reaction_rates%size() diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 4f558db2..11e5b389 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -83,7 +83,6 @@ subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, & ! instead of when the solver is created. ! Re-create the MICM solver with the correct number of grid cells number_of_grid_cells = horizontal_dimension * vertical_layer_dimension - ! TODO(jiwon) - have to clean up before this gets called again call micm_register(micm_solver_type, number_of_grid_cells, constituent_props, & micm_species, errmsg, errcode) call micm_init(errmsg, errcode) diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index c8b55ce6..d48b3238 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -198,7 +198,6 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) ! Ask if this has been implemented ! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison - ! this code will be deleted when the framework does the check do i_elem = 1, size(micm_molar_mass_array) if (micm_molar_mass_array(i_elem) <= 0) then errcode = 1 From 08d24999830941ae82924f711856b1d184b9534f Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Sun, 22 Dec 2024 19:05:29 -0700 Subject: [PATCH 13/18] code clean up --- schemes/musica/musica_ccpp.F90 | 6 +++--- test/musica/tuvx/CMakeLists.txt | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/schemes/musica/musica_ccpp.F90 b/schemes/musica/musica_ccpp.F90 index 11e5b389..70d9791d 100644 --- a/schemes/musica/musica_ccpp.F90 +++ b/schemes/musica/musica_ccpp.F90 @@ -148,13 +148,13 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co ! local variables real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_micm_species) :: constituents_micm_species ! kg kg-1 + number_of_rate_parameters) :: rate_parameters ! various units real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 + number_of_micm_species) :: constituents_micm_species ! kg kg-1 real(kind_phys), dimension(size(constituents, dim=1), & size(constituents, dim=2), & - number_of_rate_parameters) :: rate_parameters ! various units + number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1 call extract_subset_constituents(tuvx_indices_constituent_props, constituents, & constituents_tuvx_species, errmsg, errcode) diff --git a/test/musica/tuvx/CMakeLists.txt b/test/musica/tuvx/CMakeLists.txt index c82ba2d4..82f99684 100644 --- a/test/musica/tuvx/CMakeLists.txt +++ b/test/musica/tuvx/CMakeLists.txt @@ -206,7 +206,7 @@ add_test( add_memory_check_test(test_tuvx_gas_species $ "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) -# Configure TUV-x species/constituents +# Configure TUV-x species add_executable(test_tuvx_load_species test_tuvx_load_species.F90) target_sources(test_tuvx_load_species From 67691d05a654c536235b0b1a2b150b8a9129d95b Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Mon, 23 Dec 2024 08:20:11 -0700 Subject: [PATCH 14/18] code cleanup --- schemes/musica/musica_ccpp_species.F90 | 30 +++++++++++-------- .../tuvx/musica_ccpp_tuvx_gas_species.F90 | 8 ++--- .../tuvx/musica_ccpp_tuvx_load_species.F90 | 27 +++++++++-------- test/musica/test_musica_species.F90 | 7 ++--- test/musica/tuvx/test_tuvx_load_species.F90 | 26 ++++++++-------- 5 files changed, 53 insertions(+), 45 deletions(-) diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index d48b3238..9e78f362 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -10,17 +10,17 @@ module musica_ccpp_species integer, parameter, public :: MUSICA_INT_UNASSIGNED = -99999 - !> Definition of the gas species type + !> Definition of musica species object type, public :: musica_species_t character(len=:), allocatable :: name character(len=:), allocatable :: unit - real(kind_phys) :: molar_mass = 0.0_kind_phys ! kg mol-1 + real(kind_phys) :: molar_mass = 0.0_kind_phys ! kg mol-1 integer :: index_musica_species = MUSICA_INT_UNASSIGNED integer :: index_constituent_props = MUSICA_INT_UNASSIGNED - logical :: profiled = .false. ! optional - real(kind_phys) :: scale_height = 0.0_kind_phys ! km, optional + logical :: profiled = .false. ! TUV-x gas species optional + real(kind_phys) :: scale_height = 0.0_kind_phys ! km, TUV-x gas species optional contains - ! Deallocates the member objects + ! Deallocates memory associated with this musica species object procedure :: deallocate => musica_species_t_deallocate end type musica_species_t @@ -39,7 +39,7 @@ module musica_ccpp_species contains - !> Constructor for musica_species_t object + !> Constructor for musica species object function species_t_constructor(name, unit, molar_mass, scale_height, & index_musica_species, index_constituent_props) result( this ) character(len=*), intent(in) :: name @@ -96,6 +96,7 @@ subroutine cleanup_musica_species() end subroutine cleanup_musica_species + !> Allocates memory and initializes the species array for MICM and TUV-x subroutine register_musica_species(micm_species, tuvx_species) type(musica_species_t), intent(in) :: micm_species(:) type(musica_species_t), intent(in) :: tuvx_species(:) @@ -110,7 +111,7 @@ subroutine register_musica_species(micm_species, tuvx_species) end subroutine register_musica_species - !> Retrieve the species indices from the constituents array and store them + !> Retrieves the species indices from the constituents array and store them subroutine find_musica_species_indices(constituent_props, musica_species_set, & indices_constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t @@ -141,7 +142,7 @@ subroutine find_musica_species_indices(constituent_props, musica_species_set, & end subroutine find_musica_species_indices - !> Initialize arrays to store the species indices of the CCPP constituents + !> Initializes arrays to store the species indices of the CCPP constituents subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t @@ -168,7 +169,7 @@ subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) end subroutine initialize_musica_species_indices - !> Iterate through the constituent property array to populate the molar mass array, + !> Iterates through the constituent property pointer array to populate the molar mass array, ! storing molar mass values in a sequence that matches the order of the MICM state array subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t @@ -196,7 +197,6 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) end if end do - ! Ask if this has been implemented ! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison do i_elem = 1, size(micm_molar_mass_array) if (micm_molar_mass_array(i_elem) <= 0) then @@ -209,7 +209,7 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) end subroutine initialize_molar_mass_array - !> Extract sub-constituents array using the indices from constituents array + !> Extracts sub-constituents array using the indices from constituents array subroutine extract_subset_constituents(indices_constituent_props, constituents, & subset_constituents, errmsg, errcode) integer, intent(in) :: indices_constituent_props(:) @@ -237,6 +237,8 @@ subroutine extract_subset_constituents(indices_constituent_props, constituents, end subroutine extract_subset_constituents + !> The updated subset of constituents is added back to the constituents array + ! using the indices array to specify where the updates should occur subroutine update_constituents(indices_constituent_props, subset_constituents, & constituents, errmsg, errcode) integer, intent(in) :: indices_constituent_props(:) @@ -262,9 +264,13 @@ subroutine update_constituents(indices_constituent_props, subset_constituents, & constituents(:,:,indices_constituent_props(i)) = subset_constituents(:,:,i) end do - end subroutine update_constituents + !> Checks that the musica species-related objects are initialized, + ! including the MICM species set, TUV-x species set, their constituent property indices, + ! and the molar mass values for the MICM species. + ! This function is specifically designed to ensure that the musica species are properly + ! initialized, so they don't need to be checked during the run phase. subroutine check_initialization(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 index 83ae0e2a..af6c9c8a 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 @@ -14,7 +14,7 @@ module musica_ccpp_tuvx_gas_species contains - !> Creates a TUV-x dry air profile + !> Creates TUV-x dry air profile function create_dry_air_profile(height_grid, errmsg, errcode) & result(profile) use musica_ccpp_util, only: has_error_occurred @@ -39,7 +39,7 @@ function create_dry_air_profile(height_grid, errmsg, errcode) & end function create_dry_air_profile - !> Creates a TUV-x O2 profile + !> Creates TUV-x O2 profile function create_O2_profile(height_grid, errmsg, errcode) & result(profile) use musica_ccpp_util, only: has_error_occurred @@ -64,7 +64,7 @@ function create_O2_profile(height_grid, errmsg, errcode) & end function create_O2_profile - !> Creates a TUV-x O3 profile + !> Creates TUV-x O3 profile function create_O3_profile(height_grid, errmsg, errcode) & result(profile) use musica_ccpp_util, only: has_error_occurred @@ -89,7 +89,7 @@ function create_O3_profile(height_grid, errmsg, errcode) & end function create_O3_profile - !> Sets the species concentrations in the vertical layer + !> Sets the species constituents in the vertical layer subroutine set_gas_species_values(profile, dry_air_density, constituents, & height_deltas, index_species, errmsg, errcode) use musica_ccpp_util, only: has_error_occurred diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index fe7a4b39..79f25b53 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -1,5 +1,5 @@ module musica_ccpp_tuvx_load_species - use ccpp_kinds, only: kind_phys + use ccpp_kinds, only: kind_phys use musica_ccpp_species, only: MUSICA_INT_UNASSIGNED implicit none @@ -35,10 +35,9 @@ module musica_ccpp_tuvx_load_species contains - ! Add constituent props and then create micm_species - ! This is another reason in favor of moving all mechanism parsing of open atmos; - ! you could choose to do this and it would be valid. For micm, we always want - ! a full mechanism becauase that's what we need + !> Configures the TUV-x species and their constituent properties. + ! If the MICM configuration includes any TUV-x gas species, constituent properties + ! are not created; otherwise, new constituent properties are generated for each species. subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, & errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t @@ -80,10 +79,8 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, errmsg = errmsg ) if (errcode /= 0) return - ! Add gas species - dry air, O2, O3 - to be profiled - ! iterate through all the registered species to - ! check if the species is already registered and if so - ! update scale_height + ! Iterates through the MICM species to check if any TUV-x gas + ! species are included; if present, updates the scale height and profiled status. do i_species = 1, num_micm_species if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit @@ -166,7 +163,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, index_dry_air = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & name = DRY_AIR_LABEL, & - unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, different from molar mass unit molar_mass = MOLAR_MASS_DRY_AIR, & ! kg mol-1 index_musica_species = i_tuvx_species, & profiled = .true., & @@ -176,7 +173,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, index_O2 = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & name = O2_LABEL, & - unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, different from molar mass unit molar_mass = MOLAR_MASS_O2, & ! kg mol-1 index_musica_species = i_tuvx_species, & profiled = .true., & @@ -186,7 +183,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, index_O3 = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & name = O3_LABEL, & - unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, which can be different from molar mass unit + unit = TUVX_GAS_SPECIES_UNITS, & ! TUV-x profile unit, different from molar mass unit molar_mass = MOLAR_MASS_O3, & ! kg mol-1 index_musica_species = i_tuvx_species, & profiled = .true., & @@ -194,6 +191,10 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, end subroutine configure_tuvx_species + !> Ensures that the indices of all TUV-x species are initialized. + ! This function is typically called during the initialization phase, + ! so that the indices can be used during the run phase without the need + ! for additional checks. subroutine check_tuvx_species_initialization(errmsg, errcode) character(len=512), intent(out) :: errmsg integer, intent(out) :: errcode @@ -212,4 +213,4 @@ subroutine check_tuvx_species_initialization(errmsg, errcode) end subroutine check_tuvx_species_initialization -end module musica_ccpp_tuvx_load_species +end module musica_ccpp_tuvx_load_species \ No newline at end of file diff --git a/test/musica/test_musica_species.F90 b/test/musica/test_musica_species.F90 index 3287c2e2..4fccfc0a 100644 --- a/test/musica/test_musica_species.F90 +++ b/test/musica/test_musica_species.F90 @@ -17,8 +17,8 @@ subroutine test_register_musica_species() use ccpp_kinds, only: kind_phys use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t - use musica_ccpp_tuvx_load_species, & - only: configure_tuvx_species, check_tuvx_species_initialization + use musica_ccpp_tuvx_load_species, only: configure_tuvx_species, & + check_tuvx_species_initialization integer, parameter :: NUM_MICM_SPECIES = 6 integer, parameter :: NUM_TUVX_CONSTITUENTS = 4 @@ -160,8 +160,7 @@ subroutine test_extract_and_update_subset_constituents() character(len=512) :: errmsg integer :: errcode integer :: i, j, k - - ! Initialize the arrays (example values) + constituents = reshape([1.0, 2.0, 3.0, 4.0, 5.0, & 6.0, 7.0, 8.0, 9.0, 10.0, & 11.0, 12.0, 13.0, 14.0, 15.0, & diff --git a/test/musica/tuvx/test_tuvx_load_species.F90 b/test/musica/tuvx/test_tuvx_load_species.F90 index a091f26d..9663575b 100644 --- a/test/musica/tuvx/test_tuvx_load_species.F90 +++ b/test/musica/tuvx/test_tuvx_load_species.F90 @@ -16,7 +16,8 @@ program test_tuvx_load_species subroutine test_configure_shared_gas_species_tuvx_micm() ! There are three gas species required for TUV-x: dry air, O2, and O3. ! This test focuses on configuring MUSICA species and constituent properties - ! when the MICM species include all of these. Cloud liquid water content is the only component specific to TUVX. + ! when the MICM species include all of these. Cloud liquid water content + ! is the only component specific to TUVX. use ccpp_kinds, only: kind_phys use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t, MUSICA_INT_UNASSIGNED @@ -73,16 +74,18 @@ subroutine test_configure_shared_gas_species_tuvx_micm() ASSERT(errcode == 0) ASSERT(allocated(tuvx_constituent_props)) ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) - ASSERT(tuvx_constituent_props(1)%is_instantiated(errcode, errmsg)) - call tuvx_constituent_props(1)%standard_name(species_name, errcode, errmsg) - ASSERT(errcode == 0) - call tuvx_constituent_props(1)%molar_mass(molar_mass, errcode, errmsg) - ASSERT(errcode == 0) - call tuvx_constituent_props(1)%is_advected(is_advected, errcode, errmsg) - ASSERT(errcode == 0) - tmp_bool = (trim(species_name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & - molar_mass == 0.018_kind_phys .and. is_advected) - ASSERT(tmp_bool) + do i_species = 1, size(tuvx_constituent_props) + ASSERT(tuvx_constituent_props(i_species)%is_instantiated(errcode, errmsg)) + call tuvx_constituent_props(i_species)%standard_name(species_name, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%molar_mass(molar_mass, errcode, errmsg) + ASSERT(errcode == 0) + call tuvx_constituent_props(i_species)%is_advected(is_advected, errcode, errmsg) + ASSERT(errcode == 0) + tmp_bool = (trim(species_name) == 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' .and. & + molar_mass == 0.018_kind_phys .and. is_advected) + ASSERT(tmp_bool) + end do ASSERT(allocated(tuvx_species)) ASSERT(size(tuvx_species) == NUM_TUVX_CONSTITUENTS) @@ -184,7 +187,6 @@ subroutine test_configure_partial_shared_gas_species() errmsg, errcode) ASSERT(errcode == 0) ASSERT(allocated(tuvx_constituent_props)) - write(*,*) "size(tuvx_constituent_props): ", size(tuvx_constituent_props) ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) do i_species = 1, size(tuvx_constituent_props) ASSERT(tuvx_constituent_props(i_species)%is_instantiated(errcode, errmsg)) From bf5b86cbcf5488b64f7388f188fad9d0918062bc Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Mon, 23 Dec 2024 14:03:47 -0700 Subject: [PATCH 15/18] add profile test --- schemes/musica/micm/musica_ccpp_micm.F90 | 1 - test/docker/Dockerfile.musica | 2 +- test/docker/Dockerfile.musica.no_install | 2 +- test/musica/tuvx/test_tuvx_gas_species.F90 | 182 +++++++++++++++++---- 4 files changed, 156 insertions(+), 31 deletions(-) diff --git a/schemes/musica/micm/musica_ccpp_micm.F90 b/schemes/musica/micm/musica_ccpp_micm.F90 index 9c2079be..d51b51cc 100644 --- a/schemes/musica/micm/musica_ccpp_micm.F90 +++ b/schemes/musica/micm/musica_ccpp_micm.F90 @@ -22,7 +22,6 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, & micm_species, errmsg, errcode) use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t use musica_ccpp_species, only: musica_species_t - use musica_micm, only: Rosenbrock, RosenbrockStandardOrder use musica_util, only: error_t use iso_c_binding, only: c_int diff --git a/test/docker/Dockerfile.musica b/test/docker/Dockerfile.musica index f09f7d4e..2c3f8967 100644 --- a/test/docker/Dockerfile.musica +++ b/test/docker/Dockerfile.musica @@ -6,7 +6,7 @@ FROM ubuntu:22.04 ARG MUSICA_GIT_TAG=326b5119768d5be9654baf96ae3bd6a1b757fdc8 -ARG CAM_SIMA_CHEMISTRY_DATA_TAG=d3a93a77e08b7a2a1e0864fb18c2be7c61d1d32f +ARG CAM_SIMA_CHEMISTRY_DATA_TAG=ea3539f1d7b71162e8a78d900ecbe265ba870e3d ARG BUILD_TYPE=Debug RUN apt update \ diff --git a/test/docker/Dockerfile.musica.no_install b/test/docker/Dockerfile.musica.no_install index f461965c..8500a8a3 100644 --- a/test/docker/Dockerfile.musica.no_install +++ b/test/docker/Dockerfile.musica.no_install @@ -9,7 +9,7 @@ FROM ubuntu:22.04 ARG MUSICA_GIT_TAG=326b5119768d5be9654baf96ae3bd6a1b757fdc8 -ARG CAM_SIMA_CHEMISTRY_DATA_TAG=d3a93a77e08b7a2a1e0864fb18c2be7c61d1d32f +ARG CAM_SIMA_CHEMISTRY_DATA_TAG=ea3539f1d7b71162e8a78d900ecbe265ba870e3d ARG BUILD_TYPE=Debug RUN apt update \ diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 index 89b60f30..8b9be703 100644 --- a/test/musica/tuvx/test_tuvx_gas_species.F90 +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -131,39 +131,93 @@ subroutine get_wavelength_edges(edges) end subroutine get_wavelength_edges + subroutine calculate_gas_species_interfaces_and_densities( & + molar_mass, dry_air_density, constituents, height_deltas, & + is_O3, interfaces, densities) + use ccpp_kinds, only: kind_phys + + real(kind_phys), intent(in) :: molar_mass + real(kind_phys), intent(in) :: dry_air_density(:) + real(kind_phys), intent(in) :: constituents(:) + real(kind_phys), intent(in) :: height_deltas(:) + logical, intent(in) :: is_O3 + real(kind_phys), intent(inout) :: interfaces(size(constituents) + 2) + real(kind_phys), intent(inout) :: densities(size(constituents) + 1) + + ! local variables + real(kind_phys) :: constituent_mol_per_cm_3(size(constituents)) ! mol cm-3 + integer :: num_vertical_levels + + constituent_mol_per_cm_3(:) = constituents(:) * dry_air_density(:) / molar_mass / m_3_to_cm_3 + + num_vertical_levels = size(constituents) + interfaces(1) = constituent_mol_per_cm_3(num_vertical_levels) + interfaces(2:num_vertical_levels+1) = constituent_mol_per_cm_3(num_vertical_levels:1:-1) + interfaces(num_vertical_levels+2) = constituent_mol_per_cm_3(1) + + if ( is_O3 ) then + densities(:) = height_deltas(:) * km_to_cm & + * ( interfaces(1:num_vertical_levels+1) & + + interfaces(2:num_vertical_levels+2) ) * 0.5_kind_phys + else + densities(:) = height_deltas(:) * km_to_cm & + * sqrt(interfaces(1:num_vertical_levels+1)) & + * sqrt(interfaces(2:num_vertical_levels+2)) + end if + + end subroutine calculate_gas_species_interfaces_and_densities + subroutine test_create_gas_species_profile() 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_tuvx, only: grid_t, profile_t + use musica_util, only: error_t use musica_ccpp, only: musica_ccpp_register, musica_ccpp_final use musica_ccpp_tuvx_height_grid, only: create_height_grid use musica_ccpp_namelist, only: filename_of_micm_configuration, & filename_of_tuvx_configuration, & filename_of_tuvx_micm_mapping_configuration - use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3 + use musica_ccpp_tuvx_load_species, only: index_dry_air, index_O2, index_O3, & + SCALE_HEIGHT_DRY_AIR, SCALE_HEIGHT_O2, SCALE_HEIGHT_O3, & + MOLAR_MASS_DRY_AIR, MOLAR_MASS_O2, MOLAR_MASS_O3 use musica_ccpp_species, only: tuvx_species_set, MUSICA_INT_UNASSIGNED - integer, parameter :: NUM_COLUMNS = 2 - integer, parameter :: NUM_LAYERS = 2 - integer, parameter :: NUM_TUVX_SPECIES = 4 - type(ccpp_constituent_properties_t), allocatable, & - target :: constituent_props(:) - type(grid_t), pointer :: height_grid => null() - type(profile_t), pointer :: dry_air_profile => null() - type(profile_t), pointer :: O2_profile => null() - type(profile_t), pointer :: O3_profile => null() - real(kind_phys) :: dry_air_density(NUM_COLUMNS,NUM_LAYERS) ! kg m-3 - real(kind_phys) :: constituents(NUM_COLUMNS,NUM_LAYERS, NUM_TUVX_SPECIES) - real(kind_phys) :: height_deltas(NUM_LAYERS) ! km - integer :: errcode - character(len=512) :: errmsg - character(len=50) :: name, unit - real(kind_phys) :: molar_mass ! kg mol-1 - real(kind_phys) :: scale_height ! km - integer :: index_musica - logical :: tmp_bool - integer :: i_elem, i_col, i, j, k + integer, parameter :: NUM_COLUMNS = 2 + integer, parameter :: NUM_LAYERS = 2 + integer, parameter :: NUM_TUVX_SPECIES = 4 + real, parameter :: ABS_ERROR = 10.0 + real, parameter :: m_to_cm = 100.0_kind_phys + type(ccpp_constituent_properties_t), & + allocatable, target :: constituent_props(:) + type(grid_t), pointer :: height_grid => null() + type(profile_t), pointer :: dry_air_profile => null() + type(profile_t), pointer :: O2_profile => null() + type(profile_t), pointer :: O3_profile => null() + real(kind_phys) :: dry_air_density(NUM_COLUMNS,NUM_LAYERS) ! kg m-3 + real(kind_phys) :: constituents(NUM_COLUMNS,NUM_LAYERS,NUM_TUVX_SPECIES) + real(kind_phys) :: height_deltas(NUM_LAYERS+1) ! km + integer :: errcode + character(len=512) :: errmsg + type(error_t) :: error + character(len=50) :: name, unit + real(kind_phys) :: molar_mass ! kg mol-1 + real(kind_phys) :: scale_height ! km + integer :: index_musica + logical :: tmp_bool + integer :: i_elem, i_col, i, j, k + real(kind_phys) :: dry_air_interfaces(NUM_LAYERS+2), expected_dry_air_interfaces(NUM_COLUMNS,NUM_LAYERS+2) + real(kind_phys) :: O2_interfaces(NUM_LAYERS+2), expected_O2_interfaces(NUM_COLUMNS,NUM_LAYERS+2) + real(kind_phys) :: O3_interfaces(NUM_LAYERS+2), expected_O3_interfaces(NUM_COLUMNS,NUM_LAYERS+2) + real(kind_phys) :: dry_air_densities(NUM_LAYERS+1), expected_dry_air_densities(NUM_COLUMNS,NUM_LAYERS+1) + real(kind_phys) :: O2_densities(NUM_LAYERS+1), expected_O2_densities(NUM_COLUMNS,NUM_LAYERS+1) + real(kind_phys) :: O3_densities(NUM_LAYERS+1), expected_O3_densities(NUM_COLUMNS,NUM_LAYERS+1) + real(kind_phys) :: dry_air_exo_layer_density + real(kind_phys) :: expected_dry_air_exo_layer_density = SCALE_HEIGHT_DRY_AIR + real(kind_phys) :: O2_exo_layer_density + real(kind_phys) :: expected_O2_exo_layer_density = SCALE_HEIGHT_O2 + real(kind_phys) :: O3_exo_layer_density + real(kind_phys) :: expected_O3_exo_layer_density = SCALE_HEIGHT_O3 filename_of_micm_configuration = 'musica_configurations/chapman/micm/config.json' filename_of_tuvx_configuration = 'musica_configurations/chapman/tuvx/config.json' @@ -171,12 +225,12 @@ subroutine test_create_gas_species_profile() dry_air_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) dry_air_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) - height_deltas(:) = (/ 0.5_kind_phys, 1.5_kind_phys /) + height_deltas(:) = (/ 0.5_kind_phys, 1.5_kind_phys, 1.0_kind_phys /) ! Initialize the constituents array with real values between 0 and 1 - do k = 1, 4 - do j = 1, 2 - do i = 1, 2 + do k = 1, NUM_TUVX_SPECIES + do j = 1, NUM_LAYERS + do i = 1, NUM_COLUMNS constituents(i, j, k) = (i + j + k) * 0.1_kind_phys end do end do @@ -188,6 +242,24 @@ subroutine test_create_gas_species_profile() stop 3 endif + do i_col = 1, NUM_COLUMNS + call calculate_gas_species_interfaces_and_densities( & + MOLAR_MASS_DRY_AIR, dry_air_density(i_col,:), constituents(i_col,:,index_dry_air), & + height_deltas, .false., expected_dry_air_interfaces(i_col,:), expected_dry_air_densities(i_col,:) ) + + call calculate_gas_species_interfaces_and_densities( & + MOLAR_MASS_O2, dry_air_density(i_col,:), constituents(i_col,:,index_O2), & + height_deltas, .false., expected_O2_interfaces(i_col,:), expected_O2_densities(i_col,:) ) + + call calculate_gas_species_interfaces_and_densities( & + MOLAR_MASS_O3, dry_air_density(i_col,:), constituents(i_col,:,index_O3), & + height_deltas, .true., expected_O3_interfaces(i_col,:), expected_O3_densities(i_col,:) ) + write(*,*) " $$$$$$$$$ " + write(*,*) "[F] interfaces: ", expected_dry_air_interfaces(i_col,:) + write(*,*) "[F] densities: ", expected_dry_air_densities(i_col,:) + write(*,*) " $$$$$$$$$ " + end do + height_grid => create_height_grid( NUM_LAYERS, NUM_LAYERS + 1 , errmsg, errcode ) ASSERT(errcode == 0) ASSERT(associated(height_grid)) @@ -207,18 +279,72 @@ subroutine test_create_gas_species_profile() do i_col = 1, NUM_COLUMNS call set_gas_species_values( dry_air_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_dry_air), height_deltas, index_dry_air, & - errmsg, errcode) + errmsg, errcode ) ASSERT(errcode == 0) call set_gas_species_values( O2_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_O2), height_deltas, index_O2, & - errmsg, errcode) + errmsg, errcode ) ASSERT(errcode == 0) call set_gas_species_values( O3_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_O3), height_deltas, index_O3, & - errmsg, errcode) + errmsg, errcode ) ASSERT(errcode == 0) + + ! Retrieve the values set by the profile + ! Dry air + call dry_air_profile%get_edge_values( dry_air_interfaces, error ) + ASSERT(error%is_success()) + do i = 1, size(dry_air_interfaces) + ASSERT(dry_air_interfaces(i) == expected_dry_air_interfaces(i_col, i)) + end do + call dry_air_profile%get_layer_densities( dry_air_densities, error ) + ASSERT(error%is_success()) + do i = 1, size(dry_air_densities) - 1 + ASSERT(dry_air_densities(i) == expected_dry_air_densities(i_col, i)) + end do + ! the calculate_exo_layer_density call uses the scale height and the density of the uppermost + ! layer to estimate the density above the column top, which affects the uppermost top value + ASSERT_NEAR(dry_air_densities(size(dry_air_densities)), expected_dry_air_densities(i_col, size(dry_air_densities)) * SCALE_HEIGHT_DRY_AIR * m_to_cm, ABS_ERROR) + dry_air_exo_layer_density = dry_air_profile%get_exo_layer_density( error ) + ASSERT(error%is_success()) + expected_dry_air_exo_layer_density = expected_dry_air_densities(i_col, size(dry_air_densities)) * SCALE_HEIGHT_DRY_AIR * m_to_cm + ASSERT_NEAR(dry_air_exo_layer_density, expected_dry_air_exo_layer_density, ABS_ERROR) + + ! O2 + call O2_profile%get_edge_values( O2_interfaces, error ) + ASSERT(error%is_success()) + do i = 1, size(O2_interfaces) + ASSERT(O2_interfaces(i) == expected_O2_interfaces(i_col, i)) + end do + call O2_profile%get_layer_densities( O2_densities, error ) + ASSERT(error%is_success()) + do i = 1, size(O2_densities) - 1 + ASSERT(O2_densities(i) == expected_O2_densities(i_col, i)) + end do + ASSERT_NEAR(O2_densities(size(O2_densities)), expected_O2_densities(i_col, size(O2_densities)) * SCALE_HEIGHT_O2 * m_to_cm, ABS_ERROR) + O2_exo_layer_density = O2_profile%get_exo_layer_density( error ) + ASSERT(error%is_success()) + expected_O2_exo_layer_density = expected_O2_densities(i_col, size(O2_densities)) * SCALE_HEIGHT_O2 * m_to_cm + ASSERT_NEAR(O2_exo_layer_density, expected_O2_exo_layer_density, ABS_ERROR) + + ! O3 + call O3_profile%get_edge_values( O3_interfaces, error ) + ASSERT(error%is_success()) + do i = 1, size(O3_interfaces) + ASSERT(O3_interfaces(i) == expected_O3_interfaces(i_col, i)) + end do + call O3_profile%get_layer_densities( O3_densities, error ) + ASSERT(error%is_success()) + do i = 1, size(O3_densities) - 1 + ASSERT(O3_densities(i) == expected_O3_densities(i_col, i)) + end do + ASSERT_NEAR(O3_densities(size(O3_densities)), expected_O3_densities(i_col, size(O3_densities)) * SCALE_HEIGHT_O3 * m_to_cm, ABS_ERROR) + O3_exo_layer_density = O3_profile%get_exo_layer_density( error ) + ASSERT(error%is_success()) + expected_O3_exo_layer_density = expected_O3_densities(i_col, size(O3_densities)) * SCALE_HEIGHT_O3 * m_to_cm + ASSERT_NEAR(O3_exo_layer_density, expected_O3_exo_layer_density, ABS_ERROR) end do ! The gas species index starts at 2 because index 1 is reserved for cloud liquid From f1e36526bd73b1340882c75cbec135ce7e209ac8 Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Mon, 23 Dec 2024 14:32:00 -0700 Subject: [PATCH 16/18] formatting --- schemes/musica/musica_ccpp_species.F90 | 14 +++++----- schemes/musica/tuvx/musica_ccpp_tuvx.F90 | 6 ++--- .../tuvx/musica_ccpp_tuvx_load_species.F90 | 4 +-- test/musica/test_musica_species.F90 | 26 +++++++++---------- test/musica/tuvx/test_tuvx_gas_species.F90 | 15 ++++++----- test/musica/tuvx/test_tuvx_load_species.F90 | 18 ++++++------- 6 files changed, 43 insertions(+), 40 deletions(-) diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index 9e78f362..deee769e 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -73,6 +73,8 @@ subroutine musica_species_t_deallocate(this) end subroutine musica_species_t_deallocate + !> Deallocates the memory associated with the MUSICA species object, its indices array, + ! and its molar mass array subroutine cleanup_musica_species() integer :: i @@ -127,8 +129,8 @@ subroutine find_musica_species_indices(constituent_props, musica_species_set, & integer :: i_elem, index_species do i_elem = 1, size(musica_species_set) - call ccpp_const_get_idx(constituent_props, musica_species_set(i_elem)%name, & - musica_species_set(i_elem)%index_constituent_props, errmsg, errcode) + call ccpp_const_get_idx( constituent_props, musica_species_set(i_elem)%name, & + musica_species_set(i_elem)%index_constituent_props, errmsg, errcode ) if (errcode /= 0) return index_species = musica_species_set(i_elem)%index_constituent_props @@ -158,13 +160,13 @@ subroutine initialize_musica_species_indices(constituent_props, errmsg, errcode) end if allocate( micm_indices_constituent_props( size(micm_species_set) ) ) - call find_musica_species_indices(constituent_props, micm_species_set, & - micm_indices_constituent_props, errmsg, errcode) + call find_musica_species_indices( constituent_props, micm_species_set, & + micm_indices_constituent_props, errmsg, errcode ) if (errcode /= 0) return allocate( tuvx_indices_constituent_props( size(tuvx_species_set) ) ) - call find_musica_species_indices(constituent_props, tuvx_species_set, & - tuvx_indices_constituent_props, errmsg, errcode) + call find_musica_species_indices( constituent_props, tuvx_species_set, & + tuvx_indices_constituent_props, errmsg, errcode ) if (errcode /= 0) return end subroutine initialize_musica_species_indices diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 index c80979b5..2966b57e 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx.F90 @@ -566,17 +566,17 @@ subroutine tuvx_run(temperature, dry_air_density, & call set_gas_species_values( dry_air_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_dry_air), height_deltas, index_dry_air, & - errmsg, errcode) + errmsg, errcode ) if (errcode /= 0) return call set_gas_species_values( O2_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_O2), height_deltas, index_O2, & - errmsg, errcode) + errmsg, errcode ) if (errcode /= 0) return call set_gas_species_values( O3_profile, dry_air_density(i_col,:), & constituents(i_col,:,index_O3), height_deltas, index_O3, & - errmsg, errcode) + errmsg, errcode ) if (errcode /= 0) return ! calculate photolysis rate constants and heating rates diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index 79f25b53..d623aa90 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -79,7 +79,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, errmsg = errmsg ) if (errcode /= 0) return - ! Iterates through the MICM species to check if any TUV-x gas + ! Iterate through the MICM species to check if any TUV-x gas ! species are included; if present, updates the scale height and profiled status. do i_species = 1, num_micm_species if (is_dry_air_registered .and. is_O2_registered .and. is_O3_registered) exit @@ -150,7 +150,7 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, allocate( constituent_props(i_new) ) constituent_props(:) = temp_constituent_props(1:i_new) - allocate(tuvx_species(num_new_species)) + allocate( tuvx_species(num_new_species) ) i_tuvx_species = 1 index_cloud_liquid_water_content = i_tuvx_species tuvx_species(i_tuvx_species) = musica_species_t( & diff --git a/test/musica/test_musica_species.F90 b/test/musica/test_musica_species.F90 index 4fccfc0a..579031de 100644 --- a/test/musica/test_musica_species.F90 +++ b/test/musica/test_musica_species.F90 @@ -60,17 +60,17 @@ subroutine test_register_musica_species() index_musica_species = i_species ) end do - call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & - errmsg, errcode) + call configure_tuvx_species( micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode ) ASSERT(errcode == 0) - call register_musica_species(micm_species, tuvx_species) + call register_musica_species( micm_species, tuvx_species ) ASSERT(allocated(micm_species_set)) ASSERT(allocated(tuvx_species_set)) ASSERT(number_of_micm_species == NUM_MICM_SPECIES) ASSERT(number_of_tuvx_species == NUM_TUVX_CONSTITUENTS) - call check_tuvx_species_initialization(errmsg, errcode) + call check_tuvx_species_initialization( errmsg, errcode ) ASSERT(errcode == 0) do i_species = 1, size(micm_species) @@ -104,7 +104,7 @@ subroutine test_initialize_musica_species_indices_and_molar_mass() 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(constituent_props, errmsg, errcode) + call musica_ccpp_register( constituent_props, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -114,15 +114,15 @@ subroutine test_initialize_musica_species_indices_and_molar_mass() allocate(constituent_props_ptr(size(constituent_props))) do i = 1, size(constituent_props) const_prop => constituent_props(i) - call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) + call constituent_props_ptr(i)%set( const_prop, errcode, errmsg ) end do - call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode) + call initialize_musica_species_indices( constituent_props_ptr, errmsg, errcode ) ASSERT(errcode == 0) ASSERT(allocated(micm_indices_constituent_props)) ASSERT(allocated(tuvx_indices_constituent_props)) - call initialize_molar_mass_array(constituent_props_ptr, errmsg, errcode) + call initialize_molar_mass_array( constituent_props_ptr, errmsg, errcode ) ASSERT(errcode == 0) ASSERT(allocated(micm_molar_mass_array)) @@ -137,7 +137,7 @@ subroutine test_initialize_musica_species_indices_and_molar_mass() ASSERT(tuvx_species_set(i)%index_constituent_props == tuvx_indices_constituent_props(i)) end do - call check_initialization(errmsg, errcode) + call check_initialization( errmsg, errcode ) ASSERT(errcode == 0) call cleanup_musica_species() @@ -180,8 +180,8 @@ subroutine test_extract_and_update_subset_constituents() end do end do - call extract_subset_constituents(indices_array, constituents, & - subset_constituents, errmsg, errcode) + call extract_subset_constituents( indices_array, constituents, & + subset_constituents, errmsg, errcode ) ASSERT(errcode == 0) do k = 1, NUM_SUBSET_SPECIES do j = 1, NUM_LAYERS @@ -201,8 +201,8 @@ subroutine test_extract_and_update_subset_constituents() end do end do - call update_constituents(indices_array, subset_constituents, & - constituents, errmsg, errcode) + call update_constituents( indices_array, subset_constituents, & + constituents, errmsg, errcode ) ASSERT(errcode == 0) do k = 1, NUM_SPECIES do j = 1, NUM_LAYERS diff --git a/test/musica/tuvx/test_tuvx_gas_species.F90 b/test/musica/tuvx/test_tuvx_gas_species.F90 index 8b9be703..c226f6c8 100644 --- a/test/musica/tuvx/test_tuvx_gas_species.F90 +++ b/test/musica/tuvx/test_tuvx_gas_species.F90 @@ -131,6 +131,7 @@ subroutine get_wavelength_edges(edges) end subroutine get_wavelength_edges + ! Calculates the expected values for comparison with the answer subroutine calculate_gas_species_interfaces_and_densities( & molar_mass, dry_air_density, constituents, height_deltas, & is_O3, interfaces, densities) @@ -316,7 +317,7 @@ subroutine test_create_gas_species_profile() call O2_profile%get_edge_values( O2_interfaces, error ) ASSERT(error%is_success()) do i = 1, size(O2_interfaces) - ASSERT(O2_interfaces(i) == expected_O2_interfaces(i_col, i)) + ASSERT(O2_interfaces(i) == expected_O2_interfaces(i_col, i)) end do call O2_profile%get_layer_densities( O2_densities, error ) ASSERT(error%is_success()) @@ -333,7 +334,7 @@ subroutine test_create_gas_species_profile() call O3_profile%get_edge_values( O3_interfaces, error ) ASSERT(error%is_success()) do i = 1, size(O3_interfaces) - ASSERT(O3_interfaces(i) == expected_O3_interfaces(i_col, i)) + ASSERT(O3_interfaces(i) == expected_O3_interfaces(i_col, i)) end do call O3_profile%get_layer_densities( O3_densities, error ) ASSERT(error%is_success()) @@ -415,7 +416,7 @@ subroutine test_initialize_tuvx_species() dry_air_density(:,1) = (/ 3.5_kind_phys, 4.5_kind_phys /) dry_air_density(:,2) = (/ 5.5_kind_phys, 6.5_kind_phys /) - call get_wavelength_edges(photolysis_wavelength_grid_interfaces) + call get_wavelength_edges( photolysis_wavelength_grid_interfaces ) do k = 1, 4 do j = 1, 2 do i = 1, 2 @@ -424,7 +425,7 @@ subroutine test_initialize_tuvx_species() end do end do - call musica_ccpp_register(constituent_props, errmsg, errcode) + call musica_ccpp_register( constituent_props, errmsg, errcode ) if (errcode /= 0) then write(*,*) trim(errmsg) stop 3 @@ -433,11 +434,11 @@ subroutine test_initialize_tuvx_species() allocate(constituent_props_ptr(size(constituent_props))) do i = 1, size(constituent_props) const_prop => constituent_props(i) - call constituent_props_ptr(i)%set(const_prop, errcode, errmsg) + call constituent_props_ptr(i)%set( const_prop, errcode, errmsg ) end do - call musica_ccpp_init(NUM_COLUMNS, NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, & - constituent_props_ptr, errmsg, errcode) + 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) stop 3 diff --git a/test/musica/tuvx/test_tuvx_load_species.F90 b/test/musica/tuvx/test_tuvx_load_species.F90 index 9663575b..5d34f1e5 100644 --- a/test/musica/tuvx/test_tuvx_load_species.F90 +++ b/test/musica/tuvx/test_tuvx_load_species.F90 @@ -69,8 +69,8 @@ subroutine test_configure_shared_gas_species_tuvx_micm() index_musica_species = i_species ) end do - call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & - errmsg, errcode) + call configure_tuvx_species( micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode ) ASSERT(errcode == 0) ASSERT(allocated(tuvx_constituent_props)) ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) @@ -113,7 +113,7 @@ subroutine test_configure_shared_gas_species_tuvx_micm() ASSERT(tmp_bool) end do - call check_tuvx_species_initialization(errmsg, errcode) + call check_tuvx_species_initialization( errmsg, errcode ) ASSERT(errcode == 0) ASSERT(index_cloud_liquid_water_content == 1) ASSERT(index_dry_air == 2) @@ -183,8 +183,8 @@ subroutine test_configure_partial_shared_gas_species() index_musica_species = i_species ) end do - call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & - errmsg, errcode) + call configure_tuvx_species( micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode ) ASSERT(errcode == 0) ASSERT(allocated(tuvx_constituent_props)) ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) @@ -228,7 +228,7 @@ subroutine test_configure_partial_shared_gas_species() ASSERT(tmp_bool) end do - call check_tuvx_species_initialization(errmsg, errcode) + call check_tuvx_species_initialization( errmsg, errcode ) ASSERT(errcode == 0) ASSERT(index_cloud_liquid_water_content == 1) ASSERT(index_dry_air == 2) @@ -297,8 +297,8 @@ subroutine test_configure_no_shared_gas_species() index_musica_species = i_species ) end do - call configure_tuvx_species(micm_species, tuvx_species, tuvx_constituent_props, & - errmsg, errcode) + call configure_tuvx_species( micm_species, tuvx_species, tuvx_constituent_props, & + errmsg, errcode ) ASSERT(errcode == 0) ASSERT(allocated(tuvx_constituent_props)) ASSERT(size(tuvx_constituent_props) == NUM_TUVX_CONSTITUENTS - NUM_SHARED_SPECIES_BETWEEN_MICM_TUVX) @@ -344,7 +344,7 @@ subroutine test_configure_no_shared_gas_species() ASSERT(tmp_bool) end do - call check_tuvx_species_initialization(errmsg, errcode) + call check_tuvx_species_initialization( errmsg, errcode ) ASSERT(errcode == 0) ASSERT(index_cloud_liquid_water_content == 1) ASSERT(index_dry_air == 2) From 983d6acf8e685a3f8a001979ebbd4a55c7e9bedc Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 8 Jan 2025 13:10:04 -0700 Subject: [PATCH 17/18] address code review --- schemes/musica/musica_ccpp_species.F90 | 3 ++- schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 | 10 ++++------ schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 | 2 +- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/schemes/musica/musica_ccpp_species.F90 b/schemes/musica/musica_ccpp_species.F90 index deee769e..3f746a2f 100644 --- a/schemes/musica/musica_ccpp_species.F90 +++ b/schemes/musica/musica_ccpp_species.F90 @@ -199,7 +199,8 @@ subroutine initialize_molar_mass_array(constituent_props, errmsg, errcode) end if end do - ! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison + ! TODO(jiwon) - This code block can be removed once the CCPP framework handles + ! the check for non-zero molar mass do i_elem = 1, size(micm_molar_mass_array) if (micm_molar_mass_array(i_elem) <= 0) then errcode = 1 diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 index af6c9c8a..74b73b17 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 @@ -123,13 +123,11 @@ subroutine set_gas_species_values(profile, dry_air_density, constituents, & interfaces(num_vertical_levels+2) = constituent_mol_per_cm_3(1) if (tuvx_species_set(index_species)%name == O3_LABEL) then - densities(:) = height_deltas(:) * km_to_cm & - * ( interfaces(1:num_vertical_levels+1) & - + interfaces(2:num_vertical_levels+2) ) * 0.5_kind_phys + densities(:) = height_deltas(:) * km_to_cm * 0.5_kind_phys & + * ( interfaces(1:num_vertical_levels+1) + interfaces(2:num_vertical_levels+2) ) else - densities(:) = height_deltas(:) * km_to_cm & - * sqrt(interfaces(1:num_vertical_levels+1)) & - * sqrt(interfaces(2:num_vertical_levels+2)) + densities(:) = height_deltas(:) * km_to_cm & + * sqrt(interfaces(1:num_vertical_levels+1)) * sqrt(interfaces(2:num_vertical_levels+2)) end if call profile%set_edge_values( interfaces, error ) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index d623aa90..a95c5bc3 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -13,7 +13,7 @@ module musica_ccpp_tuvx_load_species integer, protected, public :: index_O3 = MUSICA_INT_UNASSIGNED ! Constants - ! Clould liquid water + ! Cloud liquid water character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_LABEL = & 'cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water' character(len=*), parameter, public :: CLOUD_LIQUID_WATER_CONTENT_LONG_NAME = & From f034bae21291e5cfcb5245d0ca46c17ca6234b9c Mon Sep 17 00:00:00 2001 From: Jiwon Gim Date: Wed, 8 Jan 2025 14:12:42 -0700 Subject: [PATCH 18/18] add comments --- schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 index a95c5bc3..916e5e97 100644 --- a/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 +++ b/schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 @@ -53,6 +53,9 @@ subroutine configure_tuvx_species(micm_species, tuvx_species, constituent_props, ! local variables integer :: num_new_species = 4 integer :: num_micm_species + ! temp_constituents_props is used to store TUVx-specific constituents and gas species + ! that are not registered by MICM. Its fixed array size represents the maximum number + ! of possible constituents. type(ccpp_constituent_properties_t) :: temp_constituent_props(4) logical :: is_dry_air_registered = .false. logical :: is_O2_registered = .false.