pm_geomechanics_force.F90 coverage: 73.33 %func 66.67 %block
1) module PM_Geomechanics_Force_class
2)
3) use PM_Base_class
4) use Geomechanics_Realization_class
5) use Communicator_Base_module
6) use Option_module
7) use PFLOTRAN_Constants_module
8)
9) implicit none
10)
11) private
12)
13) #include "petsc/finclude/petscsys.h"
14)
15) #include "petsc/finclude/petscvec.h"
16) #include "petsc/finclude/petscvec.h90"
17) #include "petsc/finclude/petscmat.h"
18) #include "petsc/finclude/petscmat.h90"
19) #include "petsc/finclude/petscsnes.h"
20) #include "petsc/finclude/petscts.h"
21)
22) type, public, extends(pm_base_type) :: pm_geomech_force_type
23) class(realization_geomech_type), pointer :: geomech_realization
24) class(communicator_type), pointer :: comm1
25) contains
26) procedure, public :: Setup => PMGeomechForceSetup
27) procedure, public :: PMGeomechForceSetRealization
28) procedure, public :: InitializeRun => PMGeomechForceInitializeRun
29) procedure, public :: FinalizeRun => PMGeomechForceFinalizeRun
30) procedure, public :: InitializeTimestep => PMGeomechForceInitializeTimestep
31) procedure, public :: Residual => PMGeomechForceResidual
32) procedure, public :: Jacobian => PMGeomechForceJacobian
33) procedure, public :: PreSolve => PMGeomechForcePreSolve
34) procedure, public :: UpdateSolution => PMGeomechForceUpdateSolution
35) procedure, public :: CheckpointBinary => PMGeomechForceCheckpointBinary
36) procedure, public :: RestartBinary => PMGeomechForceRestartBinary
37) procedure, public :: InputRecord => PMGeomechForceInputRecord
38) procedure, public :: Destroy => PMGeomechForceDestroy
39) procedure, public :: FinalizeTimestep => PMGeomechForceFinalizeTimestep
40) end type pm_geomech_force_type
41)
42) public :: PMGeomechForceCreate
43)
44) contains
45)
46) ! ************************************************************************** !
47)
48) function PMGeomechForceCreate()
49) !
50) ! This routine creates
51) !
52) ! Author: Gautam Bisht, LBNL
53) ! Date: 12/31/13
54) !
55)
56) implicit none
57)
58) class(pm_geomech_force_type), pointer :: PMGeomechForceCreate
59)
60) class(pm_geomech_force_type), pointer :: geomech_force_pm
61)
62) allocate(geomech_force_pm)
63) nullify(geomech_force_pm%option)
64) nullify(geomech_force_pm%output_option)
65) nullify(geomech_force_pm%geomech_realization)
66) nullify(geomech_force_pm%comm1)
67)
68) call PMBaseInit(geomech_force_pm)
69)
70) PMGeomechForceCreate => geomech_force_pm
71)
72) end function PMGeomechForceCreate
73)
74) ! ************************************************************************** !
75)
76) subroutine PMGeomechForceSetup(this)
77) !
78) ! This routine
79) !
80) ! Author: Gautam Bisht, LBNL
81) ! Date: 12/31/13
82) !
83)
84) use Geomechanics_Discretization_module
85) use Communicator_Structured_class
86) use Communicator_Unstructured_class
87) use Grid_module
88)
89) implicit none
90)
91) class(pm_geomech_force_type) :: this
92)
93) ! set up communicator
94) select case(this%geomech_realization%geomech_discretization%itype)
95) case(STRUCTURED_GRID)
96) this%comm1 => StructuredCommunicatorCreate()
97) case(UNSTRUCTURED_GRID)
98) this%comm1 => UnstructuredCommunicatorCreate()
99) end select
100)
101) !call this%comm1%SetDM(this%geomech_realization%geomech_discretization%dm_1dof)
102)
103) end subroutine PMGeomechForceSetup
104)
105) ! ************************************************************************** !
106)
107) recursive subroutine PMGeomechForceInitializeRun(this)
108) !
109) ! This routine
110) !
111) ! Author: Gautam Bisht, LBNL
112) ! Date: 12/31/13
113) !
114)
115) use Geomechanics_Force_module, only : GeomechUpdateSolution
116)
117) implicit none
118)
119) class(pm_geomech_force_type) :: this
120)
121) end subroutine PMGeomechForceInitializeRun
122)
123) ! ************************************************************************** !
124)
125) recursive subroutine PMGeomechForceFinalizeRun(this)
126) !
127) ! This routine
128) !
129) ! Author: Gautam Bisht, LBNL
130) ! Date: 12/31/13
131) !
132)
133) implicit none
134)
135) class(pm_geomech_force_type) :: this
136)
137) #ifdef PM_GEOMECH_FORCE_DEBUG
138) call printMsg(this%option,'PMGeomechForce%FinalizeRun()')
139) #endif
140)
141) if (associated(this%next)) then
142) call this%next%FinalizeRun()
143) endif
144)
145) end subroutine PMGeomechForceFinalizeRun
146)
147) ! ************************************************************************** !
148)
149) subroutine PMGeomechForceSetRealization(this, geomech_realization)
150) !
151) ! This routine
152) !
153) ! Author: Gautam Bisht, LBNL
154) ! Date: 12/31/13
155) !
156)
157) use Grid_module
158)
159) implicit none
160)
161) class(pm_geomech_force_type) :: this
162) class(realization_geomech_type), pointer :: geomech_realization
163)
164) this%geomech_realization => geomech_realization
165) this%realization_base => geomech_realization
166)
167) this%solution_vec = geomech_realization%geomech_field%disp_xx
168) this%residual_vec = geomech_realization%geomech_field%disp_r
169)
170) end subroutine PMGeomechForceSetRealization
171)
172) ! ************************************************************************** !
173)
174) subroutine PMGeomechForceInitializeTimestep(this)
175) !
176) ! This routine
177) !
178) ! Author: Gautam Bisht, LBNL
179) ! Date: 12/31/13
180) !
181)
182) use Geomechanics_Force_module, only : GeomechanicsForceInitialGuess
183) use Global_module
184)
185) implicit none
186)
187) class(pm_geomech_force_type) :: this
188)
189) #ifdef PM_GEOMECH_FORCE_DEBUG
190) call printMsg(this%option,'PMGeomechForce%InitializeTimestep()')
191) #endif
192)
193) if (this%option%print_screen_flag) then
194) write(*,'(/,2("=")," GEOMECHANICS ",62("="))')
195) endif
196)
197) call GeomechanicsForceInitialGuess(this%geomech_realization)
198)
199) end subroutine PMGeomechForceInitializeTimestep
200)
201) ! ************************************************************************** !
202)
203) subroutine PMGeomechForceResidual(this,snes,xx,r,ierr)
204) !
205) ! This routine
206) !
207) ! Author: Gautam Bisht, LBNL
208) ! Date: 12/31/13
209) !
210)
211) use Geomechanics_Force_module, only : GeomechForceResidual
212)
213) implicit none
214)
215) class(pm_geomech_force_type) :: this
216) SNES :: snes
217) Vec :: xx
218) Vec :: r
219) PetscErrorCode :: ierr
220)
221) #ifdef PM_GEOMECH_FORCE_DEBUG
222) call printMsg(this%option,'PMGeomechForce%Residual()')
223) #endif
224)
225) call GeomechForceResidual(snes,xx,r,this%geomech_realization,ierr)
226)
227) end subroutine PMGeomechForceResidual
228)
229) ! ************************************************************************** !
230)
231) subroutine PMGeomechForceJacobian(this,snes,xx,A,B,ierr)
232) !
233) ! This routine
234) !
235) ! Author: Gautam Bisht, LBNL
236) ! Date: 12/31/13
237) !
238)
239) use Geomechanics_Force_module, only : GeomechForceJacobian
240)
241) implicit none
242)
243) class(pm_geomech_force_type) :: this
244) SNES :: snes
245) Vec :: xx
246) Mat :: A, B
247) PetscErrorCode :: ierr
248)
249) #ifdef PM_GEOMECH_FORCE_DEBUG
250) call printMsg(this%option,'PMGeomechForce%Jacobian()')
251) #endif
252)
253) call GeomechForceJacobian(snes,xx,A,B,this%geomech_realization,ierr)
254)
255) end subroutine PMGeomechForceJacobian
256)
257) ! ************************************************************************** !
258)
259) subroutine PMGeomechForcePreSolve(this)
260) !
261) ! This routine
262) !
263) ! Author: Gautam Bisht, LBNL
264) ! Date: 12/31/13
265) !
266)
267) implicit none
268)
269) class(pm_geomech_force_type) :: this
270)
271) end subroutine PMGeomechForcePreSolve
272)
273) ! ************************************************************************** !
274)
275) subroutine PMGeomechForceUpdateSolution(this)
276) !
277) ! This routine
278) !
279) ! Author: Gautam Bisht, LBNL
280) ! Date: 12/31/13
281) !
282)
283) use Geomechanics_Force_module, only : GeomechUpdateSolution, &
284) GeomechStoreInitialDisp, &
285) GeomechForceUpdateAuxVars
286) use Condition_module
287)
288) implicit none
289)
290) class(pm_geomech_force_type) :: this
291)
292) PetscBool :: force_update_flag = PETSC_FALSE
293)
294) #ifdef PM_GEOMECH_FORCE_DEBUG
295) call printMsg(this%option,'PMGeomechForce%UpdateSolution()')
296) #endif
297)
298) ! begin from RealizationUpdate()
299) call GeomechUpdateSolution(this%geomech_realization)
300) if (this%option%geomech_initial) then
301) call GeomechStoreInitialDisp(this%geomech_realization)
302) this%option%geomech_initial = PETSC_FALSE
303) endif
304) call GeomechForceUpdateAuxVars(this%geomech_realization)
305)
306) end subroutine PMGeomechForceUpdateSolution
307)
308) ! ************************************************************************** !
309)
310) subroutine PMGeomechForceFinalizeTimestep(this)
311) !
312) ! This routine
313) !
314) ! Author: Gautam Bisht, LBNL
315) ! Date: 12/31/13
316) !
317)
318) use Global_module
319)
320) implicit none
321)
322) class(pm_geomech_force_type) :: this
323)
324) #ifdef PM_GEOMECH_FORCE_DEBUG
325) call printMsg(this%option,'PMGeomechForce%FinalizeTimestep()')
326) #endif
327)
328) end subroutine PMGeomechForceFinalizeTimestep
329)
330) ! ************************************************************************** !
331)
332) subroutine PMGeomechForceCheckpointBinary(this,viewer)
333) !
334) ! This routine
335) !
336) ! Author: Gautam Bisht, LBNL
337) ! Date: 12/31/13
338) !
339)
340) use Checkpoint_module
341)
342) implicit none
343) #include "petsc/finclude/petscviewer.h"
344)
345) class(pm_geomech_force_type) :: this
346) PetscViewer :: viewer
347)
348) call printErrMsg(this%option,'add code for checkpointing Geomech in PM approach')
349)
350) end subroutine PMGeomechForceCheckpointBinary
351)
352) ! ************************************************************************** !
353)
354) subroutine PMGeomechForceRestartBinary(this,viewer)
355) !
356) ! This routine
357) !
358) ! Author: Gautam Bisht, LBNL
359) ! Date: 12/31/13
360) !
361)
362) use Checkpoint_module
363)
364) implicit none
365) #include "petsc/finclude/petscviewer.h"
366)
367) class(pm_geomech_force_type) :: this
368) PetscViewer :: viewer
369)
370) call printErrMsg(this%option,'add code for restarting Geomech in PM approach')
371)
372) end subroutine PMGeomechForceRestartBinary
373)
374) ! ************************************************************************** !
375)
376) subroutine PMGeomechForceInputRecord(this)
377) !
378) ! Writes ingested information to the input record file.
379) !
380) ! Author: Jenn Frederick, SNL
381) ! Date: 03/21/2016
382) !
383)
384) implicit none
385)
386) class(pm_geomech_force_type) :: this
387)
388) character(len=MAXWORDLENGTH) :: word
389) PetscInt :: id
390)
391) id = INPUT_RECORD_UNIT
392)
393) write(id,'(a29)',advance='no') 'pm: '
394) write(id,'(a)') this%name
395)
396) end subroutine PMGeomechForceInputRecord
397)
398) ! ************************************************************************** !
399)
400) subroutine PMGeomechForceDestroy(this)
401) !
402) ! This routine
403) !
404) ! Author: Gautam Bisht, LBNL
405) ! Date: 12/31/13
406) !
407)
408) use Geomechanics_Realization_class, only : GeomechRealizDestroy
409)
410) implicit none
411)
412) class(pm_geomech_force_type) :: this
413)
414) if (associated(this%next)) then
415) call this%next%Destroy()
416) endif
417)
418) #ifdef PM_GEOMECH_FORCE_DEBUG
419) call printMsg(this%option,'PMGeomechForce%Destroy()')
420) #endif
421)
422) call GeomechRealizDestroy(this%geomech_realization)
423)
424) call this%comm1%Destroy()
425)
426) end subroutine PMGeomechForceDestroy
427)
428) end module PM_Geomechanics_Force_class