@@ -14,16 +14,20 @@ module musica_ccpp
14
14
15
15
! > \section arg_table_musica_ccpp_register Argument Table
16
16
! ! \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
21
22
22
23
type (ccpp_constituent_properties_t), allocatable , intent (out ) :: constituent_props(:)
23
24
character (len= 512 ), intent (out ) :: errmsg
24
25
integer , intent (out ) :: errcode
25
26
27
+ ! local variables
26
28
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(:)
27
31
integer :: number_of_grid_cells
28
32
29
33
! 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, &
32
36
! the solver when the number of grid cells is known at the init stage.
33
37
number_of_grid_cells = 1
34
38
call micm_register(micm_solver_type, number_of_grid_cells, constituent_props_subset, &
35
- errmsg, errcode)
39
+ micm_species, errmsg, errcode)
36
40
if (errcode /= 0 ) return
37
41
constituent_props = constituent_props_subset
38
42
deallocate (constituent_props_subset)
39
43
40
- call tuvx_register(constituent_props_subset, errmsg, errcode)
44
+ call tuvx_register(micm_species, tuvx_species, constituent_props_subset, &
45
+ errmsg, errcode)
41
46
if (errcode /= 0 ) return
42
47
constituent_props = [ constituent_props, constituent_props_subset ]
43
48
49
+ call register_musica_species(micm_species, tuvx_species)
50
+ call check_tuvx_species_initialization(errmsg, errcode)
51
+ if (errcode /= 0 ) return
52
+
44
53
end subroutine musica_ccpp_register
45
54
46
55
! > \section arg_table_musica_ccpp_init Argument Table
47
56
! ! \htmlinclude musica_ccpp_init.html
48
57
subroutine musica_ccpp_init (horizontal_dimension , vertical_layer_dimension , &
49
58
vertical_interface_dimension , &
50
59
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
+
57
69
integer , intent (in ) :: horizontal_dimension ! (count)
58
70
integer , intent (in ) :: vertical_layer_dimension ! (count)
59
71
integer , intent (in ) :: vertical_interface_dimension ! (count)
60
72
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 (:)
62
74
character (len= 512 ), intent (out ) :: errmsg
63
75
integer , intent (out ) :: errcode
64
76
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
67
81
68
82
! Temporary fix until the number of grid cells is only needed to create a MICM state
69
83
! instead of when the solver is created.
70
84
! Re-create the MICM solver with the correct number of grid cells
71
85
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)
73
88
call micm_init(errmsg, errcode)
74
89
if (errcode /= 0 ) return
75
90
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)
79
100
if (errcode /= 0 ) return
80
101
81
102
end subroutine musica_ccpp_init
@@ -98,6 +119,9 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co
98
119
use ccpp_kinds, only: kind_phys
99
120
use musica_ccpp_micm, only: number_of_rate_parameters
100
121
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
101
125
102
126
real (kind_phys), intent (in ) :: time_step ! s
103
127
real (kind_phys), target , intent (in ) :: temperature(:,:) ! K
@@ -122,69 +146,71 @@ subroutine musica_ccpp_run(time_step, temperature, pressure, dry_air_density, co
122
146
integer , intent (out ) :: errcode
123
147
124
148
! local variables
125
- real (kind_phys), dimension (size (constituents, dim= 3 )) :: molar_mass_arr ! kg mol-1
126
149
real (kind_phys), dimension (size (constituents, dim= 1 ), &
127
150
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
130
162
131
163
! 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, &
146
178
errmsg, errcode)
147
179
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
166
186
167
187
! 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 )
169
189
170
190
! Solve chemistry at the current time step
171
191
call micm_run(time_step, temperature, pressure, dry_air_density, rate_parameters, &
172
- constituents , errmsg, errcode)
192
+ constituents_micm_species , errmsg, errcode)
173
193
174
194
! 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 )
176
196
197
+ call update_constituents(micm_indices_constituent_props, constituents_micm_species, &
198
+ constituents, errmsg, errcode)
199
+ if (errcode /= 0 ) return
200
+
177
201
end subroutine musica_ccpp_run
178
202
179
203
! > \section arg_table_musica_ccpp_final Argument Table
180
204
! ! \htmlinclude musica_ccpp_final.html
181
205
subroutine musica_ccpp_final (errmsg , errcode )
206
+ use musica_ccpp_species, only: cleanup_musica_species
182
207
character (len= 512 ), intent (out ) :: errmsg
183
208
integer , intent (out ) :: errcode
184
209
210
+ call cleanup_musica_species()
185
211
call tuvx_final(errmsg, errcode)
186
212
call micm_final(errmsg, errcode)
187
213
188
214
end subroutine musica_ccpp_final
189
215
190
- end module musica_ccpp
216
+ end module musica_ccpp
0 commit comments