reaction_database.F90 coverage: 100.00 %func 75.37 %block
1) module Reaction_Database_module
2)
3) use Reaction_module
4) use Reaction_Aux_module
5) use Reaction_Database_Aux_module
6)
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15) public :: DatabaseRead, BasisInit
16)
17) public :: GetSpeciesBasisID, &
18) BasisPrint
19)
20)
21) contains
22)
23) ! ************************************************************************** !
24)
25) subroutine DatabaseRead(reaction,option)
26) !
27) ! Collects parameters from geochemical database
28) !
29) ! Author: Glenn Hammond
30) ! Date: 09/01/08
31) !
32)
33) use Option_module
34) use Input_Aux_module
35) use String_module
36)
37) use Reaction_Surface_Complexation_Aux_module
38) use Reaction_Mineral_Aux_module
39) use Reaction_Mineral_module
40) use Reaction_Microbial_Aux_module
41) use Reaction_Microbial_module
42) use Reaction_Immobile_Aux_module
43) use Reaction_Immobile_module
44)
45) implicit none
46)
47) type(reaction_type) :: reaction
48) type(option_type) :: option
49)
50) type(aq_species_type), pointer :: cur_aq_spec, cur_aq_spec2
51) type(gas_species_type), pointer :: cur_gas_spec, cur_gas_spec2
52) type(mineral_rxn_type), pointer :: cur_mineral, cur_mineral2
53) type(immobile_species_type), pointer :: cur_immobile_spec
54) type(colloid_type), pointer :: cur_colloid
55) type(surface_complexation_type), pointer :: surface_complexation
56) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
57) type(surface_complex_type), pointer :: cur_srfcplx, cur_srfcplx2, &
58) cur_srfcplx_in_master_list
59) type(mineral_type), pointer :: mineral
60) type(immobile_type), pointer :: immobile
61)
62) character(len=MAXSTRINGLENGTH) :: string
63) character(len=MAXWORDLENGTH) :: name
64) character(len=MAXWORDLENGTH) :: null_name
65)
66) PetscBool :: flag, found, logK_error_flag
67) PetscInt :: ispec, itemp, i
68) PetscReal :: stoich
69) PetscReal :: temp_real
70) type(input_type), pointer :: input
71) PetscInt :: iostat
72) PetscInt :: num_nulls
73) PetscInt :: num_logKs
74)
75) surface_complexation => reaction%surface_complexation
76) mineral => reaction%mineral
77) immobile => reaction%immobile
78)
79) ! negate ids for use as flags
80) cur_aq_spec => reaction%primary_species_list
81) do
82) if (.not.associated(cur_aq_spec)) exit
83) cur_aq_spec%id = -abs(cur_aq_spec%id)
84) cur_aq_spec => cur_aq_spec%next
85) enddo
86) cur_aq_spec => reaction%secondary_species_list
87) do
88) if (.not.associated(cur_aq_spec)) exit
89) cur_aq_spec%id = -abs(cur_aq_spec%id)
90) cur_aq_spec => cur_aq_spec%next
91) enddo
92) cur_gas_spec => reaction%gas_species_list
93) do
94) if (.not.associated(cur_gas_spec)) exit
95) cur_gas_spec%id = -abs(cur_gas_spec%id)
96) cur_gas_spec => cur_gas_spec%next
97) enddo
98) cur_immobile_spec => immobile%list
99) do
100) if (.not.associated(cur_immobile_spec)) exit
101) cur_immobile_spec%id = -abs(cur_immobile_spec%id)
102) cur_immobile_spec => cur_immobile_spec%next
103) enddo
104) cur_mineral => mineral%mineral_list
105) do
106) if (.not.associated(cur_mineral)) exit
107) cur_mineral%id = -abs(cur_mineral%id)
108) cur_mineral => cur_mineral%next
109) enddo
110)
111) cur_srfcplx => surface_complexation%complex_list
112) do
113) if (.not.associated(cur_srfcplx)) exit
114) cur_srfcplx%id = -abs(cur_srfcplx%id)
115) cur_srfcplx => cur_srfcplx%next
116) enddo
117)
118) if (len_trim(reaction%database_filename) < 2) then
119) option%io_buffer = 'Database filename not included in input deck.'
120) call printErrMsg(option)
121) endif
122) input => InputCreate(IUNIT_TEMP,reaction%database_filename,option)
123)
124) ! read temperatures
125) call InputReadPflotranString(input,option)
126) ! remove comment
127) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
128) call InputReadInt(input,option,num_logKs)
129) if (reaction%use_geothermal_hpt) then
130) reaction%num_dbase_parameters = num_logKs
131) call InputErrorMsg(input,option,'Number of database parameters','DATABASE')
132) else
133) reaction%num_dbase_temperatures = num_logKs
134) call InputErrorMsg(input,option,'Number of database temperatures','DATABASE')
135) allocate(reaction%dbase_temperatures(reaction%num_dbase_temperatures))
136) reaction%dbase_temperatures = 0.d0
137)
138) do itemp = 1, reaction%num_dbase_temperatures
139) call InputReadDouble(input,option,reaction%dbase_temperatures(itemp))
140) call InputErrorMsg(input,option,'Database temperatures','DATABASE')
141) enddo
142) endif
143)
144) num_nulls = 0
145) null_name = 'null'
146) do ! loop over every entry in the database
147) call InputReadPflotranString(input,option)
148) call InputReadStringErrorMsg(input,option,'DATABASE')
149)
150) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
151) ! 'null's mark the end of a section in the database. We count these
152) ! to determine which species we are reading.
153) ! --
154) ! primary species
155) ! null
156) ! aq complexes
157) ! null
158) ! gases
159) ! null
160) ! minerals
161) ! null
162) ! surface complexes
163) ! null
164) ! --
165)
166) if (StringCompare(name,null_name,MAXWORDLENGTH)) then
167) num_nulls = num_nulls + 1
168) if (reaction%use_geothermal_hpt) then
169) if (num_nulls >= 4) exit
170) cycle
171) else
172) if (num_nulls >= 5) exit
173) cycle
174) endif
175) endif
176)
177) select case(num_nulls)
178) case(0,1) ! primary and secondary aq species and colloids
179) cur_aq_spec => reaction%primary_species_list
180) found = PETSC_FALSE
181) do
182) if (found .or. .not.associated(cur_aq_spec)) exit
183) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
184) found = PETSC_TRUE
185) ! change negative id to positive, indicating it was found in database
186) cur_aq_spec%id = abs(cur_aq_spec%id)
187) exit
188) endif
189) cur_aq_spec => cur_aq_spec%next
190) enddo
191) if (.not.found) cur_aq_spec => reaction%secondary_species_list
192) do
193) if (found .or. .not.associated(cur_aq_spec)) exit
194) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
195) found = PETSC_TRUE
196) ! change negative id to positive, indicating it was found in database
197) cur_aq_spec%id = abs(cur_aq_spec%id)
198) exit
199) endif
200) cur_aq_spec => cur_aq_spec%next
201) enddo
202) ! check if a colloid
203) if (.not.found) cur_colloid => reaction%colloid_list
204) do
205) if (found .or. .not.associated(cur_colloid)) exit
206) if (StringCompare(name,cur_colloid%name,MAXWORDLENGTH)) then
207) found = PETSC_TRUE
208) ! change negative id to positive, indicating it was found in
209) ! database
210) cur_colloid%id = abs(cur_colloid%id)
211)
212) ! skip the Debye-Huckel ion size parameter (a0)
213) call InputReadDouble(input,option,temp_real)
214) call InputErrorMsg(input,option,'Colloid skip a0','DATABASE')
215) ! skip the valence
216) call InputReadDouble(input,option,temp_real)
217) call InputErrorMsg(input,option,'Colloid skip Z','DATABASE')
218) ! read the molar weight
219) call InputReadDouble(input,option,cur_colloid%molar_weight)
220) call InputErrorMsg(input,option,'Colloid molar weight','DATABASE')
221)
222) cycle ! avoid the aqueous species parameters below
223) endif
224) cur_colloid => cur_colloid%next
225) enddo
226) ! check if immobile
227) if (.not.found) cur_immobile_spec => immobile%list
228) do
229) if (found .or. .not.associated(cur_immobile_spec)) exit
230) if (StringCompare(name,cur_immobile_spec%name,MAXWORDLENGTH)) then
231) found = PETSC_TRUE
232) ! change negative id to positive, indicating it was found in
233) ! database
234) cur_immobile_spec%id = abs(cur_immobile_spec%id)
235)
236) ! skip the Debye-Huckel ion size parameter (a0)
237) call InputReadDouble(input,option,temp_real)
238) call InputErrorMsg(input,option,'Immobile skip a0','DATABASE')
239) ! skip the valence
240) call InputReadDouble(input,option,temp_real)
241) call InputErrorMsg(input,option,'Immobile skip Z','DATABASE')
242) ! read the molar weight
243) call InputReadDouble(input,option,cur_immobile_spec%molar_weight)
244) call InputErrorMsg(input,option,'Immobile molar weight','DATABASE')
245)
246) cycle ! avoid the aqueous species parameters below
247) endif
248) cur_immobile_spec => cur_immobile_spec%next
249) enddo
250)
251) if (.not.found) cycle ! go to next line in database
252)
253) if (num_nulls > 0) then ! secondary species in database
254) ! create aqueous equilibrium reaction
255) if (.not.associated(cur_aq_spec%dbaserxn)) &
256) cur_aq_spec%dbaserxn => DatabaseRxnCreate()
257) ! read the number of primary species in secondary rxn
258) call InputReadInt(input,option,cur_aq_spec%dbaserxn%nspec)
259) call InputErrorMsg(input,option,'Number of species in aqueous ', &
260) 'complex DATABASE')
261) ! allocate arrays for rxn
262) allocate(cur_aq_spec%dbaserxn%spec_name(cur_aq_spec%dbaserxn%nspec))
263) cur_aq_spec%dbaserxn%spec_name = ''
264) allocate(cur_aq_spec%dbaserxn%stoich(cur_aq_spec%dbaserxn%nspec))
265) cur_aq_spec%dbaserxn%stoich = 0.d0
266) allocate(cur_aq_spec%dbaserxn%logK(num_logKs))
267) cur_aq_spec%dbaserxn%logK = 0.d0
268) ! read in species and stoichiometries
269) do ispec = 1, cur_aq_spec%dbaserxn%nspec
270) call InputReadDouble(input,option,cur_aq_spec%dbaserxn%stoich(ispec))
271) call InputErrorMsg(input,option,'EQRXN species stoichiometry','DATABASE')
272) call InputReadQuotedWord(input,option,cur_aq_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
273) call InputErrorMsg(input,option,'EQRXN species name','DATABASE')
274) enddo
275) do itemp = 1, num_logKs
276) call InputReadDouble(input,option,cur_aq_spec%dbaserxn%logK(itemp))
277) call InputErrorMsg(input,option,'EQRXN logKs','DATABASE')
278) enddo
279) endif
280) ! read the Debye-Huckel ion size parameter (a0)
281) call InputReadDouble(input,option,cur_aq_spec%a0)
282) call InputErrorMsg(input,option,'AQ Species a0','DATABASE')
283) ! read the valence
284) call InputReadDouble(input,option,cur_aq_spec%Z)
285) call InputErrorMsg(input,option,'AQ Species Z','DATABASE')
286) ! read the molar weight
287) call InputReadDouble(input,option,cur_aq_spec%molar_weight)
288) call InputErrorMsg(input,option,'AQ Species molar weight','DATABASE')
289)
290)
291) case(2) ! gas species
292) cur_gas_spec => reaction%gas_species_list
293) if (.not.associated(cur_gas_spec)) cycle
294) found = PETSC_FALSE
295) do
296) if (found .or. .not.associated(cur_gas_spec)) exit
297) if (StringCompare(name,cur_gas_spec%name,MAXWORDLENGTH)) then
298) found = PETSC_TRUE
299) ! change negative id to positive, indicating it was found in database
300) cur_gas_spec%id = abs(cur_gas_spec%id)
301) exit
302) endif
303) cur_gas_spec => cur_gas_spec%next
304) enddo
305)
306) if (.not.found) cycle ! go to next line in database
307)
308) ! read the molar volume
309) call InputReadDouble(input,option,cur_gas_spec%molar_volume)
310) call InputErrorMsg(input,option,'GAS molar volume','DATABASE')
311) ! convert from cm^3/mol to m^3/mol
312) cur_gas_spec%molar_volume = cur_gas_spec%molar_volume*1.d-6
313) ! create aqueous equilibrium reaction
314) if (.not.associated(cur_gas_spec%dbaserxn)) &
315) cur_gas_spec%dbaserxn => DatabaseRxnCreate()
316) ! read the number of aqueous species in secondary rxn
317) call InputReadInt(input,option,cur_gas_spec%dbaserxn%nspec)
318) call InputErrorMsg(input,option,'Number of species in gas reaction', &
319) 'DATABASE')
320) ! allocate arrays for rxn
321) allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
322) cur_gas_spec%dbaserxn%spec_name = ''
323) allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
324) cur_gas_spec%dbaserxn%stoich = 0.d0
325) allocate(cur_gas_spec%dbaserxn%logK(num_logKs))
326) cur_gas_spec%dbaserxn%logK = 0.d0
327) ! read in species and stoichiometries
328) do ispec = 1, cur_gas_spec%dbaserxn%nspec
329) call InputReadDouble(input,option,cur_gas_spec%dbaserxn%stoich(ispec))
330) call InputErrorMsg(input,option,'GAS species stoichiometry','DATABASE')
331) call InputReadQuotedWord(input,option,cur_gas_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
332) call InputErrorMsg(input,option,'GAS species name','DATABASE')
333) enddo
334) do itemp = 1, num_logKs
335) call InputReadDouble(input,option,cur_gas_spec%dbaserxn%logK(itemp))
336) call InputErrorMsg(input,option,'GAS logKs','DATABASE')
337) enddo
338) ! read the molar weight
339) call InputReadDouble(input,option,cur_gas_spec%molar_weight)
340) call InputErrorMsg(input,option,'GAS molar weight','DATABASE')
341)
342)
343) case(3) ! minerals
344) cur_mineral => mineral%mineral_list
345) if (.not.associated(cur_mineral)) cycle
346) found = PETSC_FALSE
347) do
348) if (found .or. .not.associated(cur_mineral)) exit
349) if (StringCompare(name,cur_mineral%name,MAXWORDLENGTH)) then
350) found = PETSC_TRUE
351) ! change negative id to positive, indicating it was found in database
352) cur_mineral%id = abs(cur_mineral%id)
353) exit
354) endif
355) cur_mineral => cur_mineral%next
356) enddo
357)
358) if (.not.found) cycle ! go to next line in database
359)
360) call MineralReadFromDatabase(cur_mineral, &
361) num_logKs,input, &
362) option)
363) case(4) ! surface complexes
364) cur_srfcplx => surface_complexation%complex_list
365) found = PETSC_FALSE
366) do
367) if (.not.associated(cur_srfcplx)) exit
368) if (StringCompare(name,cur_srfcplx%name,MAXWORDLENGTH)) then
369) found = PETSC_TRUE
370) ! change negative id to positive, indicating it was found in database
371) cur_srfcplx%id = abs(cur_srfcplx%id)
372) exit
373) endif
374) cur_srfcplx => cur_srfcplx%next
375) enddo
376)
377) if (.not.found) cycle ! go to next line in database
378)
379) if (.not.associated(cur_srfcplx%dbaserxn)) &
380) cur_srfcplx%dbaserxn => DatabaseRxnCreate()
381)
382) ! read the number of aqueous species in surface complexation rxn
383) call InputReadInt(input,option,cur_srfcplx%dbaserxn%nspec)
384) call InputErrorMsg(input,option,'Number of species in surface complexation reaction', &
385) 'DATABASE')
386) ! decrement number of species since free site will not be included
387) cur_srfcplx%dbaserxn%nspec = cur_srfcplx%dbaserxn%nspec - 1
388) ! allocate arrays for rxn
389) allocate(cur_srfcplx%dbaserxn%spec_name(cur_srfcplx%dbaserxn%nspec))
390) cur_srfcplx%dbaserxn%spec_name = ''
391) allocate(cur_srfcplx%dbaserxn%stoich(cur_srfcplx%dbaserxn%nspec))
392) cur_srfcplx%dbaserxn%stoich = 0.d0
393) allocate(cur_srfcplx%dbaserxn%logK(num_logKs))
394) cur_srfcplx%dbaserxn%logK = 0.d0
395) ! read in species and stoichiometries
396) ispec = 0
397) do i = 1, cur_srfcplx%dbaserxn%nspec+1 ! recall that nspec was decremented above
398) call InputReadDouble(input,option,stoich)
399) call InputErrorMsg(input,option,'SURFACE COMPLEX species stoichiometry','DATABASE')
400) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
401) call InputErrorMsg(input,option,'SURFACE COMPLEX species name','DATABASE')
402) ! if (StringCompare(name,cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
403) if (StringStartsWith(name,'>')) then
404) cur_srfcplx%free_site_name = name
405) cur_srfcplx%free_site_stoich = stoich
406) else
407) ispec = ispec + 1
408) cur_srfcplx%dbaserxn%stoich(ispec) = stoich
409) cur_srfcplx%dbaserxn%spec_name(ispec) = name
410) endif
411) enddo
412) do itemp = 1, num_logKs
413) call InputReadDouble(input,option,cur_srfcplx%dbaserxn%logK(itemp))
414) call InputErrorMsg(input,option,'SURFACE COMPLEX logKs','DATABASE')
415) enddo
416) ! read the valence
417) call InputReadDouble(input,option,cur_srfcplx%Z)
418) call InputErrorMsg(input,option,'Surface Complex Z','DATABASE')
419)
420)
421) end select
422)
423) enddo
424)
425) ! check for duplicate species
426) flag = PETSC_FALSE
427)
428) ! aqueous primary species
429) cur_aq_spec => reaction%primary_species_list
430) do
431) if (.not.associated(cur_aq_spec)) exit
432)
433) ! aqueous primary species
434) cur_aq_spec2 => cur_aq_spec%next
435) do
436) if (.not.associated(cur_aq_spec2)) exit
437) if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
438) StringCompare(cur_aq_spec%name, &
439) cur_aq_spec2%name,MAXWORDLENGTH)) then
440) flag = PETSC_TRUE
441) option%io_buffer = &
442) 'Aqueous primary species (' // trim(cur_aq_spec%name) // &
443) ') duplicated in input file.'
444) call printMsg(option)
445) endif
446) cur_aq_spec2 => cur_aq_spec2%next
447) enddo
448)
449) cur_aq_spec2 => reaction%secondary_species_list
450) do
451) if (.not.associated(cur_aq_spec2)) exit
452) if (StringCompare(cur_aq_spec%name, &
453) cur_aq_spec2%name,MAXWORDLENGTH)) then
454) flag = PETSC_TRUE
455) option%io_buffer = 'Aqueous primary species (' // &
456) trim(cur_aq_spec%name) // &
457) ') duplicated as secondary species in input file.'
458) call printMsg(option)
459) endif
460) cur_aq_spec2 => cur_aq_spec2%next
461) enddo
462)
463) cur_gas_spec2 => reaction%gas_species_list
464) do
465) if (.not.associated(cur_gas_spec2)) exit
466) if (StringCompare(cur_aq_spec%name, &
467) cur_gas_spec2%name,MAXWORDLENGTH)) then
468) flag = PETSC_TRUE
469) option%io_buffer = 'Aqueous primary species (' // &
470) trim(cur_aq_spec%name) // &
471) ') duplicated as gas species in input file.'
472) call printMsg(option)
473) endif
474) cur_gas_spec2 => cur_gas_spec2%next
475) enddo
476) cur_aq_spec => cur_aq_spec%next
477) enddo
478)
479) ! aqueous secondary species
480) cur_aq_spec => reaction%secondary_species_list
481) do
482) if (.not.associated(cur_aq_spec)) exit
483)
484) ! already checked against primary
485) ! aqueous secondary species
486) cur_aq_spec2 => cur_aq_spec%next
487) do
488) if (.not.associated(cur_aq_spec2)) exit
489) if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
490) StringCompare(cur_aq_spec%name, &
491) cur_aq_spec2%name,MAXWORDLENGTH)) then
492) flag = PETSC_TRUE
493) option%io_buffer = 'Aqueous secondary species (' // &
494) trim(cur_aq_spec%name) // &
495) ') duplicated in input file.'
496) call printMsg(option)
497) endif
498) cur_aq_spec2 => cur_aq_spec2%next
499) enddo
500)
501) cur_gas_spec2 => reaction%gas_species_list
502) do
503) if (.not.associated(cur_gas_spec2)) exit
504) if (StringCompare(cur_aq_spec%name, &
505) cur_gas_spec2%name,MAXWORDLENGTH)) then
506) flag = PETSC_TRUE
507) option%io_buffer = 'Aqueous secondary species (' // &
508) trim(cur_aq_spec%name) // &
509) ') duplicated as gas species in input file.'
510) call printMsg(option)
511) endif
512) cur_gas_spec2 => cur_gas_spec2%next
513) enddo
514) cur_aq_spec => cur_aq_spec%next
515) enddo
516)
517) ! gas species
518) cur_gas_spec => reaction%gas_species_list
519) do
520) if (.not.associated(cur_aq_spec)) exit
521)
522) ! already checked against primary
523) ! already checked against secondary
524) ! gas species
525) cur_gas_spec2 => cur_gas_spec%next
526) do
527) if (.not.associated(cur_gas_spec2)) exit
528) if (cur_gas_spec%id /= cur_gas_spec2%id .and. &
529) StringCompare(cur_aq_spec%name, &
530) cur_gas_spec2%name,MAXWORDLENGTH)) then
531) flag = PETSC_TRUE
532) option%io_buffer = 'Gas species (' // &
533) trim(cur_aq_spec%name) // &
534) ') duplicated in input file.'
535) call printMsg(option)
536) endif
537) cur_gas_spec2 => cur_gas_spec2%next
538) enddo
539) cur_aq_spec => cur_aq_spec%next
540) enddo
541)
542) ! minerals
543) cur_mineral => mineral%mineral_list
544) do
545) if (.not.associated(cur_mineral)) exit
546) cur_mineral2 => cur_mineral%next
547) do
548) if (.not.associated(cur_mineral2)) exit
549) if (cur_mineral%id /= cur_mineral2%id .and. &
550) StringCompare(cur_mineral%name, &
551) cur_mineral2%name,MAXWORDLENGTH)) then
552) flag = PETSC_TRUE
553) option%io_buffer = 'Mineral (' // &
554) trim(cur_mineral%name) // &
555) ') duplicated in input file.'
556) call printMsg(option)
557) endif
558) cur_mineral2 => cur_mineral2%next
559) enddo
560) cur_mineral => cur_mineral%next
561) enddo
562)
563) ! surface complexes
564) ! ensure that duplicate surface complexes do not exist in master list
565) cur_srfcplx_in_master_list => surface_complexation%complex_list
566) do
567) if (.not.associated(cur_srfcplx_in_master_list)) exit
568) cur_srfcplx2 => cur_srfcplx_in_master_list%next
569) do
570) if (.not.associated(cur_srfcplx2)) exit
571) if (StringCompare(cur_srfcplx_in_master_list%name, &
572) cur_srfcplx2%name,MAXWORDLENGTH)) then
573) flag = PETSC_TRUE
574) option%io_buffer = 'Surface complex (' // &
575) trim(cur_srfcplx2%name) // &
576) ') duplicated in master surface complex list.'
577) call printMsg(option)
578) endif
579) cur_srfcplx2 => cur_srfcplx2%next
580) enddo
581) cur_srfcplx_in_master_list => cur_srfcplx_in_master_list%next
582) enddo
583)
584) ! surface complexation reaction
585) cur_srfcplx_rxn => surface_complexation%rxn_list
586) do
587) if (.not.associated(cur_srfcplx_rxn)) exit
588) cur_srfcplx => cur_srfcplx_rxn%complex_list
589) do
590) if (.not.associated(cur_srfcplx)) exit
591)
592) ! link reaction complexes to those in master complex list
593) cur_srfcplx_in_master_list => surface_complexation%complex_list
594) do
595) if (.not.associated(cur_srfcplx_in_master_list)) exit
596) if (StringCompare(cur_srfcplx%name, &
597) cur_srfcplx_in_master_list%name,MAXWORDLENGTH)) then
598) cur_srfcplx%ptr => cur_srfcplx_in_master_list
599) cur_srfcplx%id = cur_srfcplx_in_master_list%id
600) exit
601) endif
602) cur_srfcplx_in_master_list => cur_srfcplx_in_master_list%next
603) enddo
604) if (.not.associated(cur_srfcplx%ptr)) then
605) option%io_buffer = 'Surface complex "' // &
606) trim(cur_srfcplx%name) // &
607) '" not found in master list.'
608) call printErrMsg(option)
609) endif
610)
611) ! ensure that site listed in reaction matches site in complex
612) ! note that we use %ptr%free_site_name to access the site name of
613) ! the surface complex in the master list
614) if (.not.StringCompare(cur_srfcplx%ptr%free_site_name, &
615) cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
616) ! It is possible that the surface complex may not be found in the
617) ! database. This is caught later. In that case, we need to
618) ! bail out here as the site name will not have been set, but this
619) ! error message misrepresents the issue. If dbaserxn is unassociated,
620) ! the surface complex was not found.
621) if (associated(cur_srfcplx%ptr%dbaserxn)) then
622) option%io_buffer = 'Free site name: ' // &
623) trim(cur_srfcplx_rxn%free_site_name) // &
624) ' not found in surface complex:' // &
625) trim(cur_srfcplx%name)
626) call printErrMsg(option)
627) endif
628) endif
629) ! ensure that duplicate surface complexes do not exist in reaction
630) ! complex list
631) cur_srfcplx2 => cur_srfcplx%next
632) do
633) if (.not.associated(cur_srfcplx2)) exit
634) if (cur_srfcplx%id /= cur_srfcplx2%id .and. &
635) StringCompare(cur_srfcplx%name, &
636) cur_srfcplx2%name,MAXWORDLENGTH)) then
637) flag = PETSC_TRUE
638) option%io_buffer = 'Surface complex (' // &
639) trim(cur_srfcplx2%name) // &
640) ') duplicated in input file surface complex reaction.'
641) call printMsg(option)
642) endif
643) cur_srfcplx2 => cur_srfcplx2%next
644) enddo
645) cur_srfcplx => cur_srfcplx%next
646) enddo
647) cur_srfcplx_rxn => cur_srfcplx_rxn%next
648) enddo
649)
650) if (flag) call printErrMsg(option,'Species duplicated in input file.')
651)
652) ! check that all species, etc. were read
653) ! also check whether legitimate logK values exist if non-isothermal and
654) ! a database reaction exists
655) flag = PETSC_FALSE
656) logK_error_flag = PETSC_FALSE
657) cur_aq_spec => reaction%primary_species_list
658) do
659) if (.not.associated(cur_aq_spec)) exit
660) if (cur_aq_spec%id < 0) then
661) flag = PETSC_TRUE
662) option%io_buffer = 'Aqueous primary species (' // &
663) trim(cur_aq_spec%name) // &
664) ') not found in database.'
665) call printMsg(option)
666) endif
667) if (.not.reaction%use_geothermal_hpt) then
668) if (.not.DatabaseCheckLegitimateLogKs(cur_aq_spec%dbaserxn, &
669) cur_aq_spec%name, &
670) reaction%dbase_temperatures, &
671) option)) then
672) logK_error_flag = PETSC_TRUE
673) endif
674) endif
675) cur_aq_spec => cur_aq_spec%next
676) enddo
677) cur_aq_spec => reaction%secondary_species_list
678) do
679) if (.not.associated(cur_aq_spec)) exit
680) if (cur_aq_spec%id < 0) then
681) flag = PETSC_TRUE
682) option%io_buffer = &
683) 'Aqueous secondary species (' // trim(cur_aq_spec%name) // &
684) ') not found in database.'
685) call printMsg(option)
686) endif
687) if (.not.reaction%use_geothermal_hpt) then
688) if (.not.DatabaseCheckLegitimateLogKs(cur_aq_spec%dbaserxn, &
689) cur_aq_spec%name, &
690) reaction%dbase_temperatures, &
691) option)) then
692) logK_error_flag = PETSC_TRUE
693) endif
694) endif
695) cur_aq_spec => cur_aq_spec%next
696) enddo
697) cur_gas_spec => reaction%gas_species_list
698) do
699) if (.not.associated(cur_gas_spec)) exit
700) if (cur_gas_spec%id < 0) then
701) flag = PETSC_TRUE
702) option%io_buffer = 'Gas species (' // trim(cur_gas_spec%name) // &
703) ') not found in database.'
704) call printMsg(option)
705) endif
706) if (.not.reaction%use_geothermal_hpt) then
707) if (.not.DatabaseCheckLegitimateLogKs(cur_gas_spec%dbaserxn, &
708) cur_gas_spec%name, &
709) reaction%dbase_temperatures, &
710) option)) then
711) logK_error_flag = PETSC_TRUE
712) endif
713) endif
714) cur_gas_spec => cur_gas_spec%next
715) enddo
716) cur_mineral => mineral%mineral_list
717) do
718) if (.not.associated(cur_mineral)) exit
719) if (cur_mineral%id < 0) then
720) flag = PETSC_TRUE
721) option%io_buffer = 'Mineral (' // trim(cur_mineral%name) // &
722) ') not found in database.'
723) call printErrMsg(option)
724) endif
725) if (.not.reaction%use_geothermal_hpt) then
726) if (.not.DatabaseCheckLegitimateLogKs(cur_mineral%dbaserxn, &
727) cur_mineral%name, &
728) reaction%dbase_temperatures, &
729) option)) then
730) logK_error_flag = PETSC_TRUE
731) endif
732) endif
733) cur_mineral => cur_mineral%next
734) enddo
735) cur_srfcplx => surface_complexation%complex_list
736) do
737) if (.not.associated(cur_srfcplx)) exit
738) if (cur_srfcplx%id < 0) then
739) flag = PETSC_TRUE
740) option%io_buffer = 'Surface species (' // trim(cur_srfcplx%name) // &
741) ') not found in database.'
742) call printMsg(option)
743) endif
744) if (.not.reaction%use_geothermal_hpt) then
745) if (.not.DatabaseCheckLegitimateLogKs(cur_srfcplx%dbaserxn, &
746) cur_srfcplx%name, &
747) reaction%dbase_temperatures, &
748) option)) then
749) logK_error_flag = PETSC_TRUE
750) endif
751) endif
752) cur_srfcplx => cur_srfcplx%next
753) enddo
754)
755) if (flag) call printErrMsg(option,'Species not found in database.')
756) if (.not.option%use_isothermal) then
757) !geh: only stop if running with temperature dependent log Ks.
758) if (logK_error_flag) then
759) option%io_buffer = 'Non-isothermal reactions not possible due to ' // &
760) 'missing logKs in database.'
761) call printErrMsg(option)
762) endif
763) endif
764)
765) call InputDestroy(input)
766)
767) end subroutine DatabaseRead
768)
769) ! ************************************************************************** !
770)
771) subroutine BasisInit(reaction,option)
772) !
773) ! Initializes the basis for geochemistry
774) !
775) ! Author: Glenn Hammond
776) ! Date: 09/01/08
777) !
778)
779) use Option_module
780) use String_module
781) use Utility_module
782) use Input_Aux_module
783)
784) use Reaction_Surface_Complexation_Aux_module
785) use Reaction_Mineral_Aux_module
786) use Reaction_Microbial_Aux_module
787) use Reaction_Immobile_Aux_module
788)
789) #ifdef SOLID_SOLUTION
790) use Reaction_Solid_Solution_module
791) #endif
792) use Reaction_Sandbox_module
793) use CLM_Rxn_module
794)
795) implicit none
796)
797) type(reaction_type) :: reaction
798) type(option_type) :: option
799)
800) type(aq_species_type), pointer :: cur_aq_spec
801) type(aq_species_type), pointer :: cur_pri_aq_spec
802) type(aq_species_type), pointer :: cur_sec_aq_spec
803) type(gas_species_type), pointer :: cur_gas_spec
804) type(mineral_rxn_type), pointer :: cur_mineral
805) type(aq_species_type), pointer :: cur_sec_aq_spec1
806) type(aq_species_type), pointer :: cur_sec_aq_spec2
807) type(gas_species_type), pointer :: cur_gas_spec1
808) type(gas_species_type), pointer :: cur_gas_spec2
809) type(immobile_species_type), pointer :: cur_immobile_spec
810) type(surface_complexation_type), pointer :: surface_complexation
811) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
812) type(surface_complex_type), pointer :: cur_srfcplx, cur_srfcplx_in_rxn
813) type(surface_complex_type), pointer :: cur_srfcplx2
814) type(ion_exchange_rxn_type), pointer :: cur_ionx_rxn
815) type(ion_exchange_cation_type), pointer :: cur_cation
816) type(general_rxn_type), pointer :: cur_general_rxn
817) type(radioactive_decay_rxn_type), pointer :: cur_radiodecay_rxn
818) type(microbial_rxn_type), pointer :: cur_microbial_rxn
819) type(immobile_decay_rxn_type), pointer :: cur_immobile_decay_rxn
820) type(kd_rxn_type), pointer :: cur_kd_rxn, sec_cont_cur_kd_rxn
821) type(colloid_type), pointer :: cur_colloid
822) type(database_rxn_type), pointer :: dbaserxn
823) type(transition_state_rxn_type), pointer :: tstrxn
824) type(transition_state_prefactor_type), pointer :: cur_prefactor
825) type(ts_prefactor_species_type), pointer :: cur_prefactor_species
826) type(monod_type), pointer :: cur_monod
827) type(inhibition_type), pointer :: cur_inhibition
828) type(mineral_type), pointer :: mineral
829) type(microbial_type), pointer :: microbial
830) type(immobile_type), pointer :: immobile
831)
832) character(len=MAXWORDLENGTH), allocatable :: old_basis_names(:)
833) character(len=MAXWORDLENGTH), allocatable :: new_basis_names(:)
834)
835) character(len=MAXWORDLENGTH), parameter :: h2oname = 'H2O'
836) character(len=MAXWORDLENGTH) :: word, word2
837) character(len=MAXSTRINGLENGTH) :: string, string2
838)
839) PetscInt, parameter :: h2o_id = 1
840)
841) PetscReal :: logK(reaction%num_dbase_temperatures)
842) PetscReal, allocatable :: transformation(:,:), old_basis(:,:), new_basis(:,:)
843) PetscReal, allocatable :: stoich_new(:), stoich_prev(:), logKvector(:,:)
844) PetscInt, allocatable :: indices(:)
845)
846) PetscReal, allocatable :: pri_matrix(:,:), sec_matrix(:,:)
847) PetscReal, allocatable :: sec_matrix_inverse(:,:)
848) PetscReal, allocatable :: stoich_matrix(:,:)
849) PetscReal, allocatable :: unit_vector(:)
850) character(len=MAXWORDLENGTH), allocatable :: pri_names(:)
851) character(len=MAXWORDLENGTH), allocatable :: sec_names(:)
852) character(len=MAXWORDLENGTH), allocatable :: gas_names(:)
853) PetscReal, allocatable :: logKvector_swapped(:,:)
854) PetscBool, allocatable :: colloid_species_flag(:)
855) PetscReal :: value
856)
857) PetscInt :: ispec, itemp
858) PetscInt :: spec_id
859) PetscInt :: ncomp_h2o, ncomp_secondary
860) PetscInt :: icount_old, icount_new, icount, icount2, icount3
861) PetscInt :: i, j, irow, icol
862) PetscInt :: icomp, icplx, irxn, ieqrxn
863) PetscInt :: ipri_spec, isec_spec, imnrl, igas_spec, ikinmnrl, icoll
864) PetscInt :: i_old, i_new
865) PetscInt :: isrfcplx
866) PetscInt :: ication
867) PetscInt :: temp_int
868) PetscReal :: scale
869) PetscReal :: temp_high, temp_low
870) PetscInt :: itemp_high, itemp_low
871) PetscInt :: species_count, max_species_count
872) PetscInt :: max_monod_count, max_inhibition_count
873) PetscInt :: monod_count, inhibition_count, activation_energy_count
874) PetscInt :: forward_count, max_forward_count
875) PetscInt :: backward_count, max_backward_count
876) PetscInt :: max_aq_species
877) PetscInt :: max_num_prefactors, max_num_prefactor_species
878)
879) PetscBool :: compute_new_basis
880) PetscBool :: found
881) PetscErrorCode :: ierr
882) PetscInt :: num_logKs
883)
884) surface_complexation => reaction%surface_complexation
885) mineral => reaction%mineral
886) microbial => reaction%microbial
887) immobile => reaction%immobile
888)
889) if (reaction%use_geothermal_hpt) then
890) num_logKs = reaction%num_dbase_parameters
891) else
892) num_logKs = reaction%num_dbase_temperatures
893) endif
894)
895) ! get database temperature based on REFERENCE_TEMPERATURE
896) if (option%reference_temperature <= 0.01d0) then
897) reaction%debyeA = 0.4939d0
898) reaction%debyeB = 0.3253d0
899) reaction%debyeBdot = 0.0374d0
900) else if (option%reference_temperature > 0.d0 .and. &
901) option%reference_temperature <= 25.d0) then
902) temp_low = 0.d0
903) temp_high = 25.d0
904) call Interpolate(temp_high,temp_low,option%reference_temperature, &
905) 0.5114d0,0.4939d0,reaction%debyeA)
906) call Interpolate(temp_high,temp_low,option%reference_temperature, &
907) 0.3288d0,0.3253d0,reaction%debyeB)
908) call Interpolate(temp_high,temp_low,option%reference_temperature, &
909) 0.0410d0,0.0374d0,reaction%debyeBdot)
910) else if (option%reference_temperature > 25.d0 .and. &
911) option%reference_temperature <= 60.d0) then
912) temp_low = 25.d0
913) temp_high = 60.d0
914) call Interpolate(temp_high,temp_low,option%reference_temperature, &
915) 0.5465d0,0.5114d0,reaction%debyeA)
916) call Interpolate(temp_high,temp_low,option%reference_temperature, &
917) 0.3346d0,0.3288d0,reaction%debyeB)
918) call Interpolate(temp_high,temp_low,option%reference_temperature, &
919) 0.0440d0,0.0410d0,reaction%debyeBdot)
920) else if (option%reference_temperature > 60.d0 .and. &
921) option%reference_temperature <= 100.d0) then
922) temp_low = 60.d0
923) temp_high = 100.d0
924) call Interpolate(temp_high,temp_low,option%reference_temperature, &
925) 0.5995d0,0.5465d0,reaction%debyeA)
926) call Interpolate(temp_high,temp_low,option%reference_temperature, &
927) 0.3421d0,0.3346d0,reaction%debyeB)
928) call Interpolate(temp_high,temp_low,option%reference_temperature, &
929) 0.0460d0,0.0440d0,reaction%debyeBdot)
930) else if (option%reference_temperature > 100.d0 .and. &
931) option%reference_temperature <= 150.d0) then
932) temp_low = 100.d0
933) temp_high = 150.d0
934) call Interpolate(temp_high,temp_low,option%reference_temperature, &
935) 0.6855d0,0.5995d0,reaction%debyeA)
936) call Interpolate(temp_high,temp_low,option%reference_temperature, &
937) 0.3525d0,0.3421d0,reaction%debyeB)
938) call Interpolate(temp_high,temp_low,option%reference_temperature, &
939) 0.0470d0,0.0460d0,reaction%debyeBdot)
940) else if (option%reference_temperature > 150.d0 .and. &
941) option%reference_temperature <= 200.d0) then
942) temp_low = 150.d0
943) temp_high = 200.d0
944) call Interpolate(temp_high,temp_low,option%reference_temperature, &
945) 0.7994d0,0.6855d0,reaction%debyeA)
946) call Interpolate(temp_high,temp_low,option%reference_temperature, &
947) 0.3639d0,0.3525d0,reaction%debyeB)
948) call Interpolate(temp_high,temp_low,option%reference_temperature, &
949) 0.0470d0,0.0470d0,reaction%debyeBdot)
950) else if (option%reference_temperature > 200.d0 .and. &
951) option%reference_temperature <= 250.d0) then
952) temp_low = 200.d0
953) temp_high = 250.d0
954) call Interpolate(temp_high,temp_low,option%reference_temperature, &
955) 0.9593d0,0.7994d0,reaction%debyeA)
956) call Interpolate(temp_high,temp_low,option%reference_temperature, &
957) 0.3766d0,0.3639d0,reaction%debyeB)
958) call Interpolate(temp_high,temp_low,option%reference_temperature, &
959) 0.0340d0,0.0470d0,reaction%debyeBdot)
960) else if (option%reference_temperature > 250.d0 .and. &
961) option%reference_temperature <= 300.d0) then
962) temp_low = 250.d0
963) temp_high = 300.d0
964) call Interpolate(temp_high,temp_low,option%reference_temperature, &
965) 1.2180d0,0.9593d0,reaction%debyeA)
966) call Interpolate(temp_high,temp_low,option%reference_temperature, &
967) 0.3925d0,0.3766d0,reaction%debyeB)
968) call Interpolate(temp_high,temp_low,option%reference_temperature, &
969) 0.0000d0,0.0340d0,reaction%debyeBdot)
970) else if (option%reference_temperature > 300.d0 .and. &
971) option%reference_temperature <= 350.d0) then
972) temp_low = 300.d0
973) temp_high = 350.d0
974) call Interpolate(temp_high,temp_low,option%reference_temperature, &
975) 1.2180d0,1.2180d0,reaction%debyeA)
976) call Interpolate(temp_high,temp_low,option%reference_temperature, &
977) 0.3925d0,0.3925d0,reaction%debyeB)
978) call Interpolate(temp_high,temp_low,option%reference_temperature, &
979) 0.0000d0,0.0000d0,reaction%debyeBdot)
980) else if (option%reference_temperature > 350.d0) then
981) reaction%debyeA = 1.2180d0
982) reaction%debyeB = 0.3925d0
983) reaction%debyeBdot = 0.0000d0
984) endif
985)
986) if (.not.reaction%act_coef_use_bdot) then
987) reaction%debyeBdot = 0.d0
988) endif
989)
990) if (.not. reaction%use_geothermal_hpt) then
991) if (option%reference_temperature <= reaction%dbase_temperatures(1)) then
992) itemp_low = 1
993) itemp_high = 1
994) temp_low = reaction%dbase_temperatures(itemp_low)
995) temp_high = reaction%dbase_temperatures(itemp_high)
996) else if (option%reference_temperature > &
997) reaction%dbase_temperatures(reaction%num_dbase_temperatures)) then
998) itemp_low = reaction%num_dbase_temperatures
999) itemp_high = reaction%num_dbase_temperatures
1000) temp_low = reaction%dbase_temperatures(itemp_low)
1001) temp_high = reaction%dbase_temperatures(itemp_high)
1002) else
1003) do itemp = 1, reaction%num_dbase_temperatures-1
1004) itemp_low = itemp
1005) itemp_high = itemp+1
1006) temp_low = reaction%dbase_temperatures(itemp_low)
1007) temp_high = reaction%dbase_temperatures(itemp_high)
1008) if (option%reference_temperature > temp_low .and. &
1009) option%reference_temperature <= temp_high) then
1010) exit
1011) endif
1012) enddo
1013) endif
1014) endif
1015)
1016) reaction%naqcomp = GetPrimarySpeciesCount(reaction)
1017) reaction%neqcplx = GetSecondarySpeciesCount(reaction)
1018) reaction%ngas = GetGasCount(reaction)
1019) reaction%nimcomp = GetImmobileCount(reaction)
1020) reaction%ncoll = GetColloidCount(reaction)
1021) reaction%ncollcomp = reaction%naqcomp ! set to naqcomp for now, will be adjusted later
1022)
1023) reaction%offset_aqueous = 0
1024) reaction%offset_immobile = reaction%offset_aqueous + reaction%naqcomp
1025) reaction%offset_colloid = reaction%offset_immobile + reaction%nimcomp
1026) reaction%offset_collcomp = reaction%offset_colloid + reaction%ncoll
1027)
1028) ! account for H2O in the basis by adding 1
1029) ncomp_h2o = reaction%naqcomp+1
1030)
1031) allocate(old_basis_names(ncomp_h2o+reaction%neqcplx))
1032) allocate(new_basis_names(ncomp_h2o))
1033) old_basis_names = ''
1034) new_basis_names = ''
1035)
1036) call BasisPrint(reaction,'Initial Basis',option)
1037)
1038) !--------------------------------------------
1039)
1040) ! for now, remove equilibrium reactions from any primary species that are
1041) ! flagged as "redox"
1042) cur_aq_spec => reaction%primary_species_list
1043) do
1044) if (.not.associated(cur_aq_spec)) exit
1045) if (cur_aq_spec%is_redox .and. associated(cur_aq_spec%dbaserxn)) then
1046) call DatabaseRxnDestroy(cur_aq_spec%dbaserxn)
1047) endif
1048) cur_aq_spec => cur_aq_spec%next
1049) enddo
1050)
1051) ncomp_secondary = reaction%neqcplx+reaction%ngas
1052)
1053) ! check to ensure that the number of secondary aqueous and gas species
1054) ! (i.e. those with a reaction defined from the database) is equal to the
1055) ! number of reactions read from the database. If not, send an error
1056) ! message.
1057)
1058) icount = 0
1059) cur_pri_aq_spec => reaction%primary_species_list
1060) do
1061) if (.not.associated(cur_pri_aq_spec)) exit
1062) if (associated(cur_pri_aq_spec%dbaserxn)) then
1063) icount = icount + 1
1064) endif
1065) cur_pri_aq_spec => cur_pri_aq_spec%next
1066) enddo
1067)
1068) cur_sec_aq_spec => reaction%secondary_species_list
1069) do
1070) if (.not.associated(cur_sec_aq_spec)) exit
1071) if (associated(cur_sec_aq_spec%dbaserxn)) then
1072) icount = icount + 1
1073) endif
1074) cur_sec_aq_spec => cur_sec_aq_spec%next
1075) enddo
1076)
1077) cur_gas_spec => reaction%gas_species_list
1078) do
1079) if (.not.associated(cur_gas_spec)) exit
1080) if (associated(cur_gas_spec%dbaserxn)) then
1081) icount = icount + 1
1082) endif
1083) cur_gas_spec => cur_gas_spec%next
1084) enddo
1085)
1086) if (icount /= ncomp_secondary) then
1087) if (icount < ncomp_secondary) then
1088) option%io_buffer = 'Too few reactions read from database for ' // &
1089) 'number of secondary species defined.'
1090) else
1091) option%io_buffer = 'Too many reactions read from database for ' // &
1092) 'number of secondary species defined. Perhaps REDOX ' // &
1093) 'SPECIES need to be defined?'
1094) endif
1095) call printErrMsg(option)
1096) endif
1097)
1098) allocate(pri_matrix(ncomp_secondary,ncomp_h2o))
1099) pri_matrix = 0.d0
1100) allocate(pri_names(ncomp_h2o))
1101) pri_names = ''
1102) allocate(sec_matrix(ncomp_secondary,ncomp_secondary))
1103) sec_matrix = 0.d0
1104) allocate(sec_names(reaction%neqcplx))
1105) sec_names = ''
1106) allocate(gas_names(reaction%ngas))
1107) gas_names = ''
1108)
1109) allocate(logKvector(num_logKs,ncomp_secondary))
1110) logKvector = 0.d0
1111)
1112) ! fill in names
1113) icount = 1
1114) pri_names(icount) = h2oname
1115) cur_aq_spec => reaction%primary_species_list
1116) do
1117) if (.not.associated(cur_aq_spec)) exit
1118) icount = icount + 1
1119) pri_names(icount) = cur_aq_spec%name
1120) cur_aq_spec => cur_aq_spec%next
1121) enddo
1122) icount = 0
1123) cur_aq_spec => reaction%secondary_species_list
1124) do
1125) if (.not.associated(cur_aq_spec)) exit
1126) icount = icount + 1
1127) sec_names(icount) = cur_aq_spec%name
1128) cur_aq_spec => cur_aq_spec%next
1129) enddo
1130) icount= 0
1131) cur_gas_spec => reaction%gas_species_list
1132) do
1133) if (.not.associated(cur_gas_spec)) exit
1134) icount = icount + 1
1135) gas_names(icount) = cur_gas_spec%name
1136) cur_gas_spec => cur_gas_spec%next
1137) enddo
1138)
1139) ! fill in matrices
1140) icount = 0
1141) cur_pri_aq_spec => reaction%primary_species_list
1142) do
1143) if (.not.associated(cur_pri_aq_spec)) exit
1144) if (associated(cur_pri_aq_spec%dbaserxn)) then
1145) icount = icount + 1
1146) logKvector(:,icount) = cur_pri_aq_spec%dbaserxn%logK
1147) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1148) cur_pri_aq_spec%name, &
1149) cur_pri_aq_spec%name, &
1150) pri_names,sec_names,gas_names)
1151) if (i < 0) then
1152) option%io_buffer = 'Primary species ' // &
1153) trim(cur_pri_aq_spec%name) // &
1154) ' found in secondary or gas list.'
1155) call printErrMsg(option)
1156) endif
1157) pri_matrix(icount,i) = -1.d0
1158) do ispec=1,cur_pri_aq_spec%dbaserxn%nspec
1159) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1160) cur_pri_aq_spec%name, &
1161) cur_pri_aq_spec%dbaserxn%spec_name(ispec), &
1162) pri_names,sec_names,gas_names)
1163) if (i > 0) then
1164) pri_matrix(icount,i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
1165) else
1166) sec_matrix(icount,-i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
1167) endif
1168) enddo
1169) endif
1170) cur_pri_aq_spec => cur_pri_aq_spec%next
1171) enddo
1172)
1173) cur_sec_aq_spec => reaction%secondary_species_list
1174) do
1175) if (.not.associated(cur_sec_aq_spec)) exit
1176) if (associated(cur_sec_aq_spec%dbaserxn)) then
1177) icount = icount + 1
1178) logKvector(:,icount) = cur_sec_aq_spec%dbaserxn%logK
1179) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1180) cur_sec_aq_spec%name, &
1181) cur_sec_aq_spec%name, &
1182) pri_names,sec_names,gas_names)
1183) if (i > 0) then
1184) option%io_buffer = 'Secondary aqueous species ' // &
1185) trim(cur_sec_aq_spec%name) // &
1186) ' found in primary species list.'
1187) call printErrMsg(option)
1188) endif
1189) sec_matrix(icount,-i) = -1.d0
1190) do ispec=1,cur_sec_aq_spec%dbaserxn%nspec
1191) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1192) cur_sec_aq_spec%name, &
1193) cur_sec_aq_spec%dbaserxn%spec_name(ispec), &
1194) pri_names,sec_names,gas_names)
1195) if (i > 0) then
1196) pri_matrix(icount,i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
1197) else
1198) sec_matrix(icount,-i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
1199) endif
1200) enddo
1201) endif
1202) cur_sec_aq_spec => cur_sec_aq_spec%next
1203) enddo
1204)
1205) cur_gas_spec => reaction%gas_species_list
1206) do
1207) if (.not.associated(cur_gas_spec)) exit
1208) if (associated(cur_gas_spec%dbaserxn)) then
1209) icount = icount + 1
1210) logKvector(:,icount) = cur_gas_spec%dbaserxn%logK
1211) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1212) cur_gas_spec%name, &
1213) cur_gas_spec%name, &
1214) pri_names,sec_names,gas_names)
1215) if (i > 0) then
1216) option%io_buffer = 'Gas species ' // &
1217) trim(cur_gas_spec%name) // &
1218) ' found in primary species list.'
1219) call printErrMsg(option)
1220) endif
1221) sec_matrix(icount,-i) = -1.d0
1222) do ispec=1,cur_gas_spec%dbaserxn%nspec
1223) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1224) cur_gas_spec%name, &
1225) cur_gas_spec%dbaserxn%spec_name(ispec), &
1226) pri_names,sec_names,gas_names)
1227) if (i > 0) then
1228) pri_matrix(icount,i) = cur_gas_spec%dbaserxn%stoich(ispec)
1229) else
1230) sec_matrix(icount,-i) = cur_gas_spec%dbaserxn%stoich(ispec)
1231) endif
1232) enddo
1233) endif
1234) cur_gas_spec => cur_gas_spec%next
1235) enddo
1236)
1237) allocate(indices(ncomp_secondary))
1238) indices = 0
1239) allocate(unit_vector(ncomp_secondary))
1240) unit_vector = 0.d0
1241) allocate(sec_matrix_inverse(ncomp_secondary,ncomp_secondary))
1242) sec_matrix_inverse = 0.d0
1243)
1244) call ludcmp(sec_matrix,ncomp_secondary,indices,temp_int)
1245) do ispec = 1, ncomp_secondary
1246) unit_vector = 0.d0
1247) unit_vector(ispec) = 1.d0
1248) call lubksb(sec_matrix,ncomp_secondary,indices,unit_vector)
1249) sec_matrix_inverse(:,ispec) = unit_vector(:)
1250) enddo
1251)
1252) ! invert the secondary species matrix
1253) allocate(stoich_matrix(ncomp_secondary,ncomp_h2o))
1254) stoich_matrix = 0.d0
1255) do j = 1, ncomp_h2o
1256) do i = 1, ncomp_secondary
1257) do ispec = 1, ncomp_secondary
1258) stoich_matrix(i,j) = stoich_matrix(i,j) + &
1259) sec_matrix_inverse(i,ispec)*pri_matrix(ispec,j)
1260) enddo
1261) enddo
1262) enddo
1263) stoich_matrix = -1.d0*stoich_matrix
1264)
1265) allocate(logKvector_swapped(num_logKs,ncomp_secondary))
1266) logKvector_swapped = 0.d0
1267)
1268) do j = 1, ncomp_secondary
1269) do i = 1, num_logKs
1270) logKvector_swapped(i,j) = logKvector_swapped(i,j) - &
1271) dot_product(sec_matrix_inverse(j,1:ncomp_secondary), &
1272) logKvector(i,1:ncomp_secondary))
1273) enddo
1274) enddo
1275)
1276) deallocate(pri_matrix)
1277) deallocate(sec_matrix)
1278) deallocate(indices)
1279) deallocate(unit_vector)
1280) deallocate(sec_matrix_inverse)
1281) deallocate(logKvector)
1282)
1283) cur_pri_aq_spec => reaction%primary_species_list
1284) do
1285) if (.not.associated(cur_pri_aq_spec)) exit
1286) if (associated(cur_pri_aq_spec%dbaserxn)) then
1287) call DatabaseRxnDestroy(cur_pri_aq_spec%dbaserxn)
1288) endif
1289) cur_pri_aq_spec => cur_pri_aq_spec%next
1290) enddo
1291)
1292) icount = 0
1293) cur_sec_aq_spec => reaction%secondary_species_list
1294) do
1295) if (.not.associated(cur_sec_aq_spec)) exit
1296) icount = icount + 1
1297) ! destory old reaction
1298) call DatabaseRxnDestroy(cur_sec_aq_spec%dbaserxn)
1299) ! allocate new
1300) cur_sec_aq_spec%dbaserxn => DatabaseRxnCreate()
1301)
1302) ! count # of species in reaction
1303) icount2 = 0
1304) do icol = 1, ncomp_h2o
1305) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1306) cur_sec_aq_spec%dbaserxn%nspec = cur_sec_aq_spec%dbaserxn%nspec + 1
1307) endif
1308) enddo
1309)
1310) allocate(cur_sec_aq_spec%dbaserxn%stoich(cur_sec_aq_spec%dbaserxn%nspec))
1311) cur_sec_aq_spec%dbaserxn%stoich = 0.d0
1312) allocate(cur_sec_aq_spec%dbaserxn%spec_name(cur_sec_aq_spec%dbaserxn%nspec))
1313) cur_sec_aq_spec%dbaserxn%spec_name = ''
1314) allocate(cur_sec_aq_spec%dbaserxn%spec_ids(cur_sec_aq_spec%dbaserxn%nspec))
1315) cur_sec_aq_spec%dbaserxn%spec_ids = 0
1316) allocate(cur_sec_aq_spec%dbaserxn%logK(num_logKs))
1317) cur_sec_aq_spec%dbaserxn%logK = 0.d0
1318)
1319) ispec = 0
1320) do icol = 1, ncomp_h2o
1321) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1322) ispec = ispec + 1
1323) cur_sec_aq_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
1324) cur_sec_aq_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
1325) cur_sec_aq_spec%dbaserxn%spec_ids(ispec) = icol
1326) endif
1327) enddo
1328)
1329) cur_sec_aq_spec%dbaserxn%logK = logKvector_swapped(:,icount)
1330)
1331) cur_sec_aq_spec => cur_sec_aq_spec%next
1332) enddo
1333)
1334) cur_gas_spec => reaction%gas_species_list
1335) do
1336) if (.not.associated(cur_gas_spec)) exit
1337) icount = icount + 1
1338) ! destory old reaction
1339) call DatabaseRxnDestroy(cur_gas_spec%dbaserxn)
1340) ! allocate new
1341) cur_gas_spec%dbaserxn => DatabaseRxnCreate()
1342)
1343) ! count # of species in reaction
1344) icount2 = 0
1345) do icol = 1, ncomp_h2o
1346) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1347) cur_gas_spec%dbaserxn%nspec = cur_gas_spec%dbaserxn%nspec + 1
1348) endif
1349) enddo
1350)
1351) allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
1352) cur_gas_spec%dbaserxn%stoich = 0.d0
1353) allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
1354) cur_gas_spec%dbaserxn%spec_name = ''
1355) allocate(cur_gas_spec%dbaserxn%spec_ids(cur_gas_spec%dbaserxn%nspec))
1356) cur_gas_spec%dbaserxn%spec_ids = 0
1357) allocate(cur_gas_spec%dbaserxn%logK(num_logKs))
1358) cur_gas_spec%dbaserxn%logK = 0.d0
1359)
1360) ispec = 0
1361) do icol = 1, ncomp_h2o
1362) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1363) ispec = ispec + 1
1364) cur_gas_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
1365) cur_gas_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
1366) cur_gas_spec%dbaserxn%spec_ids(ispec) = icol
1367) endif
1368) enddo
1369)
1370) cur_gas_spec%dbaserxn%logK = logKvector_swapped(:,icount)
1371)
1372) cur_gas_spec => cur_gas_spec%next
1373) enddo
1374)
1375) new_basis_names = pri_names
1376)
1377) deallocate(stoich_matrix)
1378) deallocate(logKvector_swapped)
1379)
1380) deallocate(pri_names)
1381) deallocate(sec_names)
1382) deallocate(gas_names)
1383)
1384) nullify(cur_sec_aq_spec)
1385) nullify(cur_gas_spec)
1386) nullify(cur_mineral)
1387) nullify(cur_srfcplx_rxn)
1388) nullify(cur_srfcplx)
1389)
1390) ! first off, lets remove all the secondary gases from all other reactions
1391) cur_gas_spec => reaction%gas_species_list
1392) do
1393) if (.not.associated(cur_gas_spec)) exit
1394)
1395) ! gases in mineral reactions
1396) cur_mineral => mineral%mineral_list
1397) do
1398) if (.not.associated(cur_mineral)) exit
1399)
1400) if (associated(cur_mineral%tstrxn)) then
1401) ispec = 1
1402) do
1403) if (ispec > cur_mineral%dbaserxn%nspec) exit
1404) if (StringCompare(cur_gas_spec%name, &
1405) cur_mineral%dbaserxn%spec_name(ispec), &
1406) MAXWORDLENGTH)) then
1407) call BasisSubSpeciesInMineralRxn(cur_gas_spec%name, &
1408) cur_gas_spec%dbaserxn, &
1409) cur_mineral%dbaserxn, &
1410) scale)
1411) !geh cur_mineral%dbaserxn%logK = cur_mineral%dbaserxn%logK &
1412) !geh + scale*cur_gas_spec%dbaserxn%logK
1413) ispec = 0
1414) endif
1415) ispec = ispec + 1
1416) enddo
1417) endif
1418) cur_mineral => cur_mineral%next
1419) enddo
1420) nullify(cur_mineral)
1421)
1422) ! gases in surface complex reactions
1423) cur_srfcplx2 => surface_complexation%complex_list
1424) do
1425) if (.not.associated(cur_srfcplx2)) exit
1426) if (associated(cur_srfcplx2%dbaserxn)) then
1427) ispec = 1
1428) do
1429) if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
1430) if (StringCompare(cur_gas_spec%name, &
1431) cur_srfcplx2%dbaserxn%spec_name(ispec), &
1432) MAXWORDLENGTH)) then
1433) call BasisSubSpeciesInGasOrSecRxn(cur_gas_spec%name, &
1434) cur_gas_spec%dbaserxn, &
1435) cur_srfcplx2%dbaserxn, &
1436) scale)
1437) !geh cur_srfcplx2%dbaserxn%logK=cur_srfcplx2%dbaserxn%logK &
1438) !geh + scale *cur_gas_spec%dbaserxn%logK
1439) ispec = 0
1440) endif
1441) ispec = ispec + 1
1442) enddo
1443) endif
1444) cur_srfcplx2 => cur_srfcplx2%next
1445) enddo
1446) nullify(cur_srfcplx2)
1447)
1448) cur_gas_spec => cur_gas_spec%next
1449) enddo
1450)
1451) nullify(cur_sec_aq_spec)
1452) nullify(cur_gas_spec)
1453) nullify(cur_mineral)
1454) nullify(cur_srfcplx_rxn)
1455) nullify(cur_srfcplx)
1456)
1457) ! secondary aqueous species
1458) cur_sec_aq_spec => reaction%secondary_species_list
1459) do
1460)
1461) if (.not.associated(cur_sec_aq_spec)) exit
1462)
1463) ! secondary aqueous species in mineral reactions
1464) cur_mineral => mineral%mineral_list
1465) do
1466) if (.not.associated(cur_mineral)) exit
1467)
1468) if (associated(cur_mineral%tstrxn)) then
1469) ispec = 1
1470) do
1471) if (ispec > cur_mineral%dbaserxn%nspec) exit
1472) if (StringCompare(cur_sec_aq_spec%name, &
1473) cur_mineral%dbaserxn%spec_name(ispec), &
1474) MAXWORDLENGTH)) then
1475) call BasisSubSpeciesInMineralRxn(cur_sec_aq_spec%name, &
1476) cur_sec_aq_spec%dbaserxn, &
1477) cur_mineral%dbaserxn, &
1478) scale)
1479) !geh cur_mineral%dbaserxn%logK = cur_mineral%dbaserxn%logK &
1480) !geh + scale*cur_sec_aq_spec%dbaserxn%logK
1481) ispec = 0
1482) endif
1483) ispec = ispec + 1
1484) enddo
1485) endif
1486) cur_mineral => cur_mineral%next
1487) enddo
1488)
1489) ! secondary aqueous species in surface complex reactions
1490) cur_srfcplx2 => surface_complexation%complex_list
1491) do
1492) if (.not.associated(cur_srfcplx2)) exit
1493) if (associated(cur_srfcplx2%dbaserxn)) then
1494) ispec = 1
1495) do
1496) if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
1497) if (StringCompare(cur_sec_aq_spec%name, &
1498) cur_srfcplx2%dbaserxn%spec_name(ispec), &
1499) MAXWORDLENGTH)) then
1500) call BasisSubSpeciesInGasOrSecRxn(cur_sec_aq_spec%name, &
1501) cur_sec_aq_spec%dbaserxn, &
1502) cur_srfcplx2%dbaserxn, &
1503) scale)
1504) !geh cur_srfcplx2%dbaserxn%logK=cur_srfcplx2%dbaserxn%logK &
1505) !geh + scale *cur_sec_aq_spec%dbaserxn%logK
1506) ispec = 0
1507) endif
1508) ispec = ispec + 1
1509) enddo
1510) endif
1511) cur_srfcplx2 => cur_srfcplx2%next
1512) enddo
1513) nullify(cur_srfcplx2)
1514)
1515) cur_sec_aq_spec => cur_sec_aq_spec%next
1516) enddo
1517)
1518) nullify(cur_sec_aq_spec)
1519) nullify(cur_gas_spec)
1520) nullify(cur_mineral)
1521) nullify(cur_srfcplx_rxn)
1522) nullify(cur_srfcplx)
1523)
1524) ! substitute new basis into mineral and surface complexation rxns,
1525) ! if necessary
1526) cur_mineral => mineral%mineral_list
1527) do
1528) if (.not.associated(cur_mineral)) exit
1529) if (.not.associated(cur_mineral%dbaserxn%spec_ids)) then
1530) allocate(cur_mineral%dbaserxn%spec_ids(cur_mineral%dbaserxn%nspec))
1531) cur_mineral%dbaserxn%spec_ids = 0
1532) endif
1533)
1534) call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
1535) cur_mineral%dbaserxn%nspec, &
1536) cur_mineral%dbaserxn%spec_name, &
1537) cur_mineral%dbaserxn%stoich, &
1538) cur_mineral%dbaserxn%spec_ids, &
1539) cur_mineral%name,option)
1540) cur_mineral => cur_mineral%next
1541) enddo
1542)
1543) cur_srfcplx => surface_complexation%complex_list
1544) do
1545) if (.not.associated(cur_srfcplx)) exit
1546) if (.not.associated(cur_srfcplx%dbaserxn%spec_ids)) then
1547) allocate(cur_srfcplx%dbaserxn%spec_ids(cur_srfcplx%dbaserxn%nspec))
1548) cur_srfcplx%dbaserxn%spec_ids = 0
1549) endif
1550) call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
1551) cur_srfcplx%dbaserxn%nspec, &
1552) cur_srfcplx%dbaserxn%spec_name, &
1553) cur_srfcplx%dbaserxn%stoich, &
1554) cur_srfcplx%dbaserxn%spec_ids, &
1555) cur_srfcplx%name,option)
1556) cur_srfcplx => cur_srfcplx%next
1557) enddo
1558) nullify(cur_srfcplx)
1559)
1560) ! fill reaction arrays, swapping if necessary
1561) if (associated(reaction%primary_species_names)) &
1562) deallocate(reaction%primary_species_names)
1563)
1564) allocate(reaction%primary_species_names(reaction%naqcomp))
1565) reaction%primary_species_names = ''
1566)
1567) allocate(reaction%primary_species_print(reaction%naqcomp))
1568) reaction%primary_species_print = PETSC_FALSE
1569)
1570) allocate(reaction%primary_spec_Z(reaction%naqcomp))
1571) reaction%primary_spec_Z = 0.d0
1572)
1573) allocate(reaction%primary_spec_molar_wt(reaction%naqcomp))
1574) reaction%primary_spec_molar_wt = 0.d0
1575)
1576) allocate(reaction%primary_spec_a0(reaction%naqcomp))
1577) reaction%primary_spec_a0 = 0.d0
1578)
1579) allocate(reaction%kd_print(reaction%naqcomp))
1580) reaction%kd_print = PETSC_FALSE
1581) if (reaction%nsorb > 0) then
1582) allocate(reaction%total_sorb_print(reaction%naqcomp))
1583) reaction%total_sorb_print = PETSC_FALSE
1584) endif
1585)
1586) ! pack in reaction arrays
1587) cur_pri_aq_spec => reaction%primary_species_list
1588) ispec = 1
1589) do
1590) if (.not.associated(cur_pri_aq_spec)) exit
1591) reaction%primary_species_names(ispec) = cur_pri_aq_spec%name
1592) reaction%primary_spec_Z(ispec) = cur_pri_aq_spec%Z
1593) reaction%primary_spec_molar_wt(ispec) = cur_pri_aq_spec%molar_weight
1594) reaction%primary_spec_a0(ispec) = cur_pri_aq_spec%a0
1595) reaction%primary_species_print(ispec) = cur_pri_aq_spec%print_me .or. &
1596) reaction%print_all_primary_species
1597) reaction%kd_print(ispec) = (cur_pri_aq_spec%print_me .or. &
1598) reaction%print_all_primary_species) .and. &
1599) reaction%print_kd
1600) if (reaction%nsorb > 0) then
1601) reaction%total_sorb_print(ispec) = (cur_pri_aq_spec%print_me .or. &
1602) reaction%print_all_primary_species) .and. &
1603) reaction%print_total_sorb
1604) endif
1605) ispec = ispec + 1
1606) cur_pri_aq_spec => cur_pri_aq_spec%next
1607) enddo
1608) nullify(cur_pri_aq_spec)
1609) ispec = -1 ! to catch bugs
1610)
1611) ! secondary aqueous complexes
1612) reaction%neqcplx = GetSecondarySpeciesCount(reaction)
1613)
1614) if (reaction%neqcplx > 0) then
1615)
1616) ! get maximum # of aqueous species in a aqueous complexation reaction
1617) cur_sec_aq_spec => reaction%secondary_species_list
1618) max_aq_species = 0
1619) do
1620) if (.not.associated(cur_sec_aq_spec)) exit
1621) max_aq_species = max(cur_sec_aq_spec%dbaserxn%nspec,max_aq_species)
1622) cur_sec_aq_spec => cur_sec_aq_spec%next
1623) enddo
1624)
1625) allocate(reaction%secondary_species_names(reaction%neqcplx))
1626) reaction%secondary_species_names = ''
1627)
1628) allocate(reaction%secondary_species_print(reaction%neqcplx))
1629) reaction%secondary_species_print = PETSC_FALSE
1630)
1631) allocate(reaction%eqcplx_basis_names(max_aq_species,reaction%neqcplx))
1632) reaction%eqcplx_basis_names = ''
1633)
1634) allocate(reaction%eqcplxspecid(0:max_aq_species,reaction%neqcplx))
1635) reaction%eqcplxspecid = 0
1636)
1637) allocate(reaction%eqcplxstoich(0:max_aq_species,reaction%neqcplx))
1638) reaction%eqcplxstoich = 0.d0
1639)
1640) allocate(reaction%eqcplxh2oid(reaction%neqcplx))
1641) reaction%eqcplxh2oid = 0
1642)
1643) allocate(reaction%eqcplxh2ostoich(reaction%neqcplx))
1644) reaction%eqcplxh2ostoich = 0.d0
1645)
1646) allocate(reaction%eqcplx_logK(reaction%neqcplx))
1647) reaction%eqcplx_logK = 0.d0
1648)
1649) if (.not.reaction%use_geothermal_hpt) then
1650) if (option%use_isothermal) then
1651) allocate(reaction%eqcplx_logKcoef(reaction%num_dbase_temperatures, &
1652) reaction%neqcplx))
1653) else
1654) allocate(reaction%eqcplx_logKcoef(FIVE_INTEGER,reaction%neqcplx))
1655) endif
1656) else
1657) allocate(reaction%eqcplx_logKcoef(num_logKs,reaction%neqcplx))
1658) endif
1659)
1660) reaction%eqcplx_logKcoef = 0.d0
1661)
1662) allocate(reaction%eqcplx_Z(reaction%neqcplx))
1663) reaction%eqcplx_Z = 0.d0
1664)
1665) allocate(reaction%eqcplx_molar_wt(reaction%neqcplx))
1666) reaction%eqcplx_molar_wt = 0.d0
1667)
1668) allocate(reaction%eqcplx_a0(reaction%neqcplx))
1669) reaction%eqcplx_a0 = 0.d0
1670)
1671) ! pack in reaction arrays
1672) cur_sec_aq_spec => reaction%secondary_species_list
1673) isec_spec = 1
1674) do
1675) if (.not.associated(cur_sec_aq_spec)) exit
1676)
1677) reaction%secondary_species_names(isec_spec) = &
1678) cur_sec_aq_spec%name
1679) reaction%secondary_species_print(isec_spec) = cur_sec_aq_spec%print_me .or. &
1680) reaction%print_all_secondary_species
1681) ispec = 0
1682) do i = 1, cur_sec_aq_spec%dbaserxn%nspec
1683)
1684) ! print *,'database: ',i,cur_sec_aq_spec%dbaserxn%spec_name(i)
1685)
1686) if (cur_sec_aq_spec%dbaserxn%spec_ids(i) /= h2o_id) then
1687) ispec = ispec + 1
1688) spec_id = cur_sec_aq_spec%dbaserxn%spec_ids(i)
1689) if (spec_id > h2o_id) spec_id = spec_id - 1
1690) reaction%eqcplxspecid(ispec,isec_spec) = spec_id
1691) reaction%eqcplx_basis_names(ispec,isec_spec) = &
1692) cur_sec_aq_spec%dbaserxn%spec_name(i)
1693) reaction%eqcplxstoich(ispec,isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
1694)
1695) else ! fill in h2o id and stoich
1696) reaction%eqcplxh2oid(isec_spec) = h2o_id
1697) reaction%eqcplxh2ostoich(isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
1698) endif
1699) enddo
1700) reaction%eqcplxspecid(0,isec_spec) = ispec
1701)
1702) if (.not.reaction%use_geothermal_hpt) then
1703) if (option%use_isothermal) then
1704) call Interpolate(temp_high,temp_low,option%reference_temperature, &
1705) cur_sec_aq_spec%dbaserxn%logK(itemp_high), &
1706) cur_sec_aq_spec%dbaserxn%logK(itemp_low), &
1707) reaction%eqcplx_logK(isec_spec))
1708) else
1709) call ReactionFitLogKCoef(reaction%eqcplx_logKcoef(:,isec_spec), &
1710) cur_sec_aq_spec%dbaserxn%logK, &
1711) reaction%secondary_species_names(isec_spec), &
1712) option,reaction)
1713) call ReactionInitializeLogK(reaction%eqcplx_logKcoef(:,isec_spec), &
1714) cur_sec_aq_spec%dbaserxn%logK, &
1715) reaction%eqcplx_logK(isec_spec), &
1716) option,reaction)
1717) endif
1718) else
1719) reaction%eqcplx_logKcoef(:,isec_spec) = cur_sec_aq_spec%dbaserxn%logK
1720) call ReactionInitializeLogK_hpt(reaction%eqcplx_logKcoef(:,isec_spec), &
1721) reaction%eqcplx_logK(isec_spec), &
1722) option,reaction)
1723)
1724) endif
1725)
1726) reaction%eqcplx_Z(isec_spec) = cur_sec_aq_spec%Z
1727) reaction%eqcplx_molar_wt(isec_spec) = cur_sec_aq_spec%molar_weight
1728) reaction%eqcplx_a0(isec_spec) = cur_sec_aq_spec%a0
1729)
1730) isec_spec = isec_spec + 1
1731) cur_sec_aq_spec => cur_sec_aq_spec%next
1732) enddo
1733)
1734) endif
1735) nullify(cur_sec_aq_spec)
1736) isec_spec = -1 ! to catch bugs
1737)
1738) ! gas complexes
1739) reaction%ngas = GetGasCount(reaction)
1740)
1741) if (reaction%ngas > 0) then
1742)
1743) ! get maximum # of aqueous species in a gas reaction
1744) cur_gas_spec => reaction%gas_species_list
1745) max_aq_species = 0
1746) do
1747) if (.not.associated(cur_gas_spec)) exit
1748) max_aq_species = max(cur_gas_spec%dbaserxn%nspec,max_aq_species)
1749) cur_gas_spec => cur_gas_spec%next
1750) enddo
1751)
1752) allocate(reaction%gas_species_names(reaction%ngas))
1753) reaction%gas_species_names = ''
1754) allocate(reaction%gas_species_print(reaction%ngas))
1755) reaction%gas_species_print = PETSC_FALSE
1756) allocate(reaction%eqgasspecid(0:max_aq_species,reaction%ngas))
1757) reaction%eqgasspecid = 0
1758) allocate(reaction%eqgasstoich(0:max_aq_species,reaction%ngas))
1759) reaction%eqgasstoich = 0.d0
1760) allocate(reaction%eqgash2oid(reaction%ngas))
1761) reaction%eqgash2oid = 0
1762) allocate(reaction%eqgash2ostoich(reaction%ngas))
1763) reaction%eqgash2ostoich = 0.d0
1764) allocate(reaction%eqgas_logK(reaction%ngas))
1765) reaction%eqgas_logK = 0.d0
1766) if (.not.reaction%use_geothermal_hpt) then
1767) if (option%use_isothermal) then
1768) allocate(reaction%eqgas_logKcoef(reaction%num_dbase_temperatures, &
1769) reaction%ngas))
1770) else
1771) allocate(reaction%eqgas_logKcoef(FIVE_INTEGER,reaction%ngas))
1772) endif
1773) else
1774) allocate(reaction%eqgas_logKcoef(num_logKs,reaction%ngas))
1775) endif
1776)
1777) reaction%eqgas_logKcoef = 0.d0
1778)
1779) ! pack in reaction arrays
1780) cur_gas_spec => reaction%gas_species_list
1781) igas_spec = 1
1782) do
1783) if (.not.associated(cur_gas_spec)) exit
1784)
1785) reaction%gas_species_names(igas_spec) = cur_gas_spec%name
1786) reaction%gas_species_print(igas_spec) = cur_gas_spec%print_me .or. &
1787) reaction%print_all_gas_species
1788) ispec = 0
1789) do i = 1, cur_gas_spec%dbaserxn%nspec
1790) if (cur_gas_spec%dbaserxn%spec_ids(i) /= h2o_id) then
1791) ispec = ispec + 1
1792) spec_id = cur_gas_spec%dbaserxn%spec_ids(i)
1793) if (spec_id > h2o_id) spec_id = spec_id - 1
1794) reaction%eqgasspecid(ispec,igas_spec) = spec_id
1795) reaction%eqgasstoich(ispec,igas_spec) = &
1796) cur_gas_spec%dbaserxn%stoich(i)
1797)
1798) else ! fill in h2o id and stoich
1799) reaction%eqgash2oid(igas_spec) = h2o_id
1800) reaction%eqgash2ostoich(igas_spec) = &
1801) cur_gas_spec%dbaserxn%stoich(i)
1802) endif
1803) enddo
1804) reaction%eqgasspecid(0,igas_spec) = ispec
1805)
1806) if (.not.reaction%use_geothermal_hpt) then
1807) if (option%use_isothermal) then
1808) reaction%eqgas_logKcoef(:,igas_spec) = cur_gas_spec%dbaserxn%logK
1809) call Interpolate(temp_high,temp_low,option%reference_temperature, &
1810) cur_gas_spec%dbaserxn%logK(itemp_high), &
1811) cur_gas_spec%dbaserxn%logK(itemp_low), &
1812) reaction%eqgas_logK(igas_spec))
1813) else
1814) call ReactionFitLogKCoef(reaction%eqgas_logKcoef(:,igas_spec), &
1815) cur_gas_spec%dbaserxn%logK, &
1816) reaction%gas_species_names(igas_spec), &
1817) option,reaction)
1818) call ReactionInitializeLogK(reaction%eqgas_logKcoef(:,igas_spec), &
1819) cur_gas_spec%dbaserxn%logK, &
1820) reaction%eqgas_logK(igas_spec), &
1821) option,reaction)
1822) endif
1823) else
1824) reaction%eqgas_logKcoef(:,igas_spec) = cur_gas_spec%dbaserxn%logK
1825) call ReactionInitializeLogK_hpt(reaction%eqgas_logKcoef(:,igas_spec), &
1826) reaction%eqgas_logK(igas_spec), &
1827) option,reaction)
1828) endif
1829)
1830) igas_spec = igas_spec + 1
1831) cur_gas_spec => cur_gas_spec%next
1832) enddo
1833)
1834) endif
1835) nullify(cur_gas_spec)
1836) igas_spec = -1 ! to catch bugs
1837)
1838) ! immobile species
1839) immobile%nimmobile = ImmobileGetCount(immobile)
1840) if (immobile%nimmobile > 0) then
1841) allocate(immobile%names(immobile%nimmobile))
1842) immobile%names = ''
1843) allocate(immobile%print_me(immobile%nimmobile))
1844) immobile%print_me = PETSC_FALSE
1845)
1846) cur_immobile_spec => immobile%list
1847) temp_int = 0
1848) do
1849) if (.not.associated(cur_immobile_spec)) exit
1850) temp_int = temp_int + 1
1851) immobile%names(temp_int) = cur_immobile_spec%name
1852) immobile%print_me(temp_int) = cur_immobile_spec%print_me .or. &
1853) immobile%print_all
1854) cur_immobile_spec => cur_immobile_spec%next
1855) enddo
1856) endif
1857)
1858) ! minerals
1859) ! Count the number of kinetic mineral reactions, max number of prefactors in a
1860) ! tst reaction, and the maximum number or species in a prefactor
1861) temp_int = mineral%nkinmnrl !geh: store for check after processing
1862) mineral%nkinmnrl = 0
1863) max_num_prefactors = 0
1864) max_num_prefactor_species = 0
1865) cur_mineral => mineral%mineral_list
1866) !
1867) do
1868) if (.not.associated(cur_mineral)) exit
1869) if (cur_mineral%itype == MINERAL_KINETIC .and. &
1870) associated(cur_mineral%tstrxn)) then
1871) ! increment number of kinetic minerals
1872) mineral%nkinmnrl = mineral%nkinmnrl + 1
1873) cur_prefactor => cur_mineral%tstrxn%prefactor
1874) ! zero number of prefactors
1875) i = 0
1876) do
1877) if (.not.associated(cur_prefactor)) exit
1878) i = i + 1
1879) cur_prefactor_species => cur_prefactor%species
1880) ! zero number of prefactor species
1881) j = 0
1882) do
1883) if (.not.associated(cur_prefactor_species)) exit
1884) j = j + 1
1885) cur_prefactor_species => cur_prefactor_species%next
1886) enddo
1887) if (j > max_num_prefactor_species) max_num_prefactor_species = j
1888) cur_prefactor => cur_prefactor%next
1889) enddo
1890) if (i > max_num_prefactors) max_num_prefactors = i
1891) endif
1892) cur_mineral => cur_mineral%next
1893) enddo
1894)
1895) if (mineral%nkinmnrl /= temp_int) then
1896) write(string,'(2i4)') temp_int, mineral%nkinmnrl
1897) option%io_buffer = 'Inconsistent number of kinetic minerals: ' // &
1898) trim(string)
1899) call printErrMsg(option)
1900) endif
1901)
1902) if (mineral%nmnrl > 0) then
1903)
1904) ! get maximum # of aqueous species in a mineral reaction
1905) cur_mineral => mineral%mineral_list
1906) max_aq_species = 0
1907) do
1908) if (.not.associated(cur_mineral)) exit
1909) max_aq_species = max(cur_mineral%dbaserxn%nspec,max_aq_species)
1910) cur_mineral => cur_mineral%next
1911) enddo
1912)
1913) allocate(mineral%mineral_names(mineral%nmnrl))
1914) mineral%mineral_names = ''
1915) allocate(mineral%mnrlspecid(0:max_aq_species,mineral%nmnrl))
1916) mineral%mnrlspecid = 0
1917) allocate(mineral%mnrlstoich(max_aq_species,mineral%nmnrl))
1918) mineral%mnrlstoich = 0.d0
1919) allocate(mineral%mnrlh2oid(mineral%nmnrl))
1920) mineral%mnrlh2oid = 0
1921) allocate(mineral%mnrlh2ostoich(mineral%nmnrl))
1922) mineral%mnrlh2ostoich = 0.d0
1923) allocate(mineral%mnrl_logK(mineral%nmnrl))
1924) mineral%mnrl_logK = 0.d0
1925) allocate(mineral%mnrl_print(mineral%nmnrl))
1926) mineral%mnrl_print = PETSC_FALSE
1927) if (.not.reaction%use_geothermal_hpt) then
1928) if (option%use_isothermal) then
1929) allocate(mineral%mnrl_logKcoef(reaction%num_dbase_temperatures, &
1930) mineral%nmnrl))
1931) else
1932) allocate(mineral%mnrl_logKcoef(FIVE_INTEGER,mineral%nmnrl))
1933) endif
1934) else
1935) allocate(mineral%mnrl_logKcoef(num_logKs,mineral%nmnrl))
1936) endif
1937)
1938) reaction%mineral%mnrl_logKcoef = 0.d0
1939)
1940) if (mineral%nkinmnrl > 0) then
1941)
1942) ! get maximum # of aqueous species in a mineral reaction
1943) cur_mineral => mineral%mineral_list
1944) max_aq_species = 0
1945) do
1946) if (.not.associated(cur_mineral)) exit
1947) if (associated(cur_mineral%tstrxn)) then ! reaction is kinetic
1948) max_aq_species = max(cur_mineral%dbaserxn%nspec,max_aq_species)
1949) endif
1950) cur_mineral => cur_mineral%next
1951) enddo
1952)
1953) allocate(mineral%kinmnrl_names(mineral%nkinmnrl))
1954) mineral%kinmnrl_names = ''
1955) allocate(mineral%kinmnrl_print(mineral%nkinmnrl))
1956) mineral%kinmnrl_print = PETSC_FALSE
1957) allocate(mineral%kinmnrlspecid(0:max_aq_species,mineral%nkinmnrl))
1958) mineral%kinmnrlspecid = 0
1959) allocate(mineral%kinmnrlstoich(max_aq_species,mineral%nkinmnrl))
1960) mineral%kinmnrlstoich = 0.d0
1961) allocate(mineral%kinmnrlh2oid(mineral%nkinmnrl))
1962) mineral%kinmnrlh2oid = 0
1963) allocate(mineral%kinmnrlh2ostoich(mineral%nkinmnrl))
1964) mineral%kinmnrlh2ostoich = 0.d0
1965) allocate(mineral%kinmnrl_logK(mineral%nkinmnrl))
1966) mineral%kinmnrl_logK = 0.d0
1967) if (.not.reaction%use_geothermal_hpt) then
1968) if (option%use_isothermal) then
1969) allocate(mineral%kinmnrl_logKcoef(reaction%num_dbase_temperatures, &
1970) mineral%nkinmnrl))
1971) else
1972) allocate(mineral%kinmnrl_logKcoef(FIVE_INTEGER,mineral%nkinmnrl))
1973) endif
1974) else
1975) allocate(mineral%kinmnrl_logKcoef(num_logKs,mineral%nkinmnrl))
1976) endif
1977)
1978) mineral%kinmnrl_logKcoef = 0.d0
1979)
1980) ! TST Rxn variables
1981) allocate(mineral%kinmnrl_affinity_threshold(mineral%nkinmnrl))
1982) mineral%kinmnrl_affinity_threshold = 0.d0
1983) allocate(mineral%kinmnrl_rate_limiter(mineral%nkinmnrl))
1984) mineral%kinmnrl_rate_limiter = 0.d0
1985) allocate(mineral%kinmnrl_irreversible(mineral%nkinmnrl))
1986) mineral%kinmnrl_irreversible = 0
1987) allocate(mineral%kinmnrl_rate_constant(mineral%nkinmnrl))
1988) mineral%kinmnrl_rate_constant = 0.d0
1989) allocate(mineral%kinmnrl_activation_energy(mineral%nkinmnrl))
1990) mineral%kinmnrl_activation_energy = 0.d0
1991) allocate(mineral%kinmnrl_molar_vol(mineral%nkinmnrl))
1992) mineral%kinmnrl_molar_vol = 0.d0
1993) allocate(mineral%kinmnrl_molar_wt(mineral%nkinmnrl))
1994) mineral%kinmnrl_molar_wt = 0.d0
1995)
1996) allocate(mineral%kinmnrl_armor_pwr(mineral%nkinmnrl))
1997) mineral%kinmnrl_armor_pwr = 0.d0
1998)
1999) allocate(mineral%kinmnrl_armor_crit_vol_frac(mineral%nkinmnrl))
2000) mineral%kinmnrl_armor_crit_vol_frac = 0.d0
2001)
2002) allocate(mineral%kinmnrl_armor_min_names(mineral%nkinmnrl))
2003) mineral%kinmnrl_armor_min_names = ''
2004)
2005) allocate(mineral%kinmnrl_num_prefactors(mineral%nkinmnrl))
2006) mineral%kinmnrl_num_prefactors = 0
2007) if (max_num_prefactors > 0) then
2008) allocate(mineral%kinmnrl_pref_rate(max_num_prefactors,mineral%nkinmnrl))
2009) mineral%kinmnrl_pref_rate = 0.d0
2010) allocate(mineral%kinmnrl_pref_activation_energy(max_num_prefactors, &
2011) mineral%nkinmnrl))
2012) mineral%kinmnrl_pref_activation_energy = 0.d0
2013) allocate(mineral%kinmnrl_prefactor_id(0:max_num_prefactor_species, &
2014) max_num_prefactors,mineral%nkinmnrl))
2015) mineral%kinmnrl_prefactor_id = 0
2016) allocate(mineral%kinmnrl_pref_alpha(max_num_prefactor_species, &
2017) max_num_prefactors,mineral%nkinmnrl))
2018) mineral%kinmnrl_pref_alpha = 0.d0
2019) allocate(mineral%kinmnrl_pref_beta(max_num_prefactor_species, &
2020) max_num_prefactors,mineral%nkinmnrl))
2021) mineral%kinmnrl_pref_beta = 0.d0
2022) allocate(mineral%kinmnrl_pref_atten_coef(max_num_prefactor_species, &
2023) max_num_prefactors,mineral%nkinmnrl))
2024) mineral%kinmnrl_pref_atten_coef = 0.d0
2025) endif
2026) endif
2027)
2028) ! Determine whether mineral scale factor is used in any TST reactions
2029) cur_mineral => mineral%mineral_list
2030) found = PETSC_FALSE
2031) do
2032) if (.not.associated(cur_mineral)) exit
2033) if (associated(cur_mineral%tstrxn)) then
2034) if (Initialized(cur_mineral%tstrxn%min_scale_factor)) then
2035) found = PETSC_TRUE
2036) exit
2037) endif
2038) endif
2039) cur_mineral => cur_mineral%next
2040) enddo
2041) if (found) then
2042) allocate(mineral%kinmnrl_min_scale_factor(mineral%nkinmnrl))
2043) mineral%kinmnrl_min_scale_factor = 1.d0
2044) endif
2045)
2046) ! Determine whether Temkin's constant is used in any TST reactions
2047) cur_mineral => mineral%mineral_list
2048) found = PETSC_FALSE
2049) do
2050) if (.not.associated(cur_mineral)) exit
2051) if (associated(cur_mineral%tstrxn)) then
2052) if (Initialized(cur_mineral%tstrxn%affinity_factor_sigma)) then
2053) found = PETSC_TRUE
2054) exit
2055) endif
2056) endif
2057) cur_mineral => cur_mineral%next
2058) enddo
2059) if (found) then
2060) allocate(mineral%kinmnrl_Temkin_const(mineral%nkinmnrl))
2061) mineral%kinmnrl_Temkin_const = 1.d0
2062) endif
2063)
2064) ! Determine whether affinity factor has power
2065) cur_mineral => mineral%mineral_list
2066) found = PETSC_FALSE
2067) do
2068) if (.not.associated(cur_mineral)) exit
2069) if (associated(cur_mineral%tstrxn)) then
2070) if (Initialized(cur_mineral%tstrxn%affinity_factor_beta)) then
2071) found = PETSC_TRUE
2072) exit
2073) endif
2074) endif
2075) cur_mineral => cur_mineral%next
2076) enddo
2077) if (found) then
2078) allocate(mineral%kinmnrl_affinity_power(mineral%nkinmnrl))
2079) mineral%kinmnrl_affinity_power = 1.d0
2080) endif
2081)
2082) ! Determine whether surface area volume fraction power defined
2083) cur_mineral => mineral%mineral_list
2084) found = PETSC_FALSE
2085) do
2086) if (.not.associated(cur_mineral)) exit
2087) if (associated(cur_mineral%tstrxn)) then
2088) if (.not.Equal(cur_mineral%tstrxn%surf_area_vol_frac_pwr, &
2089) 0.d0)) then
2090) found = PETSC_TRUE
2091) exit
2092) endif
2093) endif
2094) cur_mineral => cur_mineral%next
2095) enddo
2096) if (reaction%update_mineral_surface_area .or. found) then
2097) allocate(mineral%kinmnrl_surf_area_vol_frac_pwr(mineral%nkinmnrl))
2098) mineral%kinmnrl_surf_area_vol_frac_pwr = 0.d0
2099) endif
2100)
2101) ! Determine whether surface area volume fraction power defined
2102) cur_mineral => mineral%mineral_list
2103) found = PETSC_FALSE
2104) do
2105) if (.not.associated(cur_mineral)) exit
2106) if (associated(cur_mineral%tstrxn)) then
2107) if (.not.Equal(cur_mineral%tstrxn%surf_area_porosity_pwr, &
2108) 0.d0)) then
2109) found = PETSC_TRUE
2110) exit
2111) endif
2112) endif
2113) cur_mineral => cur_mineral%next
2114) enddo
2115) if (found) then
2116) allocate(mineral%kinmnrl_surf_area_porosity_pwr(mineral%nkinmnrl))
2117) mineral%kinmnrl_surf_area_porosity_pwr = 0.d0
2118) endif
2119)
2120) #if 0
2121) ! Determine whether armor mineral name defined
2122) cur_mineral => mineral%mineral_list
2123) found = PETSC_FALSE
2124) do
2125) if (.not.associated(cur_mineral)) exit
2126) if (associated(cur_mineral%tstrxn)) then
2127) if (.not. cur_mineral%tstrxn%armor_min_name == '') then
2128) found = PETSC_TRUE
2129) exit
2130) endif
2131) endif
2132) cur_mineral => cur_mineral%next
2133) enddo
2134) if (found) then
2135) allocate(mineral%kinmnrl_armor_min_names(mineral%nkinmnrl))
2136) mineral%kinmnrl_armor_min_names = ''
2137) endif
2138)
2139) ! Determine whether armor mineral volume fraction power defined
2140) cur_mineral => mineral%mineral_list
2141) found = PETSC_FALSE
2142) do
2143) if (.not.associated(cur_mineral)) exit
2144) if (associated(cur_mineral%tstrxn)) then
2145) if (.not.Equal(cur_mineral%tstrxn%armor_pwr,0.d0)) then
2146) found = PETSC_TRUE
2147) exit
2148) endif
2149) endif
2150) cur_mineral => cur_mineral%next
2151) enddo
2152) if (found) then
2153) allocate(mineral%kinmnrl_armor_pwr(mineral%nkinmnrl))
2154) mineral%kinmnrl_armor_pwr = 0.d0
2155) endif
2156)
2157) ! Determine whether armor critical volume fraction defined
2158) cur_mineral => mineral%mineral_list
2159) found = PETSC_FALSE
2160) do
2161) if (.not.associated(cur_mineral)) exit
2162) if (associated(cur_mineral%tstrxn)) then
2163) if (.not.Equal(cur_mineral%tstrxn%armor_crit_vol_frac, &
2164) 0.d0)) then
2165) found = PETSC_TRUE
2166) exit
2167) endif
2168) endif
2169) cur_mineral => cur_mineral%next
2170) enddo
2171) if (found) then
2172) allocate(mineral%kinmnrl_armor_crit_vol_frac(mineral%nkinmnrl))
2173) mineral%kinmnrl_armor_crit_vol_frac = 0.d0
2174) endif
2175) #endif
2176)
2177) cur_mineral => mineral%mineral_list
2178) imnrl = 1
2179) ikinmnrl = 1
2180) do
2181) if (.not.associated(cur_mineral)) exit
2182)
2183) mineral%mineral_names(imnrl) = cur_mineral%name
2184) ispec = 0
2185) do i = 1, cur_mineral%dbaserxn%nspec
2186) if (cur_mineral%dbaserxn%spec_ids(i) /= h2o_id) then
2187) ispec = ispec + 1
2188) spec_id = cur_mineral%dbaserxn%spec_ids(i)
2189) if (spec_id > h2o_id) spec_id = spec_id - 1
2190) mineral%mnrlspecid(ispec,imnrl) = spec_id
2191) mineral%mnrlstoich(ispec,imnrl) = &
2192) cur_mineral%dbaserxn%stoich(i)
2193)
2194) else ! fill in h2o id and stoich
2195) mineral%mnrlh2oid(imnrl) = h2o_id
2196) mineral%mnrlh2ostoich(imnrl) = &
2197) cur_mineral%dbaserxn%stoich(i)
2198) endif
2199) enddo
2200) mineral%mnrlspecid(0,imnrl) = ispec
2201)
2202) if (.not.reaction%use_geothermal_hpt) then
2203) if (option%use_isothermal) then
2204) call Interpolate(temp_high,temp_low,option%reference_temperature, &
2205) cur_mineral%dbaserxn%logK(itemp_high), &
2206) cur_mineral%dbaserxn%logK(itemp_low), &
2207) mineral%mnrl_logK(imnrl))
2208) else
2209) call ReactionFitLogKCoef(mineral%mnrl_logKcoef(:,imnrl), &
2210) cur_mineral%dbaserxn%logK, &
2211) mineral%mineral_names(imnrl), &
2212) option,reaction)
2213) call ReactionInitializeLogK(mineral%mnrl_logKcoef(:,imnrl), &
2214) cur_mineral%dbaserxn%logK, &
2215) mineral%mnrl_logK(imnrl), &
2216) option,reaction)
2217) endif
2218) else
2219) mineral%mnrl_logKcoef(:,imnrl) = cur_mineral%dbaserxn%logK
2220) call ReactionInitializeLogK_hpt(mineral%mnrl_logKcoef(:,imnrl), &
2221) mineral%mnrl_logK(imnrl), &
2222) option,reaction)
2223) endif
2224)
2225) ! geh - for now, the user must specify they want each individual
2226) ! mineral printed for non-kinetic reactions (e.g. for SI).
2227) mineral%mnrl_print(imnrl) = cur_mineral%print_me .or. &
2228) reaction%mineral%print_all
2229) if (cur_mineral%itype == MINERAL_KINETIC) then
2230) mineral%kinmnrl_names(ikinmnrl) = mineral%mineral_names(imnrl)
2231) mineral%kinmnrl_print(ikinmnrl) = cur_mineral%print_me .or. &
2232) reaction%mineral%print_all
2233) mineral%kinmnrlspecid(:,ikinmnrl) = mineral%mnrlspecid(:,imnrl)
2234) mineral%kinmnrlstoich(:,ikinmnrl) = mineral%mnrlstoich(:,imnrl)
2235) mineral%kinmnrlh2oid(ikinmnrl) = mineral%mnrlh2oid(imnrl)
2236) mineral%kinmnrlh2ostoich(ikinmnrl) = mineral%mnrlh2ostoich(imnrl)
2237)
2238) if (.not.reaction%use_geothermal_hpt) then
2239) if (option%use_isothermal) then
2240) call Interpolate(temp_high,temp_low,option%reference_temperature, &
2241) cur_mineral%dbaserxn%logK(itemp_high), &
2242) cur_mineral%dbaserxn%logK(itemp_low), &
2243) mineral%kinmnrl_logK(ikinmnrl))
2244) else
2245) call ReactionFitLogKCoef(mineral%kinmnrl_logKcoef(:,ikinmnrl), &
2246) cur_mineral%dbaserxn%logK, &
2247) mineral%kinmnrl_names(ikinmnrl), &
2248) option,reaction)
2249) call ReactionInitializeLogK(mineral%kinmnrl_logKcoef(:,ikinmnrl), &
2250) cur_mineral%dbaserxn%logK, &
2251) mineral%kinmnrl_logK(ikinmnrl), &
2252) option,reaction)
2253) endif
2254) else
2255) mineral%kinmnrl_logKcoef(:,ikinmnrl) = cur_mineral%dbaserxn%logK
2256) call ReactionInitializeLogK_hpt(mineral%kinmnrl_logKcoef(:,ikinmnrl), &
2257) mineral%kinmnrl_logK(ikinmnrl), &
2258) option,reaction)
2259) endif
2260)
2261) tstrxn => cur_mineral%tstrxn
2262) if (associated(tstrxn)) then
2263) ! loop over transition state theory reactions/prefactors
2264) cur_prefactor => cur_mineral%tstrxn%prefactor
2265) i = 0
2266) do
2267) if (.not.associated(cur_prefactor)) exit
2268) ! ith prefactor
2269) i = i + 1
2270)
2271) mineral%kinmnrl_pref_rate(i,ikinmnrl) = cur_prefactor%rate
2272) mineral%kinmnrl_pref_activation_energy(i,ikinmnrl) = &
2273) cur_prefactor%activation_energy
2274)
2275) cur_prefactor_species => cur_prefactor%species
2276) j = 0
2277) do
2278) if (.not.associated(cur_prefactor_species)) exit
2279) ! jth prefactor species
2280) j = j + 1
2281) ! find the prefactor species
2282) do ispec = 1, reaction%naqcomp
2283) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2284) cur_prefactor_species%name)) then
2285) cur_prefactor_species%id = ispec
2286) exit
2287) endif
2288) enddo
2289) if (cur_prefactor_species%id == 0) then ! not found
2290) ! negative prefactor_species_id denotes a secondary species
2291) do ispec = 1, reaction%neqcplx
2292) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
2293) cur_prefactor_species%name)) then
2294) cur_prefactor_species%id = -ispec
2295) exit
2296) endif
2297) enddo
2298) endif
2299) if (cur_prefactor_species%id == 0) then
2300) option%io_buffer = 'Kinetic mineral prefactor species "' // &
2301) trim(cur_prefactor_species%name) // &
2302) '" not found among primary or secondary species.'
2303) call printErrMsg(option)
2304) endif
2305) mineral%kinmnrl_prefactor_id(j,i,ikinmnrl) = cur_prefactor_species%id
2306) mineral%kinmnrl_pref_alpha(j,i,ikinmnrl) = cur_prefactor_species%alpha
2307) mineral%kinmnrl_pref_beta(j,i,ikinmnrl) = cur_prefactor_species%beta
2308) mineral%kinmnrl_pref_atten_coef(j,i,ikinmnrl) = &
2309) cur_prefactor_species%attenuation_coef
2310) cur_prefactor_species => cur_prefactor_species%next
2311) enddo
2312) ! store the number of species
2313) mineral%kinmnrl_prefactor_id(0,i,ikinmnrl) = j
2314) cur_prefactor => cur_prefactor%next
2315) enddo
2316) mineral%kinmnrl_num_prefactors(ikinmnrl) = i
2317)
2318) mineral%kinmnrl_affinity_threshold(ikinmnrl) = &
2319) tstrxn%affinity_threshold
2320) mineral%kinmnrl_rate_limiter(ikinmnrl) = tstrxn%rate_limiter
2321) mineral%kinmnrl_irreversible(ikinmnrl) = tstrxn%irreversible
2322)
2323) mineral%kinmnrl_armor_min_names(ikinmnrl) = tstrxn%armor_min_name
2324) mineral%kinmnrl_armor_pwr(ikinmnrl) = tstrxn%armor_pwr
2325) mineral%kinmnrl_armor_crit_vol_frac(ikinmnrl) = tstrxn%armor_crit_vol_frac
2326)
2327) if (mineral%kinmnrl_num_prefactors(ikinmnrl) == 0) then
2328) ! no prefactors, rates stored in upper level
2329) mineral%kinmnrl_rate_constant(ikinmnrl) = tstrxn%rate
2330) mineral%kinmnrl_activation_energy(ikinmnrl) = &
2331) tstrxn%activation_energy
2332) endif
2333) if (Initialized(tstrxn%min_scale_factor)) then
2334) mineral%kinmnrl_min_scale_factor(ikinmnrl) = &
2335) tstrxn%min_scale_factor
2336) endif
2337) if (Initialized(tstrxn%affinity_factor_sigma)) then
2338) mineral%kinmnrl_Temkin_const(ikinmnrl) = &
2339) tstrxn%affinity_factor_sigma
2340) endif
2341) if (Initialized(tstrxn%affinity_factor_beta)) then
2342) mineral%kinmnrl_affinity_power(ikinmnrl) = &
2343) tstrxn%affinity_factor_beta
2344) endif
2345) if (.not.Equal(tstrxn%surf_area_vol_frac_pwr, &
2346) 0.d0)) then
2347) mineral%kinmnrl_surf_area_vol_frac_pwr(ikinmnrl) = &
2348) tstrxn%surf_area_vol_frac_pwr
2349) endif
2350) if (.not.Equal(tstrxn%surf_area_porosity_pwr, &
2351) 0.d0)) then
2352) mineral%kinmnrl_surf_area_porosity_pwr(ikinmnrl) = &
2353) tstrxn%surf_area_porosity_pwr
2354) endif
2355) endif ! associated(tstrxn)
2356)
2357) mineral%kinmnrl_molar_vol(ikinmnrl) = cur_mineral%molar_volume
2358) mineral%kinmnrl_molar_wt(ikinmnrl) = cur_mineral%molar_weight
2359) ikinmnrl = ikinmnrl + 1
2360) endif
2361)
2362) cur_mineral => cur_mineral%next
2363) imnrl = imnrl + 1
2364) enddo
2365)
2366) #ifdef SOLID_SOLUTION
2367) call SolidSolutionLinkNamesToIDs(reaction%solid_solution_list, &
2368) mineral,option)
2369) #endif
2370) endif
2371)
2372) ! colloids
2373) ! already calculated above
2374) !reaction%ncoll = GetColloidCount(reaction)
2375)
2376) if (reaction%ncoll > 0) then
2377) allocate(reaction%colloid_names(reaction%ncoll))
2378) allocate(reaction%colloid_mobile_fraction(reaction%ncoll))
2379) allocate(reaction%colloid_print(reaction%ncoll))
2380) reaction%colloid_names = ''
2381) reaction%colloid_mobile_fraction = 0.d0
2382) reaction%colloid_print = PETSC_FALSE
2383)
2384) cur_colloid => reaction%colloid_list
2385) icoll = 1
2386) do
2387) if (.not.associated(cur_colloid)) exit
2388)
2389) reaction%colloid_names(icoll) = cur_colloid%name
2390) reaction%colloid_mobile_fraction(icoll) = cur_colloid%mobile_fraction
2391) reaction%colloid_print(icoll) = cur_colloid%print_me .or. &
2392) reaction%print_all_species
2393) cur_colloid => cur_colloid%next
2394) icoll = icoll + 1
2395) enddo
2396) endif
2397)
2398) ! use flags to determine whether a primary aqueous species is included
2399) ! in the list of colloid species
2400) allocate(colloid_species_flag(reaction%naqcomp))
2401) colloid_species_flag = PETSC_FALSE
2402)
2403) if (surface_complexation%nsrfcplxrxn > 0) then
2404)
2405) if (surface_complexation%nsrfcplxrxn /= &
2406) surface_complexation%neqsrfcplxrxn + &
2407) surface_complexation%nkinmrsrfcplxrxn + &
2408) surface_complexation%nkinsrfcplxrxn) then
2409) option%io_buffer = 'Inconsistent number of surface complexation ' // &
2410) 'reactions. (Initial Check)'
2411) call printErrMsg(option)
2412) endif
2413)
2414) ! generic list of surface complexes
2415) ! count number of surface complexes
2416) icount = 0
2417) cur_srfcplx => surface_complexation%complex_list
2418) do
2419) if (.not.associated(cur_srfcplx)) exit
2420) icount = icount + 1
2421) cur_srfcplx => cur_srfcplx%next
2422) enddo
2423)
2424) ! get maximum # of aqueous species in a surface complexation reaction
2425) cur_srfcplx => surface_complexation%complex_list
2426) max_aq_species = 0
2427) do
2428) if (.not.associated(cur_srfcplx)) exit
2429) max_aq_species = max(cur_srfcplx%dbaserxn%nspec,max_aq_species)
2430) cur_srfcplx => cur_srfcplx%next
2431) enddo
2432)
2433) surface_complexation%nsrfcplx = icount
2434)
2435) allocate(surface_complexation%srfcplx_names(icount))
2436) surface_complexation%srfcplx_names = ''
2437)
2438) allocate(surface_complexation%srfcplx_print(icount))
2439) surface_complexation%srfcplx_print = PETSC_FALSE
2440)
2441) allocate(surface_complexation%srfcplxspecid(0:max_aq_species,icount))
2442) surface_complexation%srfcplxspecid = 0
2443)
2444) allocate(surface_complexation%srfcplxstoich(max_aq_species, &
2445) icount))
2446) surface_complexation%srfcplxstoich = 0.d0
2447)
2448) allocate(surface_complexation%srfcplxh2oid(icount))
2449) surface_complexation%srfcplxh2oid = 0
2450)
2451) allocate(surface_complexation%srfcplxh2ostoich(icount))
2452) surface_complexation%srfcplxh2ostoich = 0.d0
2453)
2454) allocate(surface_complexation%srfcplx_free_site_stoich(icount))
2455) surface_complexation%srfcplx_free_site_stoich = 0.d0
2456)
2457) allocate(surface_complexation%srfcplx_logK(icount))
2458) surface_complexation%srfcplx_logK = 0.d0
2459)
2460) if (.not.reaction%use_geothermal_hpt) then
2461) if (option%use_isothermal) then
2462) allocate(surface_complexation%srfcplx_logKcoef(reaction% &
2463) num_dbase_temperatures, &
2464) icount))
2465) else
2466) allocate(surface_complexation%srfcplx_logKcoef(FIVE_INTEGER,icount))
2467) endif
2468) else
2469) allocate(surface_complexation%srfcplx_logKcoef(num_logKs,icount))
2470) endif
2471)
2472) surface_complexation%srfcplx_logKcoef = 0.d0
2473)
2474) allocate(surface_complexation%srfcplx_Z(icount))
2475) surface_complexation%srfcplx_Z = 0.d0
2476)
2477) ! fill in surface complex arrays with info from linked lists
2478) isrfcplx = 0
2479) cur_srfcplx => surface_complexation%complex_list
2480) do
2481) if (.not.associated(cur_srfcplx)) exit
2482)
2483) isrfcplx = isrfcplx + 1
2484)
2485) surface_complexation%srfcplx_names(isrfcplx) = cur_srfcplx%name
2486) !geh: Only print surface complex concentrations for equilibrium
2487) ! surface complexation reaction. They are not stored for
2488) ! multirate and kinetic surface complexation has its own
2489) ! data structure and print flag.
2490) if (surface_complexation%neqsrfcplxrxn > 0) then
2491) surface_complexation%srfcplx_print(isrfcplx) = &
2492) cur_srfcplx%print_me .or. reaction%print_all_species
2493) endif
2494) surface_complexation%srfcplx_free_site_stoich(isrfcplx) = &
2495) cur_srfcplx%free_site_stoich
2496)
2497) ispec = 0
2498) do i = 1, cur_srfcplx%dbaserxn%nspec
2499) if (cur_srfcplx%dbaserxn%spec_ids(i) /= h2o_id) then
2500) ispec = ispec + 1
2501) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2502) if (spec_id > h2o_id) spec_id = spec_id - 1
2503) surface_complexation%srfcplxspecid(ispec,isrfcplx) = spec_id
2504) surface_complexation%srfcplxstoich(ispec,isrfcplx) = &
2505) cur_srfcplx%dbaserxn%stoich(i)
2506)
2507) else ! fill in h2o id and stoich
2508) surface_complexation%srfcplxh2oid(isrfcplx) = h2o_id
2509) surface_complexation%srfcplxh2ostoich(isrfcplx) = &
2510) cur_srfcplx%dbaserxn%stoich(i)
2511) endif
2512) enddo
2513) surface_complexation%srfcplxspecid(0,isrfcplx) = ispec
2514)
2515) if (.not.reaction%use_geothermal_hpt) then
2516) if (option%use_isothermal) then
2517) call Interpolate(temp_high,temp_low,option%reference_temperature, &
2518) cur_srfcplx%dbaserxn%logK(itemp_high), &
2519) cur_srfcplx%dbaserxn%logK(itemp_low), &
2520) surface_complexation%srfcplx_logK(isrfcplx))
2521) else
2522) call ReactionFitLogKCoef(surface_complexation%srfcplx_logKcoef(:,isrfcplx),&
2523) cur_srfcplx%dbaserxn%logK, &
2524) surface_complexation%srfcplx_names(isrfcplx), &
2525) option,reaction)
2526) call ReactionInitializeLogK(surface_complexation%srfcplx_logKcoef(:,isrfcplx), &
2527) cur_srfcplx%dbaserxn%logK, &
2528) surface_complexation%srfcplx_logK(isrfcplx), &
2529) option,reaction)
2530) endif
2531) else
2532) surface_complexation%srfcplx_logKcoef(:,isrfcplx) = cur_srfcplx%dbaserxn%logK
2533) call ReactionInitializeLogK_hpt(surface_complexation%srfcplx_logKcoef(:,isrfcplx), &
2534) surface_complexation%srfcplx_logK(isrfcplx), &
2535) option,reaction)
2536) endif
2537)
2538) surface_complexation%srfcplx_Z(isrfcplx) = cur_srfcplx%Z
2539)
2540) cur_srfcplx => cur_srfcplx%next
2541) enddo
2542) nullify(cur_srfcplx)
2543)
2544) ! determine max # complexes for a given reaction
2545) icount = 0 ! maximum # or surface complexes per rxn
2546) icount2 = 0 ! will hold the maximum # rates for multirate
2547) icount3 = 0 ! maximum # of surface complexes per kinetic rxn
2548) cur_srfcplx_rxn => surface_complexation%rxn_list
2549) do
2550) if (.not.associated(cur_srfcplx_rxn)) exit
2551) isrfcplx = 0
2552) cur_srfcplx => cur_srfcplx_rxn%complex_list
2553) do
2554) if (.not.associated(cur_srfcplx)) exit
2555) isrfcplx = isrfcplx + 1
2556) cur_srfcplx => cur_srfcplx%next
2557) enddo
2558) icount = max(isrfcplx,icount)
2559) select case(cur_srfcplx_rxn%itype)
2560) case(SRFCMPLX_RXN_EQUILIBRIUM)
2561) case(SRFCMPLX_RXN_KINETIC)
2562) icount3 = max(icount3,isrfcplx)
2563) case(SRFCMPLX_RXN_MULTIRATE_KINETIC)
2564) icount2 = max(size(cur_srfcplx_rxn%rates),icount2)
2565) end select
2566) cur_srfcplx_rxn => cur_srfcplx_rxn%next
2567) enddo
2568) nullify(cur_srfcplx_rxn)
2569)
2570) surface_complexation%neqsrfcplx = &
2571) SrfCplxGetSrfCplxCountInRxnType(surface_complexation, &
2572) SRFCMPLX_RXN_EQUILIBRIUM)
2573) surface_complexation%nkinmrsrfcplx = &
2574) SrfCplxGetSrfCplxCountInRxnType(surface_complexation, &
2575) SRFCMPLX_RXN_MULTIRATE_KINETIC)
2576) surface_complexation%nkinsrfcplx = &
2577) SrfCplxGetSrfCplxCountInRxnType(surface_complexation, &
2578) SRFCMPLX_RXN_KINETIC)
2579)
2580) ! surface complexation reaction (general members)
2581) allocate(surface_complexation%srfcplxrxn_to_surf( &
2582) surface_complexation%nsrfcplxrxn))
2583) surface_complexation%srfcplxrxn_to_surf = 0
2584)
2585) allocate(surface_complexation%srfcplxrxn_surf_type( &
2586) surface_complexation%nsrfcplxrxn))
2587) surface_complexation%srfcplxrxn_surf_type = 0
2588)
2589) allocate(surface_complexation%srfcplxrxn_to_complex(0:icount, &
2590) surface_complexation%nsrfcplxrxn))
2591) surface_complexation%srfcplxrxn_to_complex = 0
2592)
2593) allocate(surface_complexation%srfcplxrxn_site_names( &
2594) surface_complexation%nsrfcplxrxn))
2595) surface_complexation%srfcplxrxn_site_names = ''
2596)
2597) allocate(surface_complexation%srfcplxrxn_site_print( &
2598) surface_complexation%nsrfcplxrxn))
2599) surface_complexation%srfcplxrxn_site_print = PETSC_FALSE
2600)
2601) allocate(surface_complexation%srfcplxrxn_site_density_print( &
2602) surface_complexation%nsrfcplxrxn))
2603) surface_complexation%srfcplxrxn_site_density_print = PETSC_FALSE
2604)
2605) allocate(surface_complexation%srfcplxrxn_site_density( &
2606) surface_complexation%nsrfcplxrxn))
2607) surface_complexation%srfcplxrxn_site_density = 0.d0
2608)
2609) allocate(surface_complexation%srfcplxrxn_stoich_flag( &
2610) surface_complexation%nsrfcplxrxn))
2611) surface_complexation%srfcplxrxn_stoich_flag = PETSC_FALSE
2612)
2613) ! equilibrium
2614) if (surface_complexation%neqsrfcplxrxn > 0) then
2615) allocate(surface_complexation%eqsrfcplxrxn_to_srfcplxrxn( &
2616) surface_complexation%neqsrfcplxrxn))
2617) surface_complexation%eqsrfcplxrxn_to_srfcplxrxn = 0
2618) #if 0
2619) !geh: save for later
2620) allocate(surface_complexation%srfcplx_to_eqsrfcplx( &
2621) surface_complexation%nsrfcplx))
2622) surface_complexation%srfcplx_to_eqsrfcplx = 0
2623) call SrfCplxMapMasterSrfCplxToRxn(surface_complexation, &
2624) SRFCMPLX_RXN_EQUILIBRIUM)
2625) #endif
2626) endif
2627)
2628) ! kinetic
2629) if (surface_complexation%nkinsrfcplxrxn > 0) then
2630) allocate(surface_complexation%kinsrfcplxrxn_to_srfcplxrxn( &
2631) surface_complexation%nkinsrfcplxrxn))
2632) surface_complexation%kinsrfcplxrxn_to_srfcplxrxn = 0
2633) allocate(surface_complexation%kinsrfcplx_to_name(icount3, &
2634) surface_complexation%nkinsrfcplxrxn))
2635) surface_complexation%kinsrfcplx_to_name = 0
2636) allocate(surface_complexation%kinsrfcplx_forward_rate(icount3, &
2637) surface_complexation%nkinsrfcplxrxn))
2638) surface_complexation%kinsrfcplx_forward_rate = 0.d0
2639) allocate(surface_complexation%kinsrfcplx_backward_rate(icount3, &
2640) surface_complexation%nkinsrfcplxrxn))
2641) surface_complexation%kinsrfcplx_backward_rate = 0.d0
2642) endif
2643)
2644) ! multirate kinetic surface complexation
2645) if (surface_complexation%nkinmrsrfcplxrxn > 0) then
2646) allocate(surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn( &
2647) surface_complexation%nkinmrsrfcplxrxn))
2648) surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn = 0
2649) allocate(surface_complexation%kinmr_nrate(0: &
2650) surface_complexation%nkinmrsrfcplxrxn))
2651) surface_complexation%kinmr_nrate = 0
2652) allocate(surface_complexation%kinmr_rate(icount2, &
2653) surface_complexation%nkinmrsrfcplxrxn))
2654) surface_complexation%kinmr_rate = 0.d0
2655) allocate(surface_complexation%kinmr_frac(icount2, &
2656) surface_complexation%nkinmrsrfcplxrxn))
2657) surface_complexation%kinmr_frac = 0.d0
2658) endif
2659)
2660) irxn = 0
2661) surface_complexation%neqsrfcplxrxn = 0
2662) surface_complexation%nkinsrfcplxrxn = 0
2663) surface_complexation%nkinmrsrfcplxrxn = 0
2664) cur_srfcplx_rxn => surface_complexation%rxn_list
2665) do
2666) if (.not.associated(cur_srfcplx_rxn)) exit
2667)
2668) irxn = irxn + 1
2669)
2670) select case(cur_srfcplx_rxn%itype)
2671) case(SRFCMPLX_RXN_EQUILIBRIUM)
2672) surface_complexation%neqsrfcplxrxn = &
2673) surface_complexation%neqsrfcplxrxn + 1
2674) surface_complexation%eqsrfcplxrxn_to_srfcplxrxn( &
2675) surface_complexation%neqsrfcplxrxn) = irxn
2676) case(SRFCMPLX_RXN_KINETIC)
2677) surface_complexation%nkinsrfcplxrxn = &
2678) surface_complexation%nkinsrfcplxrxn + 1
2679) surface_complexation%kinsrfcplxrxn_to_srfcplxrxn( &
2680) surface_complexation%nkinsrfcplxrxn) = irxn
2681) isrfcplx = 0
2682) cur_srfcplx => cur_srfcplx_rxn%complex_list
2683) do
2684) if (.not.associated(cur_srfcplx)) exit
2685) isrfcplx = isrfcplx + 1
2686) surface_complexation%kinsrfcplx_to_name(isrfcplx, &
2687) surface_complexation%nkinsrfcplxrxn) = &
2688) cur_srfcplx%ptr%id
2689) surface_complexation%kinsrfcplx_forward_rate(isrfcplx, &
2690) surface_complexation%nkinsrfcplxrxn) = &
2691) cur_srfcplx%forward_rate
2692) ! if backward rate = UNINITIALIZED_INTEGER, the backward rate is calculated
2693) ! as a function of the forward and and equilibrium coefficient
2694) if (Uninitialized(surface_complexation%kinsrfcplx_backward_rate(isrfcplx, &
2695) surface_complexation%nkinsrfcplxrxn))) then
2696) ! backward rate will be calculated based on Kb = Kf * Keq
2697) if (.not.reaction%use_geothermal_hpt) then
2698) call Interpolate(temp_high,temp_low, &
2699) option%reference_temperature, &
2700) cur_srfcplx%dbaserxn%logK(itemp_high), &
2701) cur_srfcplx%dbaserxn%logK(itemp_low), &
2702) value)
2703) else
2704) call ReactionInitializeLogK_hpt(surface_complexation%srfcplx_logKcoef(:,isrfcplx), &
2705) surface_complexation%srfcplx_logK(isrfcplx), &
2706) option,reaction)
2707) endif
2708) surface_complexation%kinsrfcplx_backward_rate(isrfcplx, &
2709) surface_complexation%nkinsrfcplxrxn) = 10.d0**value * &
2710) cur_srfcplx%forward_rate
2711) else
2712) surface_complexation%kinsrfcplx_backward_rate(isrfcplx, &
2713) surface_complexation%nkinsrfcplxrxn) = &
2714) cur_srfcplx%backward_rate
2715) endif
2716) cur_srfcplx => cur_srfcplx%next
2717) enddo
2718) nullify(cur_srfcplx)
2719) case(SRFCMPLX_RXN_MULTIRATE_KINETIC)
2720) surface_complexation%nkinmrsrfcplxrxn = &
2721) surface_complexation%nkinmrsrfcplxrxn + 1
2722) surface_complexation%kinmrsrfcplxrxn_to_srfcplxrxn( &
2723) surface_complexation%nkinmrsrfcplxrxn) = irxn
2724) surface_complexation%kinmr_nrate( &
2725) surface_complexation%nkinmrsrfcplxrxn) = &
2726) size(cur_srfcplx_rxn%rates)
2727) surface_complexation%kinmr_nrate(0) = &
2728) maxval(surface_complexation%kinmr_nrate(1: &
2729) surface_complexation%nkinmrsrfcplxrxn))
2730) surface_complexation%kinmr_rate(1:size(cur_srfcplx_rxn%rates), &
2731) surface_complexation%nkinmrsrfcplxrxn) = cur_srfcplx_rxn%rates
2732) surface_complexation%kinmr_frac( &
2733) 1:size(cur_srfcplx_rxn%site_fractions), &
2734) surface_complexation%nkinmrsrfcplxrxn) = &
2735) cur_srfcplx_rxn%site_fractions
2736) end select
2737)
2738) surface_complexation%srfcplxrxn_site_names(irxn) = &
2739) cur_srfcplx_rxn%free_site_name
2740) surface_complexation%srfcplxrxn_site_print(irxn) = &
2741) cur_srfcplx_rxn%free_site_print_me .or. &
2742) reaction%print_all_species
2743) surface_complexation%srfcplxrxn_site_density_print(irxn) = &
2744) cur_srfcplx_rxn%site_density_print_me .or. &
2745) reaction%print_all_species
2746) surface_complexation%srfcplxrxn_surf_type(irxn) = &
2747) cur_srfcplx_rxn%surface_itype
2748) select case(cur_srfcplx_rxn%surface_itype)
2749) case(ROCK_SURFACE)
2750) ! nothing to do here as the linkage to rick density is already set
2751) case(MINERAL_SURFACE)
2752) surface_complexation%srfcplxrxn_to_surf(irxn) = &
2753) GetKineticMineralIDFromName(cur_srfcplx_rxn%surface_name, &
2754) reaction%mineral,option)
2755) if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
2756) option%io_buffer = 'Mineral ' // &
2757) trim(cur_srfcplx_rxn%surface_name) // &
2758) ' listed in surface complexation ' // &
2759) 'reaction not found in kinetic mineral list'
2760) call printErrMsg(option)
2761) endif
2762) case(COLLOID_SURFACE)
2763) surface_complexation%srfcplxrxn_to_surf(irxn) = &
2764) GetColloidIDFromName(reaction,cur_srfcplx_rxn%surface_name)
2765) if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
2766) option%io_buffer = 'Colloid ' // &
2767) trim(cur_srfcplx_rxn%surface_name) // &
2768) ' listed in surface complexation ' // &
2769) 'reaction not found in colloid list'
2770) call printErrMsg(option)
2771) endif
2772) ! loop over primary species associated with colloid sorption and
2773) ! add to colloid species list, if not already listed
2774) cur_srfcplx_in_rxn => cur_srfcplx_rxn%complex_list
2775) do
2776) if (.not.associated(cur_srfcplx_in_rxn)) exit
2777) ! cur_srfcplx2%ptr is a pointer to complex in master list
2778) cur_srfcplx => cur_srfcplx_in_rxn%ptr
2779) do i = 1, cur_srfcplx%dbaserxn%nspec
2780) if (cur_srfcplx%dbaserxn%spec_ids(i) == h2o_id) cycle
2781) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2782) if (spec_id > h2o_id) spec_id = spec_id - 1
2783) colloid_species_flag(spec_id) = PETSC_TRUE
2784) enddo
2785) nullify(cur_srfcplx)
2786) cur_srfcplx_in_rxn => cur_srfcplx_in_rxn%next
2787) enddo
2788) case(NULL_SURFACE)
2789) write(word,*) cur_srfcplx_rxn%id
2790) option%io_buffer = 'No mineral or colloid name specified ' // &
2791) 'for equilibrium surface complexation reaction:' // &
2792) trim(adjustl(word))
2793) call printWrnMsg(option)
2794) end select
2795) surface_complexation%srfcplxrxn_site_density(irxn) = &
2796) cur_srfcplx_rxn%site_density
2797)
2798) cur_srfcplx_in_rxn => cur_srfcplx_rxn%complex_list
2799) do
2800) if (.not.associated(cur_srfcplx_in_rxn)) exit
2801)
2802) ! remember that cur_srfcplx_in_rxn%ptr points to the complex in the
2803) ! master list
2804) cur_srfcplx => cur_srfcplx_in_rxn%ptr
2805)
2806) isrfcplx = isrfcplx + 1
2807)
2808) ! set up integer pointers from site to complexes
2809) ! increment count for site
2810) surface_complexation%srfcplxrxn_to_complex(0,irxn) = &
2811) surface_complexation%srfcplxrxn_to_complex(0,irxn) + 1
2812) surface_complexation%srfcplxrxn_to_complex( &
2813) surface_complexation%srfcplxrxn_to_complex(0,irxn),irxn) = &
2814) cur_srfcplx%id
2815) if (cur_srfcplx%free_site_stoich > 1.d0) then
2816) surface_complexation%srfcplxrxn_stoich_flag(irxn) = PETSC_TRUE
2817) endif
2818) nullify(cur_srfcplx)
2819) cur_srfcplx_in_rxn => cur_srfcplx_in_rxn%next
2820) enddo
2821)
2822) cur_srfcplx_rxn => cur_srfcplx_rxn%next
2823) enddo
2824) nullify(cur_srfcplx_rxn)
2825)
2826) if (surface_complexation%nsrfcplxrxn /= &
2827) surface_complexation%neqsrfcplxrxn + &
2828) surface_complexation%nkinmrsrfcplxrxn + &
2829) surface_complexation%nkinsrfcplxrxn) then
2830) option%io_buffer = 'Inconsistent number of surface complexation ' // &
2831) 'reactions. (Final Check)'
2832) call printErrMsg(option)
2833) endif
2834)
2835) endif ! surface_complexation%nsrfcplxrxn > 0
2836)
2837) ! allocate colloids species names, mappings, etc.
2838) reaction%ncollcomp = 0
2839) icount = 0
2840) do i = 1, reaction%naqcomp
2841) if (colloid_species_flag(i)) then
2842) icount = icount + 1
2843) endif
2844) enddo
2845) if (icount > 0) then
2846) allocate(reaction%pri_spec_to_coll_spec(reaction%naqcomp))
2847) allocate(reaction%colloid_species_names(icount))
2848) allocate(reaction%coll_spec_to_pri_spec(icount))
2849) reaction%pri_spec_to_coll_spec = UNINITIALIZED_INTEGER
2850) reaction%coll_spec_to_pri_spec = UNINITIALIZED_INTEGER
2851) reaction%colloid_species_names = ''
2852) reaction%ncollcomp = icount
2853) icount = 0
2854) do i = 1, reaction%naqcomp
2855) if (colloid_species_flag(i)) then
2856) icount = icount + 1
2857) reaction%colloid_species_names(icount) = &
2858) trim(reaction%primary_species_names(i))
2859) reaction%coll_spec_to_pri_spec(icount) = i
2860) reaction%pri_spec_to_coll_spec(i) = icount
2861) endif
2862) enddo
2863) if (minval(reaction%coll_spec_to_pri_spec) < 1) then
2864) option%io_buffer = 'Species colloid surface complexation reaction not' // &
2865) ' recognized among primary species'
2866) call printErrMsg(option)
2867) endif
2868) allocate(reaction%total_sorb_mobile_print(reaction%ncollcomp))
2869) reaction%total_sorb_mobile_print = PETSC_FALSE
2870) do i = 1, reaction%ncollcomp
2871) reaction%total_sorb_mobile_print(i) = &
2872) (reaction%primary_species_print(reaction%coll_spec_to_pri_spec(i)) .or. &
2873) reaction%print_all_species) .and. &
2874) reaction%print_total_sorb_mobile
2875) enddo
2876) endif
2877) deallocate(colloid_species_flag)
2878)
2879) if (reaction%neqionxrxn > 0) then
2880)
2881) ! determine max # cations for a given ionx exchange rxn
2882) icount = 0
2883) cur_ionx_rxn => reaction%ion_exchange_rxn_list
2884) do
2885) if (.not.associated(cur_ionx_rxn)) exit
2886) ication = 0
2887) cur_cation => cur_ionx_rxn%cation_list
2888) do
2889) if (.not.associated(cur_cation)) exit
2890) ication = ication + 1
2891) cur_cation => cur_cation%next
2892) enddo
2893) if (ication > icount) icount = ication
2894) cur_ionx_rxn => cur_ionx_rxn%next
2895) enddo
2896) nullify(cur_ionx_rxn)
2897)
2898) allocate(reaction%eqionx_rxn_cationid(0:icount,reaction%neqionxrxn))
2899) reaction%eqionx_rxn_cationid = 0
2900) allocate(reaction%eqionx_rxn_Z_flag(reaction%neqionxrxn))
2901) reaction%eqionx_rxn_Z_flag = PETSC_FALSE
2902) allocate(reaction%eqionx_rxn_cation_X_offset(reaction%neqionxrxn))
2903) reaction%eqionx_rxn_cation_X_offset = 0
2904) allocate(reaction%eqionx_rxn_CEC(reaction%neqionxrxn))
2905) reaction%eqionx_rxn_CEC = 0.d0
2906) allocate(reaction%eqionx_rxn_to_surf(reaction%neqionxrxn))
2907) reaction%eqionx_rxn_to_surf = 0
2908) allocate(reaction%eqionx_rxn_k(icount,reaction%neqionxrxn))
2909) reaction%eqionx_rxn_k = 0.d0
2910)
2911) irxn = 0
2912) icount = 0
2913) cur_ionx_rxn => reaction%ion_exchange_rxn_list
2914) do
2915) if (.not.associated(cur_ionx_rxn)) exit
2916) irxn = irxn + 1
2917) ication = 0
2918) reaction%eqionx_rxn_CEC(irxn) = cur_ionx_rxn%CEC
2919) ! compute the offset to the first cation in rxn
2920) reaction%eqionx_rxn_cation_X_offset(irxn) = icount
2921) if (len_trim(cur_ionx_rxn%mineral_name) > 1) then
2922) reaction%eqionx_rxn_to_surf(irxn) = &
2923) GetKineticMineralIDFromName(cur_ionx_rxn%mineral_name, &
2924) reaction%mineral,option)
2925) if (reaction%eqionx_rxn_to_surf(irxn) < 0) then
2926) option%io_buffer = 'Mineral ' // trim(cur_ionx_rxn%mineral_name) // &
2927) ' listed in ion exchange ' // &
2928) 'reaction not found in mineral list'
2929) call printErrMsg(option)
2930) endif
2931) endif
2932) cur_cation => cur_ionx_rxn%cation_list
2933) do
2934) if (.not.associated(cur_cation)) exit
2935) ication = ication + 1
2936) icount = icount + 1
2937) reaction%eqionx_rxn_k(ication,irxn) = cur_cation%k
2938)
2939) found = PETSC_FALSE
2940) do i = 1, reaction%naqcomp
2941) if (StringCompare(cur_cation%name, &
2942) reaction%primary_species_names(i), &
2943) MAXWORDLENGTH)) then
2944) reaction%eqionx_rxn_cationid(ication,irxn) = i
2945) found = PETSC_TRUE
2946) endif
2947) enddo
2948) if (.not.found) then
2949) option%io_buffer = 'Cation ' // trim(cur_cation%name) // &
2950) ' in ion exchange reaction' // &
2951) ' not found in swapped basis.'
2952) call printErrMsg(option)
2953) endif
2954) cur_cation => cur_cation%next
2955) enddo
2956) reaction%eqionx_rxn_cationid(0,irxn) = ication
2957) ! Find any Zi /= Zj for all species i, j
2958) found = PETSC_FALSE
2959) do i = 1, reaction%eqionx_rxn_cationid(0,irxn)
2960) do j = 1, reaction%eqionx_rxn_cationid(0,irxn)
2961) if (abs(reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(i,irxn))- &
2962) reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(j,irxn))) > &
2963) 0.1d0) then
2964) found = PETSC_TRUE
2965) exit
2966) endif
2967) enddo
2968) if (found) exit
2969) enddo
2970) reaction%eqionx_rxn_Z_flag(irxn) = found
2971) cur_ionx_rxn => cur_ionx_rxn%next
2972) enddo
2973) nullify(cur_ionx_rxn)
2974)
2975) endif
2976)
2977) ! radioactive decay reaction
2978)
2979) if (reaction%nradiodecay_rxn > 0) then
2980)
2981) ! process reaction equation into the database format
2982) cur_radiodecay_rxn => reaction%radioactive_decay_rxn_list
2983) do
2984) if (.not.associated(cur_radiodecay_rxn)) exit
2985) cur_radiodecay_rxn%dbaserxn => &
2986) DatabaseRxnCreateFromRxnString(cur_radiodecay_rxn%reaction, &
2987) reaction%naqcomp, &
2988) reaction%offset_aqueous, &
2989) reaction%primary_species_names, &
2990) reaction%nimcomp, &
2991) reaction%offset_immobile, &
2992) reaction%immobile%names, &
2993) PETSC_FALSE,option)
2994) cur_radiodecay_rxn => cur_radiodecay_rxn%next
2995) enddo
2996) nullify(cur_radiodecay_rxn)
2997)
2998) ! determine max # species for a given radiodecay rxn
2999) max_species_count = 0
3000) cur_radiodecay_rxn => reaction%radioactive_decay_rxn_list
3001) do
3002) if (.not.associated(cur_radiodecay_rxn)) exit
3003)
3004) ! zero count
3005) forward_count = 0
3006)
3007) ! max species in reaction
3008) species_count = cur_radiodecay_rxn%dbaserxn%nspec
3009)
3010) ! sum forward and reverse species
3011) dbaserxn => cur_radiodecay_rxn%dbaserxn
3012) do i = 1, dbaserxn%nspec
3013) if (dbaserxn%stoich(i) < 0.d0) then
3014) forward_count = forward_count + 1
3015) endif
3016) enddo
3017)
3018) if (forward_count > 1) then ! currently cannot have more than one species
3019) option%io_buffer = 'Cannot have more than one reactant in ' // &
3020) 'radioactive decay reaction: (' // &
3021) trim(cur_radiodecay_rxn%reaction) // ').'
3022) call printErrMsg(option)
3023) endif
3024)
3025) ! calculate maximum
3026) if (species_count > max_species_count) max_species_count = species_count
3027)
3028) cur_radiodecay_rxn => cur_radiodecay_rxn%next
3029)
3030) enddo
3031) nullify(cur_radiodecay_rxn)
3032)
3033) allocate(reaction%radiodecayspecid(0:max_species_count,reaction%nradiodecay_rxn))
3034) reaction%radiodecayspecid = 0
3035) allocate(reaction%radiodecaystoich(max_species_count,reaction%nradiodecay_rxn))
3036) reaction%radiodecaystoich = 0.d0
3037) allocate(reaction%radiodecayforwardspecid(reaction%nradiodecay_rxn))
3038) reaction%radiodecayforwardspecid = 0
3039) allocate(reaction%radiodecay_kf(reaction%nradiodecay_rxn))
3040) reaction%radiodecay_kf = 0.d0
3041)
3042) ! load the data into the compressed arrays
3043) irxn = 0
3044) cur_radiodecay_rxn => reaction%radioactive_decay_rxn_list
3045) do
3046) if (.not.associated(cur_radiodecay_rxn)) exit
3047)
3048) dbaserxn => cur_radiodecay_rxn%dbaserxn
3049)
3050) irxn = irxn + 1
3051)
3052) forward_count = 0
3053) backward_count = 0
3054) do i = 1, dbaserxn%nspec
3055) reaction%radiodecayspecid(i,irxn) = dbaserxn%spec_ids(i)
3056) reaction%radiodecaystoich(i,irxn) = dbaserxn%stoich(i)
3057) if (dbaserxn%stoich(i) < 0.d0) then
3058) reaction%radiodecayforwardspecid(irxn) = dbaserxn%spec_ids(i)
3059) endif
3060) enddo
3061) reaction%radiodecayspecid(0,irxn) = dbaserxn%nspec
3062) reaction%radiodecay_kf(irxn) = cur_radiodecay_rxn%rate_constant
3063)
3064) cur_radiodecay_rxn => cur_radiodecay_rxn%next
3065)
3066) enddo
3067)
3068) endif
3069)
3070) ! general reaction
3071)
3072) if (reaction%ngeneral_rxn > 0) then
3073)
3074) ! process reaction equation into the database format
3075) cur_general_rxn => reaction%general_rxn_list
3076) do
3077) if (.not.associated(cur_general_rxn)) exit
3078) cur_general_rxn%dbaserxn => &
3079) DatabaseRxnCreateFromRxnString(cur_general_rxn%reaction, &
3080) reaction%naqcomp, &
3081) reaction%offset_aqueous, &
3082) reaction%primary_species_names, &
3083) reaction%nimcomp, &
3084) reaction%offset_immobile, &
3085) reaction%immobile%names, &
3086) PETSC_FALSE,option)
3087) cur_general_rxn => cur_general_rxn%next
3088) enddo
3089) nullify(cur_general_rxn)
3090)
3091) ! determine max # species, forward species and backward species
3092) ! for a given general rxn
3093) max_species_count = 0
3094) max_forward_count = 0
3095) max_backward_count = 0
3096) cur_general_rxn => reaction%general_rxn_list
3097) do
3098) if (.not.associated(cur_general_rxn)) exit
3099)
3100) ! zero count
3101) forward_count = 0
3102) backward_count = 0
3103)
3104) ! max species in reaction
3105) species_count = cur_general_rxn%dbaserxn%nspec
3106)
3107) ! sum forward and reverse species
3108) dbaserxn => cur_general_rxn%dbaserxn
3109) do i = 1, dbaserxn%nspec
3110) if (dbaserxn%stoich(i) < 0.d0) then
3111) forward_count = forward_count + 1
3112) else if (dbaserxn%stoich(i) > 0.d0) then
3113) backward_count = backward_count + 1
3114) endif
3115) enddo
3116)
3117) ! calculate maximum
3118) if (forward_count > max_forward_count) max_forward_count = forward_count
3119) if (backward_count > max_backward_count) max_backward_count = backward_count
3120) if (species_count > max_species_count) max_species_count = species_count
3121)
3122) cur_general_rxn => cur_general_rxn%next
3123)
3124) enddo
3125) nullify(cur_general_rxn)
3126)
3127) allocate(reaction%generalspecid(0:max_species_count,reaction%ngeneral_rxn))
3128) reaction%generalspecid = 0
3129) allocate(reaction%generalstoich(max_species_count,reaction%ngeneral_rxn))
3130) reaction%generalstoich = 0.d0
3131) allocate(reaction%generalforwardspecid(0:max_forward_count,reaction%ngeneral_rxn))
3132) reaction%generalforwardspecid = 0
3133) allocate(reaction%generalforwardstoich(max_forward_count,reaction%ngeneral_rxn))
3134) reaction%generalforwardstoich = 0.d0
3135) allocate(reaction%generalbackwardspecid(0:max_backward_count,reaction%ngeneral_rxn))
3136) reaction%generalbackwardspecid = 0
3137) allocate(reaction%generalbackwardstoich(max_backward_count,reaction%ngeneral_rxn))
3138) reaction%generalbackwardstoich = 0.d0
3139) allocate(reaction%generalh2oid(reaction%ngeneral_rxn))
3140) reaction%generalh2oid = 0
3141) allocate(reaction%generalh2ostoich(reaction%ngeneral_rxn))
3142) reaction%generalh2ostoich = 0.d0
3143) allocate(reaction%general_kf(reaction%ngeneral_rxn))
3144) reaction%general_kf = 0.d0
3145) allocate(reaction%general_kr(reaction%ngeneral_rxn))
3146) reaction%general_kr = 0.d0
3147)
3148) ! load the data into the compressed arrays
3149) irxn = 0
3150) cur_general_rxn => reaction%general_rxn_list
3151) do
3152) if (.not.associated(cur_general_rxn)) exit
3153)
3154) dbaserxn => cur_general_rxn%dbaserxn
3155)
3156) irxn = irxn + 1
3157)
3158) forward_count = 0
3159) backward_count = 0
3160) do i = 1, dbaserxn%nspec
3161) reaction%generalspecid(i,irxn) = dbaserxn%spec_ids(i)
3162) reaction%generalstoich(i,irxn) = dbaserxn%stoich(i)
3163) if (dbaserxn%stoich(i) < 0.d0) then
3164) forward_count = forward_count + 1
3165) reaction%generalforwardspecid(forward_count,irxn) = dbaserxn%spec_ids(i)
3166) ! ensure that forward stoich is positive for rate expression
3167) reaction%generalforwardstoich(forward_count,irxn) = dabs(dbaserxn%stoich(i))
3168) else if (dbaserxn%stoich(i) > 0.d0) then
3169) backward_count = backward_count + 1
3170) reaction%generalbackwardspecid(backward_count,irxn) = dbaserxn%spec_ids(i)
3171) reaction%generalbackwardstoich(backward_count,irxn) = dbaserxn%stoich(i)
3172) endif
3173) enddo
3174) reaction%generalspecid(0,irxn) = dbaserxn%nspec
3175) reaction%generalforwardspecid(0,irxn) = forward_count
3176) reaction%generalbackwardspecid(0,irxn) = backward_count
3177)
3178) reaction%general_kf(irxn) = cur_general_rxn%forward_rate
3179) reaction%general_kr(irxn) = cur_general_rxn%backward_rate
3180)
3181) cur_general_rxn => cur_general_rxn%next
3182)
3183) enddo
3184)
3185) endif
3186)
3187) ! microbial reaction
3188) if (microbial%nrxn > 0) then
3189)
3190) ! process reaction equation into the database format
3191) max_species_count = 0
3192) max_monod_count = 0
3193) max_inhibition_count = 0
3194) monod_count = 0
3195) inhibition_count = 0
3196) activation_energy_count = 0
3197) cur_microbial_rxn => microbial%microbial_rxn_list
3198) do
3199) if (.not.associated(cur_microbial_rxn)) exit
3200) cur_microbial_rxn%dbaserxn => &
3201) DatabaseRxnCreateFromRxnString(cur_microbial_rxn%reaction, &
3202) reaction%naqcomp, &
3203) reaction%offset_aqueous, &
3204) reaction%primary_species_names, &
3205) reaction%nimcomp, &
3206) reaction%offset_immobile, &
3207) reaction%immobile%names, &
3208) PETSC_TRUE,option)
3209) if (cur_microbial_rxn%activation_energy > 0.d0) then
3210) activation_energy_count = activation_energy_count + 1
3211) endif
3212) temp_int = cur_microbial_rxn%dbaserxn%nspec
3213) if (temp_int > max_species_count) max_species_count = temp_int
3214) temp_int = MicrobialGetMonodCount(cur_microbial_rxn)
3215) monod_count = monod_count + temp_int
3216) if (temp_int > max_monod_count) max_monod_count = temp_int
3217) temp_int = MicrobialGetInhibitionCount(cur_microbial_rxn)
3218) inhibition_count = inhibition_count + temp_int
3219) if (temp_int > max_inhibition_count) max_inhibition_count = temp_int
3220) cur_microbial_rxn => cur_microbial_rxn%next
3221) enddo
3222) nullify(cur_microbial_rxn)
3223)
3224) ! rate constant
3225) allocate(microbial%rate_constant(microbial%nrxn))
3226) microbial%rate_constant = 0.d0
3227)
3228) ! activation_energy
3229) if (activation_energy_count > 0) then
3230) allocate(microbial%activation_energy(microbial%nrxn))
3231) microbial%activation_energy = 0.d0
3232) endif
3233)
3234) ! species ids and stoichiometry
3235) allocate(microbial%specid(0:max_species_count,microbial%nrxn))
3236) microbial%specid = 0
3237) allocate(microbial%stoich(max_species_count,microbial%nrxn))
3238) microbial%stoich = 0.d0
3239)
3240) ! biomass id and yield
3241) allocate(microbial%biomassid(microbial%nrxn))
3242) microbial%biomassid = 0
3243) allocate(microbial%biomass_yield(microbial%nrxn))
3244) microbial%biomass_yield = 0.d0
3245)
3246) ! linkage to monod and inhibition terms
3247) allocate(microbial%monodid(0:max_monod_count,microbial%nrxn))
3248) microbial%monodid = 0
3249) allocate(microbial%inhibitionid(0:max_inhibition_count, &
3250) microbial%nrxn))
3251) microbial%inhibitionid = 0
3252)
3253) ! monod
3254) allocate(microbial%monod_specid(monod_count))
3255) microbial%monod_specid = 0
3256) allocate(microbial%monod_K(monod_count))
3257) microbial%monod_K = 0.d0
3258) allocate(microbial%monod_Cth(monod_count))
3259) microbial%monod_Cth = 0.d0
3260)
3261) ! inhibition
3262) allocate(microbial%inhibition_specid(inhibition_count))
3263) microbial%inhibition_specid = 0
3264) allocate(microbial%inhibition_type(inhibition_count))
3265) microbial%inhibition_type = 0
3266) allocate(microbial%inhibition_C(inhibition_count))
3267) microbial%inhibition_C = 0.d0
3268) allocate(microbial%inhibition_C2(inhibition_count))
3269) microbial%inhibition_C2 = 0.d0
3270)
3271) ! load the data into the compressed arrays
3272) irxn = 0
3273) monod_count = 0
3274) inhibition_count = 0
3275) cur_microbial_rxn => microbial%microbial_rxn_list
3276) do
3277) if (.not.associated(cur_microbial_rxn)) exit
3278)
3279) dbaserxn => cur_microbial_rxn%dbaserxn
3280)
3281) irxn = irxn + 1
3282)
3283) microbial%rate_constant(irxn) = cur_microbial_rxn%rate_constant
3284) if (associated(microbial%activation_energy)) then
3285) microbial%activation_energy(irxn) = cur_microbial_rxn%activation_energy
3286) endif
3287)
3288) microbial%specid(0,irxn) = dbaserxn%nspec
3289) do i = 1, dbaserxn%nspec
3290) microbial%specid(i,irxn) = dbaserxn%spec_ids(i)
3291) microbial%stoich(i,irxn) = dbaserxn%stoich(i)
3292) enddo
3293)
3294) if (associated(cur_microbial_rxn%biomass)) then
3295) ! check for biomass species in global immobile list
3296) temp_int = &
3297) StringFindEntryInList(cur_microbial_rxn%biomass%species_name, &
3298) immobile%names)
3299) if (temp_int == 0) then
3300) option%io_buffer = 'Biomass species "' // &
3301) trim(cur_microbial_rxn%biomass%species_name) // &
3302) ' not found among immobile species.'
3303) call printErrMsg(option)
3304) else
3305) microbial%biomassid(irxn) = temp_int
3306) microbial%biomass_yield(irxn) = &
3307) cur_microbial_rxn%biomass%yield
3308) endif
3309) ! check for biomass species in microbial reaction
3310) temp_int = &
3311) StringFindEntryInList(cur_microbial_rxn%biomass%species_name, &
3312) dbaserxn%spec_name)
3313) if (temp_int /= 0) then
3314) option%io_buffer = 'Biomass species "' // &
3315) trim(cur_microbial_rxn%biomass%species_name) // &
3316) ' should not be included in microbial reaction.'
3317) call printErrMsg(option)
3318) endif
3319) endif
3320)
3321) cur_monod => cur_microbial_rxn%monod
3322) do
3323) if (.not.associated(cur_monod)) exit
3324) monod_count = monod_count + 1
3325)
3326) ! increment # of monod reactions in microbial reaction
3327) microbial%monodid(0,irxn) = microbial%monodid(0,irxn) + 1
3328) ! set global id of this monod reaction
3329) microbial%monodid(microbial%monodid(0,irxn),irxn) = monod_count
3330)
3331) ! ensure that monod species exists in reaction expression
3332) temp_int = StringFindEntryInList(cur_monod%species_name, &
3333) dbaserxn%spec_name)
3334) if (temp_int == 0) then
3335) option%io_buffer = 'Monod species "' // &
3336) trim(cur_monod%species_name) // ' not found in microbial reaction.'
3337) call printErrMsg(option)
3338) endif
3339) ! if species stoichiometry is > 0., it is a product and cannot be
3340) ! used in a monod expression.
3341) if (dbaserxn%stoich(temp_int) > 0.d0) then
3342) option%io_buffer = 'Monod species "' // &
3343) trim(cur_monod%species_name) // ' must be a reactant and not ' // &
3344) 'a product in microbial reaction.'
3345) call printErrMsg(option)
3346) endif
3347)
3348) microbial%monod_specid(monod_count) = &
3349) GetPrimarySpeciesIDFromName(cur_monod%species_name,reaction,option)
3350) microbial%monod_K(monod_count) = cur_monod%half_saturation_constant
3351) microbial%monod_Cth(monod_count) = cur_monod%threshold_concentration
3352) cur_monod => cur_monod%next
3353) enddo
3354)
3355) cur_inhibition => cur_microbial_rxn%inhibition
3356) do
3357) if (.not.associated(cur_inhibition)) exit
3358) inhibition_count = inhibition_count + 1
3359)
3360) ! increment # of inhibition reactions in microbial reaction
3361) microbial%inhibitionid(0,irxn) = microbial%inhibitionid(0,irxn) + 1
3362) ! set global id of this inhibition reaction
3363) microbial%inhibitionid(microbial%inhibitionid(0,irxn),irxn) = &
3364) inhibition_count
3365)
3366) ! Check whether inhibition species exists in reaction expression
3367) ! If no, print warning.
3368) temp_int = StringFindEntryInList(cur_inhibition%species_name, &
3369) dbaserxn%spec_name)
3370) if (temp_int == 0) then
3371) option%io_buffer = 'Inhibition species "' // &
3372) trim(cur_inhibition%species_name) // &
3373) ' not found in microbial reaction.'
3374) call printWrnMsg(option)
3375) endif
3376)
3377) microbial%inhibition_specid(inhibition_count) = &
3378) GetPrimarySpeciesIDFromName(cur_inhibition%species_name, &
3379) reaction,option)
3380) microbial%inhibition_type(inhibition_count) = &
3381) cur_inhibition%itype
3382) microbial%inhibition_C(inhibition_count) = &
3383) cur_inhibition%inhibition_constant
3384) microbial%inhibition_C2(inhibition_count) = &
3385) cur_inhibition%inhibition_constant2
3386) cur_inhibition => cur_inhibition%next
3387) enddo
3388)
3389) cur_microbial_rxn => cur_microbial_rxn%next
3390)
3391) enddo
3392)
3393) endif
3394)
3395) ! immobile decay reaction
3396)
3397) if (reaction%immobile%ndecay_rxn > 0) then
3398)
3399) allocate(reaction%immobile%decayspecid(reaction%immobile%ndecay_rxn))
3400) allocate(reaction%immobile%decay_rate_constant(reaction%immobile%ndecay_rxn))
3401)
3402) cur_immobile_decay_rxn => reaction%immobile%decay_rxn_list
3403) irxn = 0
3404) do
3405) if (.not.associated(cur_immobile_decay_rxn)) exit
3406)
3407) irxn = irxn + 1
3408)
3409) found = PETSC_FALSE
3410) do i = 1, reaction%immobile%nimmobile
3411) if (StringCompare(cur_immobile_decay_rxn%species_name, &
3412) reaction%immobile%names(i), &
3413) MAXWORDLENGTH)) then
3414) reaction%immobile%decayspecid(irxn) = i
3415) found = PETSC_TRUE
3416) exit
3417) endif
3418) enddo
3419) if (.not.found) then
3420) option%io_buffer = 'Species "' // &
3421) trim(cur_immobile_decay_rxn%species_name) // &
3422) '" in immobile decay reaction not found among immobile species.'
3423) call printErrMsg(option)
3424) endif
3425) reaction%immobile%decay_rate_constant(irxn) = &
3426) cur_immobile_decay_rxn%rate_constant
3427) cur_immobile_decay_rxn => cur_immobile_decay_rxn%next
3428) enddo
3429) nullify(cur_immobile_decay_rxn)
3430)
3431) endif
3432)
3433) ! Kd reactions
3434)
3435) if (reaction%neqkdrxn > 0) then
3436)
3437) if (reaction%neqcplx > 0) then
3438) option%io_buffer = 'Isotherm reactions currently calculated as a ' // &
3439) 'function of free-ion, not totals. Contact Glenn!'
3440) call printErrMsg(option)
3441) endif
3442)
3443) ! allocate arrays
3444) allocate(reaction%eqkdspecid(reaction%neqkdrxn))
3445) reaction%eqkdspecid = 0
3446) allocate(reaction%eqkdtype(reaction%neqkdrxn))
3447) reaction%eqkdtype = 0
3448) allocate(reaction%eqkddistcoef(reaction%neqkdrxn))
3449) reaction%eqkddistcoef = 0.d0
3450) allocate(reaction%eqkdlangmuirb(reaction%neqkdrxn))
3451) reaction%eqkdlangmuirb = 0.d0
3452) allocate(reaction%eqkdfreundlichn(reaction%neqkdrxn))
3453) reaction%eqkdfreundlichn = 0.d0
3454) allocate(reaction%eqkdmineral(reaction%neqkdrxn))
3455) reaction%eqkdmineral = 0
3456)
3457) cur_kd_rxn => reaction%kd_rxn_list
3458)
3459) if (option%use_mc) then
3460) allocate(reaction%sec_cont_eqkdtype(reaction%neqkdrxn))
3461) reaction%sec_cont_eqkdtype = 0
3462) allocate(reaction%sec_cont_eqkddistcoef(reaction%neqkdrxn))
3463) reaction%sec_cont_eqkddistcoef = 0.d0
3464) allocate(reaction%sec_cont_eqkdlangmuirb(reaction%neqkdrxn))
3465) reaction%sec_cont_eqkdlangmuirb = 0.d0
3466) allocate(reaction%sec_cont_eqkdfreundlichn(reaction%neqkdrxn))
3467) reaction%sec_cont_eqkdfreundlichn = 0.d0
3468) sec_cont_cur_kd_rxn => reaction%sec_cont_kd_rxn_list
3469) endif
3470)
3471) irxn = 0
3472) do
3473) if (.not.associated(cur_kd_rxn)) exit
3474)
3475) irxn = irxn + 1
3476)
3477) found = PETSC_FALSE
3478) do i = 1, reaction%naqcomp
3479) if (StringCompare(cur_kd_rxn%species_name, &
3480) reaction%primary_species_names(i), &
3481) MAXWORDLENGTH)) then
3482) reaction%eqkdspecid(irxn) = i
3483) found = PETSC_TRUE
3484) exit
3485) endif
3486) enddo
3487) if (.not.found) then
3488) option%io_buffer = 'Species ' // trim(word) // &
3489) ' in kd reaction' // &
3490) ' not found among primary species list.'
3491) call printErrMsg(option)
3492) endif
3493) reaction%eqkdtype(irxn) = cur_kd_rxn%itype
3494) ! associate mineral id
3495) if (len_trim(cur_kd_rxn%kd_mineral_name) > 1) then
3496) reaction%eqkdmineral(irxn) = &
3497) GetKineticMineralIDFromName(cur_kd_rxn%kd_mineral_name, &
3498) reaction%mineral,option)
3499) if (reaction%eqkdmineral(irxn) < 0) then
3500) option%io_buffer = 'Mineral ' // trim(cur_ionx_rxn%mineral_name) // &
3501) ' listed in kd (linear sorption)' // &
3502) 'reaction not found in mineral list'
3503) call printErrMsg(option)
3504) endif
3505) endif
3506) reaction%eqkddistcoef(irxn) = cur_kd_rxn%Kd
3507) reaction%eqkdlangmuirb(irxn) = cur_kd_rxn%Langmuir_b
3508) reaction%eqkdfreundlichn(irxn) = cur_kd_rxn%Freundlich_n
3509)
3510) cur_kd_rxn => cur_kd_rxn%next
3511)
3512) if (option%use_mc) then
3513) reaction%sec_cont_eqkdtype(irxn) = sec_cont_cur_kd_rxn%itype
3514) reaction%sec_cont_eqkddistcoef(irxn) = sec_cont_cur_kd_rxn%Kd
3515) reaction%sec_cont_eqkdlangmuirb(irxn) = sec_cont_cur_kd_rxn%Langmuir_b
3516) reaction%sec_cont_eqkdfreundlichn(irxn) = sec_cont_cur_kd_rxn%Freundlich_n
3517) sec_cont_cur_kd_rxn => sec_cont_cur_kd_rxn%next
3518) endif
3519)
3520)
3521) enddo
3522) endif
3523)
3524) call BasisPrint(reaction,'Final Basis',option)
3525)
3526) ! locate specific species
3527) reaction%species_idx => SpeciesIndexCreate()
3528) do ispec = 1, reaction%naqcomp
3529) if (reaction%species_idx%h_ion_id == 0) then
3530) word = 'H+'
3531) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3532) word)) then
3533) reaction%species_idx%h_ion_id = ispec
3534) endif
3535) endif
3536) if (reaction%species_idx%na_ion_id == 0) then
3537) word = 'Na+'
3538) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3539) word)) then
3540) reaction%species_idx%na_ion_id = ispec
3541) endif
3542) endif
3543) if (reaction%species_idx%cl_ion_id == 0) then
3544) word = 'Cl-'
3545) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3546) word)) then
3547) reaction%species_idx%cl_ion_id = ispec
3548) endif
3549) endif
3550) if (reaction%species_idx%co2_aq_id == 0) then
3551) word = 'CO2(aq)'
3552) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3553) word)) then
3554) reaction%species_idx%co2_aq_id = ispec
3555) endif
3556) endif
3557) if (reaction%species_idx%tracer_aq_id == 0) then
3558) word = 'Tracer'
3559) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3560) word)) then
3561) reaction%species_idx%tracer_aq_id = ispec
3562) endif
3563) endif
3564) if (reaction%species_idx%h2o_aq_id == 0) then
3565) word = 'H2O'
3566) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3567) word)) then
3568) reaction%species_idx%h2o_aq_id = ispec
3569) endif
3570) endif
3571) if (reaction%species_idx%tracer_age_id == 0) then
3572) word = 'Tracer_Age'
3573) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3574) word)) then
3575) reaction%species_idx%tracer_age_id = ispec
3576) reaction%calculate_tracer_age = PETSC_TRUE
3577) endif
3578) endif
3579) if (reaction%species_idx%water_age_id == 0) then
3580) word = 'Water_Age'
3581) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
3582) word)) then
3583) reaction%species_idx%water_age_id = ispec
3584) reaction%calculate_water_age = PETSC_TRUE
3585) endif
3586) endif
3587) enddo
3588)
3589) do ispec = 1, reaction%neqcplx
3590) if (reaction%species_idx%h_ion_id == 0) then
3591) word = 'H+'
3592) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
3593) word)) then
3594) reaction%species_idx%h_ion_id = -ispec
3595) endif
3596) endif
3597) if (reaction%species_idx%na_ion_id == 0) then
3598) word = 'Na+'
3599) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
3600) word)) then
3601) reaction%species_idx%na_ion_id = -ispec
3602) endif
3603) endif
3604) if (reaction%species_idx%cl_ion_id == 0) then
3605) word = 'Cl-'
3606) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
3607) word)) then
3608) reaction%species_idx%cl_ion_id = -ispec
3609) endif
3610) endif
3611) if (reaction%species_idx%co2_aq_id == 0) then
3612) word = 'CO2(aq)'
3613) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
3614) word)) then
3615) reaction%species_idx%co2_aq_id = -ispec
3616) endif
3617) endif
3618) enddo
3619)
3620) do ispec = 1, reaction%ngas
3621) if (reaction%species_idx%o2_gas_id == 0) then
3622) word = 'O2(g)'
3623) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
3624) word)) then
3625) reaction%species_idx%o2_gas_id = ispec
3626) endif
3627) endif
3628) if (reaction%species_idx%co2_gas_id == 0) then
3629) word = 'CO2(g)'
3630) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
3631) word)) then
3632) reaction%species_idx%co2_gas_id = ispec
3633) endif
3634) word = 'CO2(g)*'
3635) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
3636) word)) then
3637) reaction%species_idx%co2_gas_id = ispec
3638) endif
3639)
3640) endif
3641)
3642) enddo
3643)
3644) ! sandbox reactions
3645) call RSandboxSetup(reaction,option)
3646) call RCLMRxnSetup(reaction,option)
3647)
3648) 90 format(80('-'))
3649) 100 format(/,2x,i4,2x,a)
3650) 110 format(100(/,14x,3(a20,2x)))
3651) 120 format(/,a)
3652)
3653) if (OptionPrintToFile(option)) then
3654) write(option%fid_out,90)
3655) write(option%fid_out,100) reaction%naqcomp, 'Primary Species'
3656) write(option%fid_out,110) (reaction%primary_species_names(i),i=1,reaction%naqcomp)
3657)
3658) write(option%fid_out,100) reaction%neqcplx, 'Secondary Complex Species'
3659) write(option%fid_out,110) (reaction%secondary_species_names(i),i=1,reaction%neqcplx)
3660)
3661) write(option%fid_out,100) reaction%ngas, 'Gas Species'
3662) write(option%fid_out,110) (reaction%gas_species_names(i),i=1,reaction%ngas)
3663)
3664) write(option%fid_out,100) mineral%nmnrl, 'Reference Minerals'
3665) write(option%fid_out,110) (mineral%mineral_names(i),i=1,mineral%nmnrl)
3666)
3667) write(option%fid_out,100) mineral%nkinmnrl, 'Kinetic Mineral Reactions'
3668) write(option%fid_out,110) (mineral%kinmnrl_names(i),i=1,mineral%nkinmnrl)
3669)
3670) if (surface_complexation%nsrfcplxrxn > 0) then
3671) write(word,*) surface_complexation%nsrfcplxrxn
3672) write(option%fid_out,120) trim(adjustl(word)) // &
3673) ' Surface Complexation Reactions'
3674) write(option%fid_out,110) (surface_complexation%srfcplxrxn_site_names(i), &
3675) i=1,surface_complexation%nsrfcplxrxn)
3676) write(word,*) surface_complexation%nsrfcplx
3677) write(option%fid_out,120) trim(adjustl(word)) // ' Surface Complexes'
3678) write(option%fid_out,110) (surface_complexation%srfcplx_names(i), &
3679) i=1,surface_complexation%nsrfcplx)
3680) endif
3681)
3682) write(option%fid_out,100) reaction%neqionxrxn, 'Ion Exchange Reactions'
3683) write(option%fid_out,100) reaction%neqionxcation, 'Ion Exchange Cations'
3684) write(option%fid_out,90)
3685) endif
3686)
3687) #ifdef AMANZI_BGD
3688) ! output reaction in amanzi "bgd" formatted file
3689) if (OptionPrintToFile(option)) then
3690) string = trim(option%global_prefix) // '.bgd'
3691) open(unit=86,file=trim(string))
3692)
3693) write(86,'("# pflotran database preprocessing :")')
3694) call date_and_time(date=word,time=word2)
3695) write(86,'("# date : ",a," ",a)') trim(word), trim(word2)
3696) write(86,'("# input : ",a)') trim(option%input_filename)
3697)
3698) write(86,'(/,"<Primary Aqueous Species")')
3699) do icomp = 1, reaction%naqcomp
3700) write(86,'(a,x,3(" ; ",f6.2))') trim(reaction%primary_species_names(icomp)), &
3701) reaction%primary_spec_a0(icomp), &
3702) reaction%primary_spec_Z(icomp), &
3703) reaction%primary_spec_molar_wt(icomp)
3704) enddo
3705)
3706) write(86,'(/,"<Aqueous Equilibrium Complexes")')
3707) do icplx = 1, reaction%neqcplx
3708) write(86,'(a," = ")',advance='no') trim(reaction%secondary_species_names(icplx))
3709) if (reaction%eqcplxh2oid(icplx) > 0) then
3710) write(86,'(f6.2," H2O ")',advance='no') reaction%eqcplxh2ostoich(icplx)
3711) endif
3712)
3713) do i = 1,reaction%eqcplxspecid(0,icplx)
3714) temp_tin = reaction%eqcplxspecid(i,icplx)
3715) write(86,'(f6.2,x,a,x)',advance='no') reaction%eqcplxstoich(i,icplx), &
3716) trim(reaction%primary_species_names(temp_int))
3717) enddo
3718) write(86,'(4(" ; ",f10.5))') reaction%eqcplx_logK(icplx), &
3719) reaction%eqcplx_a0(icplx), &
3720) reaction%eqcplx_Z(icplx), &
3721) reaction%eqcplx_molar_wt(icplx)
3722) enddo
3723)
3724) write(86,'(/,"<General Kinetics")')
3725) do irxn = 1, reaction%ngeneral_rxn
3726) do i = 1, reaction%generalforwardspecid(0,irxn)
3727) temp_int = reaction%generalforwardspecid(i,irxn)
3728) write(86,'(f6.2,x,a)',advance='no') reaction%generalforwardstoich(i,irxn), &
3729) trim(reaction%primary_species_names(temp_int))
3730) if (i /= reaction%generalforwardspecid(0,irxn)) then
3731) write(86,'(" + ")',advance='no')
3732) endif
3733) enddo
3734) write(86,'(" <-> ")',advance='no')
3735) do i = 1, reaction%generalbackwardspecid(0,irxn)
3736) temp_int = reaction%generalbackwardspecid(i,irxn)
3737) write(86,'(f6.2,x,a)',advance='no') reaction%generalbackwardstoich(i,irxn), &
3738) trim(reaction%primary_species_names(temp_int))
3739) if (i /= reaction%generalbackwardspecid(0,irxn)) then
3740) write(86,'(" + ")',advance='no')
3741) endif
3742) enddo
3743) write(86,'(" ; ")',advance='no')
3744) do i = 1, reaction%generalforwardspecid(0,irxn)
3745) temp_int = reaction%generalforwardspecid(i,irxn)
3746) write(86,'(f6.2,x,a)',advance='no') reaction%generalforwardstoich(i,irxn), &
3747) trim(reaction%primary_species_names(temp_int))
3748) enddo
3749) write(86,'(" ; ")',advance='no')
3750) write(86,'(1es13.5)',advance='no') reaction%general_kf(irxn)
3751) write(86,'(" ; ")',advance='no')
3752) do i = 1, reaction%generalbackwardspecid(0,irxn)
3753) temp_int = reaction%generalbackwardspecid(i,irxn)
3754) write(86,'(f6.2,x,a)',advance='no') reaction%generalbackwardstoich(i,irxn), &
3755) trim(reaction%primary_species_names(temp_int))
3756) enddo
3757) write(86,'(" ; ")',advance='no')
3758) write(86,'(1es13.5)') reaction%general_kr(irxn)
3759) !write(86,'(" ; ")',advance='no')
3760) !write(86,'(f6.2)',advance='no') reaction%generalh2ostoich(irxn)
3761) enddo
3762)
3763) write(86,'(/,"<Minerals")')
3764)
3765) do imnrl = 1, mineral%nkinmnrl
3766) write(86,'(a," = ")',advance='no') trim(mineral%kinmnrl_names(imnrl))
3767) if (mineral%kinmnrlh2oid(imnrl) > 0) then
3768) write(86,'(f6.2," H2O ")',advance='no') mineral%kinmnrlh2ostoich(imnrl)
3769) endif
3770) do i = 1, mineral%kinmnrlspecid(0,imnrl)
3771) temp_tin = mineral%kinmnrlspecid(i,imnrl)
3772) write(86,'(f6.2,x,a,x)',advance='no') mineral%kinmnrlstoich(i,imnrl), &
3773) trim(reaction%primary_species_names(temp_int))
3774) enddo
3775) !molar volume has been converted to m^3/mol!
3776) write(86,'(4(" ; ",1es13.5))') mineral%kinmnrl_logK(imnrl), &
3777) mineral%kinmnrl_molar_wt(imnrl), &
3778) mineral%kinmnrl_molar_vol(imnrl)*1.d6, 1.0
3779) enddo
3780)
3781) write(86,'(/,"<Mineral Kinetics")')
3782) do imnrl = 1, mineral%nkinmnrl
3783) write(86,'(a," ; TST ; log10_rate_constant ")',advance='no') &
3784) trim(mineral%kinmnrl_names(imnrl))
3785) write(86,'(1es13.5," moles/cm^2/sec ")',advance='no') &
3786) log10(mineral%kinmnrl_rate_constant(imnrl))
3787) if (mineral%kinmnrl_num_prefactors(imnrl) /= 0) then
3788) write(86,'(" ; ")',advance='no')
3789) do i = 1, mineral%kinmnrl_num_prefactors(imnrl)
3790) ! number of prefactor species stored in kinmnrl_prefactor_id(0,i,imnrl)
3791) do j = 1, mineral%kinmnrl_prefactor_id(0,i,imnrl)
3792) temp_int = mineral%kinmnrl_prefactor_id(j,i,imnrl)
3793) if (temp_int > 0) then
3794) write(86,'(a)',advance='no') &
3795) trim(reaction%primary_species_names(temp_int))
3796) else
3797) write(86,'(a)',advance='no') &
3798) trim(reaction%secondary_species_names(-temp_int))
3799) endif
3800) write(86,'(x,1es13.5,x)',advance='no') &
3801) mineral%kinmnrl_pref_alpha(j,i,imnrl)
3802) enddo
3803) enddo
3804) endif
3805) write(86,*)
3806) enddo
3807)
3808) write(86,'(/,"<Ion Exchange Sites")')
3809) do irxn = 1, reaction%neqionxrxn
3810) write(86,'("X- ; -1.0 ; ",a)') trim(reaction%ion_exchange_rxn_list%mineral_name)
3811) enddo
3812)
3813) write(86,'(/,"<Ion Exchange Complexes")')
3814) do irxn = 1, reaction%neqionxrxn
3815) do i = 1, reaction%neqionxcation
3816) temp_int = reaction%eqionx_rxn_cationid(i,irxn)
3817) write(86,'(a,"X = 1.0 ",a)',advance='no') &
3818) trim(reaction%primary_species_names(temp_int)), &
3819) trim(reaction%primary_species_names(temp_int))
3820) write(86,'(f6.2," X- ")',advance='no') reaction%primary_spec_Z(temp_int)
3821) write(86,'(" ; ",1es13.5)') reaction%eqionx_rxn_k(i,irxn)
3822) enddo
3823) enddo
3824)
3825) write(86,'(/,"<Surface Complex Sites")')
3826) do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
3827) irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
3828) write(86,'(a, " ; ")',advance='no') &
3829) trim(surface_complexation%srfcplxrxn_site_names(irxn))
3830) write(86,'(1es13.5)') surface_complexation%srfcplxrxn_site_density(irxn)
3831) enddo
3832)
3833) write(86,'(/,"<Surface Complexes")')
3834) do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
3835) irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
3836) do i = 1, surface_complexation%srfcplxrxn_to_complex(0,irxn)
3837) icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
3838) write(86,'(a, " = ")',advance='no') &
3839) trim(surface_complexation%srfcplx_names(icplx))
3840) write(86,'(f6.2,x,a)',advance='no') &
3841) surface_complexation%srfcplx_free_site_stoich(icplx), &
3842) trim(surface_complexation%srfcplxrxn_site_names(irxn))
3843)
3844) if (surface_complexation%srfcplxh2oid(icplx) > 0) then
3845) write(86,'(f6.2," H2O ")',advance='no') &
3846) surface_complexation%srfcplxh2ostoich(icplx)
3847) endif
3848) do j = 1, surface_complexation%srfcplxspecid(0,icplx)
3849) temp_int = surface_complexation%srfcplxspecid(j,icplx)
3850) write(86,'(f6.2,x,a)',advance='no') &
3851) surface_complexation%srfcplxstoich(j,icplx), &
3852) trim(reaction%primary_species_names(temp_int))
3853) enddo
3854) write(86,'(" ; ",1es13.5," ; ",f6.2)') &
3855) surface_complexation%srfcplx_logK(icplx), &
3856) surface_complexation%srfcplx_Z(icplx)
3857)
3858) enddo
3859) enddo
3860)
3861) write(86,'(/,"<Isotherms")')
3862) do irxn = 1, reaction%neqkdrxn
3863) write(86,'(a," ; ")',advance='no') trim(reaction%primary_species_names(reaction%eqkdspecid(irxn)))
3864) select case (reaction%eqkdtype(irxn))
3865) case(SORPTION_LINEAR)
3866) write(86,'("linear ; ",es13.5)',advance='no') reaction%eqkddistcoef(irxn)
3867) write(86,'()')
3868) case(SORPTION_LANGMUIR)
3869) write(86,'("langmuir ; ",es13.5)',advance='no') reaction%eqkddistcoef(irxn)
3870) write(86,'(es13.5)') reaction%eqkdlangmuirb(irxn)
3871) case(SORPTION_FREUNDLICH)
3872) write(86,'("freundlich ; ",es13.5)',advance='no') reaction%eqkddistcoef(irxn)
3873) write(86,'(es13.5)') reaction%eqkdfreundlichn(irxn)
3874) end select
3875) enddo
3876)
3877) close(86)
3878) endif
3879) #endif
3880) ! AMANZI_BGD
3881)
3882) #if 0
3883) ! output for ASCEM reactions
3884) if (OptionPrintToFile(option)) then
3885) open(unit=86,file='reaction.dat')
3886) write(86,'(10i4)') reaction%naqcomp, reaction%neqcplx, reaction%ngeneral_rxn, &
3887) reaction%neqsrfcplxrxn, mineral%nkinmnrl
3888) do icomp = 1, reaction%naqcomp
3889) write(86,'(a12,f6.2,f6.2)') reaction%primary_species_names(icomp), &
3890) reaction%primary_spec_Z(icomp), &
3891) reaction%primary_spec_a0(icomp)
3892) enddo
3893) do icplx = 1, reaction%neqcplx
3894) write(86,'(a32,f6.2,f6.2)') reaction%secondary_species_names(icplx), &
3895) reaction%eqcplx_Z(icplx), &
3896) reaction%eqcplx_a0(icplx)
3897) write(86,'(40i4)') reaction%eqcplxspecid(:,icplx)
3898) write(86,'(40f6.2)') reaction%eqcplxstoich(:,icplx)
3899) write(86,'(i4)') reaction%eqcplxh2oid(icplx)
3900) write(86,'(f6.2)') reaction%eqcplxh2ostoich(icplx)
3901) write(86,'(1es13.5)') reaction%eqcplx_logK(icplx)
3902) enddo
3903) do irxn = 1, reaction%ngeneral_rxn
3904) write(86,'(40i4)') reaction%generalspecid(:,irxn)
3905) write(86,'(40f6.2)') reaction%generalstoich(:,irxn)
3906) write(86,'(40i4)') reaction%generalforwardspecid(:,irxn)
3907) write(86,'(40f6.2)') reaction%generalforwardstoich(:,irxn)
3908) write(86,'(40i4)') reaction%generalbackwardspecid(:,irxn)
3909) write(86,'(40f6.2)') reaction%generalbackwardstoich(:,irxn)
3910) write(86,'(f6.2)') reaction%generalh2ostoich(irxn)
3911) write(86,'(1es13.5)') reaction%general_kf(irxn)
3912) write(86,'(1es13.5)') reaction%general_kr(irxn)
3913) enddo
3914) do irxn = 1, reaction%neqsrfcplxrxn
3915) write(86,'(a32)')reaction%eqsrfcplx_site_names(irxn)
3916) write(86,'(1es13.5)') reaction%eqsrfcplx_rxn_site_density(irxn)
3917) write(86,'(i4)') reaction%srfcplxrxn_to_complex(0,irxn) ! # complexes
3918) do i = 1, reaction%srfcplxrxn_to_complex(0,irxn)
3919) icplx = reaction%srfcplxrxn_to_complex(i,irxn)
3920) write(86,'(a32,f6.2)') reaction%eqsrfcplx_names(icplx), &
3921) reaction%eqsrfcplx_Z(icplx)
3922) write(86,'(40i4)') reaction%srfcplxspecid(:,icplx)
3923) write(86,'(40f6.2)') reaction%eqsrfcplxstoich(:,icplx)
3924) write(86,'(i4)') reaction%eqsrfcplxh2oid(icplx)
3925) write(86,'(f6.2)') reaction%eqsrfcplxh2ostoich(icplx)
3926) write(86,'(i4)') reaction%eqsrfcplx_free_site_id(icplx)
3927) write(86,'(f6.2)') reaction%eqsrfcplx_free_site_stoich(icplx)
3928) write(86,'(1es13.5)') reaction%eqsrfcplx_logK(icplx)
3929)
3930) enddo
3931) enddo
3932) do imnrl = 1, mineral%nkinmnrl
3933) write(86,'(a32)') mineral%kinmnrl_names(imnrl)
3934) write(86,'(40i4)') mineral%kinmnrlspecid(:,imnrl)
3935) write(86,'(40f6.2)') mineral%kinmnrlstoich(:,imnrl)
3936) write(86,'(i4)') mineral%kinmnrlh2oid(imnrl)
3937) write(86,'(f6.2)') mineral%kinmnrlh2ostoich(imnrl)
3938) write(86,'(1es13.5)') mineral%kinmnrl_logK(imnrl)
3939) write(86,'(1es13.5)') mineral%kinmnrl_molar_vol(imnrl)
3940) write(86,'(1es13.5)') mineral%kinmnrl_molar_wt(imnrl)
3941) write(86,'(1es13.5)') mineral%kinmnrl_rate_constant(1,imnrl)
3942) write(86,'(1es13.5)') 1.d0 ! specific surface area 1 cm^2 / cm^3
3943) enddo
3944) close(86)
3945) endif
3946) #endif
3947)
3948) if (allocated(new_basis)) deallocate(new_basis)
3949) if (allocated(old_basis)) deallocate(old_basis)
3950) if (allocated(transformation)) deallocate(transformation)
3951) if (allocated(stoich_prev)) deallocate(stoich_prev)
3952) if (allocated(stoich_new)) deallocate(stoich_new)
3953) if (allocated(logKvector)) deallocate(logKvector)
3954) if (allocated(indices)) deallocate(indices)
3955)
3956) if (allocated(new_basis_names)) deallocate(new_basis_names)
3957) if (allocated(old_basis_names)) deallocate(old_basis_names)
3958)
3959) end subroutine BasisInit
3960)
3961) ! ************************************************************************** !
3962)
3963) function GetSpeciesBasisID(reaction,option,ncomp_h2o,reaction_name, &
3964) species_name, &
3965) pri_names,sec_names,gas_names)
3966) !
3967) ! Reduces redundant coding above
3968) !
3969) ! Author: Glenn Hammond
3970) ! Date: 12/02/08
3971) !
3972)
3973) use Option_module
3974) use String_module
3975)
3976) implicit none
3977)
3978) type(reaction_type) :: reaction
3979) type(option_type) :: option
3980) PetscInt :: ncomp_h2o
3981) character(len=MAXWORDLENGTH) :: reaction_name
3982) character(len=MAXWORDLENGTH) :: species_name
3983) character(len=MAXWORDLENGTH) :: pri_names(:)
3984) character(len=MAXWORDLENGTH) :: sec_names(:)
3985) character(len=MAXWORDLENGTH) :: gas_names(:)
3986)
3987) PetscInt :: GetSpeciesBasisID
3988) PetscInt :: i
3989)
3990) GetSpeciesBasisID = 0
3991) do i=1,ncomp_h2o
3992) if (StringCompare(species_name, &
3993) pri_names(i),MAXWORDLENGTH)) then
3994) GetSpeciesBasisID = i
3995) return
3996) endif
3997) enddo
3998) ! secondary aqueous and gas species denoted by negative id
3999) do i=1,reaction%neqcplx
4000) if (StringCompare(species_name, &
4001) sec_names(i),MAXWORDLENGTH)) then
4002) GetSpeciesBasisID = -i
4003) return
4004) endif
4005) enddo
4006) do i=1,reaction%ngas
4007) if (StringCompare(species_name, &
4008) gas_names(i),MAXWORDLENGTH)) then
4009) GetSpeciesBasisID = -(reaction%neqcplx+i)
4010) return
4011) endif
4012) enddo
4013)
4014) option%io_buffer = 'Species ' // &
4015) trim(species_name) // &
4016) ' listed in reaction for ' // &
4017) trim(reaction_name) // &
4018) ' not found among primary, secondary, or gas species.'
4019) call printErrMsg(option)
4020)
4021) end function GetSpeciesBasisID
4022)
4023) ! ************************************************************************** !
4024)
4025) subroutine BasisPrint(reaction,title,option)
4026) !
4027) ! Prints the basis
4028) !
4029) ! Author: Glenn Hammond
4030) ! Date: 09/01/08
4031) !
4032)
4033) use Option_module
4034) use Reaction_module
4035) use Reaction_Surface_Complexation_Aux_module
4036) use Reaction_Mineral_Aux_module
4037)
4038) implicit none
4039)
4040) type(reaction_type) :: reaction
4041) character(len=*) :: title
4042) type(option_type) :: option
4043)
4044) type(aq_species_type), pointer :: cur_aq_spec
4045) type(gas_species_type), pointer :: cur_gas_spec
4046) type(mineral_rxn_type), pointer :: cur_mineral
4047) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
4048) type(surface_complex_type), pointer :: cur_srfcplx, cur_srfcplx_in_rxn
4049) type(ion_exchange_rxn_type), pointer :: cur_ionx_rxn
4050) type(ion_exchange_cation_type), pointer :: cur_cation
4051)
4052) character(len=MAXSTRINGLENGTH) :: reactant_string, product_string
4053) character(len=MAXWORDLENGTH) :: word
4054) PetscInt :: fid
4055)
4056) PetscInt :: ispec, itemp
4057)
4058) 100 format(a)
4059) 110 format(a,f9.4,a)
4060) 120 format(a,f9.4,2x,a)
4061) 130 format(a,100f11.4)
4062) 140 format(a,f6.2)
4063) 150 format(a,es11.4,a)
4064)
4065) if (OptionPrintToFile(option)) then
4066) write(option%fid_out,*)
4067) write(option%fid_out,*) '! *************************************************' // &
4068) '************************* !'
4069) write(option%fid_out,*)
4070) write(option%fid_out,*) trim(title)
4071) write(option%fid_out,*)
4072)
4073) write(option%fid_out,*) 'Primary Species:'
4074) cur_aq_spec => reaction%primary_species_list
4075) do
4076) if (.not.associated(cur_aq_spec)) exit
4077) write(option%fid_out,100,advance='no') ' ' // trim(cur_aq_spec%name)
4078) if (cur_aq_spec%is_redox) then
4079) write(option%fid_out,100) ' (redox species)'
4080) else
4081) write(option%fid_out,100) ''
4082) endif
4083) write(option%fid_out,140) ' Charge: ', cur_aq_spec%Z
4084) write(option%fid_out,110) ' Molar Mass: ', cur_aq_spec%molar_weight, ' [g/mol]'
4085) write(option%fid_out,110) ' Debye-Huckel a0: ', cur_aq_spec%a0, ' [Angstrom]'
4086) if (associated(cur_aq_spec%dbaserxn)) then
4087) write(option%fid_out,100) ' Equilibrium Aqueous Reaction: '
4088) write(option%fid_out,120) ' ', -1.d0, cur_aq_spec%name
4089) do ispec = 1, cur_aq_spec%dbaserxn%nspec
4090) write(option%fid_out,120) ' ', cur_aq_spec%dbaserxn%stoich(ispec), &
4091) cur_aq_spec%dbaserxn%spec_name(ispec)
4092) enddo
4093) if (reaction%use_geothermal_hpt)then
4094) write(option%fid_out,130) ' logKCoeff(PT):', (cur_aq_spec%dbaserxn%logK(itemp),&
4095) itemp=1, reaction%num_dbase_parameters)
4096) else
4097) write(option%fid_out,130) ' logK:', (cur_aq_spec%dbaserxn%logK(itemp),itemp=1, &
4098) reaction%num_dbase_temperatures)
4099) endif
4100) endif
4101) write(option%fid_out,*)
4102) cur_aq_spec => cur_aq_spec%next
4103) enddo
4104)
4105) cur_aq_spec => reaction%secondary_species_list
4106) if (associated(cur_aq_spec)) then
4107) write(option%fid_out,*)
4108) write(option%fid_out,*) 'Secondary Species:'
4109) else
4110) write(option%fid_out,*)
4111) write(option%fid_out,*) 'Secondary Species: None'
4112) endif
4113) !#define WRITE_LATEX
4114) #ifdef WRITE_LATEX
4115) fid = 86
4116) open(fid,file="rxns.txt",action="write")
4117) #endif
4118) do
4119) if (.not.associated(cur_aq_spec)) exit
4120) write(option%fid_out,100) ' ' // trim(cur_aq_spec%name)
4121) write(option%fid_out,140) ' Charge: ', cur_aq_spec%Z
4122) write(option%fid_out,110) ' Molar Mass: ', cur_aq_spec%molar_weight,' [g/mol]'
4123) write(option%fid_out,110) ' Debye-Huckel a0: ', cur_aq_spec%a0, ' [Angstrom]'
4124) if (associated(cur_aq_spec%dbaserxn)) then
4125) write(option%fid_out,100) ' Equilibrium Aqueous Reaction: '
4126) write(option%fid_out,120) ' ', -1.d0, cur_aq_spec%name
4127) #ifdef WRITE_LATEX
4128) reactant_string = cur_aq_spec%name
4129) product_string = ''
4130) #endif
4131) do ispec = 1, cur_aq_spec%dbaserxn%nspec
4132) write(option%fid_out,120) ' ', cur_aq_spec%dbaserxn%stoich(ispec), &
4133) cur_aq_spec%dbaserxn%spec_name(ispec)
4134) #ifdef WRITE_LATEX
4135) if (dabs(cur_aq_spec%dbaserxn%stoich(ispec)) > 1.d0) then
4136) write(word,160) int(dabs(cur_aq_spec%dbaserxn%stoich(ispec))+1.e-10), &
4137) ' ' // trim(cur_aq_spec%dbaserxn%spec_name(ispec))
4138) word = adjustl(word)
4139) else
4140) word = cur_aq_spec%dbaserxn%spec_name(ispec)
4141) endif
4142) if (cur_aq_spec%dbaserxn%stoich(ispec) < 0.d0) then
4143) reactant_string = trim(reactant_string) // ' + ' // trim(word)
4144) else
4145) if (len_trim(product_string) > 0) then
4146) product_string = trim(product_string) // ' + ' // trim(word)
4147) else
4148) product_string = word
4149) endif
4150) endif
4151) #endif
4152) enddo
4153) if (reaction%use_geothermal_hpt)then
4154) write(option%fid_out,130) ' logKCoeff(PT):', (cur_aq_spec%dbaserxn%logK(itemp),&
4155) itemp=1, reaction%num_dbase_parameters)
4156)
4157) else
4158) write(option%fid_out,130) ' logK:', (cur_aq_spec%dbaserxn%logK(itemp),itemp=1, &
4159) reaction%num_dbase_temperatures)
4160) endif
4161)
4162) endif
4163) #ifdef WRITE_LATEX
4164) write(word,130) '', cur_aq_spec%dbaserxn%logK(2)
4165) write(fid,*) trim(reactant_string) // ' $~\rightleftharpoons~$ ' // &
4166) trim(product_string) // ' & ' // trim(adjustl(word)) // ' \\'
4167) #endif
4168) write(option%fid_out,*)
4169) cur_aq_spec => cur_aq_spec%next
4170) enddo
4171) #ifdef WRITE_LATEX
4172) close(fid)
4173) #endif
4174)
4175) cur_gas_spec => reaction%gas_species_list
4176) if (associated(cur_gas_spec)) then
4177) write(option%fid_out,*)
4178) write(option%fid_out,*) 'Gas Components:'
4179) else
4180) write(option%fid_out,*)
4181) write(option%fid_out,*) 'Gas Components: None'
4182) endif
4183) do
4184) if (.not.associated(cur_gas_spec)) exit
4185) write(option%fid_out,100) ' ' // trim(cur_gas_spec%name)
4186) write(option%fid_out,110) ' Molar Mass: ', cur_gas_spec%molar_weight,' [g/mol]'
4187) if (associated(cur_gas_spec%dbaserxn)) then
4188) write(option%fid_out,100) ' Gas Reaction: '
4189) write(option%fid_out,120) ' ', -1.d0, cur_gas_spec%name
4190) do ispec = 1, cur_gas_spec%dbaserxn%nspec
4191) write(option%fid_out,120) ' ', cur_gas_spec%dbaserxn%stoich(ispec), &
4192) cur_gas_spec%dbaserxn%spec_name(ispec)
4193) enddo
4194) if (reaction%use_geothermal_hpt)then
4195) write(option%fid_out,130) ' logKCoeff(PT):', (cur_gas_spec%dbaserxn%logK(itemp),&
4196) itemp=1, reaction%num_dbase_parameters)
4197)
4198) else
4199) write(option%fid_out,130) ' logK:', (cur_gas_spec%dbaserxn%logK(itemp),itemp=1, &
4200) reaction%num_dbase_temperatures)
4201) endif
4202) endif
4203) write(option%fid_out,*)
4204) cur_gas_spec => cur_gas_spec%next
4205) enddo
4206)
4207) cur_mineral => reaction%mineral%mineral_list
4208) if (associated(cur_mineral)) then
4209) write(option%fid_out,*)
4210) write(option%fid_out,*) 'Minerals:'
4211) else
4212) write(option%fid_out,*)
4213) write(option%fid_out,*) 'Minerals: None'
4214) endif
4215) do
4216) if (.not.associated(cur_mineral)) exit
4217) write(option%fid_out,100) ' ' // trim(cur_mineral%name)
4218) write(option%fid_out,110) ' Molar Mass: ', cur_mineral%molar_weight,' [g/mol]'
4219) write(option%fid_out,150) ' Molar Volume: ', cur_mineral%molar_volume,' [m^3/mol]'
4220) if (associated(cur_mineral%tstrxn)) then
4221) write(option%fid_out,100) ' Mineral Reaction: '
4222) write(option%fid_out,120) ' ', -1.d0, cur_mineral%name
4223) do ispec = 1, cur_mineral%dbaserxn%nspec
4224) write(option%fid_out,120) ' ', cur_mineral%dbaserxn%stoich(ispec), &
4225) cur_mineral%dbaserxn%spec_name(ispec)
4226) enddo
4227) if (reaction%use_geothermal_hpt)then
4228) write(option%fid_out,130) ' logKCoeff(PT):', (cur_mineral%dbaserxn%logK(itemp),&
4229) itemp=1, reaction%num_dbase_parameters)
4230) else
4231) write(option%fid_out,130) ' logK:', (cur_mineral%dbaserxn%logK(itemp),itemp=1, &
4232) reaction%num_dbase_temperatures)
4233) endif
4234) endif
4235) write(option%fid_out,*)
4236) cur_mineral => cur_mineral%next
4237) enddo
4238)
4239) if (reaction%surface_complexation%nsrfcplxrxn > 0) then
4240) cur_srfcplx_rxn => reaction%surface_complexation%rxn_list
4241) write(option%fid_out,*)
4242) write(option%fid_out,*) 'Surface Complexation Reactions:'
4243) do
4244) if (.not.associated(cur_srfcplx_rxn)) exit
4245) cur_srfcplx_in_rxn => cur_srfcplx_rxn%complex_list
4246) write(option%fid_out,*)
4247) write(option%fid_out,*) ' Surface Complexes:'
4248) do
4249) if (.not.associated(cur_srfcplx_in_rxn)) exit
4250) cur_srfcplx => cur_srfcplx_in_rxn%ptr
4251) write(option%fid_out,100) ' ' // trim(cur_srfcplx%name)
4252) write(option%fid_out,140) ' Charge: ', cur_srfcplx%Z
4253) write(option%fid_out,100) ' Surface Complex Reaction: '
4254) write(option%fid_out,120) ' ', -1.d0, cur_srfcplx%name
4255) write(option%fid_out,120) ' ', cur_srfcplx%free_site_stoich, &
4256) cur_srfcplx_rxn%free_site_name
4257) do ispec = 1, cur_srfcplx%dbaserxn%nspec
4258) write(option%fid_out,120) ' ', &
4259) cur_srfcplx%dbaserxn%stoich(ispec), &
4260) cur_srfcplx%dbaserxn%spec_name(ispec)
4261) enddo
4262) if (reaction%use_geothermal_hpt)then
4263) write(option%fid_out,130) ' logKCoeff(PT):', &
4264) (cur_srfcplx%dbaserxn%logK(itemp),&
4265) itemp=1, reaction%num_dbase_parameters)
4266) else
4267) write(option%fid_out,130) ' logK:', &
4268) (cur_srfcplx%dbaserxn%logK(itemp),itemp=1, &
4269) reaction%num_dbase_temperatures)
4270) endif
4271) write(option%fid_out,*)
4272) nullify(cur_srfcplx)
4273) cur_srfcplx_in_rxn => cur_srfcplx_in_rxn%next
4274) enddo
4275) cur_srfcplx_rxn => cur_srfcplx_rxn%next
4276) enddo
4277) else
4278) write(option%fid_out,*)
4279) write(option%fid_out,*) 'Surface Complexation Reactions: None'
4280) write(option%fid_out,*)
4281) write(option%fid_out,*) ' Surface Complexes: None'
4282) endif
4283)
4284) cur_ionx_rxn => reaction%ion_exchange_rxn_list
4285) if (associated(cur_ionx_rxn)) then
4286) write(option%fid_out,*)
4287) write(option%fid_out,*) 'Ion Exchange Reactions:'
4288) else
4289) write(option%fid_out,*)
4290) write(option%fid_out,*) 'Ion Exchange Reactions: None'
4291) endif
4292) do
4293) if (.not.associated(cur_ionx_rxn)) exit
4294) write(option%fid_out,*) ' Mineral: ', trim(cur_ionx_rxn%mineral_name)
4295) write(option%fid_out,150) ' CEC: ', cur_ionx_rxn%CEC
4296) cur_cation => cur_ionx_rxn%cation_list
4297) if (associated(cur_cation)) then
4298) write(option%fid_out,*) ' Cations:'
4299) else
4300) write(option%fid_out,*) ' Cations: None'
4301) endif
4302) do
4303) if (.not.associated(cur_cation)) exit
4304) write(option%fid_out,150) ' ' // trim(cur_cation%name), cur_cation%k
4305) cur_cation => cur_cation%next
4306) enddo
4307) write(option%fid_out,*)
4308) cur_ionx_rxn => cur_ionx_rxn%next
4309) enddo
4310)
4311) write(option%fid_out,*)
4312) write(option%fid_out,*) '! *************************************************' // &
4313) '************************* !'
4314) write(option%fid_out,*)
4315) endif
4316)
4317) end subroutine BasisPrint
4318)
4319) end module Reaction_Database_module