Skip to content

Commit e8a29b3

Browse files
authored
Set gas-species profiles in TUV-x and map indices between constituents and MICM (#184)
Originator(s): @boulderdaze Summary (include the keyword ['closes', 'fixes', 'resolves'] and issue number): - Closes #98 - Closes #165 Describe any changes made to the namelist: N/A List all files eliminated and why: N/A List all files added and what they do: ``` A schemes/musica/musica_ccpp_species.F90 A schemes/musica/tuvx/musica_ccpp_tuvx_gas_species.F90 A schemes/musica/tuvx/musica_ccpp_tuvx_load_species.F90 A test/musica/test_musica_species.F90 A test/musica/tuvx/test_tuvx_gas_species.F90 A test/musica/tuvx/test_tuvx_load_species.F90 ``` List all existing files that have been modified, and describe the changes: ``` M schemes/musica/micm/musica_ccpp_micm.F90 M schemes/musica/musica_ccpp.F90 M schemes/musica/musica_ccpp.meta M schemes/musica/tuvx/musica_ccpp_tuvx.F90 M schemes/musica/tuvx/musica_ccpp_tuvx_height_grid.F90 M test/docker/Dockerfile.musica M test/docker/Dockerfile.musica.no_install M test/musica/CMakeLists.txt M test/musica/test_musica_api.F90 M test/musica/tuvx/CMakeLists.txt M test/musica/tuvx/test_tuvx_height_grid.F90 M to_be_ccppized/ccpp_tuvx_utils.F90 ``` List any test failures: N/A Is this a science-changing update? New physics package, algorithm change, tuning changes, etc? No
1 parent d4bd202 commit e8a29b3

18 files changed

+2187
-186
lines changed

schemes/musica/micm/musica_ccpp_micm.F90

+20-4
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,16 @@ module musica_ccpp_micm
1919

2020
!> Registers MICM constituent properties with the CCPP
2121
subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, &
22-
errmsg, errcode)
22+
micm_species, errmsg, errcode)
2323
use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t
24-
use musica_micm, only: Rosenbrock, RosenbrockStandardOrder
24+
use musica_ccpp_species, only: musica_species_t
2525
use musica_util, only: error_t
2626
use iso_c_binding, only: c_int
2727

2828
integer(c_int), intent(in) :: solver_type
2929
integer(c_int), intent(in) :: number_of_grid_cells
3030
type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:)
31+
type(musica_species_t), allocatable, intent(out) :: micm_species(:)
3132
character(len=512), intent(out) :: errmsg
3233
integer, intent(out) :: errcode
3334

@@ -36,6 +37,7 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, &
3637
real(kind=kind_phys) :: molar_mass
3738
character(len=:), allocatable :: species_name
3839
logical :: is_advected
40+
integer :: number_of_species
3941
integer :: i, species_index
4042

4143
if (associated( micm )) then
@@ -46,13 +48,20 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, &
4648
number_of_grid_cells, error)
4749
if (has_error_occurred(error, errmsg, errcode)) return
4850

49-
allocate(constituent_props(micm%species_ordering%size()), stat=errcode)
51+
number_of_species = micm%species_ordering%size()
52+
allocate(constituent_props(number_of_species), stat=errcode)
5053
if (errcode /= 0) then
5154
errmsg = "[MUSICA Error] Failed to allocate memory for constituent properties."
5255
return
5356
end if
5457

55-
do i = 1, micm%species_ordering%size()
58+
allocate(micm_species(number_of_species), stat=errcode)
59+
if (errcode /= 0) then
60+
errmsg = "[MUSICA Error] Failed to allocate memory for micm species."
61+
return
62+
end if
63+
64+
do i = 1, number_of_species
5665
associate( map => micm%species_ordering )
5766
species_name = map%name(i)
5867
species_index = map%index(i)
@@ -78,6 +87,13 @@ subroutine micm_register(solver_type, number_of_grid_cells, constituent_props, &
7887
errcode = errcode, &
7988
errmsg = errmsg)
8089
if (errcode /= 0) return
90+
91+
! Species are ordered to match the sequence of the MICM state array
92+
micm_species(species_index) = musica_species_t( &
93+
name = species_name, &
94+
unit = 'kg kg-1', &
95+
molar_mass = molar_mass, &
96+
index_musica_species = species_index )
8197
end associate ! map
8298
end do
8399
number_of_rate_parameters = micm%user_defined_reaction_rates%size()

