CAMP 1.0.0
Chemistry Across Multiple Phases
rxn_SIMPOL_phase_transfer.F90
Go to the documentation of this file.
1! Copyright (C) 2021 Barcelona Supercomputing Center and University of
2! Illinois at Urbana-Champaign
3! SPDX-License-Identifier: MIT
4
5!> \file
6!> The camp_rxn_SIMPOL_phase_transfer module.
7
8!> \page camp_rxn_SIMPOL_phase_transfer CAMP: SIMPOL.1 Phase-Transfer Reaction
9!!
10!! SIMPOL phase transfer reactions are based on the SIMPOL.1 model
11!! calculations of vapor pressure described by Pankow and Asher (2008)
12!! \cite Pankow2008.
13!!
14!! Mass accomodation coefficients and condensation rate constants are
15!! calculated using the method of Ervans et al. (2003) \cite Ervens2003 and
16!! references therein. Mass accomodation coefficients (\f$\alpha\f$) are
17!! calculated as:
18!!
19!! \f[
20!! \Delta H_{obs} = -10 \times (N^*-1) + 7.53 \times (N^{*2/3}-1) - 0.1 \times 10 \quad (\mbox{kcal}\,\mbox{M}^{-1})
21!! \f]
22!! \f[
23!! \Delta S_{obs} = -13 \times (N^*-1) - 19 \times (N^*-1) + 9.21 \times (N^{*2/3}-1) - 0.1 \times 13 \quad (\mbox{cal}\,\mbox{M}^{-1}\,\mbox{K}^{-1})
24!! \f]
25!! \f[
26!! \frac{\alpha}{1-\alpha} = e^{\frac{-\Delta G^{*}}{RT}}
27!! \f]
28!! If \f$\Delta H\f$ and \f$\Delta S\f$ are not provided, the mass accomodation
29!! coefficient is assumed to be 0.1 (\cite Zaveri2008).
30!!
31!! Condensation rate constants are calculated following \cite Zaveri2008 as:
32!! \f[
33!! k_c = 4 \pi r D_g f_{fs}( K_n, \alpha )
34!! \f]
35!! where \f$r\f$ is the radius of the particle(s) [m], \f$D_g\f$ is the
36!! diffusion coefficient of the gas-phase species [\f$\mbox{m}^2\,\mbox{s}^{-1}\f$],
37!! \f$f_{fs}( K_n, \alpha )\f$ is the Fuchs Sutugin transition regime correction
38!! factor [unitless], \f$K_n\f$ is the Knudsen Number [unitess], and \f$\alpha\f$
39!! is the mass accomodation coefficient.
40!!
41!! Rates can be calculated as:
42!! \f[
43!! r_c = [G] N_a k_c
44!! \f]
45!! where \f$[G]\f$ is the gas-phase species concentration [ppm], \f$N_a\f$ is
46!! the number concentration of particles [\f$\mbox{particle}\,\mbox{m}^{-3}\f$] and
47!! the rate \f$r_c\f$ is in [\f$\mbox{ppm}\,\mbox{s}^{-1}\f$].
48!! The particle radius used
49!! to calculate \f$k_{f}\f$ is the effective radius [\f$r_{eff}\f$], which is
50!! taken as the "least-wrong" choice for condensation rates, as it is weighted
51!! to surface area \cite Zender2002 .
52!!
53!! Input data for SIMPOL phase transfer reactions have the following format :
54!! \code{.json}
55!! {
56!! "type" : "SIMPOL_PHASE_TRANSFER",
57!! "gas-phase species" : "my gas spec",
58!! "aerosol phase" : "my aero phase",
59!! "aerosol-phase species" : "my aero spec",
60!! "aerosol-phase activity coefficient" : "my aero act coeff"
61!! "B" : [ 123.2e3, -41.24, 2951.2, -1.245e-4 ]
62!! ...
63!! }
64!! \endcode
65!! The key-value pairs \b gas-phase \b species, \b aerosol \b phase and
66!! \b aerosol-phase \b species are required. Only one gas- and one
67!! aerosol-phase species are allowed per phase-transfer reaction. The
68!! key-value pair \b aerosol-phase \b activity \b coefficient is optional.
69!! When it is included its value must be the name of an species of type
70!! \c ACTIVITY_COEFF that is present in the specified aerosol phase. When
71!! it is not included, activity coefficients are assume to be 1.0.
72!!
73!! Gas-phase species must include parameters named
74!! \b diffusion \b coeff \b [\b m2 \b s-1], which specifies the diffusion
75!! coefficient in \f$\mbox{m}^2\,\mbox{s}^{-1}\f$, and \b molecular
76!! \b weight \b [\b kg \b mol-1], which specifies the molecular weight of the
77!! species in \f$\mbox{kg}\,\mbox{mol}^{-1}\f$. They may optionally
78!! include the parameter \b N \b star, which will be used to calculate th
79!! mass accomodation coefficient. When this parameter is not included, the
80!! mass accomodation coefficient is assumed to be 1.0.
81!!
82!! The key-value pair \b B is also required and must have a value of an array
83!! of exactly four members that specifies the SIMPOL parameters for the
84!! partitioning species. The \b B parameters can be obtained by summing the
85!! contributions of each functional group present in the partitioning species
86!! to the overall \f$B_{n,i}\f$ for species \f$i\f$, such that:
87!! \f[
88!! B_{n,i} = \sum_{k} \nu_{k,i} B_{n,k} \forall n \in [1...4]
89!! \f]
90!! where \f$\nu_{k,i}\f$ is the number of functional groups \f$k\f$ in species
91!! \f$i\f$ and the parameters \f$B_{n,k}\f$ for each functional group \f$k\f$
92!! can be found in table 5 of Pankow and Asher (2008) \cite Pankow2008.
93
94!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
95
96!> The rxn_SIMPOL_phase_transfer_t type and associated functions.
98
102 use camp_constants, only: const
104 use camp_property
105 use camp_rxn_data
106 use camp_util, only: i_kind, dp, to_string, &
109
110 implicit none
111 private
112
113#define DELTA_H_ this%condensed_data_real(1)
114#define DELTA_S_ this%condensed_data_real(2)
115#define DIFF_COEFF_ this%condensed_data_real(3)
116#define PRE_C_AVG_ this%condensed_data_real(4)
117#define B1_ this%condensed_data_real(5)
118#define B2_ this%condensed_data_real(6)
119#define B3_ this%condensed_data_real(7)
120#define B4_ this%condensed_data_real(8)
121#define CONV_ this%condensed_data_real(9)
122#define MW_ this%condensed_data_real(10)
123#define NUM_AERO_PHASE_ this%condensed_data_int(1)
124#define GAS_SPEC_ this%condensed_data_int(2)
125#define NUM_INT_PROP_ 2
126#define NUM_REAL_PROP_ 10
127#define NUM_ENV_PARAM_ 4
128#define AERO_SPEC_(x) this%condensed_data_int(NUM_INT_PROP_+x)
129#define AERO_ACT_ID_(x) this%condensed_data_int(NUM_INT_PROP_+NUM_AERO_PHASE_+x)
130#define AERO_PHASE_ID_(x) this%condensed_data_int(NUM_INT_PROP_+2*NUM_AERO_PHASE_+x)
131#define AERO_REP_ID_(x) this%condensed_data_int(NUM_INT_PROP_+3*NUM_AERO_PHASE_+x)
132#define DERIV_ID_(x) this%condensed_data_int(NUM_INT_PROP_+4*NUM_AERO_PHASE_+x)
133#define GAS_ACT_JAC_ID_(x) this%condensed_data_int(NUM_INT_PROP_+1+5*NUM_AERO_PHASE_+x)
134#define AERO_ACT_JAC_ID_(x) this%condensed_data_int(NUM_INT_PROP_+1+6*NUM_AERO_PHASE_+x)
135#define JAC_ID_(x) this%condensed_data_int(NUM_INT_PROP_+1+7*NUM_AERO_PHASE_+x)
136#define PHASE_INT_LOC_(x) this%condensed_data_int(NUM_INT_PROP_+2+10*NUM_AERO_PHASE_+x)
137#define PHASE_REAL_LOC_(x) this%condensed_data_int(NUM_INT_PROP_+2+11*NUM_AERO_PHASE_+x)
138#define NUM_AERO_PHASE_JAC_ELEM_(x) this%condensed_data_int(PHASE_INT_LOC_(x))
139#define PHASE_JAC_ID_(x,s,e) this%condensed_data_int(PHASE_INT_LOC_(x)+(s-1)*NUM_AERO_PHASE_JAC_ELEM_(x)+e)
140#define EFF_RAD_JAC_ELEM_(x,e) this%condensed_data_real(PHASE_REAL_LOC_(x)-1+e)
141#define NUM_CONC_JAC_ELEM_(x,e) this%condensed_data_real(PHASE_REAL_LOC_(x)-1+NUM_AERO_PHASE_JAC_ELEM_(x)+e)
142#define MASS_JAC_ELEM_(x,e) this%condensed_data_real(PHASE_REAL_LOC_(x)-1+2*NUM_AERO_PHASE_JAC_ELEM_(x)+e)
143#define MW_JAC_ELEM_(x,e) this%condensed_data_real(PHASE_REAL_LOC_(x)-1+3*NUM_AERO_PHASE_JAC_ELEM_(x)+e)
144
146
147 !> Generic test reaction data type
149 contains
150 !> Reaction initialization
151 procedure :: initialize
152 !> Finalize the reaction
155
156 !> Constructor for rxn_SIMPOL_phase_transfer_t
158 procedure :: constructor
159 end interface rxn_simpol_phase_transfer_t
160
161contains
162
163!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
164
165 !> Constructor for Phase transfer reaction
166 function constructor() result(new_obj)
167
168 !> A new reaction instance
169 type(rxn_simpol_phase_transfer_t), pointer :: new_obj
170
171 allocate(new_obj)
172 new_obj%rxn_phase = aero_rxn
173
174 end function constructor
175
176!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
177
178 !> Initialize the reaction data, validating component data and loading
179 !! any required information into the condensed data arrays for use during
180 !! solving
181 subroutine initialize(this, chem_spec_data, aero_phase, aero_rep, n_cells)
182
183 !> Reaction data
184 class(rxn_simpol_phase_transfer_t), intent(inout) :: this
185 !> Chemical species data
186 type(chem_spec_data_t), intent(in) :: chem_spec_data
187 !> Aerosol phase data
188 type(aero_phase_data_ptr), intent(in) :: aero_phase(:)
189 !> Aerosol representations
190 type(aero_rep_data_ptr), pointer, intent(in) :: aero_rep(:)
191 !> Number of grid cells to solve simultaneously
192 integer(kind=i_kind), intent(in) :: n_cells
193
194 type(property_t), pointer :: spec_props, b_params
195 character(len=:), allocatable :: key_name, gas_spec_name, aero_spec_name
196 character(len=:), allocatable :: phase_name, act_name, error_msg
197 integer(kind=i_kind) :: i_spec, i_aero_rep, n_aero_ids, i_aero_id
198 integer(kind=i_kind) :: i_phase, n_aero_jac_elem, tmp_size
199 type(string_t), allocatable :: unique_spec_names(:), unique_act_names(:)
200 integer(kind=i_kind), allocatable :: phase_ids(:)
201 real(kind=dp) :: temp_real, n_star
202 logical :: has_act_coeff
203
204 ! Get the property set
205 if (.not. associated(this%property_set)) call die_msg(382913491, &
206 "Missing property set needed to initialize reaction")
207
208 ! Get the gas-phase species name
209 key_name = "gas-phase species"
210 call assert_msg(740333884, &
211 this%property_set%get_string(key_name, gas_spec_name), &
212 "Missing gas-phase species in SIMPOL.1 phase transfer reaction")
213
214 ! Get the aerosol phase name
215 key_name = "aerosol phase"
216 call assert_msg(325074932, &
217 this%property_set%get_string(key_name, phase_name), &
218 "Missing aerosol phase in SIMPOL.1 phase-transfer reaction")
219
220 ! Get the aerosol-phase species name
221 key_name = "aerosol-phase species"
222 call assert_msg(988456388, &
223 this%property_set%get_string(key_name, aero_spec_name), &
224 "Missing aerosol-phase species in SIMPOL.1 phase-transfer "// &
225 "reaction")
226
227 ! Set up a general error message
228 error_msg = " for SIMPOL.1 phase transfer of gas species '"// &
229 gas_spec_name//"' to aerosol-phase species '"// &
230 aero_spec_name//"' in phase '"//phase_name//"'"
231
232 ! Get the aerosol-phase activity coeffcient name
233 key_name = "aerosol-phase activity coefficient"
234 has_act_coeff = this%property_set%get_string(key_name, act_name)
235
236 ! Check for aerosol representations
237 call assert_msg(260518827, associated(aero_rep), &
238 "Missing aerosol representation"//error_msg)
239 call assert_msg(590304021, size(aero_rep).gt.0, &
240 "Missing aerosol representation"//error_msg)
241
242 ! Count the instances of this phase/species pair
243 n_aero_ids = 0
244 n_aero_jac_elem = 0
245 do i_aero_rep = 1, size(aero_rep)
246
247 ! Get the unique names in this aerosol representation for the
248 ! partitioning species
249 unique_spec_names = aero_rep(i_aero_rep)%val%unique_names( &
250 phase_name = phase_name, spec_name = aero_spec_name, &
251 phase_is_at_surface = .true.)
252
253 ! Skip aerosol representations that do not contain this phase
254 if (.not.allocated(unique_spec_names)) cycle
255
256 ! Add these instances to the list
257 n_aero_ids = n_aero_ids + size(unique_spec_names)
258
259 ! Get the number of Jacobian elements for calculations of mass, volume,
260 ! number, etc. for this partitioning into this phase
261 phase_ids = aero_rep(i_aero_rep)%val%phase_ids(phase_name, is_at_surface=.true.)
262 do i_phase = 1, size(phase_ids)
263 n_aero_jac_elem = n_aero_jac_elem + &
264 aero_rep(i_aero_rep)%val%num_jac_elem(phase_ids(i_phase))
265 end do
266
267 deallocate(unique_spec_names)
268
269 end do
270
271 call assert_msg(314000134, n_aero_ids.gt.0, &
272 "Aerosol species not found"//error_msg)
273
274 ! Allocate space in the condensed data arrays
275 allocate(this%condensed_data_int(num_int_prop_ + 2 + n_aero_ids * 13 + &
276 n_aero_jac_elem * 2))
277 allocate(this%condensed_data_real(num_real_prop_ + n_aero_jac_elem * 4))
278 this%condensed_data_int(:) = int(0, kind=i_kind)
279 this%condensed_data_real(:) = real(0.0, kind=dp)
280
281 ! Save space for the environment-dependent parameters
282 this%num_env_params = num_env_param_
283
284 ! Set the number of aerosol-species instances
285 num_aero_phase_ = n_aero_ids
286
287 ! Get the properties required of the aerosol species
288 call assert_msg(162662115, &
289 chem_spec_data%get_property_set(aero_spec_name, spec_props), &
290 "Missing properties"//error_msg)
291
292 ! Get the aerosol species molecular weight
293 key_name = "molecular weight [kg mol-1]"
294 call assert_msg(839930958, spec_props%get_real(key_name, mw_), &
295 "Missing property 'MW'"//error_msg)
296
297 ! Set the kg/m3 -> ppm conversion prefactor (multiply by T/P to get
298 ! conversion)
299 ! (ppm_x*Pa_air*m^3/K/kg_x) = Pa_air*m^3/mol_air/K * mol_x/kg_x *
300 ! 1.0e6ppm_x*mol_air/mol_x
301 conv_ = const%univ_gas_const / mw_ * 1.0e6
302
303 ! Set the ids of each aerosol-phase species instance
304 i_aero_id = 1
305 phase_int_loc_(i_aero_id) = num_int_prop_+12*num_aero_phase_+3
306 phase_real_loc_(i_aero_id) = num_real_prop_+1
307 do i_aero_rep = 1, size(aero_rep)
308
309 ! Get the unique names in this aerosol representation for the
310 ! partitioning species
311 unique_spec_names = aero_rep(i_aero_rep)%val%unique_names( &
312 phase_name = phase_name, spec_name = aero_spec_name, &
313 phase_is_at_surface = .true.)
314
315 ! Find the corresponding activity coefficients, if specified
316 if (has_act_coeff) then
317 unique_act_names = aero_rep(i_aero_rep)%val%unique_names( &
318 phase_name = phase_name, spec_name = act_name, &
319 phase_is_at_surface = .true.)
320 call assert_msg(236251734, size(unique_act_names).eq. &
321 size(unique_spec_names), &
322 "Mismatch of SIMPOL species and activity coeffs"// &
323 error_msg)
324 end if
325
326 ! Get the phase ids for this aerosol phase
327 phase_ids = aero_rep(i_aero_rep)%val%phase_ids(phase_name, is_at_surface=.true.)
328 ! Add the species concentration and activity coefficient ids to
329 ! the condensed data, and set the number of Jacobian elements for
330 ! the aerosol representations and the locations of the real data
331 do i_spec = 1, size(unique_spec_names)
332 num_aero_phase_jac_elem_(i_aero_id) = &
333 aero_rep(i_aero_rep)%val%num_jac_elem(phase_ids(i_spec))
334 aero_spec_(i_aero_id) = &
335 aero_rep(i_aero_rep)%val%spec_state_id( &
336 unique_spec_names(i_spec)%string)
337 if (has_act_coeff) then
338 aero_act_id_(i_aero_id) = &
339 aero_rep(i_aero_rep)%val%spec_state_id( &
340 unique_act_names(i_spec)%string)
341 else
342 aero_act_id_(i_aero_id) = -1
343 end if
344 aero_phase_id_(i_aero_id) = phase_ids(i_spec)
345 aero_rep_id_(i_aero_id) = i_aero_rep
346 i_aero_id = i_aero_id + 1
347 if (i_aero_id .le. num_aero_phase_) then
348 phase_int_loc_(i_aero_id) = phase_int_loc_(i_aero_id - 1) + 1 + &
349 2*num_aero_phase_jac_elem_(i_aero_id - 1)
350 phase_real_loc_(i_aero_id) = phase_real_loc_(i_aero_id - 1) + &
351 4*num_aero_phase_jac_elem_(i_aero_id - 1)
352 end if
353 end do
354
355 deallocate(unique_spec_names)
356
357 end do
358
359 ! Get the SIMPOL.1 parameters
360 key_name = "B"
361 call assert_msg(882881186, &
362 this%property_set%get_property_t(key_name, b_params), &
363 "Missing 'B' parameters"//error_msg)
364 call assert_msg(654885723, b_params%size().eq.4, &
365 "Incorrect number of 'B' parameters"//error_msg)
366 call b_params%iter_reset()
367 call assert_msg(694024883, b_params%get_real(val = b1_), &
368 "Got non-real 'B1' parameter"//error_msg)
369 call b_params%iter_next()
370 call assert_msg(231316411, b_params%get_real(val = b2_), &
371 "Got non-real 'B2' parameter"//error_msg)
372 call b_params%iter_next()
373 call assert_msg(126167907, b_params%get_real(val = b3_), &
374 "Got non-real 'B3' parameter"//error_msg)
375 call b_params%iter_next()
376 call assert_msg(573535753, b_params%get_real(val = b4_), &
377 "Got non-real 'B4' parameter"//error_msg)
378
379 ! Save the index of the gas-phase species in the state variable array
380 gas_spec_ = chem_spec_data%gas_state_id(gas_spec_name)
381
382 ! Make sure the species exists
383 call assert_msg(551477581, gas_spec_.gt.0, &
384 "Missing gas-phase species"//error_msg)
385
386 ! Get the required properties for the gas-phase species
387 call assert_msg(611221674, &
388 chem_spec_data%get_property_set(gas_spec_name, spec_props), &
389 "Missing properties for gas-phase species"//error_msg)
390
391 ! Get N* to calculate the mass accomodation coefficient. If it is not
392 ! present, set DELTA_H_ and DELTA_S_ to zero to indicate a mass
393 ! accomodation coefficient of 1.0
394 ! Mass accomodation equation is based on equations in:
395 ! Ervens, B., et al., 2003. "CAPRAM 2.4 (MODAC mechanism): An extended
396 ! and condensed tropospheric aqueous mechanism and its application."
397 ! J. Geophys. Res. 108, 4426. doi:10.1029/2002JD002202
398 key_name = "N star"
399 if (spec_props%get_real(key_name, n_star)) then
400 ! enthalpy change (kcal mol-1)
401 delta_h_ = real(- 10.0d0*(n_star-1.0d0) + &
402 7.53d0*(n_star**(2.0d0/3.0d0)-1.0d0) - 1.0d0, kind=dp)
403 ! entropy change (cal mol-1)
404 delta_s_ = real(- 32.0d0*(n_star-1.0d0) + &
405 9.21d0*(n_star**(2.0d0/3.0d0)-1.0d0) - 1.3d0, kind=dp)
406 ! Convert dH and dS to (J mol-1)
407 delta_h_ = real(delta_h_ * 4184.0d0, kind=dp)
408 delta_s_ = real(delta_s_ * 4.184d0, kind=dp)
409 else
410 delta_h_ = real(0.0, kind=dp)
411 delta_s_ = real(0.0, kind=dp)
412 end if
413
414 ! Get the diffusion coefficient (m^2/s)
415 key_name = "diffusion coeff [m2 s-1]"
416 call assert_msg(948176709, spec_props%get_real(key_name, diff_coeff_), &
417 "Missing diffusion coefficient"//error_msg)
418
419 ! Calculate the constant portion of c_rms [m /( K^(1/2) * s )]
420 key_name = "molecular weight [kg mol-1]"
421 call assert_msg(272813400, spec_props%get_real(key_name, temp_real), &
422 "Missing molecular weight"//error_msg)
423 pre_c_avg_ = sqrt(8.0*const%univ_gas_const/(const%pi*temp_real))
424
425 ! Check the sizes of the data arrays
426 tmp_size = phase_int_loc_(i_aero_id - 1) + 1 + &
427 2*num_aero_phase_jac_elem_(i_aero_id - 1) - 1
428 call assert_msg(625802519, size(this%condensed_data_int) .eq. tmp_size, &
429 "int array size mismatch"//error_msg)
430 tmp_size = phase_real_loc_(i_aero_id - 1) + &
431 4*num_aero_phase_jac_elem_(i_aero_id - 1) - 1
432 call assert_msg(391089510, size(this%condensed_data_real) .eq. tmp_size, &
433 "real array size mismatch"//error_msg)
434
435 end subroutine initialize
436
437!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
438
439 !> Finalize the reaction
440 subroutine finalize(this)
441
442 !> Reaction data
443 type(rxn_simpol_phase_transfer_t), intent(inout) :: this
444
445 if (associated(this%property_set)) &
446 deallocate(this%property_set)
447 if (allocated(this%condensed_data_real)) &
448 deallocate(this%condensed_data_real)
449 if (allocated(this%condensed_data_int)) &
450 deallocate(this%condensed_data_int)
451
452 end subroutine finalize
453
454!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
455
456 !> Finalize an array of reactions
457 subroutine finalize_array(this)
458
459 !> Array of reaction data
460 type(rxn_simpol_phase_transfer_t), intent(inout) :: this(:)
461
462 integer(kind=i_kind) :: i
463
464 do i = 1, size(this)
465 call finalize(this(i))
466 end do
467
468 end subroutine finalize_array
469
470!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
471
Initialize the aerosol representation data, validating component data and loading any required inform...
Get the non-unique name of a chemical species by its unique name.
Interface for to_string functions.
Definition util.F90:32
The abstract aero_phase_data_t structure and associated subroutines.
subroutine finalize_array(this)
Finalize the aerosol phase data.
type(aero_phase_data_t) function, pointer constructor(phase_name, init_size)
Constructor for aero_phase_data_t.
subroutine finalize(this)
Finalize the aerosol phase data.
The abstract aero_rep_data_t structure and associated subroutines.
The camp_state_t structure and associated subroutines.
Definition camp_state.F90:9
The chem_spec_data_t structure and associated subroutines.
Physical constants.
Definition constants.F90:9
integer, parameter dp
Kind of a double precision real number.
Definition constants.F90:16
type(const_t), save const
Fixed variable for accessing the constant's values.
Definition constants.F90:77
integer, parameter i_kind
Kind of an integer.
Definition constants.F90:21
The property_t structure and associated subroutines.
Definition property.F90:9
The rxn_data_t structure and associated subroutines.
Definition rxn_data.F90:60
integer(kind=i_kind), parameter, public aero_rxn
Aerosol-phase reaction.
Definition rxn_data.F90:89
The rxn_SIMPOL_phase_transfer_t type and associated functions.
Common utility subroutines.
Definition util.F90:9
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition util.F90:165
subroutine die_msg(code, error_msg)
Error immediately.
Definition util.F90:196
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition util.F90:130
Pointer type for building arrays.
Pointer to aero_rep_data_t extending types.
Abstract reaction data type.
Definition rxn_data.F90:99
String type for building arrays of string of various size.
Definition util.F90:53