reaction.F90 coverage: 75.00 %func 56.74 %block
1) module Reaction_module
2)
3) use Reaction_Aux_module
4) use Reactive_Transport_Aux_module
5) use Global_Aux_module
6) use Material_Aux_class
7)
8) use Reaction_Surface_Complexation_module
9) use Reaction_Mineral_module
10) use Reaction_Microbial_module
11) use Reaction_Immobile_module
12)
13) use Reaction_Surface_Complexation_Aux_module
14) use Reaction_Mineral_Aux_module
15) use Reaction_Microbial_Aux_module
16) use Reaction_Immobile_Aux_module
17)
18) #ifdef SOLID_SOLUTION
19) use Reaction_Solid_Solution_module
20) use Reaction_Solid_Soln_Aux_module
21) #endif
22)
23) use Reaction_Sandbox_module
24) use CLM_Rxn_module
25)
26) use PFLOTRAN_Constants_module
27)
28) implicit none
29)
30) private
31)
32) #include "petsc/finclude/petscsys.h"
33)
34) PetscReal, parameter :: perturbation_tolerance = 1.d-5
35)
36) public :: ReactionInit, &
37) ReactionReadPass1, &
38) ReactionReadPass2, &
39) ReactionReadOutput, &
40) ReactionReadRedoxSpecies, &
41) RTotal, &
42) RTotalSorb, &
43) CO2AqActCoeff, &
44) RActivityCoefficients, &
45) RReaction, &
46) RReactionDerivative, &
47) ReactionProcessConstraint, &
48) ReactionEquilibrateConstraint, &
49) ReactionPrintConstraint, &
50) ReactionFitLogKCoef, &
51) ReactionInitializeLogK, &
52) ReactionComputeKd, &
53) RAccumulationSorb, &
54) RAccumulationSorbDerivative, &
55) RJumpStartKineticSorption, &
56) RAge, &
57) RReact, &
58) RTAuxVarCompute, &
59) RTAccumulation, &
60) RTAccumulationDerivative, &
61) RTPrintAuxVar, &
62) ReactionInterpolateLogK_hpt, &
63) ReactionInitializeLogK_hpt, &
64) RUpdateKineticState, &
65) RUpdateTempDependentCoefs, &
66) RZeroSorb, &
67) RCO2MoleFraction
68)
69) contains
70)
71) ! ************************************************************************** !
72)
73) subroutine ReactionInit(reaction,input,option)
74) !
75) ! ReactionReadPass1: Initializes the reaction object, creating object and
76) ! reading first pass of CHEMISTRY input file block
77) !
78) ! Author: Glenn Hammond
79) ! Date: 01/03/13
80) !
81)
82) use Option_module
83) use Input_Aux_module
84) use CLM_Rxn_module, only : RCLMRxnInit
85)
86) implicit none
87)
88) type(reaction_type), pointer :: reaction
89) type(input_type), pointer :: input
90) type(option_type) :: option
91)
92) reaction => ReactionCreate()
93)
94) ! must be called prior to the first pass
95) call RSandboxInit(option)
96) call RCLMRxnInit(option)
97)
98) call ReactionReadPass1(reaction,input,option)
99) reaction%primary_species_names => GetPrimarySpeciesNames(reaction)
100) ! PCL add in colloid dofs
101) option%ntrandof = GetPrimarySpeciesCount(reaction)
102) option%ntrandof = option%ntrandof + GetColloidCount(reaction)
103) option%ntrandof = option%ntrandof + GetImmobileCount(reaction)
104) reaction%ncomp = option%ntrandof
105)
106) end subroutine ReactionInit
107)
108) ! ************************************************************************** !
109)
110) subroutine ReactionReadPass1(reaction,input,option)
111) !
112) ! Reads chemistry (first pass)
113) !
114) ! Author: Glenn Hammond
115) ! Date: 05/02/08
116) !
117)
118) use Option_module
119) use String_module
120) use Input_Aux_module
121) use Utility_module
122) use Units_module
123) use Variables_module, only : PRIMARY_MOLALITY, PRIMARY_MOLARITY, &
124) TOTAL_MOLALITY, TOTAL_MOLARITY, &
125) SECONDARY_MOLALITY, SECONDARY_MOLARITY
126) use CLM_Rxn_module, only : RCLMRxnRead
127)
128) implicit none
129)
130) type(reaction_type) :: reaction
131) type(input_type), pointer :: input
132) type(option_type) :: option
133)
134) character(len=MAXSTRINGLENGTH) :: string
135) character(len=MAXWORDLENGTH) :: word
136) character(len=MAXWORDLENGTH) :: name
137) character(len=MAXWORDLENGTH) :: card
138) character(len=MAXWORDLENGTH) :: internal_units
139) character(len=MAXWORDLENGTH) :: kd_units
140) type(aq_species_type), pointer :: species, prev_species
141) type(gas_species_type), pointer :: gas, prev_gas
142) type(immobile_species_type), pointer :: immobile_species
143) type(immobile_species_type), pointer :: prev_immobile_species
144) type(colloid_type), pointer :: colloid, prev_colloid
145) type(ion_exchange_rxn_type), pointer :: ionx_rxn, prev_ionx_rxn
146) type(ion_exchange_cation_type), pointer :: cation, prev_cation
147) type(general_rxn_type), pointer :: general_rxn, prev_general_rxn
148) type(radioactive_decay_rxn_type), pointer :: radioactive_decay_rxn
149) type(radioactive_decay_rxn_type), pointer :: prev_radioactive_decay_rxn
150) type(kd_rxn_type), pointer :: kd_rxn, prev_kd_rxn
151) type(kd_rxn_type), pointer :: sec_cont_kd_rxn, sec_cont_prev_kd_rxn
152) PetscInt :: i, temp_int
153) PetscReal :: temp_real
154) PetscInt :: srfcplx_count
155) PetscInt :: temp_srfcplx_count
156) PetscBool :: found
157) PetscBool :: reaction_sandbox_read
158) PetscBool :: reaction_clm_read
159)
160) nullify(prev_species)
161) nullify(prev_gas)
162) nullify(prev_immobile_species)
163) nullify(prev_colloid)
164) nullify(prev_cation)
165) nullify(prev_general_rxn)
166) nullify(prev_radioactive_decay_rxn)
167) nullify(prev_kd_rxn)
168) nullify(prev_ionx_rxn)
169)
170) if (option%use_mc) then
171) nullify(sec_cont_prev_kd_rxn)
172) endif
173)
174) reaction_sandbox_read = PETSC_FALSE
175) reaction_clm_read = PETSC_FALSE
176)
177) kd_units = ''
178) srfcplx_count = 0
179) input%ierr = 0
180) do
181)
182) call InputReadPflotranString(input,option)
183) if (InputError(input)) exit
184) if (InputCheckExit(input,option)) exit
185)
186) call InputReadWord(input,option,word,PETSC_TRUE)
187) call InputErrorMsg(input,option,'keyword','CHEMISTRY')
188) call StringToUpper(word)
189)
190) select case(trim(word))
191)
192) case('PRIMARY_SPECIES')
193) nullify(prev_species)
194) do
195) call InputReadPflotranString(input,option)
196) if (InputError(input)) exit
197) if (InputCheckExit(input,option)) exit
198)
199) reaction%naqcomp = reaction%naqcomp + 1
200)
201) species => AqueousSpeciesCreate()
202) call InputReadWord(input,option,species%name,PETSC_TRUE)
203) call InputErrorMsg(input,option,'keyword','CHEMISTRY,&
204) &PRIMARY_SPECIES')
205) if (.not.associated(reaction%primary_species_list)) then
206) reaction%primary_species_list => species
207) species%id = 1
208) endif
209) if (associated(prev_species)) then
210) prev_species%next => species
211) species%id = prev_species%id + 1
212) endif
213) prev_species => species
214) nullify(species)
215) enddo
216) case('SECONDARY_SPECIES')
217) nullify(prev_species)
218) do
219) call InputReadPflotranString(input,option)
220) if (InputError(input)) exit
221) if (InputCheckExit(input,option)) exit
222)
223) reaction%neqcplx = reaction%neqcplx + 1
224)
225) species => AqueousSpeciesCreate()
226) call InputReadWord(input,option,species%name,PETSC_TRUE)
227) call InputErrorMsg(input,option,'keyword','CHEMISTRY,&
228) &SECONDARY_SPECIES')
229) if (.not.associated(reaction%secondary_species_list)) then
230) reaction%secondary_species_list => species
231) species%id = 1
232) endif
233) if (associated(prev_species)) then
234) prev_species%next => species
235) species%id = prev_species%id + 1
236) endif
237) prev_species => species
238) nullify(species)
239) enddo
240) case('GAS_SPECIES')
241) nullify(prev_gas)
242) do
243) call InputReadPflotranString(input,option)
244) if (InputError(input)) exit
245) if (InputCheckExit(input,option)) exit
246)
247) reaction%ngas = reaction%ngas + 1
248)
249) gas => GasSpeciesCreate()
250) call InputReadWord(input,option,gas%name,PETSC_TRUE)
251) call InputErrorMsg(input,option,'keyword','CHEMISTRY,GAS_SPECIES')
252) if (.not.associated(reaction%gas_species_list)) then
253) reaction%gas_species_list => gas
254) gas%id = 1
255) endif
256) if (associated(prev_gas)) then
257) prev_gas%next => gas
258) gas%id = prev_gas%id + 1
259) endif
260) prev_gas => gas
261) nullify(gas)
262) enddo
263) case('IMMOBILE_SPECIES')
264) ! find end of list if it exists
265) if (associated(reaction%immobile%list)) then
266) immobile_species => reaction%immobile%list
267) do
268) if (.not.associated(immobile_species%next)) exit
269) immobile_species => immobile_species%next
270) enddo
271) prev_immobile_species => immobile_species
272) nullify(immobile_species)
273) else
274) nullify(prev_immobile_species)
275) endif
276) do
277) call InputReadPflotranString(input,option)
278) if (InputError(input)) exit
279) if (InputCheckExit(input,option)) exit
280)
281) reaction%immobile%nimmobile = reaction%immobile%nimmobile + 1
282)
283) immobile_species => ImmobileSpeciesCreate()
284) call InputReadWord(input,option,immobile_species%name,PETSC_TRUE)
285) call InputErrorMsg(input,option,'keyword', &
286) 'CHEMISTRY,IMMOBILE_SPECIES')
287) if (.not.associated(prev_immobile_species)) then
288) reaction%immobile%list => immobile_species
289) immobile_species%id = 1
290) else
291) prev_immobile_species%next => immobile_species
292) immobile_species%id = prev_immobile_species%id + 1
293) endif
294) prev_immobile_species => immobile_species
295) nullify(immobile_species)
296) enddo
297) case('IMMOBILE_DECAY_REACTION')
298) call ImmobileDecayRxnRead(reaction%immobile,input,option)
299) case('RADIOACTIVE_DECAY_REACTION')
300) reaction%nradiodecay_rxn = reaction%nradiodecay_rxn + 1
301) radioactive_decay_rxn => RadioactiveDecayRxnCreate()
302) radioactive_decay_rxn%rate_constant = UNINITIALIZED_DOUBLE
303) do
304) call InputReadPflotranString(input,option)
305) if (InputError(input)) exit
306) if (InputCheckExit(input,option)) exit
307)
308) call InputReadWord(input,option,word,PETSC_TRUE)
309) call InputErrorMsg(input,option,'keyword', &
310) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION')
311) call StringToUpper(word)
312)
313) select case(trim(word))
314) case('REACTION')
315) ! remainder of string should be the reaction equation
316) radioactive_decay_rxn%reaction = trim(adjustl(input%buf))
317) ! set flag for error message
318) if (len_trim(radioactive_decay_rxn%reaction) < 2) input%ierr = 1
319) call InputErrorMsg(input,option,'reaction', &
320) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,REACTION')
321) case('RATE_CONSTANT')
322) call InputReadDouble(input,option, &
323) radioactive_decay_rxn%rate_constant)
324) call InputErrorMsg(input,option,'rate constant', &
325) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,RATE_CONSTANT')
326) call InputReadAndConvertUnits(input, &
327) radioactive_decay_rxn%rate_constant,'unitless/sec', &
328) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,RATE_CONSTANT',option)
329) case('HALF_LIFE')
330) call InputReadDouble(input,option, &
331) radioactive_decay_rxn%half_life)
332) call InputErrorMsg(input,option,'half life', &
333) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,HALF_LIFE')
334) call InputReadAndConvertUnits(input, &
335) radioactive_decay_rxn%half_life,'sec', &
336) 'CHEMISTRY,RADIOACTIVE_DECAY_REACTION,HALF_LIFE',option)
337) ! convert half life to rate constant
338) radioactive_decay_rxn%rate_constant = &
339) -1.d0*log(0.5d0)/radioactive_decay_rxn%half_life
340) case default
341) call InputKeywordUnrecognized(word, &
342) 'CHEMISTRY,IMMOBILE_DECAY_REACTION',option)
343) end select
344) enddo
345) if (Uninitialized(radioactive_decay_rxn%rate_constant)) then
346) option%io_buffer = 'RATE_CONSTANT or HALF_LIFE must be set in ' // &
347) 'RADIOACTIVE_DECAY_REACTION.'
348) call printErrMsg(option)
349) endif
350) if (.not.associated(reaction%radioactive_decay_rxn_list)) then
351) reaction%radioactive_decay_rxn_list => radioactive_decay_rxn
352) radioactive_decay_rxn%id = 1
353) endif
354) if (associated(prev_radioactive_decay_rxn)) then
355) prev_radioactive_decay_rxn%next => radioactive_decay_rxn
356) radioactive_decay_rxn%id = prev_radioactive_decay_rxn%id + 1
357) endif
358) prev_radioactive_decay_rxn => radioactive_decay_rxn
359) nullify(radioactive_decay_rxn)
360) case('GENERAL_REACTION')
361) reaction%ngeneral_rxn = reaction%ngeneral_rxn + 1
362) general_rxn => GeneralRxnCreate()
363) do
364) call InputReadPflotranString(input,option)
365) if (InputError(input)) exit
366) if (InputCheckExit(input,option)) exit
367)
368) call InputReadWord(input,option,word,PETSC_TRUE)
369) call InputErrorMsg(input,option,'keyword','CHEMISTRY,GENERAL_REACTION')
370) call StringToUpper(word)
371)
372) select case(trim(word))
373) case('REACTION')
374) ! remainder of string should be the reaction equation
375) general_rxn%reaction = trim(adjustl(input%buf))
376) ! set flag for error message
377) if (len_trim(general_rxn%reaction) < 2) input%ierr = 1
378) call InputErrorMsg(input,option,'reaction', &
379) 'CHEMISTRY,GENERAL_REACTION,REACTION')
380) ! For now, the reactants are negative stoich, products positive in reaction equation - geh
381) #if 0
382) case('FORWARD_SPECIES')
383) nullify(prev_species)
384) do
385) call InputReadPflotranString(input,option)
386) if (InputError(input)) exit
387) if (InputCheckExit(input,option)) exit
388)
389) species => AqueousSpeciesCreate()
390) call InputReadWord(input,option,species%name,PETSC_TRUE)
391) call InputErrorMsg(input,option,'keyword','CHEMISTRY, &
392) GENERAL_REACTION,FORWARD_SPECIES')
393) if (.not.associated(general_rxn%forward_species_list)) then
394) general_rxn%forward_species_list => species
395) species%id = 1
396) endif
397) if (associated(prev_species)) then
398) prev_species%next => species
399) species%id = prev_species%id + 1
400) endif
401) prev_species => species
402) nullify(species)
403) enddo
404) nullify(prev_species)
405) case('BACKWARD_SPECIES')
406) nullify(prev_species)
407) do
408) call InputReadPflotranString(input,option)
409) if (InputError(input)) exit
410) if (InputCheckExit(input,option)) exit
411)
412) species => AqueousSpeciesCreate()
413) call InputReadWord(input,option,species%name,PETSC_TRUE)
414) call InputErrorMsg(input,option,'keyword','CHEMISTRY, &
415) GENERAL_REACTION,BACKWARD_SPECIES')
416) if (.not.associated(general_rxn%backward_species_list)) then
417) general_rxn%forward_species_list => species
418) species%id = 1
419) endif
420) if (associated(prev_species)) then
421) prev_species%next => species
422) species%id = prev_species%id + 1
423) endif
424) prev_species => species
425) nullify(species)
426) enddo
427) nullify(prev_species)
428) #endif
429) case('FORWARD_RATE')
430) call InputReadDouble(input,option,general_rxn%forward_rate)
431) call InputErrorMsg(input,option,'forward rate', &
432) 'CHEMISTRY,GENERAL_REACTION')
433) case('BACKWARD_RATE')
434) call InputReadDouble(input,option,general_rxn%backward_rate)
435) call InputErrorMsg(input,option,'backward rate', &
436) 'CHEMISTRY,GENERAL_REACTION')
437) end select
438) enddo
439) if (.not.associated(reaction%general_rxn_list)) then
440) reaction%general_rxn_list => general_rxn
441) general_rxn%id = 1
442) endif
443) if (associated(prev_general_rxn)) then
444) prev_general_rxn%next => general_rxn
445) general_rxn%id = prev_general_rxn%id + 1
446) endif
447) prev_general_rxn => general_rxn
448) nullify(general_rxn)
449)
450) case('REACTION_SANDBOX')
451) call RSandboxRead(input,option)
452) reaction_sandbox_read = PETSC_TRUE
453) case('CLM_REACTION')
454) call RCLMRxnRead(input,option)
455) reaction_clm_read = PETSC_TRUE
456) case('MICROBIAL_REACTION')
457) call MicrobialRead(reaction%microbial,input,option)
458) case('MINERALS')
459) call MineralRead(reaction%mineral,input,option)
460) case('MINERAL_KINETICS') ! mineral kinetics read on second round
461) !geh: but we need to count the number of kinetic minerals this round
462) temp_int = 0 ! used to count kinetic minerals
463) do
464) call InputReadPflotranString(input,option)
465) call InputReadStringErrorMsg(input,option,card)
466) if (InputCheckExit(input,option)) exit
467) call InputReadWord(input,option,name,PETSC_TRUE)
468) call InputErrorMsg(input,option,name,'CHEMISTRY,MINERAL_KINETICS')
469) temp_int = temp_int + 1
470)
471) do
472) call InputReadPflotranString(input,option)
473) call InputReadStringErrorMsg(input,option,card)
474) if (InputCheckExit(input,option)) exit
475) call InputReadWord(input,option,word,PETSC_TRUE)
476) call InputErrorMsg(input,option,'keyword', &
477) 'CHEMISTRY,MINERAL_KINETICS')
478) call StringToUpper(word)
479) select case(word)
480) case('PREFACTOR')
481) do
482) call InputReadPflotranString(input,option)
483) call InputReadStringErrorMsg(input,option,card)
484) if (InputCheckExit(input,option)) exit
485) call InputReadWord(input,option,word,PETSC_TRUE)
486) call InputErrorMsg(input,option,'keyword', &
487) 'CHEMISTRY,MINERAL_KINETICS,PREFACTOR')
488) call StringToUpper(word)
489) select case(word)
490) case('PREFACTOR_SPECIES')
491) call InputSkipToEnd(input,option,word)
492) end select
493) enddo
494) end select
495) enddo
496) enddo
497) reaction%mineral%nkinmnrl = reaction%mineral%nkinmnrl + temp_int
498)
499) case('SOLID_SOLUTIONS') ! solid solutions read on second round
500) #ifdef SOLID_SOLUTION
501) do
502) call InputReadPflotranString(input,option)
503) call InputReadStringErrorMsg(input,option,card)
504) if (InputCheckExit(input,option)) exit
505) call InputSkipToEnd(input,option,word)
506) enddo
507) #else
508) option%io_buffer = 'To use solid solutions, must compile with -DSOLID_SOLUTION'
509) call printErrMsg(option)
510) #endif
511)
512) case('COLLOIDS')
513) nullify(prev_colloid)
514) do
515) call InputReadPflotranString(input,option)
516) if (InputError(input)) exit
517) if (InputCheckExit(input,option)) exit
518)
519) reaction%ncoll = reaction%ncoll + 1
520)
521) colloid => ColloidCreate()
522) call InputReadWord(input,option,colloid%name,PETSC_TRUE)
523) call InputErrorMsg(input,option,'keyword','CHEMISTRY,COLLOIDS')
524) call InputReadDouble(input,option,colloid%mobile_fraction)
525) call InputDefaultMsg(input,option,'CHEMISTRY,COLLOIDS,MOBILE_FRACTION')
526) if (.not.associated(reaction%colloid_list)) then
527) reaction%colloid_list => colloid
528) colloid%id = 1
529) endif
530) if (associated(prev_colloid)) then
531) prev_colloid%next => colloid
532) colloid%id = prev_colloid%id + 1
533) endif
534) prev_colloid => colloid
535) nullify(colloid)
536) enddo
537) case('SORPTION')
538) !geh nullify(prev_srfcplx_rxn)
539) do
540) call InputReadPflotranString(input,option)
541) if (InputError(input)) exit
542) if (InputCheckExit(input,option)) exit
543)
544) call InputReadWord(input,option,word,PETSC_TRUE)
545) call InputErrorMsg(input,option,'keyword','CHEMISTRY,SORPTION')
546) call StringToUpper(word)
547)
548) select case(trim(word))
549)
550) case('ISOTHERM_REACTIONS')
551) do
552) call InputReadPflotranString(input,option)
553) if (InputError(input)) exit
554) if (InputCheckExit(input,option)) exit
555)
556) reaction%neqkdrxn = reaction%neqkdrxn + 1
557)
558) kd_rxn => KDRxnCreate()
559) if (option%use_mc) then
560) sec_cont_kd_rxn => KDRxnCreate()
561) endif
562) ! first string is species name
563) call InputReadWord(input,option,word,PETSC_TRUE)
564) call InputErrorMsg(input,option,'species name', &
565) 'CHEMISTRY,ISOTHERM_REACTIONS')
566) kd_rxn%species_name = trim(word)
567) if (option%use_mc) then
568) sec_cont_kd_rxn%species_name = kd_rxn%species_name
569) endif
570) do
571) call InputReadPflotranString(input,option)
572) if (InputError(input)) exit
573) if (InputCheckExit(input,option)) exit
574)
575) call InputReadWord(input,option,word,PETSC_TRUE)
576) call InputErrorMsg(input,option,'keyword', &
577) 'CHEMISTRY,ISOTHERM_REACTIONS')
578) call StringToUpper(word)
579)
580) ! default type is linear
581) kd_rxn%itype = SORPTION_LINEAR
582) select case(trim(word))
583) case('TYPE')
584) call InputReadWord(input,option,word,PETSC_TRUE)
585) call InputErrorMsg(input,option,'type', &
586) 'CHEMISTRY,ISOTHERM_REACTIONS')
587) select case(word)
588) case('LINEAR')
589) kd_rxn%itype = SORPTION_LINEAR
590) case('LANGMUIR')
591) kd_rxn%itype = SORPTION_LANGMUIR
592) case('FREUNDLICH')
593) kd_rxn%itype = SORPTION_FREUNDLICH
594) case default
595) call InputKeywordUnrecognized(word, &
596) 'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS,TYPE', &
597) option)
598) end select
599) if (option%use_mc) then
600) sec_cont_kd_rxn%itype = kd_rxn%itype
601) endif
602) case('DISTRIBUTION_COEFFICIENT','KD')
603) call InputReadDouble(input,option,kd_rxn%Kd)
604) call InputErrorMsg(input,option, &
605) 'DISTRIBUTION_COEFFICIENT', &
606) 'CHEMISTRY,ISOTHERM_REACTIONS')
607) call InputReadWord(input,option,word,PETSC_TRUE)
608) if (input%ierr == 0) kd_units = trim(word)
609) ! S.Karra, 02/20/2014
610) case('SEC_CONT_DISTRIBUTION_COEFFICIENT', &
611) 'SEC_CONT_KD')
612) if (.not.option%use_mc) then
613) option%io_buffer = 'Make sure MULTIPLE_CONTINUUM ' &
614) // 'keyword is set, SECONDARY_CONTINUUM_KD.'
615) call printErrMsg(option)
616) else
617) call InputReadDouble(input,option,sec_cont_kd_rxn%Kd)
618) call InputErrorMsg(input,option, &
619) 'SECONDARY_CONTINUUM_DISTRIBUTION_COEFFICIENT', &
620) 'CHEMISTRY,ISOTHERM_REACTIONS')
621) endif
622) case('LANGMUIR_B')
623) call InputReadDouble(input,option,kd_rxn%Langmuir_B)
624) call InputErrorMsg(input,option,'Langmuir_B', &
625) 'CHEMISTRY,ISOTHERM_REACTIONS')
626) kd_rxn%itype = SORPTION_LANGMUIR
627) case('FREUNDLICH_N')
628) call InputReadDouble(input,option,kd_rxn%Freundlich_N)
629) call InputErrorMsg(input,option,'Freundlich_N', &
630) 'CHEMISTRY,ISOTHERM_REACTIONS')
631) kd_rxn%itype = SORPTION_FREUNDLICH
632) case('KD_MINERAL_NAME')
633) call InputReadWord(input,option,word,PETSC_TRUE)
634) call InputErrorMsg(input,option,'KD_MINERAL_NAME', &
635) 'ISOTHERM_REACTIONS,KD_MINERAL_NAME')
636) kd_rxn%kd_mineral_name = word
637) case default
638) call InputKeywordUnrecognized(word, &
639) 'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS',option)
640) end select
641) enddo
642)
643) if (len_trim(kd_units) > 0) then
644) if (len_trim(kd_rxn%kd_mineral_name) > 0) then
645) internal_units = 'L/kg'
646) kd_rxn%Kd = kd_rxn%Kd * &
647) UnitsConvertToInternal(kd_units,internal_units,option)
648) else
649) internal_units = 'kg/m^3'
650) kd_rxn%Kd = kd_rxn%Kd * &
651) UnitsConvertToInternal(kd_units,internal_units,option)
652) endif
653) endif
654)
655) ! add to list
656) if (.not.associated(reaction%kd_rxn_list)) then
657) reaction%kd_rxn_list => kd_rxn
658) kd_rxn%id = 1
659) endif
660) if (associated(prev_kd_rxn)) then
661) prev_kd_rxn%next => kd_rxn
662) kd_rxn%id = prev_kd_rxn%id + 1
663) endif
664) prev_kd_rxn => kd_rxn
665) nullify(kd_rxn)
666)
667) if (option%use_mc) then
668) ! add to list
669) if (.not.associated(reaction%sec_cont_kd_rxn_list)) then
670) reaction%sec_cont_kd_rxn_list => sec_cont_kd_rxn
671) sec_cont_kd_rxn%id = 1
672) endif
673) if (associated(sec_cont_prev_kd_rxn)) then
674) sec_cont_prev_kd_rxn%next => sec_cont_kd_rxn
675) sec_cont_kd_rxn%id = sec_cont_prev_kd_rxn%id + 1
676) endif
677) sec_cont_prev_kd_rxn => sec_cont_kd_rxn
678) nullify(sec_cont_kd_rxn)
679) endif
680) enddo
681)
682) case('SURFACE_COMPLEXATION_RXN')
683) call SurfaceComplexationRead(reaction,input,option)
684) case('ION_EXCHANGE_RXN')
685) ionx_rxn => IonExchangeRxnCreate()
686) do
687) call InputReadPflotranString(input,option)
688) if (InputError(input)) exit
689) if (InputCheckExit(input,option)) exit
690)
691) call InputReadWord(input,option,word,PETSC_TRUE)
692) call InputErrorMsg(input,option,'keyword', &
693) 'CHEMISTRY,ION_EXCHANGE_RXN')
694) call StringToUpper(word)
695)
696) select case(trim(word))
697) case('MINERAL')
698) call InputReadWord(input,option,ionx_rxn%mineral_name, &
699) PETSC_TRUE)
700) call InputErrorMsg(input,option,'keyword', &
701) 'CHEMISTRY,ION_EXCHANGE_RXN,MINERAL_NAME')
702) case('CEC')
703) call InputReadDouble(input,option,ionx_rxn%CEC)
704) call InputErrorMsg(input,option,'keyword', &
705) 'CHEMISTRY,ION_EXCHANGE_RXN,CEC')
706) case('CATIONS')
707) string = '' ! string denotes the reference cation
708) nullify(prev_cation)
709) do
710) call InputReadPflotranString(input,option)
711) if (InputError(input)) exit
712) if (InputCheckExit(input,option)) exit
713)
714) cation => IonExchangeCationCreate()
715) reaction%neqionxcation = reaction%neqionxcation + 1
716) call InputReadWord(input,option,cation%name,PETSC_TRUE)
717) call InputErrorMsg(input,option,'keyword', &
718) 'CHEMISTRY,ION_EXCHANGE_RXN,CATION_NAME')
719) call InputReadDouble(input,option,cation%k)
720) call InputErrorMsg(input,option,'keyword', &
721) 'CHEMISTRY,ION_EXCHANGE_RXN,K')
722) call InputReadWord(input,option,word,PETSC_TRUE)
723) if (input%ierr == 0) then
724) if (StringCompareIgnoreCase(word,'REFERENCE')) then
725) string = cation%name
726) else
727) call InputKeywordUnrecognized(word, &
728) 'CHEMISTRY,ION_EXCHANGE_RXN,CATIONS',option)
729) endif
730) endif
731) if (.not.associated(ionx_rxn%cation_list)) then
732) ionx_rxn%cation_list => cation
733) endif
734) if (associated(prev_cation)) then
735) prev_cation%next => cation
736) endif
737) prev_cation => cation
738) nullify(cation)
739) enddo
740) if (len_trim(string) == 0) then
741) option%io_buffer = &
742) 'Reference cation missing in Ion Exchange reaction.'
743) call printErrMsg(option)
744) endif
745) cation => ionx_rxn%cation_list
746) nullify(prev_cation)
747) do
748) if (.not.associated(cation)) exit
749) if (StringCompare(cation%name,string)) then
750) if (dabs(cation%k - 1.d0) > 1.d-40) then
751) option%io_buffer = 'Reference cation "' // &
752) trim(cation%name) // '" must have k = 1.d0.'
753) call printErrMsg(option)
754) endif
755) ! move it to the front of the list
756) if (associated(prev_cation)) then
757) prev_cation%next => cation%next
758) cation%next => ionx_rxn%cation_list
759) ionx_rxn%cation_list => cation
760) else
761) ! nothing to do as it is at the front of the list
762) endif
763) exit
764) endif
765) prev_cation => cation
766) cation => cation%next
767) enddo
768) case default
769) call InputKeywordUnrecognized(word, &
770) 'CHEMISTRY,ION_EXCHANGE_RXN',option)
771) end select
772) enddo
773) if (.not.associated(reaction%ion_exchange_rxn_list)) then
774) reaction%ion_exchange_rxn_list => ionx_rxn
775) ionx_rxn%id = 1
776) endif
777) if (associated(prev_ionx_rxn)) then
778) prev_ionx_rxn%next => ionx_rxn
779) ionx_rxn%id = prev_ionx_rxn%id + 1
780) endif
781) prev_ionx_rxn => ionx_rxn
782)
783) reaction%neqionxrxn = ionx_rxn%id
784)
785) nullify(ionx_rxn)
786) case('JUMPSTART_KINETIC_SORPTION')
787) option%transport%jumpstart_kinetic_sorption = PETSC_TRUE
788) option%transport%no_restart_kinetic_sorption = PETSC_TRUE
789) case('NO_CHECKPOINT_KINETIC_SORPTION')
790) option%transport%no_checkpoint_kinetic_sorption = PETSC_TRUE
791) case('NO_RESTART_KINETIC_SORPTION')
792) option%transport%no_restart_kinetic_sorption = PETSC_TRUE
793) end select
794) enddo
795) case('DATABASE')
796) call InputReadNChars(input,option,reaction%database_filename, &
797) MAXSTRINGLENGTH,PETSC_TRUE)
798) call InputErrorMsg(input,option,'keyword', &
799) 'CHEMISTRY,DATABASE FILENAME')
800) case('LOG_FORMULATION')
801) reaction%use_log_formulation = PETSC_TRUE
802) case('TRUNCATE_CONCENTRATION')
803) call InputReadDouble(input,option,reaction%truncated_concentration)
804) call InputErrorMsg(input,option,'truncate_concentration','CHEMISTRY')
805) case('GEOTHERMAL_HPT')
806) reaction%use_geothermal_hpt = PETSC_TRUE
807) case('NO_CHECK_UPDATE')
808) reaction%check_update = PETSC_FALSE
809) case('NO_RESTART_MINERAL_VOL_FRAC')
810) option%transport%no_restart_mineral_vol_frac = PETSC_TRUE
811) case('NO_CHECKPOINT_ACT_COEFS')
812) reaction%checkpoint_activity_coefs = PETSC_FALSE
813) case('ACTIVITY_COEFFICIENTS')
814) reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG
815) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_TIMESTEP
816) do
817) call InputReadWord(input,option,word,PETSC_TRUE)
818) if (input%ierr /= 0) exit
819) select case(trim(word))
820) case('OFF')
821) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
822) case('LAG')
823) reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_LAG
824) case('NEWTON')
825) reaction%act_coef_update_algorithm = ACT_COEF_ALGORITHM_NEWTON
826) case('TIMESTEP')
827) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_TIMESTEP
828) case('NEWTON_ITERATION')
829) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_NEWTON_ITER
830) case default
831) call InputKeywordUnrecognized(word, &
832) 'CHEMISTRY,ACTIVITY_COEFFICIENTS',option)
833) end select
834) enddo
835) case('NO_BDOT')
836) reaction%act_coef_use_bdot = PETSC_FALSE
837) case('UPDATE_POROSITY')
838) reaction%update_porosity = PETSC_TRUE
839) option%flow%transient_porosity = PETSC_TRUE
840) case('UPDATE_TORTUOSITY')
841) reaction%update_tortuosity = PETSC_TRUE
842) case('UPDATE_PERMEABILITY')
843) reaction%update_permeability = PETSC_TRUE
844) case('UPDATE_MINERAL_SURFACE_AREA')
845) reaction%update_mineral_surface_area = PETSC_TRUE
846) case('UPDATE_MNRL_SURF_AREA_WITH_POR')
847) reaction%update_mnrl_surf_with_porosity = PETSC_TRUE
848) case('UPDATE_ARMOR_MINERAL_SURFACE')
849) reaction%update_armor_mineral_surface = PETSC_TRUE
850) case('UPDATE_ARMOR_MINERAL_SURFACE_FLAG')
851) reaction%update_armor_mineral_surface = PETSC_TRUE
852) case('MOLAL','MOLALITY')
853) reaction%initialize_with_molality = PETSC_TRUE
854) case('ACTIVITY_H2O','ACTIVITY_WATER')
855) reaction%use_activity_h2o = PETSC_TRUE
856) case('REDOX_SPECIES')
857) call InputSkipToEnd(input,option,word)
858) case('OUTPUT')
859) call InputSkipToEnd(input,option,word)
860) case('MAX_DLNC')
861) call InputReadDouble(input,option,reaction%max_dlnC)
862) call InputErrorMsg(input,option,trim(word),'CHEMISTRY')
863) case('OPERATOR_SPLIT','OPERATOR_SPLITTING')
864) option%io_buffer = 'OPERATOR_SPLIT functionality has not been ' // &
865) 'reimplemented in the refactored PFLOTRAN at this time. Please ' // &
866) 'GLOBAL_IMPLICIT (remove OPERATOR_SPLIT(TING)) or ask for the ' // &
867) 'capability through pflotran-dev@googlegroups.com if you really ' // &
868) 'need it.'
869) call printErrMsg(option)
870) option%transport%reactive_transport_coupling = OPERATOR_SPLIT
871) case('EXPLICIT_ADVECTION')
872) option%itranmode = EXPLICIT_ADVECTION
873) call InputReadWord(input,option,word,PETSC_TRUE)
874) if (input%ierr == 0) then
875) call StringToUpper(word)
876) select case(word)
877) !TODO(geh): fix these hardwired values.
878) case('UPWIND')
879) option%transport%tvd_flux_limiter = 1
880) case('MINMOD')
881) option%transport%tvd_flux_limiter = 3
882) case('MC')
883) option%transport%tvd_flux_limiter = 2
884) case('SUPERBEE')
885) option%transport%tvd_flux_limiter = 4
886) case('VANLEER')
887) option%transport%tvd_flux_limiter = 5
888) case default
889) call InputKeywordUnrecognized(word, &
890) 'CHEMISTRY,EXPLICIT_ADVECTION',option)
891) end select
892) option%io_buffer = 'Flux Limiter: ' // trim(word)
893) call printMsg(option)
894) else
895) call InputDefaultMsg(input,option,'TVD Flux Limiter')
896) endif
897) case('MAX_RELATIVE_CHANGE_TOLERANCE','REACTION_TOLERANCE')
898) call InputReadDouble(input,option,reaction%max_relative_change_tolerance)
899) call InputErrorMsg(input,option,'maximum relative change tolerance','CHEMISTRY')
900) case('MAX_RESIDUAL_TOLERANCE')
901) call InputReadDouble(input,option,reaction%max_residual_tolerance)
902) call InputErrorMsg(input,option,'maximum residual tolerance','CHEMISTRY')
903) case('MINIMUM_POROSITY')
904) call InputReadDouble(input,option,reaction%minimum_porosity)
905) call InputErrorMsg(input,option,'minimim porosity','CHEMISTRY')
906) case default
907) call InputKeywordUnrecognized(word,'CHEMISTRY',option)
908) end select
909) enddo
910)
911) reaction%neqsorb = reaction%neqionxrxn + &
912) reaction%neqkdrxn + &
913) reaction%surface_complexation%neqsrfcplxrxn
914) reaction%nsorb = reaction%neqsorb + &
915) reaction%surface_complexation%nkinmrsrfcplxrxn + &
916) reaction%surface_complexation%nkinsrfcplxrxn
917)
918)
919) if (reaction%print_free_conc_type == 0) then
920) if (reaction%initialize_with_molality) then
921) reaction%print_free_conc_type = PRIMARY_MOLALITY
922) else
923) reaction%print_free_conc_type = PRIMARY_MOLARITY
924) endif
925) endif
926) if (reaction%print_tot_conc_type == 0) then
927) if (reaction%initialize_with_molality) then
928) reaction%print_tot_conc_type = TOTAL_MOLALITY
929) else
930) reaction%print_tot_conc_type = TOTAL_MOLARITY
931) endif
932) endif
933) if (reaction%print_secondary_conc_type == 0) then
934) if (reaction%initialize_with_molality) then
935) reaction%print_secondary_conc_type = SECONDARY_MOLALITY
936) else
937) reaction%print_secondary_conc_type = SECONDARY_MOLARITY
938) endif
939) endif
940) if (reaction%neqcplx + reaction%nsorb + reaction%mineral%nmnrl + &
941) reaction%ngeneral_rxn + reaction%microbial%nrxn + &
942) reaction%nradiodecay_rxn + reaction%immobile%nimmobile > 0 .or. &
943) reaction_clm_read .or. &
944) reaction_sandbox_read) then
945) reaction%use_full_geochemistry = PETSC_TRUE
946) endif
947)
948) ! ensure that update porosity is ON if update of tortuosity, permeability or
949) ! mineral surface area are ON
950) if (.not.reaction%update_porosity .and. &
951) (reaction%update_tortuosity .or. &
952) reaction%update_permeability .or. &
953) reaction%update_mnrl_surf_with_porosity)) then
954) option%io_buffer = 'UPDATE_POROSITY must be listed under CHEMISTRY ' // &
955) 'card when UPDATE_TORTUOSITY, UPDATE_PERMEABILITY, or ' // &
956) 'UPDATE_MNRL_SURF_WITH_POR are listed.'
957) call printErrMsg(option)
958) endif
959)
960) if (len_trim(reaction%database_filename) < 2) &
961) reaction%act_coef_update_frequency = ACT_COEF_FREQUENCY_OFF
962)
963) end subroutine ReactionReadPass1
964)
965) ! ************************************************************************** !
966)
967) subroutine ReactionReadPass2(reaction,input,option)
968) !
969) ! Reads chemistry on pass 2
970) !
971) ! Author: Glenn Hammond
972) ! Date: 01/03/13
973) !
974)
975) use Option_module
976) use String_module
977) use Input_Aux_module
978) use Utility_module
979)
980) implicit none
981)
982) type(reaction_type) :: reaction
983) type(input_type), pointer :: input
984) type(option_type) :: option
985)
986) character(len=MAXSTRINGLENGTH) :: string
987) character(len=MAXWORDLENGTH) :: word
988) character(len=MAXWORDLENGTH) :: name
989) character(len=MAXWORDLENGTH) :: card
990)
991) do
992) call InputReadPflotranString(input,option)
993) call InputReadStringErrorMsg(input,option,card)
994) if (InputCheckExit(input,option)) exit
995) call InputReadWord(input,option,word,PETSC_TRUE)
996) call InputErrorMsg(input,option,'word','CHEMISTRY')
997) select case(trim(word))
998) case('PRIMARY_SPECIES','SECONDARY_SPECIES','GAS_SPECIES', &
999) 'MINERALS','COLLOIDS','GENERAL_REACTION', &
1000) 'IMMOBILE_SPECIES','RADIOACTIVE_DECAY_REACTION', &
1001) 'IMMOBILE_DECAY_REACTION')
1002) call InputSkipToEND(input,option,card)
1003) case('REDOX_SPECIES')
1004) call ReactionReadRedoxSpecies(reaction,input,option)
1005) case('OUTPUT')
1006) call ReactionReadOutput(reaction,input,option)
1007) case('MINERAL_KINETICS')
1008) call MineralReadKinetics(reaction%mineral,input,option)
1009) case('REACTION_SANDBOX')
1010) call RSandboxSkipInput(input,option)
1011) case('CLM_REACTION')
1012) call RCLMRxnSkipInput(input,option)
1013) case('SOLID_SOLUTIONS')
1014) #ifdef SOLID_SOLUTION
1015) call SolidSolutionReadFromInputFile(reaction%solid_solution_list, &
1016) input,option)
1017) #endif
1018) case('SORPTION')
1019) do
1020) call InputReadPflotranString(input,option)
1021) call InputReadStringErrorMsg(input,option,card)
1022) if (InputCheckExit(input,option)) exit
1023) call InputReadWord(input,option,word,PETSC_TRUE)
1024) call InputErrorMsg(input,option,'SORPTION','CHEMISTRY')
1025) select case(trim(word))
1026) case('ISOTHERM_REACTIONS')
1027) do
1028) call InputReadPflotranString(input,option)
1029) call InputReadStringErrorMsg(input,option,card)
1030) if (InputCheckExit(input,option)) exit
1031) call InputReadWord(input,option,word,PETSC_TRUE)
1032) call InputErrorMsg(input,option,word, &
1033) 'CHEMISTRY,SORPTION,ISOTHERM_REACTIONS')
1034) ! skip over remaining cards to end of each kd entry
1035) call InputSkipToEnd(input,option,word)
1036) enddo
1037) case('SURFACE_COMPLEXATION_RXN','ION_EXCHANGE_RXN')
1038) do
1039) call InputReadPflotranString(input,option)
1040) call InputReadStringErrorMsg(input,option,card)
1041) if (InputCheckExit(input,option)) exit
1042) call InputReadWord(input,option,word,PETSC_TRUE)
1043) call InputErrorMsg(input,option,'SORPTION','CHEMISTRY')
1044) select case(trim(word))
1045) case('COMPLEXES','CATIONS')
1046) call InputSkipToEND(input,option,word)
1047) case('COMPLEX_KINETICS')
1048) do
1049) call InputReadPflotranString(input,option)
1050) call InputReadStringErrorMsg(input,option,card)
1051) if (InputCheckExit(input,option)) exit
1052) call InputReadWord(input,option,word,PETSC_TRUE)
1053) call InputErrorMsg(input,option,word, &
1054) 'CHEMISTRY,SURFACE_COMPLEXATION_RXN,KINETIC_RATES')
1055) ! skip over remaining cards to end of each mineral entry
1056) call InputSkipToEnd(input,option,word)
1057) enddo
1058) end select
1059) enddo
1060) case('NUM_THREADS')
1061) case('JUMPSTART_KINETIC_SORPTION')
1062) case('NO_CHECKPOINT_KINETIC_SORPTION')
1063) case('NO_RESTART_KINETIC_SORPTION')
1064) ! dummy placeholder
1065) end select
1066) enddo
1067) case('MICROBIAL_REACTION')
1068) do
1069) call InputReadPflotranString(input,option)
1070) call InputReadStringErrorMsg(input,option,card)
1071) if (InputCheckExit(input,option)) exit
1072) call InputReadWord(input,option,word,PETSC_TRUE)
1073) call InputErrorMsg(input,option,'MICROBIAL_REACTION','CHEMISTRY')
1074) select case(trim(word))
1075) case('INHIBITION','MONOD','BIOMASS')
1076) call InputSkipToEND(input,option,word)
1077) end select
1078) enddo
1079) case('MOLAL','MOLALITY', &
1080) 'UPDATE_POROSITY','UPDATE_TORTUOSITY', &
1081) 'UPDATE_PERMEABILITY','UPDATE_MINERAL_SURFACE_AREA', &
1082) 'NO_RESTART_MINERAL_VOL_FRAC')
1083) ! dummy placeholder
1084) end select
1085) enddo
1086)
1087) end subroutine ReactionReadPass2
1088)
1089) ! ************************************************************************** !
1090)
1091) subroutine ReactionReadRedoxSpecies(reaction,input,option)
1092) !
1093) ! Reads names of mineral species and sets flag
1094) !
1095) ! Author: Glenn Hammond
1096) ! Date: 04/01/11
1097) !
1098)
1099) use Input_Aux_module
1100) use String_module
1101) use Option_module
1102)
1103) implicit none
1104)
1105) type(reaction_type) :: reaction
1106) type(input_type), pointer :: input
1107) type(option_type) :: option
1108)
1109) character(len=MAXWORDLENGTH) :: name
1110)
1111) type(aq_species_type), pointer :: cur_species
1112)
1113) input%ierr = 0
1114) do
1115) call InputReadPflotranString(input,option)
1116) if (InputError(input)) exit
1117) if (InputCheckExit(input,option)) exit
1118)
1119) call InputReadWord(input,option,name,PETSC_TRUE)
1120) call InputErrorMsg(input,option,'keyword','CHEMISTRY,REDOX_SPECIES')
1121)
1122) cur_species => reaction%primary_species_list
1123) do
1124) if (.not.associated(cur_species)) exit
1125) if (StringCompare(cur_species%name,name,MAXWORDLENGTH)) then
1126) cur_species%is_redox = PETSC_TRUE
1127) exit
1128) endif
1129) cur_species => cur_species%next
1130) enddo
1131)
1132) if (.not.associated(cur_species)) then
1133) option%io_buffer = 'Redox species "' // trim(name) // &
1134) '" not found among primary species.'
1135) call printErrMsg(option)
1136) endif
1137) enddo
1138)
1139) end subroutine ReactionReadRedoxSpecies
1140)
1141) ! ************************************************************************** !
1142)
1143) subroutine ReactionProcessConstraint(reaction,constraint_name, &
1144) aq_species_constraint, &
1145) free_ion_guess, &
1146) mineral_constraint, &
1147) srfcplx_constraint, &
1148) colloid_constraint, &
1149) immobile_constraint, &
1150) option)
1151) !
1152) ! Initializes constraints based on primary
1153) ! species in system
1154) !
1155) ! Author: Glenn Hammond
1156) ! Date: 10/14/08
1157) !
1158) use Option_module
1159) use Input_Aux_module
1160) use String_module
1161) use Utility_module
1162) use Transport_Constraint_module
1163)
1164) implicit none
1165)
1166) type(reaction_type), pointer :: reaction
1167) character(len=MAXWORDLENGTH) :: constraint_name
1168) type(aq_species_constraint_type), pointer :: aq_species_constraint
1169) type(guess_constraint_type), pointer :: free_ion_guess
1170) type(mineral_constraint_type), pointer :: mineral_constraint
1171) type(srfcplx_constraint_type), pointer :: srfcplx_constraint
1172) type(colloid_constraint_type), pointer :: colloid_constraint
1173) type(immobile_constraint_type), pointer :: immobile_constraint
1174) type(option_type) :: option
1175)
1176) PetscBool :: found
1177) PetscInt :: icomp, jcomp
1178) PetscInt :: icoll, jcoll
1179) PetscInt :: igas, imnrl
1180) PetscReal :: constraint_conc(reaction%naqcomp)
1181) PetscInt :: constraint_type(reaction%naqcomp)
1182) character(len=MAXWORDLENGTH) :: constraint_aux_string(reaction%naqcomp)
1183) character(len=MAXWORDLENGTH) :: constraint_colloid_name(reaction%ncoll)
1184) PetscInt :: constraint_id(reaction%naqcomp)
1185) PetscBool :: external_dataset(reaction%naqcomp)
1186)
1187) constraint_id = 0
1188) constraint_aux_string = ''
1189) constraint_type = 0
1190) constraint_conc = 0.d0
1191) external_dataset = PETSC_FALSE
1192)
1193) ! aqueous species
1194) do icomp = 1, reaction%naqcomp
1195) found = PETSC_FALSE
1196) do jcomp = 1, reaction%naqcomp
1197) if (StringCompare(aq_species_constraint%names(icomp), &
1198) reaction%primary_species_names(jcomp), &
1199) MAXWORDLENGTH)) then
1200) found = PETSC_TRUE
1201) exit
1202) endif
1203) enddo
1204) if (.not.found) then
1205) option%io_buffer = &
1206) 'Species ' // trim(aq_species_constraint%names(icomp)) // &
1207) ' from CONSTRAINT ' // trim(constraint_name) // &
1208) ' not found among primary species.'
1209) call printErrMsg(option)
1210) else
1211) constraint_type(jcomp) = aq_species_constraint%constraint_type(icomp)
1212) constraint_aux_string(jcomp) = aq_species_constraint%constraint_aux_string(icomp)
1213) constraint_conc(jcomp) = aq_species_constraint%constraint_conc(icomp)
1214) external_dataset(jcomp) = aq_species_constraint%external_dataset(icomp)
1215)
1216) ! link constraint species
1217) select case(constraint_type(jcomp))
1218) case(CONSTRAINT_MINERAL)
1219) found = PETSC_FALSE
1220) do imnrl = 1, reaction%mineral%nmnrl
1221) if (StringCompare(constraint_aux_string(jcomp), &
1222) reaction%mineral%mineral_names(imnrl), &
1223) MAXWORDLENGTH)) then
1224) constraint_id(jcomp) = imnrl
1225) found = PETSC_TRUE
1226) exit
1227) endif
1228) enddo
1229) if (.not.found) then
1230) option%io_buffer = 'Constraint mineral: ' // &
1231) trim(constraint_aux_string(jcomp)) // &
1232) ' for aqueous species: ' // &
1233) trim(reaction%primary_species_names(jcomp)) // &
1234) ' in constraint: ' // &
1235) trim(constraint_name) // ' not found.'
1236) call printErrMsg(option)
1237) endif
1238) case(CONSTRAINT_GAS, CONSTRAINT_SUPERCRIT_CO2)
1239) found = PETSC_FALSE
1240) do igas = 1, reaction%ngas
1241) if (StringCompare(constraint_aux_string(jcomp), &
1242) reaction%gas_species_names(igas), &
1243) MAXWORDLENGTH)) then
1244) constraint_id(jcomp) = igas
1245) found = PETSC_TRUE
1246) exit
1247) endif
1248) enddo
1249) if (.not.found) then
1250) option%io_buffer = 'Constraint gas: ' // &
1251) trim(constraint_aux_string(jcomp)) // &
1252) ' for aqueous species: ' // &
1253) trim(reaction%primary_species_names(jcomp)) // &
1254) ' in constraint: ' // &
1255) trim(constraint_name) // ' not found.'
1256) call printErrMsg(option)
1257) endif
1258) end select
1259)
1260) endif
1261) enddo
1262)
1263) ! place ordered constraint parameters back in original arrays
1264) aq_species_constraint%constraint_type = constraint_type
1265) aq_species_constraint%constraint_aux_string = constraint_aux_string
1266) aq_species_constraint%constraint_spec_id = constraint_id
1267) aq_species_constraint%constraint_conc = constraint_conc
1268) aq_species_constraint%external_dataset = external_dataset
1269)
1270)
1271) if (.not.reaction%use_full_geochemistry) return
1272)
1273) ! free ion guess
1274) if (associated(free_ion_guess)) then
1275) constraint_conc = 0.d0
1276) do icomp = 1, reaction%naqcomp
1277) found = PETSC_FALSE
1278) do jcomp = 1, reaction%naqcomp
1279) if (StringCompare(free_ion_guess%names(icomp), &
1280) reaction%primary_species_names(jcomp), &
1281) MAXWORDLENGTH)) then
1282) found = PETSC_TRUE
1283) exit
1284) endif
1285) enddo
1286) if (.not.found) then
1287) option%io_buffer = &
1288) 'Guess species ' // trim(free_ion_guess%names(icomp)) // &
1289) ' from CONSTRAINT ' // trim(constraint_name) // &
1290) ' not found among primary species.'
1291) call printErrMsg(option)
1292) else
1293) constraint_conc(jcomp) = free_ion_guess%conc(icomp)
1294) endif
1295) enddo
1296) ! place ordered concentrations back in original array
1297) free_ion_guess%conc = constraint_conc
1298) endif
1299)
1300) ! minerals
1301) call MineralProcessConstraint(reaction%mineral,constraint_name, &
1302) mineral_constraint,option)
1303)
1304) ! surface complexes
1305) call SrfCplxProcessConstraint(reaction%surface_complexation, &
1306) constraint_name, &
1307) srfcplx_constraint,option)
1308)
1309) ! microbial immobile
1310) call ImmobileProcessConstraint(reaction%immobile,constraint_name, &
1311) immobile_constraint,option)
1312)
1313) end subroutine ReactionProcessConstraint
1314)
1315) ! ************************************************************************** !
1316)
1317) subroutine ReactionEquilibrateConstraint(rt_auxvar,global_auxvar, &
1318) material_auxvar, &
1319) reaction,constraint_name, &
1320) aq_species_constraint, &
1321) free_ion_guess_constraint, &
1322) mineral_constraint, &
1323) srfcplx_constraint, &
1324) colloid_constraint, &
1325) immobile_constraint, &
1326) num_iterations, &
1327) use_prev_soln_as_guess,option)
1328) !
1329) ! Equilibrates constraint concentrations
1330) ! with prescribed geochemistry
1331) !
1332) ! Author: Glenn Hammond
1333) ! Date: 10/22/08
1334) !
1335) use Option_module
1336) use Input_Aux_module
1337) use String_module
1338) use Utility_module
1339) use Transport_Constraint_module
1340) use EOS_Water_module
1341) use Material_Aux_class
1342)
1343) ! CO2-specific
1344) use co2eos_module, only: Henry_duan_sun
1345) use co2_span_wagner_module, only: co2_span_wagner
1346)
1347) implicit none
1348)
1349) type(reactive_transport_auxvar_type) :: rt_auxvar
1350) type(global_auxvar_type) :: global_auxvar
1351) class(material_auxvar_type) :: material_auxvar
1352) type(reaction_type), pointer :: reaction
1353) character(len=MAXWORDLENGTH) :: constraint_name
1354) type(aq_species_constraint_type), pointer :: aq_species_constraint
1355) type(guess_constraint_type), pointer :: free_ion_guess_constraint
1356) type(mineral_constraint_type), pointer :: mineral_constraint
1357) type(srfcplx_constraint_type), pointer :: srfcplx_constraint
1358) type(colloid_constraint_type), pointer :: colloid_constraint
1359) type(immobile_constraint_type), pointer :: immobile_constraint
1360) PetscInt :: num_iterations
1361)
1362) PetscBool :: use_prev_soln_as_guess
1363) type(option_type) :: option
1364)
1365) character(len=MAXSTRINGLENGTH) :: string
1366) PetscInt :: icomp, jcomp, kcomp
1367) PetscInt :: imnrl, jmnrl
1368) PetscInt :: icplx
1369) PetscInt :: irxn, isite, ncplx, k, ikinrxn
1370) PetscInt :: igas
1371) PetscReal :: conc(reaction%naqcomp)
1372) PetscInt :: constraint_type(reaction%naqcomp)
1373) character(len=MAXWORDLENGTH) :: constraint_aux_string(reaction%naqcomp)
1374) type(surface_complexation_type), pointer :: surface_complexation
1375) type(mineral_type), pointer :: mineral_reaction
1376)
1377) PetscReal :: Res(reaction%naqcomp)
1378) PetscReal :: update(reaction%naqcomp)
1379) PetscReal :: total_conc(reaction%naqcomp)
1380) PetscReal :: free_conc(reaction%naqcomp)
1381) PetscReal :: Jac(reaction%naqcomp,reaction%naqcomp)
1382) PetscInt :: indices(reaction%naqcomp)
1383) PetscReal :: norm
1384) PetscReal :: maximum_residual, maximum_relative_change
1385) PetscReal :: ratio, min_ratio
1386) PetscReal :: prev_molal(reaction%naqcomp)
1387) PetscBool :: compute_activity_coefs
1388)
1389) PetscInt :: constraint_id(reaction%naqcomp)
1390) PetscReal :: lnQK, QK
1391) PetscReal :: tempreal
1392) PetscReal :: pres, tc, xphico2, henry, m_na, m_cl, xmass
1393) PetscInt :: comp_id
1394) PetscReal :: convert_molal_to_molar
1395) PetscReal :: convert_molar_to_molal
1396)
1397) PetscBool :: charge_balance_warning_flag = PETSC_FALSE
1398) PetscBool :: use_log_formulation
1399)
1400) PetscReal :: Jac_num(reaction%naqcomp)
1401) PetscReal :: Res_pert, pert, prev_value, coh0
1402)
1403) PetscInt :: iphase
1404) PetscInt :: idof
1405) PetscInt :: istartaq, iendaq
1406) PetscInt :: irate
1407)
1408) PetscInt :: num_it_act_coef_turned_on
1409)
1410) ! CO2-specific
1411) PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
1412) yco2,pco2,sat_pressure,lngamco2
1413) PetscInt :: iflag
1414) PetscErrorCode :: ierr
1415)
1416) surface_complexation => reaction%surface_complexation
1417) mineral_reaction => reaction%mineral
1418)
1419) constraint_type = aq_species_constraint%constraint_type
1420) constraint_aux_string = aq_species_constraint%constraint_aux_string
1421) constraint_id = aq_species_constraint%constraint_spec_id
1422) conc = aq_species_constraint%constraint_conc
1423)
1424) istartaq = reaction%offset_aqueous
1425) iendaq = reaction%offset_aqueous + reaction%naqcomp
1426)
1427) iphase = 1
1428)
1429) xmass = 1.d0
1430) if (associated(global_auxvar%xmass)) xmass = global_auxvar%xmass(iphase)
1431)
1432) if (reaction%initialize_with_molality) then
1433) convert_molal_to_molar = global_auxvar%den_kg(iphase)*xmass/1000.d0
1434) convert_molar_to_molal = 1.d0
1435) else
1436) convert_molal_to_molar = 1.d0
1437) convert_molar_to_molal = 1000.d0/global_auxvar%den_kg(iphase)/xmass
1438) endif
1439)
1440) !geh: We do need this setting of mineral volume fractions. If not specified
1441) ! by a dataset, we must set the volume fraction and areas so that
1442) ! surface complexation is scaled correctly. Yes, these will get
1443) ! overwrittent with the same values when called from
1444) ! CondControlAssignTranInitCond(), but big deal.
1445) if (associated(mineral_constraint)) then
1446) do imnrl = 1, mineral_reaction%nkinmnrl
1447) ! if read from a dataset, the mineral volume frac has already been set.
1448) if (.not.mineral_constraint%external_vol_frac_dataset(imnrl)) then
1449) rt_auxvar%mnrl_volfrac0(imnrl) = &
1450) mineral_constraint%constraint_vol_frac(imnrl)
1451) rt_auxvar%mnrl_volfrac(imnrl) = &
1452) mineral_constraint%constraint_vol_frac(imnrl)
1453) endif
1454) if (.not.mineral_constraint%external_area_dataset(imnrl)) then
1455) rt_auxvar%mnrl_area0(imnrl) = &
1456) mineral_constraint%constraint_area(imnrl)
1457) rt_auxvar%mnrl_area(imnrl) = &
1458) mineral_constraint%constraint_area(imnrl)
1459) endif
1460) enddo
1461) endif
1462)
1463) if (associated(colloid_constraint)) then
1464) colloid_constraint%basis_conc_mob = colloid_constraint%constraint_conc_mob
1465) colloid_constraint%basis_conc_imb = colloid_constraint%constraint_conc_imb
1466) rt_auxvar%colloid%conc_mob = colloid_constraint%basis_conc_mob* &
1467) convert_molar_to_molal
1468) !TODO(geh): this can't be correct as immobile concentrations are mol/m^3
1469) rt_auxvar%colloid%conc_imb = colloid_constraint%basis_conc_imb* &
1470) convert_molar_to_molal
1471) endif
1472)
1473) if (.not.reaction%use_full_geochemistry) then
1474) aq_species_constraint%basis_molarity = conc ! don't need to convert
1475) rt_auxvar%pri_molal = aq_species_constraint%basis_molarity* &
1476) convert_molar_to_molal
1477) rt_auxvar%total(:,iphase) = aq_species_constraint%basis_molarity
1478) return
1479) endif
1480)
1481) if (.not.option%use_isothermal) then
1482) call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_TRUE,option)
1483) endif
1484)
1485) if (use_prev_soln_as_guess) then
1486) free_conc = rt_auxvar%pri_molal
1487) else if (associated(free_ion_guess_constraint)) then
1488) free_conc = free_ion_guess_constraint%conc
1489) else
1490) free_conc = 1.d-9
1491) endif
1492) total_conc = 0.d0
1493) do icomp = 1, reaction%naqcomp
1494) select case(constraint_type(icomp))
1495) case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
1496) ! units = mol/L
1497) total_conc(icomp) = conc(icomp)*convert_molal_to_molar
1498) ! free_conc guess set above
1499) case(CONSTRAINT_TOTAL_SORB)
1500) ! units = mol/m^3 bulk
1501) total_conc(icomp) = conc(icomp)
1502) case(CONSTRAINT_FREE)
1503) free_conc(icomp) = conc(icomp)*convert_molar_to_molal
1504) case(CONSTRAINT_LOG)
1505) free_conc(icomp) = (10.d0**conc(icomp))*convert_molar_to_molal
1506) case(CONSTRAINT_CHARGE_BAL)
1507) if (.not.use_prev_soln_as_guess) then
1508) free_conc(icomp) = conc(icomp)*convert_molar_to_molal ! just a guess
1509) endif
1510) case(CONSTRAINT_PH)
1511) ! check if H+ id set
1512) if (associated(reaction%species_idx)) then
1513) if (reaction%species_idx%h_ion_id /= 0) then
1514) ! check if icomp is H+
1515) if (reaction%species_idx%h_ion_id /= icomp) then
1516) string = 'OH-'
1517) if (.not.StringCompare(reaction%primary_species_names(icomp), &
1518) string,MAXWORDLENGTH)) then
1519) option%io_buffer = &
1520) 'pH specified as constraint (constraint =' // &
1521) trim(constraint_name) // &
1522) ') for species other than H+ or OH-: ' // &
1523) trim(reaction%primary_species_names(icomp))
1524) call printErrMsg(option)
1525) endif
1526) endif
1527) free_conc(icomp) = 10.d0**(-conc(icomp))
1528) else
1529) option%io_buffer = &
1530) 'pH specified as constraint (constraint =' // &
1531) trim(constraint_name) // &
1532) '), but H+ not found in chemical species.'
1533) call printErrMsg(option)
1534) endif
1535) endif
1536) case(CONSTRAINT_MINERAL)
1537) if (.not.use_prev_soln_as_guess) then
1538) free_conc(icomp) = conc(icomp)*convert_molar_to_molal ! guess
1539) endif
1540) case(CONSTRAINT_GAS, CONSTRAINT_SUPERCRIT_CO2)
1541) if (conc(icomp) <= 0.d0) then ! log form
1542) conc(icomp) = 10.d0**conc(icomp) ! conc log10 partial pressure gas
1543) endif
1544) ! free_conc guess set above
1545) end select
1546) enddo
1547)
1548) rt_auxvar%pri_molal = free_conc
1549)
1550) num_iterations = 0
1551) num_it_act_coef_turned_on = 0
1552)
1553) ! if previous solution is provided as a guess, it should be close enough
1554) ! to use activity coefficients right away. - geh
1555) ! essentially the same as:
1556) ! compute_activity_coefficients = (use_prev_soln_as_guess == PETSC_TRUE)
1557) compute_activity_coefs = use_prev_soln_as_guess
1558)
1559) do
1560)
1561) if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF .and. &
1562) compute_activity_coefs) then
1563) call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
1564) if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
1565) call CO2AqActCoeff(rt_auxvar,global_auxvar,reaction,option)
1566) endif
1567) endif
1568) call RTotal(rt_auxvar,global_auxvar,reaction,option)
1569) if (reaction%nsorb > 0) then
1570) if (reaction%neqsorb > 0) then
1571) call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
1572) endif
1573) if (reaction%surface_complexation%nkinmrsrfcplx > 0) then
1574) call RTotalSorbMultiRateAsEQ(rt_auxvar,global_auxvar,material_auxvar, &
1575) reaction,option)
1576) endif
1577) endif
1578)
1579) ! geh - for debugging
1580) !call RTPrintAuxVar(rt_auxvar,reaction,option)
1581)
1582) Jac = 0.d0
1583)
1584) ! for colloids later on
1585) ! if (reaction%ncoll > 0) then
1586) ! do idof = istartcoll, iendcoll
1587) ! Jac(idof,idof) = 1.d0
1588) ! enddo
1589) ! endif
1590)
1591) do icomp = 1, reaction%naqcomp
1592)
1593) select case(constraint_type(icomp))
1594)
1595) case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
1596)
1597) ! units = mol/L water
1598) Res(icomp) = rt_auxvar%total(icomp,1) - total_conc(icomp)
1599) ! dtotal units = kg water/L water
1600)
1601) ! Jac units = kg water/L water
1602) Jac(icomp,:) = rt_auxvar%aqueous%dtotal(icomp,:,1)
1603)
1604) case(CONSTRAINT_TOTAL_SORB)
1605)
1606) ! units = mol/m^3 bulk
1607) Res(icomp) = rt_auxvar%total_sorb_eq(icomp) - total_conc(icomp)
1608) ! dtotal_sorb units = kg water/m^3 bulk
1609) ! Jac units = kg water/m^3 bulk
1610) Jac(icomp,:) = rt_auxvar%dtotal_sorb_eq(icomp,:)
1611)
1612) case(CONSTRAINT_FREE,CONSTRAINT_LOG)
1613)
1614) Res(icomp) = 0.d0
1615) Jac(icomp,:) = 0.d0
1616) ! Jac(:,icomp) = 0.d0
1617) Jac(icomp,icomp) = 1.d0
1618)
1619) case(CONSTRAINT_CHARGE_BAL)
1620)
1621) Res(icomp) = 0.d0
1622) Jac(icomp,:) = 0.d0
1623) do jcomp = 1, reaction%naqcomp
1624) Res(icomp) = Res(icomp) + reaction%primary_spec_Z(jcomp) * &
1625) rt_auxvar%total(jcomp,1)
1626) do kcomp = 1, reaction%naqcomp
1627) Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
1628) reaction%primary_spec_Z(kcomp)*rt_auxvar%aqueous%dtotal(kcomp,jcomp,1)
1629) enddo
1630) enddo
1631) if (rt_auxvar%pri_molal(icomp) < 1.d-20 .and. &
1632) .not.charge_balance_warning_flag) then
1633) if ((Res(icomp) > 0.d0 .and. &
1634) reaction%primary_spec_Z(icomp) > 0.d0) .or. &
1635) (Res(icomp) < 0.d0 .and. &
1636) reaction%primary_spec_Z(icomp) < 0.d0)) then
1637) option%io_buffer = &
1638) 'Charge balance species ' // &
1639) trim(reaction%primary_species_names(icomp)) // &
1640) ' may not satisfy constraint ' // &
1641) trim(constraint_name) // &
1642) '. Molality already below 1.e-20.'
1643) call printMsg(option)
1644) charge_balance_warning_flag = PETSC_TRUE
1645) rt_auxvar%pri_molal(icomp) = 1.e-3 ! reset guess
1646) endif
1647) endif
1648)
1649) case(CONSTRAINT_PH)
1650)
1651) Res(icomp) = 0.d0
1652) Jac(icomp,:) = 0.d0
1653) if (associated(reaction%species_idx)) then
1654) if (reaction%species_idx%h_ion_id > 0) then ! conc(icomp) = 10**-pH
1655) rt_auxvar%pri_molal(icomp) = 10.d0**(-conc(icomp)) / &
1656) rt_auxvar%pri_act_coef(icomp)
1657) Jac(icomp,icomp) = 1.d0
1658) else ! H+ is a complex
1659)
1660) icplx = abs(reaction%species_idx%h_ion_id)
1661)
1662) ! compute secondary species concentration
1663) ! *note that the sign was flipped below
1664) lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
1665)
1666) ! activity of water
1667) if (reaction%eqcplxh2oid(icplx) > 0) then
1668) lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
1669) endif
1670)
1671) do jcomp = 1, reaction%eqcplxspecid(0,icplx)
1672) comp_id = reaction%eqcplxspecid(jcomp,icplx)
1673) lnQK = lnQK + reaction%eqcplxstoich(jcomp,icplx)* &
1674) log(rt_auxvar%pri_molal(comp_id)* &
1675) rt_auxvar%pri_act_coef(comp_id))
1676) enddo
1677) lnQK = lnQK + conc(icomp)*LOG_TO_LN ! this is log activity H+
1678) QK = exp(lnQK)
1679)
1680) Res(icomp) = 1.d0 - QK
1681)
1682) do jcomp = 1,reaction%eqcplxspecid(0,icplx)
1683) comp_id = reaction%eqcplxspecid(jcomp,icplx)
1684) Jac(icomp,comp_id) = -QK/rt_auxvar%pri_molal(comp_id)* &
1685) reaction%eqcplxstoich(jcomp,icplx)
1686) enddo
1687) endif
1688) endif
1689)
1690) case(CONSTRAINT_MINERAL)
1691)
1692) imnrl = constraint_id(icomp)
1693) lnQK = -mineral_reaction%mnrl_logK(imnrl)*LOG_TO_LN
1694)
1695) ! activity of water
1696) if (mineral_reaction%mnrlh2oid(imnrl) > 0) then
1697) lnQK = lnQK + mineral_reaction%mnrlh2ostoich(imnrl)*rt_auxvar%ln_act_h2o
1698) endif
1699)
1700) ! compute ion activity product
1701) do jcomp = 1, mineral_reaction%mnrlspecid(0,imnrl)
1702) comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
1703) lnQK = lnQK + mineral_reaction%mnrlstoich(jcomp,imnrl)* &
1704) log(rt_auxvar%pri_molal(comp_id)* &
1705) rt_auxvar%pri_act_coef(comp_id))
1706) enddo
1707)
1708) Res(icomp) = lnQK
1709)
1710) do jcomp = 1,mineral_reaction%mnrlspecid(0,imnrl)
1711) comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
1712) Jac(icomp,comp_id) = mineral_reaction%mnrlstoich(jcomp,imnrl)/ &
1713) rt_auxvar%pri_molal(comp_id)
1714) enddo
1715)
1716) case(CONSTRAINT_GAS)
1717)
1718) igas = constraint_id(icomp)
1719) lnQK = -reaction%eqgas_logK(igas)*LOG_TO_LN
1720)
1721) ! divide K by RT
1722) !lnQK = lnQK - log((auxvar%temp+273.15d0)*IDEAL_GAS_CONSTANT)
1723)
1724) ! activity of water
1725) if (reaction%eqgash2oid(igas) > 0) then
1726) lnQK = lnQK + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
1727) endif
1728)
1729) ! compute ion activity product
1730) do jcomp = 1, reaction%eqgasspecid(0,igas)
1731) comp_id = reaction%eqgasspecid(jcomp,igas)
1732) lnQK = lnQK + reaction%eqgasstoich(jcomp,igas)* &
1733) log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
1734) enddo
1735)
1736) ! QK = exp(lnQK)
1737)
1738) ! Res(icomp) = QK - conc(icomp)
1739) Res(icomp) = lnQK - log(conc(icomp)) ! gas pressure
1740) Jac(icomp,:) = 0.d0
1741) do jcomp = 1,reaction%eqgasspecid(0,igas)
1742) comp_id = reaction%eqgasspecid(jcomp,igas)
1743) ! Jac(icomp,comp_id) = QK/auxvar%primary_spec(comp_id)* &
1744) ! reaction%eqgasstoich(jcomp,igas)
1745) Jac(icomp,comp_id) = reaction%eqgasstoich(jcomp,igas)/ &
1746) rt_auxvar%pri_molal(comp_id)
1747) enddo
1748)
1749) ! CO2-specific
1750) case(CONSTRAINT_SUPERCRIT_CO2)
1751)
1752) igas = constraint_id(icomp)
1753)
1754) ! compute secondary species concentration
1755) if (abs(reaction%species_idx%co2_gas_id) == igas) then
1756)
1757) ! pres = global_auxvar%pres(2)
1758) pres = conc(icomp)*1.D5
1759) global_auxvar%pres(2) = pres
1760)
1761) tc = global_auxvar%temp
1762)
1763) call EOSWaterSaturationPressure(tc, sat_pressure, ierr)
1764)
1765) pco2 = conc(icomp)*1.e5
1766) ! pco2 = pres - sat_pressure
1767)
1768) pres = pco2 + sat_pressure
1769) yco2 = pco2/pres
1770)
1771) iflag = 1
1772) call co2_span_wagner(pres*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
1773) dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,iflag,option%itable)
1774)
1775) ! call co2_span_wagner(pco2*1D-6,tc+273.15D0,dg,dddt,dddp,fg, &
1776) ! dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,option%itable)
1777)
1778) global_auxvar%den_kg(2) = dg
1779)
1780) !compute fugacity coefficient
1781) fg = fg*1.D6
1782) xphico2 = fg / pres
1783) global_auxvar%fugacoeff(1) = xphico2
1784)
1785) m_na = 0.d0
1786) m_cl = 0.d0
1787) if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
1788) m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
1789) m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
1790) ! call Henry_duan_sun(tc,pco2*1D-5,henry,lngamco2,m_na,m_cl)
1791) call Henry_duan_sun(tc,pres*1D-5,henry,lngamco2,m_na,m_cl)
1792) else
1793) call Henry_duan_sun(tc,pres*1D-5,henry,lngamco2, &
1794) option%m_nacl,option%m_nacl)
1795) ! print *, 'SC: mnacl=', option%m_nacl,'stioh2o=',reaction%eqgash2ostoich(igas)
1796) endif
1797)
1798) lnQk = -log(xphico2*henry)-lngamco2
1799)
1800) reaction%eqgas_logK(igas) = -lnQK*LN_TO_LOG
1801) ! reaction%scco2_eq_logK = -lnQK*LN_TO_LOG
1802) !geh: scco2_eq_logK is only used in one location. Why add to global_auxvar???
1803) !geh global_auxvar%scco2_eq_logK = -lnQK*LN_TO_LOG
1804)
1805) ! activity of water
1806) if (reaction%eqgash2oid(igas) > 0) then
1807) lnQK = lnQK + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
1808) endif
1809) do jcomp = 1, reaction%eqgasspecid(0,igas)
1810) comp_id = reaction%eqgasspecid(jcomp,igas)
1811) lnQK = lnQK + reaction%eqgasstoich(jcomp,igas)* &
1812) ! log(rt_auxvar%pri_molal(comp_id))
1813) log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
1814) ! print *,'SC: ',rt_auxvar%pri_molal(comp_id), &
1815) ! rt_auxvar%pri_act_coef(comp_id),exp(lngamco2)
1816) enddo
1817)
1818) ! QK = exp(lnQK)
1819)
1820) Res(icomp) = lnQK - log(pco2*1D-5) ! gas pressure bars
1821) Jac(icomp,:) = 0.d0
1822) do jcomp = 1,reaction%eqgasspecid(0,igas)
1823) comp_id = reaction%eqgasspecid(jcomp,igas)
1824) ! Jac(icomp,comp_id) = QK/auxvar%primary_spec(comp_id)* &
1825) ! reaction%eqgasstoich(jcomp,igas)
1826) Jac(icomp,comp_id) = reaction%eqgasstoich(jcomp,igas)/ &
1827) rt_auxvar%pri_molal(comp_id)
1828)
1829) enddo
1830) endif
1831) ! end CO2-specific
1832) end select
1833) enddo
1834)
1835) maximum_residual = maxval(abs(Res))
1836)
1837) if (reaction%use_log_formulation) then
1838) ! force at least 4 log updates, then cycle the next 5 updates between
1839) ! log/linear. This improves convergence of linear problems or
1840) ! primary components with no complexes, reactions, etc. (e.g. tracers)
1841) if (num_iterations > 3 .and. num_iterations < 9) then
1842) use_log_formulation = (mod(num_iterations,2) == 0)
1843) else
1844) use_log_formulation = PETSC_TRUE
1845) endif
1846) else
1847) use_log_formulation = PETSC_FALSE
1848) endif
1849)
1850) call RSolve(Res,Jac,rt_auxvar%pri_molal,update,reaction%naqcomp, &
1851) use_log_formulation)
1852)
1853) prev_molal = rt_auxvar%pri_molal
1854)
1855) if (use_log_formulation) then
1856) update = dsign(1.d0,update)*min(dabs(update),reaction%max_dlnC)
1857) rt_auxvar%pri_molal = rt_auxvar%pri_molal*exp(-update)
1858) else ! linear update
1859) ! ensure non-negative concentration
1860) min_ratio = 1.d20 ! large number
1861) do icomp = 1, reaction%naqcomp
1862) if (prev_molal(icomp) <= update(icomp)) then
1863) ratio = abs(prev_molal(icomp)/update(icomp))
1864) if (ratio < min_ratio) min_ratio = ratio
1865) endif
1866) enddo
1867) if (min_ratio <= 1.d0) then
1868) ! scale by 0.99 to make the update slightly smaller than the min_ratio
1869) update = update*min_ratio*0.99d0
1870) endif
1871) rt_auxvar%pri_molal = prev_molal - update
1872) ! could use:
1873) ! rt_auxvar%pri_molal = prev_molal - update * minval(abs(prev_molal/update))
1874) endif
1875)
1876) ! check to ensure that minimum concentration is not less than or equal
1877) ! to zero
1878) tempreal = minval(rt_auxvar%pri_molal)
1879) if (tempreal <= 0.d0) then
1880) option%io_buffer = 'ERROR: Zero concentrations found in ' // &
1881) 'constraint "' // trim(constraint_name) // '".'
1882) call printMsgByRank(option)
1883) ! now figure out which species have zero concentrations
1884) do idof = 1, reaction%naqcomp
1885) if (rt_auxvar%pri_molal(idof) <= 0.d0) then
1886) write(string,*) rt_auxvar%pri_molal(idof)
1887) option%io_buffer = ' Species "' // &
1888) trim(reaction%primary_species_names(idof)) // &
1889) '" has zero concentration (' // &
1890) trim(adjustl(string)) // ').'
1891) call printMsgByRank(option)
1892) endif
1893) enddo
1894) option%io_buffer = 'Free ion concentations RESULTING from ' // &
1895) 'constraint concentrations must be positive.'
1896) call printErrMsgByRank(option)
1897) endif
1898)
1899) #if 0
1900) !geh cannot use this check as for many problems (e.g. Hanford 300 Area U), the
1901) ! concentrations temporarily go well above 100.
1902)
1903) ! check for excessively large maximum values, which likely indicates
1904) ! reaction going awry.
1905) tempreal = maxval(rt_auxvar%pri_molal)
1906) ! allow a few iterations; sometime charge balance constraint jumps
1907) ! during initial iterations
1908) if (tempreal > 100.d0 .and. num_iterations > 500) then
1909) !geh: for some reason, needs the array rank included in call to maxloc
1910) idof = maxloc(rt_auxvar%pri_molal,1)
1911) option%io_buffer = 'ERROR: Excessively large concentration for ' // &
1912) 'species "' // trim(reaction%primary_species_names(idof)) // &
1913) '" in constraint "' // trim(constraint_name) // &
1914) '" in ReactionEquilibrateConstraint. Email input deck to ' // &
1915) 'pflotran-dev@googlegroups.com.'
1916) call printErrMsg(option)
1917) endif
1918) #endif
1919)
1920) maximum_relative_change = maxval(abs((rt_auxvar%pri_molal-prev_molal)/ &
1921) prev_molal))
1922)
1923) num_iterations = num_iterations + 1
1924)
1925) if (mod(num_iterations,1000) == 0) then
1926) 100 format('Constraint iteration count has exceeded: ',i5)
1927) write(option%io_buffer,100) num_iterations
1928) call printMsg(option)
1929) do icomp=1,reaction%naqcomp
1930) write(option%io_buffer,200) reaction%primary_species_names(icomp), &
1931) prev_molal(icomp),Res(icomp)
1932) call printMsg(option)
1933) enddo
1934) 200 format(a12,1x,1p2e12.4)
1935) if (num_iterations >= 10000) then
1936) print *, 'cell id (natural):', option%iflag
1937) print *, 'constraint:', conc
1938) print *, 'constraint type:', constraint_type
1939) print *, 'free_conc:', free_conc
1940) option%io_buffer = 'Equilibration of constraint "' // &
1941) trim(constraint_name) // &
1942) '" stopping due to excessive iteration count!'
1943) call printErrMsgByRank(option)
1944) endif
1945) endif
1946)
1947) ! check for convergence
1948) if (maximum_residual < reaction%max_residual_tolerance .and. &
1949) maximum_relative_change < reaction%max_relative_change_tolerance) then
1950) ! Need some sort of convergence before we kick in activities
1951) if (compute_activity_coefs .and. &
1952) ! With some constraints (e.g. pH), the total component concentration
1953) ! is not updated immediately after activity coefficients are turned
1954) ! on. Therefore, we need at least two iterations to declare
1955) ! convergence. - geh
1956) num_iterations - num_it_act_coef_turned_on > 1) exit
1957) if (.not. compute_activity_coefs) &
1958) num_it_act_coef_turned_on = num_iterations
1959) compute_activity_coefs = PETSC_TRUE
1960) endif
1961)
1962) enddo
1963)
1964) ! once equilibrated, compute sorbed concentrations
1965) if (reaction%nsorb > 0) then
1966) if (reaction%neqsorb > 0) then
1967) call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
1968) endif
1969) if (reaction%surface_complexation%nkinmrsrfcplx > 0) then
1970) call RTotalSorbMultiRateAsEQ(rt_auxvar,global_auxvar,material_auxvar, &
1971) reaction,option)
1972) endif
1973) endif
1974)
1975) ! WARNING: below assumes site concentration multiplicative factor
1976) if (surface_complexation%nsrfcplxrxn > 0) then
1977) do irxn = 1, surface_complexation%nkinmrsrfcplxrxn
1978) do irate = 1, surface_complexation%kinmr_nrate(irxn)
1979) rt_auxvar%kinmr_total_sorb(:,irate,irxn) = &
1980) surface_complexation%kinmr_frac(irate,irxn) * &
1981) rt_auxvar%kinmr_total_sorb(:,0,irxn)
1982) enddo
1983) enddo
1984)
1985) if (surface_complexation%nkinsrfcplx > 0 .and. &
1986) associated(srfcplx_constraint)) then
1987) ! compute surface complex conc. at new time step (5.1-30)
1988) rt_auxvar%kinsrfcplx_conc(:,1) = srfcplx_constraint%constraint_conc
1989) do ikinrxn = 1, surface_complexation%nkinsrfcplxrxn
1990) irxn = surface_complexation%kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
1991) isite = surface_complexation%srfcplxrxn_to_surf(irxn)
1992) rt_auxvar%kinsrfcplx_free_site_conc(isite) = surface_complexation%srfcplxrxn_site_density(isite)
1993) ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
1994) do k = 1, ncplx ! ncplx in rxn
1995) icplx = surface_complexation%srfcplxrxn_to_complex(k,irxn)
1996) rt_auxvar%kinsrfcplx_free_site_conc(isite) = &
1997) rt_auxvar%kinsrfcplx_free_site_conc(isite) - &
1998) rt_auxvar%kinsrfcplx_conc(icplx,ikinrxn)
1999) enddo
2000) enddo
2001) do ikinrxn = 1, surface_complexation%nkinsrfcplxrxn
2002) irxn = surface_complexation%kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
2003) isite = surface_complexation%srfcplxrxn_to_surf(irxn)
2004) if (rt_auxvar%kinsrfcplx_free_site_conc(isite) < 0.d0) then
2005) option%io_buffer = 'Free site concentration for site ' // &
2006) trim(surface_complexation%srfcplxrxn_site_names(isite)) // &
2007) ' is less than zero.'
2008) call printErrMsgByRank(option)
2009) endif
2010) enddo
2011) srfcplx_constraint%basis_free_site_conc = &
2012) rt_auxvar%kinsrfcplx_free_site_conc
2013) endif
2014) endif
2015)
2016) ! do not scale by molal_to_molar since it could be 1.d0 if MOLAL flag set
2017) aq_species_constraint%basis_molarity = rt_auxvar%pri_molal* &
2018) global_auxvar%den_kg(option%liquid_phase)/ &
2019) 1000.d0
2020)
2021) #if 0
2022) call RCalculateCompression(global_auxvar,rt_auxvar,reaction,option)
2023) #endif
2024)
2025) ! this is performed above
2026) ! if (associated(colloid_constraint%colloids)) then
2027) ! colloid_constraint%colloids%basis_conc_mob = rt_auxvar%colloid%conc_mob* &
2028) ! global_auxvar%den_kg(option%liquid_phase)/1000.d0
2029) ! colloid_constraint%colloids%basis_conc_imb = rt_auxvar%colloid%conc_imb* &
2030) ! global_auxvar%den_kg(option%liquid_phase)/1000.d0
2031) ! endif
2032)
2033) ! write(option%io_buffer,111) trim(constraint_name),num_iterations
2034) ! call printMsg(option)
2035) !111 format(' Equilibrate Constraint: ',a30,i4)
2036)
2037) end subroutine ReactionEquilibrateConstraint
2038)
2039) ! ************************************************************************** !
2040)
2041) subroutine ReactionPrintConstraint(constraint_coupler,reaction,option)
2042) !
2043) ! Prints a constraint associated with reactive
2044) ! transport
2045) !
2046) ! Author: Glenn Hammond
2047) ! Date: 10/28/08
2048) !
2049)
2050) use Option_module
2051) use Input_Aux_module
2052) use String_module
2053) use Transport_Constraint_module
2054)
2055) implicit none
2056)
2057) type(option_type) :: option
2058) type(tran_constraint_coupler_type) :: constraint_coupler
2059) type(reaction_type), pointer :: reaction
2060)
2061) type(reactive_transport_auxvar_type), pointer :: rt_auxvar
2062) type(global_auxvar_type), pointer :: global_auxvar
2063) type(aq_species_constraint_type), pointer :: aq_species_constraint
2064) type(mineral_constraint_type), pointer :: mineral_constraint
2065) type(surface_complexation_type), pointer :: surface_complexation
2066) type(mineral_type), pointer :: mineral_reaction
2067) character(len=MAXSTRINGLENGTH) :: string
2068) PetscInt :: i, icomp, irxn, j, jj, ncomp, ncplx, ieqrxn
2069) PetscInt :: icplx, icplx2
2070) PetscInt :: imnrl,igas
2071) PetscInt :: eqcplxsort(reaction%neqcplx+1)
2072) PetscInt :: eqcplxid(reaction%neqcplx+1)
2073) PetscInt :: eqminsort(reaction%mineral%nmnrl)
2074) PetscInt, allocatable :: eqsrfcplxsort(:)
2075) PetscBool :: finished, found
2076) PetscReal :: conc, conc2
2077) PetscReal :: lnQK(reaction%mineral%nmnrl), QK(reaction%mineral%nmnrl)
2078) PetscReal :: lnQKgas(reaction%ngas), QKgas(reaction%ngas)
2079) PetscReal :: charge_balance, ionic_strength
2080) PetscReal :: percent(reaction%neqcplx+1)
2081) PetscReal :: totj, retardation, kd, ph
2082) PetscInt :: comp_id, jcomp
2083) PetscInt :: icount
2084) PetscInt :: iphase, ifo2
2085) PetscReal :: bulk_vol_to_fluid_vol, molar_to_molal, molal_to_molar
2086) PetscReal :: sum_molality, sum_mass, mole_fraction_h2o, mass_fraction_h2o, &
2087) mass_fraction_co2, mole_fraction_co2
2088) PetscReal :: ehfac,eh,pe,tk
2089) PetscReal :: affinity
2090)
2091) aq_species_constraint => constraint_coupler%aqueous_species
2092) mineral_constraint => constraint_coupler%minerals
2093)
2094) iphase = 1
2095)
2096) 90 format(2x,76('-'))
2097) 91 format(a)
2098)
2099) write(option%fid_out,'(/,'' Constraint: '',a)') &
2100) trim(constraint_coupler%constraint_name)
2101)
2102) rt_auxvar => constraint_coupler%rt_auxvar
2103) global_auxvar => constraint_coupler%global_auxvar
2104) surface_complexation => reaction%surface_complexation
2105) mineral_reaction => reaction%mineral
2106)
2107) select case(option%iflowmode)
2108) case(FLASH2_MODE,MPH_MODE,IMS_MODE,MIS_MODE)
2109) case(NULL_MODE)
2110) global_auxvar%den_kg(iphase) = option%reference_water_density
2111) global_auxvar%temp = option%reference_temperature
2112) global_auxvar%sat(iphase) = option%reference_saturation
2113) case(RICHARDS_MODE)
2114) global_auxvar%temp = option%reference_temperature
2115) end select
2116)
2117) ! global_auxvar%den_kg(iphase) = option%reference_water_density
2118) ! global_auxvar%temp = option%reference_temperature
2119) ! global_auxvar%sat(iphase) = option%reference_saturation
2120) bulk_vol_to_fluid_vol = option%reference_porosity* &
2121) global_auxvar%sat(iphase)*1000.d0
2122)
2123) ! compute mole and mass fractions of H2O
2124) if (reaction%use_full_geochemistry) then
2125) sum_molality = 0.d0
2126) do icomp = 1, reaction%naqcomp
2127) if (icomp /= reaction%species_idx%h2o_aq_id) then
2128) sum_molality = sum_molality + rt_auxvar%pri_molal(icomp)
2129) endif
2130) enddo
2131) if (reaction%neqcplx > 0) then
2132) do i = 1, reaction%neqcplx
2133) sum_molality = sum_molality + rt_auxvar%sec_molal(i)
2134) enddo
2135) endif
2136) mole_fraction_h2o = 1.d0/(1.d0+FMWH2O*sum_molality*1.d-3)
2137)
2138) sum_mass = 0.d0
2139) do icomp = 1, reaction%naqcomp
2140) if (icomp /= reaction%species_idx%h2o_aq_id) then
2141) sum_mass = sum_mass + &
2142) reaction%primary_spec_molar_wt(icomp)*rt_auxvar%pri_molal(icomp)
2143) endif
2144) enddo
2145) if (reaction%neqcplx > 0) then
2146) do i = 1, reaction%neqcplx
2147) sum_mass = sum_mass + reaction%eqcplx_molar_wt(i)*rt_auxvar%sec_molal(i)
2148) enddo
2149) endif
2150) mass_fraction_h2o = 1.d0/(1.d0 + sum_mass*1.d-3)
2151) endif
2152)
2153) molal_to_molar = global_auxvar%den_kg(iphase)/1000.d0
2154) molar_to_molal = 1.d0/molal_to_molar
2155)
2156) if (.not.reaction%use_full_geochemistry) then
2157) 100 format(/,' species molality')
2158) write(option%fid_out,100)
2159) 101 format(2x,a12,es12.4)
2160) do icomp = 1, reaction%naqcomp
2161) write(option%fid_out,101) reaction%primary_species_names(icomp), &
2162) rt_auxvar%pri_molal(icomp)
2163) enddo
2164) else
2165)
2166) ! CO2-specific
2167) if (.not.option%use_isothermal .and. &
2168) (option%iflowmode == MPH_MODE .or. &
2169) option%iflowmode == FLASH2_MODE)) then
2170) call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_TRUE,option)
2171) if (associated(reaction%eqgas_logKcoef)) then
2172) do i = 1, reaction%naqcomp
2173) if (aq_species_constraint%constraint_type(i) == &
2174) CONSTRAINT_SUPERCRIT_CO2) then
2175) igas = aq_species_constraint%constraint_spec_id(i)
2176) if (abs(reaction%species_idx%co2_gas_id) == igas) then
2177) option%io_buffer = 'Adding "scco2_eq_logK" to ' // &
2178) 'global_auxvar_type solely so you can set reaction%' // &
2179) '%eqgas_logK(igas) within ReactionPrintConstraint is not ' // &
2180) 'acceptable. Find another way! - Regards, Glenn'
2181) call printErrMsg(option)
2182) !geh reaction%eqgas_logK(igas) = global_auxvar%scco2_eq_logK
2183) endif
2184) endif
2185) enddo
2186) endif
2187) endif
2188)
2189) 200 format('')
2190) 201 format(a20,i5)
2191) 202 format(a20,f10.2)
2192) 203 format(a20,f8.4)
2193) 204 format(a20,es12.4)
2194)
2195) write(option%fid_out,90)
2196) write(option%fid_out,201) ' iterations: ', &
2197) constraint_coupler%num_iterations
2198)
2199) if (associated(reaction%species_idx)) then
2200) ! output pH
2201) if (reaction%species_idx%h_ion_id > 0) then
2202) ph = &
2203) -log10(rt_auxvar%pri_molal(reaction%species_idx%h_ion_id)* &
2204) rt_auxvar%pri_act_coef(reaction%species_idx%h_ion_id))
2205) else if (reaction%species_idx%h_ion_id < 0) then
2206) ph = &
2207) -log10(rt_auxvar%sec_molal(abs(reaction%species_idx%h_ion_id))* &
2208) rt_auxvar%sec_act_coef(abs(reaction%species_idx%h_ion_id)))
2209) endif
2210) if (reaction%species_idx%h_ion_id > 0 .or. reaction%species_idx%h_ion_id < 0) &
2211) write(option%fid_out,203) ' pH: ',ph
2212)
2213) ! output Eh and pe
2214) if (reaction%species_idx%o2_gas_id > 0 .and. (reaction%species_idx%h_ion_id > 0 &
2215) .or. reaction%species_idx%h_ion_id < 0)) then
2216)
2217) ifo2 = reaction%species_idx%o2_gas_id
2218)
2219) ! compute gas partial pressure
2220) lnQKgas(ifo2) = -reaction%eqgas_logK(ifo2)*LOG_TO_LN
2221)
2222) ! activity of water
2223) if (reaction%eqgash2oid(ifo2) > 0) then
2224) lnQKgas(ifo2) = lnQKgas(ifo2) + reaction%eqgash2ostoich(ifo2)*rt_auxvar%ln_act_h2o
2225) endif
2226) do jcomp = 1, reaction%eqgasspecid(0,ifo2)
2227) comp_id = reaction%eqgasspecid(jcomp,ifo2)
2228) lnQKgas(ifo2) = lnQKgas(ifo2) + reaction%eqgasstoich(jcomp,ifo2)* &
2229) log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
2230) enddo
2231)
2232) tk = global_auxvar%temp+273.15d0
2233) ehfac = IDEAL_GAS_CONSTANT*tk*LOG_TO_LN/faraday
2234) eh = ehfac*(-4.d0*ph+lnQKgas(ifo2)*LN_TO_LOG+logKeh(tk))/4.d0
2235) pe = eh/ehfac
2236)
2237) ! pe = (-4.d0*ph+lnQKgas(ifo2)*LN_TO_LOG+logKeh(tk))/4.d0
2238) ! eh = pe*ehfac
2239) write(option%fid_out,203) ' pe: ',pe
2240) write(option%fid_out,203) ' Eh: ',eh
2241) endif
2242) endif
2243)
2244) ionic_strength = 0.d0
2245) charge_balance = 0.d0
2246) do icomp = 1, reaction%naqcomp
2247) charge_balance = charge_balance + rt_auxvar%total(icomp,1)* &
2248) reaction%primary_spec_Z(icomp)
2249) ionic_strength = ionic_strength + rt_auxvar%pri_molal(icomp)* &
2250) reaction%primary_spec_Z(icomp)*reaction%primary_spec_Z(icomp)
2251) enddo
2252)
2253) if (reaction%neqcplx > 0) then
2254) do i = 1, reaction%neqcplx
2255) ionic_strength = ionic_strength + rt_auxvar%sec_molal(i)* &
2256) reaction%eqcplx_Z(i)* &
2257) reaction%eqcplx_Z(i)
2258) enddo
2259) endif
2260) ionic_strength = 0.5d0 * ionic_strength
2261)
2262) write(option%fid_out,'(a20,es12.4,a8)') ' ionic strength: ', &
2263) ionic_strength,' [mol/L]'
2264) write(option%fid_out,204) ' charge balance: ', charge_balance
2265)
2266) write(option%fid_out,'(a20,1pe12.4,a5)') ' pressure: ', &
2267) global_auxvar%pres(1),' [Pa]'
2268) write(option%fid_out,'(a20,f8.2,a4)') ' temperature: ', &
2269) global_auxvar%temp,' [C]'
2270) write(option%fid_out,'(a20,f8.2,a9)') ' density H2O: ', &
2271) global_auxvar%den_kg(1),' [kg/m^3]'
2272) write(option%fid_out,'(a20,1p2e12.4,a9)') 'ln / activity H2O: ', &
2273) rt_auxvar%ln_act_h2o,exp(rt_auxvar%ln_act_h2o),' [---]'
2274) write(option%fid_out,'(a20,1pe12.4,a9)') 'mole fraction H2O: ', &
2275) mole_fraction_h2o,' [---]'
2276) write(option%fid_out,'(a20,1pe12.4,a9)') 'mass fraction H2O: ', &
2277) mass_fraction_h2o,' [---]'
2278)
2279) ! CO2-specific
2280) if (option%iflowmode == MPH_MODE .or. option%iflowmode == FLASH2_MODE) then
2281) if (global_auxvar%den_kg(2) > 0.d0) then
2282) write(option%fid_out,'(a20,f8.2,a9)') ' density CO2: ', &
2283) global_auxvar%den_kg(2),' [kg/m^3]'
2284) write(option%fid_out,'(a20,es12.4,a9)') ' xphi: ', &
2285) global_auxvar%fugacoeff(1)
2286)
2287) if (reaction%species_idx%co2_aq_id /= 0) then
2288) icomp = reaction%species_idx%co2_aq_id
2289) mass_fraction_co2 = reaction%primary_spec_molar_wt(icomp)*rt_auxvar%pri_molal(icomp)* &
2290) mass_fraction_h2o*1.d-3
2291) mole_fraction_co2 = rt_auxvar%pri_molal(icomp)*FMWH2O*mole_fraction_h2o*1.e-3
2292) write(option%fid_out,'(a20,es12.4,a9)') 'mole fraction CO2: ', &
2293) mole_fraction_co2
2294) write(option%fid_out,'(a20,es12.4,a9)') 'mass fraction CO2: ', &
2295) mass_fraction_co2
2296) endif
2297) endif
2298) endif
2299) ! end CO2-specific
2300)
2301) write(option%fid_out,90)
2302)
2303) 102 format(/,' primary free total')
2304) 103 format(' species molal molal act coef constraint')
2305) write(option%fid_out,102)
2306) write(option%fid_out,103)
2307) write(option%fid_out,90)
2308)
2309) 104 format(2x,a20,es12.4,es12.4,es12.4,4x,a)
2310) do icomp = 1, reaction%naqcomp
2311) select case(aq_species_constraint%constraint_type(icomp))
2312) case(CONSTRAINT_NULL,CONSTRAINT_TOTAL)
2313) string = 'total aq'
2314) case(CONSTRAINT_TOTAL_SORB)
2315) string = 'total sorb'
2316) case(CONSTRAINT_FREE)
2317) string = 'free'
2318) case(CONSTRAINT_CHARGE_BAL)
2319) string = 'chrg'
2320) case(CONSTRAINT_LOG)
2321) string = 'log'
2322) case(CONSTRAINT_PH)
2323) string = 'pH'
2324) case(CONSTRAINT_MINERAL,CONSTRAINT_GAS)
2325) string = aq_species_constraint%constraint_aux_string(icomp)
2326) case(CONSTRAINT_SUPERCRIT_CO2)
2327) string = 'SC ' // aq_species_constraint%constraint_aux_string(icomp)
2328) end select
2329) write(option%fid_out,104) reaction%primary_species_names(icomp), &
2330) rt_auxvar%pri_molal(icomp), &
2331) rt_auxvar%total(icomp,1)*molar_to_molal, &
2332) rt_auxvar%pri_act_coef(icomp), &
2333) trim(string)
2334) enddo
2335) endif
2336)
2337) if (reaction%neqcplx > 0) then
2338) ! sort complex concentrations from largest to smallest
2339) do i = 1, reaction%neqcplx
2340) eqcplxsort(i) = i
2341) enddo
2342) do
2343) finished = PETSC_TRUE
2344) do i = 1, reaction%neqcplx-1
2345) icplx = eqcplxsort(i)
2346) icplx2 = eqcplxsort(i+1)
2347) if (rt_auxvar%sec_molal(icplx) < &
2348) rt_auxvar%sec_molal(icplx2)) then
2349) eqcplxsort(i) = icplx2
2350) eqcplxsort(i+1) = icplx
2351) finished = PETSC_FALSE
2352) endif
2353) enddo
2354) if (finished) exit
2355) enddo
2356)
2357) 110 format(/,' complex molality act coef logK')
2358) write(option%fid_out,110)
2359) write(option%fid_out,90)
2360) 111 format(2x,a20,es12.4,es12.4,2x,es12.4)
2361) do i = 1, reaction%neqcplx ! for each secondary species
2362) icplx = eqcplxsort(i)
2363) write(option%fid_out,111) reaction%secondary_species_names(icplx), &
2364) rt_auxvar%sec_molal(icplx), &
2365) rt_auxvar%sec_act_coef(icplx), &
2366) reaction%eqcplx_logK(icplx)
2367) enddo
2368)
2369) !print speciation precentages
2370) write(option%fid_out,92)
2371) 92 format(/)
2372) 134 format(2x,'complex species percent molality')
2373) 135 format(2x,'primary species: ',a20,2x,' total conc: ',1pe12.4)
2374) 136 format(2x,a20,2x,f6.2,2x,1pe12.4,1p2e12.4)
2375) do icomp = 1, reaction%naqcomp
2376)
2377) eqcplxsort = 0
2378) eqcplxid = 0
2379) percent = 0.d0
2380) totj = 0.d0
2381)
2382) icount = 0
2383) do icplx = 1, reaction%neqcplx
2384) found = PETSC_FALSE
2385) do i = 1, reaction%eqcplxspecid(0,icplx)
2386) if (reaction%eqcplxspecid(i,icplx) == icomp) then
2387) icount = icount + 1
2388) found = PETSC_TRUE
2389) exit
2390) endif
2391) enddo
2392) if (found) then
2393) eqcplxid(icount) = icplx
2394) percent(icount) = dabs(rt_auxvar%sec_molal(icplx)* &
2395) reaction%eqcplxstoich(i,icplx))
2396) totj = totj + percent(icount)
2397) endif
2398) enddo
2399) icount = icount + 1
2400) eqcplxid(icount) = -icomp
2401) percent(icount) = rt_auxvar%pri_molal(icomp)
2402) totj = totj + percent(icount)
2403) percent = percent / totj
2404)
2405) eqcplxsort = 0
2406) do i = 1, icount
2407) eqcplxsort(i) = i
2408) enddo
2409)
2410) do
2411) finished = PETSC_TRUE
2412) do i = 1, icount-1
2413) icplx = eqcplxsort(i)
2414) icplx2 = eqcplxsort(i+1)
2415) if (percent(abs(icplx)) < percent(abs(icplx2))) then
2416) eqcplxsort(i) = icplx2
2417) eqcplxsort(i+1) = icplx
2418) finished = PETSC_FALSE
2419) endif
2420) enddo
2421) if (finished) exit
2422) enddo
2423)
2424) write(option%fid_out,90)
2425) write(option%fid_out,135) reaction%primary_species_names(icomp), &
2426) rt_auxvar%total(icomp,iphase)
2427) write(option%fid_out,134)
2428) write(option%fid_out,90)
2429) do i = 1, icount
2430) j = eqcplxsort(i)
2431) if (percent(j) < 0.0001d0) cycle
2432) icplx = eqcplxid(j)
2433) if (icplx < 0) then
2434) icplx = abs(icplx)
2435) write(option%fid_out,136) reaction%primary_species_names(icplx), &
2436) percent(j)*100.d0, &
2437) rt_auxvar%pri_molal(icplx)
2438) else
2439) write(option%fid_out,136) reaction%secondary_species_names(icplx), &
2440) percent(j)*100.d0, &
2441) rt_auxvar%sec_molal(icplx)
2442) endif
2443) enddo
2444) enddo
2445)
2446) endif
2447)
2448) if (surface_complexation%nsrfcplxrxn > 0 .and. &
2449) surface_complexation%neqsrfcplxrxn /= &
2450) surface_complexation%nsrfcplxrxn) then
2451) string = 'WARNING: Only equilibrium surface complexes are printed to ' // &
2452) 'this file!'
2453) write(option%fid_out,'(/,2x,a,/)') trim(string)
2454) endif
2455)
2456) if (surface_complexation%neqsrfcplxrxn > 0) then
2457) ! sort surface complex concentrations from largest to smallest
2458) ! note that we include free site concentrations; their ids negated
2459) allocate(eqsrfcplxsort(surface_complexation%neqsrfcplx + &
2460) surface_complexation%neqsrfcplxrxn))
2461) do i = 1, surface_complexation%neqsrfcplx
2462) eqsrfcplxsort(i) = i
2463) enddo
2464) do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
2465) irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
2466) eqsrfcplxsort(surface_complexation%neqsrfcplx+ieqrxn) = -irxn
2467) enddo
2468) do
2469) finished = PETSC_TRUE
2470) do i = 1, size(eqsrfcplxsort)-1
2471) icplx = eqsrfcplxsort(i)
2472) icplx2 = eqsrfcplxsort(i+1)
2473) if (icplx > 0) then
2474) conc = rt_auxvar%eqsrfcplx_conc(icplx)
2475) else
2476) conc = rt_auxvar%srfcplxrxn_free_site_conc(-icplx)
2477) endif
2478) if (icplx2 > 0) then
2479) conc2 = rt_auxvar%eqsrfcplx_conc(icplx2)
2480) else
2481) conc2 = rt_auxvar%srfcplxrxn_free_site_conc(-icplx2)
2482) endif
2483) if (conc < conc2) then
2484) eqsrfcplxsort(i) = icplx2
2485) eqsrfcplxsort(i+1) = icplx
2486) finished = PETSC_FALSE
2487) endif
2488) enddo
2489) if (finished) exit
2490) enddo
2491)
2492) write(option%fid_out, &
2493) '(//,'' NOTE: Only equilibrium surface complexation is considered below'')')
2494) write(option%fid_out,120)
2495) write(option%fid_out,90)
2496) do i = 1, size(eqsrfcplxsort)
2497) icplx = eqsrfcplxsort(i)
2498) if (icplx > 0) then
2499) write(option%fid_out,121) surface_complexation%srfcplx_names(icplx), &
2500) rt_auxvar%eqsrfcplx_conc(icplx), &
2501) surface_complexation%srfcplx_logK(icplx)
2502) else
2503) write(option%fid_out,122) surface_complexation%srfcplxrxn_site_names(-icplx), &
2504) rt_auxvar%srfcplxrxn_free_site_conc(-icplx)
2505) endif
2506) enddo
2507) deallocate(eqsrfcplxsort)
2508)
2509) 120 format(/,' surf complex mol/m^3 blk logK')
2510) 121 format(2x,a20,es12.4,es12.4)
2511) 122 format(2x,a20,es12.4,' free site')
2512)
2513) #if 0
2514) write(option%fid_out,120)
2515) write(option%fid_out,90)
2516) do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
2517) irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
2518) write(option%fid_out,122) surface_complexation%srfcplxrxn_site_names(irxn), &
2519) rt_auxvar%srfcplxrxn_free_site_conc(irxn)
2520) ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
2521) do i = 1, ncplx
2522) icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
2523) write(option%fid_out,121) surface_complexation%srfcplx_names(icplx), &
2524) rt_auxvar%eqsrfcplx_conc(icplx), &
2525) surface_complexation%srfcplx_logK(icplx)
2526) enddo
2527) enddo
2528) #endif
2529)
2530) ! retardation
2531) if (surface_complexation%neqsrfcplxrxn > 0) then
2532) write(option%fid_out,123)
2533) write(option%fid_out,90)
2534) do j = 1, reaction%naqcomp
2535) retardation = 1.d0
2536) do ieqrxn = 1, surface_complexation%neqsrfcplxrxn
2537) irxn = surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(ieqrxn)
2538) ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
2539) do i = 1, ncplx
2540) icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
2541) ncomp = surface_complexation%srfcplxspecid(0,icplx)
2542) do jj = 1, ncomp
2543) jcomp = surface_complexation%srfcplxspecid(jj,icplx)
2544) if (j == jcomp) then
2545) if (rt_auxvar%total(j,iphase) /= 0.d0) &
2546) retardation = retardation + &
2547) surface_complexation%srfcplxstoich(jj,icplx)* &
2548) rt_auxvar%eqsrfcplx_conc(icplx)/ &
2549) bulk_vol_to_fluid_vol/ &
2550) rt_auxvar%total(j,iphase)
2551) exit
2552) endif
2553) enddo
2554) enddo
2555) enddo
2556) write(option%fid_out,124) reaction%primary_species_names(j),retardation
2557) enddo
2558) 123 format(/,' primary species retardation')
2559) 124 format(2x,a12,4x,1pe12.4)
2560)
2561) #ifdef DOUBLE_LAYER
2562) call ReactionDoubleLayer (constraint_coupler,reaction,option)
2563) #endif
2564)
2565) endif
2566)
2567) endif ! surface_complexation%nsrfcplxrxn > 0
2568)
2569) ! Ion Exchange
2570) if (reaction%neqionxrxn > 0) then
2571) write(option%fid_out,125)
2572) do irxn = 1, reaction%neqionxrxn
2573) write(option%fid_out,90)
2574) write(option%fid_out,126) reaction%eqionx_rxn_CEC(irxn)
2575) write(option%fid_out,127)
2576) write(option%fid_out,90)
2577) ncomp = reaction%eqionx_rxn_cationid(0,irxn)
2578) do i = 1, ncomp
2579) icomp = reaction%eqionx_rxn_cationid(i,irxn)
2580) kd = rt_auxvar%eqionx_conc(i,irxn)/rt_auxvar%total(icomp,iphase) &
2581) /bulk_vol_to_fluid_vol
2582) write(option%fid_out,128) reaction%primary_species_names(icomp), &
2583) reaction%eqionx_rxn_k(i,irxn), &
2584) rt_auxvar%eqionx_conc(i,irxn), &
2585) kd
2586) enddo
2587) enddo
2588) 125 format(/,2x,'ion-exchange reactions')
2589) 126 format(2x,'CEC = ',1pe12.4)
2590) 127 format(2x,'cation selectivity coef. sorbed conc. Kd',&
2591) /,30x,'[mol/m^3]')
2592) 128 format(2x,a8,2x,1pe12.4,4x,1pe12.4,4x,1pe12.4,4x,1pe12.4)
2593) endif
2594)
2595) ! total retardation from ion exchange and equilibrium surface complexation
2596) if (reaction%neqsorb > 0) then
2597) write(option%fid_out,1128)
2598) write(option%fid_out,90)
2599) do jcomp = 1, reaction%naqcomp
2600) if (abs(rt_auxvar%total(jcomp,iphase)) > 0.d0) &
2601) retardation = 1.d0 + rt_auxvar%total_sorb_eq(jcomp)/bulk_vol_to_fluid_vol &
2602) /rt_auxvar%total(jcomp,iphase)
2603) totj = rt_auxvar%total(jcomp,iphase)+rt_auxvar%total_sorb_eq(jcomp)/bulk_vol_to_fluid_vol
2604) write(option%fid_out,129) reaction%primary_species_names(jcomp), &
2605) totj,retardation
2606) enddo
2607) 1128 format(/,2x,'primary species total(aq+sorbed) total retardation', &
2608) /,25x,'[mol/L]',15x,'1+Kd')
2609) 129 format(2x,a12,8x,1pe12.4,8x,1pe12.4)
2610) endif
2611)
2612) if (mineral_reaction%nmnrl > 0) then
2613)
2614) 130 format(/,' mineral log SI Affinity log K', &
2615) /,51x,'[kJ/mol]')
2616) 131 format(2x,a30,2x,2f12.4,2x,1pe12.4)
2617)
2618) do imnrl = 1, mineral_reaction%nmnrl
2619) ! compute saturation
2620) lnQK(imnrl) = -mineral_reaction%mnrl_logK(imnrl)*LOG_TO_LN
2621) if (mineral_reaction%mnrlh2oid(imnrl) > 0) then
2622) lnQK(imnrl) = lnQK(imnrl) + mineral_reaction%mnrlh2ostoich(imnrl)*rt_auxvar%ln_act_h2o
2623) endif
2624) do jcomp = 1, mineral_reaction%mnrlspecid(0,imnrl)
2625) comp_id = mineral_reaction%mnrlspecid(jcomp,imnrl)
2626) lnQK(imnrl) = lnQK(imnrl) + mineral_reaction%mnrlstoich(jcomp,imnrl)* &
2627) log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
2628) enddo
2629) QK(imnrl) = exp(lnQK(imnrl))
2630) enddo
2631)
2632) ! sort mineral saturation indices from largest to smallest
2633) do i = 1, mineral_reaction%nmnrl
2634) eqminsort(i) = i
2635) enddo
2636) do
2637) finished = PETSC_TRUE
2638) do i = 1, mineral_reaction%nmnrl-1
2639) icplx = eqminsort(i)
2640) icplx2 = eqminsort(i+1)
2641) if (QK(icplx) < QK(icplx2)) then
2642) eqminsort(i) = icplx2
2643) eqminsort(i+1) = icplx
2644) finished = PETSC_FALSE
2645) endif
2646) enddo
2647) if (finished) exit
2648) enddo
2649)
2650) write(option%fid_out,130)
2651) write(option%fid_out,90)
2652)
2653) do imnrl = 1, mineral_reaction%nmnrl
2654) i = eqminsort(imnrl)
2655) affinity = -1.d0*IDEAL_GAS_CONSTANT*(global_auxvar%temp+273.15d0)*lnQK(i)
2656) write(option%fid_out,131) mineral_reaction%mineral_names(i), &
2657) lnQK(i)*LN_TO_LOG, affinity, &
2658) mineral_reaction%mnrl_logK(i)
2659) enddo
2660) endif
2661)
2662) if (reaction%ngas > 0) then
2663)
2664) 132 format(/,' gas log part. press. part. press. [bars] log K')
2665) 133 format(2x,a10,2x,1pe12.4,6x,1pe12.4,8x,1pe12.4)
2666)
2667) write(option%fid_out,132)
2668) write(option%fid_out,90)
2669)
2670) do igas = 1, reaction%ngas
2671)
2672) ! compute gas partial pressure
2673) lnQKgas(igas) = -reaction%eqgas_logK(igas)*LOG_TO_LN
2674)
2675) ! divide K by RT
2676) !lnQKgas = lnQKgas - log((auxvar%temp+273.15d0)*IDEAL_GAS_CONSTANT)
2677)
2678) ! activity of water
2679) if (reaction%eqgash2oid(igas) > 0) then
2680) lnQKgas(igas) = lnQKgas(igas) + reaction%eqgash2ostoich(igas)*rt_auxvar%ln_act_h2o
2681) endif
2682)
2683) do jcomp = 1, reaction%eqgasspecid(0,igas)
2684) comp_id = reaction%eqgasspecid(jcomp,igas)
2685) lnQKgas(igas) = lnQKgas(igas) + reaction%eqgasstoich(jcomp,igas)* &
2686) log(rt_auxvar%pri_molal(comp_id)*rt_auxvar%pri_act_coef(comp_id))
2687) enddo
2688)
2689) QKgas(igas) = exp(lnQKgas(igas))
2690)
2691) write(option%fid_out,133) reaction%gas_species_names(igas),lnQKgas(igas)*LN_TO_LOG, &
2692) QKgas(igas),reaction%eqgas_logK(igas)
2693) enddo
2694) endif
2695)
2696) #ifdef AMANZI_BGD
2697) ! output constraints for amanzi cfg formatted input
2698) if (OptionPrintToFile(option)) then
2699) string = trim(option%global_prefix) // '-' // &
2700) trim(constraint_coupler%constraint_name) // '.txt'
2701) open(unit=86,file=trim(string))
2702)
2703) write(86,'("# pflotran constraint preprocessing :")')
2704) !call date_and_time(date=word,time=word2)
2705) ! prints garbage? need to clear memory?
2706) !write(86,'("# date : ",a," ",a)') trim(word), trim(word2)
2707) write(86,'("# input : ",a)') trim(option%input_filename)
2708) write(86,'(/,"# Constraint: ",a)') &
2709) trim(constraint_coupler%constraint_name)
2710)
2711) write(86,'(/,"[total]")')
2712) do icomp = 1, reaction%naqcomp
2713) write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
2714) rt_auxvar%pri_molal(icomp)
2715) enddo
2716)
2717) write(86,'(/,"[free_ion]")')
2718) do icomp = 1, reaction%naqcomp
2719) write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
2720) rt_auxvar%total(icomp,1)*molar_to_molal
2721) enddo
2722)
2723) write(86,'(/,"[minerals]")')
2724) do imnrl = 1, mineral_reaction%nkinmnrl
2725) write(86,'(a," = ",f6.3)') trim(mineral_reaction%kinmnrl_names(imnrl)), &
2726) mineral_reaction%mnrl_volfrac(imnrl)
2727) enddo
2728)
2729) if (associated(rt_auxvar%total_sorb_eq)) then
2730) write(86,'(/,"[total_sorbed]")')
2731) do icomp = 1, reaction%naqcomp
2732) write(86,'(a," = ",1es13.6)') trim(reaction%primary_species_names(icomp)), &
2733) rt_auxvar%total_sorb_eq(icomp)
2734) enddo
2735) endif
2736)
2737) write(86,'(/,"[ion_exchange]")')
2738) do icomp = 1, reaction%neqionxrxn
2739) write(86, '("X- = ",1es13.6)') reaction%eqionx_rxn_CEC(icomp)
2740) enddo
2741) close(86)
2742) endif
2743) #endif
2744) ! end AMANZI_BGD
2745)
2746) end subroutine ReactionPrintConstraint
2747)
2748) ! ************************************************************************** !
2749)
2750) subroutine ReactionDoubleLayer(constraint_coupler,reaction,option)
2751) !
2752) ! Calculates double layer potential, surface charge, and
2753) ! sorbed surface complex concentrations
2754) !
2755) ! Author: Peter C. Lichtner
2756) ! Date: ???
2757) !
2758)
2759) use Option_module
2760) use Input_Aux_module
2761) use String_module
2762) use Transport_Constraint_module
2763)
2764) implicit none
2765)
2766) type(option_type) :: option
2767) type(tran_constraint_coupler_type) :: constraint_coupler
2768) type(reaction_type), pointer :: reaction
2769)
2770) type(reactive_transport_auxvar_type), pointer :: rt_auxvar
2771) type(global_auxvar_type), pointer :: global_auxvar
2772) type(aq_species_constraint_type), pointer :: aq_species_constraint
2773) type(mineral_constraint_type), pointer :: mineral_constraint
2774) type(surface_complexation_type), pointer :: surface_complexation
2775) type(mineral_type), pointer :: mineral_reaction
2776)
2777) PetscReal, parameter :: tk = 273.15d0
2778) PetscReal, parameter :: epsilon = 78.5d0
2779) PetscReal, parameter :: epsilon0 = 8.854187817d-12
2780) PetscReal, parameter :: faraday = 96485.d0
2781)
2782) PetscReal :: fac, boltzmann, dbl_charge, surface_charge, ionic_strength, &
2783) charge_balance, potential, tempk, debye_length, &
2784) srfchrg_capacitance_model, capacitance
2785)
2786) PetscReal :: ln_conc(reaction%naqcomp)
2787) PetscReal :: ln_act(reaction%naqcomp)
2788) PetscReal :: srfcplx_conc(reaction%surface_complexation%neqsrfcplx)
2789)
2790) PetscReal :: free_site_conc
2791) PetscReal :: ln_free_site
2792) PetscReal :: lnQK, tempreal, tempreal1, tempreal2, total
2793)
2794) PetscInt :: iphase
2795) PetscInt :: i, j, icomp, icplx, irxn, ncomp, ncplx
2796)
2797) PetscReal :: site_density(2)
2798) PetscReal :: mobile_fraction
2799) PetscInt :: num_types_of_sites
2800) PetscInt :: isite
2801)
2802) PetscBool :: one_more
2803)
2804) #if 1
2805) surface_complexation => reaction%surface_complexation
2806) rt_auxvar => constraint_coupler%rt_auxvar
2807) global_auxvar => constraint_coupler%global_auxvar
2808)
2809) iphase = 1
2810) global_auxvar%temp = option%reference_temperature
2811) tempk = tk + global_auxvar%temp
2812)
2813) potential = 0.1d0 ! initial guess
2814) boltzmann = exp(-faraday*potential/(IDEAL_GAS_CONSTANT*tempk))
2815)
2816) fac = sqrt(epsilon*epsilon0*IDEAL_GAS_CONSTANT*tempk)
2817)
2818) ionic_strength = 0.d0
2819) charge_balance = 0.d0
2820) dbl_charge = 0.d0
2821) do icomp = 1, reaction%naqcomp
2822) charge_balance = charge_balance + reaction%primary_spec_Z(icomp)* &
2823) rt_auxvar%total(icomp,1)
2824)
2825) ionic_strength = ionic_strength + reaction%primary_spec_Z(icomp)**2* &
2826) rt_auxvar%pri_molal(icomp)
2827) dbl_charge = dbl_charge + rt_auxvar%pri_molal(icomp)* &
2828) (boltzmann**reaction%primary_spec_Z(icomp) - 1.d0)
2829) enddo
2830)
2831) if (reaction%neqcplx > 0) then
2832) do i = 1, reaction%neqcplx
2833) ionic_strength = ionic_strength + reaction%eqcplx_Z(i)**2* &
2834) rt_auxvar%sec_molal(i)
2835) dbl_charge = dbl_charge + rt_auxvar%sec_molal(i)* &
2836) (boltzmann**reaction%eqcplx_Z(i) - 1.d0)
2837) enddo
2838) endif
2839) ionic_strength = 0.5d0*ionic_strength
2840) if (dbl_charge > 0.d0) then
2841) dbl_charge = fac*sqrt(2.d0*dbl_charge)
2842) else
2843) print *,'neg. dbl_charge: ',dbl_charge
2844) dbl_charge = fac*sqrt(2.d0*(-dbl_charge))
2845) endif
2846)
2847) srfchrg_capacitance_model = faraday* &
2848) sqrt(2.d0*epsilon*epsilon0*ionic_strength*1.d3/(IDEAL_GAS_CONSTANT*tempk))
2849)
2850) surface_charge = 0.d0
2851) do irxn = 1, surface_complexation%neqsrfcplxrxn
2852) ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
2853) do i = 1, ncplx
2854) icplx = surface_complexation%srfcplxrxn_to_complex(i,irxn)
2855) surface_charge = surface_charge + surface_complexation%srfcplx_Z(icplx)* &
2856) rt_auxvar%eqsrfcplx_conc(icplx)
2857) enddo
2858) enddo
2859) surface_charge = faraday*surface_charge
2860)
2861) debye_length = sqrt(fac/(2.d0*ionic_strength*1.d3))/faraday
2862) capacitance = sqrt(2.d0*epsilon*epsilon0*ionic_strength*1.d3/ &
2863) (IDEAL_GAS_CONSTANT*tempk)) * faraday
2864)
2865) print *,'========================='
2866) print *,'dbl: debye_length = ',debye_length
2867) print *,'surface charge = ',dbl_charge,surface_charge, &
2868) srfchrg_capacitance_model
2869) print *,'ionic strength = ',ionic_strength
2870) print *,'chrg bal. = ',charge_balance,' Tk = ',tempk,' Boltz. = ',boltzmann
2871) print *,'srfcmplx: ',rt_auxvar%eqsrfcplx_conc
2872) print *,'capacitance: ',capacitance
2873) print *,'========================='
2874)
2875) ! compute surface complex concentrations
2876) ln_conc = log(rt_auxvar%pri_molal)
2877) ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
2878)
2879) do irxn = 1, surface_complexation%neqsrfcplxrxn
2880)
2881) ncplx = surface_complexation%srfcplxrxn_to_complex(0,irxn)
2882)
2883) free_site_conc = rt_auxvar%srfcplxrxn_free_site_conc( &
2884) surface_complexation%eqsrfcplxrxn_to_srfcplxrxn(irxn))
2885)
2886) site_density(1) = surface_complexation%srfcplxrxn_site_density(irxn)
2887) num_types_of_sites = 1
2888)
2889) do isite = 1, num_types_of_sites
2890) ! isite == 1 - immobile (colloids, minerals, etc.)
2891) ! isite == 2 - mobile (colloids)
2892)
2893) if (site_density(isite) < 1.d-40) cycle
2894)
2895) ! get a pointer to the first complex (there will always be at least 1)
2896) ! in order to grab free site conc
2897) one_more = PETSC_FALSE
2898) do
2899) total = free_site_conc
2900) ln_free_site = log(free_site_conc)
2901)
2902) ! call srfcmplx(irxn,icplx,lnQK,reaction%eqsrfcplx_logK,reaction%eqsrfcplx_Z,potential, &
2903) ! tempk,ln_act,rt_auxvar%ln_act_h2o,ln_free_site,srfcplx_conc)
2904)
2905) #if 0
2906) do j = 1, ncplx
2907) icplx = surface_complexation%srfcplxrxn_to_complex(j,irxn)
2908)
2909) ! compute ion activity product
2910) lnQK = -reaction%eqsrfcplx_logK(icplx)*LOG_TO_LN &
2911) + reaction%eqsrfcplx_Z(icplx)*faraday*potential &
2912) /(IDEAL_GAS_CONSTANT*tempk)/LOG_TO_LN
2913)
2914) ! activity of water
2915) if (surface_complexation%eqsrfcplxh2oid(icplx) > 0) then
2916) lnQK = lnQK + surface_complexation%eqsrfcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
2917) endif
2918)
2919) lnQK = lnQK + surface_complexation%eqsrfcplx_free_site_stoich(icplx)* &
2920) ln_free_site
2921)
2922) ncomp = surface_complexation%srfcplxspecid(0,icplx)
2923) do i = 1, ncomp
2924) icomp = surface_complexation%srfcplxspecid(i,icplx)
2925) lnQK = lnQK + surface_complexation%eqsrfcplxstoich(i,icplx)*ln_act(icomp)
2926) enddo
2927) srfcplx_conc(icplx) = exp(lnQK)
2928)
2929) total = total + surface_complexation%eqsrfcplx_free_site_stoich(icplx)*srfcplx_conc(icplx)
2930)
2931) enddo
2932) #endif
2933) if (one_more) exit
2934)
2935) total = total / free_site_conc
2936) free_site_conc = site_density(isite) / total
2937)
2938) one_more = PETSC_TRUE
2939)
2940) enddo ! generic do
2941) enddo
2942) enddo
2943) #endif
2944) print *,'exit srfcmplx1: ',srfcplx_conc
2945)
2946) end subroutine ReactionDoubleLayer
2947)
2948) #if 0
2949)
2950) ! ************************************************************************** !
2951)
2952) subroutine srfcmplx(irxn,icplx,lnQK,logK,Z,potential,tempk, &
2953) ln_act,ln_act_h2o,ln_free_site,srfcplx_conc)
2954)
2955) implicit none
2956)
2957) PetscReal, parameter :: tk = 273.15d0
2958) PetscReal, parameter :: faraday = 96485.d0
2959)
2960) PetscReal :: fac, boltzmann, dbl_charge, surface_charge, ionic_strength, &
2961) charge_balance, potential, tempk, debye_length, &
2962) srfchrg_capacitance_model
2963)
2964) PetscReal :: ln_conc(reaction%naqcomp)
2965) PetscReal :: ln_act(reaction%naqcomp)
2966) PetscReal :: srfcplx_conc(reaction%neqsrfcplx)
2967)
2968) PetscReal :: free_site_conc
2969) PetscReal :: ln_free_site, ln_act_h2o
2970) PetscReal :: lnQK, tempreal, tempreal1, tempreal2, total
2971)
2972) PetscInt :: i, j, icomp, icplx, irxn, ncomp, ncplx
2973)
2974) do j = 1, ncplx
2975) icplx = reaction%srfcplxrxn_to_complex(j,irxn)
2976) ! compute secondary species concentration
2977) lnQK = -logK(icplx)*LOG_TO_LN &
2978) + Z(icplx)*faraday*potential &
2979) /(IDEAL_GAS_CONSTANT*tempk)/LOG_TO_LN
2980)
2981) ! activity of water
2982) if (reaction%eqsrfcplxh2oid(icplx) > 0) then
2983) lnQK = lnQK + reaction%eqsrfcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
2984) endif
2985)
2986) lnQK = lnQK + reaction%eqsrfcplx_free_site_stoich(icplx)* &
2987) ln_free_site
2988)
2989) ncomp = reaction%srfcplxspecid(0,icplx)
2990) do i = 1, ncomp
2991) icomp = reaction%srfcplxspecid(i,icplx)
2992) lnQK = lnQK + reaction%eqsrfcplxstoich(i,icplx)*ln_act(icomp)
2993) enddo
2994) srfcplx_conc(icplx) = exp(lnQK)
2995) enddo
2996) end subroutine srfcmplx
2997) #endif
2998)
2999) ! ************************************************************************** !
3000)
3001) subroutine ReactionReadOutput(reaction,input,option)
3002) !
3003) ! Reads species to be printed in output
3004) !
3005) ! Author: Glenn Hammond
3006) ! Date: 01/24/09
3007) !
3008)
3009) use Input_Aux_module
3010) use String_module
3011) use Option_module
3012) use Variables_module, only : PRIMARY_MOLALITY, PRIMARY_MOLARITY, &
3013) TOTAL_MOLALITY, TOTAL_MOLARITY
3014) implicit none
3015)
3016) type(reaction_type) :: reaction
3017) type(input_type), pointer :: input
3018) type(option_type) :: option
3019)
3020) character(len=MAXSTRINGLENGTH) :: string
3021) character(len=MAXWORDLENGTH) :: word
3022) character(len=MAXWORDLENGTH) :: name
3023) PetscBool :: found
3024) PetscInt :: temp_int
3025)
3026) type(aq_species_type), pointer :: cur_aq_spec
3027) type(gas_species_type), pointer :: cur_gas_spec
3028) type(mineral_rxn_type), pointer :: cur_mineral
3029) type(immobile_species_type), pointer :: cur_immobile
3030) type(surface_complex_type), pointer :: cur_srfcplx
3031) type(surface_complexation_rxn_type), pointer :: cur_srfcplx_rxn
3032)
3033) nullify(cur_aq_spec)
3034) nullify(cur_gas_spec)
3035) nullify(cur_mineral)
3036) nullify(cur_srfcplx)
3037) nullify(cur_srfcplx_rxn)
3038)
3039) input%ierr = 0
3040) do
3041)
3042) call InputReadPflotranString(input,option)
3043) if (InputError(input)) exit
3044) if (InputCheckExit(input,option)) exit
3045)
3046) call InputReadWord(input,option,name,PETSC_TRUE)
3047) call InputErrorMsg(input,option,'keyword','CHEMISTRY,OUTPUT,SPECIES_NAME')
3048)
3049) word = name
3050) call StringToUpper(word)
3051) select case(word)
3052) case('OFF')
3053) reaction%print_all_species = PETSC_FALSE
3054) reaction%print_all_primary_species = PETSC_FALSE
3055) reaction%print_all_secondary_species = PETSC_FALSE
3056) reaction%print_all_gas_species = PETSC_FALSE
3057) reaction%mineral%print_all = PETSC_FALSE
3058) reaction%print_pH = PETSC_FALSE
3059) reaction%print_Eh = PETSC_FALSE
3060) reaction%print_pe = PETSC_FALSE
3061) reaction%print_O2 = PETSC_FALSE
3062) reaction%print_kd = PETSC_FALSE
3063) reaction%print_total_sorb = PETSC_FALSE
3064) reaction%print_total_sorb_mobile = PETSC_FALSE
3065) reaction%print_colloid = PETSC_FALSE
3066) reaction%print_act_coefs = PETSC_FALSE
3067) reaction%print_total_component = PETSC_FALSE
3068) reaction%print_free_ion = PETSC_FALSE
3069) case('ALL')
3070) reaction%print_all_species = PETSC_TRUE
3071) reaction%print_all_primary_species = PETSC_TRUE
3072) ! reaction%print_all_secondary_species = PETSC_TRUE
3073) ! reaction%print_all_gas_species = PETSC_TRUE
3074) reaction%mineral%print_all = PETSC_TRUE
3075) reaction%immobile%print_all = PETSC_TRUE
3076) ! reaction%print_pH = PETSC_TRUE
3077) case('PRIMARY_SPECIES')
3078) reaction%print_all_primary_species = PETSC_TRUE
3079) reaction%print_pH = PETSC_TRUE
3080) case('SECONDARY_SPECIES')
3081) reaction%print_all_secondary_species = PETSC_TRUE
3082) case('GASES')
3083) reaction%print_all_gas_species = PETSC_TRUE
3084) case('MINERALS')
3085) reaction%mineral%print_all = PETSC_TRUE
3086) case('MINERAL_SATURATION_INDEX')
3087) reaction%mineral%print_saturation_index = PETSC_TRUE
3088) case('IMMOBILE')
3089) reaction%immobile%print_all = PETSC_TRUE
3090) case('PH')
3091) reaction%print_pH = PETSC_TRUE
3092) case('EH')
3093) reaction%print_Eh = PETSC_TRUE
3094) case('PE')
3095) reaction%print_pe = PETSC_TRUE
3096) case('O2')
3097) reaction%print_O2 = PETSC_TRUE
3098) case('KD')
3099) reaction%print_kd = PETSC_TRUE
3100) case('COLLOIDS')
3101) reaction%print_colloid = PETSC_TRUE
3102) case('TOTAL')
3103) reaction%print_total_component = PETSC_TRUE
3104) case('TOTAL_SORBED')
3105) reaction%print_total_sorb = PETSC_TRUE
3106) case('TOTAL_BULK')
3107) reaction%print_total_bulk = PETSC_TRUE
3108) case('TOTAL_SORBED_MOBILE')
3109) reaction%print_total_sorb_mobile = PETSC_TRUE
3110) case('FREE_ION')
3111) reaction%print_free_ion = PETSC_TRUE
3112) case('ACTIVITY_COEFFICIENTS')
3113) reaction%print_act_coefs = PETSC_TRUE
3114) case('MOLARITY')
3115) reaction%print_free_conc_type = PRIMARY_MOLARITY
3116) reaction%print_tot_conc_type = TOTAL_MOLARITY
3117) case('MOLALITY')
3118) reaction%print_free_conc_type = PRIMARY_MOLALITY
3119) reaction%print_tot_conc_type = TOTAL_MOLALITY
3120) case('AGE')
3121) reaction%print_age = PETSC_TRUE
3122) case ('SITE_DENSITY')
3123) call InputReadWord(input,option,name,PETSC_TRUE)
3124) call InputErrorMsg(input,option,'Site Name', &
3125) 'CHEMISTRY,OUTPUT,SITE DENSITY')
3126) cur_srfcplx_rxn => reaction%surface_complexation%rxn_list
3127) do
3128) if (.not.associated(cur_srfcplx_rxn)) exit
3129) if (StringCompare(name,cur_srfcplx_rxn%free_site_name,MAXWORDLENGTH)) then
3130) cur_srfcplx_rxn%site_density_print_me = PETSC_TRUE
3131) found = PETSC_TRUE
3132) exit
3133) endif
3134) cur_srfcplx_rxn => cur_srfcplx_rxn%next
3135) enddo
3136) case default
3137) found = PETSC_FALSE
3138) ! primary aqueous species
3139) if (.not.found) then
3140) cur_aq_spec => reaction%primary_species_list
3141) do
3142) if (.not.associated(cur_aq_spec)) exit
3143) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
3144) cur_aq_spec%print_me = PETSC_TRUE
3145) found = PETSC_TRUE
3146) exit
3147) endif
3148) cur_aq_spec => cur_aq_spec%next
3149) enddo
3150) endif
3151) ! secondary aqueous complex
3152) if (.not.found) then
3153) cur_aq_spec => reaction%secondary_species_list
3154) do
3155) if (.not.associated(cur_aq_spec)) exit
3156) if (StringCompare(name,cur_aq_spec%name,MAXWORDLENGTH)) then
3157) cur_aq_spec%print_me = PETSC_TRUE
3158) found = PETSC_TRUE
3159) exit
3160) endif
3161) cur_aq_spec => cur_aq_spec%next
3162) enddo
3163) endif
3164) ! gas
3165) if (.not.found) then
3166) cur_gas_spec => reaction%gas_species_list
3167) do
3168) if (.not.associated(cur_gas_spec)) exit
3169) if (StringCompare(name,cur_gas_spec%name,MAXWORDLENGTH)) then
3170) cur_gas_spec%print_me = PETSC_TRUE
3171) found = PETSC_TRUE
3172) exit
3173) endif
3174) cur_gas_spec => cur_gas_spec%next
3175) enddo
3176) endif
3177) ! minerals
3178) if (.not.found) then
3179) cur_mineral => reaction%mineral%mineral_list
3180) do
3181) if (.not.associated(cur_mineral)) exit
3182) if (StringCompare(name,cur_mineral%name,MAXWORDLENGTH)) then
3183) cur_mineral%print_me = PETSC_TRUE
3184) found = PETSC_TRUE
3185) exit
3186) endif
3187) cur_mineral => cur_mineral%next
3188) enddo
3189) endif
3190) ! immobile
3191) if (.not.found) then
3192) cur_immobile => reaction%immobile%list
3193) do
3194) if (.not.associated(cur_immobile)) exit
3195) if (StringCompare(name,cur_immobile%name,MAXWORDLENGTH)) then
3196) cur_immobile%print_me = PETSC_TRUE
3197) found = PETSC_TRUE
3198) exit
3199) endif
3200) cur_immobile => cur_immobile%next
3201) enddo
3202) endif
3203) ! surface complexation reaction
3204) if (.not.found) then
3205) cur_srfcplx_rxn => reaction%surface_complexation%rxn_list
3206) do
3207) if (.not.associated(cur_srfcplx_rxn)) exit
3208) if (StringCompare(name,cur_srfcplx_rxn%free_site_name, &
3209) MAXWORDLENGTH)) then
3210) cur_srfcplx_rxn%free_site_print_me = PETSC_TRUE
3211) found = PETSC_TRUE
3212) exit
3213) endif
3214) cur_srfcplx_rxn => cur_srfcplx_rxn%next
3215) enddo
3216) endif
3217) ! surface complex
3218) if (.not.found) then
3219) cur_srfcplx => reaction%surface_complexation%complex_list
3220) do
3221) if (.not.associated(cur_srfcplx)) exit
3222) if (StringCompare(name,cur_srfcplx%name,MAXWORDLENGTH)) then
3223) cur_srfcplx%print_me = PETSC_TRUE
3224) found = PETSC_TRUE
3225) exit
3226) endif
3227) cur_srfcplx => cur_srfcplx%next
3228) enddo
3229) endif
3230) if (.not.found) then
3231) option%io_buffer = 'CHEMISTRY,OUTPUT species name: '//trim(name)// &
3232) ' not found among chemical species'
3233) call printErrMsg(option)
3234) endif
3235) end select
3236)
3237) enddo
3238)
3239) ! check to ensure that the user has listed FREE_ION or TOTAL is a primary
3240) ! species is listed for output
3241) found = PETSC_FALSE
3242) cur_aq_spec => reaction%primary_species_list
3243) do
3244) if (.not.associated(cur_aq_spec)) exit
3245) if (cur_aq_spec%print_me) then
3246) found = PETSC_TRUE
3247) exit
3248) endif
3249) cur_aq_spec => cur_aq_spec%next
3250) enddo
3251)
3252) if ((found .or. reaction%print_all_primary_species .or. &
3253) reaction%print_all_species) .and. &
3254) .not.(reaction%print_total_component .or. &
3255) reaction%print_free_ion)) then
3256) option%io_buffer = 'FREE_ION or TOTAL must be specified to print a ' // &
3257) 'primary species.'
3258) call printErrMsg(option)
3259) endif
3260)
3261) end subroutine ReactionReadOutput
3262)
3263) ! ************************************************************************** !
3264)
3265) subroutine RJumpStartKineticSorption(rt_auxvar,global_auxvar, &
3266) material_auxvar,reaction,option)
3267) !
3268) ! Calculates the concentrations of species sorbing
3269) ! through kinetic sorption processes based
3270) ! on equilibrium with the aqueous phase.
3271) !
3272) ! Author: Glenn Hammond
3273) ! Date: 08/05/09
3274) !
3275)
3276) use Option_module
3277)
3278) implicit none
3279)
3280) type(reaction_type), pointer :: reaction
3281) type(reactive_transport_auxvar_type) :: rt_auxvar
3282) type(global_auxvar_type) :: global_auxvar
3283) class(material_auxvar_type) :: material_auxvar
3284) type(option_type) :: option
3285)
3286) PetscInt :: irate
3287)
3288) ! WARNING: below assumes site concentration multiplicative factor
3289) allocate(rt_auxvar%dtotal_sorb_eq(reaction%naqcomp,reaction%naqcomp))
3290) !geh: if jumpstarting, we need to zero the sorbed total as
3291) ! RTotalSorbEqSurfCplx() will add but not initialize
3292) call RZeroSorb(rt_auxvar)
3293) call RTotalSorbEqSurfCplx(rt_auxvar,global_auxvar,material_auxvar, &
3294) reaction,option)
3295) option%io_buffer = 'RJumpStartKineticSorption needs to be fixed'
3296) call printErrMsg(option)
3297) #if 0
3298) !TODO(geh): sort this out
3299) do irate = 1, reaction%kinmr_nrate
3300) rt_auxvar%kinmr_total_sorb(:,irate) = reaction%kinmr_frac(irate) * &
3301) rt_auxvar%total_sorb_eq
3302) enddo
3303) #endif
3304) deallocate(rt_auxvar%dtotal_sorb_eq)
3305) nullify(rt_auxvar%dtotal_sorb_eq)
3306)
3307) end subroutine RJumpStartKineticSorption
3308)
3309) ! ************************************************************************** !
3310)
3311) subroutine RReact(rt_auxvar,global_auxvar,material_auxvar,tran_xx_p, &
3312) num_iterations_,reaction,option)
3313) !
3314) ! Solves reaction portion of operator splitting using Newton-Raphson
3315) !
3316) ! Author: Glenn Hammond
3317) ! Date: 05/04/10
3318) !
3319)
3320) use Option_module
3321)
3322) implicit none
3323)
3324) type(reaction_type), pointer :: reaction
3325) type(reactive_transport_auxvar_type) :: rt_auxvar
3326) type(global_auxvar_type) :: global_auxvar
3327) class(material_auxvar_type) :: material_auxvar
3328) PetscReal :: tran_xx_p(reaction%ncomp)
3329) type(option_type) :: option
3330) PetscInt :: num_iterations_
3331) PetscReal :: sign_(reaction%ncomp)
3332)
3333) PetscReal :: residual(reaction%ncomp)
3334) PetscReal :: res(reaction%ncomp)
3335) PetscReal :: J(reaction%ncomp,reaction%ncomp)
3336) PetscReal :: one_over_dt
3337) PetscReal :: prev_solution(reaction%ncomp)
3338) PetscReal :: new_solution(reaction%ncomp)
3339) PetscReal :: update(reaction%ncomp)
3340) PetscReal :: maximum_relative_change
3341) PetscReal :: accumulation_coef
3342) PetscReal :: fixed_accum(reaction%ncomp)
3343) PetscInt :: num_iterations
3344) PetscInt :: icomp
3345) PetscInt :: immobile_start, immobile_end
3346) PetscReal :: ratio, min_ratio
3347) PetscReal :: scale
3348)
3349) PetscInt, parameter :: iphase = 1
3350)
3351) one_over_dt = 1.d0/option%tran_dt
3352) num_iterations = 0
3353)
3354) ! calculate fixed portion of accumulation term
3355) ! fixed_accum is overwritten in RTAccumulation
3356) ! Since RTAccumulation uses rt_auxvar%total, we must overwrite the
3357) ! rt_auxvar total variables
3358) ! aqueous
3359) rt_auxvar%total(:,iphase) = tran_xx_p(1:reaction%naqcomp)
3360)
3361) if (reaction%ncoll > 0) then
3362) option%io_buffer = 'Colloids not set up for operator split mode.'
3363) call printErrMsg(option)
3364) endif
3365)
3366) ! skip chemistry if species nonreacting
3367) #if 1
3368) if (.not.reaction%use_full_geochemistry) then
3369) rt_auxvar%pri_molal(:) = tran_xx_p(1:reaction%naqcomp) / &
3370) global_auxvar%den_kg(iphase)*1.d3
3371) return
3372) endif
3373) #endif
3374)
3375) ! update immobile concentrations
3376) if (reaction%nimcomp > 0) then
3377) immobile_start = reaction%offset_immobile + 1
3378) immobile_end = reaction%offset_immobile + reaction%nimcomp
3379) rt_auxvar%immobile(1:reaction%nimcomp) = &
3380) tran_xx_p(immobile_start:immobile_end)
3381) endif
3382)
3383) if (.not.option%use_isothermal) then
3384) call RUpdateTempDependentCoefs(global_auxvar,reaction,PETSC_FALSE,option)
3385) endif
3386)
3387) ! still need code to overwrite other phases
3388) call RTAccumulation(rt_auxvar,global_auxvar,material_auxvar,reaction, &
3389) option,fixed_accum)
3390) if (reaction%neqsorb > 0) then
3391) call RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar,reaction, &
3392) option,fixed_accum)
3393) endif
3394)
3395) ! now update activity coefficients
3396) if (reaction%act_coef_update_frequency /= ACT_COEF_FREQUENCY_OFF) then
3397) call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
3398) endif
3399)
3400) do
3401)
3402) num_iterations = num_iterations + 1
3403)
3404) if (reaction%act_coef_update_frequency == &
3405) ACT_COEF_FREQUENCY_NEWTON_ITER) then
3406) call RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
3407) endif
3408) call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction, &
3409) option)
3410)
3411) ! Accumulation
3412) ! residual is overwritten in RTAccumulation()
3413) call RTAccumulation(rt_auxvar,global_auxvar,material_auxvar,reaction, &
3414) option,residual)
3415) residual = residual-fixed_accum
3416)
3417) ! J is overwritten in RTAccumulationDerivative()
3418) call RTAccumulationDerivative(rt_auxvar,global_auxvar,material_auxvar, &
3419) reaction,option,J)
3420)
3421) if (reaction%neqsorb > 0) then
3422) call RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar,reaction, &
3423) option,residual)
3424) call RAccumulationSorbDerivative(rt_auxvar,global_auxvar,material_auxvar, &
3425) reaction,option,J)
3426) endif
3427)
3428) ! derivative
3429) call RReaction(residual,J,PETSC_TRUE,rt_auxvar,global_auxvar, &
3430) material_auxvar,reaction,option)
3431)
3432) if (maxval(abs(residual)) < reaction%max_residual_tolerance) exit
3433)
3434) call RSolve(residual,J,rt_auxvar%pri_molal,update,reaction%ncomp, &
3435) reaction%use_log_formulation)
3436)
3437) prev_solution(1:reaction%naqcomp) = rt_auxvar%pri_molal(1:reaction%naqcomp)
3438) if (reaction%nimcomp > 0) then
3439) prev_solution(immobile_start:immobile_end) = &
3440) rt_auxvar%immobile(1:reaction%nimcomp)
3441) endif
3442)
3443) if (reaction%use_log_formulation) then
3444) update = dsign(1.d0,update)*min(dabs(update),reaction%max_dlnC)
3445) new_solution = prev_solution*exp(-update)
3446) else ! linear upage
3447) ! ensure non-negative concentration
3448) min_ratio = 1.d20 ! large number
3449) do icomp = 1, reaction%ncomp
3450) if (prev_solution(icomp) <= update(icomp)) then
3451) ratio = abs(prev_solution(icomp)/update(icomp))
3452) if (ratio < min_ratio) min_ratio = ratio
3453) endif
3454) enddo
3455) if (min_ratio < 1.d0) then
3456) ! scale by 0.99 to make the update slightly smaller than the min_ratio
3457) update = update*min_ratio*0.99d0
3458) endif
3459) new_solution = prev_solution - update
3460) endif
3461)
3462) maximum_relative_change = maxval(abs((new_solution-prev_solution)/ &
3463) prev_solution))
3464)
3465) if (maximum_relative_change < reaction%max_relative_change_tolerance) exit
3466)
3467) if (num_iterations > 50) then
3468) scale = 1.d0
3469) if (num_iterations > 50) then
3470) scale = 0.1d0
3471) else if (num_iterations > 100) then
3472) scale = 0.01d0
3473) else if (num_iterations > 150) then
3474) scale = 0.001d0
3475) else if (num_iterations > 500) then
3476) print *, 'Maximum iterations in RReact: stop: ',num_iterations
3477) print *, 'Maximum iterations in RReact: residual: ',residual
3478) print *, 'Maximum iterations in RReact: new solution: ',new_solution
3479) stop
3480) endif
3481) if (scale < 0.99d0) then
3482) ! apply scaling
3483) new_solution = scale*(new_solution-prev_solution(:))+prev_solution(:)
3484) endif
3485) endif
3486)
3487) rt_auxvar%pri_molal(1:reaction%naqcomp) = new_solution(1:reaction%naqcomp)
3488) if (reaction%nimcomp > 0) then
3489) rt_auxvar%immobile(1:reaction%nimcomp) = &
3490) new_solution(immobile_start:immobile_end)
3491) endif
3492)
3493) enddo
3494)
3495) ! one last update
3496) call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
3497)
3498) num_iterations_ = num_iterations
3499)
3500) end subroutine RReact
3501)
3502) ! ************************************************************************** !
3503)
3504) subroutine RReaction(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3505) material_auxvar,reaction,option)
3506) !
3507) ! Computes reactions
3508) !
3509) ! Author: Glenn Hammond
3510) ! Date: 09/30/08
3511) !
3512)
3513) use Option_module
3514) use CLM_Rxn_module, only : RCLMRxn, clmrxn_list
3515)
3516) implicit none
3517)
3518) type(reaction_type), pointer :: reaction
3519) type(reactive_transport_auxvar_type) :: rt_auxvar
3520) type(global_auxvar_type) :: global_auxvar
3521) class(material_auxvar_type) :: material_auxvar
3522) type(option_type) :: option
3523) PetscBool :: derivative
3524) PetscReal :: Res(reaction%ncomp)
3525) PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
3526)
3527) if (reaction%mineral%nkinmnrl > 0) then
3528) call RKineticMineral(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3529) material_auxvar,reaction,option)
3530) endif
3531)
3532) if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
3533) call RMultiRateSorption(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3534) material_auxvar,reaction,option)
3535) endif
3536)
3537) if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
3538) call RKineticSurfCplx(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3539) material_auxvar,reaction,option)
3540) endif
3541)
3542) if (reaction%nradiodecay_rxn > 0) then
3543) call RRadioactiveDecay(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3544) material_auxvar,reaction,option)
3545) endif
3546)
3547) if (reaction%ngeneral_rxn > 0) then
3548) call RGeneral(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3549) material_auxvar,reaction,option)
3550) endif
3551)
3552) if (reaction%microbial%nrxn > 0) then
3553) call RMicrobial(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3554) material_auxvar,reaction,option)
3555) endif
3556)
3557) if (reaction%immobile%ndecay_rxn > 0) then
3558) call RImmobileDecay(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3559) material_auxvar,reaction,option)
3560) endif
3561)
3562) if (associated(rxn_sandbox_list)) then
3563) call RSandbox(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3564) material_auxvar,reaction,option)
3565) endif
3566)
3567) ! add new reactions here and in RReactionDerivative
3568) if (associated(clmrxn_list)) then
3569) call RCLMRxn(Res,Jac,derivative,rt_auxvar,global_auxvar, &
3570) material_auxvar,reaction,option)
3571) endif
3572)
3573) end subroutine RReaction
3574)
3575) ! ************************************************************************** !
3576)
3577) subroutine RReactionDerivative(Res,Jac,rt_auxvar,global_auxvar, &
3578) material_auxvar,reaction,option)
3579) !
3580) ! RReaction: Computes reactions
3581) !
3582) ! Author: Glenn Hammond
3583) ! Date: 09/30/08
3584) !
3585)
3586) use Option_module
3587)
3588) implicit none
3589)
3590) type(reaction_type), pointer :: reaction
3591) type(reactive_transport_auxvar_type) :: rt_auxvar
3592) type(reactive_transport_auxvar_type) :: rt_auxvar_pert
3593) type(global_auxvar_type) :: global_auxvar
3594) class(material_auxvar_type) :: material_auxvar
3595) type(option_type) :: option
3596) PetscReal :: Res(reaction%ncomp)
3597) PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
3598)
3599) PetscReal :: Res_orig(reaction%ncomp)
3600) PetscReal :: Res_pert(reaction%ncomp)
3601) PetscInt :: icomp, jcomp, joffset
3602) PetscReal :: Jac_dummy(reaction%ncomp,reaction%ncomp)
3603) PetscReal :: pert
3604) PetscBool :: compute_derivative
3605)
3606) ! add new reactions in the 3 locations below
3607)
3608) if (.not.option%transport%numerical_derivatives) then ! analytical derivative
3609) compute_derivative = PETSC_TRUE
3610) call RReaction(Res,Jac,compute_derivative,rt_auxvar, &
3611) global_auxvar,material_auxvar,reaction,option)
3612)
3613) ! add only in RReaction
3614)
3615) else ! numerical derivative
3616) compute_derivative = PETSC_FALSE
3617) Res_orig = 0.d0
3618) option%iflag = 0 ! be sure not to allocate mass_balance array
3619) call RTAuxVarInit(rt_auxvar_pert,reaction,option)
3620) call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
3621)
3622) call RReaction(Res_orig,Jac_dummy,compute_derivative,rt_auxvar, &
3623) global_auxvar,material_auxvar,reaction,option)
3624)
3625) ! aqueous species
3626) do jcomp = 1, reaction%naqcomp
3627) Res_pert = 0.d0
3628) call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
3629) pert = rt_auxvar_pert%pri_molal(jcomp)*perturbation_tolerance
3630) rt_auxvar_pert%pri_molal(jcomp) = rt_auxvar_pert%pri_molal(jcomp) + pert
3631)
3632) call RTotal(rt_auxvar_pert,global_auxvar,reaction,option)
3633) if (reaction%neqsorb > 0) then
3634) call RTotalSorb(rt_auxvar_pert,global_auxvar,material_auxvar, &
3635) reaction,option)
3636) endif
3637) call RReaction(Res_pert,Jac_dummy,compute_derivative,rt_auxvar_pert, &
3638) global_auxvar,material_auxvar,reaction,option)
3639)
3640) do icomp = 1, reaction%ncomp
3641) Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
3642) (Res_pert(icomp)-Res_orig(icomp))/pert
3643) enddo
3644) enddo
3645) ! immobile species
3646) do jcomp = 1, reaction%nimcomp
3647) Res_pert = 0.d0
3648) call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
3649) ! leave pri_molal, total, total sorbed as is; just copy
3650) pert = rt_auxvar_pert%immobile(jcomp)*perturbation_tolerance
3651) rt_auxvar_pert%immobile(jcomp) = rt_auxvar_pert%immobile(jcomp) + pert
3652) call RReaction(Res_pert,Jac_dummy,compute_derivative,rt_auxvar_pert, &
3653) global_auxvar,material_auxvar,reaction,option)
3654)
3655) ! j is the index in the residual vector and Jacobian
3656) joffset = reaction%offset_immobile + jcomp
3657) do icomp = 1, reaction%ncomp
3658) Jac(icomp,joffset) = Jac(icomp,joffset) + &
3659) (Res_pert(icomp)-Res_orig(icomp))/pert
3660) enddo
3661) enddo
3662)
3663) ! zero small derivatives
3664) do icomp = 1, reaction%ncomp
3665) do jcomp = 1, reaction%ncomp
3666) if (dabs(Jac(icomp,jcomp)) < 1.d-40) Jac(icomp,jcomp) = 0.d0
3667) enddo
3668) enddo
3669) call RTAuxVarStrip(rt_auxvar_pert)
3670) endif
3671)
3672) end subroutine RReactionDerivative
3673)
3674) ! ************************************************************************** !
3675)
3676) subroutine CO2AqActCoeff(rt_auxvar,global_auxvar,reaction,option)
3677) !
3678) ! Computes activity coefficients of aqueous CO2
3679) !
3680) ! Author: Chuan Lu
3681) ! Date: 07/13/09
3682) !
3683)
3684) use Option_module
3685) use co2eos_module
3686)
3687) implicit none
3688)
3689) type(reactive_transport_auxvar_type) :: rt_auxvar
3690) type(global_auxvar_type) :: global_auxvar
3691) type(reaction_type) :: reaction
3692) type(option_type) :: option
3693)
3694) PetscReal :: m_na, m_cl, tc, co2aqact, lngamco2, henry, xphico2, pco2
3695) PetscReal :: sat_pressure
3696) PetscErrorCode :: ierr
3697)
3698) ! print *,'CO2AqActCoeff: ', global_auxvar%pres(:)
3699)
3700) tc = global_auxvar%temp
3701) pco2 = global_auxvar%pres(2)
3702) sat_pressure =0D0
3703)
3704) m_na = option%m_nacl; m_cl = m_na
3705) if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
3706) m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
3707) m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
3708) endif
3709)
3710) call Henry_duan_sun(tc,pco2*1D-5,henry,lngamco2, &
3711) m_na,m_cl,co2aqact)
3712)
3713) if (reaction%species_idx%co2_aq_id /= 0) then
3714) rt_auxvar%pri_act_coef(reaction%species_idx%co2_aq_id) = co2aqact
3715) else
3716) co2aqact = 1.d0
3717) endif
3718) ! print *, 'CO2AqActCoeff', tc, pco2, m_na,m_cl, sat_pressure,co2aqact
3719) end subroutine CO2AqActCoeff
3720)
3721) ! ************************************************************************** !
3722)
3723) function RSumMoles(rt_auxvar,reaction,option)
3724) !
3725) ! Sums the total moles of primary and secondary aqueous species
3726) !
3727) ! Author: Glenn Hammond
3728) ! Date: 12/01/14
3729) !
3730)
3731) use Option_module
3732)
3733) implicit none
3734)
3735) type(reactive_transport_auxvar_type) :: rt_auxvar
3736) type(reaction_type) :: reaction
3737) type(option_type) :: option
3738) PetscReal :: RSumMoles
3739)
3740) PetscInt :: i
3741)
3742) RSumMoles = 0.d0
3743) do i = 1, reaction%naqcomp
3744) RSumMoles = RSumMoles + rt_auxvar%pri_molal(i)
3745) enddo
3746)
3747) do i = 1, reaction%neqcplx
3748) RSumMoles = RSumMoles + rt_auxvar%sec_molal(i)
3749) enddo
3750)
3751) end function RSumMoles
3752)
3753) ! ************************************************************************** !
3754)
3755) function RCO2MoleFraction(rt_auxvar,global_auxvar,reaction,option)
3756) !
3757) ! Sums the total moles of primary and secondary aqueous species
3758) !
3759) ! Author: Glenn Hammond
3760) ! Date: 12/01/14
3761) !
3762)
3763) use Option_module
3764)
3765) implicit none
3766)
3767) type(reactive_transport_auxvar_type) :: rt_auxvar
3768) type(global_auxvar_type) :: global_auxvar
3769) type(reaction_type) :: reaction
3770) type(option_type) :: option
3771) PetscReal :: RCO2MoleFraction
3772)
3773) PetscInt :: i
3774) PetscInt :: icplx
3775) PetscInt :: ico2
3776) PetscReal :: sum_co2, sum_mol
3777)
3778) ico2 = reaction%species_idx%co2_aq_id
3779)
3780) if (ico2 == 0) then
3781) option%io_buffer = 'CO2 is not set in RCO2MoleFraction().'
3782) call printErrMsg(option)
3783) endif
3784)
3785) sum_co2 = rt_auxvar%pri_molal(ico2)
3786) sum_mol = RSumMoles(rt_auxvar,reaction,option)
3787) ! sum_co2 and sum_mol are both in units mol/kg water
3788) ! FMWH2O is in units g/mol
3789) ! therefore, scale by 1.d-3 to convert from mol/kg water - g water/mol water
3790) ! to mol/mol water -- kg water / 1000g water
3791) RCO2MoleFraction = sum_co2 * FMWH2O * 1.d-3 / &
3792) (1.d0 + FMWH2O * sum_mol * 1.d-3)
3793)
3794) end function RCO2MoleFraction
3795)
3796) ! ************************************************************************** !
3797)
3798) subroutine RActivityCoefficients(rt_auxvar,global_auxvar,reaction,option)
3799) !
3800) ! Computes the ionic strength and activity coefficients
3801) !
3802) ! Author: Glenn Hammond
3803) ! Date: 09/30/08
3804) !
3805)
3806) use Option_module
3807)
3808) implicit none
3809)
3810) type(reactive_transport_auxvar_type) :: rt_auxvar
3811) type(global_auxvar_type) :: global_auxvar
3812) type(reaction_type) :: reaction
3813) type(option_type) :: option
3814)
3815) PetscInt :: icplx, icomp, it, j, jcomp, ncomp
3816) PetscReal :: I, sqrt_I, II, sqrt_II, f, fpri, didi, dcdi, den, dgamdi, &
3817) lnQK, sum, sum_pri_molal, sum_sec_molal
3818) PetscReal :: sum_molality
3819) PetscReal :: ln_conc(reaction%naqcomp)
3820) PetscReal :: ln_act(reaction%naqcomp)
3821) PetscReal :: NaN
3822)
3823) if (reaction%use_activity_h2o) then
3824) sum_pri_molal = 0.d0
3825) do j = 1, reaction%naqcomp
3826) if (j /= reaction%species_idx%h2o_aq_id) then
3827) sum_pri_molal = sum_pri_molal + rt_auxvar%pri_molal(j)
3828) endif
3829) enddo
3830) endif
3831)
3832) if (reaction%act_coef_update_algorithm == ACT_COEF_ALGORITHM_NEWTON) then
3833)
3834) ln_conc = log(rt_auxvar%pri_molal)
3835) ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
3836)
3837) ! compute primary species contribution to ionic strength
3838) fpri = 0.d0
3839) sum_molality = 0.d0
3840) do j = 1, reaction%naqcomp
3841) fpri = fpri + rt_auxvar%pri_molal(j)*reaction%primary_spec_Z(j)* &
3842) reaction%primary_spec_Z(j)
3843) enddo
3844)
3845) it = 0
3846) II = 0
3847) do
3848) it = it + 1
3849)
3850) if (it > 50) then
3851) write(option%io_buffer,*) &
3852) ' too many iterations in computing activity coefficients-stop',it,f,I, &
3853) ' setting all activity coefficients to NaNs to crash the code.'
3854) call printErrMsgNoStopByRank(option)
3855) NaN = 0.d0
3856) NaN = 1.d0/NaN
3857) NaN = 0.d0*NaN
3858) rt_auxvar%pri_molal = NaN
3859) rt_auxvar%pri_act_coef = NaN
3860) rt_auxvar%sec_act_coef = NaN
3861) endif
3862)
3863) ! add secondary species contribution to ionic strength
3864) I = fpri
3865) do icplx = 1, reaction%neqcplx ! for each secondary species
3866) I = I + rt_auxvar%sec_molal(icplx)*reaction%eqcplx_Z(icplx)* &
3867) reaction%eqcplx_Z(icplx)
3868) enddo
3869) I = 0.5d0*I
3870) f = I
3871)
3872) if (abs(I-II) < 1.d-6*I) exit
3873)
3874) if (reaction%neqcplx > 0) then
3875) didi = 0.d0
3876) sqrt_I = sqrt(I)
3877) do icplx = 1, reaction%neqcplx
3878) if (abs(reaction%eqcplx_Z(icplx)) > 0.d0) then
3879) sum = 0.5d0*reaction%debyeA*reaction%eqcplx_Z(icplx)* &
3880) reaction%eqcplx_Z(icplx) &
3881) /(sqrt_I*(1.d0+reaction%debyeB*reaction%eqcplx_a0(icplx)*sqrt_I)**2) &
3882) -reaction%debyeBdot
3883) ncomp = reaction%eqcplxspecid(0,icplx)
3884) do jcomp = 1, ncomp
3885) j = reaction%eqcplxspecid(jcomp,icplx)
3886) if (abs(reaction%primary_spec_Z(j)) > 0.d0) then
3887) dgamdi = -0.5d0*reaction%debyeA*reaction%primary_spec_Z(j)**2/(sqrt_I* &
3888) (1.d0+reaction%debyeB*reaction%primary_spec_a0(j)*sqrt_I)**2)+ &
3889) reaction%debyeBdot
3890) sum = sum + reaction%eqcplxstoich(jcomp,icplx)*dgamdi
3891) endif
3892) enddo
3893) dcdi = rt_auxvar%sec_molal(icplx)*LOG_TO_LN*sum
3894) didi = didi+0.5d0*reaction%eqcplx_Z(icplx)*reaction%eqcplx_Z(icplx)*dcdi
3895) endif
3896) enddo
3897) den = 1.d0-didi
3898) if (abs(den) > 0.d0) then
3899) II = (f-I*didi)/den
3900) else
3901) II = f
3902) endif
3903) else
3904) II = f
3905) endif
3906)
3907) if (II < 0.d0) then
3908) write(option%io_buffer,*) 'ionic strength negative! it =',it, &
3909) ' I= ',I,II,den,didi,dcdi,sum
3910) call printErrMsgByRank(option)
3911) endif
3912)
3913) ! compute activity coefficients
3914) ! primary species
3915) I = II
3916) sqrt_I = sqrt(I)
3917) do icomp = 1, reaction%naqcomp
3918) if (abs(reaction%primary_spec_Z(icomp)) > 0.d0) then
3919) rt_auxvar%pri_act_coef(icomp) = exp((-reaction%primary_spec_Z(icomp)* &
3920) reaction%primary_spec_Z(icomp)* &
3921) sqrt_I*reaction%debyeA/ &
3922) (1.d0+reaction%primary_spec_a0(icomp)* &
3923) reaction%debyeB*sqrt_I)+ &
3924) reaction%debyeBdot*I)* &
3925) LOG_TO_LN)
3926) else
3927) rt_auxvar%pri_act_coef(icomp) = 1.d0
3928) endif
3929) enddo
3930)
3931) ! secondary species
3932) sum_sec_molal = 0.d0
3933) do icplx = 1, reaction%neqcplx
3934) if (abs(reaction%eqcplx_Z(icplx)) > 0.d0) then
3935) rt_auxvar%sec_act_coef(icplx) = exp((-reaction%eqcplx_Z(icplx)* &
3936) reaction%eqcplx_Z(icplx)* &
3937) sqrt_I*reaction%debyeA/ &
3938) (1.d0+reaction%eqcplx_a0(icplx)* &
3939) reaction%debyeB*sqrt_I)+ &
3940) reaction%debyeBdot*I)* &
3941) LOG_TO_LN)
3942) else
3943) rt_auxvar%sec_act_coef(icplx) = 1.d0
3944) endif
3945)
3946) ! compute secondary species concentration
3947) lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
3948)
3949) ! activity of water
3950) if (reaction%eqcplxh2oid(icplx) > 0) then
3951) lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
3952) endif
3953)
3954) ncomp = reaction%eqcplxspecid(0,icplx)
3955) do jcomp = 1, ncomp
3956) icomp = reaction%eqcplxspecid(jcomp,icplx)
3957) lnQK = lnQK + reaction%eqcplxstoich(jcomp,icplx)*ln_act(icomp)
3958) enddo
3959) rt_auxvar%sec_molal(icplx) = exp(lnQK)/rt_auxvar%sec_act_coef(icplx)
3960) sum_sec_molal = sum_sec_molal + rt_auxvar%sec_molal(icplx)
3961)
3962) enddo
3963)
3964) if (reaction%use_activity_h2o) then
3965) rt_auxvar%ln_act_h2o = 1.d0-0.017d0*(sum_pri_molal+sum_sec_molal)
3966) if (rt_auxvar%ln_act_h2o > 0.d0) then
3967) rt_auxvar%ln_act_h2o = log(rt_auxvar%ln_act_h2o)
3968) else
3969) rt_auxvar%ln_act_h2o = 0.d0
3970) write(option%io_buffer,*) 'activity of H2O negative! ln act H2O =', &
3971) rt_auxvar%ln_act_h2o
3972) call printMsg(option)
3973) endif
3974) endif
3975)
3976) enddo
3977)
3978) else
3979)
3980) ! compute ionic strength
3981) ! primary species
3982) I = 0.d0
3983) do icomp = 1, reaction%naqcomp
3984) I = I + rt_auxvar%pri_molal(icomp)*reaction%primary_spec_Z(icomp)* &
3985) reaction%primary_spec_Z(icomp)
3986) enddo
3987)
3988) ! secondary species
3989) do icplx = 1, reaction%neqcplx ! for each secondary species
3990) I = I + rt_auxvar%sec_molal(icplx)*reaction%eqcplx_Z(icplx)* &
3991) reaction%eqcplx_Z(icplx)
3992) enddo
3993) I = 0.5d0*I
3994) sqrt_I = sqrt(I)
3995)
3996) ! compute activity coefficients
3997) ! primary species
3998) do icomp = 1, reaction%naqcomp
3999) if (abs(reaction%primary_spec_Z(icomp)) > 1.d-10) then
4000) rt_auxvar%pri_act_coef(icomp) = exp((-reaction%primary_spec_Z(icomp)* &
4001) reaction%primary_spec_Z(icomp)* &
4002) sqrt_I*reaction%debyeA/ &
4003) (1.d0+reaction%primary_spec_a0(icomp)* &
4004) reaction%debyeB*sqrt_I)+ &
4005) reaction%debyeBdot*I)* &
4006) LOG_TO_LN)
4007) else
4008) rt_auxvar%pri_act_coef(icomp) = 1.d0
4009) endif
4010) enddo
4011)
4012) ! secondary species
4013) sum_sec_molal = 0.d0
4014) do icplx = 1, reaction%neqcplx
4015) if (dabs(reaction%eqcplx_Z(icplx)) > 1.d-10) then
4016) rt_auxvar%sec_act_coef(icplx) = exp((-reaction%eqcplx_Z(icplx)* &
4017) reaction%eqcplx_Z(icplx)* &
4018) sqrt_I*reaction%debyeA/ &
4019) (1.d0+reaction%eqcplx_a0(icplx)* &
4020) reaction%debyeB*sqrt_I)+ &
4021) reaction%debyeBdot*I)* &
4022) LOG_TO_LN)
4023) else
4024) rt_auxvar%sec_act_coef(icplx) = 1.d0
4025) endif
4026) sum_sec_molal = sum_sec_molal + rt_auxvar%sec_molal(icplx)
4027) enddo
4028)
4029) if (reaction%use_activity_h2o) then
4030) rt_auxvar%ln_act_h2o = 1.d0-0.017d0*(sum_pri_molal+sum_sec_molal)
4031) if (rt_auxvar%ln_act_h2o > 0.d0) then
4032) rt_auxvar%ln_act_h2o = log(rt_auxvar%ln_act_h2o)
4033) else
4034) rt_auxvar%ln_act_h2o = 0.d0
4035) endif
4036) endif
4037) endif
4038)
4039) end subroutine RActivityCoefficients
4040)
4041) ! ************************************************************************** !
4042)
4043) subroutine RTotal(rt_auxvar,global_auxvar,reaction,option)
4044) !
4045) ! Computes the total component concentrations and derivative with
4046) ! respect to free-ion
4047) !
4048) ! Author: Glenn Hammond
4049) ! Date: 08/28/08
4050) !
4051)
4052) use Option_module
4053)
4054) ! CO2-specific
4055) use co2eos_module, only: Henry_duan_sun
4056) use EOS_Water_module
4057)
4058) implicit none
4059)
4060) type(reactive_transport_auxvar_type) :: rt_auxvar
4061) type(global_auxvar_type) :: global_auxvar
4062) type(reaction_type) :: reaction
4063) type(option_type) :: option
4064)
4065) PetscInt :: i, j, icplx, icomp, jcomp, iphase, ncomp, ieqgas
4066) PetscErrorCode :: ierr
4067) PetscReal :: ln_conc(reaction%naqcomp)
4068) PetscReal :: ln_act(reaction%naqcomp)
4069) PetscReal :: lnQK, tempreal
4070) PetscReal :: den_kg_per_L, xmass
4071) PetscReal :: pressure, temperature, xphico2, muco2, den, m_na, m_cl
4072)
4073) ! CO2-specific
4074) PetscReal :: dg,dddt,dddp,fg,dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,&
4075) yco2,pco2,sat_pressure,lngamco2
4076) rt_auxvar%total = 0.d0 !debugging
4077)
4078) iphase = 1
4079) ! den_kg_per_L = global_auxvar%den_kg(iphase)*1.d-3
4080) xmass = 1.d0
4081) if (associated(global_auxvar%xmass)) xmass = global_auxvar%xmass(iphase)
4082) den_kg_per_L = global_auxvar%den_kg(iphase)*xmass*1.d-3
4083)
4084) ln_conc = log(rt_auxvar%pri_molal)
4085) ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
4086) rt_auxvar%total(:,iphase) = rt_auxvar%pri_molal(:)
4087)
4088) ! initialize derivatives
4089) rt_auxvar%aqueous%dtotal = 0.d0
4090) do icomp = 1, reaction%naqcomp
4091) rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) = 1.d0
4092) enddo
4093)
4094) do icplx = 1, reaction%neqcplx ! for each secondary species
4095) ! compute secondary species concentration
4096) lnQK = -reaction%eqcplx_logK(icplx)*LOG_TO_LN
4097)
4098) ! activity of water
4099) if (reaction%eqcplxh2oid(icplx) > 0) then
4100) lnQK = lnQK + reaction%eqcplxh2ostoich(icplx)*rt_auxvar%ln_act_h2o
4101) endif
4102)
4103) ncomp = reaction%eqcplxspecid(0,icplx)
4104) do i = 1, ncomp
4105) icomp = reaction%eqcplxspecid(i,icplx)
4106) lnQK = lnQK + reaction%eqcplxstoich(i,icplx)*ln_act(icomp)
4107) enddo
4108) rt_auxvar%sec_molal(icplx) = exp(lnQK)/rt_auxvar%sec_act_coef(icplx)
4109)
4110) ! add contribution to primary totals
4111) ! units of total = mol/L
4112) do i = 1, ncomp
4113) icomp = reaction%eqcplxspecid(i,icplx)
4114) rt_auxvar%total(icomp,iphase) = rt_auxvar%total(icomp,iphase) + &
4115) reaction%eqcplxstoich(i,icplx)* &
4116) rt_auxvar%sec_molal(icplx)
4117) enddo
4118)
4119) ! add contribution to derivatives of total with respect to free
4120) ! bear in mind that the water density portion is scaled below
4121) do j = 1, ncomp
4122) jcomp = reaction%eqcplxspecid(j,icplx)
4123) tempreal = reaction%eqcplxstoich(j,icplx)*exp(lnQK-ln_conc(jcomp))/ &
4124) rt_auxvar%sec_act_coef(icplx)
4125) do i = 1, ncomp
4126) icomp = reaction%eqcplxspecid(i,icplx)
4127) rt_auxvar%aqueous%dtotal(icomp,jcomp,iphase) = &
4128) rt_auxvar%aqueous%dtotal(icomp,jcomp,iphase) + &
4129) reaction%eqcplxstoich(i,icplx)*tempreal
4130) enddo
4131) enddo
4132) enddo
4133)
4134) ! convert molality -> molarity
4135) ! unit of total = mol/L water
4136) rt_auxvar%total(:,iphase) = rt_auxvar%total(:,iphase)*den_kg_per_L
4137)
4138) ! units of dtotal = kg water/L water
4139) rt_auxvar%aqueous%dtotal = rt_auxvar%aqueous%dtotal*den_kg_per_L
4140)
4141) if (option%iflowmode == G_MODE) return
4142)
4143) ! *********** Add SC phase and gas contributions ***********************
4144) ! CO2-specific
4145)
4146) iphase = 2
4147)
4148) if (iphase > option%nphase) return
4149) rt_auxvar%total(:,iphase) = 0.D0
4150) rt_auxvar%aqueous%dtotal(:,:,iphase) = 0.D0
4151)
4152) ! den_kg_per_L = global_auxvar%den_kg(iphase)*1.d-3
4153)
4154) if (global_auxvar%sat(iphase) > 1.D-20) then
4155) do ieqgas = 1, reaction%ngas ! all gas phase species are secondary
4156)
4157) pressure = global_auxvar%pres(2)
4158) temperature = global_auxvar%temp
4159) xphico2 = global_auxvar%fugacoeff(1)
4160) den = global_auxvar%den(2)
4161)
4162) call EOSWaterSaturationPressure(temperature, sat_pressure, ierr)
4163) pco2 = pressure - sat_pressure
4164) ! call co2_span_wagner(pressure*1.D-6,temperature+273.15D0,dg,dddt,dddp,fg, &
4165) ! dfgdp,dfgdt,eng,hg,dhdt,dhdp,visg,dvdt,dvdp,option%itable)
4166) !
4167) ! fg = fg*1D6
4168) ! xphico2 = fg / pco2
4169) ! global_auxvar%fugacoeff(1) = xphico2
4170)
4171)
4172) if (abs(reaction%species_idx%co2_gas_id) == ieqgas ) then
4173)
4174) if (reaction%species_idx%na_ion_id /= 0 .and. reaction%species_idx%cl_ion_id /= 0) then
4175) m_na = rt_auxvar%pri_molal(reaction%species_idx%na_ion_id)
4176) m_cl = rt_auxvar%pri_molal(reaction%species_idx%cl_ion_id)
4177) call Henry_duan_sun(temperature,pressure*1D-5,muco2, &
4178) lngamco2,m_na,m_cl)
4179) else
4180) call Henry_duan_sun(temperature,pressure*1D-5,muco2, &
4181) lngamco2,option%m_nacl,option%m_nacl)
4182) endif
4183) !lnQk = - log(muco2)
4184) lnQk = - log(muco2)-lngamco2
4185)
4186) else
4187) lngamco2 = 0.d0
4188) lnQK = -reaction%eqgas_logK(ieqgas)*LOG_TO_LN
4189) endif
4190)
4191) if (reaction%eqgash2oid(ieqgas) > 0) then
4192) lnQK = lnQK + reaction%eqgash2ostoich(ieqgas)*rt_auxvar%ln_act_h2o
4193) endif
4194)
4195) ! contribute to %total
4196) ! do i = 1, ncomp
4197) ! removed loop over species, suppose only one primary species is related
4198) icomp = reaction%eqgasspecid(1,ieqgas)
4199) pressure = pressure * 1.D-5
4200)
4201) ! rt_auxvar%gas_molar(ieqgas) = &
4202) ! exp(lnQK+lngamco2)*rt_auxvar%pri_molal(icomp) &
4203) ! /(IDEAL_GAS_CONSTANT*1.d-2*(temperature+273.15D0)*xphico2)
4204)
4205) ! This form includes factor Z in pV = ZRT for nonideal gas
4206) rt_auxvar%gas_molar(ieqgas) = &
4207) exp(lnQK)*rt_auxvar%pri_act_coef(icomp)*rt_auxvar%pri_molal(icomp)* &
4208) den/pressure/xphico2
4209)
4210) rt_auxvar%total(icomp,iphase) = rt_auxvar%total(icomp,iphase) + &
4211) reaction%eqgasstoich(1,ieqgas)* &
4212) rt_auxvar%gas_molar(ieqgas)
4213)
4214) ! print *,'RTotal: ',icomp,ieqgas,pressure, temperature, xphico2, &
4215) ! global_auxvar%sat(iphase),rt_auxvar%gas_molar(ieqgas), &
4216) ! rt_auxvar%pri_act_coef(icomp)*exp(lnQK)*rt_auxvar%pri_molal(icomp) &
4217) ! /pressure/xphico2*den
4218)
4219)
4220) ! contribute to %dtotal
4221) ! tempreal = exp(lnQK+lngamco2)/pressure/xphico2*den
4222) ! tempreal = rt_auxvar%pri_act_coef(icomp)*exp(lnQK) &
4223) ! /pressure/xphico2*den
4224) tempreal = rt_auxvar%gas_molar(ieqgas)/rt_auxvar%pri_molal(icomp)
4225) rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) = &
4226) rt_auxvar%aqueous%dtotal(icomp,icomp,iphase) + &
4227) reaction%eqgasstoich(1,ieqgas)*tempreal
4228) enddo
4229) ! rt_auxvar%total(:,iphase) = rt_auxvar%total(:,iphase)!*den_kg_per_L
4230) ! units of dtotal = kg water/L water
4231) ! rt_auxvar%dtotal(:, :,iphase) = rt_auxvar%dtotal(:,:,iphase)!*den_kg_per_L
4232) endif
4233)
4234) end subroutine RTotal
4235)
4236) ! ************************************************************************** !
4237)
4238) subroutine RZeroSorb(rt_auxvar)
4239) !
4240) ! Zeros out arrays associated with sorption
4241) !
4242) ! Author: Glenn Hammond
4243) ! Date: 03/20/12
4244) !
4245)
4246) implicit none
4247)
4248) type(reactive_transport_auxvar_type) :: rt_auxvar
4249)
4250) if (associated(rt_auxvar%total_sorb_eq)) rt_auxvar%total_sorb_eq = 0.d0
4251) if (associated(rt_auxvar%dtotal_sorb_eq)) rt_auxvar%dtotal_sorb_eq = 0.d0
4252) if (associated(rt_auxvar%eqsrfcplx_conc)) rt_auxvar%eqsrfcplx_conc = 0.d0
4253)
4254) end subroutine RZeroSorb
4255)
4256) ! ************************************************************************** !
4257)
4258) subroutine RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
4259) !
4260) ! Computes the total sorbed component concentrations and
4261) ! derivative with respect to free-ion
4262) !
4263) ! Author: Glenn Hammond
4264) ! Date: 10/22/08
4265) !
4266)
4267) use Option_module
4268)
4269) implicit none
4270)
4271) type(reactive_transport_auxvar_type) :: rt_auxvar
4272) type(global_auxvar_type) :: global_auxvar
4273) class(material_auxvar_type) :: material_auxvar
4274) type(reaction_type) :: reaction
4275) type(option_type) :: option
4276)
4277) call RZeroSorb(rt_auxvar)
4278)
4279) if (reaction%surface_complexation%neqsrfcplxrxn > 0) then
4280) call RTotalSorbEqSurfCplx(rt_auxvar,global_auxvar,material_auxvar, &
4281) reaction,option)
4282) endif
4283)
4284) if (reaction%neqionxrxn > 0) then
4285) call RTotalSorbEqIonx(rt_auxvar,global_auxvar,reaction,option)
4286) endif
4287)
4288) if (reaction%neqkdrxn > 0) then
4289) call RTotalSorbKD(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
4290) endif
4291)
4292) end subroutine RTotalSorb
4293)
4294) ! ************************************************************************** !
4295)
4296) subroutine RTotalSorbKD(rt_auxvar,global_auxvar,material_auxvar,reaction, &
4297) option)
4298) !
4299) ! Computes the total sorbed component concentrations and
4300) ! derivative with respect to free-ion for the linear
4301) ! K_D model
4302) !
4303) ! Author: Glenn Hammond
4304) ! Date: 09/30/2010
4305) !
4306)
4307) use Option_module
4308)
4309) implicit none
4310)
4311) type(reactive_transport_auxvar_type) :: rt_auxvar
4312) type(global_auxvar_type) :: global_auxvar
4313) class(material_auxvar_type) :: material_auxvar
4314) type(reaction_type) :: reaction
4315) type(option_type) :: option
4316)
4317) PetscInt :: irxn
4318) PetscInt :: icomp
4319) PetscReal :: res
4320) PetscReal :: dres_dc
4321) PetscReal :: molality
4322) PetscReal :: tempreal
4323) PetscReal :: one_over_n
4324) PetscReal :: molality_one_over_n
4325) PetscReal :: kd_kgw_m3b
4326) PetscReal :: temp
4327)
4328) PetscInt, parameter :: iphase = 1
4329)
4330) do irxn = 1, reaction%neqkdrxn
4331) icomp = reaction%eqkdspecid(irxn)
4332) molality = rt_auxvar%pri_molal(icomp)
4333) if (reaction%eqkdmineral(irxn) > 0) then
4334) ! NOTE: mineral volume fraction here is solely a scaling factor. It has
4335) ! nothing to do with the soil volume; that is calculated through as a
4336) ! function of porosity.
4337) temp = reaction%eqkddistcoef(irxn)
4338) temp = global_auxvar%den_kg(iphase)
4339) temp = (1.d0-material_auxvar%porosity)
4340) temp = material_auxvar%soil_particle_density
4341) temp = (rt_auxvar%mnrl_volfrac(reaction%eqkdmineral(irxn)))
4342) kd_kgw_m3b = reaction%eqkddistcoef(irxn) * & !KD units [mL water/g soil]
4343) global_auxvar%den_kg(iphase) * &
4344) (1.d0-material_auxvar%porosity) * &
4345) material_auxvar%soil_particle_density * &
4346) 1.d-3 * & ! convert mL water/g soil to m^3 water/kg soil
4347) (rt_auxvar%mnrl_volfrac(reaction%eqkdmineral(irxn)))
4348) else
4349) kd_kgw_m3b = reaction%eqkddistcoef(irxn)
4350) endif
4351) select case(reaction%eqkdtype(irxn))
4352) case(SORPTION_LINEAR)
4353) ! Csorb = Kd*Caq
4354) res = kd_kgw_m3b*molality
4355) dres_dc = kd_kgw_m3b
4356) case(SORPTION_LANGMUIR)
4357) ! Csorb = K*Caq*b/(1+K*Caq)
4358) tempreal = kd_kgw_m3b*molality
4359) res = tempreal*reaction%eqkdlangmuirb(irxn) / (1.d0 + tempreal)
4360) dres_dc = res/molality - &
4361) res / (1.d0 + tempreal) * tempreal / molality
4362) case(SORPTION_FREUNDLICH)
4363) ! Csorb = Kd*Caq**(1/n)
4364) one_over_n = 1.d0/reaction%eqkdfreundlichn(irxn)
4365) molality_one_over_n = molality**one_over_n
4366) res = kd_kgw_m3b*molality**one_over_n
4367) dres_dc = res/molality*one_over_n
4368) case default
4369) res = 0.d0
4370) dres_dc = 0.d0
4371) end select
4372) rt_auxvar%total_sorb_eq(icomp) = rt_auxvar%total_sorb_eq(icomp) + res
4373) rt_auxvar%dtotal_sorb_eq(icomp,icomp) = &
4374) rt_auxvar%dtotal_sorb_eq(icomp,icomp) + dres_dc
4375) enddo
4376)
4377) end subroutine RTotalSorbKD
4378)
4379) ! ************************************************************************** !
4380)
4381) subroutine RTotalSorbEqIonx(rt_auxvar,global_auxvar,reaction,option)
4382) !
4383) ! Computes the total sorbed component concentrations and
4384) ! derivative with respect to free-ion for equilibrium ion
4385) ! exchange
4386) !
4387) ! Author: Glenn Hammond
4388) ! Date: 10/22/08; 05/26/09
4389) !
4390)
4391) use Option_module
4392)
4393) implicit none
4394)
4395) type(reactive_transport_auxvar_type) :: rt_auxvar
4396) type(global_auxvar_type) :: global_auxvar
4397) type(reaction_type) :: reaction
4398) type(option_type) :: option
4399)
4400) PetscInt :: i, j, k, icplx, icomp, jcomp, iphase, ncomp, ncplx
4401) PetscReal :: ln_conc(reaction%naqcomp)
4402) PetscReal :: ln_act(reaction%naqcomp)
4403) PetscReal :: tempreal, tempreal1, tempreal2, total
4404) PetscInt :: irxn
4405) PetscReal, parameter :: tol = 1.d-12
4406) PetscBool :: one_more
4407) PetscReal :: res
4408)
4409) PetscReal :: omega
4410) PetscReal :: ref_cation_X, ref_cation_conc, ref_cation_Z, ref_cation_k, &
4411) ref_cation_quotient
4412) PetscReal :: cation_X(reaction%naqcomp)
4413) PetscReal :: dres_dref_cation_X, dref_cation_X
4414) PetscReal :: sumZX, sumkm
4415)
4416) PetscReal :: total_pert, ref_cation_X_pert, pert
4417) PetscReal :: ref_cation_quotient_pert, dres_dref_cation_X_pert
4418)
4419) PetscReal :: KDj, dres_dKDj, delta_KDj
4420) PetscInt :: it
4421)
4422) ln_conc = log(rt_auxvar%pri_molal)
4423) ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
4424)
4425) ! Ion Exchange
4426) if (associated(rt_auxvar%eqionx_conc)) rt_auxvar%eqionx_conc = 0.d0
4427) do irxn = 1, reaction%neqionxrxn
4428)
4429) ncomp = reaction%eqionx_rxn_cationid(0,irxn)
4430)
4431) ! for now we assume that omega is equal to CEC.
4432) if (reaction%eqionx_rxn_to_surf(irxn) > 0) then
4433) ! if tied to a mineral vol frac
4434) omega = max(reaction%eqionx_rxn_CEC(irxn)* &
4435) rt_auxvar%mnrl_volfrac(reaction%eqionx_rxn_to_surf(irxn)), &
4436) 1.d-40)
4437) else
4438) omega = reaction%eqionx_rxn_CEC(irxn)
4439) endif
4440)
4441) if (reaction%eqionx_rxn_Z_flag(irxn)) then ! Zi /= Zj for any i,j
4442)
4443) icomp = reaction%eqionx_rxn_cationid(1,irxn)
4444) ref_cation_conc = rt_auxvar%pri_molal(icomp)*rt_auxvar%pri_act_coef(icomp)
4445) ref_cation_Z = reaction%primary_spec_Z(icomp)
4446) ref_cation_k = reaction%eqionx_rxn_k(1,irxn)
4447) ref_cation_X = ref_cation_Z* &
4448) rt_auxvar%eqionx_ref_cation_sorbed_conc(irxn)/omega
4449)
4450) one_more = PETSC_FALSE
4451) cation_X = 0.d0
4452) KDj = ref_cation_X /(ref_cation_k*ref_cation_conc)
4453) it = 0
4454) !geh: Change from 0 to 1 to run new implementation.
4455) #if 1
4456) do
4457) it = it + 1
4458) if (it > 20000) then
4459) option%io_buffer = 'Too many Newton iterations in ion exchange.'
4460) call printErrMsgByRank(option)
4461) endif
4462) ref_cation_X = KDj*(ref_cation_k*ref_cation_conc)
4463) cation_X(1) = ref_cation_X
4464) total = ref_cation_X
4465) dres_dKDj = 0.d0
4466) do j = 2, ncomp
4467) icomp = reaction%eqionx_rxn_cationid(j,irxn)
4468) cation_X(j) = reaction%eqionx_rxn_k(j,irxn)* &
4469) rt_auxvar%pri_molal(icomp)* &
4470) rt_auxvar%pri_act_coef(icomp)* &
4471) KDj**(reaction%primary_spec_Z(icomp)/ref_cation_Z)
4472) total = total + cation_X(j)
4473) dres_dKDj = dres_dKDj + cation_X(j)/KDj* &
4474) reaction%primary_spec_Z(icomp)
4475) enddo
4476) dres_dKDj = dres_dKDj/ref_cation_Z + (ref_cation_k*ref_cation_conc)
4477) res = 1.d0 - total
4478)
4479) if (one_more) exit
4480)
4481) ! no need to negate since res is subtracted above.
4482) delta_KDj = res/dres_dKDj
4483) KDj = KDj + delta_KDj
4484) KDj = max(KDj,1.d-40) ! prevent from going negative
4485) if (dabs(delta_KDj/KDj) < tol) then
4486) one_more = PETSC_TRUE
4487) endif
4488) enddo
4489) #else
4490) do
4491) if (ref_cation_X <= 0.d0) ref_cation_X = 1.d-8
4492) cation_X(1) = ref_cation_X
4493) ref_cation_quotient = ref_cation_X/(ref_cation_k*ref_cation_conc)
4494) total = ref_cation_X
4495)
4496) do j = 2, ncomp
4497) icomp = reaction%eqionx_rxn_cationid(j,irxn)
4498) cation_X(j) = rt_auxvar%pri_molal(icomp)* &
4499) rt_auxvar%pri_act_coef(icomp)* &
4500) reaction%eqionx_rxn_k(j,irxn)* &
4501) ref_cation_quotient** &
4502) (reaction%primary_spec_Z(icomp)/ref_cation_Z)
4503) total = total + cation_X(j)
4504) enddo
4505)
4506) if (one_more) exit
4507)
4508) res = 1.d0-total
4509)
4510) dres_dref_cation_X = 1.d0
4511)
4512) #if 0
4513) ! test derivative
4514) pert = 1.d-6 * ref_cation_X
4515) ref_cation_X_pert = ref_cation_X + pert
4516) ref_cation_quotient_pert = ref_cation_X_pert/ &
4517) (ref_cation_k*ref_cation_conc)
4518) total_pert = ref_cation_X_pert
4519)
4520) do j = 2, ncomp
4521) icomp = reaction%eqionx_rxn_cationid(j,irxn)
4522) total_pert = total_pert + &
4523) rt_auxvar%pri_molal(icomp)* &
4524) rt_auxvar%pri_act_coef(icomp)* &
4525) reaction%eqionx_rxn_k(j,irxn)* &
4526) ref_cation_quotient_pert** &
4527) (reaction%primary_spec_Z(icomp)/ref_cation_Z)
4528) enddo
4529) dres_dref_cation_X_pert = (1.d0-total_pert-res)/pert
4530) ! test
4531) #endif
4532)
4533) do j = 2, ncomp
4534) icomp = reaction%eqionx_rxn_cationid(j,irxn)
4535) dres_dref_cation_X = dres_dref_cation_X + &
4536) (reaction%primary_spec_Z(icomp)/ref_cation_Z)* &
4537) cation_X(j)/ref_cation_X
4538) enddo
4539)
4540) dref_cation_X = res / (-dres_dref_cation_X)
4541) ! dref_cation_X = res / dres_dref_cation_X_pert
4542) ref_cation_X = ref_cation_X - dref_cation_X
4543)
4544) if (dabs(dref_cation_X/ref_cation_X) < tol) then
4545) one_more = PETSC_TRUE
4546) endif
4547)
4548) enddo
4549) #endif
4550)
4551) rt_auxvar%eqionx_ref_cation_sorbed_conc(irxn) = ref_cation_X*omega/ &
4552) ref_cation_Z
4553)
4554) else ! Zi == Zj for all i,j
4555)
4556) sumkm = 0.d0
4557) cation_X = 0.d0
4558)
4559) do j = 1, ncomp
4560) icomp = reaction%eqionx_rxn_cationid(j,irxn)
4561) cation_X(j) = rt_auxvar%pri_molal(icomp)* &
4562) rt_auxvar%pri_act_coef(icomp)* &
4563) reaction%eqionx_rxn_k(j,irxn)
4564) sumkm = sumkm + cation_X(j)
4565) enddo
4566)
4567) cation_X = cation_X / sumkm
4568)
4569) endif
4570)
4571) ! sum up charges
4572) sumZX = 0.d0
4573) do i = 1, ncomp
4574) icomp = reaction%eqionx_rxn_cationid(i,irxn)
4575) sumZX = sumZX + reaction%primary_spec_Z(icomp)*cation_X(i)
4576) enddo
4577)
4578) ! compute totals based on sorbed ions
4579) do i = 1, ncomp
4580) icomp = reaction%eqionx_rxn_cationid(i,irxn)
4581) tempreal1 = cation_X(i)*omega/reaction%primary_spec_Z(icomp)
4582) ! residual function entry
4583)
4584) rt_auxvar%eqionx_conc(i,irxn) = rt_auxvar%eqionx_conc(i,irxn) + tempreal1
4585)
4586) rt_auxvar%total_sorb_eq(icomp) = rt_auxvar%total_sorb_eq(icomp) + &
4587) tempreal1
4588)
4589) tempreal2 = reaction%primary_spec_Z(icomp)/sumZX
4590) do j = 1, ncomp
4591) jcomp = reaction%eqionx_rxn_cationid(j,irxn)
4592) if (i == j) then
4593) rt_auxvar%dtotal_sorb_eq(icomp,jcomp) = &
4594) rt_auxvar%dtotal_sorb_eq(icomp,jcomp) + &
4595) tempreal1*(1.d0-(tempreal2*cation_X(j)))/ &
4596) rt_auxvar%pri_molal(jcomp)
4597) else
4598) rt_auxvar%dtotal_sorb_eq(icomp,jcomp) = &
4599) rt_auxvar%dtotal_sorb_eq(icomp,jcomp) + &
4600) (-tempreal1)*tempreal2*cation_X(j)/ &
4601) rt_auxvar%pri_molal(jcomp)
4602) endif
4603) enddo
4604) enddo
4605)
4606) enddo
4607)
4608) ! units of total_sorb = mol/m^3
4609) ! units of dtotal_sorb = kg water/m^3 bulk
4610)
4611) end subroutine RTotalSorbEqIonx
4612)
4613) ! ************************************************************************** !
4614)
4615) subroutine RAccumulationSorb(rt_auxvar,global_auxvar,material_auxvar, &
4616) reaction,option,Res)
4617) !
4618) ! Computes non-aqueous portion of the accumulation term in
4619) ! residual function
4620) !
4621) ! Author: Glenn Hammond
4622) ! Date: 05/26/09
4623) !
4624)
4625) use Option_module
4626)
4627) implicit none
4628)
4629) type(reactive_transport_auxvar_type) :: rt_auxvar
4630) type(global_auxvar_type) :: global_auxvar
4631) class(material_auxvar_type) :: material_auxvar
4632) type(option_type) :: option
4633) type(reaction_type) :: reaction
4634) PetscReal :: Res(reaction%ncomp)
4635)
4636) PetscReal :: v_t
4637)
4638) ! units = (mol solute/m^3 bulk)*(m^3 bulk)/(sec) = mol/sec
4639) ! all residual entries should be in mol/sec
4640) v_t = material_auxvar%volume/option%tran_dt
4641) Res(1:reaction%naqcomp) = Res(1:reaction%naqcomp) + &
4642) rt_auxvar%total_sorb_eq(:)*v_t
4643)
4644) end subroutine RAccumulationSorb
4645)
4646) ! ************************************************************************** !
4647)
4648) subroutine RAccumulationSorbDerivative(rt_auxvar,global_auxvar, &
4649) material_auxvar,reaction,option,J)
4650) !
4651) ! Computes derivative of non-aqueous portion of
4652) ! the accumulation term in residual function
4653) !
4654) ! Author: Glenn Hammond
4655) ! Date: 05/26/09
4656) !
4657)
4658) use Option_module
4659)
4660) implicit none
4661)
4662) type(reactive_transport_auxvar_type) :: rt_auxvar
4663) type(global_auxvar_type) :: global_auxvar
4664) class(material_auxvar_type) :: material_auxvar
4665) type(option_type) :: option
4666) type(reaction_type) :: reaction
4667) PetscReal :: J(reaction%ncomp,reaction%ncomp)
4668)
4669) PetscInt :: icomp
4670) PetscReal :: v_t
4671)
4672) ! units = (kg water/m^3 bulk)*(m^3 bulk)/(sec) = kg water/sec
4673) ! all Jacobian entries should be in kg water/sec
4674) v_t = material_auxvar%volume/option%tran_dt
4675) J(1:reaction%naqcomp,1:reaction%naqcomp) = &
4676) J(1:reaction%naqcomp,1:reaction%naqcomp) + &
4677) rt_auxvar%dtotal_sorb_eq(:,:)*v_t
4678)
4679) end subroutine RAccumulationSorbDerivative
4680)
4681) ! ************************************************************************** !
4682)
4683) subroutine RRadioactiveDecay(Res,Jac,compute_derivative,rt_auxvar, &
4684) global_auxvar,material_auxvar,reaction,option)
4685) !
4686) ! Computes radioactive decay with a single reactant
4687) ! (considering both the aqueous and sorbed phases) with
4688) ! the possibility of multiple daughter products
4689) !
4690) ! Author: Glenn Hammond
4691) ! Date: 09/08/10, 01/07/13
4692) !
4693)
4694) use Option_module
4695)
4696) implicit none
4697)
4698) type(option_type) :: option
4699) type(reaction_type) :: reaction
4700) PetscBool :: compute_derivative
4701) PetscReal :: Res(reaction%ncomp)
4702) PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
4703) type(reactive_transport_auxvar_type) :: rt_auxvar
4704) type(global_auxvar_type) :: global_auxvar
4705) class(material_auxvar_type) :: material_auxvar
4706)
4707) PetscInt :: i, icomp, jcomp, irxn, ncomp
4708) PetscReal :: tempreal, L_water, sum, rate
4709)
4710) PetscInt, parameter :: iphase = 1
4711)
4712) L_water = material_auxvar%porosity*global_auxvar%sat(iphase)* &
4713) material_auxvar%volume*1.d3 ! L water
4714)
4715) do irxn = 1, reaction%nradiodecay_rxn ! for each reaction
4716)
4717) ! units(kf): 1/sec
4718)
4719) ! we assume only one chemical component involved in decay reaction
4720) icomp = reaction%radiodecayforwardspecid(irxn)
4721)
4722) ! sum total moles of component in aqueous and sorbed phases
4723) sum = rt_auxvar%total(icomp,iphase)*L_water
4724) if (associated(rt_auxvar%total_sorb_eq)) then
4725) sum = sum + rt_auxvar%total_sorb_eq(icomp)*material_auxvar%volume
4726) endif
4727)
4728) rate = sum*reaction%radiodecay_kf(irxn)
4729)
4730) ! units(Res): mol/sec
4731) ncomp = reaction%radiodecayspecid(0,irxn)
4732) do i = 1, ncomp
4733) icomp = reaction%radiodecayspecid(i,irxn)
4734) ! units = mol/sec
4735) Res(icomp) = Res(icomp) - reaction%radiodecaystoich(i,irxn)*rate
4736) enddo
4737)
4738) if (.not. compute_derivative) cycle
4739)
4740) tempreal = -1.d0*reaction%radiodecay_kf(irxn)
4741) jcomp = reaction%radiodecayforwardspecid(irxn)
4742) if (associated(rt_auxvar%dtotal_sorb_eq)) then
4743) do i = 1, ncomp
4744) icomp = reaction%radiodecayspecid(i,irxn)
4745) ! units = (mol/sec)*(kg water/mol) = kg water/sec
4746) Jac(icomp,1:reaction%naqcomp) = Jac(icomp,1:reaction%naqcomp) + &
4747) tempreal * &
4748) reaction%radiodecaystoich(i,irxn) * &
4749) (rt_auxvar%aqueous%dtotal(jcomp,1:reaction%naqcomp,iphase)*L_water + &
4750) rt_auxvar%dtotal_sorb_eq(jcomp,1:reaction%naqcomp)* &
4751) material_auxvar%volume)
4752) enddo
4753) else ! no sorption
4754) do i = 1, ncomp
4755) icomp = reaction%radiodecayspecid(i,irxn)
4756) ! units = (mol/sec)*(kg water/mol) = kg water/sec
4757) Jac(icomp,1:reaction%naqcomp) = Jac(icomp,1:reaction%naqcomp) + &
4758) tempreal * &
4759) reaction%radiodecaystoich(i,irxn) * &
4760) rt_auxvar%aqueous%dtotal(jcomp,1:reaction%naqcomp,iphase)*L_water
4761) enddo
4762) endif
4763)
4764) enddo ! loop over reactions
4765)
4766) end subroutine RRadioactiveDecay
4767)
4768) ! ************************************************************************** !
4769)
4770) subroutine RGeneral(Res,Jac,compute_derivative,rt_auxvar,global_auxvar, &
4771) material_auxvar,reaction,option)
4772) !
4773) ! Computes the general reaction rates
4774) !
4775) ! Author: Glenn Hammond
4776) ! Date: 09/08/10
4777) !
4778)
4779) use Option_module
4780)
4781) implicit none
4782)
4783) type(option_type) :: option
4784) type(reaction_type) :: reaction
4785) PetscBool :: compute_derivative
4786) PetscReal :: Res(reaction%ncomp)
4787) PetscReal :: Jac(reaction%ncomp,reaction%ncomp)
4788) type(reactive_transport_auxvar_type) :: rt_auxvar
4789) type(global_auxvar_type) :: global_auxvar
4790) class(material_auxvar_type) :: material_auxvar
4791)
4792) PetscReal :: ln_conc(reaction%naqcomp)
4793) PetscReal :: ln_act(reaction%naqcomp)
4794)
4795) PetscInt :: i, j, icomp, jcomp, irxn, ncomp
4796) PetscReal :: tempreal
4797) PetscReal :: kf, kr
4798) PetscReal :: Qkf, lnQkf
4799) PetscReal :: Qkr, lnQkr
4800) PetscReal :: por_den_sat_vol
4801)
4802) PetscInt, parameter :: iphase = 1
4803)
4804) ln_conc = log(rt_auxvar%pri_molal)
4805) ln_act = ln_conc+log(rt_auxvar%pri_act_coef)
4806)
4807) do irxn = 1, reaction%ngeneral_rxn ! for each mineral
4808)
4809) ! units
4810) ! for nth-order reaction
4811) ! kf/kr = kg^(n-1)/mol^(n-1)-sec
4812) ! thus for a 1st-order reaction, kf units = 1/sec
4813)
4814) kf = reaction%general_kf(irxn)
4815) kr = reaction%general_kr(irxn)
4816)
4817) if (kf > 0.d0) then
4818) ! compute ion activity product
4819) lnQkf = log(kf)
4820)
4821) ! currently not accommodating activity of water
4822) ! activity of water
4823) ! if (reaction%kinmnrlh2oid(irxn) > 0) then
4824) ! lnQkf = lnQkf + reaction%generalh2ostoich(irxn)*rt_auxvar%ln_act_h2o
4825) ! endif
4826)
4827) ncomp = reaction%generalforwardspecid(0,irxn)
4828) do i = 1, ncomp
4829) icomp = reaction%generalforwardspecid(i,irxn)
4830) lnQkf = lnQkf + reaction%generalforwardstoich(i,irxn)*ln_act(icomp)
4831) enddo
4832) Qkf = exp(lnQkf)
4833) else
4834) Qkf = 0.d0
4835) endif
4836)
4837) if (kr > 0.d0) then
4838) lnQkr = log(kr)
4839)
4840) ! currently not accommodating activity of water
4841) ! activity of water
4842) ! if (reaction%kinmnrlh2oid(irxn) > 0) then
4843) ! lnQkr = lnQkr + reaction%generalh2ostoich(irxn)*rt_auxvar%ln_act_h2o
4844) ! endif
4845)
4846) ncomp = reaction%generalbackwardspecid(0,irxn)
4847) do i = 1, ncomp
4848) icomp = reaction%generalbackwardspecid(i,irxn)
4849) lnQkr = lnQkr + reaction%generalbackwardstoich(i,irxn)*ln_act(icomp)
4850) enddo
4851) Qkr = exp(lnQkr)
4852) else
4853) Qkr = 0.d0
4854) endif
4855)
4856) ! Qkf/Qkr units are now mol/kg(water)-sec
4857)
4858) por_den_sat_vol = material_auxvar%porosity*global_auxvar%den_kg(iphase)* &
4859) global_auxvar%sat(iphase)* &
4860) material_auxvar%volume
4861)
4862) ncomp = reaction%generalspecid(0,irxn)
4863) do i = 1, ncomp
4864) icomp = reaction%generalspecid(i,irxn)
4865) ! units = mol/sec
4866) Res(icomp) = Res(icomp) - reaction%generalstoich(i,irxn)*(Qkf-Qkr)* &
4867) por_den_sat_vol
4868) enddo
4869)
4870) if (.not. compute_derivative) cycle
4871)
4872) ! calculate derivatives of rate with respect to free
4873) ! units = mol/sec
4874)
4875) if (kf > 0.d0) then
4876) ! derivatives with respect to primary species in forward reaction
4877) do j = 1, reaction%generalforwardspecid(0,irxn)
4878) jcomp = reaction%generalforwardspecid(j,irxn)
4879) tempreal = -1.d0*reaction%generalforwardstoich(j,irxn)*exp(lnQkf-ln_conc(jcomp))* &
4880) por_den_sat_vol
4881) do i = 1, reaction%generalspecid(0,irxn)
4882) icomp = reaction%generalspecid(i,irxn)
4883) ! units = (mol/sec)*(kg water/mol) = kg water/sec
4884) Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
4885) reaction%generalstoich(i,irxn)*tempreal
4886) enddo
4887) enddo
4888) endif
4889)
4890) if (kr > 0.d0) then
4891) ! derivatives with respect to primary species in forward reaction
4892) do j = 1, reaction%generalbackwardspecid(0,irxn)
4893) jcomp = reaction%generalbackwardspecid(j,irxn)
4894) tempreal = reaction%generalbackwardstoich(j,irxn)*exp(lnQkr-ln_conc(jcomp))* &
4895) por_den_sat_vol
4896) do i = 1, reaction%generalspecid(0,irxn)
4897) icomp = reaction%generalspecid(i,irxn)
4898) ! units = (mol/sec)*(kg water/mol) = kg water/sec
4899) Jac(icomp,jcomp) = Jac(icomp,jcomp) + &
4900) reaction%generalstoich(i,irxn)*tempreal
4901) enddo
4902) enddo
4903) endif
4904)
4905) enddo ! loop over reactions
4906)
4907) end subroutine RGeneral
4908)
4909) ! ************************************************************************** !
4910)
4911) subroutine RSolve(Res,Jac,conc,update,ncomp,use_log_formulation)
4912) !
4913) ! Computes the kinetic mineral precipitation/dissolution
4914) ! rates
4915) !
4916) ! Author: Glenn Hammond
4917) ! Date: 09/04/08
4918) !
4919)
4920) use Utility_module
4921)
4922) implicit none
4923)
4924) PetscInt :: ncomp
4925) PetscReal :: Res(ncomp)
4926) PetscReal :: Jac(ncomp,ncomp)
4927) PetscReal :: update(ncomp)
4928) PetscReal :: conc(ncomp)
4929) PetscBool :: use_log_formulation
4930)
4931) PetscInt :: indices(ncomp)
4932) PetscReal :: rhs(ncomp)
4933) PetscInt :: icomp
4934) PetscReal :: norm
4935)
4936) ! scale Jacobian
4937) do icomp = 1, ncomp
4938) norm = max(1.d0,maxval(abs(Jac(icomp,:))))
4939) norm = 1.d0/norm
4940) rhs(icomp) = Res(icomp)*norm
4941) Jac(icomp,:) = Jac(icomp,:)*norm
4942) enddo
4943)
4944) if (use_log_formulation) then
4945) ! for derivatives with respect to ln conc
4946) do icomp = 1, ncomp
4947) Jac(:,icomp) = Jac(:,icomp)*conc(icomp)
4948) enddo
4949) endif
4950)
4951) call ludcmp(Jac,ncomp,indices,icomp)
4952) call lubksb(Jac,ncomp,indices,rhs)
4953)
4954) update = rhs
4955)
4956) end subroutine RSolve
4957)
4958) ! ************************************************************************** !
4959)
4960) subroutine ReactionComputeKd(icomp,retardation,rt_auxvar,global_auxvar, &
4961) material_auxvar,reaction,option)
4962) !
4963) ! RComputeKd: Computes the Kd for a given chemical component
4964) !
4965) ! Author: Glenn Hammond
4966) ! Date: 05/14/09
4967) !
4968)
4969) use Option_module
4970)
4971) implicit none
4972)
4973) PetscInt :: icomp
4974) PetscReal :: retardation
4975) type(reactive_transport_auxvar_type) :: rt_auxvar
4976) type(global_auxvar_type) :: global_auxvar
4977) class(material_auxvar_type) :: material_auxvar
4978) type(reaction_type) :: reaction
4979) type(option_type) :: option
4980)
4981) PetscReal :: bulk_vol_to_fluid_vol
4982) PetscInt :: i, j, jcomp, irxn, icplx, irate
4983) PetscInt, parameter :: iphase = 1
4984)
4985) retardation = 0.d0
4986) if (reaction%nsorb == 0) return
4987)
4988) bulk_vol_to_fluid_vol = material_auxvar%porosity* &
4989) global_auxvar%sat(iphase)*1000.d0
4990)
4991) if (associated(rt_auxvar%total_sorb_eq)) then
4992) retardation = rt_auxvar%total_sorb_eq(icomp)
4993) endif
4994) do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
4995) do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
4996) retardation = retardation + &
4997) rt_auxvar%kinmr_total_sorb(icomp,irate,irxn)
4998) enddo
4999) enddo
5000)
5001) if (dabs(rt_auxvar%total(icomp,iphase)) > 1.d-40) &
5002) retardation = retardation/bulk_vol_to_fluid_vol/ &
5003) rt_auxvar%total(icomp,iphase)
5004)
5005) end subroutine ReactionComputeKd
5006)
5007) ! ************************************************************************** !
5008)
5009) subroutine RAge(rt_auxvar,global_auxvar,material_auxvar,option,reaction,Res)
5010) !
5011) ! Computes the ages of the groundwater
5012) !
5013) ! Author: Glenn Hammond
5014) ! Date: 02/22/10
5015) !
5016)
5017) use Option_module
5018)
5019) implicit none
5020)
5021) type(reactive_transport_auxvar_type) :: rt_auxvar
5022) type(global_auxvar_type) :: global_auxvar
5023) class(material_auxvar_type) :: material_auxvar
5024) type(option_type) :: option
5025) type(reaction_type) :: reaction
5026) PetscReal :: Res(reaction%ncomp)
5027) PetscInt, parameter :: iphase = 1
5028)
5029) Res(:) = 0.d0
5030) if (reaction%calculate_water_age) then
5031) Res(reaction%species_idx%water_age_id) = material_auxvar%porosity* &
5032) global_auxvar%sat(iphase)* &
5033) 1000.d0 * material_auxvar%volume
5034) endif
5035) if (reaction%calculate_tracer_age) then
5036) Res(reaction%species_idx%tracer_age_id) = &
5037) -rt_auxvar%total(reaction%species_idx%tracer_aq_id,iphase)* &
5038) material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
5039) material_auxvar%volume
5040) endif
5041) end subroutine RAge
5042)
5043) ! ************************************************************************** !
5044)
5045) subroutine RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction, &
5046) option)
5047) !
5048) ! Computes secondary variables for each grid cell
5049) !
5050) ! Author: Glenn Hammond
5051) ! Date: 08/28/08
5052) !
5053)
5054) use Option_module
5055)
5056) implicit none
5057)
5058) type(option_type) :: option
5059) type(reaction_type) :: reaction
5060) type(reactive_transport_auxvar_type) :: rt_auxvar
5061) type(global_auxvar_type) :: global_auxvar
5062) class(material_auxvar_type) :: material_auxvar
5063)
5064) #if 0
5065) PetscReal :: Res_orig(reaction%ncomp)
5066) PetscReal :: Res_pert(reaction%ncomp)
5067) PetscInt :: icomp, jcomp
5068) PetscReal :: dtotal(reaction%naqcomp,reaction%naqcomp)
5069) PetscReal :: dtotalsorb(reaction%naqcomp,reaction%naqcomp)
5070) PetscReal :: pert
5071) type(reactive_transport_auxvar_type) :: rt_auxvar_pert
5072) #endif
5073)
5074) !already set rt_auxvar%pri_molal = x
5075) call RTotal(rt_auxvar,global_auxvar,reaction,option)
5076) if (reaction%neqsorb > 0) then
5077) call RTotalSorb(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
5078) endif
5079)
5080) #if 0
5081) ! numerical check
5082) Res_orig = 0.d0
5083) dtotal = 0.d0
5084) dtotalsorb = 0.d0
5085) option%iflag = 0 ! be sure not to allocate mass_balance array
5086) call RTAuxVarInit(rt_auxvar_pert,reaction,option)
5087) do jcomp = 1, reaction%naqcomp
5088) Res_pert = 0.d0
5089) call RTAuxVarCopy(rt_auxvar_pert,rt_auxvar,option)
5090) if (reaction%neqcplx > 0) then
5091) rt_auxvar%sec_molal = 0.d0
5092) endif
5093) if (reaction%ngas > 0) then
5094) rt_auxvar%gas_molar = 0.d0
5095) endif
5096) if (reaction%neqsrfcplxrxn > 0) then
5097) rt_auxvar_pert%eqsrfcplx_free_site_conc = 1.d-9
5098) rt_auxvar_pert%srfcplx_conc = 0.d0
5099) endif
5100) if (reaction%neqionxrxn > 0) then
5101) rt_auxvar%eqionx_ref_cation_sorbed_conc = 1.d-9
5102) endif
5103) pert = rt_auxvar_pert%pri_molal(jcomp)*perturbation_tolerance
5104) rt_auxvar_pert%pri_molal(jcomp) = rt_auxvar_pert%pri_molal(jcomp) + pert
5105)
5106) call RTotal(rt_auxvar_pert,global_auxvar,reaction,option)
5107) dtotal(:,jcomp) = (rt_auxvar_pert%total(:,1) - rt_auxvar%total(:,1))/pert
5108) if (reaction%neqsorb > 0) then
5109) call RTotalSorb(rt_auxvar_pert,global_auxvar,reaction,option)
5110) dtotalsorb(:,jcomp) = (rt_auxvar_pert%total_sorb_eq(:) - &
5111) rt_auxvar%total_sorb_eq(:))/pert
5112) endif
5113) enddo
5114) do icomp = 1, reaction%naqcomp
5115) do jcomp = 1, reaction%naqcomp
5116) if (dabs(dtotal(icomp,jcomp)) < 1.d-16) dtotal(icomp,jcomp) = 0.d0
5117) if (reaction%neqsorb > 0) then
5118) if (dabs(dtotalsorb(icomp,jcomp)) < 1.d-16) dtotalsorb(icomp,jcomp) = 0.d0
5119) endif
5120) enddo
5121) enddo
5122) rt_auxvar%aqueous%dtotal(:,:,1) = dtotal
5123) if (reaction%neqsorb > 0) rt_auxvar%dtotal_sorb_eq = dtotalsorb
5124) call RTAuxVarDestroy(rt_auxvar_pert)
5125) #endif
5126)
5127) end subroutine RTAuxVarCompute
5128)
5129) ! ************************************************************************** !
5130)
5131) subroutine RTAccumulation(rt_auxvar,global_auxvar,material_auxvar, &
5132) reaction,option,Res)
5133) !
5134) ! Computes aqueous portion of the accumulation term in
5135) ! residual function
5136) !
5137) ! Author: Glenn Hammond
5138) ! Date: 02/15/08
5139) !
5140)
5141) use Option_module
5142)
5143) implicit none
5144)
5145) type(reactive_transport_auxvar_type) :: rt_auxvar
5146) type(global_auxvar_type) :: global_auxvar
5147) class(material_auxvar_type) :: material_auxvar
5148) type(option_type) :: option
5149) type(reaction_type) :: reaction
5150) PetscReal :: Res(reaction%ncomp)
5151)
5152) PetscInt :: iphase
5153) PetscInt :: istart, iend
5154) PetscInt :: idof
5155) PetscInt :: iimob
5156) PetscInt :: icoll
5157) PetscInt :: icollcomp
5158) PetscInt :: iaqcomp
5159) PetscInt :: iimb
5160) PetscReal :: psv_t
5161) PetscReal :: v_t
5162)
5163) iphase = 1
5164) Res = 0.d0
5165)
5166) ! units = (mol solute/L water)*(m^3 por/m^3 bulk)*(m^3 water/m^3 por)*
5167) ! (m^3 bulk)*(1000L water/m^3 water)/(sec) = mol/sec
5168) ! 1000.d0 converts vol from m^3 -> L
5169) ! all residual entries should be in mol/sec
5170) psv_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
5171) material_auxvar%volume / option%tran_dt
5172) istart = 1
5173) iend = reaction%naqcomp
5174) Res(istart:iend) = psv_t*rt_auxvar%total(:,iphase)
5175)
5176) if (reaction%nimcomp > 0) then
5177) do iimob = 1, reaction%nimcomp
5178) idof = reaction%offset_immobile + iimob
5179) Res(idof) = Res(idof) + rt_auxvar%immobile(iimob)* &
5180) material_auxvar%volume/option%tran_dt
5181) enddo
5182) endif
5183) if (reaction%ncoll > 0) then
5184) do icoll = 1, reaction%ncoll
5185) idof = reaction%offset_colloid + icoll
5186) Res(idof) = psv_t*rt_auxvar%colloid%conc_mob(icoll)
5187) enddo
5188) endif
5189) if (reaction%ncollcomp > 0) then
5190) do icollcomp = 1, reaction%ncollcomp
5191) iaqcomp = reaction%coll_spec_to_pri_spec(icollcomp)
5192) Res(iaqcomp) = Res(iaqcomp) + &
5193) psv_t*rt_auxvar%colloid%total_eq_mob(icollcomp)
5194) enddo
5195) endif
5196)
5197) ! CO2-specific
5198) if (option%iflowmode == G_MODE) return
5199) ! Add in multiphase, clu 12/29/08
5200) do
5201) iphase = iphase + 1
5202) if (iphase > option%nphase) exit
5203)
5204) ! super critical CO2 phase
5205) if (iphase == 2) then
5206) psv_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
5207) material_auxvar%volume / option%tran_dt
5208) Res(istart:iend) = Res(istart:iend) + psv_t*rt_auxvar%total(:,iphase)
5209) ! should sum over gas component only need more implementations
5210) endif
5211) ! add code for other phases here
5212) enddo
5213)
5214) end subroutine RTAccumulation
5215)
5216) ! ************************************************************************** !
5217)
5218) subroutine RTAccumulationDerivative(rt_auxvar,global_auxvar, &
5219) material_auxvar, &
5220) reaction,option,J)
5221) !
5222) ! Computes derivative of aqueous portion of the
5223) ! accumulation term in residual function
5224) !
5225) ! Author: Glenn Hammond
5226) ! Date: 02/15/08
5227) !
5228)
5229) use Option_module
5230)
5231) implicit none
5232)
5233) type(reactive_transport_auxvar_type) :: rt_auxvar
5234) type(global_auxvar_type) :: global_auxvar
5235) class(material_auxvar_type) :: material_auxvar
5236) type(option_type) :: option
5237) type(reaction_type) :: reaction
5238) PetscReal :: J(reaction%ncomp,reaction%ncomp)
5239)
5240) PetscInt :: icomp, iphase
5241) PetscInt :: istart, iendaq
5242) PetscInt :: idof
5243) PetscInt :: icoll
5244) PetscInt :: iimob
5245) PetscReal :: psvd_t, v_t
5246)
5247) iphase = 1
5248) istart = 1
5249) iendaq = reaction%naqcomp
5250) ! units = (m^3 por/m^3 bulk)*(m^3 water/m^3 por)*(m^3 bulk)/(sec)
5251) ! *(kg water/L water)*(1000L water/m^3 water) = kg water/sec
5252) ! all Jacobian entries should be in kg water/sec
5253) J = 0.d0
5254) if (associated(rt_auxvar%aqueous%dtotal)) then ! units of dtotal = kg water/L water
5255) psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
5256) material_auxvar%volume/option%tran_dt
5257) J(istart:iendaq,istart:iendaq) = rt_auxvar%aqueous%dtotal(:,:,iphase)*psvd_t
5258) else
5259) psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)* &
5260) global_auxvar%den_kg(iphase)*material_auxvar%volume/ &
5261) option%tran_dt ! units of den = kg water/m^3 water
5262) do icomp=istart,iendaq
5263) J(icomp,icomp) = psvd_t
5264) enddo
5265) endif
5266)
5267) if (reaction%nimcomp > 0) then
5268) do iimob = 1, reaction%nimcomp
5269) idof = reaction%offset_immobile + iimob
5270) J(idof,idof) = material_auxvar%volume/option%tran_dt
5271) enddo
5272) endif
5273) if (reaction%ncoll > 0) then
5274) do icoll = 1, reaction%ncoll
5275) idof = reaction%offset_colloid + icoll
5276) ! shouldn't have to sum a this point
5277) J(idof,idof) = psvd_t
5278) enddo
5279) endif
5280) if (reaction%ncollcomp > 0) then
5281) ! dRj_dCj - mobile
5282) J(istart:iendaq,istart:iendaq) = J(istart:iendaq,istart:iendaq) + &
5283) rt_auxvar%colloid%dRj_dCj%dtotal(:,:,1)*psvd_t
5284) ! need the below
5285) ! dRj_dSic
5286) ! dRic_dCj
5287) endif
5288)
5289) ! CO2-specific
5290) if (option%iflowmode == G_MODE) return
5291) ! Add in multiphase, clu 12/29/08
5292) do
5293) iphase = iphase +1
5294) if (iphase > option%nphase) exit
5295) ! super critical CO2 phase
5296) if (iphase == 2) then
5297) if (associated(rt_auxvar%aqueous%dtotal)) then
5298) psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)*1000.d0* &
5299) material_auxvar%volume/option%tran_dt
5300) J(istart:iendaq,istart:iendaq) = J(istart:iendaq,istart:iendaq) + &
5301) rt_auxvar%aqueous%dtotal(:,:,iphase)*psvd_t
5302) else
5303) psvd_t = material_auxvar%porosity*global_auxvar%sat(iphase)* &
5304) global_auxvar%den_kg(iphase)*material_auxvar%volume/ &
5305) option%tran_dt ! units of den = kg water/m^3 water
5306) do icomp=istart,iendaq
5307) J(icomp,icomp) = J(icomp,icomp) + psvd_t
5308) enddo
5309) endif
5310) endif
5311) enddo
5312)
5313) end subroutine RTAccumulationDerivative
5314)
5315) ! ************************************************************************** !
5316)
5317) subroutine RCalculateCompression(global_auxvar,rt_auxvar,material_auxvar, &
5318) reaction,option)
5319) !
5320) ! Calculates the compression for the Jacobian block
5321) !
5322) ! Author: Glenn Hammond
5323) ! Date: 07/12/10
5324) !
5325)
5326) use Option_module
5327)
5328) implicit none
5329)
5330) type(reaction_type), pointer :: reaction
5331) type(option_type) :: option
5332)
5333) PetscInt :: dfill(reaction%ncomp,reaction%ncomp)
5334) PetscInt :: ofill(reaction%ncomp,reaction%ncomp)
5335) PetscReal :: J(reaction%ncomp,reaction%ncomp)
5336) PetscReal :: residual(reaction%ncomp)
5337) type(reactive_transport_auxvar_type) :: rt_auxvar
5338) type(global_auxvar_type) :: global_auxvar
5339) class(material_auxvar_type) :: material_auxvar
5340)
5341) PetscInt :: i, jj
5342) PetscReal :: vol = 1.d0
5343) PetscReal :: por = 0.25d0
5344) PetscReal :: sum
5345)
5346) dfill = 0
5347) ofill = 0
5348) J = 0.d0
5349) residual = 0.d0
5350)
5351) call RTAuxVarCompute(rt_auxvar,global_auxvar,material_auxvar,reaction,option)
5352) call RTAccumulationDerivative(rt_auxvar,global_auxvar, &
5353) material_auxvar,reaction,option,J)
5354)
5355) do jj = 1, reaction%ncomp
5356) do i = 1, reaction%ncomp
5357) if (dabs(J(i,jj)) > 1.d-20) ofill(i,jj) = 1
5358) enddo
5359) enddo
5360)
5361) if (reaction%neqsorb > 0) then
5362) call RAccumulationSorbDerivative(rt_auxvar,global_auxvar, &
5363) material_auxvar, &
5364) reaction,option,J)
5365) endif
5366)
5367) call RReaction(residual,J,PETSC_TRUE,rt_auxvar,global_auxvar, &
5368) material_auxvar,reaction,option)
5369)
5370) do jj = 1, reaction%ncomp
5371) do i = 1, reaction%ncomp
5372) if (dabs(J(i,jj)) > 1.d-20) dfill(i,jj) = 1
5373) enddo
5374) enddo
5375)
5376) sum = 0.d0
5377) do jj = 1, reaction%ncomp
5378) do i = 1, reaction%ncomp
5379) if (dfill(i,jj) == 1) sum = sum + 1.d0
5380) enddo
5381) enddo
5382) write(option%io_buffer,'(''Diagonal Fill (%): '',f6.2)') &
5383) sum / (reaction%ncomp*reaction%ncomp) * 100.d0
5384) call printMsg(option)
5385)
5386)
5387) sum = 0.d0
5388) do jj = 1, reaction%ncomp
5389) do i = 1, reaction%ncomp
5390) if (ofill(i,jj) == 1) sum = sum + 1.d0
5391) enddo
5392) enddo
5393) write(option%io_buffer,'(''Off-Diagonal Fill (%): '',f6.2)') &
5394) sum / (reaction%ncomp*reaction%ncomp) * 100.d0
5395) call printMsg(option)
5396)
5397) end subroutine RCalculateCompression
5398)
5399) ! ************************************************************************** !
5400)
5401) subroutine RUpdateKineticState(rt_auxvar,global_auxvar,material_auxvar, &
5402) reaction,option)
5403) !
5404) ! Updates state variables such as mineral vol frac,
5405) ! etc.
5406) !
5407) ! Author: Glenn Hammond
5408) ! Date: 01/24/13
5409) !
5410)
5411) use Option_module
5412)
5413) implicit none
5414)
5415) type(reactive_transport_auxvar_type) :: rt_auxvar
5416) type(global_auxvar_type) :: global_auxvar
5417) class(material_auxvar_type) :: material_auxvar
5418) type(reaction_type) :: reaction
5419) type(option_type) :: option
5420)
5421) PetscInt :: imnrl, iaqspec, ncomp, icomp
5422) PetscInt :: k, irate, irxn, icplx, ncplx, ikinrxn
5423) PetscReal :: kdt, one_plus_kdt, k_over_one_plus_kdt
5424) PetscReal :: delta_volfrac
5425) PetscReal :: res(reaction%ncomp)
5426) PetscReal :: jac(reaction%ncomp,reaction%ncomp)
5427)
5428) ! update mineral volume fractions
5429) if (reaction%mineral%nkinmnrl > 0) then
5430)
5431) ! Updates the mineral rates, res is not needed
5432) call RKineticMineral(res,jac,PETSC_FALSE,rt_auxvar,global_auxvar, &
5433) material_auxvar,reaction,option)
5434)
5435) do imnrl = 1, reaction%mineral%nkinmnrl
5436) ! rate = mol/m^3/sec
5437) ! dvolfrac = m^3 mnrl/m^3 bulk = rate (mol mnrl/m^3 bulk/sec) *
5438) ! mol_vol (m^3 mnrl/mol mnrl)
5439) delta_volfrac = rt_auxvar%mnrl_rate(imnrl)* &
5440) reaction%mineral%kinmnrl_molar_vol(imnrl)* &
5441) option%tran_dt
5442) rt_auxvar%mnrl_volfrac(imnrl) = rt_auxvar%mnrl_volfrac(imnrl) + &
5443) delta_volfrac
5444) if (rt_auxvar%mnrl_volfrac(imnrl) < 0.d0) &
5445) rt_auxvar%mnrl_volfrac(imnrl) = 0.d0
5446)
5447) ! CO2-specific
5448) if (option%iflowmode == MPH_MODE .or. &
5449) option%iflowmode == FLASH2_MODE) then
5450) ncomp = reaction%mineral%kinmnrlspecid(0,imnrl)
5451) do iaqspec = 1, ncomp
5452) icomp = reaction%mineral%kinmnrlspecid(iaqspec,imnrl)
5453) if (icomp == reaction%species_idx%co2_aq_id) then
5454) global_auxvar%reaction_rate(2) &
5455) = global_auxvar%reaction_rate(2) &
5456) + rt_auxvar%mnrl_rate(imnrl)*option%tran_dt &
5457) * reaction%mineral%kinmnrlstoich(iaqspec,imnrl) /option%flow_dt
5458) cycle
5459) endif
5460) enddo
5461)
5462) ! water rate
5463) if (reaction%mineral%kinmnrlh2ostoich(imnrl) /= 0) then
5464) global_auxvar%reaction_rate(1) &
5465) = global_auxvar%reaction_rate(1) &
5466) + rt_auxvar%mnrl_rate(imnrl)*option%tran_dt &
5467) * reaction%mineral%kinmnrlh2ostoich(imnrl) /option%flow_dt
5468) endif
5469) endif
5470) enddo
5471) endif
5472)
5473) ! update multirate sorption concentrations
5474) ! WARNING: below assumes site concentration multiplicative factor
5475) if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
5476) do irxn = 1, reaction%surface_complexation%nkinmrsrfcplxrxn
5477) do irate = 1, reaction%surface_complexation%kinmr_nrate(irxn)
5478) kdt = reaction%surface_complexation%kinmr_rate(irate,irxn) * &
5479) option%tran_dt
5480) one_plus_kdt = 1.d0 + kdt
5481) k_over_one_plus_kdt = &
5482) reaction%surface_complexation%kinmr_rate(irate,irxn)/one_plus_kdt
5483) rt_auxvar%kinmr_total_sorb(:,irate,irxn) = &
5484) (rt_auxvar%kinmr_total_sorb(:,irate,irxn) + &
5485) kdt * reaction%surface_complexation%kinmr_frac(irate,irxn) * &
5486) rt_auxvar%kinmr_total_sorb(:,0,irxn))/one_plus_kdt
5487) enddo
5488) enddo
5489) endif
5490)
5491) ! update kinetic sorption concentrations
5492) if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
5493) do ikinrxn = 1, reaction%surface_complexation%nkinsrfcplxrxn
5494) irxn = reaction%surface_complexation%&
5495) kinsrfcplxrxn_to_srfcplxrxn(ikinrxn)
5496) ncplx = reaction%surface_complexation%srfcplxrxn_to_complex(0,irxn)
5497) do k = 1, ncplx ! ncplx in rxn
5498) icplx = reaction%surface_complexation%srfcplxrxn_to_complex(k,irxn)
5499) rt_auxvar%kinsrfcplx_conc(icplx,ikinrxn) = &
5500) rt_auxvar%kinsrfcplx_conc_kp1(icplx,ikinrxn)
5501) enddo
5502) enddo
5503) endif
5504)
5505) end subroutine RUpdateKineticState
5506)
5507) ! ************************************************************************** !
5508)
5509) subroutine RUpdateTempDependentCoefs(global_auxvar,reaction, &
5510) update_mnrl,option)
5511) !
5512) ! Updates temperature dependent coefficients for
5513) ! anisothermal simulations
5514) !
5515) ! Author: Glenn Hammond
5516) ! Date: 01/25/13
5517) !
5518)
5519) use Option_module
5520)
5521) implicit none
5522)
5523) type(global_auxvar_type) :: global_auxvar
5524) type(reaction_type) :: reaction
5525) PetscBool :: update_mnrl
5526) type(option_type) :: option
5527)
5528) PetscReal :: temp
5529) PetscReal :: pres
5530)
5531) PetscInt, parameter :: iphase = 1
5532)
5533) if (.not.reaction%use_geothermal_hpt)then
5534) temp = global_auxvar%temp
5535) pres = 0.d0
5536) if (associated(reaction%eqcplx_logKcoef)) then
5537) call ReactionInterpolateLogK(reaction%eqcplx_logKcoef, &
5538) reaction%eqcplx_logK, &
5539) temp, &
5540) reaction%neqcplx)
5541) endif
5542) if (associated(reaction%eqgas_logKcoef)) then
5543) call ReactionInterpolateLogK(reaction%eqgas_logKcoef, &
5544) reaction%eqgas_logK, &
5545) temp, &
5546) reaction%ngas)
5547) endif
5548) call MineralUpdateTempDepCoefs(temp,pres,reaction%mineral, &
5549) reaction%use_geothermal_hpt, &
5550) update_mnrl, &
5551) option)
5552) if (associated(reaction%surface_complexation%srfcplx_logKcoef)) then
5553) call ReactionInterpolateLogK(reaction%surface_complexation% &
5554) srfcplx_logKcoef, &
5555) reaction%surface_complexation%srfcplx_logK, &
5556) temp, &
5557) reaction%surface_complexation%nsrfcplx)
5558) endif
5559) else ! high pressure and temperature
5560) temp = global_auxvar%temp
5561) pres = global_auxvar%pres(iphase)
5562) if (associated(reaction%eqcplx_logKcoef)) then
5563) call ReactionInterpolateLogK_hpt(reaction%eqcplx_logKcoef, &
5564) reaction%eqcplx_logK, &
5565) temp, &
5566) pres, &
5567) reaction%neqcplx)
5568) endif
5569) if (associated(reaction%eqgas_logKcoef)) then
5570) call ReactionInterpolateLogK_hpt(reaction%eqgas_logKcoef, &
5571) reaction%eqgas_logK, &
5572) temp, &
5573) pres, &
5574) reaction%ngas)
5575) endif
5576) call MineralUpdateTempDepCoefs(temp,pres,reaction%mineral, &
5577) reaction%use_geothermal_hpt, &
5578) update_mnrl, &
5579) option)
5580) if (associated(reaction%surface_complexation%srfcplx_logKcoef)) then
5581) option%io_buffer = 'Temperature dependent surface complexation ' // &
5582) 'coefficients not yet function for high pressure/temperature.'
5583) call printMsg(option)
5584) endif
5585) endif
5586)
5587) end subroutine RUpdateTempDependentCoefs
5588)
5589) ! ************************************************************************** !
5590)
5591) subroutine RTPrintAuxVar(rt_auxvar,reaction,option)
5592) !
5593) ! PrintRTAuxVar: Prints data from RTAuxVar object
5594) !
5595) ! Author: Glenn Hammond
5596) ! Date: 05/18/2011
5597) !
5598)
5599) use Option_module
5600)
5601) implicit none
5602)
5603) type(reactive_transport_auxvar_type) :: rt_auxvar
5604) type(reaction_type) :: reaction
5605) type(option_type) :: option
5606)
5607) character(len=MAXSTRINGLENGTH) :: string
5608) PetscInt :: i
5609)
5610) 10 format(a20,':',10es19.11)
5611) 20 format(a20,':',a20)
5612) 30 format(/)
5613)
5614) if (OptionPrintToScreen(option)) write(*,30)
5615) if (OptionPrintToFile(option)) write(option%fid_out,30)
5616)
5617) if (OptionPrintToScreen(option)) &
5618) write(*,20) 'Primary', 'free molal., total molar., act. coef.'
5619) if (OptionPrintToFile(option)) &
5620) write(option%fid_out,20) 'Primary', 'free molal., total molar., act. coef.'
5621) do i = 1, reaction%naqcomp
5622) if (OptionPrintToScreen(option)) &
5623) write(*,10) reaction%primary_species_names(i), &
5624) rt_auxvar%pri_molal(i), &
5625) rt_auxvar%total(i,1), &
5626) rt_auxvar%pri_act_coef(i)
5627) if (OptionPrintToFile(option)) &
5628) write(option%fid_out,10) reaction%primary_species_names(i), &
5629) rt_auxvar%pri_molal(i), &
5630) rt_auxvar%total(i,1), &
5631) rt_auxvar%pri_act_coef(i)
5632) enddo
5633) if (OptionPrintToScreen(option)) write(*,30)
5634) if (OptionPrintToFile(option)) write(option%fid_out,30)
5635)
5636) if (reaction%neqcplx > 0) then
5637) if (OptionPrintToScreen(option)) &
5638) write(*,20) 'Secondary Complex', 'molal., act. coef.'
5639) if (OptionPrintToFile(option)) &
5640) write(option%fid_out,20) 'Secondary Complex', 'molal., act. coef.'
5641) do i = 1, reaction%neqcplx
5642) if (OptionPrintToScreen(option)) &
5643) write(*,10) reaction%secondary_species_names(i), &
5644) rt_auxvar%sec_molal(i), &
5645) rt_auxvar%sec_act_coef(i)
5646) if (OptionPrintToFile(option)) &
5647) write(option%fid_out,10) reaction%secondary_species_names(i), &
5648) rt_auxvar%sec_molal(i), &
5649) rt_auxvar%sec_act_coef(i)
5650) enddo
5651) if (OptionPrintToScreen(option)) write(*,30)
5652) if (OptionPrintToFile(option)) write(option%fid_out,30)
5653) endif
5654)
5655) if (reaction%neqsorb > 0) then
5656) if (OptionPrintToScreen(option)) &
5657) write(*,20) 'Total Sorbed EQ', 'mol/m^3'
5658) if (OptionPrintToFile(option)) &
5659) write(option%fid_out,20) 'Total Sorbed EQ', 'mol/m^3'
5660) do i = 1, reaction%naqcomp
5661) if (OptionPrintToScreen(option)) &
5662) write(*,10) reaction%primary_species_names(i), rt_auxvar%total_sorb_eq(i)
5663) if (OptionPrintToFile(option)) &
5664) write(option%fid_out,10) reaction%primary_species_names(i), &
5665) rt_auxvar%total_sorb_eq(i)
5666) enddo
5667) if (OptionPrintToScreen(option)) write(*,30)
5668) if (OptionPrintToFile(option)) write(option%fid_out,30)
5669) endif
5670)
5671) #if 0
5672) if (reaction%surface_complexation%neqsrfcplx > 0) then
5673) if (OptionPrintToScreen(option)) &
5674) write(*,20) 'EQ Surface Complex Conc.', 'mol/m^3'
5675) if (OptionPrintToFile(option)) &
5676) write(option%fid_out,20) 'EQ Surface Complex Conc.', 'mol/m^3'
5677) do i = 1, reaction%surface_complexation%neqsrfcplx
5678) if (OptionPrintToScreen(option)) &
5679) write(*,10) reaction%eqsrfcplx_names(i), rt_auxvar%eqsrfcplx_conc(i)
5680) if (OptionPrintToFile(option)) &
5681) write(option%fid_out,10) reaction%eqsrfcplx_names(i), &
5682) rt_auxvar%eqsrfcplx_conc(i)
5683) enddo
5684) if (OptionPrintToScreen(option)) write(*,30)
5685) if (OptionPrintToFile(option)) write(option%fid_out,30)
5686) endif
5687) #endif
5688)
5689) if (reaction%surface_complexation%nkinmrsrfcplxrxn > 0) then
5690) endif
5691)
5692) if (reaction%surface_complexation%nkinsrfcplxrxn > 0) then
5693) endif
5694)
5695) if (reaction%neqionxrxn > 0) then
5696) endif
5697)
5698) if (reaction%mineral%nkinmnrl > 0) then
5699) if (OptionPrintToScreen(option)) &
5700) write(*,20) 'Kinetic Minerals', 'vol frac, area, rate'
5701) if (OptionPrintToFile(option)) &
5702) write(option%fid_out,20) 'Kinetic Minerals', 'vol frac, area, rate'
5703) do i = 1, reaction%mineral%nkinmnrl
5704) if (OptionPrintToScreen(option)) &
5705) write(*,10) reaction%mineral%kinmnrl_names(i), &
5706) rt_auxvar%mnrl_volfrac(i), &
5707) rt_auxvar%mnrl_area(i), &
5708) rt_auxvar%mnrl_rate(i)
5709)
5710) if (OptionPrintToFile(option)) &
5711) write(option%fid_out,10) reaction%mineral%kinmnrl_names(i), &
5712) rt_auxvar%mnrl_volfrac(i), &
5713) rt_auxvar%mnrl_area(i), &
5714) rt_auxvar%mnrl_rate(i)
5715) enddo
5716) if (OptionPrintToScreen(option)) write(*,30)
5717) if (OptionPrintToFile(option)) write(option%fid_out,30)
5718) endif
5719)
5720) end subroutine RTPrintAuxVar
5721)
5722) end module Reaction_module