reaction_database_hpt.F90 coverage: 0.00 %func 0.00 %block
1) module Reaction_Database_hpt_module
2)
3) use Reaction_module
4) use Reaction_Aux_module
5) use Reaction_Database_module
6) use Reaction_Database_Aux_module
7) use Reaction_Surface_Complexation_Aux_module
8) use Reaction_Mineral_Aux_module
9)
10) use PFLOTRAN_Constants_module
11)
12) implicit none
13)
14) private
15)
16) #include "petsc/finclude/petscsys.h"
17)
18) public :: DatabaseRead_hpt, BasisInit_hpt
19)
20) contains
21)
22) ! ************************************************************************** !
23)
24) subroutine DatabaseRead_hpt(reaction,option)
25) !
26) ! Collects parameters from geochemical database
27) !
28) ! Author: ???
29) ! Date: ???
30) !
31)
32) use Option_module
33) use Input_Aux_module
34) use String_module
35)
36) implicit none
37)
38) type(reaction_type) :: reaction
39) type(option_type) :: option
40)
41) type(aq_species_type), pointer :: cur_aq_spec, cur_aq_spec2
42) type(gas_species_type), pointer :: cur_gas_spec, cur_gas_spec2
43) type(mineral_rxn_type), pointer :: cur_mineral, cur_mineral2
44) type(colloid_type), pointer :: cur_colloid
45) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
46) type(surface_complex_type), pointer :: cur_srfcplx, cur_srfcplx2
47)
48) character(len=MAXSTRINGLENGTH) :: string
49) character(len=MAXWORDLENGTH) :: name
50) character(len=MAXWORDLENGTH) :: null_name
51)
52) PetscBool :: flag, found
53) PetscInt :: ispec, itemp, i
54) PetscReal :: stoich
55) PetscReal :: temp_real
56) type(input_type), pointer :: input
57) PetscInt :: iostat
58) PetscInt :: num_nulls
59) !TODO(geh)
60) #if 0
61) ! negate ids for use as flags
62) cur_aq_spec => reaction%primary_species_list
63) do
64) if (.not.associated(cur_aq_spec)) exit
65) cur_aq_spec%id = -abs(cur_aq_spec%id)
66) cur_aq_spec => cur_aq_spec%next
67) enddo
68) cur_aq_spec => reaction%secondary_species_list
69) do
70) if (.not.associated(cur_aq_spec)) exit
71) cur_aq_spec%id = -abs(cur_aq_spec%id)
72) cur_aq_spec => cur_aq_spec%next
73) enddo
74) cur_gas_spec => reaction%gas_species_list
75) do
76) if (.not.associated(cur_gas_spec)) exit
77) cur_gas_spec%id = -abs(cur_gas_spec%id)
78) cur_gas_spec => cur_gas_spec%next
79) enddo
80) cur_mineral => reaction%mineral_list
81) do
82) if (.not.associated(cur_mineral)) exit
83) cur_mineral%id = -abs(cur_mineral%id)
84) cur_mineral => cur_mineral%next
85) enddo
86) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
87) do
88) if (.not.associated(cur_srfcplx_rxn)) exit
89) cur_srfcplx => cur_srfcplx_rxn%complex_list
90) do
91) if (.not.associated(cur_srfcplx)) exit
92) cur_srfcplx%id = -abs(cur_srfcplx%id)
93) cur_srfcplx => cur_srfcplx%next
94) enddo
95) cur_srfcplx_rxn => cur_srfcplx_rxn%next
96) enddo
97)
98) if (len_trim(reaction%database_filename) < 2) then
99) option%io_buffer = 'Database filename not included in input deck.'
100) call printErrMsg(option)
101) endif
102) input => InputCreate(IUNIT_TEMP,reaction%database_filename,option)
103)
104) ! read temperatures
105) call InputReadPflotranString(input,option)
106) ! remove comment
107) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
108) call InputReadInt(input,option,reaction%num_dbase_parameters)
109) call InputErrorMsg(input,option,'Number of database parameters','DATABASE')
110) ! allocate(reaction%dbase_temperatures(reaction%num_dbase_temperatures))
111) ! reaction%dbase_temperatures = 0.d0
112) ! do itemp = 1, reaction%num_dbase_temperatures
113) ! call InputReadDouble(input,option,reaction%dbase_temperatures(itemp))
114) ! call InputErrorMsg(input,option,'Database temperatures','DATABASE')
115) ! enddo
116)
117) num_nulls = 0
118) null_name = 'null'
119) do ! loop over every entry in the database
120) call InputReadPflotranString(input,option)
121) call InputReadStringErrorMsg(input,option,'DATABASE')
122)
123) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
124) ! 'null's mark the end of a section in the database. We count these
125) ! to determine which species we are reading.
126) ! --
127) ! primary species
128) ! null
129) ! aq complexes
130) ! null
131) ! gases
132) ! null
133) ! minerals
134) ! null
135) ! surface complexes
136) ! null
137) ! --
138)
139) if (StringCompare(name,null_name,MAXWORDLENGTH)) then
140) num_nulls = num_nulls + 1
141) if (num_nulls >= 5) exit
142) cycle
143) endif
144)
145) select case(num_nulls)
146) case(0,1) ! primary and secondary aq species and colloids
147) cur_aq_spec => reaction%primary_species_list
148) found = PETSC_FALSE
149) do
150) if (found .or. .not.associated(cur_aq_spec)) exit
151) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
152) found = PETSC_TRUE
153) ! change negative id to positive, indicating it was found in database
154) cur_aq_spec%id = abs(cur_aq_spec%id)
155) exit
156) endif
157) cur_aq_spec => cur_aq_spec%next
158) enddo
159) if (.not.found) cur_aq_spec => reaction%secondary_species_list
160) do
161) if (found .or. .not.associated(cur_aq_spec)) exit
162) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
163) found = PETSC_TRUE
164) ! change negative id to positive, indicating it was found in database
165) cur_aq_spec%id = abs(cur_aq_spec%id)
166) exit
167) endif
168) cur_aq_spec => cur_aq_spec%next
169) enddo
170) ! check if a colloid
171) if (.not.found) cur_colloid => reaction%colloid_list
172) do
173) if (found .or. .not.associated(cur_colloid)) exit
174) if (StringCompare(name,cur_colloid%name,MAXWORDLENGTH)) then
175) found = PETSC_TRUE
176) ! change negative id to positive, indicating it was found in database
177) cur_colloid%id = abs(cur_colloid%id)
178)
179) ! skip the Debye-Huckel ion size parameter (a0)
180) call InputReadDouble(input,option,temp_real)
181) call InputErrorMsg(input,option,'Colloid skip a0','DATABASE')
182) ! skipo the valence
183) call InputReadDouble(input,option,temp_real)
184) call InputErrorMsg(input,option,'Colloid skip Z','DATABASE')
185) ! read the molar weight
186) call InputReadDouble(input,option,cur_colloid%molar_weight)
187) call InputErrorMsg(input,option,'Colloid molar weight','DATABASE')
188)
189) cycle ! avoid the aqueous species parameters below
190) endif
191) cur_colloid => cur_colloid%next
192) enddo
193)
194) if (.not.found) cycle ! go to next line in database
195)
196) if (num_nulls > 0) then ! secondary species in database
197) ! create aqueous equilibrium reaction
198) if (.not.associated(cur_aq_spec%dbaserxn)) &
199) cur_aq_spec%dbaserxn => DatabaseRxnCreate()
200) ! read the number of primary species in secondary rxn
201) call InputReadInt(input,option,cur_aq_spec%dbaserxn%nspec)
202) call InputErrorMsg(input,option,'Number of species in aqueous complex', &
203) 'DATABASE')
204) ! allocate arrays for rxn
205) allocate(cur_aq_spec%dbaserxn%spec_name(cur_aq_spec%dbaserxn%nspec))
206) cur_aq_spec%dbaserxn%spec_name = ''
207) allocate(cur_aq_spec%dbaserxn%stoich(cur_aq_spec%dbaserxn%nspec))
208) cur_aq_spec%dbaserxn%stoich = 0.d0
209) allocate(cur_aq_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
210) cur_aq_spec%dbaserxn%logKCoeff_hpt = 0.d0
211) ! read in species and stoichiometries
212) do ispec = 1, cur_aq_spec%dbaserxn%nspec
213) call InputReadDouble(input,option,cur_aq_spec%dbaserxn%stoich(ispec))
214) call InputErrorMsg(input,option,'EQRXN species stoichiometry','DATABASE')
215) call InputReadQuotedWord(input,option,cur_aq_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
216) call InputErrorMsg(input,option,'EQRXN species name','DATABASE')
217) enddo
218) do itemp = 1, reaction%num_dbase_parameters
219) call InputReadDouble(input,option,cur_aq_spec%dbaserxn%logKCoeff_hpt(itemp))
220) call InputErrorMsg(input,option,'EQRXN logKs Coeff','DATABASE')
221) enddo
222) endif
223) ! read the Debye-Huckel ion size parameter (a0)
224) call InputReadDouble(input,option,cur_aq_spec%a0)
225) call InputErrorMsg(input,option,'AQ Species a0','DATABASE')
226) ! read the valence
227) call InputReadDouble(input,option,cur_aq_spec%Z)
228) call InputErrorMsg(input,option,'AQ Species Z','DATABASE')
229) ! read the molar weight
230) call InputReadDouble(input,option,cur_aq_spec%molar_weight)
231) call InputErrorMsg(input,option,'AQ Species molar weight','DATABASE')
232)
233)
234) case(2) ! gas species
235) cur_gas_spec => reaction%gas_species_list
236) if (.not.associated(cur_gas_spec)) cycle
237) found = PETSC_FALSE
238) do
239) if (found .or. .not.associated(cur_gas_spec)) exit
240) if (StringCompare(name,cur_gas_spec%name,MAXWORDLENGTH)) then
241) found = PETSC_TRUE
242) ! change negative id to positive, indicating it was found in database
243) cur_gas_spec%id = abs(cur_gas_spec%id)
244) exit
245) endif
246) cur_gas_spec => cur_gas_spec%next
247) enddo
248)
249) if (.not.found) cycle ! go to next line in database
250)
251) ! read the molar volume
252) call InputReadDouble(input,option,cur_gas_spec%molar_volume)
253) call InputErrorMsg(input,option,'GAS molar volume','DATABASE')
254) ! convert from cm^3/mol to m^3/mol
255) cur_gas_spec%molar_volume = cur_gas_spec%molar_volume*1.d-6
256) ! create aqueous equilibrium reaction
257) if (.not.associated(cur_gas_spec%dbaserxn)) &
258) cur_gas_spec%dbaserxn => DatabaseRxnCreate()
259) ! read the number of aqueous species in secondary rxn
260) call InputReadInt(input,option,cur_gas_spec%dbaserxn%nspec)
261) call InputErrorMsg(input,option,'Number of species in gas reaction', &
262) 'DATABASE')
263) ! allocate arrays for rxn
264) allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
265) cur_gas_spec%dbaserxn%spec_name = ''
266) allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
267) cur_gas_spec%dbaserxn%stoich = 0.d0
268) allocate(cur_gas_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
269) cur_gas_spec%dbaserxn%logKCoeff_hpt = 0.d0
270) ! read in species and stoichiometries
271) do ispec = 1, cur_gas_spec%dbaserxn%nspec
272) call InputReadDouble(input,option,cur_gas_spec%dbaserxn%stoich(ispec))
273) call InputErrorMsg(input,option,'GAS species stoichiometry','DATABASE')
274) call InputReadQuotedWord(input,option,cur_gas_spec%dbaserxn%spec_name(ispec),PETSC_TRUE)
275) call InputErrorMsg(input,option,'GAS species name','DATABASE')
276) enddo
277) do itemp = 1, reaction%num_dbase_parameters
278) call InputReadDouble(input,option,cur_gas_spec%dbaserxn%logKCoeff_hpt(itemp))
279) call InputErrorMsg(input,option,'GAS logKs Coeff','DATABASE')
280) enddo
281) ! read the molar weight
282) call InputReadDouble(input,option,cur_gas_spec%molar_weight)
283) call InputErrorMsg(input,option,'GAS molar weight','DATABASE')
284)
285)
286) case(3) ! minerals
287) cur_mineral => reaction%mineral_list
288) if (.not.associated(cur_mineral)) cycle
289) found = PETSC_FALSE
290) do
291) if (found .or. .not.associated(cur_mineral)) exit
292) if (StringCompare(name,cur_mineral%name,MAXWORDLENGTH)) then
293) found = PETSC_TRUE
294) ! change negative id to positive, indicating it was found in database
295) cur_mineral%id = abs(cur_mineral%id)
296) exit
297) endif
298) cur_mineral => cur_mineral%next
299) enddo
300)
301) if (.not.found) cycle ! go to next line in database
302)
303) ! read the molar volume
304) call InputReadDouble(input,option,cur_mineral%molar_volume)
305) call InputErrorMsg(input,option,'MINERAL molar volume','DATABASE')
306) ! convert from cm^3/mol to m^3/mol
307) cur_mineral%molar_volume = cur_mineral%molar_volume*1.d-6
308) ! create mineral reaction
309) if (.not.associated(cur_mineral%tstrxn)) then
310) cur_mineral%tstrxn => TransitionStateTheoryRxnCreate()
311) endif
312) ! read the number of aqueous species in mineral rxn
313) cur_mineral%dbaserxn => DatabaseRxnCreate()
314) call InputReadInt(input,option,cur_mineral%dbaserxn%nspec)
315) call InputErrorMsg(input,option,'Number of species in mineral reaction', &
316) 'DATABASE')
317) ! allocate arrays for rxn
318) allocate(cur_mineral%dbaserxn%spec_name(cur_mineral%dbaserxn%nspec))
319) cur_mineral%dbaserxn%spec_name = ''
320) allocate(cur_mineral%dbaserxn%stoich(cur_mineral%dbaserxn%nspec))
321) cur_mineral%dbaserxn%stoich = 0.d0
322) allocate(cur_mineral%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
323) cur_mineral%dbaserxn%logKCoeff_hpt = 0.d0
324) ! read in species and stoichiometries
325) do ispec = 1, cur_mineral%dbaserxn%nspec
326) call InputReadDouble(input,option,cur_mineral%dbaserxn%stoich(ispec))
327) call InputErrorMsg(input,option,'MINERAL species stoichiometry','DATABASE')
328) call InputReadQuotedWord(input,option,cur_mineral%dbaserxn% &
329) spec_name(ispec),PETSC_TRUE)
330) call InputErrorMsg(input,option,'MINERAL species name','DATABASE')
331) enddo
332) do itemp = 1, reaction%num_dbase_parameters
333) call InputReadDouble(input,option,cur_mineral%dbaserxn%logKCoeff_hpt(itemp))
334) call InputErrorMsg(input,option,'MINERAL logKs','DATABASE')
335) enddo
336) ! read the molar weight
337) call InputReadDouble(input,option,cur_mineral%molar_weight)
338) call InputErrorMsg(input,option,'MINERAL molar weight','DATABASE')
339)
340)
341) case(4) ! surface complexes
342) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
343) found = PETSC_FALSE
344) do
345) if (.not.associated(cur_srfcplx_rxn)) exit
346) cur_srfcplx => cur_srfcplx_rxn%complex_list
347) do
348) if (.not.associated(cur_srfcplx)) exit
349) if (StringCompare(name,cur_srfcplx%name,MAXWORDLENGTH)) then
350) found = PETSC_TRUE
351) ! change negative id to positive, indicating it was found in database
352) cur_srfcplx%id = abs(cur_srfcplx%id)
353) exit
354) endif
355) cur_srfcplx => cur_srfcplx%next
356) enddo
357) if (found) exit
358) cur_srfcplx_rxn => cur_srfcplx_rxn%next
359) enddo
360)
361) if (.not.found) cycle ! go to next line in database
362)
363) if (.not.associated(cur_srfcplx%dbaserxn)) &
364) cur_srfcplx%dbaserxn => DatabaseRxnCreate()
365)
366) ! read the number of aqueous species in surface complexation rxn
367) call InputReadInt(input,option,cur_srfcplx%dbaserxn%nspec)
368) call InputErrorMsg(input,option,'Number of species in surface complexation reaction', &
369) 'DATABASE')
370) ! decrement number of species since free site will not be included
371) cur_srfcplx%dbaserxn%nspec = cur_srfcplx%dbaserxn%nspec - 1
372) ! allocate arrays for rxn
373) allocate(cur_srfcplx%dbaserxn%spec_name(cur_srfcplx%dbaserxn%nspec))
374) cur_srfcplx%dbaserxn%spec_name = ''
375) allocate(cur_srfcplx%dbaserxn%stoich(cur_srfcplx%dbaserxn%nspec))
376) cur_srfcplx%dbaserxn%stoich = 0.d0
377) allocate(cur_srfcplx%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
378) cur_srfcplx%dbaserxn%logKCoeff_hpt = 0.d0
379) ! read in species and stoichiometries
380) ispec = 0
381) found = PETSC_FALSE
382) do i = 1, cur_srfcplx%dbaserxn%nspec+1 ! recall that nspec was decremented above
383) call InputReadDouble(input,option,stoich)
384) call InputErrorMsg(input,option,'SURFACE COMPLEX species stoichiometry','DATABASE')
385) call InputReadQuotedWord(input,option,name,PETSC_TRUE)
386) call InputErrorMsg(input,option,'SURFACE COMPLEX species name','DATABASE')
387) if (StringCompare(name,cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
388) found = PETSC_TRUE
389) cur_srfcplx%free_site_stoich = stoich
390) else
391) ispec = ispec + 1
392) cur_srfcplx%dbaserxn%stoich(ispec) = stoich
393) cur_srfcplx%dbaserxn%spec_name(ispec) = name
394) endif
395) enddo
396) if (.not.found) then
397) option%io_buffer = 'Free site name: ' // &
398) trim(cur_srfcplx_rxn%free_site_name) // &
399) ' not found in surface complex:' // &
400) trim(cur_srfcplx%name)
401) call printErrMsg(option)
402) endif
403) do itemp = 1, reaction%num_dbase_parameters
404) call InputReadDouble(input,option,cur_srfcplx%dbaserxn%logKCoeff_hpt(itemp))
405) call InputErrorMsg(input,option,'SURFACE COMPLEX logKs','DATABASE')
406) enddo
407) ! read the valence
408) call InputReadDouble(input,option,cur_srfcplx%Z)
409) call InputErrorMsg(input,option,'Surface Complex Z','DATABASE')
410)
411)
412) end select
413)
414) enddo
415)
416) ! check for duplicate species
417) flag = PETSC_FALSE
418)
419) ! aqueous primary species
420) cur_aq_spec => reaction%primary_species_list
421) do
422) if (.not.associated(cur_aq_spec)) exit
423)
424) ! aqueous primary species
425) cur_aq_spec2 => cur_aq_spec%next
426) do
427) if (.not.associated(cur_aq_spec2)) exit
428) if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
429) StringCompare(cur_aq_spec%name, &
430) cur_aq_spec2%name,MAXWORDLENGTH)) then
431) flag = PETSC_TRUE
432) option%io_buffer = &
433) 'Aqueous primary species (' // trim(cur_aq_spec%name) // &
434) ') duplicated in input file.'
435) call printMsg(option)
436) endif
437) cur_aq_spec2 => cur_aq_spec2%next
438) enddo
439)
440) cur_aq_spec2 => reaction%secondary_species_list
441) do
442) if (.not.associated(cur_aq_spec2)) exit
443) if (StringCompare(cur_aq_spec%name, &
444) cur_aq_spec2%name,MAXWORDLENGTH)) then
445) flag = PETSC_TRUE
446) option%io_buffer = 'Aqueous primary species (' // &
447) trim(cur_aq_spec%name) // &
448) ') duplicated as secondary species in input file.'
449) call printMsg(option)
450) endif
451) cur_aq_spec2 => cur_aq_spec2%next
452) enddo
453)
454) cur_gas_spec2 => reaction%gas_species_list
455) do
456) if (.not.associated(cur_gas_spec2)) exit
457) if (StringCompare(cur_aq_spec%name, &
458) cur_gas_spec2%name,MAXWORDLENGTH)) then
459) flag = PETSC_TRUE
460) option%io_buffer = 'Aqueous primary species (' // &
461) trim(cur_aq_spec%name) // &
462) ') duplicated as gas species in input file.'
463) call printMsg(option)
464) endif
465) cur_gas_spec2 => cur_gas_spec2%next
466) enddo
467) cur_aq_spec => cur_aq_spec%next
468) enddo
469)
470) ! aqueous secondary species
471) cur_aq_spec => reaction%secondary_species_list
472) do
473) if (.not.associated(cur_aq_spec)) exit
474)
475) ! already checked against primary
476) ! aqueous secondary species
477) cur_aq_spec2 => cur_aq_spec%next
478) do
479) if (.not.associated(cur_aq_spec2)) exit
480) if (cur_aq_spec%id /= cur_aq_spec2%id .and. &
481) StringCompare(cur_aq_spec%name, &
482) cur_aq_spec2%name,MAXWORDLENGTH)) then
483) flag = PETSC_TRUE
484) option%io_buffer = 'Aqueous secondary species (' // &
485) trim(cur_aq_spec%name) // &
486) ') duplicated in input file.'
487) call printMsg(option)
488) endif
489) cur_aq_spec2 => cur_aq_spec2%next
490) enddo
491)
492) cur_gas_spec2 => reaction%gas_species_list
493) do
494) if (.not.associated(cur_gas_spec2)) exit
495) if (StringCompare(cur_aq_spec%name, &
496) cur_gas_spec2%name,MAXWORDLENGTH)) then
497) flag = PETSC_TRUE
498) option%io_buffer = 'Aqueous secondary species (' // &
499) trim(cur_aq_spec%name) // &
500) ') duplicated as gas species in input file.'
501) call printMsg(option)
502) endif
503) cur_gas_spec2 => cur_gas_spec2%next
504) enddo
505) cur_aq_spec => cur_aq_spec%next
506) enddo
507)
508) ! gas species
509) cur_gas_spec => reaction%gas_species_list
510) do
511) if (.not.associated(cur_aq_spec)) exit
512)
513) ! already checked against primary
514) ! already checked against secondary
515) ! gas species
516) cur_gas_spec2 => cur_gas_spec%next
517) do
518) if (.not.associated(cur_gas_spec2)) exit
519) if (cur_gas_spec%id /= cur_gas_spec2%id .and. &
520) StringCompare(cur_aq_spec%name, &
521) cur_gas_spec2%name,MAXWORDLENGTH)) then
522) flag = PETSC_TRUE
523) option%io_buffer = 'Gas species (' // &
524) trim(cur_aq_spec%name) // &
525) ') duplicated in input file.'
526) call printMsg(option)
527) endif
528) cur_gas_spec2 => cur_gas_spec2%next
529) enddo
530) cur_aq_spec => cur_aq_spec%next
531) enddo
532)
533) ! minerals
534) cur_mineral => reaction%mineral_list
535) do
536) if (.not.associated(cur_mineral)) exit
537) cur_mineral2 => cur_mineral%next
538) do
539) if (.not.associated(cur_mineral2)) exit
540) if (cur_mineral%id /= cur_mineral2%id .and. &
541) StringCompare(cur_mineral%name, &
542) cur_mineral2%name,MAXWORDLENGTH)) then
543) flag = PETSC_TRUE
544) option%io_buffer = 'Mineral (' // &
545) trim(cur_mineral%name) // &
546) ') duplicated in input file.'
547) call printMsg(option)
548) endif
549) cur_mineral2 => cur_mineral2%next
550) enddo
551) cur_mineral => cur_mineral%next
552) enddo
553)
554) ! surface complexes
555) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
556) do
557) if (.not.associated(cur_srfcplx_rxn)) exit
558) cur_srfcplx => cur_srfcplx_rxn%complex_list
559) do
560) if (.not.associated(cur_srfcplx)) exit
561) cur_srfcplx2 => cur_srfcplx%next
562) do
563) if (.not.associated(cur_srfcplx2)) exit
564) if (cur_srfcplx%id /= cur_srfcplx2%id .and. &
565) StringCompare(cur_srfcplx%name, &
566) cur_srfcplx2%name,MAXWORDLENGTH)) then
567) flag = PETSC_TRUE
568) option%io_buffer = 'Surface complex (' // &
569) trim(cur_srfcplx2%name) // &
570) ') duplicated in input file surface complex reaction.'
571) call printMsg(option)
572) endif
573) cur_srfcplx2 => cur_srfcplx2%next
574) enddo
575) cur_srfcplx => cur_srfcplx%next
576) enddo
577) cur_srfcplx_rxn => cur_srfcplx_rxn%next
578) enddo
579)
580) if (flag) call printErrMsg(option,'Species duplicated in input file.')
581)
582) ! check that all species, etc. were read
583) flag = PETSC_FALSE
584) cur_aq_spec => reaction%primary_species_list
585) do
586) if (.not.associated(cur_aq_spec)) exit
587) if (cur_aq_spec%id < 0) then
588) flag = PETSC_TRUE
589) option%io_buffer = 'Aqueous primary species (' // &
590) trim(cur_aq_spec%name) // &
591) ') not found in database.'
592) call printMsg(option)
593) endif
594) cur_aq_spec => cur_aq_spec%next
595) enddo
596) cur_aq_spec => reaction%secondary_species_list
597) do
598) if (.not.associated(cur_aq_spec)) exit
599) if (cur_aq_spec%id < 0) then
600) flag = PETSC_TRUE
601) option%io_buffer = &
602) 'Aqueous secondary species (' // trim(cur_aq_spec%name) // &
603) ') not found in database.'
604) call printMsg(option)
605) endif
606) cur_aq_spec => cur_aq_spec%next
607) enddo
608) cur_gas_spec => reaction%gas_species_list
609) do
610) if (.not.associated(cur_gas_spec)) exit
611) if (cur_gas_spec%id < 0) then
612) flag = PETSC_TRUE
613) option%io_buffer = 'Gas species (' // trim(cur_gas_spec%name) // &
614) ') not found in database.'
615) call printMsg(option)
616) endif
617) cur_gas_spec => cur_gas_spec%next
618) enddo
619) cur_mineral => reaction%mineral_list
620) do
621) if (.not.associated(cur_mineral)) exit
622) if (cur_mineral%id < 0) then
623) flag = PETSC_TRUE
624) option%io_buffer = 'Mineral (' // trim(cur_mineral%name) // &
625) ') not found in database.'
626) call printMsg(option)
627) endif
628) cur_mineral => cur_mineral%next
629) enddo
630) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
631) do
632) if (.not.associated(cur_srfcplx_rxn)) exit
633) cur_srfcplx => cur_srfcplx_rxn%complex_list
634) do
635) if (.not.associated(cur_srfcplx)) exit
636) if (cur_srfcplx%id < 0) then
637) flag = PETSC_TRUE
638) option%io_buffer = 'Surface species (' // trim(cur_srfcplx%name) // &
639) ') not found in database.'
640) call printMsg(option)
641) endif
642) cur_srfcplx => cur_srfcplx%next
643) enddo
644) cur_srfcplx_rxn => cur_srfcplx_rxn%next
645) enddo
646)
647) if (flag) call printErrMsg(option,'Species not found in database.')
648)
649) call InputDestroy(input)
650) !TODO(geh)
651) #endif
652) end subroutine DatabaseRead_hpt
653)
654) ! ************************************************************************** !
655)
656) subroutine BasisInit_hpt(reaction,option)
657) !
658) ! Initializes the basis for geochemistry
659) !
660) ! Author: ???
661) ! Date: ???
662) !
663)
664) use Option_module
665) use String_module
666) use Utility_module
667) use Input_Aux_module
668)
669) implicit none
670)
671) type(reaction_type) :: reaction
672) type(option_type) :: option
673)
674) type(aq_species_type), pointer :: cur_aq_spec
675) type(aq_species_type), pointer :: cur_pri_aq_spec
676) type(aq_species_type), pointer :: cur_sec_aq_spec
677) type(gas_species_type), pointer :: cur_gas_spec
678) type(mineral_rxn_type), pointer :: cur_mineral
679) type(aq_species_type), pointer :: cur_sec_aq_spec1
680) type(aq_species_type), pointer :: cur_sec_aq_spec2
681) type(gas_species_type), pointer :: cur_gas_spec1
682) type(gas_species_type), pointer :: cur_gas_spec2
683) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
684) type(surface_complex_type), pointer :: cur_srfcplx
685) type(surface_complex_type), pointer :: cur_srfcplx2
686) type(ion_exchange_rxn_type), pointer :: cur_ionx_rxn
687) type(ion_exchange_cation_type), pointer :: cur_cation
688) type(general_rxn_type), pointer :: cur_general_rxn
689) type(kd_rxn_type), pointer :: cur_kd_rxn
690) type(colloid_type), pointer :: cur_colloid
691) type(database_rxn_type), pointer :: dbaserxn
692) type(transition_state_rxn_type), pointer :: tstrxn
693) type(transition_state_prefactor_type), pointer :: cur_prefactor
694) type(ts_prefactor_species_type), pointer :: cur_prefactor_species
695)
696) character(len=MAXWORDLENGTH), allocatable :: old_basis_names(:)
697) character(len=MAXWORDLENGTH), allocatable :: new_basis_names(:)
698)
699) character(len=MAXWORDLENGTH), parameter :: h2oname = 'H2O'
700) character(len=MAXWORDLENGTH) :: word, word2
701) character(len=MAXSTRINGLENGTH) :: string, string2
702)
703) PetscInt, parameter :: h2o_id = 1
704)
705) PetscReal :: logK(reaction%num_dbase_temperatures)
706) PetscReal, allocatable :: transformation(:,:), old_basis(:,:), new_basis(:,:)
707) PetscReal, allocatable :: stoich_new(:), stoich_prev(:), logKCoeffvector(:,:)
708) PetscInt, allocatable :: indices(:)
709)
710) PetscReal, allocatable :: pri_matrix(:,:), sec_matrix(:,:)
711) PetscReal, allocatable :: sec_matrix_inverse(:,:)
712) PetscReal, allocatable :: stoich_matrix(:,:)
713) PetscReal, allocatable :: unit_vector(:)
714) character(len=MAXWORDLENGTH), allocatable :: pri_names(:)
715) character(len=MAXWORDLENGTH), allocatable :: sec_names(:)
716) character(len=MAXWORDLENGTH), allocatable :: gas_names(:)
717) PetscReal, allocatable :: logKCoeffvector_swapped(:,:)
718) PetscBool, allocatable :: flags(:)
719) PetscBool :: negative_flag
720) PetscReal :: value
721)
722) PetscInt :: ispec, itemp
723) PetscInt :: spec_id
724) PetscInt :: ncomp_h2o, ncomp_secondary
725) PetscInt :: icount_old, icount_new, icount, icount2
726) PetscInt :: i, j, irow, icol
727) PetscInt :: icomp, icplx, irxn
728) PetscInt :: ipri_spec, isec_spec, imnrl, igas_spec, ikinmnrl, icoll
729) PetscInt :: i_old, i_new
730) PetscInt :: isrfcplx
731) PetscInt :: ication
732) PetscInt :: idum
733) PetscReal :: temp_high, temp_low
734) PetscInt :: itemp_high, itemp_low
735) PetscInt :: species_count, max_species_count
736) PetscInt :: forward_count, max_forward_count
737) PetscInt :: backward_count, max_backward_count
738) PetscInt :: midpoint
739) PetscInt :: max_num_prefactors, max_num_prefactor_species
740)
741) PetscBool :: compute_new_basis
742) PetscBool :: found
743) PetscErrorCode :: ierr
744) !TODO(geh)
745) #if 0
746) ! get database temperature based on REFERENCE_TEMPERATURE
747) if (option%reference_temperature <= 0.01d0) then
748) reaction%debyeA = 0.4939d0
749) reaction%debyeB = 0.3253d0
750) reaction%debyeBdot = 0.0374d0
751) else if (option%reference_temperature > 0.d0 .and. &
752) option%reference_temperature <= 25.d0) then
753) temp_low = 0.d0
754) temp_high = 25.d0
755) call Interpolate(temp_high,temp_low,option%reference_temperature, &
756) 0.5114d0,0.4939d0,reaction%debyeA)
757) call Interpolate(temp_high,temp_low,option%reference_temperature, &
758) 0.3288d0,0.3253d0,reaction%debyeB)
759) call Interpolate(temp_high,temp_low,option%reference_temperature, &
760) 0.0410d0,0.0374d0,reaction%debyeBdot)
761) else if (option%reference_temperature > 25.d0 .and. &
762) option%reference_temperature <= 60.d0) then
763) temp_low = 25.d0
764) temp_high = 60.d0
765) call Interpolate(temp_high,temp_low,option%reference_temperature, &
766) 0.5465d0,0.5114d0,reaction%debyeA)
767) call Interpolate(temp_high,temp_low,option%reference_temperature, &
768) 0.3346d0,0.3288d0,reaction%debyeB)
769) call Interpolate(temp_high,temp_low,option%reference_temperature, &
770) 0.0440d0,0.0410d0,reaction%debyeBdot)
771) else if (option%reference_temperature > 60.d0 .and. &
772) option%reference_temperature <= 100.d0) then
773) temp_low = 60.d0
774) temp_high = 100.d0
775) call Interpolate(temp_high,temp_low,option%reference_temperature, &
776) 0.5995d0,0.5465d0,reaction%debyeA)
777) call Interpolate(temp_high,temp_low,option%reference_temperature, &
778) 0.3421d0,0.3346d0,reaction%debyeB)
779) call Interpolate(temp_high,temp_low,option%reference_temperature, &
780) 0.0460d0,0.0440d0,reaction%debyeBdot)
781) else if (option%reference_temperature > 100.d0 .and. &
782) option%reference_temperature <= 150.d0) then
783) temp_low = 100.d0
784) temp_high = 150.d0
785) call Interpolate(temp_high,temp_low,option%reference_temperature, &
786) 0.6855d0,0.5995d0,reaction%debyeA)
787) call Interpolate(temp_high,temp_low,option%reference_temperature, &
788) 0.3525d0,0.3421d0,reaction%debyeB)
789) call Interpolate(temp_high,temp_low,option%reference_temperature, &
790) 0.0470d0,0.0460d0,reaction%debyeBdot)
791) else if (option%reference_temperature > 150.d0 .and. &
792) option%reference_temperature <= 200.d0) then
793) temp_low = 150.d0
794) temp_high = 200.d0
795) call Interpolate(temp_high,temp_low,option%reference_temperature, &
796) 0.7994d0,0.6855d0,reaction%debyeA)
797) call Interpolate(temp_high,temp_low,option%reference_temperature, &
798) 0.3639d0,0.3525d0,reaction%debyeB)
799) call Interpolate(temp_high,temp_low,option%reference_temperature, &
800) 0.0470d0,0.0470d0,reaction%debyeBdot)
801) else if (option%reference_temperature > 200.d0 .and. &
802) option%reference_temperature <= 250.d0) then
803) temp_low = 200.d0
804) temp_high = 250.d0
805) call Interpolate(temp_high,temp_low,option%reference_temperature, &
806) 0.9593d0,0.7994d0,reaction%debyeA)
807) call Interpolate(temp_high,temp_low,option%reference_temperature, &
808) 0.3766d0,0.3639d0,reaction%debyeB)
809) call Interpolate(temp_high,temp_low,option%reference_temperature, &
810) 0.0340d0,0.0470d0,reaction%debyeBdot)
811) else if (option%reference_temperature > 250.d0 .and. &
812) option%reference_temperature <= 300.d0) then
813) temp_low = 250.d0
814) temp_high = 300.d0
815) call Interpolate(temp_high,temp_low,option%reference_temperature, &
816) 1.2180d0,0.9593d0,reaction%debyeA)
817) call Interpolate(temp_high,temp_low,option%reference_temperature, &
818) 0.3925d0,0.3766d0,reaction%debyeB)
819) call Interpolate(temp_high,temp_low,option%reference_temperature, &
820) 0.0000d0,0.0340d0,reaction%debyeBdot)
821) else if (option%reference_temperature > 300.d0 .and. &
822) option%reference_temperature <= 350.d0) then
823) temp_low = 300.d0
824) temp_high = 350.d0
825) call Interpolate(temp_high,temp_low,option%reference_temperature, &
826) 1.2180d0,1.2180d0,reaction%debyeA)
827) call Interpolate(temp_high,temp_low,option%reference_temperature, &
828) 0.3925d0,0.3925d0,reaction%debyeB)
829) call Interpolate(temp_high,temp_low,option%reference_temperature, &
830) 0.0000d0,0.0000d0,reaction%debyeBdot)
831) else if (option%reference_temperature > 350.d0) then
832) reaction%debyeA = 1.2180d0
833) reaction%debyeB = 0.3925d0
834) reaction%debyeBdot = 0.0000d0
835) endif
836)
837) if (.not.reaction%act_coef_use_bdot) then
838) reaction%debyeBdot = 0.d0
839) endif
840)
841) if (option%reference_temperature <= reaction%dbase_temperatures(1)) then
842) itemp_low = 1
843) itemp_high = 1
844) temp_low = reaction%dbase_temperatures(itemp_low)
845) temp_high = reaction%dbase_temperatures(itemp_high)
846) else if (option%reference_temperature > &
847) reaction%dbase_temperatures(reaction%num_dbase_temperatures)) then
848) itemp_low = reaction%num_dbase_temperatures
849) itemp_high = reaction%num_dbase_temperatures
850) temp_low = reaction%dbase_temperatures(itemp_low)
851) temp_high = reaction%dbase_temperatures(itemp_high)
852) else
853) do itemp = 1, reaction%num_dbase_temperatures-1
854) itemp_low = itemp
855) itemp_high = itemp+1
856) temp_low = reaction%dbase_temperatures(itemp_low)
857) temp_high = reaction%dbase_temperatures(itemp_high)
858) if (option%reference_temperature > temp_low .and. &
859) option%reference_temperature <= temp_high) then
860) exit
861) endif
862) enddo
863) endif
864)
865) ! # of components sorbed to colloids
866) reaction%naqcomp = GetPrimarySpeciesCount(reaction)
867) reaction%ncoll = GetColloidCount(reaction)
868) reaction%neqcplx = GetSecondarySpeciesCount(reaction)
869) reaction%ngas = GetGasCount(reaction)
870)
871) reaction%ncollcomp = reaction%naqcomp ! set to naqcomp for now, will be adjusted later
872) reaction%offset_aqueous = 0
873) reaction%offset_colloid = reaction%offset_aqueous + reaction%naqcomp
874) reaction%offset_collcomp = reaction%offset_colloid + reaction%ncoll
875)
876) ! account for H2O in the basis by adding 1
877) ncomp_h2o = reaction%naqcomp+1
878)
879) allocate(old_basis_names(ncomp_h2o+reaction%neqcplx))
880) allocate(new_basis_names(ncomp_h2o))
881) old_basis_names = ''
882) new_basis_names = ''
883)
884) call BasisPrint(reaction,'Initial Basis',option)
885)
886) !--------------------------------------------
887)
888) ! for now, remove equilibrium reactions from any primary species that are
889) ! flagged as "redox"
890) cur_aq_spec => reaction%primary_species_list
891) do
892) if (.not.associated(cur_aq_spec)) exit
893) if (cur_aq_spec%is_redox .and. associated(cur_aq_spec%dbaserxn)) then
894) call DatabaseRxnDestroy(cur_aq_spec%dbaserxn)
895) endif
896) cur_aq_spec => cur_aq_spec%next
897) enddo
898)
899) ncomp_secondary = reaction%neqcplx+reaction%ngas
900)
901) ! check to ensure that the number of secondary aqueous and gas species
902) ! (i.e. those with a reaction defined from the database) is equal to the
903) ! number of reactions read from the database. If not, send an error
904) ! message.
905)
906) icount = 0
907) cur_pri_aq_spec => reaction%primary_species_list
908) do
909) if (.not.associated(cur_pri_aq_spec)) exit
910) if (associated(cur_pri_aq_spec%dbaserxn)) then
911) icount = icount + 1
912) endif
913) cur_pri_aq_spec => cur_pri_aq_spec%next
914) enddo
915)
916) cur_sec_aq_spec => reaction%secondary_species_list
917) do
918) if (.not.associated(cur_sec_aq_spec)) exit
919) if (associated(cur_sec_aq_spec%dbaserxn)) then
920) icount = icount + 1
921) endif
922) cur_sec_aq_spec => cur_sec_aq_spec%next
923) enddo
924)
925) cur_gas_spec => reaction%gas_species_list
926) do
927) if (.not.associated(cur_gas_spec)) exit
928) if (associated(cur_gas_spec%dbaserxn)) then
929) icount = icount + 1
930) endif
931) cur_gas_spec => cur_gas_spec%next
932) enddo
933)
934) if (icount /= ncomp_secondary) then
935) if (icount < ncomp_secondary) then
936) option%io_buffer = 'Too few reactions read from database for ' // &
937) 'number of secondary species defined.'
938) else
939) option%io_buffer = 'Too many reactions read from database for ' // &
940) 'number of secondary species defined. Perhaps REDOX ' // &
941) 'SPECIES need to be defined?'
942) endif
943) call printErrMsg(option)
944) endif
945)
946) allocate(pri_matrix(ncomp_secondary,ncomp_h2o))
947) pri_matrix = 0.d0
948) allocate(pri_names(ncomp_h2o))
949) pri_names = ''
950) allocate(sec_matrix(ncomp_secondary,ncomp_secondary))
951) sec_matrix = 0.d0
952) allocate(sec_names(reaction%neqcplx))
953) sec_names = ''
954) allocate(gas_names(reaction%ngas))
955) gas_names = ''
956)
957) allocate(logKCoeffvector(reaction%num_dbase_parameters,ncomp_secondary))
958) logKCoeffvector = 0.d0
959)
960) ! fill in names
961) icount = 1
962) pri_names(icount) = h2oname
963) cur_aq_spec => reaction%primary_species_list
964) do
965) if (.not.associated(cur_aq_spec)) exit
966) icount = icount + 1
967) pri_names(icount) = cur_aq_spec%name
968) cur_aq_spec => cur_aq_spec%next
969) enddo
970) icount = 0
971) cur_aq_spec => reaction%secondary_species_list
972) do
973) if (.not.associated(cur_aq_spec)) exit
974) icount = icount + 1
975) sec_names(icount) = cur_aq_spec%name
976) cur_aq_spec => cur_aq_spec%next
977) enddo
978) icount= 0
979) cur_gas_spec => reaction%gas_species_list
980) do
981) if (.not.associated(cur_gas_spec)) exit
982) icount = icount + 1
983) gas_names(icount) = cur_gas_spec%name
984) cur_gas_spec => cur_gas_spec%next
985) enddo
986)
987) ! fill in matrices
988) icount = 0
989) cur_pri_aq_spec => reaction%primary_species_list
990) do
991) if (.not.associated(cur_pri_aq_spec)) exit
992) if (associated(cur_pri_aq_spec%dbaserxn)) then
993) icount = icount + 1
994) logKCoeffvector(:,icount) = cur_pri_aq_spec%dbaserxn%logK
995) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
996) cur_pri_aq_spec%name, &
997) cur_pri_aq_spec%name, &
998) pri_names,sec_names,gas_names)
999) if (i < 0) then
1000) option%io_buffer = 'Primary species ' // &
1001) trim(cur_pri_aq_spec%name) // &
1002) ' found in secondary or gas list.'
1003) call printErrMsg(option)
1004) endif
1005) pri_matrix(icount,i) = -1.d0
1006) do ispec=1,cur_pri_aq_spec%dbaserxn%nspec
1007) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1008) cur_pri_aq_spec%name, &
1009) cur_pri_aq_spec%dbaserxn%spec_name(ispec), &
1010) pri_names,sec_names,gas_names)
1011) if (i > 0) then
1012) pri_matrix(icount,i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
1013) else
1014) sec_matrix(icount,-i) = cur_pri_aq_spec%dbaserxn%stoich(ispec)
1015) endif
1016) enddo
1017) endif
1018) cur_pri_aq_spec => cur_pri_aq_spec%next
1019) enddo
1020)
1021) cur_sec_aq_spec => reaction%secondary_species_list
1022) do
1023) if (.not.associated(cur_sec_aq_spec)) exit
1024) if (associated(cur_sec_aq_spec%dbaserxn)) then
1025) icount = icount + 1
1026) logKCoeffvector(:,icount) = cur_sec_aq_spec%dbaserxn%logKCoeff_hpt
1027) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1028) cur_sec_aq_spec%name, &
1029) cur_sec_aq_spec%name, &
1030) pri_names,sec_names,gas_names)
1031) if (i > 0) then
1032) option%io_buffer = 'Secondary aqueous species ' // &
1033) trim(cur_sec_aq_spec%name) // &
1034) ' found in primary species list.'
1035) call printErrMsg(option)
1036) endif
1037) sec_matrix(icount,-i) = -1.d0
1038) do ispec=1,cur_sec_aq_spec%dbaserxn%nspec
1039) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1040) cur_sec_aq_spec%name, &
1041) cur_sec_aq_spec%dbaserxn%spec_name(ispec), &
1042) pri_names,sec_names,gas_names)
1043) if (i > 0) then
1044) pri_matrix(icount,i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
1045) else
1046) sec_matrix(icount,-i) = cur_sec_aq_spec%dbaserxn%stoich(ispec)
1047) endif
1048) enddo
1049) endif
1050) cur_sec_aq_spec => cur_sec_aq_spec%next
1051) enddo
1052)
1053) cur_gas_spec => reaction%gas_species_list
1054) do
1055) if (.not.associated(cur_gas_spec)) exit
1056) if (associated(cur_gas_spec%dbaserxn)) then
1057) icount = icount + 1
1058) logKCoeffvector(:,icount) = cur_gas_spec%dbaserxn%logKCoeff_hpt
1059) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1060) cur_gas_spec%name, &
1061) cur_gas_spec%name, &
1062) pri_names,sec_names,gas_names)
1063) if (i > 0) then
1064) option%io_buffer = 'Gas species ' // &
1065) trim(cur_gas_spec%name) // &
1066) ' found in primary species list.'
1067) call printErrMsg(option)
1068) endif
1069) sec_matrix(icount,-i) = -1.d0
1070) do ispec=1,cur_gas_spec%dbaserxn%nspec
1071) i = GetSpeciesBasisID(reaction,option,ncomp_h2o, &
1072) cur_gas_spec%name, &
1073) cur_gas_spec%dbaserxn%spec_name(ispec), &
1074) pri_names,sec_names,gas_names)
1075) if (i > 0) then
1076) pri_matrix(icount,i) = cur_gas_spec%dbaserxn%stoich(ispec)
1077) else
1078) sec_matrix(icount,-i) = cur_gas_spec%dbaserxn%stoich(ispec)
1079) endif
1080) enddo
1081) endif
1082) cur_gas_spec => cur_gas_spec%next
1083) enddo
1084)
1085) allocate(indices(ncomp_secondary))
1086) indices = 0
1087) allocate(unit_vector(ncomp_secondary))
1088) unit_vector = 0.d0
1089) allocate(sec_matrix_inverse(ncomp_secondary,ncomp_secondary))
1090) sec_matrix_inverse = 0.d0
1091)
1092) call ludcmp(sec_matrix,ncomp_secondary,indices,idum)
1093) do ispec = 1, ncomp_secondary
1094) unit_vector = 0.d0
1095) unit_vector(ispec) = 1.d0
1096) call lubksb(sec_matrix,ncomp_secondary,indices,unit_vector)
1097) sec_matrix_inverse(:,ispec) = unit_vector(:)
1098) enddo
1099)
1100) ! invert the secondary species matrix
1101) allocate(stoich_matrix(ncomp_secondary,ncomp_h2o))
1102) stoich_matrix = 0.d0
1103) do j = 1, ncomp_h2o
1104) do i = 1, ncomp_secondary
1105) do ispec = 1, ncomp_secondary
1106) stoich_matrix(i,j) = stoich_matrix(i,j) + &
1107) sec_matrix_inverse(i,ispec)*pri_matrix(ispec,j)
1108) enddo
1109) enddo
1110) enddo
1111) stoich_matrix = -1.d0*stoich_matrix
1112)
1113) allocate(logKCoeffvector_swapped(reaction%num_dbase_parameters,ncomp_secondary))
1114) logKCoeffvector_swapped = 0.d0
1115)
1116) do j = 1, ncomp_secondary
1117) do i = 1, reaction%num_dbase_parameters
1118) logKCoeffvector_swapped(i,j) = logKCoeffvector_swapped(i,j) - &
1119) dot_product(sec_matrix_inverse(j,1:ncomp_secondary), &
1120) logKCoeffvector(i,1:ncomp_secondary))
1121) enddo
1122) enddo
1123)
1124) deallocate(pri_matrix)
1125) deallocate(sec_matrix)
1126) deallocate(indices)
1127) deallocate(unit_vector)
1128) deallocate(sec_matrix_inverse)
1129) deallocate(logKCoeffvector_swapped)
1130)
1131) cur_pri_aq_spec => reaction%primary_species_list
1132) do
1133) if (.not.associated(cur_pri_aq_spec)) exit
1134) if (associated(cur_pri_aq_spec%dbaserxn)) then
1135) call DatabaseRxnDestroy(cur_pri_aq_spec%dbaserxn)
1136) endif
1137) cur_pri_aq_spec => cur_pri_aq_spec%next
1138) enddo
1139)
1140) icount = 0
1141) cur_sec_aq_spec => reaction%secondary_species_list
1142) do
1143) if (.not.associated(cur_sec_aq_spec)) exit
1144) icount = icount + 1
1145) ! destory old reaction
1146) call DatabaseRxnDestroy(cur_sec_aq_spec%dbaserxn)
1147) ! allocate new
1148) cur_sec_aq_spec%dbaserxn => DatabaseRxnCreate()
1149)
1150) ! count # of species in reaction
1151) icount2 = 0
1152) do icol = 1, ncomp_h2o
1153) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1154) cur_sec_aq_spec%dbaserxn%nspec = cur_sec_aq_spec%dbaserxn%nspec + 1
1155) endif
1156) enddo
1157)
1158) allocate(cur_sec_aq_spec%dbaserxn%stoich(cur_sec_aq_spec%dbaserxn%nspec))
1159) cur_sec_aq_spec%dbaserxn%stoich = 0.d0
1160) allocate(cur_sec_aq_spec%dbaserxn%spec_name(cur_sec_aq_spec%dbaserxn%nspec))
1161) cur_sec_aq_spec%dbaserxn%spec_name = ''
1162) allocate(cur_sec_aq_spec%dbaserxn%spec_ids(cur_sec_aq_spec%dbaserxn%nspec))
1163) cur_sec_aq_spec%dbaserxn%spec_ids = 0
1164) allocate(cur_sec_aq_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
1165) cur_sec_aq_spec%dbaserxn%logKCoeff_hpt = 0.d0
1166)
1167) ispec = 0
1168) do icol = 1, ncomp_h2o
1169) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1170) ispec = ispec + 1
1171) cur_sec_aq_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
1172) cur_sec_aq_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
1173) cur_sec_aq_spec%dbaserxn%spec_ids(ispec) = icol
1174) endif
1175) enddo
1176)
1177) cur_sec_aq_spec%dbaserxn%logKCoeff_hpt = logKCoeffvector_swapped(:,icount)
1178)
1179) cur_sec_aq_spec => cur_sec_aq_spec%next
1180) enddo
1181)
1182) cur_gas_spec => reaction%gas_species_list
1183) do
1184) if (.not.associated(cur_gas_spec)) exit
1185) icount = icount + 1
1186) ! destory old reaction
1187) call DatabaseRxnDestroy(cur_gas_spec%dbaserxn)
1188) ! allocate new
1189) cur_gas_spec%dbaserxn => DatabaseRxnCreate()
1190)
1191) ! count # of species in reaction
1192) icount2 = 0
1193) do icol = 1, ncomp_h2o
1194) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1195) cur_gas_spec%dbaserxn%nspec = cur_gas_spec%dbaserxn%nspec + 1
1196) endif
1197) enddo
1198)
1199) allocate(cur_gas_spec%dbaserxn%stoich(cur_gas_spec%dbaserxn%nspec))
1200) cur_gas_spec%dbaserxn%stoich = 0.d0
1201) allocate(cur_gas_spec%dbaserxn%spec_name(cur_gas_spec%dbaserxn%nspec))
1202) cur_gas_spec%dbaserxn%spec_name = ''
1203) allocate(cur_gas_spec%dbaserxn%spec_ids(cur_gas_spec%dbaserxn%nspec))
1204) cur_gas_spec%dbaserxn%spec_ids = 0
1205) allocate(cur_gas_spec%dbaserxn%logKCoeff_hpt(reaction%num_dbase_parameters))
1206) cur_gas_spec%dbaserxn%logKCoeff_hpt = 0.d0
1207)
1208) ispec = 0
1209) do icol = 1, ncomp_h2o
1210) if (dabs(stoich_matrix(icount,icol)) > 1.d-40) then
1211) ispec = ispec + 1
1212) cur_gas_spec%dbaserxn%spec_name(ispec) = pri_names(icol)
1213) cur_gas_spec%dbaserxn%stoich(ispec) = stoich_matrix(icount,icol)
1214) cur_gas_spec%dbaserxn%spec_ids(ispec) = icol
1215) endif
1216) enddo
1217)
1218) cur_gas_spec%dbaserxn%logKCoeff_hpt = logKCoeffvector_swapped(:,icount)
1219)
1220) cur_gas_spec => cur_gas_spec%next
1221) enddo
1222)
1223) new_basis_names = pri_names
1224)
1225) deallocate(stoich_matrix)
1226) deallocate(logKCoeffvector_swapped)
1227)
1228) deallocate(pri_names)
1229) deallocate(sec_names)
1230) deallocate(gas_names)
1231)
1232) nullify(cur_sec_aq_spec)
1233) nullify(cur_gas_spec)
1234) nullify(cur_mineral)
1235) nullify(cur_srfcplx_rxn)
1236) nullify(cur_srfcplx)
1237)
1238) ! first off, lets remove all the secondary gases from all other reactions
1239) cur_gas_spec => reaction%gas_species_list
1240) do
1241) if (.not.associated(cur_gas_spec)) exit
1242)
1243) ! gases in mineral reactions
1244) cur_mineral => reaction%mineral_list
1245) do
1246) if (.not.associated(cur_mineral)) exit
1247)
1248) if (associated(cur_mineral%tstrxn)) then
1249) ispec = 1
1250) do
1251) if (ispec > cur_mineral%dbaserxn%nspec) exit
1252) if (StringCompare(cur_gas_spec%name, &
1253) cur_mineral%dbaserxn%spec_name(ispec), &
1254) MAXWORDLENGTH)) then
1255) call BasisSubSpeciesInMineralRxn_hpt(cur_gas_spec%name, &
1256) cur_gas_spec%dbaserxn, &
1257) cur_mineral%dbaserxn)
1258) ispec = 0
1259) endif
1260) ispec = ispec + 1
1261) enddo
1262) endif
1263) cur_mineral => cur_mineral%next
1264) enddo
1265) nullify(cur_mineral)
1266)
1267) ! gases in surface complex reactions
1268) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
1269) do
1270) if (.not.associated(cur_srfcplx_rxn)) exit
1271) cur_srfcplx2 => cur_srfcplx_rxn%complex_list
1272) do
1273) if (.not.associated(cur_srfcplx2)) exit
1274)
1275) if (associated(cur_srfcplx2%dbaserxn)) then
1276) ispec = 1
1277) do
1278) if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
1279) if (StringCompare(cur_gas_spec%name, &
1280) cur_srfcplx2%dbaserxn%spec_name(ispec), &
1281) MAXWORDLENGTH)) then
1282) call BasisSubSpecInGasOrSecRxn_hpt(cur_gas_spec%name, &
1283) cur_gas_spec%dbaserxn, &
1284) cur_srfcplx2%dbaserxn)
1285) ispec = 0
1286) endif
1287) ispec = ispec + 1
1288) enddo
1289) endif
1290) cur_srfcplx2 => cur_srfcplx2%next
1291) enddo
1292) nullify(cur_srfcplx2)
1293) cur_srfcplx_rxn => cur_srfcplx_rxn%next
1294) enddo
1295) nullify(cur_srfcplx_rxn)
1296)
1297) cur_gas_spec => cur_gas_spec%next
1298) enddo
1299)
1300) nullify(cur_sec_aq_spec)
1301) nullify(cur_gas_spec)
1302) nullify(cur_mineral)
1303) nullify(cur_srfcplx_rxn)
1304) nullify(cur_srfcplx)
1305)
1306) ! secondary aqueous species
1307) cur_sec_aq_spec => reaction%secondary_species_list
1308) do
1309)
1310) if (.not.associated(cur_sec_aq_spec)) exit
1311)
1312) ! secondary aqueous species in mineral reactions
1313) cur_mineral => reaction%mineral_list
1314) do
1315) if (.not.associated(cur_mineral)) exit
1316)
1317) if (associated(cur_mineral%tstrxn)) then
1318) ispec = 1
1319) do
1320) if (ispec > cur_mineral%dbaserxn%nspec) exit
1321) if (StringCompare(cur_sec_aq_spec%name, &
1322) cur_mineral%dbaserxn%spec_name(ispec), &
1323) MAXWORDLENGTH)) then
1324) call BasisSubSpeciesInMineralRxn_hpt(cur_sec_aq_spec%name, &
1325) cur_sec_aq_spec%dbaserxn, &
1326) cur_mineral%dbaserxn)
1327) ispec = 0
1328) endif
1329) ispec = ispec + 1
1330) enddo
1331) endif
1332) cur_mineral => cur_mineral%next
1333) enddo
1334)
1335) ! secondary aqueous species in surface complex reactions
1336) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
1337) do
1338) if (.not.associated(cur_srfcplx_rxn)) exit
1339) cur_srfcplx2 => cur_srfcplx_rxn%complex_list
1340) do
1341) if (.not.associated(cur_srfcplx2)) exit
1342)
1343) if (associated(cur_srfcplx2%dbaserxn)) then
1344) ispec = 1
1345) do
1346) if (ispec > cur_srfcplx2%dbaserxn%nspec) exit
1347) if (StringCompare(cur_sec_aq_spec%name, &
1348) cur_srfcplx2%dbaserxn%spec_name(ispec), &
1349) MAXWORDLENGTH)) then
1350) call BasisSubSpecInGasOrSecRxn_hpt(cur_sec_aq_spec%name, &
1351) cur_sec_aq_spec%dbaserxn, &
1352) cur_srfcplx2%dbaserxn)
1353) ispec = 0
1354) endif
1355) ispec = ispec + 1
1356) enddo
1357) endif
1358) cur_srfcplx2 => cur_srfcplx2%next
1359) enddo
1360) nullify(cur_srfcplx2)
1361) cur_srfcplx_rxn => cur_srfcplx_rxn%next
1362) enddo
1363) nullify(cur_srfcplx_rxn)
1364)
1365) cur_sec_aq_spec => cur_sec_aq_spec%next
1366) enddo
1367)
1368) nullify(cur_sec_aq_spec)
1369) nullify(cur_gas_spec)
1370) nullify(cur_mineral)
1371) nullify(cur_srfcplx_rxn)
1372) nullify(cur_srfcplx)
1373)
1374) ! substitute new basis into mineral and surface complexation rxns,
1375) ! if necessary
1376) cur_mineral => reaction%mineral_list
1377) do
1378) if (.not.associated(cur_mineral)) exit
1379) if (.not.associated(cur_mineral%dbaserxn%spec_ids)) then
1380) allocate(cur_mineral%dbaserxn%spec_ids(cur_mineral%dbaserxn%nspec))
1381) cur_mineral%dbaserxn%spec_ids = 0
1382) endif
1383)
1384) call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
1385) cur_mineral%dbaserxn%nspec, &
1386) cur_mineral%dbaserxn%spec_name, &
1387) cur_mineral%dbaserxn%stoich, &
1388) cur_mineral%dbaserxn%spec_ids, &
1389) cur_mineral%name,option)
1390) cur_mineral => cur_mineral%next
1391) enddo
1392)
1393) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
1394) do
1395) if (.not.associated(cur_srfcplx_rxn)) exit
1396) cur_srfcplx => cur_srfcplx_rxn%complex_list
1397) do
1398) if (.not.associated(cur_srfcplx)) exit
1399) if (.not.associated(cur_srfcplx%dbaserxn%spec_ids)) then
1400) allocate(cur_srfcplx%dbaserxn%spec_ids(cur_srfcplx%dbaserxn%nspec))
1401) cur_srfcplx%dbaserxn%spec_ids = 0
1402) endif
1403) call BasisAlignSpeciesInRxn(ncomp_h2o,new_basis_names, &
1404) cur_srfcplx%dbaserxn%nspec, &
1405) cur_srfcplx%dbaserxn%spec_name, &
1406) cur_srfcplx%dbaserxn%stoich, &
1407) cur_srfcplx%dbaserxn%spec_ids, &
1408) cur_srfcplx%name,option)
1409) cur_srfcplx => cur_srfcplx%next
1410) enddo
1411) nullify(cur_srfcplx)
1412) cur_srfcplx_rxn => cur_srfcplx_rxn%next
1413) enddo
1414) nullify(cur_srfcplx_rxn)
1415)
1416) ! fill reaction arrays, swapping if necessary
1417) if (associated(reaction%primary_species_names)) &
1418) deallocate(reaction%primary_species_names)
1419)
1420) allocate(reaction%primary_species_names(reaction%naqcomp))
1421) reaction%primary_species_names = ''
1422)
1423) allocate(reaction%primary_species_print(reaction%naqcomp))
1424) reaction%primary_species_print = PETSC_FALSE
1425)
1426) allocate(reaction%primary_spec_Z(reaction%naqcomp))
1427) reaction%primary_spec_Z = 0.d0
1428)
1429) allocate(reaction%primary_spec_molar_wt(reaction%naqcomp))
1430) reaction%primary_spec_molar_wt = 0.d0
1431)
1432) allocate(reaction%primary_spec_a0(reaction%naqcomp))
1433) reaction%primary_spec_a0 = 0.d0
1434)
1435) allocate(reaction%kd_print(reaction%naqcomp))
1436) reaction%kd_print = PETSC_FALSE
1437) if (reaction%nsorb > 0) then
1438) allocate(reaction%total_sorb_print(reaction%naqcomp))
1439) reaction%total_sorb_print = PETSC_FALSE
1440) endif
1441)
1442) ! pack in reaction arrays
1443) cur_pri_aq_spec => reaction%primary_species_list
1444) ispec = 1
1445) do
1446) if (.not.associated(cur_pri_aq_spec)) exit
1447) reaction%primary_species_names(ispec) = cur_pri_aq_spec%name
1448) reaction%primary_spec_Z(ispec) = cur_pri_aq_spec%Z
1449) reaction%primary_spec_molar_wt(ispec) = cur_pri_aq_spec%molar_weight
1450) reaction%primary_spec_a0(ispec) = cur_pri_aq_spec%a0
1451) reaction%primary_species_print(ispec) = cur_pri_aq_spec%print_me .or. &
1452) reaction%print_all_primary_species
1453) reaction%kd_print(ispec) = (cur_pri_aq_spec%print_me .or. &
1454) reaction%print_all_primary_species) .and. &
1455) reaction%print_kd
1456) if (reaction%nsorb > 0) then
1457) reaction%total_sorb_print(ispec) = (cur_pri_aq_spec%print_me .or. &
1458) reaction%print_all_primary_species) .and. &
1459) reaction%print_total_sorb
1460) endif
1461) ispec = ispec + 1
1462) cur_pri_aq_spec => cur_pri_aq_spec%next
1463) enddo
1464) nullify(cur_pri_aq_spec)
1465) ispec = -1 ! to catch bugs
1466)
1467) ! secondary aqueous complexes
1468) reaction%neqcplx = GetSecondarySpeciesCount(reaction)
1469)
1470) if (reaction%neqcplx > 0) then
1471) allocate(reaction%secondary_species_names(reaction%neqcplx))
1472) reaction%secondary_species_names = ''
1473)
1474) allocate(reaction%secondary_species_print(reaction%neqcplx))
1475) reaction%secondary_species_print = PETSC_FALSE
1476)
1477) allocate(reaction%eqcplx_basis_names(reaction%naqcomp,reaction%neqcplx))
1478) reaction%eqcplx_basis_names = ''
1479)
1480) allocate(reaction%eqcplxspecid(0:reaction%naqcomp,reaction%neqcplx))
1481) reaction%eqcplxspecid = 0
1482)
1483) allocate(reaction%eqcplxstoich(0:reaction%naqcomp,reaction%neqcplx))
1484) reaction%eqcplxstoich = 0.d0
1485)
1486) allocate(reaction%eqcplxh2oid(reaction%neqcplx))
1487) reaction%eqcplxh2oid = 0
1488)
1489) allocate(reaction%eqcplxh2ostoich(reaction%neqcplx))
1490) reaction%eqcplxh2ostoich = 0.d0
1491)
1492) allocate(reaction%eqcplx_logK(reaction%neqcplx))
1493) reaction%eqcplx_logK = 0.d0
1494)
1495) allocate(reaction%eqcplx_logKcoef(reaction%num_dbase_parameters,reaction%neqcplx))
1496) reaction%eqcplx_logKcoef = 0.d0
1497)
1498) allocate(reaction%eqcplx_Z(reaction%neqcplx))
1499) reaction%eqcplx_Z = 0.d0
1500)
1501) allocate(reaction%eqcplx_molar_wt(reaction%neqcplx))
1502) reaction%eqcplx_molar_wt = 0.d0
1503)
1504) allocate(reaction%eqcplx_a0(reaction%neqcplx))
1505) reaction%eqcplx_a0 = 0.d0
1506)
1507) ! pack in reaction arrays
1508) cur_sec_aq_spec => reaction%secondary_species_list
1509) isec_spec = 1
1510) do
1511) if (.not.associated(cur_sec_aq_spec)) exit
1512)
1513) reaction%secondary_species_names(isec_spec) = &
1514) cur_sec_aq_spec%name
1515) reaction%secondary_species_print(isec_spec) = cur_sec_aq_spec%print_me .or. &
1516) reaction%print_all_secondary_species
1517) ispec = 0
1518) do i = 1, cur_sec_aq_spec%dbaserxn%nspec
1519)
1520) ! print *,'database: ',i,cur_sec_aq_spec%dbaserxn%spec_name(i)
1521)
1522) if (cur_sec_aq_spec%dbaserxn%spec_ids(i) /= h2o_id) then
1523) ispec = ispec + 1
1524) spec_id = cur_sec_aq_spec%dbaserxn%spec_ids(i)
1525) if (spec_id > h2o_id) spec_id = spec_id - 1
1526) reaction%eqcplxspecid(ispec,isec_spec) = spec_id
1527) reaction%eqcplx_basis_names(ispec,isec_spec) = &
1528) cur_sec_aq_spec%dbaserxn%spec_name(i)
1529) reaction%eqcplxstoich(ispec,isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
1530)
1531) else ! fill in h2o id and stoich
1532) reaction%eqcplxh2oid(isec_spec) = h2o_id
1533) reaction%eqcplxh2ostoich(isec_spec) = cur_sec_aq_spec%dbaserxn%stoich(i)
1534) endif
1535) enddo
1536) reaction%eqcplxspecid(0,isec_spec) = ispec
1537) !#if 0
1538) ! TODO(Peter): fix argument list
1539) call ReactionInitializeLogK_hpt(reaction%eqcplx_logKcoef(:,isec_spec), &
1540) reaction%eqcplx_logK(isec_spec), &
1541) option,reaction)
1542) !#endif
1543) reaction%eqcplx_Z(isec_spec) = cur_sec_aq_spec%Z
1544) reaction%eqcplx_molar_wt(isec_spec) = cur_sec_aq_spec%molar_weight
1545) reaction%eqcplx_a0(isec_spec) = cur_sec_aq_spec%a0
1546)
1547) isec_spec = isec_spec + 1
1548) cur_sec_aq_spec => cur_sec_aq_spec%next
1549) enddo
1550)
1551) endif
1552) nullify(cur_sec_aq_spec)
1553) isec_spec = -1 ! to catch bugs
1554)
1555) ! gas complexes
1556) reaction%ngas = GetGasCount(reaction)
1557)
1558) if (reaction%ngas > 0) then
1559) allocate(reaction%gas_species_names(reaction%ngas))
1560) reaction%gas_species_names = ''
1561) allocate(reaction%gas_species_print(reaction%ngas))
1562) reaction%gas_species_print = PETSC_FALSE
1563) allocate(reaction%eqgasspecid(0:reaction%naqcomp,reaction%ngas))
1564) reaction%eqgasspecid = 0
1565) allocate(reaction%eqgasstoich(0:reaction%naqcomp,reaction%ngas))
1566) reaction%eqgasstoich = 0.d0
1567) allocate(reaction%eqgash2oid(reaction%ngas))
1568) reaction%eqgash2oid = 0
1569) allocate(reaction%eqgash2ostoich(reaction%ngas))
1570) reaction%eqgash2ostoich = 0.d0
1571) allocate(reaction%eqgas_logK(reaction%ngas))
1572) reaction%eqgas_logK = 0.d0
1573) allocate(reaction%eqgas_logKcoef(reaction%num_dbase_parameters, &
1574) reaction%ngas))
1575) reaction%eqgas_logKcoef = 0.d0
1576)
1577) ! pack in reaction arrays
1578) cur_gas_spec => reaction%gas_species_list
1579) igas_spec = 1
1580) do
1581) if (.not.associated(cur_gas_spec)) exit
1582)
1583) reaction%gas_species_names(igas_spec) = cur_gas_spec%name
1584) reaction%gas_species_print(igas_spec) = cur_gas_spec%print_me .or. &
1585) reaction%print_all_gas_species
1586) ispec = 0
1587) do i = 1, cur_gas_spec%dbaserxn%nspec
1588) if (cur_gas_spec%dbaserxn%spec_ids(i) /= h2o_id) then
1589) ispec = ispec + 1
1590) spec_id = cur_gas_spec%dbaserxn%spec_ids(i)
1591) if (spec_id > h2o_id) spec_id = spec_id - 1
1592) reaction%eqgasspecid(ispec,igas_spec) = spec_id
1593) reaction%eqgasstoich(ispec,igas_spec) = &
1594) cur_gas_spec%dbaserxn%stoich(i)
1595)
1596) else ! fill in h2o id and stoich
1597) reaction%eqgash2oid(igas_spec) = h2o_id
1598) reaction%eqgash2ostoich(igas_spec) = &
1599) cur_gas_spec%dbaserxn%stoich(i)
1600) endif
1601) enddo
1602) reaction%eqgasspecid(0,igas_spec) = ispec
1603) !#if 0
1604) ! TODO(Peter): fix argument list
1605) call ReactionInitializeLogK_hpt(reaction%eqgas_logKcoef(:,igas_spec), &
1606) reaction%eqgas_logK(igas_spec), &
1607) option,reaction)
1608) !#endif
1609) igas_spec = igas_spec + 1
1610) cur_gas_spec => cur_gas_spec%next
1611) enddo
1612)
1613) endif
1614) nullify(cur_gas_spec)
1615) igas_spec = -1 ! to catch bugs
1616)
1617) ! minerals
1618) ! Count the number of kinetic mineral reactions, max number of prefactors in a
1619) ! tst reaction, and the maximum number or species in a prefactor
1620) reaction%nkinmnrl = 0
1621) max_num_prefactors = 0
1622) max_num_prefactor_species = 0
1623) cur_mineral => reaction%mineral_list
1624) !
1625) do
1626) if (.not.associated(cur_mineral)) exit
1627) if (cur_mineral%itype == MINERAL_KINETIC .and. &
1628) associated(cur_mineral%tstrxn)) then
1629) ! increment number of kinetic minerals
1630) reaction%nkinmnrl = reaction%nkinmnrl + 1
1631) cur_prefactor => cur_mineral%tstrxn%prefactor
1632) ! zero number of prefactors
1633) i = 0
1634) do
1635) if (.not.associated(cur_prefactor)) exit
1636) i = i + 1
1637) cur_prefactor_species => cur_prefactor%species
1638) ! zero number of prefactor species
1639) j = 0
1640) do
1641) if (.not.associated(cur_prefactor_species)) exit
1642) j = j + 1
1643) cur_prefactor_species => cur_prefactor_species%next
1644) enddo
1645) if (j > max_num_prefactor_species) max_num_prefactor_species = j
1646) cur_prefactor => cur_prefactor%next
1647) enddo
1648) if (i > max_num_prefactors) max_num_prefactors = i
1649) endif
1650) cur_mineral => cur_mineral%next
1651) enddo
1652)
1653) if (reaction%nmnrl > 0) then
1654) allocate(reaction%mineral_names(reaction%nmnrl))
1655) reaction%mineral_names = ''
1656) allocate(reaction%mnrlspecid(0:reaction%naqcomp,reaction%nmnrl))
1657) reaction%mnrlspecid = 0
1658) allocate(reaction%mnrlstoich(reaction%naqcomp,reaction%nmnrl))
1659) reaction%mnrlstoich = 0.d0
1660) allocate(reaction%mnrlh2oid(reaction%nmnrl))
1661) reaction%mnrlh2oid = 0
1662) allocate(reaction%mnrlh2ostoich(reaction%nmnrl))
1663) reaction%mnrlh2ostoich = 0.d0
1664) allocate(reaction%mnrl_logK(reaction%nmnrl))
1665) reaction%mnrl_logK = 0.d0
1666) allocate(reaction%mnrl_print(reaction%nmnrl))
1667) reaction%mnrl_print = PETSC_FALSE
1668)
1669) allocate(reaction%mnrl_logKcoef(reaction%num_dbase_parameters, &
1670) reaction%nmnrl))
1671) reaction%mnrl_logKcoef = 0.d0
1672)
1673) if (reaction%nkinmnrl > 0) then
1674) allocate(reaction%kinmnrl_names(reaction%nkinmnrl))
1675) reaction%kinmnrl_names = ''
1676) allocate(reaction%kinmnrl_print(reaction%nkinmnrl))
1677) reaction%kinmnrl_print = PETSC_FALSE
1678) allocate(reaction%kinmnrlspecid(0:reaction%naqcomp,reaction%nkinmnrl))
1679) reaction%kinmnrlspecid = 0
1680) allocate(reaction%kinmnrlstoich(reaction%naqcomp,reaction%nkinmnrl))
1681) reaction%kinmnrlstoich = 0.d0
1682) allocate(reaction%kinmnrlh2oid(reaction%nkinmnrl))
1683) reaction%kinmnrlh2oid = 0
1684) allocate(reaction%kinmnrlh2ostoich(reaction%nkinmnrl))
1685) reaction%kinmnrlh2ostoich = 0.d0
1686) allocate(reaction%kinmnrl_logK(reaction%nkinmnrl))
1687) reaction%kinmnrl_logK = 0.d0
1688)
1689) allocate(reaction%kinmnrl_logKcoef(reaction%num_dbase_parameters, &
1690) reaction%nkinmnrl))
1691) reaction%kinmnrl_logKcoef = 0.d0
1692)
1693) ! TST Rxn variables
1694) allocate(reaction%kinmnrl_affinity_threshold(reaction%nkinmnrl))
1695) reaction%kinmnrl_affinity_threshold = 0.d0
1696) allocate(reaction%kinmnrl_rate_limiter(reaction%nkinmnrl))
1697) reaction%kinmnrl_rate_limiter = 0.d0
1698) allocate(reaction%kinmnrl_irreversible(reaction%nkinmnrl))
1699) reaction%kinmnrl_irreversible = 0
1700) allocate(reaction%kinmnrl_rate_constant(reaction%nkinmnrl))
1701) reaction%kinmnrl_rate_constant = 0.d0
1702) allocate(reaction%kinmnrl_activation_energy(reaction%nkinmnrl))
1703) reaction%kinmnrl_activation_energy = 0.d0
1704) allocate(reaction%kinmnrl_molar_vol(reaction%nkinmnrl))
1705) reaction%kinmnrl_molar_vol = 0.d0
1706) allocate(reaction%kinmnrl_molar_wt(reaction%nkinmnrl))
1707) reaction%kinmnrl_molar_wt = 0.d0
1708)
1709) allocate(reaction%kinmnrl_num_prefactors(reaction%nkinmnrl))
1710) reaction%kinmnrl_num_prefactors = 0
1711) if (max_num_prefactors > 0) then
1712) allocate(reaction%kinmnrl_pref_rate(max_num_prefactors,reaction%nkinmnrl))
1713) reaction%kinmnrl_pref_rate = 0.d0
1714) allocate(reaction%kinmnrl_pref_activation_energy(max_num_prefactors, &
1715) reaction%nkinmnrl))
1716) reaction%kinmnrl_pref_activation_energy = 0.d0
1717) allocate(reaction%kinmnrl_prefactor_id(0:max_num_prefactor_species, &
1718) max_num_prefactors,reaction%nkinmnrl))
1719) reaction%kinmnrl_prefactor_id = 0
1720) allocate(reaction%kinmnrl_pref_alpha(max_num_prefactor_species, &
1721) max_num_prefactors,reaction%nkinmnrl))
1722) reaction%kinmnrl_pref_alpha = 0.d0
1723) allocate(reaction%kinmnrl_pref_beta(max_num_prefactor_species, &
1724) max_num_prefactors,reaction%nkinmnrl))
1725) reaction%kinmnrl_pref_beta = 0.d0
1726) allocate(reaction%kinmnrl_pref_atten_coef(max_num_prefactor_species, &
1727) max_num_prefactors,reaction%nkinmnrl))
1728) reaction%kinmnrl_pref_atten_coef = 0.d0
1729) endif
1730) endif
1731)
1732) cur_mineral => reaction%mineral_list
1733) imnrl = 1
1734) ikinmnrl = 1
1735) do
1736) if (.not.associated(cur_mineral)) exit
1737)
1738) reaction%mineral_names(imnrl) = cur_mineral%name
1739) ispec = 0
1740) do i = 1, cur_mineral%dbaserxn%nspec
1741) if (cur_mineral%dbaserxn%spec_ids(i) /= h2o_id) then
1742) ispec = ispec + 1
1743) spec_id = cur_mineral%dbaserxn%spec_ids(i)
1744) if (spec_id > h2o_id) spec_id = spec_id - 1
1745) reaction%mnrlspecid(ispec,imnrl) = spec_id
1746) reaction%mnrlstoich(ispec,imnrl) = &
1747) cur_mineral%dbaserxn%stoich(i)
1748)
1749) else ! fill in h2o id and stoich
1750) reaction%mnrlh2oid(imnrl) = h2o_id
1751) reaction%mnrlh2ostoich(imnrl) = &
1752) cur_mineral%dbaserxn%stoich(i)
1753) endif
1754) enddo
1755) reaction%mnrlspecid(0,imnrl) = ispec
1756)
1757) call ReactionInitializeLogK_hpt(reaction%mnrl_logKcoef(:,imnrl), &
1758) reaction%mnrl_logK(imnrl), &
1759) option,reaction)
1760)
1761) ! geh - for now, the user must specify they want each individual
1762) ! mineral printed for non-kinetic reactions (e.g. for SI).
1763) reaction%mnrl_print(imnrl) = cur_mineral%print_me
1764) if (cur_mineral%itype == MINERAL_KINETIC) then
1765) reaction%kinmnrl_names(ikinmnrl) = reaction%mineral_names(imnrl)
1766) reaction%kinmnrl_print(ikinmnrl) = cur_mineral%print_me .or. &
1767) reaction%mineral%print_all
1768) reaction%kinmnrlspecid(:,ikinmnrl) = reaction%mnrlspecid(:,imnrl)
1769) reaction%kinmnrlstoich(:,ikinmnrl) = reaction%mnrlstoich(:,imnrl)
1770) reaction%kinmnrlh2oid(ikinmnrl) = reaction%mnrlh2oid(imnrl)
1771) reaction%kinmnrlh2ostoich(ikinmnrl) = reaction%mnrlh2ostoich(imnrl)
1772)
1773) call ReactionInitializeLogK_hpt(reaction%kinmnrl_logKcoef(:,ikinmnrl), &
1774) reaction%kinmnrl_logK(ikinmnrl), &
1775) option,reaction)
1776)
1777) tstrxn => cur_mineral%tstrxn
1778) if (associated(tstrxn)) then
1779) ! loop over transition state theory reactions/prefactors
1780) cur_prefactor => cur_mineral%tstrxn%prefactor
1781) i = 0
1782) do
1783) if (.not.associated(cur_prefactor)) exit
1784) ! ith prefactor
1785) i = i + 1
1786)
1787) reaction%kinmnrl_pref_rate(i,ikinmnrl) = cur_prefactor%rate
1788) reaction%kinmnrl_pref_activation_energy(i,ikinmnrl) = &
1789) cur_prefactor%activation_energy
1790)
1791) cur_prefactor_species => cur_prefactor%species
1792) j = 0
1793) do
1794) if (.not.associated(cur_prefactor_species)) exit
1795) ! jth prefactor species
1796) j = j + 1
1797) ! find the prefactor species
1798) do ispec = 1, reaction%naqcomp
1799) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
1800) cur_prefactor_species%name)) then
1801) cur_prefactor_species%id = ispec
1802) exit
1803) endif
1804) enddo
1805) if (cur_prefactor_species%id == 0) then ! not found
1806) ! negative prefactor_species_id denotes a secondary species
1807) do ispec = 1, reaction%neqcplx
1808) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
1809) cur_prefactor_species%name)) then
1810) cur_prefactor_species%id = -ispec
1811) exit
1812) endif
1813) enddo
1814) endif
1815) if (cur_prefactor_species%id == 0) then
1816) option%io_buffer = 'Kinetic mineral prefactor species "' // &
1817) trim(cur_prefactor_species%name) // &
1818) '" not found among primary or secondary species.'
1819) call printErrMsg(option)
1820) endif
1821) reaction%kinmnrl_prefactor_id(j,i,ikinmnrl) = cur_prefactor_species%id
1822) reaction%kinmnrl_pref_alpha(j,i,ikinmnrl) = cur_prefactor_species%alpha
1823) reaction%kinmnrl_pref_beta(j,i,ikinmnrl) = cur_prefactor_species%beta
1824) reaction%kinmnrl_pref_atten_coef(j,i,ikinmnrl) = &
1825) cur_prefactor_species%attenuation_coef
1826) cur_prefactor_species => cur_prefactor_species%next
1827) enddo
1828) ! store the number of species
1829) reaction%kinmnrl_prefactor_id(0,i,ikinmnrl) = j
1830) cur_prefactor => cur_prefactor%next
1831) enddo
1832) reaction%kinmnrl_num_prefactors(ikinmnrl) = i
1833)
1834) reaction%kinmnrl_affinity_threshold(ikinmnrl) = &
1835) tstrxn%affinity_threshold
1836) reaction%kinmnrl_rate_limiter(ikinmnrl) = tstrxn%rate_limiter
1837) reaction%kinmnrl_irreversible(ikinmnrl) = tstrxn%irreversible
1838) if (reaction%kinmnrl_num_prefactors(ikinmnrl) == 0) then
1839) ! no prefactors, rates stored in upper level
1840) reaction%kinmnrl_rate_constant(ikinmnrl) = tstrxn%rate
1841) reaction%kinmnrl_activation_energy(ikinmnrl) = &
1842) tstrxn%activation_energy
1843) endif
1844) endif ! associated(tstrxn)
1845)
1846) reaction%kinmnrl_molar_vol(ikinmnrl) = cur_mineral%molar_volume
1847) reaction%kinmnrl_molar_wt(ikinmnrl) = cur_mineral%molar_weight
1848) ikinmnrl = ikinmnrl + 1
1849) endif
1850)
1851) cur_mineral => cur_mineral%next
1852) imnrl = imnrl + 1
1853) enddo
1854) endif
1855)
1856) ! colloids
1857) reaction%ncoll = GetColloidCount(reaction)
1858)
1859) if (reaction%ncoll > 0) then
1860) allocate(reaction%colloid_names(reaction%ncoll))
1861) allocate(reaction%colloid_mobile_fraction(reaction%ncoll))
1862) allocate(reaction%colloid_print(reaction%ncoll))
1863) reaction%colloid_names = ''
1864) reaction%colloid_mobile_fraction = 0.d0
1865) reaction%colloid_print = PETSC_FALSE
1866)
1867) cur_colloid => reaction%colloid_list
1868) icoll = 1
1869) do
1870) if (.not.associated(cur_colloid)) exit
1871)
1872) reaction%colloid_names(icoll) = cur_colloid%name
1873) reaction%colloid_mobile_fraction(icoll) = cur_colloid%mobile_fraction
1874) reaction%colloid_print(icoll) = cur_colloid%print_me .or. &
1875) reaction%print_all_species
1876) cur_colloid => cur_colloid%next
1877) icoll = icoll + 1
1878) enddo
1879) endif
1880)
1881) ! use flags to determine whether a primary aqueous species is included
1882) ! in the list of colloid species
1883) allocate(flags(reaction%naqcomp))
1884) flags = PETSC_FALSE
1885)
1886) if (reaction%neqsrfcplx > 0) then
1887)
1888) ! determine max # complexes for a given site
1889) icount = 0
1890) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
1891) do
1892) if (.not.associated(cur_srfcplx_rxn)) exit
1893) if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_EQUILIBRIUM .or. &
1894) cur_srfcplx_rxn%itype == SRFCMPLX_RXN_MULTIRATE_KINETIC) then
1895) isrfcplx = 0
1896) cur_srfcplx => cur_srfcplx_rxn%complex_list
1897) do
1898) if (.not.associated(cur_srfcplx)) exit
1899) isrfcplx = isrfcplx + 1
1900) cur_srfcplx => cur_srfcplx%next
1901) enddo
1902) if (isrfcplx > icount) icount = isrfcplx
1903) endif
1904) cur_srfcplx_rxn => cur_srfcplx_rxn%next
1905) enddo
1906) nullify(cur_srfcplx_rxn)
1907)
1908) allocate(reaction%eqsrfcplx_rxn_to_surf(reaction%neqsrfcplxrxn))
1909) reaction%eqsrfcplx_rxn_to_surf = 0
1910)
1911) allocate(reaction%eqsrfcplx_rxn_surf_type(reaction%neqsrfcplxrxn))
1912) reaction%eqsrfcplx_rxn_surf_type = 0
1913)
1914) allocate(reaction%srfcplxrxn_to_complex(0:icount, &
1915) reaction%neqsrfcplxrxn))
1916) reaction%srfcplxrxn_to_complex = 0
1917)
1918) allocate(reaction%eqsrfcplx_site_names(reaction%neqsrfcplxrxn))
1919) reaction%eqsrfcplx_site_names = ''
1920)
1921) allocate(reaction%eqsrfcplx_site_print(reaction%neqsrfcplxrxn))
1922) reaction%eqsrfcplx_site_print = PETSC_FALSE
1923)
1924) allocate(reaction%eqsrfcplx_site_density_print(reaction%neqsrfcplxrxn))
1925) reaction%eqsrfcplx_site_density_print = PETSC_FALSE
1926)
1927) allocate(reaction%eqsrfcplx_rxn_site_density(reaction%neqsrfcplxrxn))
1928) reaction%eqsrfcplx_rxn_site_density = 0.d0
1929)
1930) allocate(reaction%eqsrfcplx_rxn_stoich_flag(reaction%neqsrfcplxrxn))
1931) reaction%eqsrfcplx_rxn_stoich_flag = PETSC_FALSE
1932)
1933) allocate(reaction%eqsrfcplx_names(reaction%neqsrfcplx))
1934) reaction%eqsrfcplx_names = ''
1935)
1936) allocate(reaction%eqsrfcplx_print(reaction%neqsrfcplx))
1937) reaction%eqsrfcplx_print = PETSC_FALSE
1938)
1939) allocate(reaction%srfcplxspecid(0:reaction%naqcomp,reaction%neqsrfcplx))
1940) reaction%srfcplxspecid = 0
1941)
1942) allocate(reaction%eqsrfcplxstoich(reaction%naqcomp,reaction%neqsrfcplx))
1943) reaction%eqsrfcplxstoich = 0.d0
1944)
1945) allocate(reaction%eqsrfcplxh2oid(reaction%neqsrfcplx))
1946) reaction%eqsrfcplxh2oid = 0
1947)
1948) allocate(reaction%eqsrfcplxh2ostoich(reaction%neqsrfcplx))
1949) reaction%eqsrfcplxh2ostoich = 0.d0
1950)
1951) allocate(reaction%eqsrfcplx_free_site_id(reaction%neqsrfcplx))
1952) reaction%eqsrfcplx_free_site_id = 0
1953)
1954) allocate(reaction%eqsrfcplx_free_site_stoich(reaction%neqsrfcplx))
1955) reaction%eqsrfcplx_free_site_stoich = 0.d0
1956)
1957) ! allocate(reaction%eqsrfcplx_mineral_id(reaction%neqsrfcplx))
1958) ! reaction%eqsrfcplx_mineral_id = 0
1959)
1960) allocate(reaction%eqsrfcplx_logK(reaction%neqsrfcplx))
1961) reaction%eqsrfcplx_logK = 0.d0
1962)
1963) allocate(reaction%eqsrfcplx_logKcoef(reaction%num_dbase_parameters, &
1964) reaction%neqsrfcplx))
1965) reaction%eqsrfcplx_logKcoef = 0.d0
1966)
1967) allocate(reaction%eqsrfcplx_Z(reaction%neqsrfcplx))
1968) reaction%eqsrfcplx_Z = 0.d0
1969)
1970) isrfcplx = 0
1971) irxn = 0
1972) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
1973) do
1974) if (.not.associated(cur_srfcplx_rxn)) exit
1975)
1976) if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_EQUILIBRIUM .or. &
1977) cur_srfcplx_rxn%itype == SRFCMPLX_RXN_MULTIRATE_KINETIC) then
1978)
1979) irxn = irxn + 1
1980) reaction%eqsrfcplx_site_names(irxn) = cur_srfcplx_rxn%free_site_name
1981) reaction%eqsrfcplx_site_print(irxn) = cur_srfcplx_rxn%free_site_print_me .or. &
1982) reaction%print_all_species
1983) reaction%eqsrfcplx_site_density_print(irxn) = &
1984) cur_srfcplx_rxn%site_density_print_me .or. &
1985) reaction%print_all_species
1986) surface_complexation%srfcplxrxn_surf_type(irxn) = &
1987) cur_srfcplx_rxn%surface_itype
1988) select case(cur_srfcplx_rxn%surface_itype)
1989) case(ROCK_SURFACE)
1990) ! nothing to do here as the linkage to rick density is already set
1991) case(MINERAL_SURFACE)
1992) surface_complexation%srfcplxrxn_to_surf(irxn) = &
1993) GetKineticMineralIDFromName(reaction%mineral, &
1994) cur_srfcplx_rxn%surface_name)
1995) if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
1996) option%io_buffer = 'Mineral ' // &
1997) trim(cur_srfcplx_rxn%surface_name) // &
1998) ' listed in surface complexation ' // &
1999) 'reaction not found in kinetic mineral list'
2000) call printErrMsg(option)
2001) endif
2002) case(COLLOID_SURFACE)
2003) surface_complexation%srfcplxrxn_to_surf(irxn) = &
2004) GetColloidIDFromName(reaction,cur_srfcplx_rxn%surface_name)
2005) if (surface_complexation%srfcplxrxn_to_surf(irxn) < 0) then
2006) option%io_buffer = 'Colloid ' // &
2007) trim(cur_srfcplx_rxn%surface_name) // &
2008) ' listed in surface complexation ' // &
2009) 'reaction not found in colloid list'
2010) call printErrMsg(option)
2011) endif
2012) ! loop over primary species associated with colloid sorption and
2013) ! add to colloid species list, if not already listed
2014) cur_srfcplx_in_rxn => cur_srfcplx_rxn%complex_list
2015) do
2016) if (.not.associated(cur_srfcplx_in_rxn)) exit
2017) ! cur_srfcplx2%ptr is a pointer to complex in master list
2018) cur_srfcplx => cur_srfcplx_in_rxn%ptr
2019) do i = 1, cur_srfcplx%dbaserxn%nspec
2020) if (cur_srfcplx%dbaserxn%spec_ids(i) == h2o_id) cycle
2021) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2022) if (spec_id > h2o_id) spec_id = spec_id - 1
2023) colloid_species_flag(spec_id) = PETSC_TRUE
2024) enddo
2025) nullify(cur_srfcplx)
2026) cur_srfcplx_in_rxn => cur_srfcplx_in_rxn%next
2027) enddo
2028) case(NULL_SURFACE)
2029) write(word,*) cur_srfcplx_rxn%id
2030) option%io_buffer = 'No mineral or colloid name specified ' // &
2031) 'for equilibrium surface complexation reaction:' // &
2032) trim(adjustl(word))
2033) call printWrnMsg(option)
2034) end select
2035) reaction%eqsrfcplx_rxn_site_density(irxn) = cur_srfcplx_rxn%site_density
2036)
2037) cur_srfcplx => cur_srfcplx_rxn%complex_list
2038) do
2039) if (.not.associated(cur_srfcplx)) exit
2040)
2041) isrfcplx = isrfcplx + 1
2042)
2043) ! set up integer pointers from site to complexes
2044) ! increment count for site
2045) reaction%srfcplxrxn_to_complex(0,irxn) = &
2046) reaction%srfcplxrxn_to_complex(0,irxn) + 1
2047) reaction%srfcplxrxn_to_complex( &
2048) reaction%srfcplxrxn_to_complex(0,irxn),irxn) = isrfcplx
2049)
2050) reaction%eqsrfcplx_names(isrfcplx) = cur_srfcplx%name
2051) reaction%eqsrfcplx_print(isrfcplx) = cur_srfcplx%print_me .or. &
2052) reaction%print_all_species
2053) reaction%eqsrfcplx_free_site_id(isrfcplx) = &
2054) cur_srfcplx_rxn%free_site_id
2055) reaction%eqsrfcplx_free_site_stoich(isrfcplx) = &
2056) cur_srfcplx%free_site_stoich
2057)
2058) if (cur_srfcplx%free_site_stoich > 1.d0) then
2059) reaction%eqsrfcplx_rxn_stoich_flag(irxn) = PETSC_TRUE
2060) endif
2061)
2062) ispec = 0
2063) do i = 1, cur_srfcplx%dbaserxn%nspec
2064) if (cur_srfcplx%dbaserxn%spec_ids(i) /= h2o_id) then
2065) ispec = ispec + 1
2066) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2067) if (spec_id > h2o_id) spec_id = spec_id - 1
2068) reaction%srfcplxspecid(ispec,isrfcplx) = spec_id
2069) reaction%eqsrfcplxstoich(ispec,isrfcplx) = &
2070) cur_srfcplx%dbaserxn%stoich(i)
2071)
2072) else ! fill in h2o id and stoich
2073) reaction%eqsrfcplxh2oid(isrfcplx) = h2o_id
2074) reaction%eqsrfcplxh2ostoich(isrfcplx) = &
2075) cur_srfcplx%dbaserxn%stoich(i)
2076) endif
2077) enddo
2078) reaction%srfcplxspecid(0,isrfcplx) = ispec
2079) call ReactionInitializeLogK_hpt(reaction%eqsrfcplx_logKcoef(:,isrfcplx), &
2080) reaction%eqsrfcplx_logK(isrfcplx), &
2081) option,reaction)
2082)
2083) reaction%eqsrfcplx_Z(isrfcplx) = cur_srfcplx%Z
2084)
2085) cur_srfcplx => cur_srfcplx%next
2086) enddo
2087) nullify(cur_srfcplx)
2088)
2089) endif
2090) cur_srfcplx_rxn => cur_srfcplx_rxn%next
2091) enddo
2092) nullify(cur_srfcplx_rxn)
2093)
2094) endif
2095)
2096) if (reaction%nkinsrfcplxrxn > 0) then
2097)
2098) ! determine max # complexes for a given site
2099) icount = 0
2100) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
2101) do
2102) if (.not.associated(cur_srfcplx_rxn)) exit
2103) if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_KINETIC) then
2104) isrfcplx = 0
2105) cur_srfcplx => cur_srfcplx_rxn%complex_list
2106) do
2107) if (.not.associated(cur_srfcplx)) exit
2108) isrfcplx = isrfcplx + 1
2109) cur_srfcplx => cur_srfcplx%next
2110) enddo
2111) if (isrfcplx > icount) icount = isrfcplx
2112) endif
2113) cur_srfcplx_rxn => cur_srfcplx_rxn%next
2114) enddo
2115) nullify(cur_srfcplx_rxn)
2116) allocate(reaction%kinsrfcplx_rxn_to_complex(0:icount, &
2117) reaction%nkinsrfcplxrxn))
2118) reaction%kinsrfcplx_rxn_to_complex = 0
2119)
2120) allocate(reaction%kinsrfcplx_rxn_to_site(reaction%nkinsrfcplxrxn))
2121) reaction%kinsrfcplx_rxn_to_site = 0
2122)
2123) allocate(reaction%kinsrfcplx_rxn_to_surf(reaction%nkinsrfcplxrxn))
2124) reaction%kinsrfcplx_rxn_to_surf = 0
2125)
2126) allocate(reaction%kinsrfcplx_rxn_surf_type(reaction%nkinsrfcplxrxn))
2127) reaction%kinsrfcplx_rxn_surf_type = 0
2128)
2129) allocate(reaction%kinsrfcplx_site_names(reaction%nkinsrfcplxrxn))
2130) reaction%kinsrfcplx_site_names = ''
2131)
2132) allocate(reaction%kinsrfcplx_site_print(reaction%nkinsrfcplxrxn))
2133) reaction%kinsrfcplx_site_print = PETSC_FALSE
2134)
2135) allocate(reaction%kinsrfcplx_rxn_site_density(reaction%nkinsrfcplxrxn))
2136) reaction%kinsrfcplx_rxn_site_density = 0.d0
2137)
2138) allocate(reaction%kinsrfcplx_rxn_stoich_flag(reaction%nkinsrfcplxrxn))
2139) reaction%kinsrfcplx_rxn_stoich_flag = PETSC_FALSE
2140)
2141) allocate(reaction%kinsrfcplx_names(reaction%nkinsrfcplx))
2142) reaction%kinsrfcplx_names = ''
2143)
2144) allocate(reaction%kinsrfcplx_print(reaction%nkinsrfcplx))
2145) reaction%kinsrfcplx_print = PETSC_FALSE
2146)
2147) allocate(reaction%kinsrfcplxspecid(0:reaction%naqcomp,reaction%nkinsrfcplx))
2148) reaction%kinsrfcplxspecid = 0
2149)
2150) allocate(reaction%kinsrfcplxstoich(reaction%naqcomp,reaction%nkinsrfcplx))
2151) reaction%kinsrfcplxstoich = 0.d0
2152)
2153) allocate(reaction%kinsrfcplxh2oid(reaction%nkinsrfcplx))
2154) reaction%kinsrfcplxh2oid = 0
2155)
2156) allocate(reaction%kinsrfcplxh2ostoich(reaction%nkinsrfcplx))
2157) reaction%kinsrfcplxh2ostoich = 0.d0
2158)
2159) allocate(reaction%kinsrfcplx_free_site_id(reaction%nkinsrfcplx))
2160) reaction%kinsrfcplx_free_site_id = 0
2161)
2162) allocate(reaction%kinsrfcplx_free_site_stoich(reaction%nkinsrfcplx))
2163) reaction%kinsrfcplx_free_site_stoich = 0.d0
2164)
2165) allocate(reaction%kinsrfcplx_forward_rate(reaction%nkinsrfcplx))
2166) reaction%kinsrfcplx_forward_rate = 0.d0
2167)
2168) allocate(reaction%kinsrfcplx_backward_rate(reaction%nkinsrfcplx))
2169) reaction%kinsrfcplx_backward_rate = 0.d0
2170)
2171) ! allocate(reaction%kinsrfcplx_logK(reaction%nkinsrfcplx))
2172) ! reaction%kinsrfcplx_logK = 0.d0
2173) !#if TEMP_DEPENDENT_LOGK
2174) ! allocate(reaction%kinsrfcplx_logKcoef(FIVE_INTEGER,reaction%nkinsrfcplx))
2175) ! reaction%kinsrfcplx_logKcoef = 0.d0
2176) !#else
2177) ! allocate(reaction%kinsrfcplx_logKcoef(reaction%num_dbase_temperatures, &
2178) ! reaction%nkinsrfcplx))
2179) ! reaction%kinsrfcplx_logKcoef = 0.d0
2180) !#endif
2181) allocate(reaction%kinsrfcplx_Z(reaction%nkinsrfcplx))
2182) reaction%kinsrfcplx_Z = 0.d0
2183)
2184) isrfcplx = 0
2185) irxn = 0
2186) cur_srfcplx_rxn => reaction%surface_complexation_rxn_list
2187) do
2188) if (.not.associated(cur_srfcplx_rxn)) exit
2189)
2190) if (cur_srfcplx_rxn%itype == SRFCMPLX_RXN_KINETIC) then
2191)
2192) irxn = irxn + 1
2193)
2194) reaction%kinsrfcplx_site_names(irxn) = cur_srfcplx_rxn%free_site_name
2195) reaction%kinsrfcplx_site_print(irxn) = cur_srfcplx_rxn%free_site_print_me .or. &
2196) reaction%print_all_species
2197) if (len_trim(cur_srfcplx_rxn%mineral_name) > 1) then
2198) reaction%kinsrfcplx_rxn_surf_type(irxn) = MINERAL_SURFACE
2199) reaction%kinsrfcplx_rxn_to_surf(irxn) = &
2200) GetKineticMineralIDFromName(reaction,cur_srfcplx_rxn%mineral_name)
2201) if (reaction%kinsrfcplx_rxn_to_surf(irxn) < 0) then
2202) option%io_buffer = 'Mineral ' // trim(cur_srfcplx_rxn%mineral_name) // &
2203) 'listed in kinetic surface complexation ' // &
2204) 'reaction not found in mineral list'
2205) call printErrMsg(option)
2206) endif
2207) else if (len_trim(cur_srfcplx_rxn%colloid_name) > 1) then
2208) reaction%kinsrfcplx_rxn_surf_type(irxn) = COLLOID_SURFACE
2209) reaction%kinsrfcplx_rxn_to_surf(irxn) = &
2210) GetColloidIDFromName(reaction,cur_srfcplx_rxn%colloid_name)
2211) if (reaction%kinsrfcplx_rxn_to_surf(irxn) < 0) then
2212) option%io_buffer = 'Colloid ' // trim(cur_srfcplx_rxn%colloid_name) // &
2213) 'listed in kinetic surface complexation ' // &
2214) 'reaction not found in colloid list'
2215) call printErrMsg(option)
2216) endif
2217) ! loop over primary species associated with colloid sorption and
2218) ! add to colloid species list, if not already listed
2219) cur_srfcplx => cur_srfcplx_rxn%complex_list
2220) do
2221) if (.not.associated(cur_srfcplx)) exit
2222) do i = 1, cur_srfcplx%dbaserxn%nspec
2223) if (cur_srfcplx%dbaserxn%spec_ids(i) == h2o_id) cycle
2224) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2225) if (spec_id > h2o_id) spec_id = spec_id - 1
2226) flags(spec_id) = PETSC_TRUE
2227) enddo
2228) cur_srfcplx => cur_srfcplx%next
2229) enddo
2230)
2231) else
2232) write(word,*) cur_srfcplx_rxn%id
2233) write(word,*) cur_srfcplx_rxn%id
2234) option%io_buffer = 'No mineral or colloid name specified for ' // &
2235) 'kinetic surface complexation reaction:' // &
2236) trim(adjustl(word))
2237) call printWrnMsg(option)
2238) reaction%kinsrfcplx_rxn_surf_type(irxn) = NULL_SURFACE
2239) endif
2240) reaction%kinsrfcplx_rxn_site_density(irxn) = cur_srfcplx_rxn%site_density
2241)
2242) cur_srfcplx => cur_srfcplx_rxn%complex_list
2243) do
2244) if (.not.associated(cur_srfcplx)) exit
2245)
2246) isrfcplx = isrfcplx + 1
2247)
2248) reaction%kinsrfcplx_forward_rate(isrfcplx) = cur_srfcplx%forward_rate
2249) if (Uninitialized(cur_srfcplx%backward_rate)) then
2250) ! backward rate will be calculated based on Kb = Kf * Keq
2251) call Interpolate(temp_high,temp_low,option%reference_temperature, &
2252) cur_srfcplx%dbaserxn%logK(itemp_high), &
2253) cur_srfcplx%dbaserxn%logK(itemp_low), &
2254) value)
2255) reaction%kinsrfcplx_backward_rate(isrfcplx) = 10.d0**value * &
2256) cur_srfcplx%forward_rate
2257) else
2258) reaction%kinsrfcplx_backward_rate(isrfcplx) = cur_srfcplx%backward_rate
2259) endif
2260) ! set up integer pointers from site to complexes
2261) ! increment count for site
2262) reaction%kinsrfcplx_rxn_to_complex(0,irxn) = &
2263) reaction%kinsrfcplx_rxn_to_complex(0,irxn) + 1
2264) reaction%kinsrfcplx_rxn_to_complex( &
2265) reaction%kinsrfcplx_rxn_to_complex(0,irxn),irxn) = isrfcplx
2266) reaction%kinsrfcplx_rxn_to_site(irxn) = cur_srfcplx_rxn%free_site_id
2267)
2268)
2269) reaction%kinsrfcplx_names(isrfcplx) = cur_srfcplx%name
2270) reaction%kinsrfcplx_print(isrfcplx) = cur_srfcplx%print_me .or. &
2271) reaction%print_all_species
2272) reaction%kinsrfcplx_free_site_stoich(isrfcplx) = &
2273) cur_srfcplx%free_site_stoich
2274)
2275) if (cur_srfcplx%free_site_stoich > 1.d0) then
2276) reaction%kinsrfcplx_rxn_stoich_flag(irxn) = PETSC_TRUE
2277) endif
2278)
2279) ispec = 0
2280) do i = 1, cur_srfcplx%dbaserxn%nspec
2281) if (cur_srfcplx%dbaserxn%spec_ids(i) /= h2o_id) then
2282) ispec = ispec + 1
2283) spec_id = cur_srfcplx%dbaserxn%spec_ids(i)
2284) if (spec_id > h2o_id) spec_id = spec_id - 1
2285) reaction%kinsrfcplxspecid(ispec,isrfcplx) = spec_id
2286) reaction%kinsrfcplxstoich(ispec,isrfcplx) = &
2287) cur_srfcplx%dbaserxn%stoich(i)
2288) else ! fill in h2o id and stoich
2289) reaction%kinsrfcplxh2oid(isrfcplx) = h2o_id
2290) reaction%kinsrfcplxh2ostoich(isrfcplx) = &
2291) cur_srfcplx%dbaserxn%stoich(i)
2292) endif
2293) enddo
2294) reaction%kinsrfcplxspecid(0,isrfcplx) = ispec
2295) ! Chuan added, for surface complex reaction, the new data base
2296) cur_srfcplx%dbaserxn%logK(:) = cur_srfcplx%dbaserxn%logKCoeff_hpt(:)
2297) ! #if TEMP_DEPENDENT_LOGK
2298) ! call ReactionFitLogKCoef(reaction%kinsrfcplx_logKcoef(:,isrfcplx),cur_srfcplx%dbaserxn%logK, &
2299) ! reaction%kinsrfcplx_names(isrfcplx), &
2300) ! option,reaction)
2301) ! call ReactionInitializeLogK(reaction%kinsrfcplx_logKcoef(:,isrfcplx), &
2302) ! cur_srfcplx%dbaserxn%logK, &
2303) ! reaction%kinsrfcplx_logK(isrfcplx), &
2304) ! option,reaction)
2305) ! #else
2306) ! call Interpolate(temp_high,temp_low,option%reference_temperature, &
2307) ! cur_srfcplx%dbaserxn%logK(itemp_high), &
2308) ! cur_srfcplx%dbaserxn%logK(itemp_low), &
2309) ! reaction%kinsrfcplx_logK(isrfcplx))
2310) ! !reaction%kinsrfcplx_logK(isrfcplx) = cur_srfcplx%dbaserxn%logK(option%itemp_ref)
2311) ! #endif
2312) reaction%kinsrfcplx_Z(isrfcplx) = cur_srfcplx%Z
2313)
2314) cur_srfcplx => cur_srfcplx%next
2315) enddo
2316) nullify(cur_srfcplx)
2317)
2318) endif
2319)
2320) cur_srfcplx_rxn => cur_srfcplx_rxn%next
2321) enddo
2322) nullify(cur_srfcplx_rxn)
2323)
2324) endif
2325)
2326)
2327) ! allocate colloids species names, mappings, etc.
2328) reaction%ncollcomp = 0
2329) icount = 0
2330) do i = 1, reaction%naqcomp
2331) if (flags(i)) then
2332) icount = icount + 1
2333) endif
2334) enddo
2335) if (icount > 0) then
2336) allocate(reaction%pri_spec_to_coll_spec(reaction%naqcomp))
2337) allocate(reaction%colloid_species_names(icount))
2338) allocate(reaction%coll_spec_to_pri_spec(icount))
2339) reaction%pri_spec_to_coll_spec = UNINITIALIZED_INTEGER
2340) reaction%coll_spec_to_pri_spec = UNINITIALIZED_INTEGER
2341) reaction%colloid_species_names = ''
2342) reaction%ncollcomp = icount
2343) icount = 0
2344) do i = 1, reaction%naqcomp
2345) if (flags(i)) then
2346) icount = icount + 1
2347) reaction%colloid_species_names(icount) = &
2348) trim(reaction%primary_species_names(i))
2349) reaction%coll_spec_to_pri_spec(icount) = i
2350) reaction%pri_spec_to_coll_spec(i) = icount
2351) endif
2352) enddo
2353) if (minval(reaction%coll_spec_to_pri_spec) < 1) then
2354) option%io_buffer = 'Species colloid surface complexation reaction not' // &
2355) ' recognized among primary species'
2356) call printErrMsg(option)
2357) endif
2358) allocate(reaction%total_sorb_mobile_print(reaction%ncollcomp))
2359) reaction%total_sorb_mobile_print = PETSC_FALSE
2360) do i = 1, reaction%ncollcomp
2361) reaction%total_sorb_mobile_print(i) = &
2362) (reaction%primary_species_print(reaction%coll_spec_to_pri_spec(i)) .or. &
2363) reaction%print_all_species) .and. &
2364) reaction%print_total_sorb_mobile
2365) enddo
2366) endif
2367) deallocate(flags)
2368)
2369) if (reaction%neqionxrxn > 0) then
2370)
2371) ! determine max # cations for a given ionx exchange rxn
2372) icount = 0
2373) cur_ionx_rxn => reaction%ion_exchange_rxn_list
2374) do
2375) if (.not.associated(cur_ionx_rxn)) exit
2376) ication = 0
2377) cur_cation => cur_ionx_rxn%cation_list
2378) do
2379) if (.not.associated(cur_cation)) exit
2380) ication = ication + 1
2381) cur_cation => cur_cation%next
2382) enddo
2383) if (ication > icount) icount = ication
2384) cur_ionx_rxn => cur_ionx_rxn%next
2385) enddo
2386) nullify(cur_ionx_rxn)
2387)
2388) allocate(reaction%eqionx_rxn_cationid(0:icount,reaction%neqionxrxn))
2389) reaction%eqionx_rxn_cationid = 0
2390) allocate(reaction%eqionx_rxn_Z_flag(reaction%neqionxrxn))
2391) reaction%eqionx_rxn_Z_flag = PETSC_FALSE
2392) allocate(reaction%eqionx_rxn_cation_X_offset(reaction%neqionxrxn))
2393) reaction%eqionx_rxn_cation_X_offset = 0
2394) allocate(reaction%eqionx_rxn_CEC(reaction%neqionxrxn))
2395) reaction%eqionx_rxn_CEC = 0.d0
2396) allocate(reaction%eqionx_rxn_k(icount,reaction%neqionxrxn))
2397) reaction%eqionx_rxn_k = 0.d0
2398)
2399) irxn = 0
2400) icount = 0
2401) cur_ionx_rxn => reaction%ion_exchange_rxn_list
2402) do
2403) if (.not.associated(cur_ionx_rxn)) exit
2404) irxn = irxn + 1
2405) ication = 0
2406) reaction%eqionx_rxn_CEC(irxn) = cur_ionx_rxn%CEC
2407) ! compute the offset to the first cation in rxn
2408) reaction%eqionx_rxn_cation_X_offset(irxn) = icount
2409)
2410) cur_cation => cur_ionx_rxn%cation_list
2411) do
2412) if (.not.associated(cur_cation)) exit
2413) ication = ication + 1
2414) icount = icount + 1
2415) reaction%eqionx_rxn_k(ication,irxn) = cur_cation%k
2416)
2417) found = PETSC_FALSE
2418) do i = 1, reaction%naqcomp
2419) if (StringCompare(cur_cation%name, &
2420) reaction%primary_species_names(i), &
2421) MAXWORDLENGTH)) then
2422) reaction%eqionx_rxn_cationid(ication,irxn) = i
2423) found = PETSC_TRUE
2424) endif
2425) enddo
2426) if (.not.found) then
2427) option%io_buffer = 'Cation ' // trim(cur_cation%name) // &
2428) ' in ion exchange reaction' // &
2429) ' not found in swapped basis.'
2430) call printErrMsg(option)
2431) endif
2432) cur_cation => cur_cation%next
2433) enddo
2434) reaction%eqionx_rxn_cationid(0,irxn) = ication
2435) ! Find any Zi /= Zj for all species i, j
2436) found = PETSC_FALSE
2437) do i = 1, reaction%eqionx_rxn_cationid(0,irxn)
2438) do j = 1, reaction%eqionx_rxn_cationid(0,irxn)
2439) if (abs(reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(i,irxn))- &
2440) reaction%primary_spec_Z(reaction%eqionx_rxn_cationid(j,irxn))) > &
2441) 0.1d0) then
2442) found = PETSC_TRUE
2443) exit
2444) endif
2445) enddo
2446) if (found) exit
2447) enddo
2448) reaction%eqionx_rxn_Z_flag(irxn) = found
2449) cur_ionx_rxn => cur_ionx_rxn%next
2450) enddo
2451) nullify(cur_ionx_rxn)
2452)
2453) endif
2454)
2455) ! general reaction
2456)
2457) if (reaction%ngeneral_rxn > 0) then
2458)
2459) ! process reaction equation into the database format
2460) cur_general_rxn => reaction%general_rxn_list
2461) do
2462) if (.not.associated(cur_general_rxn)) exit
2463)
2464) ! count # species
2465) icount = 0
2466) string = cur_general_rxn%reaction
2467) do
2468) ierr = 0
2469) call InputReadWord(string,word,PETSC_TRUE,ierr)
2470) if (InputError(ierr)) exit
2471)
2472) select case(word)
2473) case('+')
2474) case('-')
2475) case('=','<=>','<->')
2476) case default
2477) ! try reading as double precision
2478) string2 = word
2479) if (.not.StringStartsWithAlpha(string2)) then
2480) ! the word is the stoichiometry value
2481) else
2482) ! the word is the species name
2483) icount = icount + 1
2484) endif
2485) end select
2486)
2487) enddo
2488)
2489) ! load species into database format
2490)
2491) cur_general_rxn%dbaserxn => DatabaseRxnCreate()
2492)
2493) dbaserxn => DatabaseRxnCreate()
2494) dbaserxn%nspec = icount
2495) allocate(dbaserxn%spec_name(icount))
2496) dbaserxn%spec_name = ''
2497) allocate(dbaserxn%stoich(icount))
2498) dbaserxn%stoich = UNINITIALIZED_DOUBLE
2499) allocate(dbaserxn%spec_ids(icount))
2500) dbaserxn%spec_ids = 0
2501)
2502) string = cur_general_rxn%reaction
2503) icount = 1
2504) ! midpoint points to the first product species, as in
2505) ! reactant1 + reactant2 <-> product1 + product2
2506) midpoint = 0
2507) negative_flag = PETSC_FALSE
2508) do
2509) ierr = 0
2510) call InputReadWord(string,word,PETSC_TRUE,ierr)
2511) if (InputError(ierr)) exit
2512)
2513) select case(word)
2514) case('+')
2515) case('-')
2516) ! toggle negative flag
2517) if (negative_flag) then
2518) negative_flag = PETSC_FALSE
2519) else
2520) negative_flag = PETSC_TRUE
2521) endif
2522) case('=','<=>','<->')
2523) midpoint = icount
2524) case default
2525) ! try reading as double precision
2526) string2 = word
2527) if (.not.StringStartsWithAlpha(string2)) then
2528) ! negate if a product
2529) call InputReadDouble(string2,option,value,ierr)
2530) ! negate if negative stoichiometry
2531) if (negative_flag) value = -1.0*value
2532) dbaserxn%stoich(icount) = value
2533) else
2534) dbaserxn%spec_name(icount) = word
2535) if (negative_flag .and. &
2536) (dbaserxn%stoich(icount) + 999.d0) < 1.d-10) then
2537) dbaserxn%stoich(icount) = -1.d0
2538) endif
2539)
2540) ! set the primary species id
2541) found = PETSC_FALSE
2542) do i = 1, reaction%naqcomp
2543) if (StringCompare(word, &
2544) reaction%primary_species_names(i), &
2545) MAXWORDLENGTH)) then
2546) dbaserxn%spec_ids(icount) = i
2547) found = PETSC_TRUE
2548) exit
2549) endif
2550) enddo
2551) ! check water
2552) word2 = 'H2O'
2553) if (StringCompareIgnoreCase(word,word2)) then
2554) ! don't increment icount
2555) exit
2556) endif
2557) if (.not.found) then
2558) option%io_buffer = 'Species ' // trim(word) // &
2559) ' in general reaction' // &
2560) ' not found among primary species list.'
2561) call printErrMsg(option)
2562) endif
2563) icount = icount + 1
2564) endif
2565) negative_flag = PETSC_FALSE
2566) end select
2567)
2568) enddo
2569)
2570) ! if no stoichiometry specified, default = 1.
2571) do i = 1, dbaserxn%nspec
2572) if ((dbaserxn%stoich(i) + 999.d0) < 1.d-10) dbaserxn%stoich(i) = 1.d0
2573) enddo
2574) ! negate stoichiometries after midpoint
2575) do i = midpoint, dbaserxn%nspec
2576) dbaserxn%stoich(i) = -1.d0*dbaserxn%stoich(i)
2577) enddo
2578) ! now negate all stoichiometries to have - for reactants; + for products
2579) do i = 1, dbaserxn%nspec
2580) dbaserxn%stoich(i) = -1.d0*dbaserxn%stoich(i)
2581) enddo
2582) ! reorder species ids in ascending order
2583) do i = 1, dbaserxn%nspec
2584) do j = i+1, dbaserxn%nspec
2585) if (dbaserxn%spec_ids(i) > dbaserxn%spec_ids(j)) then
2586) ! swap ids
2587) idum = dbaserxn%spec_ids(j)
2588) dbaserxn%spec_ids(j) = dbaserxn%spec_ids(i)
2589) dbaserxn%spec_ids(i) = idum
2590) ! swap stoichiometry
2591) value = dbaserxn%stoich(j)
2592) dbaserxn%stoich(j) = dbaserxn%stoich(i)
2593) dbaserxn%stoich(i) = value
2594) ! swap names
2595) word = dbaserxn%spec_name(j)
2596) dbaserxn%spec_name(j) = dbaserxn%spec_name(i)
2597) dbaserxn%spec_name(i) = word
2598) endif
2599) enddo
2600) enddo
2601)
2602) cur_general_rxn%dbaserxn => dbaserxn
2603)
2604) cur_general_rxn => cur_general_rxn%next
2605) enddo
2606) nullify(cur_general_rxn)
2607)
2608) ! determine max # species, forward species and backward species
2609) ! for a given general rxn
2610) max_species_count = 0
2611) max_forward_count = 0
2612) max_backward_count = 0
2613) cur_general_rxn => reaction%general_rxn_list
2614) do
2615) if (.not.associated(cur_general_rxn)) exit
2616)
2617) ! zero count
2618) forward_count = 0
2619) backward_count = 0
2620)
2621) ! max species in reaction
2622) species_count = cur_general_rxn%dbaserxn%nspec
2623)
2624) ! sum forward and reverse species
2625) dbaserxn => cur_general_rxn%dbaserxn
2626) do i = 1, dbaserxn%nspec
2627) if (dbaserxn%stoich(i) < 0.d0) then
2628) forward_count = forward_count + 1
2629) else if (dbaserxn%stoich(i) > 0.d0) then
2630) backward_count = backward_count + 1
2631) endif
2632) enddo
2633)
2634) ! calculate maximum
2635) if (forward_count > max_forward_count) max_forward_count = forward_count
2636) if (backward_count > max_backward_count) max_backward_count = backward_count
2637) if (species_count > max_species_count) max_species_count = species_count
2638)
2639) cur_general_rxn => cur_general_rxn%next
2640)
2641) enddo
2642) nullify(cur_general_rxn)
2643)
2644) allocate(reaction%generalspecid(0:max_species_count,reaction%ngeneral_rxn))
2645) reaction%generalspecid = 0
2646) allocate(reaction%generalstoich(max_species_count,reaction%ngeneral_rxn))
2647) reaction%generalstoich = 0.d0
2648) allocate(reaction%generalforwardspecid(0:max_forward_count,reaction%ngeneral_rxn))
2649) reaction%generalforwardspecid = 0
2650) allocate(reaction%generalforwardstoich(max_forward_count,reaction%ngeneral_rxn))
2651) reaction%generalforwardstoich = 0.d0
2652) allocate(reaction%generalbackwardspecid(0:max_backward_count,reaction%ngeneral_rxn))
2653) reaction%generalbackwardspecid = 0
2654) allocate(reaction%generalbackwardstoich(max_backward_count,reaction%ngeneral_rxn))
2655) reaction%generalbackwardstoich = 0.d0
2656) allocate(reaction%generalh2oid(reaction%ngeneral_rxn))
2657) reaction%generalh2oid = 0
2658) allocate(reaction%generalh2ostoich(reaction%ngeneral_rxn))
2659) reaction%generalh2ostoich = 0.d0
2660) allocate(reaction%general_kf(reaction%ngeneral_rxn))
2661) reaction%general_kf = 0.d0
2662) allocate(reaction%general_kr(reaction%ngeneral_rxn))
2663) reaction%general_kr = 0.d0
2664)
2665) ! load the data into the compressed arrays
2666) irxn = 0
2667) cur_general_rxn => reaction%general_rxn_list
2668) do
2669) if (.not.associated(cur_general_rxn)) exit
2670)
2671) dbaserxn => cur_general_rxn%dbaserxn
2672)
2673) irxn = irxn + 1
2674)
2675) forward_count = 0
2676) backward_count = 0
2677) do i = 1, dbaserxn%nspec
2678) reaction%generalspecid(i,irxn) = dbaserxn%spec_ids(i)
2679) reaction%generalstoich(i,irxn) = dbaserxn%stoich(i)
2680) if (dbaserxn%stoich(i) < 0.d0) then
2681) forward_count = forward_count + 1
2682) reaction%generalforwardspecid(forward_count,irxn) = dbaserxn%spec_ids(i)
2683) ! ensure that forward stoich is positive for rate expression
2684) reaction%generalforwardstoich(forward_count,irxn) = dabs(dbaserxn%stoich(i))
2685) else if (dbaserxn%stoich(i) > 0.d0) then
2686) backward_count = backward_count + 1
2687) reaction%generalbackwardspecid(backward_count,irxn) = dbaserxn%spec_ids(i)
2688) reaction%generalbackwardstoich(backward_count,irxn) = dbaserxn%stoich(i)
2689) endif
2690) enddo
2691) reaction%generalspecid(0,irxn) = dbaserxn%nspec
2692) reaction%generalforwardspecid(0,irxn) = forward_count
2693) reaction%generalbackwardspecid(0,irxn) = backward_count
2694)
2695) reaction%general_kf(irxn) = cur_general_rxn%forward_rate
2696) reaction%general_kr(irxn) = cur_general_rxn%backward_rate
2697)
2698) cur_general_rxn => cur_general_rxn%next
2699)
2700) enddo
2701)
2702) endif
2703)
2704) ! Kd reactions
2705)
2706) if (reaction%neqkdrxn > 0) then
2707)
2708) ! allocate arrays
2709) allocate(reaction%eqkdspecid(reaction%neqkdrxn))
2710) reaction%eqkdspecid = 0
2711) allocate(reaction%eqkdtype(reaction%neqkdrxn))
2712) reaction%eqkdtype = 0
2713) allocate(reaction%eqkddistcoef(reaction%neqkdrxn))
2714) reaction%eqkddistcoef = 0.d0
2715) allocate(reaction%eqkdlangmuirb(reaction%neqkdrxn))
2716) reaction%eqkdlangmuirb = 0.d0
2717) allocate(reaction%eqkdfreundlichn(reaction%neqkdrxn))
2718) reaction%eqkdfreundlichn = 0.d0
2719)
2720) cur_kd_rxn => reaction%kd_rxn_list
2721) irxn = 0
2722) do
2723) if (.not.associated(cur_kd_rxn)) exit
2724)
2725) irxn = irxn + 1
2726)
2727) found = PETSC_FALSE
2728) do i = 1, reaction%naqcomp
2729) if (StringCompare(cur_kd_rxn%species_name, &
2730) reaction%primary_species_names(i), &
2731) MAXWORDLENGTH)) then
2732) reaction%eqkdspecid(irxn) = i
2733) found = PETSC_TRUE
2734) exit
2735) endif
2736) enddo
2737) if (.not.found) then
2738) option%io_buffer = 'Species ' // trim(word) // &
2739) ' in kd reaction' // &
2740) ' not found among primary species list.'
2741) call printErrMsg(option)
2742) endif
2743) reaction%eqkdtype(irxn) = cur_kd_rxn%itype
2744) reaction%eqkddistcoef(irxn) = cur_kd_rxn%Kd
2745) reaction%eqkdlangmuirb(irxn) = cur_kd_rxn%Langmuir_b
2746) reaction%eqkdfreundlichn(irxn) = cur_kd_rxn%Freundlich_n
2747)
2748) cur_kd_rxn => cur_kd_rxn%next
2749) enddo
2750) endif
2751)
2752) call BasisPrint(reaction,'Final Basis',option)
2753)
2754) ! locate specific species
2755) reaction%species_idx => SpeciesIndexCreate()
2756) do ispec = 1, reaction%naqcomp
2757) if (reaction%species_idx%h_ion_id == 0) then
2758) word = 'H+'
2759) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2760) word)) then
2761) reaction%species_idx%h_ion_id = ispec
2762) endif
2763) endif
2764) if (reaction%species_idx%na_ion_id == 0) then
2765) word = 'Na+'
2766) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2767) word)) then
2768) reaction%species_idx%na_ion_id = ispec
2769) endif
2770) endif
2771) if (reaction%species_idx%cl_ion_id == 0) then
2772) word = 'Cl-'
2773) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2774) word)) then
2775) reaction%species_idx%cl_ion_id = ispec
2776) endif
2777) endif
2778) if (reaction%species_idx%co2_aq_id == 0) then
2779) word = 'CO2(aq)'
2780) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2781) word)) then
2782) reaction%species_idx%co2_aq_id = ispec
2783) endif
2784) endif
2785) if (reaction%species_idx%tracer_aq_id == 0) then
2786) word = 'Tracer'
2787) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2788) word)) then
2789) reaction%species_idx%tracer_aq_id = ispec
2790) endif
2791) endif
2792) if (reaction%species_idx%h2o_aq_id == 0) then
2793) word = 'H2O'
2794) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2795) word)) then
2796) reaction%species_idx%h2o_aq_id = ispec
2797) endif
2798) endif
2799) if (reaction%species_idx%tracer_age_id == 0) then
2800) word = 'Tracer_Age'
2801) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2802) word)) then
2803) reaction%species_idx%tracer_age_id = ispec
2804) reaction%calculate_tracer_age = PETSC_TRUE
2805) endif
2806) endif
2807) if (reaction%species_idx%water_age_id == 0) then
2808) word = 'Water_Age'
2809) if (StringCompareIgnoreCase(reaction%primary_species_names(ispec), &
2810) word)) then
2811) reaction%species_idx%water_age_id = ispec
2812) reaction%calculate_water_age = PETSC_TRUE
2813) endif
2814) endif
2815) enddo
2816)
2817) do ispec = 1, reaction%neqcplx
2818) if (reaction%species_idx%h_ion_id == 0) then
2819) word = 'H+'
2820) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
2821) word)) then
2822) reaction%species_idx%h_ion_id = -ispec
2823) endif
2824) endif
2825) if (reaction%species_idx%na_ion_id == 0) then
2826) word = 'Na+'
2827) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
2828) word)) then
2829) reaction%species_idx%na_ion_id = -ispec
2830) endif
2831) endif
2832) if (reaction%species_idx%cl_ion_id == 0) then
2833) word = 'Cl-'
2834) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
2835) word)) then
2836) reaction%species_idx%cl_ion_id = -ispec
2837) endif
2838) endif
2839) if (reaction%species_idx%co2_aq_id == 0) then
2840) word = 'CO2(aq)'
2841) if (StringCompareIgnoreCase(reaction%secondary_species_names(ispec), &
2842) word)) then
2843) reaction%species_idx%co2_aq_id = -ispec
2844) endif
2845) endif
2846) enddo
2847)
2848) do ispec = 1, reaction%ngas
2849) if (reaction%species_idx%o2_gas_id == 0) then
2850) word = 'O2(g)'
2851) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
2852) word)) then
2853) reaction%species_idx%o2_gas_id = ispec
2854) endif
2855) endif
2856) if (reaction%species_idx%co2_gas_id == 0) then
2857) word = 'CO2(g)'
2858) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
2859) word)) then
2860) reaction%species_idx%co2_gas_id = ispec
2861) endif
2862) word = 'CO2(g)*'
2863) if (StringCompareIgnoreCase(reaction%gas_species_names(ispec), &
2864) word)) then
2865) reaction%species_idx%co2_gas_id = ispec
2866) endif
2867)
2868) endif
2869)
2870) enddo
2871)
2872) 90 format(80('-'))
2873) 100 format(/,2x,i4,2x,a)
2874) 110 format(100(/,14x,3(a20,2x)))
2875)
2876) if (OptionPrintToFile(option)) then
2877) write(option%fid_out,90)
2878) write(option%fid_out,100) reaction%naqcomp, 'Primary Species'
2879) write(option%fid_out,110) (reaction%primary_species_names(i),i=1,reaction%naqcomp)
2880)
2881) write(option%fid_out,100) reaction%neqcplx, 'Secondary Complex Species'
2882) write(option%fid_out,110) (reaction%secondary_species_names(i),i=1,reaction%neqcplx)
2883)
2884) write(option%fid_out,100) reaction%ngas, 'Gas Species'
2885) write(option%fid_out,110) (reaction%gas_species_names(i),i=1,reaction%ngas)
2886)
2887) write(option%fid_out,100) reaction%nmnrl, 'Reference Minerals'
2888) write(option%fid_out,110) (reaction%mineral_names(i),i=1,reaction%nmnrl)
2889)
2890) write(option%fid_out,100) reaction%nkinmnrl, 'Kinetic Mineral Reactions'
2891) write(option%fid_out,110) (reaction%kinmnrl_names(i),i=1,reaction%nkinmnrl)
2892)
2893) write(option%fid_out,100) reaction%neqsrfcplxrxn, 'Surface Complexation Reactions'
2894) write(option%fid_out,110) (reaction%eqsrfcplx_site_names(i),i=1,reaction%neqsrfcplxrxn)
2895) write(option%fid_out,100) reaction%neqsrfcplx, 'Surface Complexes'
2896) write(option%fid_out,110) (reaction%eqsrfcplx_names(i),i=1,reaction%neqsrfcplx)
2897)
2898) write(option%fid_out,100) reaction%neqionxrxn, 'Ion Exchange Reactions'
2899) write(option%fid_out,100) reaction%neqionxcation, 'Ion Exchange Cations'
2900) write(option%fid_out,90)
2901) endif
2902)
2903) #if 0
2904) ! output for ASCEM reactions
2905) if (OptionPrintToFile(option)) then
2906) open(unit=86,file='reaction.dat')
2907) write(86,'(10i4)') reaction%naqcomp, reaction%neqcplx, reaction%ngeneral_rxn, &
2908) reaction%neqsrfcplxrxn, reaction%nkinmnrl
2909) do icomp = 1, reaction%naqcomp
2910) write(86,'(a12,f6.2,f6.2)') reaction%primary_species_names(icomp), &
2911) reaction%primary_spec_Z(icomp), &
2912) reaction%primary_spec_a0(icomp)
2913) enddo
2914) do icplx = 1, reaction%neqcplx
2915) write(86,'(a32,f6.2,f6.2)') reaction%secondary_species_names(icplx), &
2916) reaction%eqcplx_Z(icplx), &
2917) reaction%eqcplx_a0(icplx)
2918) write(86,'(40i4)') reaction%eqcplxspecid(:,icplx)
2919) write(86,'(40f6.2)') reaction%eqcplxstoich(:,icplx)
2920) write(86,'(i4)') reaction%eqcplxh2oid(icplx)
2921) write(86,'(f6.2)') reaction%eqcplxh2ostoich(icplx)
2922) write(86,'(1es13.5)') reaction%eqcplx_logK(icplx)
2923) enddo
2924) do irxn = 1, reaction%ngeneral_rxn
2925) write(86,'(40i4)') reaction%generalspecid(:,irxn)
2926) write(86,'(40f6.2)') reaction%generalstoich(:,irxn)
2927) write(86,'(40i4)') reaction%generalforwardspecid(:,irxn)
2928) write(86,'(40f6.2)') reaction%generalforwardstoich(:,irxn)
2929) write(86,'(40i4)') reaction%generalbackwardspecid(:,irxn)
2930) write(86,'(40f6.2)') reaction%generalbackwardstoich(:,irxn)
2931) write(86,'(f6.2)') reaction%generalh2ostoich(irxn)
2932) write(86,'(1es13.5)') reaction%general_kf(irxn)
2933) write(86,'(1es13.5)') reaction%general_kr(irxn)
2934) enddo
2935) do irxn = 1, reaction%neqsrfcplxrxn
2936) write(86,'(a32)')reaction%eqsrfcplx_site_names(irxn)
2937) write(86,'(1es13.5)') reaction%eqsrfcplx_rxn_site_density(irxn)
2938) write(86,'(i4)') reaction%srfcplxrxn_to_complex(0,irxn) ! # complexes
2939) do i = 1, reaction%srfcplxrxn_to_complex(0,irxn)
2940) icplx = reaction%srfcplxrxn_to_complex(i,irxn)
2941) write(86,'(a32,f6.2)') reaction%eqsrfcplx_names(icplx), &
2942) reaction%eqsrfcplx_Z(icplx)
2943) write(86,'(40i4)') reaction%srfcplxspecid(:,icplx)
2944) write(86,'(40f6.2)') reaction%eqsrfcplxstoich(:,icplx)
2945) write(86,'(i4)') reaction%eqsrfcplxh2oid(icplx)
2946) write(86,'(f6.2)') reaction%eqsrfcplxh2ostoich(icplx)
2947) write(86,'(i4)') reaction%eqsrfcplx_free_site_id(icplx)
2948) write(86,'(f6.2)') reaction%eqsrfcplx_free_site_stoich(icplx)
2949) write(86,'(1es13.5)') reaction%eqsrfcplx_logK(icplx)
2950)
2951) enddo
2952) enddo
2953) do imnrl = 1, reaction%nkinmnrl
2954) write(86,'(a32)') reaction%kinmnrl_names(imnrl)
2955) write(86,'(40i4)') reaction%kinmnrlspecid(:,imnrl)
2956) write(86,'(40f6.2)') reaction%kinmnrlstoich(:,imnrl)
2957) write(86,'(i4)') reaction%kinmnrlh2oid(imnrl)
2958) write(86,'(f6.2)') reaction%kinmnrlh2ostoich(imnrl)
2959) write(86,'(1es13.5)') reaction%kinmnrl_logK(imnrl)
2960) write(86,'(1es13.5)') reaction%kinmnrl_molar_vol(imnrl)
2961) write(86,'(1es13.5)') reaction%kinmnrl_molar_wt(imnrl)
2962) write(86,'(1es13.5)') reaction%kinmnrl_rate_constant(1,imnrl)
2963) write(86,'(1es13.5)') 1.d0 ! specific surface area 1 cm^2 / cm^3
2964) enddo
2965) close(86)
2966) endif
2967) #endif
2968)
2969) if (allocated(new_basis)) deallocate(new_basis)
2970) if (allocated(old_basis)) deallocate(old_basis)
2971) if (allocated(transformation)) deallocate(transformation)
2972) if (allocated(stoich_prev)) deallocate(stoich_prev)
2973) if (allocated(stoich_new)) deallocate(stoich_new)
2974) if (allocated(logKCoeffvector)) deallocate(logKCoeffvector)
2975) if (allocated(indices)) deallocate(indices)
2976)
2977) if (allocated(new_basis_names)) deallocate(new_basis_names)
2978) if (allocated(old_basis_names)) deallocate(old_basis_names)
2979) !TODO(geh)
2980) #endif
2981) end subroutine BasisInit_hpt
2982)
2983) ! ************************************************************************** !
2984)
2985) subroutine BasisSubSpecInGasOrSecRxn_hpt(name1,dbaserxn1,dbaserxn2)
2986) !
2987) ! Swaps out a chemical species in a chemical
2988) ! reaction, replacing it with the species in a
2989) ! secondary reaction (swaps 1 into 2)
2990) !
2991) ! Author: Glenn Hammond
2992) ! Date: 03/02/2012
2993) !
2994)
2995) use String_module
2996)
2997) implicit none
2998)
2999) character(len=MAXWORDLENGTH) :: name1
3000) type(database_rxn_type) :: dbaserxn1
3001) type(database_rxn_type) :: dbaserxn2
3002)
3003) PetscReal :: scale
3004)
3005) call BasisSubSpeciesInGasOrSecRxn(name1,dbaserxn1,dbaserxn2,scale)
3006) dbaserxn2%logKCoeff_hpt = dbaserxn2%logKCoeff_hpt + &
3007) scale*dbaserxn1%logKCoeff_hpt
3008)
3009) end subroutine BasisSubSpecInGasOrSecRxn_hpt
3010)
3011) ! ************************************************************************** !
3012)
3013) subroutine BasisSubSpeciesInMineralRxn_hpt(name,sec_dbaserxn,mnrl_dbaserxn)
3014) !
3015) ! Swaps out a chemical species in a chemical
3016) ! reaction, replacing it with the species in a
3017) ! secondary reaction (swaps 1 into 2)
3018) !
3019) ! Author: Glenn Hammond
3020) ! Date: 03/02/2012
3021) !
3022)
3023) use String_module
3024) use Reaction_module
3025)
3026) implicit none
3027)
3028) character(len=MAXWORDLENGTH) :: name
3029) type(database_rxn_type) :: sec_dbaserxn
3030) type(database_rxn_type) :: mnrl_dbaserxn
3031)
3032) PetscReal :: scale
3033)
3034) call BasisSubSpeciesInMineralRxn(name,sec_dbaserxn,mnrl_dbaserxn,scale)
3035) mnrl_dbaserxn%logKCoeff_hpt = mnrl_dbaserxn%logKCoeff_hpt + &
3036) scale*sec_dbaserxn%logKCoeff_hpt
3037)
3038) end subroutine BasisSubSpeciesInMineralRxn_hpt
3039)
3040) end module Reaction_Database_hpt_module