schemes/musica/musica_ccpp.F90

+84-58
Original file line numberDiff line numberDiff line change
@@ -14,16 +14,20 @@ module musica_ccpp
1414

1515
!> \section arg_table_musica_ccpp_register Argument Table
1616
!! \htmlinclude musica_ccpp_register.html
17-
subroutine musica_ccpp_register(constituent_props, errmsg, &
18-
errcode)
19-
use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t
20-
use musica_ccpp_namelist, only: micm_solver_type
17+
subroutine musica_ccpp_register(constituent_props, errmsg, errcode)
18+
use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t
19+
use musica_ccpp_namelist, only: micm_solver_type
20+
use musica_ccpp_species, only: musica_species_t, register_musica_species
21+
use musica_ccpp_tuvx_load_species, only: check_tuvx_species_initialization
2122

2223
type(ccpp_constituent_properties_t), allocatable, intent(out) :: constituent_props(:)
2324
character(len=512), intent(out) :: errmsg
2425
integer, intent(out) :: errcode
2526

27+
! local variables
2628
type(ccpp_constituent_properties_t), allocatable :: constituent_props_subset(:)
29+
type(musica_species_t), allocatable :: micm_species(:)
30+
type(musica_species_t), allocatable :: tuvx_species(:)
2731
integer :: number_of_grid_cells
2832

2933
! Temporary fix until the number of grid cells is only needed to create a MICM state
@@ -32,50 +36,67 @@ subroutine musica_ccpp_register(constituent_props, errmsg, &
3236
! the solver when the number of grid cells is known at the init stage.
3337
number_of_grid_cells = 1
3438
call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, &
35-
errmsg, errcode)
39+
micm_species, errmsg, errcode)
3640
if (errcode /= 0) return
3741
constituent_props = constituent_props_subset
3842
deallocate(constituent_props_subset)
3943

40-
call tuvx_register(constituent_props_subset, errmsg, errcode)
44+
call tuvx_register(micm_species, tuvx_species, constituent_props_subset, &
45+
errmsg, errcode)
4146
if (errcode /= 0) return
4247
constituent_props = [ constituent_props, constituent_props_subset ]
4348

49+
call register_musica_species(micm_species, tuvx_species)
50+
call check_tuvx_species_initialization(errmsg, errcode)
51+
if (errcode /= 0) return
52+
4453
end subroutine musica_ccpp_register
4554

4655
!> \section arg_table_musica_ccpp_init Argument Table
4756
!! \htmlinclude musica_ccpp_init.html
4857
subroutine musica_ccpp_init(horizontal_dimension, vertical_layer_dimension, &
4958
vertical_interface_dimension, &
5059
photolysis_wavelength_grid_interfaces, &
51-
constituent_props, errmsg, errcode)
52-
use ccpp_constituent_prop_mod, only: ccpp_constituent_properties_t, ccpp_constituent_prop_ptr_t
53-
use ccpp_kinds, only : kind_phys
54-
use musica_ccpp_micm, only: micm
55-
use musica_ccpp_namelist, only: micm_solver_type
56-
use musica_ccpp_util, only: has_error_occurred
60+
constituent_props_ptr, errmsg, errcode)
61+
use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t, ccpp_constituent_properties_t
62+
use ccpp_kinds, only: kind_phys
63+
use musica_ccpp_micm, only: micm
64+
use musica_ccpp_namelist, only: micm_solver_type
65+
use musica_ccpp_util, only: has_error_occurred
66+
use musica_ccpp_species, only: initialize_musica_species_indices, initialize_molar_mass_array, &
67+
check_initialization, musica_species_t
68+
5769
integer, intent(in) :: horizontal_dimension ! (count)
5870
integer, intent(in) :: vertical_layer_dimension ! (count)
5971
integer, intent(in) :: vertical_interface_dimension ! (count)
6072
real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m
61-
type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props(:)
73+
type(ccpp_constituent_prop_ptr_t), intent(in) :: constituent_props_ptr(:)
6274
character(len=512), intent(out) :: errmsg
6375
integer, intent(out) :: errcode
6476

