reaction_immobile_aux.F90 coverage: 90.91 %func 80.63 %block
1) module Reaction_Immobile_Aux_module
2)
3) use Reaction_Database_Aux_module
4)
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) type, public :: immobile_species_type
14) PetscInt :: id
15) character(len=MAXWORDLENGTH) :: name
16) PetscReal :: molar_weight
17) PetscBool :: print_me
18) type(immobile_species_type), pointer :: next
19) end type immobile_species_type
20)
21) type, public :: immobile_constraint_type
22) ! Any changes here must be incorporated within ReactionProcessConstraint()
23) ! where constraints are reordered
24) character(len=MAXWORDLENGTH), pointer :: names(:)
25) PetscReal, pointer :: constraint_conc(:)
26) character(len=MAXWORDLENGTH), pointer :: constraint_aux_string(:)
27) PetscBool, pointer :: external_dataset(:)
28) end type immobile_constraint_type
29)
30) type, public :: immobile_decay_rxn_type
31) PetscInt :: id
32) character(len=MAXWORDLENGTH) :: species_name
33) PetscReal :: rate_constant
34) PetscReal :: half_life
35) PetscBool :: print_me
36) type(immobile_decay_rxn_type), pointer :: next
37) end type immobile_decay_rxn_type
38)
39) type, public :: immobile_type
40)
41) PetscInt :: nimmobile
42) PetscBool :: print_all
43)
44) type(immobile_species_type), pointer :: list
45) type(immobile_decay_rxn_type), pointer :: decay_rxn_list
46)
47) ! immobile species
48) character(len=MAXWORDLENGTH), pointer :: names(:)
49) PetscBool, pointer :: print_me(:)
50)
51) ! decay rxn
52) PetscInt :: ndecay_rxn
53) PetscInt, pointer :: decayspecid(:)
54) PetscReal, pointer :: decay_rate_constant(:)
55)
56) end type immobile_type
57)
58) interface GetImmobileSpeciesIDFromName
59) module procedure GetImmobileSpeciesIDFromName1
60) module procedure GetImmobileSpeciesIDFromName2
61) end interface
62)
63) public :: ImmobileCreate, &
64) ImmobileSpeciesCreate, &
65) ImmobileConstraintCreate, &
66) ImmobileDecayRxnCreate, &
67) ImmobileGetCount, &
68) ImmobileConstraintDestroy, &
69) GetImmobileSpeciesIDFromName, &
70) ImmobileDestroy
71)
72) contains
73)
74) ! ************************************************************************** !
75)
76) function ImmobileCreate()
77) !
78) ! Allocate and initialize immobile object
79) !
80) ! Author: Glenn Hammond
81) ! Date: 01/11/13
82) !
83)
84) implicit none
85)
86) type(immobile_type), pointer :: ImmobileCreate
87)
88) type(immobile_type), pointer :: immobile
89)
90) allocate(immobile)
91) nullify(immobile%list)
92) nullify(immobile%decay_rxn_list)
93) immobile%nimmobile = 0
94) immobile%print_all = PETSC_FALSE
95) nullify(immobile%names)
96) nullify(immobile%print_me)
97)
98) immobile%ndecay_rxn = 0
99) nullify(immobile%decayspecid)
100) nullify(immobile%decay_rate_constant)
101)
102) ImmobileCreate => immobile
103)
104) end function ImmobileCreate
105)
106) ! ************************************************************************** !
107)
108) function ImmobileSpeciesCreate()
109) !
110) ! Allocate and initialize a immobile species object
111) !
112) ! Author: Glenn Hammond
113) ! Date: 01/02/13
114) !
115)
116) implicit none
117)
118) type(immobile_species_type), pointer :: ImmobileSpeciesCreate
119)
120) type(immobile_species_type), pointer :: species
121)
122) allocate(species)
123) species%id = 0
124) species%name = ''
125) species%molar_weight = 0.d0
126) species%print_me = PETSC_FALSE
127) nullify(species%next)
128)
129) ImmobileSpeciesCreate => species
130)
131) end function ImmobileSpeciesCreate
132)
133) ! ************************************************************************** !
134)
135) function ImmobileConstraintCreate(immobile,option)
136) !
137) ! Creates a immobile constraint object
138) !
139) ! Author: Glenn Hammond
140) ! Date: 01/07/13
141) !
142)
143) use Option_module
144)
145) implicit none
146)
147) type(immobile_type) :: immobile
148) type(option_type) :: option
149) type(immobile_constraint_type), pointer :: ImmobileConstraintCreate
150)
151) type(immobile_constraint_type), pointer :: constraint
152)
153) allocate(constraint)
154) allocate(constraint%names(immobile%nimmobile))
155) constraint%names = ''
156) allocate(constraint%constraint_conc(immobile%nimmobile))
157) constraint%constraint_conc = 0.d0
158) allocate(constraint%constraint_aux_string(immobile%nimmobile))
159) constraint%constraint_aux_string = ''
160) allocate(constraint%external_dataset(immobile%nimmobile))
161) constraint%external_dataset = PETSC_FALSE
162)
163) ImmobileConstraintCreate => constraint
164)
165) end function ImmobileConstraintCreate
166)
167) ! ************************************************************************** !
168)
169) function ImmobileDecayRxnCreate()
170) !
171) ! Allocate and initialize a immobile decay reaction
172) !
173) ! Author: Glenn Hammond
174) ! Date: 03/31/15
175) !
176)
177) implicit none
178)
179) type(immobile_decay_rxn_type), pointer :: ImmobileDecayRxnCreate
180)
181) type(immobile_decay_rxn_type), pointer :: rxn
182)
183) allocate(rxn)
184) rxn%id = 0
185) rxn%species_name = ''
186) rxn%rate_constant = 0.d0
187) rxn%half_life = 0.d0
188) rxn%print_me = PETSC_FALSE
189) nullify(rxn%next)
190)
191) ImmobileDecayRxnCreate => rxn
192)
193) end function ImmobileDecayRxnCreate
194)
195) ! ************************************************************************** !
196)
197) function ImmobileGetCount(immobile)
198) !
199) ! Returns the number of immobile species
200) !
201) ! Author: Glenn Hammond
202) ! Date: 01/02/13
203) !
204)
205) implicit none
206)
207) PetscInt :: ImmobileGetCount
208) type(immobile_type) :: immobile
209)
210) type(immobile_species_type), pointer :: immobile_species
211)
212) ImmobileGetCount = 0
213) immobile_species => immobile%list
214) do
215) if (.not.associated(immobile_species)) exit
216) ImmobileGetCount = ImmobileGetCount + 1
217) immobile_species => immobile_species%next
218) enddo
219)
220) end function ImmobileGetCount
221)
222) ! ************************************************************************** !
223)
224) function GetImmobileSpeciesIDFromName1(name,immobile,option)
225) !
226) ! Returns the id of named immobile species
227) !
228) ! Author: Glenn Hammond
229) ! Date: 01/28/13
230) !
231)
232) use Option_module
233) use String_module
234)
235) implicit none
236)
237) character(len=MAXWORDLENGTH) :: name
238) type(immobile_type) :: immobile
239) type(option_type) :: option
240)
241) PetscInt :: GetImmobileSpeciesIDFromName1
242)
243) GetImmobileSpeciesIDFromName1 = &
244) GetImmobileSpeciesIDFromName2(name,immobile,PETSC_TRUE,option)
245)
246) end function GetImmobileSpeciesIDFromName1
247)
248) ! ************************************************************************** !
249)
250) function GetImmobileSpeciesIDFromName2(name,immobile,return_error,option)
251) !
252) ! Returns the id of named immobile species
253) !
254) ! Author: Glenn Hammond
255) ! Date: 01/28/13
256) !
257)
258) use Option_module
259) use String_module
260)
261) implicit none
262)
263) character(len=MAXWORDLENGTH) :: name
264) type(immobile_type) :: immobile
265) PetscBool :: return_error
266) type(option_type) :: option
267)
268) PetscInt :: GetImmobileSpeciesIDFromName2
269)
270) type(immobile_species_type), pointer :: species
271) PetscInt :: i
272)
273) GetImmobileSpeciesIDFromName2 = UNINITIALIZED_INTEGER
274)
275) ! if the primary species name list exists
276) if (associated(immobile%names)) then
277) do i = 1, size(immobile%names)
278) if (StringCompare(name,immobile%names(i), &
279) MAXWORDLENGTH)) then
280) GetImmobileSpeciesIDFromName2 = i
281) exit
282) endif
283) enddo
284) else
285) species => immobile%list
286) i = 0
287) do
288) if (.not.associated(species)) exit
289) i = i + 1
290) if (StringCompare(name,species%name,MAXWORDLENGTH)) then
291) GetImmobileSpeciesIDFromName2 = i
292) exit
293) endif
294) species => species%next
295) enddo
296) endif
297)
298) if (return_error .and. GetImmobileSpeciesIDFromName2 <= 0) then
299) option%io_buffer = 'Species "' // trim(name) // &
300) '" not founds among immobile species in GetImmobileSpeciesIDFromName().'
301) call printErrMsg(option)
302) endif
303)
304) end function GetImmobileSpeciesIDFromName2
305)
306) ! ************************************************************************** !
307)
308) subroutine ImmobileSpeciesDestroy(species)
309) !
310) ! Deallocates a immobile species
311) !
312) ! Author: Glenn Hammond
313) ! Date: 01/02/13
314) !
315)
316) implicit none
317)
318) type(immobile_species_type), pointer :: species
319)
320) if (.not.associated(species)) return
321)
322) deallocate(species)
323) nullify(species)
324)
325) end subroutine ImmobileSpeciesDestroy
326)
327) ! ************************************************************************** !
328)
329) recursive subroutine ImmobileDecayRxnDestroy(rxn)
330) !
331) ! Deallocates a general reaction
332) !
333) ! Author: Glenn Hammond
334) ! Date: 03/31/15
335) !
336)
337) implicit none
338)
339) type(immobile_decay_rxn_type), pointer :: rxn
340)
341) if (.not.associated(rxn)) return
342)
343) call ImmobileDecayRxnDestroy(rxn%next)
344) nullify(rxn%next)
345) deallocate(rxn)
346) nullify(rxn)
347)
348) end subroutine ImmobileDecayRxnDestroy
349)
350) ! ************************************************************************** !
351)
352) subroutine ImmobileConstraintDestroy(constraint)
353) !
354) ! Destroys a colloid constraint object
355) !
356) ! Author: Glenn Hammond
357) ! Date: 03/12/10
358) !
359)
360) use Utility_module, only: DeallocateArray
361)
362) implicit none
363)
364) type(immobile_constraint_type), pointer :: constraint
365)
366) if (.not.associated(constraint)) return
367)
368) call DeallocateArray(constraint%names)
369) call DeallocateArray(constraint%constraint_conc)
370) call DeallocateArray(constraint%constraint_aux_string)
371) call DeallocateArray(constraint%external_dataset)
372)
373) deallocate(constraint)
374) nullify(constraint)
375)
376) end subroutine ImmobileConstraintDestroy
377)
378) ! ************************************************************************** !
379)
380) subroutine ImmobileDestroy(immobile)
381) !
382) ! Deallocates a immobile object
383) !
384) ! Author: Glenn Hammond
385) ! Date: 05/29/08
386) !
387)
388) use Utility_module, only: DeallocateArray
389)
390) implicit none
391)
392) type(immobile_type), pointer :: immobile
393)
394) type(immobile_species_type), pointer :: cur_immobile_species, &
395) prev_immobile_species
396)
397) if (.not.associated(immobile)) return
398)
399) ! immobile species
400) cur_immobile_species => immobile%list
401) do
402) if (.not.associated(cur_immobile_species)) exit
403) prev_immobile_species => cur_immobile_species
404) cur_immobile_species => cur_immobile_species%next
405) call ImmobileSpeciesDestroy(prev_immobile_species)
406) enddo
407) nullify(immobile%list)
408)
409) call DeallocateArray(immobile%names)
410) call DeallocateArray(immobile%print_me)
411)
412) call ImmobileDecayRxnDestroy(immobile%decay_rxn_list)
413) call DeallocateArray(immobile%decayspecid)
414) call DeallocateArray(immobile%decay_rate_constant)
415)
416) deallocate(immobile)
417) nullify(immobile)
418)
419) end subroutine ImmobileDestroy
420)
421) end module Reaction_Immobile_Aux_module