surface_global_aux.F90 coverage: 71.43 %func 70.27 %block
1) module Surface_Global_Aux_module
2)
3) use PFLOTRAN_Constants_module
4)
5) implicit none
6)
7) private
8)
9) #include "petsc/finclude/petscsys.h"
10)
11) type, public :: surface_global_auxvar_type
12) PetscInt :: istate
13) PetscReal, pointer :: head(:) ! [m]
14) PetscReal :: temp ! [C]
15) PetscReal, pointer :: den_kg(:) ! [kg/m^3]
16) PetscBool :: is_dry
17) end type surface_global_auxvar_type
18)
19) type, public :: surface_global_type
20) PetscInt :: num_aux, num_aux_bc, num_aux_ss
21) type(surface_global_auxvar_type), pointer :: auxvars(:)
22) type(surface_global_auxvar_type), pointer :: auxvars_bc(:)
23) type(surface_global_auxvar_type), pointer :: auxvars_ss(:)
24) end type surface_global_type
25)
26) interface SurfaceGlobalAuxVarDestroy
27) module procedure SurfaceGlobalAuxVarSingleDestroy
28) module procedure SurfaceGlobalAuxVarArrayDestroy
29) end interface SurfaceGlobalAuxVarDestroy
30)
31) public :: SurfaceGlobalAuxCreate, &
32) SurfaceGlobalAuxDestroy, &
33) SurfaceGlobalAuxVarInit, &
34) SurfaceGlobalAuxVarCopy, &
35) SurfaceGlobalAuxVarDestroy, &
36) SurfaceGlobalAuxVarStrip
37)
38) contains
39)
40) ! ************************************************************************** !
41)
42) function SurfaceGlobalAuxCreate()
43) !
44) ! This routine
45) !
46) ! Author: Gautam Bisht, LBNL
47) ! Date: 02/28/13
48) !
49)
50) use Option_module
51)
52) implicit none
53)
54) type(surface_global_type), pointer :: SurfaceGlobalAuxCreate
55)
56) type(surface_global_type), pointer :: aux
57)
58) allocate(aux)
59) aux%num_aux = 0
60) aux%num_aux_bc = 0
61) aux%num_aux_ss = 0
62) nullify(aux%auxvars)
63) nullify(aux%auxvars_bc)
64) nullify(aux%auxvars_ss)
65)
66) SurfaceGlobalAuxCreate => aux
67)
68) end function SurfaceGlobalAuxCreate
69)
70) ! ************************************************************************** !
71)
72) subroutine SurfaceGlobalAuxVarInit(auxvar,option)
73) !
74) ! This routine
75) !
76) ! Author: Gautam Bisht, LBNL
77) ! Date: 02/28/13
78) !
79)
80) use Option_module
81) use PFLOTRAN_Constants_module, only : DUMMY_VALUE
82)
83) implicit none
84)
85) type(surface_global_auxvar_type) :: auxvar
86) type(option_type) :: option
87)
88) auxvar%istate = 0
89) auxvar%is_dry = PETSC_FALSE
90) allocate(auxvar%head(option%nphase))
91) auxvar%head = 0.d0
92) auxvar%temp = option%reference_temperature
93) allocate(auxvar%den_kg(option%nphase))
94) auxvar%den_kg = 0.d0
95)
96) end subroutine SurfaceGlobalAuxVarInit
97)
98) ! ************************************************************************** !
99)
100) subroutine SurfaceGlobalAuxVarCopy(auxvar,auxvar2,option)
101) !
102) ! This routine
103) !
104) ! Author: Gautam Bisht, LBNL
105) ! Date: 02/28/13
106) !
107)
108) use Option_module
109)
110) implicit none
111)
112) type(surface_global_auxvar_type) :: auxvar, auxvar2
113) type(option_type) :: option
114)
115) auxvar2%istate = auxvar%istate
116) auxvar2%is_dry = auxvar%is_dry
117) auxvar2%head = auxvar%head
118) auxvar2%temp = auxvar%temp
119) auxvar2%den_kg = auxvar%den_kg
120)
121) end subroutine SurfaceGlobalAuxVarCopy
122)
123) ! ************************************************************************** !
124)
125) subroutine SurfaceGlobalAuxVarSingleDestroy(auxvar)
126) !
127) ! This routine
128) !
129) ! Author: Gautam Bisht, LBNL
130) ! Date: 02/28/13
131) !
132)
133) implicit none
134)
135) type(surface_global_auxvar_type), pointer :: auxvar
136)
137) if (associated(auxvar)) then
138) call SurfaceGlobalAuxVarStrip(auxvar)
139) deallocate(auxvar)
140) endif
141) nullify(auxvar)
142)
143) end subroutine SurfaceGlobalAuxVarSingleDestroy
144)
145) ! ************************************************************************** !
146)
147) subroutine SurfaceGlobalAuxVarArrayDestroy(auxvars)
148) !
149) ! This routine
150) !
151) ! Author: Gautam Bisht, LBNL
152) ! Date: 02/28/13
153) !
154)
155) implicit none
156)
157) type(surface_global_auxvar_type), pointer :: auxvars(:)
158)
159) PetscInt :: iaux
160)
161) if (associated(auxvars)) then
162) do iaux = 1, size(auxvars)
163) call SurfaceGlobalAuxVarStrip(auxvars(iaux))
164) enddo
165) deallocate(auxvars)
166) endif
167) nullify(auxvars)
168)
169) end subroutine SurfaceGlobalAuxVarArrayDestroy
170)
171) ! ************************************************************************** !
172)
173) subroutine SurfaceGlobalAuxVarStrip(auxvar)
174) !
175) ! This routine
176) !
177) ! Author: Gautam Bisht, LBNL
178) ! Date: 02/28/13
179) !
180)
181) use Utility_module, only: DeallocateArray
182)
183) implicit none
184)
185) type(surface_global_auxvar_type) :: auxvar
186)
187) call DeallocateArray(auxvar%head)
188) call DeallocateArray(auxvar%den_kg)
189)
190)
191) end subroutine SurfaceGlobalAuxVarStrip
192)
193) ! ************************************************************************** !
194)
195) subroutine SurfaceGlobalAuxDestroy(aux)
196) !
197) ! This routine
198) !
199) ! Author: Gautam Bisht, LBNL
200) ! Date: 02/28/13
201) !
202)
203) implicit none
204)
205) type(surface_global_type), pointer :: aux
206) PetscInt :: iaux
207)
208) if (.not.associated(aux)) return
209)
210) call SurfaceGlobalAuxVarDestroy(aux%auxvars)
211) call SurfaceGlobalAuxVarDestroy(aux%auxvars_bc)
212) call SurfaceGlobalAuxVarDestroy(aux%auxvars_ss)
213)
214) deallocate(aux)
215) nullify(aux)
216)
217) end subroutine SurfaceGlobalAuxDestroy
218)
219) end module Surface_Global_Aux_module