geomechanics_global_aux.F90 coverage: 71.43 %func 67.05 %block
1) module Geomechanics_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 :: geomech_global_auxvar_type
12) PetscReal, pointer :: disp_vector(:) ! [m]
13) PetscReal, pointer :: rel_disp_vector(:) ! [m]
14) PetscReal, pointer :: strain(:) ! dimensionless -- xx, yy, zz, xy, yz, zx
15) PetscReal, pointer :: stress(:) ! [Pa]
16) PetscInt :: count ! Number of elements shared by a vertex
17) ! The count above will be used for averaging the strains and stresses
18) ! over the elements
19) end type geomech_global_auxvar_type
20)
21) type, public :: geomech_global_type
22) PetscInt :: num_aux
23) type(geomech_global_auxvar_type), pointer :: aux_vars(:)
24) end type geomech_global_type
25)
26) interface GeomechGlobalAuxVarDestroy
27) module procedure GeomechGlobalAuxVarSingleDestroy
28) module procedure GeomechGlobalAuxVarArrayDestroy
29) end interface GeomechGlobalAuxVarDestroy
30)
31) public :: GeomechGlobalAuxCreate, &
32) GeomechGlobalAuxDestroy, &
33) GeomechGlobalAuxVarInit, &
34) GeomechGlobalAuxVarCopy, &
35) GeomechGlobalAuxVarDestroy, &
36) GeomechGlobalAuxVarStrip
37)
38) contains
39)
40) ! ************************************************************************** !
41)
42) function GeomechGlobalAuxCreate()
43) !
44) ! Creates a geomech global aux
45) !
46) ! Author: Satish Karra, LANL
47) ! Date: 06/14/13
48) !
49)
50) implicit none
51)
52) type(geomech_global_type), pointer :: GeomechGlobalAuxCreate
53)
54) type(geomech_global_type), pointer :: aux
55)
56) allocate(aux)
57) aux%num_aux = 0
58) nullify(aux%aux_vars)
59)
60) GeomechGlobalAuxCreate => aux
61)
62) end function GeomechGlobalAuxCreate
63)
64) ! ************************************************************************** !
65)
66) subroutine GeomechGlobalAuxVarInit(aux_var,option)
67) !
68) ! Initializes a geomech global aux
69) !
70) ! Author: Satish Karra, LANL
71) ! Date: 06/14/13
72) !
73)
74) use Option_module
75)
76) implicit none
77)
78) type(geomech_global_auxvar_type) :: aux_var
79) type(option_type) :: option
80)
81) allocate(aux_var%disp_vector(option%ngeomechdof))
82) allocate(aux_var%rel_disp_vector(option%ngeomechdof))
83) allocate(aux_var%strain(SIX_INTEGER))
84) allocate(aux_var%stress(SIX_INTEGER))
85) aux_var%disp_vector = 0.d0
86) aux_var%rel_disp_vector = 0.d0
87) aux_var%strain = 0.d0
88) aux_var%stress = 0.d0
89)
90) end subroutine GeomechGlobalAuxVarInit
91)
92) ! ************************************************************************** !
93)
94) subroutine GeomechGlobalAuxVarCopy(aux_var,aux_var2,option)
95) !
96) ! Copies a geomech global aux to another
97) !
98) ! Author: Satish Karra, LANL
99) ! Date: 06/14/13
100) !
101)
102) use Option_module
103)
104) implicit none
105)
106) type(geomech_global_auxvar_type) :: aux_var, aux_var2
107) type(option_type) :: option
108)
109) aux_var%disp_vector = aux_var2%disp_vector
110) aux_var%rel_disp_vector = aux_var2%rel_disp_vector
111) aux_var%strain = aux_var2%strain
112) aux_var%stress = aux_var2%stress
113)
114) end subroutine GeomechGlobalAuxVarCopy
115)
116) ! ************************************************************************** !
117)
118) subroutine GeomechGlobalAuxVarSingleDestroy(aux_var)
119) !
120) ! Destroys a geomech global aux
121) !
122) ! Author: Satish Karra, LANL
123) ! Date: 06/14/13
124) !
125)
126) implicit none
127)
128) type(geomech_global_auxvar_type), pointer :: aux_var
129)
130) if (associated(aux_var)) then
131) call GeomechGlobalAuxVarStrip(aux_var)
132) deallocate(aux_var)
133) endif
134) nullify(aux_var)
135)
136) end subroutine GeomechGlobalAuxVarSingleDestroy
137)
138) ! ************************************************************************** !
139)
140) subroutine GeomechGlobalAuxVarArrayDestroy(aux_vars)
141) !
142) ! Destroys an array of geomech global auxvar
143) ! type
144) !
145) ! Author: Satish Karra, LANL
146) ! Date: 06/14/13
147) !
148)
149) implicit none
150)
151) type(geomech_global_auxvar_type), pointer :: aux_vars(:)
152)
153) PetscInt :: iaux
154)
155) if (associated(aux_vars)) then
156) do iaux = 1, size(aux_vars)
157) call GeomechGlobalAuxVarStrip(aux_vars(iaux))
158) enddo
159) deallocate(aux_vars)
160) endif
161) nullify(aux_vars)
162)
163) end subroutine GeomechGlobalAuxVarArrayDestroy
164)
165) ! ************************************************************************** !
166)
167) subroutine GeomechGlobalAuxVarStrip(aux_var)
168) !
169) ! Strips a geomech global auxvar
170) !
171) ! Author: Satish Karra, LANL
172) ! Date: 06/14/13
173) !
174)
175) use Utility_module, only: DeallocateArray
176)
177) implicit none
178)
179) type(geomech_global_auxvar_type) :: aux_var
180)
181) call DeallocateArray(aux_var%disp_vector)
182) call DeallocateArray(aux_var%rel_disp_vector)
183) call DeallocateArray(aux_var%strain)
184) call DeallocateArray(aux_var%stress)
185)
186) end subroutine GeomechGlobalAuxVarStrip
187)
188) ! ************************************************************************** !
189)
190) subroutine GeomechGlobalAuxDestroy(aux)
191) !
192) ! Destroys a geomech global type
193) !
194) ! Author: Satish Karra, LANL
195) ! Date: 06/14/13
196) !
197)
198) implicit none
199)
200) type(geomech_global_type), pointer :: aux
201)
202) if (.not.associated(aux)) return
203)
204) call GeomechGlobalAuxVarDestroy(aux%aux_vars)
205)
206) deallocate(aux)
207) nullify(aux)
208)
209) end subroutine GeomechGlobalAuxDestroy
210)
211) end module Geomechanics_Global_Aux_module