65-
integer :: number_of_grid_cells
66-
type(ccpp_constituent_properties_t), allocatable :: micm_species_props(:)
77+
! local variables
78+
type(ccpp_constituent_properties_t), allocatable :: constituent_props(:)
79+
type(musica_species_t), allocatable :: micm_species(:)
80+
integer :: number_of_grid_cells
6781

6882
! Temporary fix until the number of grid cells is only needed to create a MICM state
6983
! instead of when the solver is created.
7084
! Re-create the MICM solver with the correct number of grid cells
7185
number_of_grid_cells = horizontal_dimension * vertical_layer_dimension
72-
call micm_register(micm_solver_type, number_of_grid_cells, micm_species_props, errmsg, errcode)
86+
call micm_register(micm_solver_type, number_of_grid_cells, constituent_props, &
87+
micm_species, errmsg, errcode)
7388
call micm_init(errmsg, errcode)
7489
if (errcode /= 0) return
7590
call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
76-
photolysis_wavelength_grid_interfaces, &
77-
micm%user_defined_reaction_rates, &
78-
constituent_props, errmsg, errcode)
91+
photolysis_wavelength_grid_interfaces, &
92+
micm%user_defined_reaction_rates, errmsg, errcode)
93+
if (errcode /= 0) return
94+
95+
call initialize_musica_species_indices(constituent_props_ptr, errmsg, errcode)
96+
if (errcode /= 0) return
97+
call initialize_molar_mass_array(constituent_props_ptr, errmsg, errcode)
98+
if (errcode /= 0) return
99+
call check_initialization(errmsg, errcode)
79100
if (errcode /= 0) return
80101

81102
end subroutine musica_ccpp_init
@@ -98,6 +119,9 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co
98119
use ccpp_kinds, only: kind_phys
99120
use musica_ccpp_micm, only: number_of_rate_parameters
100121
use musica_ccpp_micm_util, only: convert_to_mol_per_cubic_meter, convert_to_mass_mixing_ratio
122+
use musica_ccpp_species, only: number_of_micm_species, number_of_tuvx_species, &
123+
micm_indices_constituent_props, tuvx_indices_constituent_props, micm_molar_mass_array, &
124+
extract_subset_constituents, update_constituents
101125

102126
real(kind_phys), intent(in) :: time_step ! s
103127
real(kind_phys), target, intent(in) :: temperature(:,:) ! K
@@ -122,69 +146,71 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co
122146
integer, intent(out) :: errcode
123147

124148
! local variables
125-
real(kind_phys), dimension(size(constituents, dim=3)) :: molar_mass_arr ! kg mol-1
126149
real(kind_phys), dimension(size(constituents, dim=1), &
127150
size(constituents, dim=2), &
128-
number_of_rate_parameters) :: rate_parameters ! various units
129-
integer :: i_elem
151+
number_of_rate_parameters) :: rate_parameters ! various units
152+
real(kind_phys), dimension(size(constituents, dim=1), &
153+
size(constituents, dim=2), &
154+
number_of_micm_species) :: constituents_micm_species ! kg kg-1
155+
real(kind_phys), dimension(size(constituents, dim=1), &
156+
size(constituents, dim=2), &
157+
number_of_tuvx_species) :: constituents_tuvx_species ! kg kg-1
158+
159+
call extract_subset_constituents(tuvx_indices_constituent_props, constituents, &
160+
constituents_tuvx_species, errmsg, errcode)
161+
if (errcode /= 0) return
130162

