transport_constraint.F90 coverage: 88.89 %func 68.41 %block
1) module Transport_Constraint_module
2)
3) use Reaction_Aux_module
4) use Reactive_Transport_Aux_module
5) use Global_Aux_module
6)
7) use Reaction_Surface_Complexation_Aux_module
8) use Reaction_Mineral_Aux_module
9) use Reaction_Immobile_Aux_module
10)
11) use PFLOTRAN_Constants_module
12)
13) implicit none
14)
15) private
16)
17) #include "petsc/finclude/petscsys.h"
18)
19) ! concentration subcondition types
20) PetscInt, parameter, public :: CONSTRAINT_NULL = 0
21) PetscInt, parameter, public :: CONSTRAINT_FREE = 1
22) PetscInt, parameter, public :: CONSTRAINT_TOTAL = 2
23) PetscInt, parameter, public :: CONSTRAINT_LOG = 3
24) PetscInt, parameter, public :: CONSTRAINT_PH = 4
25) PetscInt, parameter, public :: CONSTRAINT_MINERAL = 5
26) PetscInt, parameter, public :: CONSTRAINT_GAS = 6
27) PetscInt, parameter, public :: CONSTRAINT_CHARGE_BAL = 7
28) PetscInt, parameter, public :: CONSTRAINT_TOTAL_SORB = 9
29) PetscInt, parameter, public :: CONSTRAINT_SUPERCRIT_CO2 = 10
30)
31) type, public :: tran_constraint_type
32) PetscInt :: id
33) character(len=MAXWORDLENGTH) :: name
34) type(aq_species_constraint_type), pointer :: aqueous_species
35) type(guess_constraint_type), pointer :: free_ion_guess
36) type(mineral_constraint_type), pointer :: minerals
37) type(srfcplx_constraint_type), pointer :: surface_complexes
38) type(colloid_constraint_type), pointer :: colloids
39) type(immobile_constraint_type), pointer :: immobile_species
40) PetscBool :: requires_equilibration
41) type(tran_constraint_type), pointer :: next
42) end type tran_constraint_type
43)
44) type, public :: tran_constraint_ptr_type
45) type(tran_constraint_type), pointer :: ptr
46) end type tran_constraint_ptr_type
47)
48) type, public :: tran_constraint_list_type
49) PetscInt :: num_constraints
50) type(tran_constraint_type), pointer :: first
51) type(tran_constraint_type), pointer :: last
52) type(tran_constraint_ptr_type), pointer :: array(:)
53) end type tran_constraint_list_type
54)
55) type, public :: tran_constraint_coupler_type
56) character(len=MAXWORDLENGTH) :: constraint_name
57) PetscReal :: time
58) PetscInt :: num_iterations
59) character(len=MAXWORDLENGTH) :: time_units
60) type(aq_species_constraint_type), pointer :: aqueous_species
61) type(guess_constraint_type), pointer :: free_ion_guess
62) type(mineral_constraint_type), pointer :: minerals
63) type(srfcplx_constraint_type), pointer :: surface_complexes
64) type(colloid_constraint_type), pointer :: colloids
65) type(immobile_constraint_type), pointer :: immobile_species
66) type(global_auxvar_type), pointer :: global_auxvar
67) type(reactive_transport_auxvar_type), pointer :: rt_auxvar
68) type(tran_constraint_coupler_type), pointer :: next
69) end type tran_constraint_coupler_type
70)
71) public :: TranConstraintAddToList, &
72) TranConstraintInitList, &
73) TranConstraintDestroyList, &
74) TranConstraintGetPtrFromList, &
75) TranConstraintCreate, &
76) TranConstraintRead, &
77) TranConstraintDestroy, &
78) TranConstraintCouplerCreate, &
79) TranConstraintCouplerDestroy
80)
81) contains
82)
83) ! ************************************************************************** !
84)
85) function TranConstraintCreate(option)
86) !
87) ! Creates a transport constraint (set of concentrations
88) ! and constraints for setting boundary or initial
89) ! condition).
90) !
91) ! Author: Glenn Hammond
92) ! Date: 10/14/08
93) !
94)
95) use Option_module
96)
97) implicit none
98)
99) type(option_type) :: option
100) type(tran_constraint_type), pointer :: TranConstraintCreate
101)
102) type(tran_constraint_type), pointer :: constraint
103)
104) allocate(constraint)
105) nullify(constraint%aqueous_species)
106) nullify(constraint%free_ion_guess)
107) nullify(constraint%minerals)
108) nullify(constraint%surface_complexes)
109) nullify(constraint%colloids)
110) nullify(constraint%immobile_species)
111) nullify(constraint%next)
112) constraint%id = 0
113) constraint%name = ''
114) constraint%requires_equilibration = PETSC_FALSE
115)
116) TranConstraintCreate => constraint
117)
118) end function TranConstraintCreate
119)
120) ! ************************************************************************** !
121)
122) function TranConstraintCouplerCreate(option)
123) !
124) ! Creates a coupler that ties a constraint to a
125) ! transport condition
126) !
127) ! Author: Glenn Hammond
128) ! Date: 10/14/08
129) !
130)
131) use Option_module
132)
133) implicit none
134)
135) type(option_type) :: option
136) type(tran_constraint_coupler_type), pointer :: TranConstraintCouplerCreate
137)
138) type(tran_constraint_coupler_type), pointer :: coupler
139)
140) allocate(coupler)
141) nullify(coupler%aqueous_species)
142) nullify(coupler%free_ion_guess)
143) nullify(coupler%minerals)
144) nullify(coupler%surface_complexes)
145) nullify(coupler%colloids)
146) nullify(coupler%immobile_species)
147)
148) coupler%num_iterations = 0
149) nullify(coupler%rt_auxvar)
150) nullify(coupler%global_auxvar)
151)
152) nullify(coupler%next)
153) coupler%constraint_name = ''
154) coupler%time = 0.d0
155) coupler%time_units = ''
156)
157) TranConstraintCouplerCreate => coupler
158)
159) end function TranConstraintCouplerCreate
160)
161) ! ************************************************************************** !
162)
163) subroutine TranConstraintRead(constraint,reaction,input,option)
164) !
165) ! Reads a transport constraint from the input file
166) !
167) ! Author: Glenn Hammond
168) ! Date: 10/14/08
169) !
170)
171) use Option_module
172) use Input_Aux_module
173) use Units_module
174) use String_module
175) use Logging_module
176)
177) implicit none
178)
179) type(tran_constraint_type) :: constraint
180) type(reaction_type) :: reaction
181) type(input_type), pointer :: input
182) type(option_type) :: option
183)
184) character(len=MAXSTRINGLENGTH) :: string
185) character(len=MAXWORDLENGTH) :: word
186) character(len=MAXWORDLENGTH) :: internal_units
187) character(len=MAXSTRINGLENGTH) :: block_string
188) PetscInt :: icomp, imnrl, iimmobile
189) PetscInt :: isrfcplx
190) PetscInt :: length
191) type(aq_species_constraint_type), pointer :: aq_species_constraint
192) type(guess_constraint_type), pointer :: free_ion_guess_constraint
193) type(mineral_constraint_type), pointer :: mineral_constraint
194) type(srfcplx_constraint_type), pointer :: srfcplx_constraint
195) type(colloid_constraint_type), pointer :: colloid_constraint
196) type(immobile_constraint_type), pointer :: immobile_constraint
197) PetscErrorCode :: ierr
198) PetscReal :: tempreal
199)
200) call PetscLogEventBegin(logging%event_tran_constraint_read, &
201) ierr);CHKERRQ(ierr)
202)
203) ! read the constraint
204) input%ierr = 0
205) do
206)
207) call InputReadPflotranString(input,option)
208) call InputReadStringErrorMsg(input,option,'CONSTRAINT')
209)
210) if (InputCheckExit(input,option)) exit
211)
212) call InputReadWord(input,option,word,PETSC_TRUE)
213) call InputErrorMsg(input,option,'keyword','CONSTRAINT')
214)
215) select case(trim(word))
216)
217) case('CONC','CONCENTRATIONS')
218)
219) aq_species_constraint => &
220) AqueousSpeciesConstraintCreate(reaction,option)
221)
222) block_string = 'CONSTRAINT, CONCENTRATIONS'
223) icomp = 0
224) do
225) call InputReadPflotranString(input,option)
226) call InputReadStringErrorMsg(input,option,block_string)
227)
228) if (InputCheckExit(input,option)) exit
229)
230) icomp = icomp + 1
231)
232) if (icomp > reaction%naqcomp) then
233) option%io_buffer = 'Number of concentration constraints ' // &
234) 'exceeds number of primary chemical ' // &
235) 'components in constraint: ' // &
236) trim(constraint%name)
237) call printErrMsg(option)
238) endif
239)
240) call InputReadWord(input,option,aq_species_constraint%names(icomp), &
241) PETSC_TRUE)
242) call InputErrorMsg(input,option,'aqueous species name',block_string)
243) option%io_buffer = 'Constraint Species: ' // &
244) trim(aq_species_constraint%names(icomp))
245) call printMsg(option)
246)
247) call InputReadDouble(input,option, &
248) aq_species_constraint%constraint_conc(icomp))
249) call InputErrorMsg(input,option,'concentration',block_string)
250)
251) call InputReadWord(input,option,word,PETSC_TRUE)
252) call InputDefaultMsg(input,option, &
253) trim(block_string) // ' constraint_type')
254) length = len_trim(word)
255) if (length > 0) then
256) call StringToUpper(word)
257) select case(word)
258) case('F','FREE')
259) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_FREE
260) case('T','TOTAL')
261) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_TOTAL
262) case('TOTAL_SORB')
263) aq_species_constraint%constraint_type(icomp) = &
264) CONSTRAINT_TOTAL_SORB
265) case('S')
266) option%io_buffer = '"S" constraint type no longer ' // &
267) 'supported as of March 4, 2013.'
268) call printErrMsg(option)
269) case('P','PH')
270) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_PH
271) case('L','LOG')
272) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_LOG
273) case('M','MINERAL','MNRL')
274) aq_species_constraint%constraint_type(icomp) = &
275) CONSTRAINT_MINERAL
276) case('G','GAS')
277) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_GAS
278) case('SC','CONSTRAINT_SUPERCRIT_CO2')
279) aq_species_constraint%constraint_type(icomp) = &
280) CONSTRAINT_SUPERCRIT_CO2
281) case('Z','CHG')
282) aq_species_constraint%constraint_type(icomp) = &
283) CONSTRAINT_CHARGE_BAL
284) case default
285) call InputKeywordUnrecognized(word, &
286) 'CONSTRAINT,CONCENTRATION,TYPE',option)
287) end select
288)
289) if (aq_species_constraint%constraint_type(icomp) == &
290) CONSTRAINT_MINERAL .or. &
291) aq_species_constraint%constraint_type(icomp) == &
292) CONSTRAINT_GAS .or.&
293) aq_species_constraint%constraint_type(icomp) == &
294) CONSTRAINT_SUPERCRIT_CO2) then
295) call InputReadWord(input,option,aq_species_constraint% &
296) constraint_aux_string(icomp), &
297) PETSC_TRUE)
298) call InputErrorMsg(input,option,'constraint name',block_string)
299) else
300) call InputReadWord(input,option,word,PETSC_FALSE)
301) if (input%ierr == 0) then
302) call StringToUpper(word)
303) select case(word)
304) case('DATASET')
305) call InputReadWord(input,option,aq_species_constraint% &
306) constraint_aux_string(icomp),PETSC_TRUE)
307) call InputErrorMsg(input,option,'dataset name', &
308) block_string)
309) aq_species_constraint%external_dataset(icomp) = PETSC_TRUE
310) end select
311) endif
312) endif
313) else
314) aq_species_constraint%constraint_type(icomp) = CONSTRAINT_TOTAL
315) endif
316)
317) enddo
318)
319) if (icomp < reaction%naqcomp) then
320) option%io_buffer = &
321) 'Number of concentration constraints is less than ' // &
322) 'number of primary species in aqueous constraint.'
323) call printErrMsg(option)
324) endif
325) if (icomp > reaction%naqcomp) then
326) option%io_buffer = &
327) 'Number of concentration constraints is greater than ' // &
328) 'number of primary species in aqueous constraint.'
329) call printWrnMsg(option)
330) endif
331)
332) if (associated(constraint%aqueous_species)) &
333) call AqueousSpeciesConstraintDestroy(constraint%aqueous_species)
334) constraint%aqueous_species => aq_species_constraint
335)
336) case('FREE_ION_GUESS')
337)
338) free_ion_guess_constraint => GuessConstraintCreate(reaction,option)
339)
340) block_string = 'CONSTRAINT, FREE_ION_GUESS'
341) icomp = 0
342) do
343) call InputReadPflotranString(input,option)
344) call InputReadStringErrorMsg(input,option,block_string)
345)
346) if (InputCheckExit(input,option)) exit
347)
348) icomp = icomp + 1
349)
350) if (icomp > reaction%naqcomp) then
351) option%io_buffer = 'Number of free ion guess constraints ' // &
352) 'exceeds number of primary chemical ' // &
353) 'components in constraint: ' // &
354) trim(constraint%name)
355) call printErrMsg(option)
356) endif
357)
358) call InputReadWord(input,option, &
359) free_ion_guess_constraint%names(icomp), &
360) PETSC_TRUE)
361) call InputErrorMsg(input,option,'free ion guess name',block_string)
362) option%io_buffer = 'Constraint Species: ' // &
363) trim(free_ion_guess_constraint%names(icomp))
364) call printMsg(option)
365)
366) call InputReadDouble(input,option,free_ion_guess_constraint%conc(icomp))
367) call InputErrorMsg(input,option,'free ion guess',block_string)
368) enddo
369)
370) if (icomp < reaction%naqcomp) then
371) option%io_buffer = &
372) 'Number of free ion guess constraints is less than ' // &
373) 'number of primary species in aqueous constraint.'
374) call printErrMsg(option)
375) endif
376) if (icomp > reaction%naqcomp) then
377) option%io_buffer = &
378) 'Number of free ion guess constraints is greater than ' // &
379) 'number of primary species in aqueous constraint.'
380) call printWrnMsg(option)
381) endif
382)
383) if (associated(constraint%free_ion_guess)) &
384) call GuessConstraintDestroy(constraint%free_ion_guess)
385) constraint%free_ion_guess => free_ion_guess_constraint
386) nullify(free_ion_guess_constraint)
387)
388) case('MNRL','MINERALS')
389)
390) mineral_constraint => MineralConstraintCreate(reaction%mineral,option)
391)
392) block_string = 'CONSTRAINT, MINERALS'
393) imnrl = 0
394) do
395) call InputReadPflotranString(input,option)
396) call InputReadStringErrorMsg(input,option,block_string)
397)
398) if (InputCheckExit(input,option)) exit
399)
400) imnrl = imnrl + 1
401)
402) if (imnrl > reaction%mineral%nkinmnrl) then
403) option%io_buffer = &
404) 'Number of mineral constraints exceeds number of ' // &
405) 'kinetic minerals in constraint: ' // &
406) trim(constraint%name)
407) call printErrMsg(option)
408) endif
409)
410) call InputReadWord(input,option,mineral_constraint%names(imnrl), &
411) PETSC_TRUE)
412) call InputErrorMsg(input,option,'mineral name',block_string)
413) option%io_buffer = 'Constraint Minerals: ' // &
414) trim(mineral_constraint%names(imnrl))
415) call printMsg(option)
416)
417) ! volume fraction
418) string = trim(input%buf)
419) call InputReadWord(string,word,PETSC_TRUE,ierr)
420) ! if a dataset
421) if (StringCompareIgnoreCase(word,'DATASET')) then
422) input%buf = trim(string)
423) call InputReadWord(input,option,mineral_constraint% &
424) constraint_vol_frac_string(imnrl),PETSC_TRUE)
425) call InputErrorMsg(input,option,'dataset name', &
426) trim(block_string) // ' VOL FRAC')
427) mineral_constraint%external_voL_frac_dataset(imnrl) = PETSC_TRUE
428) ! set vol frac to NaN to catch bugs
429) tempreal = -1.d0
430) mineral_constraint%constraint_vol_frac(imnrl) = sqrt(tempreal)
431) else
432) call InputReadDouble(input,option, &
433) mineral_constraint%constraint_vol_frac(imnrl))
434) call InputErrorMsg(input,option,'volume fraction',block_string)
435) endif
436)
437) string = trim(input%buf)
438) call InputReadWord(string,word,PETSC_TRUE,ierr)
439) ! if a dataset
440) if (StringCompareIgnoreCase(word,'DATASET')) then
441) input%buf = trim(string)
442) call InputReadWord(input,option,mineral_constraint% &
443) constraint_area_string(imnrl),PETSC_TRUE)
444) call InputErrorMsg(input,option,'dataset name', &
445) trim(block_string) // ' SURF AREA')
446) mineral_constraint%external_area_dataset(imnrl) = PETSC_TRUE
447) ! set surface area to NaN to catch bugs
448) tempreal = -1.d0
449) mineral_constraint%constraint_area(imnrl) = sqrt(tempreal)
450) ! read units if they exist
451) internal_units = 'm^2/m^3'
452) call InputReadWord(input,option,word,PETSC_TRUE)
453) if (.not.InputError(input)) then
454) ! convert just to ensure that the units were properly set
455) tempreal = UnitsConvertToInternal(word,internal_units,option)
456) option%io_buffer = 'If mineral specific surface areas are ' // &
457) 'defined through a DATASET, their units must be SI ' // &
458) '[m^2/m^3]. Unit conversion cannot be performed as ' // &
459) 'currently implemented.'
460) call printErrMsg(option)
461) endif
462) else
463) ! specific surface area
464) call InputReadDouble(input,option, &
465) mineral_constraint%constraint_area(imnrl))
466) call InputErrorMsg(input,option,'surface area',block_string)
467) ! read units if they exist
468) internal_units = 'm^2/m^3'
469) call InputReadWord(input,option,word,PETSC_TRUE)
470) if (InputError(input)) then
471) input%err_buf = trim(mineral_constraint%names(imnrl)) // &
472) ' SPECIFIC SURFACE_AREA UNITS'
473) call InputDefaultMsg(input,option)
474) else
475) mineral_constraint%constraint_area(imnrl) = &
476) mineral_constraint%constraint_area(imnrl) * &
477) UnitsConvertToInternal(word,internal_units,option)
478) endif
479) endif
480) enddo
481)
482) if (imnrl < reaction%mineral%nkinmnrl) then
483) option%io_buffer = &
484) 'Mineral lists in constraints must provide a volume ' // &
485) 'fraction and surface area for all kinetic minerals ' // &
486) '(listed under MINERAL_KINETICS card in CHEMISTRY), ' // &
487) 'regardless of whether or not they are present (just ' // &
488) 'assign a zero volume fraction if not present).'
489) call printErrMsg(option)
490) endif
491)
492) if (associated(constraint%minerals)) then
493) call MineralConstraintDestroy(constraint%minerals)
494) endif
495) constraint%minerals => mineral_constraint
496)
497) case('SURFACE_COMPLEXES')
498)
499) srfcplx_constraint => &
500) SurfaceComplexConstraintCreate(reaction%surface_complexation,option)
501)
502) block_string = 'CONSTRAINT, SURFACE_COMPLEXES'
503) isrfcplx = 0
504) do
505) call InputReadPflotranString(input,option)
506) call InputReadStringErrorMsg(input,option,block_string)
507)
508) if (InputCheckExit(input,option)) exit
509)
510) isrfcplx = isrfcplx + 1
511)
512) if (isrfcplx > reaction%surface_complexation%nkinsrfcplx) then
513) option%io_buffer = &
514) 'Number of surface complex constraints exceeds ' // &
515) 'number of kinetic surface complexes in constraint: ' // &
516) trim(constraint%name)
517) call printErrMsg(option)
518) endif
519)
520) call InputReadWord(input,option,srfcplx_constraint%names(isrfcplx), &
521) PETSC_TRUE)
522) call InputErrorMsg(input,option,'surface complex name',block_string)
523) option%io_buffer = 'Constraint Surface Complex: ' // &
524) trim(srfcplx_constraint%names(isrfcplx))
525) call printMsg(option)
526) call InputReadDouble(input,option, &
527) srfcplx_constraint%constraint_conc(isrfcplx))
528) call InputErrorMsg(input,option,'concentration',block_string)
529) enddo
530)
531) if (isrfcplx < reaction%surface_complexation%nkinsrfcplx) then
532) option%io_buffer = &
533) 'Number of surface complex constraints is less than ' // &
534) 'number of kinetic surface complexes in surface ' // &
535) 'complex constraint.'
536) call printErrMsg(option)
537) endif
538)
539) if (associated(constraint%surface_complexes)) then
540) call SurfaceComplexConstraintDestroy(constraint%surface_complexes)
541) endif
542) constraint%surface_complexes => srfcplx_constraint
543)
544) case('COLL','COLLOIDS')
545)
546) colloid_constraint => ColloidConstraintCreate(reaction,option)
547)
548) block_string = 'CONSTRAINT, COLLOIDS'
549) icomp = 0
550) do
551) call InputReadPflotranString(input,option)
552) call InputReadStringErrorMsg(input,option,block_string)
553)
554) if (InputCheckExit(input,option)) exit
555)
556) icomp = icomp + 1
557)
558) if (icomp > reaction%ncoll) then
559) option%io_buffer = &
560) 'Number of colloid constraints exceeds number of ' // &
561) 'colloids in constraint: ' // &
562) trim(constraint%name)
563) call printErrMsg(option)
564) endif
565)
566) call InputReadWord(input,option,colloid_constraint%names(icomp), &
567) PETSC_TRUE)
568) call InputErrorMsg(input,option,'colloid name',block_string)
569) option%io_buffer = 'Constraint Colloids: ' // &
570) trim(colloid_constraint%names(icomp))
571) call printMsg(option)
572) call InputReadDouble(input,option, &
573) colloid_constraint%constraint_conc_mob(icomp))
574) call InputErrorMsg(input,option,'mobile concentration',block_string)
575) call InputReadDouble(input,option, &
576) colloid_constraint%constraint_conc_imb(icomp))
577) call InputErrorMsg(input,option,'immobile concentration', &
578) block_string)
579)
580) enddo
581)
582) if (icomp < reaction%ncoll) then
583) option%io_buffer = &
584) 'Colloid lists in constraints must provide mobile ' // &
585) 'and immobile concentrations for all colloids ' // &
586) '(listed under the COLLOIDS card in CHEMISTRY), ' // &
587) 'regardless of whether or not they are present (just ' // &
588) 'assign a small value (e.g. 1.d-40) if not present).'
589) call printErrMsg(option)
590) endif
591)
592) if (associated(constraint%colloids)) then
593) call ColloidConstraintDestroy(constraint%colloids)
594) endif
595) constraint%colloids => colloid_constraint
596)
597)
598)
599) case('IMMOBILE')
600)
601) immobile_constraint => &
602) ImmobileConstraintCreate(reaction%immobile,option)
603)
604) block_string = 'CONSTRAINT, IMMOBILE'
605) iimmobile = 0
606) do
607) call InputReadPflotranString(input,option)
608) call InputReadStringErrorMsg(input,option,block_string)
609)
610) if (InputCheckExit(input,option)) exit
611)
612) iimmobile = iimmobile + 1
613)
614) if (iimmobile > reaction%immobile%nimmobile) then
615) option%io_buffer = &
616) 'Number of immobile constraints exceeds number of ' // &
617) 'immobile species in constraint: ' // &
618) trim(constraint%name)
619) call printErrMsg(option)
620) endif
621)
622) call InputReadWord(input,option, &
623) immobile_constraint%names(iimmobile),PETSC_TRUE)
624) call InputErrorMsg(input,option,'immobile name',block_string)
625) option%io_buffer = 'Constraint Immobile: ' // &
626) trim(immobile_constraint%names(iimmobile))
627) call printMsg(option)
628)
629) ! concentration
630) string = trim(input%buf)
631) call InputReadWord(string,word,PETSC_TRUE,ierr)
632) ! if a dataset
633) if (StringCompareIgnoreCase(word,'DATASET')) then
634) input%buf = trim(string)
635) call InputReadWord(input,option,immobile_constraint% &
636) constraint_aux_string(iimmobile),PETSC_TRUE)
637) call InputErrorMsg(input,option,'dataset name', &
638) trim(block_string) // ' concentration')
639) immobile_constraint%external_dataset(iimmobile) = PETSC_TRUE
640) ! set vol frac to NaN to catch bugs
641) tempreal = -1.d0
642) immobile_constraint%constraint_conc(iimmobile) = sqrt(tempreal)
643) else
644) call InputReadDouble(input,option, &
645) immobile_constraint%constraint_conc(iimmobile))
646) call InputErrorMsg(input,option,'concentration',block_string)
647) endif
648)
649) ! read units if they exist
650) internal_units = 'mol/m^3'
651) call InputReadWord(input,option,word,PETSC_TRUE)
652) if (InputError(input)) then
653) input%err_buf = trim(immobile_constraint%names(iimmobile)) // &
654) ' IMMOBILE CONCENTRATION UNITS'
655) call InputDefaultMsg(input,option)
656) else
657) immobile_constraint%constraint_conc(iimmobile) = &
658) immobile_constraint%constraint_conc(iimmobile) * &
659) UnitsConvertToInternal(word,internal_units,option)
660) endif
661) enddo
662)
663) if (iimmobile < reaction%immobile%nimmobile) then
664) option%io_buffer = &
665) 'Immobile lists in constraints must provide a ' // &
666) 'concentration for all immobile species ' // &
667) '(listed under IMMOBILE card in CHEMISTRY), ' // &
668) 'regardless of whether or not they are present.'
669) call printErrMsg(option)
670) endif
671)
672) if (associated(constraint%immobile_species)) then
673) call ImmobileConstraintDestroy(constraint%immobile_species)
674) endif
675) constraint%immobile_species => immobile_constraint
676)
677) case default
678) call InputKeywordUnrecognized(word,'CONSTRAINT',option)
679) end select
680)
681) enddo
682)
683) call PetscLogEventEnd(logging%event_tran_constraint_read,ierr);CHKERRQ(ierr)
684)
685) end subroutine TranConstraintRead
686)
687) ! ************************************************************************** !
688)
689) subroutine TranConstraintInitList(list)
690) !
691) ! Initializes a transport constraint list
692) !
693) ! Author: Glenn Hammond
694) ! Date: 10/14/08
695) !
696)
697) implicit none
698)
699) type(tran_constraint_list_type) :: list
700)
701) nullify(list%first)
702) nullify(list%last)
703) nullify(list%array)
704) list%num_constraints = 0
705)
706) end subroutine TranConstraintInitList
707)
708) ! ************************************************************************** !
709)
710) subroutine TranConstraintAddToList(new_constraint,list)
711) !
712) ! Adds a new constraint to a transport constraint
713) ! list
714) !
715) ! Author: Glenn Hammond
716) ! Date: 10/14/08
717) !
718)
719) implicit none
720)
721) type(tran_constraint_type), pointer :: new_constraint
722) type(tran_constraint_list_type) :: list
723)
724) list%num_constraints = list%num_constraints + 1
725) new_constraint%id = list%num_constraints
726) if (.not.associated(list%first)) list%first => new_constraint
727) if (associated(list%last)) list%last%next => new_constraint
728) list%last => new_constraint
729)
730) end subroutine TranConstraintAddToList
731)
732) ! ************************************************************************** !
733)
734) function TranConstraintGetPtrFromList(constraint_name,constraint_list)
735) !
736) ! Returns a pointer to the constraint matching
737) ! constraint_name
738) !
739) ! Author: Glenn Hammond
740) ! Date: 10/13/08
741) !
742)
743) use String_module
744)
745) implicit none
746)
747) type(tran_constraint_type), pointer :: TranConstraintGetPtrFromList
748) character(len=MAXWORDLENGTH) :: constraint_name
749) type(tran_constraint_list_type) :: constraint_list
750)
751) PetscInt :: length
752) type(tran_constraint_type), pointer :: constraint
753)
754) nullify(TranConstraintGetPtrFromList)
755) constraint => constraint_list%first
756)
757) do
758) if (.not.associated(constraint)) exit
759) length = len_trim(constraint_name)
760) if (length == len_trim(constraint%name) .and. &
761) StringCompare(constraint%name,constraint_name, &
762) length)) then
763) TranConstraintGetPtrFromList => constraint
764) return
765) endif
766) constraint => constraint%next
767) enddo
768)
769) end function TranConstraintGetPtrFromList
770)
771) ! ************************************************************************** !
772)
773) subroutine TranConstraintDestroy(constraint)
774) !
775) ! Deallocates a constraint
776) !
777) ! Author: Glenn Hammond
778) ! Date: 10/14/08
779) !
780)
781) implicit none
782)
783) type(tran_constraint_type), pointer :: constraint
784)
785) if (.not.associated(constraint)) return
786)
787) if (associated(constraint%aqueous_species)) &
788) call AqueousSpeciesConstraintDestroy(constraint%aqueous_species)
789) nullify(constraint%aqueous_species)
790) if (associated(constraint%free_ion_guess)) &
791) call GuessConstraintDestroy(constraint%free_ion_guess)
792) nullify(constraint%free_ion_guess)
793) if (associated(constraint%minerals)) &
794) call MineralConstraintDestroy(constraint%minerals)
795) nullify(constraint%minerals)
796) if (associated(constraint%surface_complexes)) &
797) call SurfaceComplexConstraintDestroy(constraint%surface_complexes)
798) nullify(constraint%surface_complexes)
799) if (associated(constraint%colloids)) &
800) call ColloidConstraintDestroy(constraint%colloids)
801) nullify(constraint%colloids)
802) if (associated(constraint%immobile_species)) &
803) call ImmobileConstraintDestroy(constraint%immobile_species)
804) nullify(constraint%immobile_species)
805)
806) deallocate(constraint)
807) nullify(constraint)
808)
809) end subroutine TranConstraintDestroy
810)
811) ! ************************************************************************** !
812)
813) subroutine TranConstraintDestroyList(constraint_list)
814) !
815) ! Deallocates a list of constraints
816) !
817) ! Author: Glenn Hammond
818) ! Date: 10/14/08
819) !
820)
821) implicit none
822)
823) type(tran_constraint_list_type), pointer :: constraint_list
824)
825) type(tran_constraint_type), pointer :: constraint, prev_constraint
826)
827) if (.not.associated(constraint_list)) return
828)
829) constraint => constraint_list%first
830) do
831) if (.not.associated(constraint)) exit
832) prev_constraint => constraint
833) constraint => constraint%next
834) call TranConstraintDestroy(prev_constraint)
835) enddo
836)
837) constraint_list%num_constraints = 0
838) nullify(constraint_list%first)
839) nullify(constraint_list%last)
840) if (associated(constraint_list%array)) deallocate(constraint_list%array)
841) nullify(constraint_list%array)
842)
843) deallocate(constraint_list)
844) nullify(constraint_list)
845)
846) end subroutine TranConstraintDestroyList
847)
848) ! ************************************************************************** !
849)
850) subroutine TranConstraintCouplerDestroy(coupler_list)
851) !
852) ! Destroys a constraint coupler linked list
853) !
854) ! Author: Glenn Hammond
855) ! Date: 10/14/08
856) !
857)
858) use Option_module
859)
860) implicit none
861)
862) type(tran_constraint_coupler_type), pointer :: coupler_list
863)
864) type(tran_constraint_coupler_type), pointer :: cur_coupler, prev_coupler
865)
866) cur_coupler => coupler_list
867)
868) do
869) if (.not.associated(cur_coupler)) exit
870) prev_coupler => cur_coupler
871) cur_coupler => cur_coupler%next
872) if (associated(prev_coupler%rt_auxvar)) then
873) call RTAuxVarDestroy(prev_coupler%rt_auxvar)
874) endif
875) nullify(prev_coupler%rt_auxvar)
876) if (associated(prev_coupler%global_auxvar)) then
877) call GlobalAuxVarDestroy(prev_coupler%global_auxvar)
878) endif
879) nullify(prev_coupler%global_auxvar)
880) nullify(prev_coupler%aqueous_species)
881) nullify(prev_coupler%minerals)
882) nullify(prev_coupler%surface_complexes)
883) nullify(prev_coupler%colloids)
884) nullify(prev_coupler%immobile_species)
885) nullify(prev_coupler%next)
886) deallocate(prev_coupler)
887) nullify(prev_coupler)
888) enddo
889)
890) nullify(coupler_list)
891)
892) end subroutine TranConstraintCouplerDestroy
893)
894) end module Transport_Constraint_module