geomechanics_global.F90 coverage: 28.57 %func 27.59 %block
1) module Geomechanics_Global_module
2)
3) use Geomechanics_Global_Aux_module
4) use PFLOTRAN_Constants_module
5)
6) implicit none
7)
8) private
9)
10) #include "petsc/finclude/petscsys.h"
11)
12) public :: GeomechGlobalSetup, &
13) GeomechGlobalSetAuxVarScalar, &
14) GeomechGlobalSetAuxVarVecLoc, &
15) GeomechGlobalUpdateAuxVars
16)
17) contains
18)
19) ! ************************************************************************** !
20)
21) subroutine GeomechGlobalSetup(geomech_realization)
22) !
23) ! Set up global aux vars in a realization
24) !
25) ! Author: Satish Karra, LANL
26) ! Date: 06/17/13
27) !
28)
29) use Geomechanics_Realization_class
30) use Geomechanics_Patch_module
31)
32) implicit none
33)
34) class(realization_geomech_type) :: geomech_realization
35)
36) ! There is only one patch in each realization
37) call GeomechGlobalSetupPatch(geomech_realization)
38)
39) end subroutine GeomechGlobalSetup
40)
41) ! ************************************************************************** !
42)
43) subroutine GeomechGlobalSetupPatch(geomech_realization)
44) !
45) ! Strips a geomech global auxvar
46) !
47) ! Author: Satish Karra, LANL
48) ! Date: 06/17/13
49) !
50)
51) use Geomechanics_Realization_class
52) use Geomechanics_Patch_module
53) use Option_module
54) use Geomechanics_Coupler_module
55) use Geomechanics_Grid_module
56) use Geomechanics_Grid_Aux_module
57)
58) implicit none
59)
60) class(realization_geomech_type) :: geomech_realization
61)
62) type(option_type), pointer :: option
63) type(geomech_patch_type),pointer :: patch
64) type(geomech_grid_type), pointer :: grid
65) type(geomech_coupler_type), pointer :: boundary_condition
66) type(geomech_coupler_type), pointer :: source_sink
67)
68) PetscInt :: ghosted_id
69) type(geomech_global_auxvar_type), pointer :: aux_vars(:)
70) PetscInt :: ivertex
71)
72) option => geomech_realization%option
73) patch => geomech_realization%geomech_patch
74) grid => patch%geomech_grid
75)
76) patch%geomech_aux%GeomechGlobal => GeomechGlobalAuxCreate()
77)
78) allocate(aux_vars(grid%ngmax_node))
79) do ghosted_id = 1, grid%ngmax_node
80) call GeomechGlobalAuxVarInit(aux_vars(ghosted_id),option)
81) enddo
82) patch%geomech_aux%GeomechGlobal%aux_vars => aux_vars
83) patch%geomech_aux%GeomechGlobal%num_aux = grid%ngmax_node
84)
85) end subroutine GeomechGlobalSetupPatch
86)
87) ! ************************************************************************** !
88)
89) subroutine GeomechGlobalSetAuxVarScalar(geomech_realization,value,ivar)
90) !
91) ! Strips a geomech global auxvar
92) !
93) ! Author: Satish Karra, LANL
94) ! Date: 06/17/13
95) !
96)
97) use Geomechanics_Realization_class
98) use Geomechanics_Patch_module
99)
100) implicit none
101)
102) class(realization_geomech_type) :: geomech_realization
103) PetscReal :: value
104) PetscInt :: ivar
105)
106) type(geomech_patch_type), pointer :: cur_patch
107)
108) cur_patch => geomech_realization%geomech_patch
109) call GeomechGlobalSetAuxVarScalarPatch(geomech_realization,value,ivar)
110)
111) end subroutine GeomechGlobalSetAuxVarScalar
112)
113) ! ************************************************************************** !
114)
115) subroutine GeomechGlobalSetAuxVarScalarPatch(geomech_realization,value,ivar)
116) !
117) ! Strips a geomech global auxvar
118) !
119) ! Author: Satish Karra, LANL
120) ! Date: 06/17/13
121) !
122)
123) use Geomechanics_Realization_class
124) use Option_module
125) use Geomechanics_Patch_module
126) use Variables_module, only : GEOMECH_DISP_X, &
127) GEOMECH_DISP_Y, &
128) GEOMECH_DISP_Z
129)
130) implicit none
131)
132) class(realization_geomech_type) :: geomech_realization
133) PetscReal :: value
134) PetscInt :: ivar
135)
136) type(option_type), pointer :: option
137) type(geomech_patch_type), pointer :: patch
138)
139) PetscInt :: i
140)
141) patch => geomech_realization%geomech_patch
142) option => geomech_realization%option
143)
144) select case(ivar)
145) case(GEOMECH_DISP_X)
146) do i=1, patch%geomech_aux%GeomechGlobal%num_aux
147) patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
148) GEOMECH_DISP_X_DOF) = value
149) enddo
150) case(GEOMECH_DISP_Y)
151) do i=1, patch%geomech_aux%GeomechGlobal%num_aux
152) patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
153) GEOMECH_DISP_Y_DOF) = value
154) enddo
155) case(GEOMECH_DISP_Z)
156) do i=1, patch%geomech_aux%GeomechGlobal%num_aux
157) patch%geomech_aux%GeomechGlobal%aux_vars(i)%disp_vector(&
158) GEOMECH_DISP_Z_DOF) = value
159) enddo
160) end select
161)
162) end subroutine GeomechGlobalSetAuxVarScalarPatch
163)
164) ! ************************************************************************** !
165)
166) subroutine GeomechGlobalSetAuxVarVecLoc(geomech_realization,vec_loc,ivar, &
167) isubvar)
168) !
169) ! Strips a geomech global auxvar
170) !
171) ! Author: Satish Karra, LANL
172) ! Date: 06/17/13
173) !
174)
175) use Geomechanics_Realization_class
176) use Geomechanics_Patch_module
177)
178) implicit none
179)
180) #include "petsc/finclude/petscvec.h"
181) #include "petsc/finclude/petscvec.h90"
182)
183) class(realization_geomech_type) :: geomech_realization
184) Vec :: vec_loc
185) PetscInt :: ivar
186) PetscInt :: isubvar
187)
188) type(geomech_patch_type), pointer :: cur_patch
189)
190) cur_patch => geomech_realization%geomech_patch
191) call GeomechGlobalSetAuxVarVecLocPatch(geomech_realization,vec_loc,ivar,isubvar)
192)
193) end subroutine GeomechGlobalSetAuxVarVecLoc
194)
195) ! ************************************************************************** !
196)
197) subroutine GeomechGlobalSetAuxVarVecLocPatch(geomech_realization,vec_loc,ivar,&
198) isubvar)
199) !
200) ! Strips a geomech global auxvar
201) !
202) ! Author: Satish Karra, LANL
203) ! Date: 06/17/13
204) !
205)
206) use Geomechanics_Realization_class
207) use Geomechanics_Patch_module
208) use Geomechanics_Grid_Aux_module
209) use Geomechanics_Grid_module
210) use Option_module
211) use Variables_module, only : GEOMECH_DISP_X, &
212) GEOMECH_DISP_Y, &
213) GEOMECH_DISP_Z
214)
215) implicit none
216)
217) #include "petsc/finclude/petscvec.h"
218) #include "petsc/finclude/petscvec.h90"
219)
220) class(realization_geomech_type) :: geomech_realization
221) Vec :: vec_loc
222) PetscInt :: ivar
223) PetscInt :: isubvar
224)
225) type(option_type), pointer :: option
226) type(geomech_patch_type), pointer :: patch
227) type(geomech_grid_type), pointer :: grid
228)
229) PetscInt :: ghosted_id
230) PetscReal, pointer :: vec_loc_p(:)
231) PetscErrorCode :: ierr
232)
233) patch => geomech_realization%geomech_patch
234) grid => patch%geomech_grid
235) option => geomech_realization%option
236)
237) call GeomechGridVecGetArrayF90(grid,vec_loc,vec_loc_p,ierr)
238)
239) select case(ivar)
240) case(GEOMECH_DISP_X)
241) select case(isubvar)
242) case default
243) do ghosted_id=1, grid%ngmax_node
244) patch%geomech_aux%GeomechGlobal%aux_vars(&
245) ghosted_id)%disp_vector(GEOMECH_DISP_X_DOF) &
246) = vec_loc_p(ghosted_id)
247) enddo
248) end select
249) case(GEOMECH_DISP_Y)
250) select case(isubvar)
251) case default
252) do ghosted_id=1, grid%ngmax_node
253) patch%geomech_aux%GeomechGlobal%aux_vars(&
254) ghosted_id)%disp_vector(GEOMECH_DISP_Y_DOF) &
255) = vec_loc_p(ghosted_id)
256) enddo
257) end select
258) case(GEOMECH_DISP_Z)
259) select case(isubvar)
260) case default
261) do ghosted_id=1, grid%ngmax_node
262) patch%geomech_aux%GeomechGlobal%aux_vars(&
263) ghosted_id)%disp_vector(GEOMECH_DISP_Z_DOF) &
264) = vec_loc_p(ghosted_id)
265) enddo
266) end select
267) end select
268)
269) call GeomechGridVecRestoreArrayF90(grid,vec_loc,vec_loc_p,ierr)
270)
271) end subroutine GeomechGlobalSetAuxVarVecLocPatch
272)
273) ! ************************************************************************** !
274)
275) subroutine GeomechGlobalUpdateAuxVars(geomech_realization,time_level)
276) !
277) ! Strips a geomech global auxvar
278) !
279) ! Author: Satish Karra, LANL
280) ! Date: 06/17/13
281) !
282)
283) use Geomechanics_Realization_class
284) use Geomechanics_Field_module
285) use Option_module
286) use Geomechanics_Discretization_module
287) use Variables_module, only : GEOMECH_DISP_X, &
288) GEOMECH_DISP_Y, &
289) GEOMECH_DISP_Z
290)
291) class(realization_geomech_type) :: geomech_realization
292) PetscInt :: time_level
293)
294) type(geomech_field_type), pointer :: geomech_field
295) type(option_type), pointer :: option
296)
297) option => geomech_realization%option
298) geomech_field => geomech_realization%geomech_field
299)
300) ! x displacement
301) call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
302) GEOMECH_DISP_X,ZERO_INTEGER)
303) call GeomechDiscretizationGlobalToLocal(&
304) geomech_realization%geomech_discretization, &
305) geomech_field%work,geomech_field%work_loc,ONEDOF)
306) call GeomechGlobalSetAuxVarVecLoc(geomech_realization,&
307) geomech_field%work_loc, &
308) GEOMECH_DISP_X,time_level)
309)
310) ! y displacement
311) call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
312) GEOMECH_DISP_Y,ZERO_INTEGER)
313) call GeomechDiscretizationGlobalToLocal(&
314) geomech_realization%geomech_discretization, &
315) geomech_field%work,geomech_field%work_loc,ONEDOF)
316) call GeomechGlobalSetAuxVarVecLoc(geomech_realization, &
317) geomech_field%work_loc, &
318) GEOMECH_DISP_Y,time_level)
319)
320) ! z displacement
321) call GeomechRealizGetDataset(geomech_realization,geomech_field%work, &
322) GEOMECH_DISP_Z,ZERO_INTEGER)
323) call GeomechDiscretizationGlobalToLocal(&
324) geomech_realization%geomech_discretization, &
325) geomech_field%work,geomech_field%work_loc,ONEDOF)
326) call GeomechGlobalSetAuxVarVecLoc(geomech_realization, &
327) geomech_field%work_loc, &
328) GEOMECH_DISP_Z,time_level)
329)
330)
331) end subroutine GeomechGlobalUpdateAuxVars
332)
333) end module Geomechanics_Global_module