131163
! Calculate photolysis rate constants using TUV-x
132-
call tuvx_run(temperature, dry_air_density, &
133-
constituents, &
134-
geopotential_height_wrt_surface_at_midpoint, &
135-
geopotential_height_wrt_surface_at_interface, &
136-
surface_geopotential, surface_temperature, &
137-
surface_albedo, &
138-
photolysis_wavelength_grid_interfaces, &
139-
extraterrestrial_flux, &
140-
standard_gravitational_acceleration, &
141-
cloud_area_fraction, &
142-
air_pressure_thickness, &
143-
solar_zenith_angle, &
144-
earth_sun_distance, &
145-
rate_parameters, &
164+
call tuvx_run(temperature, dry_air_density, &
165+
constituents_tuvx_species, &
166+
geopotential_height_wrt_surface_at_midpoint, &
167+
geopotential_height_wrt_surface_at_interface, &
168+
surface_geopotential, surface_temperature, &
169+
surface_albedo, &
170+
photolysis_wavelength_grid_interfaces, &
171+
extraterrestrial_flux, &
172+
standard_gravitational_acceleration, &
173+
cloud_area_fraction, &
174+
air_pressure_thickness, &
175+
solar_zenith_angle, &
176+
earth_sun_distance, &
177+
rate_parameters, &
146178
errmsg, errcode)
147179

148-
! Get the molar mass that is set in the call to instantiate()
149-
do i_elem = 1, size(molar_mass_arr)
150-
call constituent_props(i_elem)%molar_mass(molar_mass_arr(i_elem), errcode, errmsg)
151-
if (errcode /= 0) then
152-
errmsg = "[MUSICA Error] Unable to get molar mass."
153-
return
154-
end if
155-
end do
156-
157-
! TODO(jiwon) Check molar mass is non zero as it becomes a denominator for unit converison
158-
! this code will be deleted when the framework does the check
159-
do i_elem = 1, size(molar_mass_arr)
160-
if (molar_mass_arr(i_elem) <= 0) then
161-
errcode = 1
162-
errmsg = "[MUSICA Error] Molar mass must be greater than zero."
163-
return
164-
end if
165-
end do
180+
call update_constituents(tuvx_indices_constituent_props, constituents_tuvx_species, &
181+
constituents, errmsg, errcode)
182+
if (errcode /= 0) return
183+
call extract_subset_constituents(micm_indices_constituent_props, constituents, &
184+
constituents_micm_species, errmsg, errcode)
185+
if (errcode /= 0) return
166186

167187
! Convert CAM-SIMA unit to MICM unit (kg kg-1 -> mol m-3)
168-
call convert_to_mol_per_cubic_meter(dry_air_density, molar_mass_arr, constituents)
188+
call convert_to_mol_per_cubic_meter(dry_air_density, micm_molar_mass_array, constituents_micm_species)
169189

170190
! Solve chemistry at the current time step
171191
call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, &
172-
constituents, errmsg, errcode)
192+
constituents_micm_species, errmsg, errcode)
173193

174194
! Convert MICM unit back to CAM-SIMA unit (mol m-3 -> kg kg-1)
175-
call convert_to_mass_mixing_ratio(dry_air_density, molar_mass_arr, constituents)
195+
call convert_to_mass_mixing_ratio(dry_air_density, micm_molar_mass_array, constituents_micm_species)
176196

197+
call update_constituents(micm_indices_constituent_props, constituents_micm_species, &
198+
constituents, errmsg, errcode)
199+
if (errcode /= 0) return
200+
177201
end subroutine musica_ccpp_run
178202

179203
!> \section arg_table_musica_ccpp_final Argument Table
180204
!! \htmlinclude musica_ccpp_final.html
181205
subroutine musica_ccpp_final(errmsg, errcode)
206+
use musica_ccpp_species, only: cleanup_musica_species
182207
character(len=512), intent(out) :: errmsg
183208
integer, intent(out) :: errcode
184209

210+
call cleanup_musica_species()
185211
call tuvx_final(errmsg, errcode)
186212
call micm_final(errmsg, errcode)
187213

188214
end subroutine musica_ccpp_final
189215

190-
end module musica_ccpp
216+
end module musica_ccpp

schemes/musica/musica_ccpp.meta

+1-1
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@
5353
type = real | kind = kind_phys
5454
dimensions = (photolysis_wavelength_grid_interface_dimension)
5555
intent = in
56-
[ constituent_props ]
56+
[ constituent_props_ptr ]
5757
standard_name = ccpp_constituent_properties
5858
units = None
5959
type = ccpp_constituent_prop_ptr_t

0 commit comments

Comments
 (0)