reaction_aux.F90 coverage: 78.26 %func 55.25 %block
1) module Reaction_Aux_module
2)
3) use Reaction_Database_Aux_module
4) use Reaction_Mineral_Aux_module
5) use Reaction_Microbial_Aux_module
6) use Reaction_Immobile_Aux_module
7) use Reaction_Surface_Complexation_Aux_module
8)
9) #ifdef SOLID_SOLUTION
10) use Reaction_Solid_Soln_Aux_module
11) #endif
12)
13) use PFLOTRAN_Constants_module
14)
15) implicit none
16)
17) private
18)
19) #include "petsc/finclude/petscsys.h"
20)
21) ! activity coefficients
22) PetscInt, parameter, public :: ACT_COEF_FREQUENCY_OFF = 0
23) PetscInt, parameter, public :: ACT_COEF_FREQUENCY_TIMESTEP = 1
24) PetscInt, parameter, public :: ACT_COEF_FREQUENCY_NEWTON_ITER = 2
25) PetscInt, parameter, public :: ACT_COEF_ALGORITHM_LAG = 3
26) PetscInt, parameter, public :: ACT_COEF_ALGORITHM_NEWTON = 4
27) PetscInt, parameter, public :: NO_BDOT = 5
28)
29) type, public :: species_idx_type
30) PetscInt :: h2o_aq_id
31) PetscInt :: h_ion_id
32) PetscInt :: na_ion_id
33) PetscInt :: cl_ion_id
34) PetscInt :: co2_aq_id
35) PetscInt :: tracer_aq_id
36) PetscInt :: co2_gas_id
37) PetscInt :: o2_gas_id
38) PetscInt :: water_age_id
39) PetscInt :: tracer_age_id
40) end type species_idx_type
41)
42) type, public :: aq_species_type
43) PetscInt :: id
44) character(len=MAXWORDLENGTH) :: name
45) PetscReal :: a0
46) PetscReal :: molar_weight
47) PetscReal :: Z
48) PetscBool :: print_me
49) PetscBool :: is_redox
50) type(database_rxn_type), pointer :: dbaserxn
51) type(aq_species_type), pointer :: next
52) end type aq_species_type
53)
54) type, public :: gas_species_type
55) PetscInt :: id
56) character(len=MAXWORDLENGTH) :: name
57) PetscReal :: molar_volume
58) PetscReal :: molar_weight
59) PetscBool :: print_me
60) type(database_rxn_type), pointer :: dbaserxn
61) type(gas_species_type), pointer :: next
62) end type gas_species_type
63)
64) type, public :: colloid_type
65) PetscInt :: id
66) PetscInt :: itype
67) character(len=MAXWORDLENGTH) :: name
68) PetscReal :: mobile_fraction
69) PetscReal :: forward_rate
70) PetscReal :: backward_rate
71) PetscReal :: surface_area
72) PetscReal :: molar_weight
73) PetscBool :: print_me
74) type(colloid_type), pointer :: next
75) end type colloid_type
76)
77) type, public :: ion_exchange_rxn_type
78) PetscInt :: id
79) character(len=MAXWORDLENGTH) :: mineral_name
80) type(ion_exchange_cation_type), pointer :: cation_list
81) PetscReal :: CEC
82) type (ion_exchange_rxn_type), pointer :: next
83) end type ion_exchange_rxn_type
84)
85) type, public :: ion_exchange_cation_type
86) character(len=MAXWORDLENGTH) :: name
87) PetscReal :: k
88) type (ion_exchange_cation_type), pointer :: next
89) end type ion_exchange_cation_type
90)
91) type, public :: kd_rxn_type
92) PetscInt :: id
93) PetscInt :: itype
94) character(len=MAXWORDLENGTH) :: species_name
95) character(len=MAXWORDLENGTH) :: kd_mineral_name
96) PetscReal :: Kd
97) PetscReal :: Langmuir_B
98) PetscReal :: Freundlich_n
99) type (kd_rxn_type), pointer :: next
100) end type kd_rxn_type
101)
102) type, public :: radioactive_decay_rxn_type
103) PetscInt :: id
104) character(len=MAXSTRINGLENGTH) :: reaction
105) PetscReal :: rate_constant
106) PetscReal :: half_life
107) PetscBool :: print_me
108) type(database_rxn_type), pointer :: dbaserxn
109) type(radioactive_decay_rxn_type), pointer :: next
110) end type radioactive_decay_rxn_type
111)
112) type, public :: general_rxn_type
113) PetscInt :: id
114) character(len=MAXSTRINGLENGTH) :: reaction
115) PetscReal :: forward_rate
116) PetscReal :: backward_rate
117) PetscBool :: print_me
118) type(database_rxn_type), pointer :: dbaserxn
119) type(general_rxn_type), pointer :: next
120) end type general_rxn_type
121)
122) type, public :: aq_species_constraint_type
123) ! Any changes here must be incorporated within ReactionProcessConstraint()
124) ! where constraints are reordered
125) character(len=MAXWORDLENGTH), pointer :: names(:)
126) PetscReal, pointer :: constraint_conc(:)
127) PetscReal, pointer :: basis_molarity(:)
128) PetscInt, pointer :: constraint_type(:)
129) PetscInt, pointer :: constraint_spec_id(:)
130) character(len=MAXWORDLENGTH), pointer :: constraint_aux_string(:)
131) PetscBool, pointer :: external_dataset(:)
132) end type aq_species_constraint_type
133)
134) type, public :: guess_constraint_type
135) ! Any changes here must be incorporated within ReactionProcessConstraint()
136) ! where constraints are reordered
137) character(len=MAXWORDLENGTH), pointer :: names(:)
138) PetscReal, pointer :: conc(:)
139) end type guess_constraint_type
140)
141) type, public :: colloid_constraint_type
142) ! Any changes here must be incorporated within ReactionProcessConstraint()
143) ! where constraints are reordered
144) character(len=MAXWORDLENGTH), pointer :: names(:)
145) PetscReal, pointer :: constraint_conc_mob(:)
146) PetscReal, pointer :: constraint_conc_imb(:)
147) PetscReal, pointer :: basis_conc_mob(:)
148) PetscReal, pointer :: basis_conc_imb(:)
149) end type colloid_constraint_type
150)
151) type, public :: reaction_type
152) character(len=MAXSTRINGLENGTH) :: database_filename
153) PetscBool :: use_full_geochemistry
154) PetscBool :: use_log_formulation ! flag for solving for the change in the log of the concentration
155) PetscReal :: truncated_concentration
156) PetscBool :: check_update
157) PetscBool :: print_all_species
158) PetscBool :: print_all_primary_species
159) PetscBool :: print_all_secondary_species
160) PetscBool :: print_all_gas_species
161) PetscBool :: print_pH
162) PetscBool :: print_Eh
163) PetscBool :: print_pe
164) PetscBool :: print_O2
165) PetscBool :: print_kd
166) PetscBool :: print_total_sorb
167) PetscBool :: print_total_sorb_mobile
168) PetscBool :: print_colloid
169) PetscBool :: print_act_coefs
170) PetscBool :: print_total_component
171) PetscBool :: print_free_ion
172) PetscBool :: print_total_bulk ! total in aq and sorbed phases
173) PetscBool :: initialize_with_molality
174) PetscBool :: print_age
175) PetscBool :: use_geothermal_hpt
176) PetscInt :: print_free_conc_type
177) PetscInt :: print_tot_conc_type
178) PetscInt :: print_secondary_conc_type
179) PetscInt :: num_dbase_temperatures
180) PetscInt :: num_dbase_parameters
181) PetscReal, pointer :: dbase_temperatures(:)
182) type(species_idx_type), pointer :: species_idx
183)
184) type(aq_species_type), pointer :: primary_species_list
185) type(aq_species_type), pointer :: secondary_species_list
186) type(gas_species_type), pointer :: gas_species_list
187) type(colloid_type), pointer :: colloid_list
188) type(ion_exchange_rxn_type), pointer :: ion_exchange_rxn_list
189) type(general_rxn_type), pointer :: general_rxn_list
190) type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn_list
191) type(kd_rxn_type), pointer :: kd_rxn_list
192) type(aq_species_type), pointer :: redox_species_list
193) PetscInt :: act_coef_update_frequency
194) PetscInt :: act_coef_update_algorithm
195) PetscBool :: checkpoint_activity_coefs
196) PetscBool :: act_coef_use_bdot
197) PetscBool :: use_activity_h2o
198) PetscBool :: calculate_water_age
199) PetscBool :: calculate_tracer_age
200)
201) ! new reaction objects
202) type(surface_complexation_type), pointer :: surface_complexation
203) type(mineral_type), pointer :: mineral
204) type(microbial_type), pointer :: microbial
205) type(immobile_type), pointer :: immobile
206)
207) ! secondary continuum reaction objects
208) type(kd_rxn_type), pointer :: sec_cont_kd_rxn_list
209)
210) #ifdef SOLID_SOLUTION
211) type(solid_solution_type), pointer :: solid_solution_list
212) #endif
213)
214) ! compressed arrays for efficient computation
215) ! primary aqueous complexes
216) PetscInt :: ncomp
217) PetscInt :: naqcomp
218) PetscInt :: ncollcomp
219) PetscInt :: nimcomp
220)
221) ! offsets
222) PetscInt :: offset_aqueous
223) PetscInt :: offset_colloid
224) PetscInt :: offset_collcomp
225) PetscInt :: offset_immobile
226)
227) character(len=MAXWORDLENGTH), pointer :: primary_species_names(:)
228) PetscBool, pointer :: primary_species_print(:)
229) PetscReal, pointer :: primary_spec_a0(:)
230) PetscReal, pointer :: primary_spec_Z(:)
231) PetscReal, pointer :: primary_spec_molar_wt(:)
232)
233) ! aqueous complexes
234) PetscInt :: neqcplx
235) character(len=MAXWORDLENGTH), pointer :: secondary_species_names(:)
236) PetscBool, pointer :: secondary_species_print(:)
237) character(len=MAXWORDLENGTH), pointer :: eqcplx_basis_names(:,:)
238) PetscBool, pointer :: eqcplx_basis_print(:)
239) PetscInt, pointer :: eqcplxspecid(:,:) ! (0:ncomp in rxn)
240) PetscReal, pointer :: eqcplxstoich(:,:)
241) PetscInt, pointer :: eqcplxh2oid(:) ! id of water, if present
242) PetscReal, pointer :: eqcplxh2ostoich(:) ! stoichiometry of water, if present
243) PetscReal, pointer :: eqcplx_a0(:) ! Debye-Huckel constant
244) PetscReal, pointer :: eqcplx_Z(:)
245) PetscReal, pointer :: eqcplx_molar_wt(:)
246) PetscReal, pointer :: eqcplx_logK(:)
247) PetscReal, pointer :: eqcplx_logKcoef(:,:)
248) ! Debye-Huckel
249) PetscReal :: debyeA ! Debye-Huckel A coefficient
250) PetscReal :: debyeB ! Debye-Huckel B coefficient
251) PetscReal :: debyeBdot ! Debye-Huckel Bdot coefficient
252)
253) ! gas species
254) PetscInt :: ngas
255) character(len=MAXWORDLENGTH), pointer :: gas_species_names(:)
256) PetscBool, pointer :: gas_species_print(:)
257) PetscInt, pointer :: eqgasspecid(:,:) ! (0:ncomp in rxn)
258) PetscReal, pointer :: eqgasstoich(:,:)
259) PetscInt, pointer :: eqgash2oid(:) ! id of water, if present
260) PetscReal, pointer :: eqgash2ostoich(:) ! stoichiometry of water, if present
261) PetscReal, pointer :: eqgas_logK(:)
262) PetscReal, pointer :: eqgas_logKcoef(:,:)
263)
264) PetscInt :: nsorb
265) PetscInt :: neqsorb
266) PetscBool, pointer :: kd_print(:)
267) PetscBool, pointer :: total_sorb_print(:)
268)
269) ! ionx exchange reactions
270) PetscInt :: neqionxrxn
271) PetscInt :: neqionxcation
272) PetscBool, pointer :: eqionx_rxn_Z_flag(:)
273) PetscInt, pointer :: eqionx_rxn_cation_X_offset(:)
274) PetscReal, pointer :: eqionx_rxn_CEC(:)
275) PetscInt, pointer :: eqionx_rxn_to_surf(:)
276) PetscReal, pointer :: eqionx_rxn_k(:,:)
277) PetscInt, pointer :: eqionx_rxn_cationid(:,:)
278) #if 0
279) PetscReal, pointer :: kinionx_rxn_CEC(:)
280) PetscReal, pointer :: kinionx_rxn_k(:,:)
281) PetscInt, pointer :: kinionx_rxn_cationid(:)
282) #endif
283)
284) ! colloids
285) PetscInt :: ncoll
286) character(len=MAXWORDLENGTH), pointer :: colloid_names(:)
287) character(len=MAXWORDLENGTH), pointer :: colloid_species_names(:)
288) PetscReal, pointer :: colloid_mobile_fraction(:)
289) PetscInt, pointer :: pri_spec_to_coll_spec(:)
290) PetscInt, pointer :: coll_spec_to_pri_spec(:)
291) PetscBool, pointer :: total_sorb_mobile_print(:)
292) PetscBool, pointer :: colloid_print(:)
293)
294) ! radioactive decay rxn
295) PetscInt :: nradiodecay_rxn
296) ! ids and stoichiometries for species involved in reaction
297) PetscInt, pointer :: radiodecayspecid(:,:)
298) PetscReal, pointer :: radiodecaystoich(:,:)
299) ! index of radiodecayspecid for species in forward
300) ! reaction equation
301) PetscInt, pointer :: radiodecayforwardspecid(:)
302) PetscReal, pointer :: radiodecay_kf(:)
303)
304) ! general rxn
305) PetscInt :: ngeneral_rxn
306) ! ids and stoichiometries for species involved in reaction
307) PetscInt, pointer :: generalspecid(:,:)
308) PetscReal, pointer :: generalstoich(:,:)
309) ! index of generalspecid & generalstoich for species in forward
310) ! reaction equation
311) PetscInt, pointer :: generalforwardspecid(:,:)
312) PetscReal, pointer :: generalforwardstoich(:,:)
313) ! index of generalspecid & generalstoich for species in backward
314) ! reaction equation
315) PetscInt, pointer :: generalbackwardspecid(:,:)
316) PetscReal, pointer :: generalbackwardstoich(:,:)
317) PetscInt, pointer :: generalh2oid(:)
318) PetscReal, pointer :: generalh2ostoich(:)
319) PetscReal, pointer :: general_kf(:)
320) PetscReal, pointer :: general_kr(:)
321)
322) ! kd rxn
323) PetscInt :: neqkdrxn
324) PetscInt, pointer :: eqkdspecid(:)
325) PetscInt, pointer :: eqkdtype(:)
326) PetscInt, pointer :: eqkdmineral(:)
327) PetscReal, pointer :: eqkddistcoef(:)
328) PetscReal, pointer :: eqkdlangmuirb(:)
329) PetscReal, pointer :: eqkdfreundlichn(:)
330)
331) ! secondary continuum kd rxn
332) ! neqkdrxn and eqkdspecid will be the same
333) PetscInt, pointer :: sec_cont_eqkdtype(:)
334) PetscReal, pointer :: sec_cont_eqkddistcoef(:)
335) PetscReal, pointer :: sec_cont_eqkdlangmuirb(:)
336) PetscReal, pointer :: sec_cont_eqkdfreundlichn(:)
337)
338) PetscReal :: max_dlnC
339) PetscReal :: max_relative_change_tolerance
340) PetscReal :: max_residual_tolerance
341)
342) PetscBool :: update_permeability
343) PetscBool :: update_tortuosity
344) PetscBool :: update_porosity
345) PetscReal :: minimum_porosity
346) PetscBool :: update_mineral_surface_area
347) PetscBool :: update_mnrl_surf_with_porosity
348)
349) PetscBool :: update_armor_mineral_surface
350) PetscInt :: update_armor_mineral_surface_flag
351)
352) PetscBool :: use_sandbox
353)
354) end type reaction_type
355)
356) interface GetPrimarySpeciesIDFromName
357) module procedure GetPrimarySpeciesIDFromName1
358) module procedure GetPrimarySpeciesIDFromName2
359) end interface
360)
361) public :: ReactionCreate, &
362) SpeciesIndexCreate, &
363) GasSpeciesCreate, &
364) GetPrimarySpeciesCount, &
365) GetPrimarySpeciesNames, &
366) GetPrimarySpeciesIDFromName, &
367) GetSecondarySpeciesCount, &
368) GetSecondarySpeciesNames, &
369) GetGasCount, &
370) GetGasNames, &
371) GetGasIDFromName, &
372) GetColloidCount, &
373) GetColloidNames, &
374) GetColloidIDFromName, &
375) GetImmobileCount, &
376) ReactionFitLogKCoef, &
377) ReactionInitializeLogK, &
378) ReactionInterpolateLogK, &
379) ReactionInitializeLogK_hpt, &
380) ReactionInterpolateLogK_hpt, &
381) TransitionStateTheoryRxnCreate, &
382) TransitionStatePrefactorCreate, &
383) TSPrefactorSpeciesCreate, &
384) TransitionStateTheoryRxnDestroy, &
385) AqueousSpeciesCreate, &
386) AqueousSpeciesDestroy, &
387) AqueousSpeciesConstraintCreate, &
388) AqueousSpeciesConstraintDestroy, &
389) GuessConstraintCreate, &
390) GuessConstraintDestroy, &
391) MineralConstraintCreate, &
392) MineralConstraintDestroy, &
393) RadioactiveDecayRxnCreate, &
394) RadioactiveDecayRxnDestroy, &
395) GeneralRxnCreate, &
396) GeneralRxnDestroy, &
397) KDRxnCreate, &
398) KDRxnDestroy, &
399) ColloidCreate, &
400) ColloidDestroy, &
401) ColloidConstraintCreate, &
402) ColloidConstraintDestroy, &
403) IonExchangeRxnCreate, &
404) IonExchangeCationCreate, &
405) ReactionInputRecord, &
406) ReactionDestroy, &
407) LogKeh
408)
409) contains
410)
411) ! ************************************************************************** !
412)
413) function ReactionCreate()
414) !
415) ! Allocate and initialize reaction object
416) !
417) ! Author: Glenn Hammond
418) ! Date: 05/02/08
419) !
420)
421) use Option_module
422)
423) implicit none
424)
425) type(reaction_type), pointer :: ReactionCreate
426)
427) type(reaction_type), pointer :: reaction
428)
429) allocate(reaction)
430)
431) reaction%database_filename = ''
432) reaction%num_dbase_temperatures = 0
433) nullify(reaction%dbase_temperatures)
434)
435) reaction%act_coef_use_bdot = PETSC_TRUE
436) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
437) reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG
438) reaction%checkpoint_activity_coefs = PETSC_TRUE
439) reaction%print_all_species = PETSC_FALSE
440) reaction%print_all_primary_species = PETSC_FALSE
441) reaction%print_all_secondary_species = PETSC_FALSE
442) reaction%print_all_gas_species = PETSC_FALSE
443) reaction%print_pH = PETSC_FALSE
444) reaction%print_Eh = PETSC_FALSE
445) reaction%print_pe = PETSC_FALSE
446) reaction%print_O2 = PETSC_FALSE
447) reaction%print_kd = PETSC_FALSE
448) reaction%print_total_sorb = PETSC_FALSE
449) reaction%print_total_sorb_mobile = PETSC_FALSE
450) reaction%print_colloid = PETSC_FALSE
451) reaction%print_act_coefs = PETSC_FALSE
452) reaction%use_log_formulation = PETSC_FALSE
453) reaction%truncated_concentration = UNINITIALIZED_DOUBLE
454) reaction%check_update = PETSC_TRUE
455) reaction%use_full_geochemistry = PETSC_FALSE
456) reaction%use_activity_h2o = PETSC_FALSE
457) reaction%calculate_tracer_age = PETSC_FALSE
458) reaction%calculate_water_age = PETSC_FALSE
459) reaction%print_age = PETSC_FALSE
460) reaction%print_total_component = PETSC_FALSE
461) reaction%print_free_ion = PETSC_FALSE
462) reaction%print_total_bulk = PETSC_FALSE
463) reaction%use_geothermal_hpt = PETSC_FALSE
464)
465) reaction%initialize_with_molality = PETSC_FALSE
466) reaction%print_free_conc_type = 0
467) reaction%print_tot_conc_type = 0
468) reaction%print_secondary_conc_type = 0
469)
470) nullify(reaction%species_idx)
471)
472) nullify(reaction%primary_species_list)
473) nullify(reaction%secondary_species_list)
474) nullify(reaction%gas_species_list)
475) nullify(reaction%colloid_list)
476) nullify(reaction%ion_exchange_rxn_list)
477) nullify(reaction%radioactive_decay_rxn_list)
478) nullify(reaction%general_rxn_list)
479) nullify(reaction%kd_rxn_list)
480) nullify(reaction%redox_species_list)
481)
482) nullify(reaction%sec_cont_kd_rxn_list)
483)
484) ! new reaction objects
485) reaction%surface_complexation => SurfaceComplexationCreate()
486) reaction%mineral => MineralCreate()
487) reaction%microbial => MicrobialCreate()
488) reaction%immobile => ImmobileCreate()
489) #ifdef SOLID_SOLUTION
490) nullify(reaction%solid_solution_list)
491) #endif
492)
493) nullify(reaction%primary_species_names)
494) nullify(reaction%secondary_species_names)
495) nullify(reaction%eqcplx_basis_names)
496) nullify(reaction%gas_species_names)
497) nullify(reaction%colloid_names)
498) nullify(reaction%colloid_species_names)
499)
500) nullify(reaction%primary_species_print)
501) nullify(reaction%secondary_species_print)
502) nullify(reaction%eqcplx_basis_print)
503) nullify(reaction%gas_species_print)
504) nullify(reaction%kd_print)
505) nullify(reaction%total_sorb_print)
506) nullify(reaction%total_sorb_mobile_print)
507) nullify(reaction%colloid_print)
508)
509) reaction%ncomp = 0
510) reaction%naqcomp = 0
511) reaction%ncoll = 0
512) reaction%ncollcomp = 0
513) reaction%nimcomp = 0
514) reaction%offset_aqueous = 0
515) reaction%offset_colloid = 0
516) reaction%offset_collcomp = 0
517) reaction%offset_immobile = 0
518) nullify(reaction%primary_spec_a0)
519) nullify(reaction%primary_spec_Z)
520) nullify(reaction%primary_spec_molar_wt)
521)
522) reaction%ngas = 0
523) nullify(reaction%eqgasspecid)
524) nullify(reaction%eqgasstoich)
525) nullify(reaction%eqgash2oid)
526) nullify(reaction%eqgash2ostoich)
527) nullify(reaction%eqgas_logK)
528) nullify(reaction%eqgas_logKcoef)
529)
530) reaction%neqcplx = 0
531) nullify(reaction%eqcplxspecid)
532) nullify(reaction%eqcplxstoich)
533) nullify(reaction%eqcplxh2oid)
534) nullify(reaction%eqcplxh2ostoich)
535) nullify(reaction%eqcplx_a0)
536) nullify(reaction%eqcplx_Z)
537) nullify(reaction%eqcplx_molar_wt)
538) nullify(reaction%eqcplx_logK)
539) nullify(reaction%eqcplx_logKcoef)
540)
541) reaction%debyeA = 0.5114d0
542) reaction%debyeB = 0.3288d0
543) reaction%debyeBdot = 0.0410d0
544)
545) reaction%nsorb = 0
546) reaction%neqsorb = 0
547)
548) reaction%neqionxrxn = 0
549) reaction%neqionxcation = 0
550) nullify(reaction%eqionx_rxn_Z_flag)
551) nullify(reaction%eqionx_rxn_cation_X_offset)
552) nullify(reaction%eqionx_rxn_CEC)
553) nullify(reaction%eqionx_rxn_to_surf)
554) nullify(reaction%eqionx_rxn_k)
555) nullify(reaction%eqionx_rxn_cationid)
556) #if 0
557) nullify(reaction%kinionx_CEC)
558) nullify(reaction%kinionx_k)
559) nullify(reaction%kinionx_cationid)
560) #endif
561)
562) reaction%ncoll = 0
563) nullify(reaction%pri_spec_to_coll_spec)
564) nullify(reaction%coll_spec_to_pri_spec)
565) nullify(reaction%colloid_mobile_fraction)
566)
567) reaction%ngeneral_rxn = 0
568) nullify(reaction%generalspecid)
569) nullify(reaction%generalstoich)
570) nullify(reaction%generalforwardspecid)
571) nullify(reaction%generalforwardstoich)
572) nullify(reaction%generalbackwardspecid)
573) nullify(reaction%generalbackwardstoich)
574) nullify(reaction%generalh2oid)
575) nullify(reaction%generalh2ostoich)
576) nullify(reaction%general_kf)
577) nullify(reaction%general_kr)
578)
579) reaction%nradiodecay_rxn = 0
580) nullify(reaction%radiodecayspecid)
581) nullify(reaction%radiodecaystoich)
582) nullify(reaction%radiodecayforwardspecid)
583) nullify(reaction%radiodecay_kf)
584)
585) reaction%neqkdrxn = 0
586) nullify(reaction%eqkdspecid)
587) nullify(reaction%eqkdtype)
588) nullify(reaction%eqkdmineral)
589) nullify(reaction%eqkddistcoef)
590) nullify(reaction%eqkdlangmuirb)
591) nullify(reaction%eqkdfreundlichn)
592)
593) nullify(reaction%sec_cont_eqkdtype)
594) nullify(reaction%sec_cont_eqkddistcoef)
595) nullify(reaction%sec_cont_eqkdlangmuirb)
596) nullify(reaction%sec_cont_eqkdfreundlichn)
597)
598) reaction%max_dlnC = 5.d0
599) reaction%max_relative_change_tolerance = 1.d-6
600) reaction%max_residual_tolerance = 1.d-12
601)
602) reaction%update_permeability = PETSC_FALSE
603) reaction%update_tortuosity = PETSC_FALSE
604) reaction%update_porosity = PETSC_FALSE
605) reaction%minimum_porosity = 0.d0
606) reaction%update_mineral_surface_area = PETSC_FALSE
607) reaction%update_mnrl_surf_with_porosity = PETSC_FALSE
608)
609) reaction%update_armor_mineral_surface = PETSC_FALSE
610) reaction%update_armor_mineral_surface_flag = 0
611)
612) reaction%use_sandbox = PETSC_FALSE
613)
614) ReactionCreate => reaction
615)
616) end function ReactionCreate
617)
618) ! ************************************************************************** !
619)
620) function SpeciesIndexCreate()
621) !
622) ! Allocate and initialize a species index object
623) !
624) ! Author: Peter Lichtner
625) ! Date: 01/29/10
626) !
627)
628) use Option_module
629)
630) implicit none
631)
632) type(species_idx_type), pointer :: SpeciesIndexCreate
633)
634) type(species_idx_type), pointer :: species_idx
635)
636) allocate(species_idx)
637)
638) species_idx%h2o_aq_id = 0
639) species_idx%h_ion_id = 0
640) species_idx%na_ion_id = 0
641) species_idx%cl_ion_id = 0
642) species_idx%co2_aq_id = 0
643) species_idx%tracer_aq_id = 0
644) species_idx%co2_gas_id = 0
645) species_idx%o2_gas_id = 0
646) species_idx%tracer_age_id = 0
647) species_idx%water_age_id = 0
648)
649) SpeciesIndexCreate => species_idx
650)
651) end function SpeciesIndexCreate
652)
653) ! ************************************************************************** !
654)
655) function AqueousSpeciesCreate()
656) !
657) ! Allocate and initialize an aqueous species object
658) !
659) ! Author: Glenn Hammond
660) ! Date: 05/02/08
661) !
662)
663) use Option_module
664)
665) implicit none
666)
667) type(aq_species_type), pointer :: AqueousSpeciesCreate
668)
669) type(aq_species_type), pointer :: species
670)
671) allocate(species)
672) species%id = 0
673) species%name = ''
674) species%a0 = 0.d0
675) species%molar_weight = 0.d0
676) species%Z = 0.d0
677) species%print_me = PETSC_FALSE
678) species%is_redox = PETSC_FALSE
679) nullify(species%dbaserxn)
680) nullify(species%next)
681)
682) AqueousSpeciesCreate => species
683)
684) end function AqueousSpeciesCreate
685)
686) ! ************************************************************************** !
687)
688) function GasSpeciesCreate()
689) !
690) ! Allocate and initialize a gas species object
691) !
692) ! Author: Glenn Hammond
693) ! Date: 05/02/08
694) !
695)
696) use Option_module
697)
698) implicit none
699)
700) type(gas_species_type), pointer :: GasSpeciesCreate
701)
702) type(gas_species_type), pointer :: species
703)
704) allocate(species)
705) species%id = 0
706) species%name = ''
707) species%molar_volume = 0.d0
708) species%molar_weight = 0.d0
709) species%print_me = PETSC_FALSE
710) nullify(species%dbaserxn)
711) nullify(species%next)
712)
713) GasSpeciesCreate => species
714)
715) end function GasSpeciesCreate
716)
717) ! ************************************************************************** !
718)
719) function ColloidCreate()
720) !
721) ! Allocate and initialize a colloid object
722) !
723) ! Author: Glenn Hammond
724) ! Date: 02/24/10
725) !
726)
727) use Option_module
728)
729) implicit none
730)
731) type(colloid_type), pointer :: ColloidCreate
732)
733) type(colloid_type), pointer :: colloid
734)
735) allocate(colloid)
736) colloid%id = 0
737) colloid%itype = 0
738) colloid%name = ''
739) colloid%mobile_fraction = 0.5d0
740) colloid%forward_rate = 0.d0
741) colloid%backward_rate = 0.d0
742) colloid%surface_area = 1.d0
743) colloid%molar_weight = 0.d0
744) colloid%print_me = PETSC_FALSE
745) nullify(colloid%next)
746)
747) ColloidCreate => colloid
748)
749) end function ColloidCreate
750)
751) ! ************************************************************************** !
752)
753) function IonExchangeRxnCreate()
754) !
755) ! Allocate and initialize an ion exchange reaction
756) !
757) ! Author: Peter Lichtner
758) ! Date: 10/24/08
759) !
760)
761) implicit none
762)
763) type(ion_exchange_rxn_type), pointer :: IonExchangeRxnCreate
764)
765) type(ion_exchange_rxn_type), pointer :: ionxrxn
766)
767) allocate(ionxrxn)
768) ionxrxn%id = 0
769) ionxrxn%mineral_name = ''
770) ionxrxn%CEC = 0.d0
771) nullify(ionxrxn%cation_list)
772) nullify(ionxrxn%next)
773)
774) IonExchangeRxnCreate => ionxrxn
775)
776) end function IonExchangeRxnCreate
777)
778) ! ************************************************************************** !
779)
780) function IonExchangeCationCreate()
781) !
782) ! Allocate and initialize a cation associated with
783) ! an ion exchange reaction
784) !
785) ! Author: Peter Lichtner
786) ! Date: 10/24/08
787) !
788)
789) implicit none
790)
791) type(ion_exchange_cation_type), pointer :: IonExchangeCationCreate
792)
793) type(ion_exchange_cation_type), pointer :: cation
794)
795) allocate(cation)
796) cation%name = ''
797) cation%k = 0.d0
798) nullify(cation%next)
799)
800) IonExchangeCationCreate => cation
801)
802) end function IonExchangeCationCreate
803)
804) ! ************************************************************************** !
805)
806) function RadioactiveDecayRxnCreate()
807) !
808) ! Allocate and initialize a radioactive decay
809) ! reaction
810) !
811) ! Author: Glenn Hammond
812) ! Date: 01/07/14
813) !
814)
815) implicit none
816)
817) type(radioactive_decay_rxn_type), pointer :: RadioactiveDecayRxnCreate
818)
819) type(radioactive_decay_rxn_type), pointer :: rxn
820)
821) allocate(rxn)
822) rxn%id = 0
823) rxn%reaction = ''
824) rxn%rate_constant = 0.d0
825) rxn%half_life = 0.d0
826) rxn%print_me = PETSC_FALSE
827) nullify(rxn%dbaserxn)
828) nullify(rxn%next)
829)
830) RadioactiveDecayRxnCreate => rxn
831)
832) end function RadioactiveDecayRxnCreate
833)
834) ! ************************************************************************** !
835)
836) function GeneralRxnCreate()
837) !
838) ! Allocate and initialize a general reaction
839) !
840) ! Author: Glenn Hammond
841) ! Date: 09/03/10
842) !
843)
844) implicit none
845)
846) type(general_rxn_type), pointer :: GeneralRxnCreate
847)
848) type(general_rxn_type), pointer :: rxn
849)
850) allocate(rxn)
851) rxn%id = 0
852) rxn%reaction = ''
853) rxn%forward_rate = 0.d0
854) rxn%backward_rate = 0.d0
855) rxn%print_me = PETSC_FALSE
856) nullify(rxn%dbaserxn)
857) nullify(rxn%next)
858)
859) GeneralRxnCreate => rxn
860)
861) end function GeneralRxnCreate
862)
863) ! ************************************************************************** !
864)
865) function KDRxnCreate()
866) !
867) ! Allocate and initialize a KD sorption reaction
868) !
869) ! Author: Glenn Hammond
870) ! Date: 09/32/10
871) !
872)
873) implicit none
874)
875) type(kd_rxn_type), pointer :: KDRxnCreate
876)
877) type(kd_rxn_type), pointer :: rxn
878)
879) allocate(rxn)
880) rxn%id = 0
881) rxn%itype = 0
882) rxn%species_name = ''
883) rxn%kd_mineral_name = ''
884) rxn%Kd = 0.d0
885) rxn%Langmuir_B = 0.d0
886) rxn%Freundlich_n = 0.d0
887) nullify(rxn%next)
888)
889) KDRxnCreate => rxn
890)
891) end function KDRxnCreate
892)
893) ! ************************************************************************** !
894)
895) function AqueousSpeciesConstraintCreate(reaction,option)
896) !
897) ! Creates an aqueous species constraint
898) ! object
899) !
900) ! Author: Glenn Hammond
901) ! Date: 10/14/08
902) !
903)
904) use Option_module
905)
906) implicit none
907)
908) type(reaction_type) :: reaction
909) type(option_type) :: option
910) type(aq_species_constraint_type), pointer :: AqueousSpeciesConstraintCreate
911)
912) type(aq_species_constraint_type), pointer :: constraint
913)
914) allocate(constraint)
915) allocate(constraint%names(reaction%naqcomp))
916) constraint%names = ''
917) allocate(constraint%constraint_conc(reaction%naqcomp))
918) constraint%constraint_conc = 0.d0
919) allocate(constraint%basis_molarity(reaction%naqcomp))
920) constraint%basis_molarity = 0.d0
921) allocate(constraint%constraint_spec_id(reaction%naqcomp))
922) constraint%constraint_spec_id = 0
923) allocate(constraint%constraint_type(reaction%naqcomp))
924) constraint%constraint_type = 0
925) allocate(constraint%constraint_aux_string(reaction%naqcomp))
926) constraint%constraint_aux_string = ''
927) allocate(constraint%external_dataset(reaction%naqcomp))
928) constraint%external_dataset = PETSC_FALSE
929)
930) AqueousSpeciesConstraintCreate => constraint
931)
932) end function AqueousSpeciesConstraintCreate
933)
934) ! ************************************************************************** !
935)
936) function GuessConstraintCreate(reaction,option)
937) !
938) ! Creates an aqueous species constraint
939) ! object
940) !
941) ! Author: Glenn Hammond
942) ! Date: 10/14/08
943) !
944)
945) use Option_module
946)
947) implicit none
948)
949) type(reaction_type) :: reaction
950) type(option_type) :: option
951) type(guess_constraint_type), pointer :: GuessConstraintCreate
952)
953) type(guess_constraint_type), pointer :: constraint
954)
955) allocate(constraint)
956) allocate(constraint%names(reaction%naqcomp))
957) constraint%names = ''
958) allocate(constraint%conc(reaction%naqcomp))
959) constraint%conc = 0.d0
960)
961) GuessConstraintCreate => constraint
962)
963) end function GuessConstraintCreate
964)
965) ! ************************************************************************** !
966)
967) function ColloidConstraintCreate(reaction,option)
968) !
969) ! Creates a colloid constraint object
970) !
971) ! Author: Glenn Hammond
972) ! Date: 03/12/10
973) !
974)
975) use Option_module
976)
977) implicit none
978)
979) type(reaction_type) :: reaction
980) type(option_type) :: option
981) type(colloid_constraint_type), pointer :: ColloidConstraintCreate
982)
983) type(colloid_constraint_type), pointer :: constraint
984)
985) allocate(constraint)
986) allocate(constraint%names(reaction%ncoll))
987) constraint%names = ''
988) allocate(constraint%constraint_conc_mob(reaction%ncoll))
989) constraint%constraint_conc_mob = 0.d0
990) allocate(constraint%constraint_conc_imb(reaction%ncoll))
991) constraint%constraint_conc_imb = 0.d0
992) allocate(constraint%basis_conc_mob(reaction%ncoll))
993) constraint%basis_conc_mob = 0.d0
994) allocate(constraint%basis_conc_imb(reaction%ncoll))
995) constraint%basis_conc_imb = 0.d0
996)
997) ColloidConstraintCreate => constraint
998)
999) end function ColloidConstraintCreate
1000)
1001) ! ************************************************************************** !
1002)
1003) function GetPrimarySpeciesNames(reaction)
1004) !
1005) ! Returns the names of primary species in an array
1006) !
1007) ! Author: Glenn Hammond
1008) ! Date: 06/02/08
1009) !
1010)
1011) implicit none
1012)
1013) character(len=MAXWORDLENGTH), pointer :: GetPrimarySpeciesNames(:)
1014) type(reaction_type) :: reaction
1015)
1016) PetscInt :: count
1017) character(len=MAXWORDLENGTH), pointer :: names(:)
1018) type(aq_species_type), pointer :: species
1019)
1020) count = GetPrimarySpeciesCount(reaction)
1021) allocate(names(count))
1022)
1023) count = 1
1024) species => reaction%primary_species_list
1025) do
1026) if (.not.associated(species)) exit
1027) names(count) = species%name
1028) count = count + 1
1029) species => species%next
1030) enddo
1031)
1032) GetPrimarySpeciesNames => names
1033)
1034) end function GetPrimarySpeciesNames
1035)
1036) ! ************************************************************************** !
1037)
1038) function GetPrimarySpeciesCount(reaction)
1039) !
1040) ! Returns the number of primary species
1041) !
1042) ! Author: Glenn Hammond
1043) ! Date: 06/02/08
1044) !
1045)
1046) implicit none
1047)
1048) PetscInt :: GetPrimarySpeciesCount
1049) type(reaction_type) :: reaction
1050)
1051) type(aq_species_type), pointer :: species
1052)
1053) GetPrimarySpeciesCount = 0
1054) species => reaction%primary_species_list
1055) do
1056) if (.not.associated(species)) exit
1057) GetPrimarySpeciesCount = GetPrimarySpeciesCount + 1
1058) species => species%next
1059) enddo
1060)
1061) end function GetPrimarySpeciesCount
1062)
1063) ! ************************************************************************** !
1064)
1065) function GetPrimarySpeciesIDFromName1(name,reaction,option)
1066) !
1067) ! Returns the id of named primary species
1068) !
1069) ! Author: Glenn Hammond
1070) ! Date: 10/30/12
1071) !
1072)
1073) use Option_module
1074) use String_module
1075)
1076) implicit none
1077)
1078) character(len=MAXWORDLENGTH) :: name
1079) type(reaction_type) :: reaction
1080) type(option_type) :: option
1081)
1082) PetscInt :: GetPrimarySpeciesIDFromName1
1083)
1084) GetPrimarySpeciesIDFromName1 = GetPrimarySpeciesIDFromName2(name,reaction, &
1085) PETSC_TRUE, option)
1086)
1087) end function GetPrimarySpeciesIDFromName1
1088)
1089) ! ************************************************************************** !
1090)
1091) function GetPrimarySpeciesIDFromName2(name,reaction,return_error,option)
1092) !
1093) ! Returns the id of named primary species
1094) !
1095) ! Author: Glenn Hammond
1096) ! Date: 10/30/12
1097)
1098)
1099) use Option_module
1100) use String_module
1101)
1102) implicit none
1103)
1104) character(len=MAXWORDLENGTH) :: name
1105) type(reaction_type) :: reaction
1106) type(option_type) :: option
1107)
1108) PetscInt :: GetPrimarySpeciesIDFromName2
1109)
1110) type(aq_species_type), pointer :: species
1111) PetscInt :: i
1112) PetscBool :: return_error
1113)
1114) GetPrimarySpeciesIDFromName2 = UNINITIALIZED_INTEGER
1115)
1116) ! if the primary species name list exists
1117) if (associated(reaction%primary_species_names)) then
1118) do i = 1, size(reaction%primary_species_names)
1119) if (StringCompare(name,reaction%primary_species_names(i), &
1120) MAXWORDLENGTH)) then
1121) GetPrimarySpeciesIDFromName2 = i
1122) exit
1123) endif
1124) enddo
1125) else
1126) species => reaction%primary_species_list
1127) i = 0
1128) do
1129) if (.not.associated(species)) exit
1130) i = i + 1
1131) if (StringCompare(name,species%name,MAXWORDLENGTH)) then
1132) GetPrimarySpeciesIDFromName2 = i
1133) exit
1134) endif
1135) species => species%next
1136) enddo
1137) endif
1138)
1139) if (return_error .and. GetPrimarySpeciesIDFromName2 <= 0) then
1140) option%io_buffer = 'Species "' // trim(name) // &
1141) '" not found among primary species in GetPrimarySpeciesIDFromName().'
1142) call printErrMsg(option)
1143) endif
1144)
1145) end function GetPrimarySpeciesIDFromName2
1146)
1147) ! ************************************************************************** !
1148)
1149) function GetSecondarySpeciesNames(reaction)
1150) !
1151) ! Returns the names of secondary species in an array
1152) !
1153) ! Author: Glenn Hammond
1154) ! Date: 06/02/08
1155) !
1156)
1157) implicit none
1158)
1159) character(len=MAXWORDLENGTH), pointer :: GetSecondarySpeciesNames(:)
1160) type(reaction_type) :: reaction
1161)
1162) PetscInt :: count
1163) character(len=MAXWORDLENGTH), pointer :: names(:)
1164) type(aq_species_type), pointer :: species
1165)
1166) count = GetSecondarySpeciesCount(reaction)
1167) allocate(names(count))
1168)
1169) count = 1
1170) species => reaction%secondary_species_list
1171) do
1172) if (.not.associated(species)) exit
1173) names(count) = species%name
1174) count = count + 1
1175) species => species%next
1176) enddo
1177)
1178) GetSecondarySpeciesNames => names
1179)
1180) end function GetSecondarySpeciesNames
1181)
1182) ! ************************************************************************** !
1183)
1184) function GetSecondarySpeciesCount(reaction)
1185) !
1186) ! Returns the number of secondary species
1187) !
1188) ! Author: Glenn Hammond
1189) ! Date: 06/02/08
1190) !
1191)
1192) implicit none
1193)
1194) PetscInt :: GetSecondarySpeciesCount
1195) type(reaction_type) :: reaction
1196)
1197) type(aq_species_type), pointer :: species
1198)
1199) GetSecondarySpeciesCount = 0
1200) species => reaction%secondary_species_list
1201) do
1202) if (.not.associated(species)) exit
1203) GetSecondarySpeciesCount = GetSecondarySpeciesCount + 1
1204) species => species%next
1205) enddo
1206)
1207) end function GetSecondarySpeciesCount
1208)
1209) ! ************************************************************************** !
1210)
1211) function GetGasNames(reaction)
1212) !
1213) ! Returns the names of gases in an array
1214) !
1215) ! Author: Glenn Hammond
1216) ! Date: 10/21/08
1217) !
1218)
1219) implicit none
1220)
1221) character(len=MAXWORDLENGTH), pointer :: GetGasNames(:)
1222) type(reaction_type) :: reaction
1223)
1224) PetscInt :: count
1225) character(len=MAXWORDLENGTH), pointer :: names(:)
1226) type(gas_species_type), pointer :: gas
1227)
1228) count = GetGasCount(reaction)
1229) allocate(names(count))
1230)
1231) count = 1
1232) gas => reaction%gas_species_list
1233) do
1234) if (.not.associated(gas)) exit
1235) names(count) = gas%name
1236) count = count + 1
1237) gas => gas%next
1238) enddo
1239)
1240) GetGasNames => names
1241)
1242) end function GetGasNames
1243)
1244) ! ************************************************************************** !
1245)
1246) function GetGasCount(reaction)
1247) !
1248) ! Returns the number of primary species
1249) !
1250) ! Author: Glenn Hammond
1251) ! Date: 06/02/08
1252) !
1253)
1254) implicit none
1255)
1256) PetscInt :: GetGasCount
1257) type(reaction_type) :: reaction
1258)
1259) type(gas_species_type), pointer :: gas
1260)
1261) GetGasCount = 0
1262) gas => reaction%gas_species_list
1263) do
1264) if (.not.associated(gas)) exit
1265) GetGasCount = GetGasCount + 1
1266) gas => gas%next
1267) enddo
1268)
1269) end function GetGasCount
1270)
1271) ! ************************************************************************** !
1272)
1273) function GetGasIDFromName(reaction,name)
1274) !
1275) ! Returns the id of gas with the corresponding name
1276) !
1277) ! Author: Glenn Hammond
1278) ! Date: 09/04/08
1279) !
1280)
1281) use String_module
1282)
1283) implicit none
1284)
1285) type(reaction_type) :: reaction
1286) character(len=MAXWORDLENGTH) :: name
1287)
1288) PetscInt :: GetGasIDFromName
1289) type(gas_species_type), pointer :: gas
1290)
1291) GetGasIDFromName = -1
1292)
1293) gas => reaction%gas_species_list
1294) do
1295) if (.not.associated(gas)) exit
1296) if (StringCompare(name,gas%name,MAXWORDLENGTH)) then
1297) GetGasIDFromName = gas%id
1298) exit
1299) endif
1300) gas => gas%next
1301) enddo
1302)
1303) end function GetGasIDFromName
1304)
1305) ! ************************************************************************** !
1306)
1307) function GetColloidIDFromName(reaction,name)
1308) !
1309) ! Returns the id of colloid with the corresponding name
1310) !
1311) ! Author: Glenn Hammond
1312) ! Date: 02/24/10
1313) !
1314)
1315) use String_module
1316)
1317) implicit none
1318)
1319) type(reaction_type) :: reaction
1320) character(len=MAXWORDLENGTH) :: name
1321)
1322) PetscInt :: GetColloidIDFromName
1323) type(colloid_type), pointer :: colloid
1324)
1325) GetColloidIDFromName = -1
1326)
1327) colloid => reaction%colloid_list
1328) do
1329) if (.not.associated(colloid)) exit
1330) if (StringCompare(name,colloid%name,MAXWORDLENGTH)) then
1331) GetColloidIDFromName = colloid%id
1332) exit
1333) endif
1334) colloid => colloid%next
1335) enddo
1336)
1337) end function GetColloidIDFromName
1338)
1339) ! ************************************************************************** !
1340)
1341) function GetColloidNames(reaction)
1342) !
1343) ! Returns the names of colloids in an array
1344) !
1345) ! Author: Glenn Hammond
1346) ! Date: 09/04/08
1347) !
1348)
1349) implicit none
1350)
1351) character(len=MAXWORDLENGTH), pointer :: GetColloidNames(:)
1352) type(reaction_type) :: reaction
1353)
1354) PetscInt :: count
1355) character(len=MAXWORDLENGTH), pointer :: names(:)
1356) type(colloid_type), pointer :: colloid
1357)
1358) count = GetColloidCount(reaction)
1359) allocate(names(count))
1360)
1361) count = 1
1362) colloid => reaction%colloid_list
1363) do
1364) if (.not.associated(colloid)) exit
1365) names(count) = colloid%name
1366) count = count + 1
1367) colloid => colloid%next
1368) enddo
1369)
1370) GetColloidNames => names
1371)
1372) end function GetColloidNames
1373)
1374) ! ************************************************************************** !
1375)
1376) function GetColloidCount(reaction)
1377) !
1378) ! Returns the number of colloids
1379) !
1380) ! Author: Glenn Hammond
1381) ! Date: 02/24/10
1382) !
1383)
1384) implicit none
1385)
1386) PetscInt :: GetColloidCount
1387) type(reaction_type) :: reaction
1388)
1389) type(colloid_type), pointer :: colloid
1390)
1391) GetColloidCount = 0
1392) colloid => reaction%colloid_list
1393) do
1394) if (.not.associated(colloid)) exit
1395) GetColloidCount = GetColloidCount + 1
1396) colloid => colloid%next
1397) enddo
1398)
1399) end function GetColloidCount
1400)
1401) ! ************************************************************************** !
1402)
1403) function GetImmobileCount(reaction)
1404) !
1405) ! Returns the number of immobile species
1406) !
1407) ! Author: Glenn Hammond
1408) ! Date: 01/02/13
1409) !
1410)
1411) implicit none
1412)
1413) PetscInt :: GetImmobileCount
1414) type(reaction_type) :: reaction
1415)
1416) GetImmobileCount = ImmobileGetCount(reaction%immobile)
1417)
1418) end function GetImmobileCount
1419)
1420) ! ************************************************************************** !
1421)
1422) subroutine ReactionFitLogKCoef(coefs,logK,name,option,reaction)
1423) !
1424) ! Least squares fit to log K over database temperature
1425) ! range
1426) !
1427) ! Author: P.C. Lichtner
1428) ! Date: 02/13/09
1429) !
1430)
1431) use Option_module
1432) use Utility_module
1433)
1434) implicit none
1435)
1436) type(reaction_type) :: reaction
1437) PetscReal :: coefs(FIVE_INTEGER)
1438) character(len=MAXWORDLENGTH) :: name
1439) PetscReal :: logK(reaction%num_dbase_temperatures)
1440) type(option_type) :: option
1441)
1442) PetscInt :: temp_int(reaction%num_dbase_temperatures), &
1443) indx(reaction%num_dbase_temperatures)
1444) PetscReal :: a(FIVE_INTEGER,FIVE_INTEGER), &
1445) vec(FIVE_INTEGER,reaction%num_dbase_temperatures), temperature_kelvin
1446)
1447) PetscInt :: i, j, k, iflag
1448)
1449) ! need to fill in vec with equations for temperatures vs coefs.
1450)
1451) do i = 1, reaction%num_dbase_temperatures
1452) temperature_kelvin = reaction%dbase_temperatures(i) + 273.15d0
1453) vec(1,i) = log(temperature_kelvin)
1454) vec(2,i) = 1.d0
1455) vec(3,i) = temperature_kelvin
1456) vec(4,i) = 1.d0/temperature_kelvin
1457) vec(5,i) = 1.d0/(temperature_kelvin*temperature_kelvin)
1458) enddo
1459)
1460) iflag = 0
1461) do j = 1, FIVE_INTEGER
1462) coefs(j) = 0.d0
1463) do i = 1, reaction%num_dbase_temperatures
1464) if (dabs(logK(i) - 500.) < 1.d-10) then
1465) iflag = 1
1466) temp_int(i) = ZERO_INTEGER
1467) else
1468) coefs(j) = coefs(j) + vec(j,i)*logK(i)
1469) temp_int(i) = ONE_INTEGER
1470) endif
1471) enddo
1472) enddo
1473)
1474) if (iflag == 1) then
1475) option%io_buffer = 'In ReactionFitLogKCoef: log K = 500 for ' // trim(name)
1476) call printWrnMsg(option)
1477) endif
1478)
1479) do j = 1, FIVE_INTEGER
1480) do k = j, FIVE_INTEGER
1481) a(j,k) = 0.d0
1482) do i = 1, reaction%num_dbase_temperatures
1483) if (temp_int(i) == 1) then
1484) a(j,k) = a(j,k) + vec(j,i)*vec(k,i)
1485) endif
1486) enddo
1487) if (j .ne. k) a(k,j) = a(j,k)
1488) enddo
1489) enddo
1490)
1491) call ludcmp(a,FIVE_INTEGER,indx,i)
1492) call lubksb(a,FIVE_INTEGER,indx,coefs)
1493)
1494) end subroutine ReactionFitLogKCoef
1495)
1496) ! ************************************************************************** !
1497)
1498) subroutine ReactionInitializeLogK(logKcoef,logKs,logK,option,reaction)
1499) !
1500) ! Least squares fit to log K over database temperature range
1501) !
1502) ! Author: P.C. Lichtner
1503) ! Date: 02/13/09
1504) !
1505)
1506) use Option_module
1507)
1508) implicit none
1509)
1510) type(reaction_type) :: reaction
1511) PetscReal :: logKcoef(FIVE_INTEGER)
1512) PetscReal :: logKs(reaction%num_dbase_temperatures)
1513) PetscReal :: logK, logK_1D_Array(ONE_INTEGER)
1514) type(option_type) :: option
1515)
1516) PetscReal :: coefs(FIVE_INTEGER,ONE_INTEGER)
1517) PetscReal :: temperature
1518) PetscInt :: itemperature
1519) PetscInt :: i
1520)
1521) ! we always initialize on reference temperature
1522) temperature = option%reference_temperature
1523)
1524) itemperature = 0
1525) if (option%use_isothermal) then ! find database temperature if relevant
1526) do i = 1, reaction%num_dbase_temperatures
1527) if (dabs(option%reference_temperature - &
1528) reaction%dbase_temperatures(i)) < 1.d-10) then
1529) itemperature = i
1530) exit
1531) endif
1532) enddo
1533) endif
1534)
1535) if (itemperature > 0) then ! use database temperature
1536) logK = logKs(itemperature)
1537) else ! interpolate
1538) coefs(:,ONE_INTEGER) = logKcoef(:)
1539) call ReactionInterpolateLogK(coefs,logK_1D_Array,temperature,ONE_INTEGER)
1540) logK = logK_1D_Array(ONE_INTEGER)
1541) endif
1542)
1543) end subroutine ReactionInitializeLogK
1544)
1545) ! ************************************************************************** !
1546)
1547) subroutine ReactionInterpolateLogK(coefs,logKs,temp,n)
1548) !
1549) ! Interpolation log K function: temp - temperature [C]
1550) ! b - fit coefficients determined from fit(...)
1551) !
1552) ! Author: P.C. Lichtner
1553) ! Date: 02/13/09
1554) !
1555)
1556) implicit none
1557)
1558) PetscInt :: n
1559) PetscReal :: coefs(5,n), logKs(n), temp
1560)
1561) PetscInt :: i
1562) PetscReal :: temp_kelvin
1563)
1564) temp_kelvin = temp + 273.15d0
1565)
1566) do i = 1, n
1567) logKs(i) = coefs(1,i)*log(temp_kelvin) &
1568) + coefs(2,i) &
1569) + coefs(3,i)*temp_kelvin &
1570) + coefs(4,i)/temp_kelvin &
1571) + coefs(5,i)/(temp_kelvin*temp_kelvin)
1572) enddo
1573)
1574) end subroutine ReactionInterpolateLogK
1575)
1576) ! ************************************************************************** !
1577)
1578) subroutine ReactionInitializeLogK_hpt(logKcoef,logK,option,reaction)
1579) !
1580) ! ReactionInitializeLogK: Least squares fit to log K over database temperature range
1581) !
1582) ! Author: Chuan Lu
1583) ! Date: 12/29/11
1584) !
1585)
1586) use Option_module
1587)
1588) implicit none
1589)
1590) type(reaction_type) :: reaction
1591) PetscReal :: logKcoef(17)
1592) PetscReal :: logK, logK_1D_Array(ONE_INTEGER)
1593) type(option_type) :: option
1594)
1595) PetscReal :: coefs(17,ONE_INTEGER)
1596) PetscReal :: temperature, pressure
1597) PetscInt :: itemperature
1598) PetscInt :: i
1599)
1600) ! we always initialize on reference temperature
1601) temperature = option%reference_temperature
1602) pressure = option%reference_pressure
1603)
1604)
1605) coefs(:,ONE_INTEGER) = logKcoef(:)
1606) call ReactionInterpolateLogK_hpt(coefs,logK_1D_Array,temperature,pressure, &
1607) ONE_INTEGER)
1608) logK = logK_1D_Array(ONE_INTEGER)
1609) ! print *,'ReactionInitializeLogK_hpt: ', pressure,temperature, logK
1610)
1611) end subroutine ReactionInitializeLogK_hpt
1612)
1613) ! ************************************************************************** !
1614)
1615) subroutine ReactionInterpolateLogK_hpt(coefs,logKs,temp,pres,n)
1616) !
1617) ! ReactionInterpolateLogK: Interpolation log K function: temp - temperature [C]
1618) ! b - fit coefficients determined from fit(...)
1619) !
1620) ! Author: P.C. Lichtner
1621) ! Date: 02/13/09
1622) !
1623)
1624) implicit none
1625)
1626) PetscInt :: n
1627) PetscReal :: coefs(17,n), logKs(n), temp, pres
1628)
1629) PetscInt :: i
1630) PetscReal :: temp_kelvin, tr, pr, logtr
1631)
1632) temp_kelvin = temp + 273.15d0
1633) tr = temp_kelvin/273.15d0
1634) pr = pres/1.d7
1635) logtr = log(tr)/log(10.d0)
1636)
1637) do i = 1, n
1638) logKs(i) = coefs(1,i) &
1639) + coefs(2,i) * tr &
1640) + coefs(3,i) / tr &
1641) + coefs(4,i) * logtr &
1642) + coefs(5,i) * tr * tr &
1643) + coefs(6,i) / tr / tr &
1644) + coefs(7,i) * sqrt(tr) &
1645) + coefs(8,i) * pr &
1646) + coefs(9,i) * pr * tr &
1647) + coefs(10,i) * pr / tr &
1648) + coefs(11,i) * pr * logtr &
1649) + coefs(12,i) / pr &
1650) + coefs(13,i) / pr * tr &
1651) + coefs(14,i) / pr / tr &
1652) + coefs(15,i) * pr * pr &
1653) + coefs(16,i) * pr * pr * tr &
1654) + coefs(17,i) * pr * pr / tr
1655) enddo
1656) ! print *,'ReactionInterpolateLogK_hpt: ', pres,temp, logKs, coefs
1657) end subroutine ReactionInterpolateLogK_hpt
1658)
1659) ! ************************************************************************** !
1660)
1661) PetscReal function logkeh(tk)
1662) !
1663) ! Function logkeh: Maier-Kelly fit to equilibrium constant half-cell reaction
1664) ! 2 H2O - 4 H+ - 4 e- = O2, to compute Eh and pe.
1665) !
1666) ! Author: Peter Lichtner
1667) ! Date: 04/27/13
1668) !
1669)
1670) implicit none
1671)
1672) PetscReal, intent(in) :: tk
1673)
1674) PetscReal, parameter :: cm1 = 6.745529048112373d0
1675) PetscReal, parameter :: c0 = -48.295936593543715d0
1676) PetscReal, parameter :: c1 = 0.0005578156078778505d0
1677) PetscReal, parameter :: c2 = 27780.749538022003d0
1678) PetscReal, parameter :: c3 = 4027.3376948579394d0
1679)
1680) logkeh = cm1 * log(tk) + c0 + c1 * tk + c2 / tk + c3 / (tk * tk)
1681)
1682) end function logkeh
1683)
1684) ! ************************************************************************** !
1685)
1686) subroutine ReactionInputRecord(rxn)
1687) !
1688) ! Prints ingested chemistry and reactive transport information to the input
1689) ! record file.
1690) !
1691) ! Author: Jenn Frederick
1692) ! Date: 04/12/2016
1693) !
1694) use Reaction_Immobile_Aux_module
1695)
1696) implicit none
1697)
1698) type(reaction_type), pointer :: rxn
1699)
1700) type(aq_species_type), pointer :: cur_aq_species
1701) type(gas_species_type), pointer :: cur_gas_species
1702) type(immobile_species_type), pointer :: cur_imm_species
1703) type(radioactive_decay_rxn_type), pointer :: cur_rad_decay_rxn
1704) type(kd_rxn_type), pointer :: cur_kd_rxn
1705) character(len=MAXWORDLENGTH) :: word1, word2
1706) character(len=MAXSTRINGLENGTH) :: string
1707) PetscInt :: id = INPUT_RECORD_UNIT
1708)
1709) write(id,'(a)') ' '
1710) write(id,'(a)') '---------------------------------------------------------&
1711) &-----------------------'
1712) write(id,'(a29)',advance='no') '---------------------------: '
1713) write(id,'(a)') 'CHEMISTRY'
1714)
1715) if (.not.associated(rxn)) return
1716)
1717) ! --------- primary species list ---------------------------------------------
1718) if (associated(rxn%primary_species_list)) then
1719) write(id,'(a29)',advance='no') 'primary species list: '
1720) cur_aq_species => rxn%primary_species_list
1721) write(id,'(a)') trim(cur_aq_species%name)
1722) cur_aq_species => cur_aq_species%next
1723) do
1724) if (.not.associated(cur_aq_species)) exit
1725) write(id,'(a29)',advance='no') ' '
1726) write(id,'(a)') trim(cur_aq_species%name)
1727) cur_aq_species => cur_aq_species%next
1728) enddo
1729) write(id,'(a29)') '---------------------------: '
1730) endif
1731) ! --------- secondary species list -------------------------------------------
1732) if (associated(rxn%secondary_species_list)) then
1733) write(id,'(a29)',advance='no') 'secondary species list: '
1734) cur_aq_species => rxn%secondary_species_list
1735) write(id,'(a)') trim(cur_aq_species%name)
1736) cur_aq_species => cur_aq_species%next
1737) do
1738) if (.not.associated(cur_aq_species)) exit
1739) write(id,'(a29)',advance='no') ' '
1740) write(id,'(a)') trim(cur_aq_species%name)
1741) cur_aq_species => cur_aq_species%next
1742) enddo
1743) write(id,'(a29)') '---------------------------: '
1744) endif
1745) ! --------- gas species list -------------------------------------------------
1746) if (associated(rxn%gas_species_list)) then
1747) write(id,'(a29)',advance='no') 'gas species list: '
1748) cur_gas_species => rxn%gas_species_list
1749) write(id,'(a)') trim(cur_gas_species%name)
1750) cur_gas_species => cur_gas_species%next
1751) do
1752) if (.not.associated(cur_gas_species)) exit
1753) write(id,'(a29)',advance='no') ' '
1754) write(id,'(a)') trim(cur_gas_species%name)
1755) cur_gas_species => cur_gas_species%next
1756) enddo
1757) write(id,'(a29)') '---------------------------: '
1758) endif
1759) ! --------- immobile species list --------------------------------------------
1760) if (associated(rxn%immobile%list)) then
1761) write(id,'(a29)',advance='no') 'immobile species list: '
1762) cur_imm_species => rxn%immobile%list
1763) write(id,'(a)') trim(cur_imm_species%name)
1764) cur_imm_species => cur_imm_species%next
1765) do
1766) if (.not.associated(cur_imm_species)) exit
1767) write(id,'(a29)',advance='no') ' '
1768) write(id,'(a)') trim(cur_imm_species%name)
1769) cur_imm_species => cur_imm_species%next
1770) enddo
1771) write(id,'(a29)') '---------------------------: '
1772) endif
1773)
1774) ! --------- radioactive decay reaction list ----------------------------------
1775) if (associated(rxn%radioactive_decay_rxn_list)) then
1776) cur_rad_decay_rxn => rxn%radioactive_decay_rxn_list
1777) do
1778) if (.not.associated(cur_rad_decay_rxn)) exit
1779) write(id,'(a29)',advance='no') 'radioactive decay reaction: '
1780) write(id,'(a)') adjustl(trim(cur_rad_decay_rxn%reaction))
1781) write(id,'(a29)',advance='no') 'decay rate: '
1782) write(word1,*) cur_rad_decay_rxn%rate_constant
1783) write(id,'(a)') adjustl(trim(word1)) // ' 1/sec'
1784)
1785) write(id,'(a29)') '---------------------------: '
1786) cur_rad_decay_rxn => cur_rad_decay_rxn%next
1787) enddo
1788) endif
1789)
1790) ! --------- sorption isotherm reaction list ----------------------------------
1791) if (associated(rxn%kd_rxn_list)) then
1792) cur_kd_rxn => rxn%kd_rxn_list
1793) do
1794) if (.not.associated(cur_kd_rxn)) exit
1795) write(id,'(a29)',advance='no') 'sorption, isotherm reaction: '
1796) write(id,'(a)') adjustl(trim(cur_kd_rxn%species_name))
1797) write(id,'(a29)',advance='no') 'type: '
1798) select case (cur_kd_rxn%itype)
1799) case (SORPTION_LINEAR)
1800) write(id,'(a)') 'linear sorption'
1801) case (SORPTION_LANGMUIR)
1802) write(id,'(a)') 'langmuir sorption'
1803) write(id,'(a29)',advance='no') 'langmuir b: '
1804) write(word1,*) cur_kd_rxn%Langmuir_B
1805) write(id,'(a)') adjustl(trim(word1))
1806) case (SORPTION_FREUNDLICH)
1807) write(id,'(a)') 'freundlich sorption'
1808) write(id,'(a29)',advance='no') 'freundlich n: '
1809) write(word1,*) cur_kd_rxn%Freundlich_N
1810) write(id,'(a)') adjustl(trim(word1))
1811) end select
1812) if (len_trim(cur_kd_rxn%kd_mineral_name) > 0) then
1813) write(id,'(a29)',advance='no') 'Kd mineral name: '
1814) write(id,'(a)') adjustl(trim(cur_kd_rxn%kd_mineral_name))
1815) word2 = ' L/kg'
1816) else
1817) word2 = ' kg/m^3'
1818) endif
1819) write(id,'(a29)',advance='no') 'distribution coeff. / Kd: '
1820) write(word1,*) cur_kd_rxn%Kd
1821) write(id,'(a)') adjustl(trim(word1)) // adjustl(trim(word2))
1822)
1823) write(id,'(a29)') '---------------------------: '
1824) cur_kd_rxn => cur_kd_rxn%next
1825) enddo
1826) endif
1827)
1828) end subroutine ReactionInputRecord
1829)
1830) ! ************************************************************************** !
1831)
1832) subroutine SpeciesIndexDestroy(species_idx)
1833) !
1834) ! Deallocates a species index object
1835) !
1836) ! Author: Glenn Hammond
1837) ! Date: 01/29/10
1838) !
1839)
1840) implicit none
1841)
1842) type(species_idx_type), pointer :: species_idx
1843)
1844) if (associated(species_idx)) deallocate(species_idx)
1845) nullify(species_idx)
1846)
1847) end subroutine SpeciesIndexDestroy
1848)
1849) ! ************************************************************************** !
1850)
1851) subroutine AqueousSpeciesDestroy(species)
1852) !
1853) ! Deallocates an aqueous species
1854) !
1855) ! Author: Glenn Hammond
1856) ! Date: 05/29/08
1857) !
1858)
1859) implicit none
1860)
1861) type(aq_species_type), pointer :: species
1862)
1863) if (associated(species%dbaserxn)) call DatabaseRxnDestroy(species%dbaserxn)
1864) deallocate(species)
1865) nullify(species)
1866)
1867) end subroutine AqueousSpeciesDestroy
1868)
1869) ! ************************************************************************** !
1870)
1871) subroutine AqueousSpeciesListDestroy(aq_species_list)
1872) !
1873) ! Deallocates an aqueous species
1874) !
1875) ! Author: Glenn Hammond
1876) ! Date: 09/03/10
1877) !
1878)
1879) implicit none
1880)
1881) type(aq_species_type), pointer :: aq_species_list
1882)
1883) type(aq_species_type), pointer :: species, prev_species
1884)
1885) species => aq_species_list
1886) do
1887) if (.not.associated(species)) exit
1888) prev_species => species
1889) species => species%next
1890) call AqueousSpeciesDestroy(prev_species)
1891) enddo
1892) nullify(aq_species_list)
1893)
1894) end subroutine AqueousSpeciesListDestroy
1895)
1896) ! ************************************************************************** !
1897)
1898) subroutine GasSpeciesDestroy(species)
1899) !
1900) ! Deallocates a gas species
1901) !
1902) ! Author: Glenn Hammond
1903) ! Date: 05/29/08
1904) !
1905)
1906) implicit none
1907)
1908) type(gas_species_type), pointer :: species
1909)
1910) if (associated(species%dbaserxn)) call DatabaseRxnDestroy(species%dbaserxn)
1911) deallocate(species)
1912) nullify(species)
1913)
1914) end subroutine GasSpeciesDestroy
1915)
1916) ! ************************************************************************** !
1917)
1918) subroutine ColloidDestroy(colloid)
1919) !
1920) ! Deallocates a colloid
1921) !
1922) ! Author: Glenn Hammond
1923) ! Date: 02/24/10
1924) !
1925)
1926) implicit none
1927)
1928) type(colloid_type), pointer :: colloid
1929)
1930) deallocate(colloid)
1931) nullify(colloid)
1932)
1933) end subroutine ColloidDestroy
1934)
1935) ! ************************************************************************** !
1936)
1937) subroutine IonExchangeRxnDestroy(ionxrxn)
1938) !
1939) ! Deallocates an ion exchange reaction
1940) !
1941) ! Author: Glenn Hammond
1942) ! Date: 10/24/08
1943) !
1944)
1945) implicit none
1946)
1947) type(ion_exchange_rxn_type), pointer :: ionxrxn
1948)
1949) type(ion_exchange_cation_type), pointer :: cur_cation, prev_cation
1950)
1951) if (.not.associated(ionxrxn)) return
1952)
1953) cur_cation => ionxrxn%cation_list
1954) do
1955) if (.not.associated(cur_cation)) exit
1956) prev_cation => cur_cation
1957) cur_cation => cur_cation%next
1958) deallocate(prev_cation)
1959) nullify(prev_cation)
1960) enddo
1961)
1962) nullify(ionxrxn%next)
1963)
1964) deallocate(ionxrxn)
1965) nullify(ionxrxn)
1966)
1967) end subroutine IonExchangeRxnDestroy
1968)
1969) ! ************************************************************************** !
1970)
1971) subroutine RadioactiveDecayRxnDestroy(rxn)
1972) !
1973) ! Deallocates a general reaction
1974) !
1975) ! Author: Glenn Hammond
1976) ! Date: 01/07/14
1977) !
1978)
1979) implicit none
1980)
1981) type(radioactive_decay_rxn_type), pointer :: rxn
1982)
1983) if (.not.associated(rxn)) return
1984)
1985) if (associated(rxn%dbaserxn)) &
1986) call DatabaseRxnDestroy(rxn%dbaserxn)
1987) nullify(rxn%dbaserxn)
1988) nullify(rxn%next)
1989)
1990) deallocate(rxn)
1991) nullify(rxn)
1992)
1993) end subroutine RadioactiveDecayRxnDestroy
1994)
1995) ! ************************************************************************** !
1996)
1997) subroutine GeneralRxnDestroy(rxn)
1998) !
1999) ! Deallocates a general reaction
2000) !
2001) ! Author: Glenn Hammond
2002) ! Date: 09/03/10
2003) !
2004)
2005) implicit none
2006)
2007) type(general_rxn_type), pointer :: rxn
2008)
2009) if (.not.associated(rxn)) return
2010)
2011) if (associated(rxn%dbaserxn)) &
2012) call DatabaseRxnDestroy(rxn%dbaserxn)
2013) nullify(rxn%dbaserxn)
2014) nullify(rxn%next)
2015)
2016) deallocate(rxn)
2017) nullify(rxn)
2018)
2019) end subroutine GeneralRxnDestroy
2020)
2021) ! ************************************************************************** !
2022)
2023) subroutine KDRxnDestroy(rxn)
2024) !
2025) ! Deallocates a KD reaction
2026) !
2027) ! Author: Glenn Hammond
2028) ! Date: 09/30/10
2029) !
2030)
2031) implicit none
2032)
2033) type(kd_rxn_type), pointer :: rxn
2034)
2035) if (.not.associated(rxn)) return
2036)
2037) deallocate(rxn)
2038) nullify(rxn)
2039)
2040) end subroutine KDRxnDestroy
2041)
2042) ! ************************************************************************** !
2043)
2044) subroutine AqueousSpeciesConstraintDestroy(constraint)
2045) !
2046) ! Destroys an aqueous species constraint
2047) ! object
2048) !
2049) ! Author: Glenn Hammond
2050) ! Date: 10/14/08
2051) !
2052)
2053) use Utility_module, only: DeallocateArray
2054)
2055) implicit none
2056)
2057) type(aq_species_constraint_type), pointer :: constraint
2058)
2059) if (.not.associated(constraint)) return
2060)
2061) call DeallocateArray(constraint%names)
2062) call DeallocateArray(constraint%constraint_conc)
2063) call DeallocateArray(constraint%basis_molarity)
2064) call DeallocateArray(constraint%constraint_type)
2065) call DeallocateArray(constraint%constraint_spec_id)
2066) call DeallocateArray(constraint%constraint_aux_string)
2067) call DeallocateArray(constraint%external_dataset)
2068)
2069) deallocate(constraint)
2070) nullify(constraint)
2071)
2072) end subroutine AqueousSpeciesConstraintDestroy
2073)
2074) ! ************************************************************************** !
2075)
2076) subroutine GuessConstraintDestroy(constraint)
2077) !
2078) ! Destroys an aqueous species constraint
2079) ! object
2080) !
2081) ! Author: Glenn Hammond
2082) ! Date: 10/14/08
2083) !
2084)
2085) use Utility_module, only: DeallocateArray
2086)
2087) implicit none
2088)
2089) type(guess_constraint_type), pointer :: constraint
2090)
2091) if (.not.associated(constraint)) return
2092)
2093) call DeallocateArray(constraint%names)
2094) call DeallocateArray(constraint%conc)
2095)
2096) deallocate(constraint)
2097) nullify(constraint)
2098)
2099) end subroutine GuessConstraintDestroy
2100)
2101) ! ************************************************************************** !
2102)
2103) subroutine ColloidConstraintDestroy(constraint)
2104) !
2105) ! Destroys a colloid constraint object
2106) !
2107) ! Author: Glenn Hammond
2108) ! Date: 03/12/10
2109) !
2110)
2111) use Utility_module, only: DeallocateArray
2112)
2113) implicit none
2114)
2115) type(colloid_constraint_type), pointer :: constraint
2116)
2117) if (.not.associated(constraint)) return
2118)
2119) call DeallocateArray(constraint%names)
2120) call DeallocateArray(constraint%constraint_conc_mob)
2121) call DeallocateArray(constraint%constraint_conc_imb)
2122) call DeallocateArray(constraint%basis_conc_mob)
2123) call DeallocateArray(constraint%basis_conc_imb)
2124)
2125) deallocate(constraint)
2126) nullify(constraint)
2127)
2128) end subroutine ColloidConstraintDestroy
2129)
2130) ! ************************************************************************** !
2131)
2132) subroutine ReactionDestroy(reaction,option)
2133) !
2134) ! Deallocates a reaction object
2135) !
2136) ! Author: Glenn Hammond
2137) ! Date: 05/29/08
2138) !
2139)
2140) use Utility_module, only: DeallocateArray
2141) use Option_module
2142)
2143) implicit none
2144)
2145) type(reaction_type), pointer :: reaction
2146)
2147) type(aq_species_type), pointer :: aq_species, prev_aq_species
2148) type(gas_species_type), pointer :: gas_species, prev_gas_species
2149) type(mineral_rxn_type), pointer :: mineral, prev_mineral
2150) type(colloid_type), pointer :: colloid, prev_colloid
2151) type(ion_exchange_rxn_type), pointer :: ionxrxn, prev_ionxrxn
2152) type(surface_complexation_rxn_type), pointer :: srfcplxrxn, prev_srfcplxrxn
2153) type(general_rxn_type), pointer :: general_rxn, prev_general_rxn
2154) type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn, &
2155) prev_radioactive_decay_rxn
2156) type(kd_rxn_type), pointer :: kd_rxn, prev_kd_rxn
2157) type(option_type) :: option
2158)
2159) if (.not.associated(reaction)) return
2160)
2161) !species index
2162) call SpeciesIndexDestroy(reaction%species_idx)
2163)
2164) ! primary species
2165) if (associated(reaction%primary_species_list)) &
2166) call AqueousSpeciesListDestroy(reaction%primary_species_list)
2167) nullify(reaction%primary_species_list)
2168)
2169) ! secondary species
2170) if (associated(reaction%secondary_species_list)) &
2171) call AqueousSpeciesListDestroy(reaction%secondary_species_list)
2172) nullify(reaction%secondary_species_list)
2173)
2174) ! gas species
2175) gas_species => reaction%gas_species_list
2176) do
2177) if (.not.associated(gas_species)) exit
2178) prev_gas_species => gas_species
2179) gas_species => gas_species%next
2180) call GasSpeciesDestroy(prev_gas_species)
2181) enddo
2182) nullify(reaction%gas_species_list)
2183)
2184) ! colloid species
2185) colloid => reaction%colloid_list
2186) do
2187) if (.not.associated(colloid)) exit
2188) prev_colloid => colloid
2189) colloid => colloid%next
2190) call ColloidDestroy(prev_colloid)
2191) enddo
2192) nullify(reaction%colloid_list)
2193)
2194) ! ionx exchange reactions
2195) ionxrxn => reaction%ion_exchange_rxn_list
2196) do
2197) if (.not.associated(ionxrxn)) exit
2198) prev_ionxrxn => ionxrxn
2199) ionxrxn => ionxrxn%next
2200) call IonExchangeRxnDestroy(prev_ionxrxn)
2201) enddo
2202) nullify(reaction%ion_exchange_rxn_list)
2203)
2204) ! radioactive decay reactions
2205) radioactive_decay_rxn => reaction%radioactive_decay_rxn_list
2206) do
2207) if (.not.associated(radioactive_decay_rxn)) exit
2208) prev_radioactive_decay_rxn => radioactive_decay_rxn
2209) radioactive_decay_rxn => radioactive_decay_rxn%next
2210) call RadioactiveDecayRxnDestroy(prev_radioactive_decay_rxn)
2211) enddo
2212) nullify(reaction%radioactive_decay_rxn_list)
2213)
2214) ! general reactions
2215) general_rxn => reaction%general_rxn_list
2216) do
2217) if (.not.associated(general_rxn)) exit
2218) prev_general_rxn => general_rxn
2219) general_rxn => general_rxn%next
2220) call GeneralRxnDestroy(prev_general_rxn)
2221) enddo
2222) nullify(reaction%general_rxn_list)
2223)
2224) ! kd reactions
2225) kd_rxn => reaction%kd_rxn_list
2226) do
2227) if (.not.associated(kd_rxn)) exit
2228) prev_kd_rxn => kd_rxn
2229) kd_rxn => kd_rxn%next
2230) call KDRxnDestroy(prev_kd_rxn)
2231) enddo
2232) nullify(reaction%kd_rxn_list)
2233)
2234) ! kd reactions secondary continuum
2235) if (option%use_mc) then
2236) kd_rxn => reaction%sec_cont_kd_rxn_list
2237) do
2238) if (.not.associated(kd_rxn)) exit
2239) prev_kd_rxn => kd_rxn
2240) kd_rxn => kd_rxn%next
2241) call KDRxnDestroy(prev_kd_rxn)
2242) enddo
2243) nullify(reaction%sec_cont_kd_rxn_list)
2244) endif
2245)
2246) call SurfaceComplexationDestroy(reaction%surface_complexation)
2247) call MineralDestroy(reaction%mineral)
2248) call MicrobialDestroy(reaction%microbial)
2249) call ImmobileDestroy(reaction%immobile)
2250) #ifdef SOLID_SOLUTION
2251) call SolidSolutionDestroy(reaction%solid_solution_list)
2252) #endif
2253)
2254) if (associated(reaction%dbase_temperatures)) &
2255) deallocate(reaction%dbase_temperatures)
2256) nullify(reaction%dbase_temperatures)
2257)
2258) ! redox species
2259) if (associated(reaction%redox_species_list)) &
2260) call AqueousSpeciesListDestroy(reaction%redox_species_list)
2261) nullify(reaction%redox_species_list)
2262)
2263) call DeallocateArray(reaction%primary_species_names)
2264) call DeallocateArray(reaction%secondary_species_names)
2265) call DeallocateArray(reaction%gas_species_names)
2266) call DeallocateArray(reaction%eqcplx_basis_names)
2267) call DeallocateArray(reaction%colloid_names)
2268) call DeallocateArray(reaction%colloid_species_names)
2269)
2270) call DeallocateArray(reaction%primary_species_print)
2271) call DeallocateArray(reaction%secondary_species_print)
2272) call DeallocateArray(reaction%gas_species_print)
2273) call DeallocateArray(reaction%eqcplx_basis_print)
2274) call DeallocateArray(reaction%kd_print)
2275) call DeallocateArray(reaction%total_sorb_print)
2276) call DeallocateArray(reaction%total_sorb_mobile_print)
2277) call DeallocateArray(reaction%colloid_print)
2278)
2279) call DeallocateArray(reaction%primary_spec_a0)
2280) call DeallocateArray(reaction%primary_spec_Z)
2281) call DeallocateArray(reaction%primary_spec_molar_wt)
2282)
2283) call DeallocateArray(reaction%eqcplxspecid)
2284) call DeallocateArray(reaction%eqcplxstoich)
2285) call DeallocateArray(reaction%eqcplxh2oid)
2286) call DeallocateArray(reaction%eqcplxh2ostoich)
2287) call DeallocateArray(reaction%eqcplx_a0)
2288) call DeallocateArray(reaction%eqcplx_Z)
2289) call DeallocateArray(reaction%eqcplx_molar_wt)
2290) call DeallocateArray(reaction%eqcplx_logK)
2291) call DeallocateArray(reaction%eqcplx_logKcoef)
2292)
2293) call DeallocateArray(reaction%eqgasspecid)
2294) call DeallocateArray(reaction%eqgasstoich)
2295) call DeallocateArray(reaction%eqgash2oid)
2296) call DeallocateArray(reaction%eqgash2ostoich)
2297) call DeallocateArray(reaction%eqgas_logK)
2298) call DeallocateArray(reaction%eqgas_logKcoef)
2299)
2300) call DeallocateArray(reaction%eqionx_rxn_Z_flag)
2301) call DeallocateArray(reaction%eqionx_rxn_cation_X_offset)
2302) call DeallocateArray(reaction%eqionx_rxn_to_surf)
2303) call DeallocateArray(reaction%eqionx_rxn_CEC)
2304) call DeallocateArray(reaction%eqionx_rxn_k)
2305) call DeallocateArray(reaction%eqionx_rxn_cationid)
2306)
2307) #if 0
2308) call DeallocateArray(reaction%kinionx_CEC)
2309) call DeallocateArray(reaction%kinionx_k)
2310) call DeallocateArray(reaction%kinionx_cationid)
2311) #endif
2312)
2313) call DeallocateArray(reaction%pri_spec_to_coll_spec)
2314) call DeallocateArray(reaction%coll_spec_to_pri_spec)
2315) call DeallocateArray(reaction%colloid_mobile_fraction)
2316)
2317) call DeallocateArray(reaction%radiodecayspecid)
2318) call DeallocateArray(reaction%radiodecaystoich)
2319) call DeallocateArray(reaction%radiodecayforwardspecid)
2320) call DeallocateArray(reaction%radiodecay_kf)
2321)
2322) call DeallocateArray(reaction%generalspecid)
2323) call DeallocateArray(reaction%generalstoich)
2324) call DeallocateArray(reaction%generalforwardspecid)
2325) call DeallocateArray(reaction%generalforwardstoich)
2326) call DeallocateArray(reaction%generalbackwardspecid)
2327) call DeallocateArray(reaction%generalbackwardstoich)
2328) call DeallocateArray(reaction%generalh2oid)
2329) call DeallocateArray(reaction%generalh2ostoich)
2330) call DeallocateArray(reaction%general_kf)
2331) call DeallocateArray(reaction%general_kr)
2332)
2333) call DeallocateArray(reaction%eqkdspecid)
2334) call DeallocateArray(reaction%eqkdtype)
2335) call DeallocateArray(reaction%eqkdmineral)
2336) call DeallocateArray(reaction%eqkddistcoef)
2337) call DeallocateArray(reaction%eqkdlangmuirb)
2338) call DeallocateArray(reaction%eqkdfreundlichn)
2339)
2340) call DeallocateArray(reaction%sec_cont_eqkdtype)
2341) call DeallocateArray(reaction%sec_cont_eqkddistcoef)
2342) call DeallocateArray(reaction%sec_cont_eqkdlangmuirb)
2343) call DeallocateArray(reaction%sec_cont_eqkdfreundlichn)
2344)
2345) deallocate(reaction)
2346) nullify(reaction)
2347)
2348) end subroutine ReactionDestroy
2349)
2350) end module Reaction_Aux_module