geomechanics_realization.F90 coverage: 94.44 %func 73.04 %block
1) module Geomechanics_Realization_class
2)
3) use Realization_Base_class
4) use Geomechanics_Discretization_module
5) use Geomechanics_Patch_module
6) use Geomechanics_Material_module
7) use Geomechanics_Field_module
8) use Geomechanics_Debug_module
9) use Geomechanics_Region_module
10) use Geomechanics_Condition_module
11) use Input_Aux_module
12) use Option_module
13) use Output_Aux_module
14) use Dataset_Base_class
15) use PFLOTRAN_Constants_module
16)
17) implicit none
18)
19) private
20)
21) #include "petsc/finclude/petscsys.h"
22)
23) type, public, extends(realization_base_type) :: realization_geomech_type
24)
25) type(geomech_discretization_type), pointer :: geomech_discretization
26) type(geomech_patch_type), pointer :: geomech_patch
27)
28) type(geomech_material_property_type), &
29) pointer :: geomech_material_properties
30) type(geomech_material_property_ptr_type), &
31) pointer :: geomech_material_property_array(:)
32)
33) type(geomech_field_type), pointer :: geomech_field
34) type(geomech_debug_type), pointer :: geomech_debug
35) type(gm_region_list_type), pointer :: geomech_region_list
36) type(geomech_condition_list_type),pointer :: geomech_conditions
37) class(dataset_base_type), pointer :: geomech_datasets
38) PetscReal :: dt_coupling
39)
40) end type realization_geomech_type
41)
42) public :: GeomechRealizCreate, &
43) GeomechRealizDestroy, &
44) GeomechRealizAddStrata, &
45) GeomechRealizAddGeomechCoupler, &
46) GeomechRealizLocalizeRegions, &
47) GeomechRealizPassFieldPtrToPatch, &
48) GeomechRealizProcessMatProp, &
49) GeomechRealizProcessGeomechCouplers, &
50) GeomechRealizCreateDiscretization, &
51) GeomechRealizProcessGeomechConditions, &
52) GeomechRealizInitAllCouplerAuxVars, &
53) GeomechRealizPrintCouplers, &
54) GeomechRealizAddWaypointsToList, &
55) GeomechRealizGetDataset, &
56) GeomechRealizLocalToLocalWithArray, &
57) GeomechRealizMapSubsurfGeomechGrid, &
58) GeomechGridElemSharedByNodes
59) contains
60)
61) ! ************************************************************************** !
62)
63) function GeomechRealizCreate(option)
64) !
65) ! This subroutine creates realization for geomechanics
66) !
67) ! Author: Satish Karra, LANL
68) ! Date: 05/23/13
69) !
70)
71) implicit none
72)
73) class(realization_geomech_type), pointer :: GeomechRealizCreate
74) class(realization_geomech_type), pointer :: geomech_realization
75) type(option_type), pointer :: option
76)
77) allocate(geomech_realization)
78) geomech_realization%id = 0
79) if (associated(option)) then
80) geomech_realization%option => option
81) else
82) geomech_realization%option => OptionCreate()
83) endif
84)
85) nullify(geomech_realization%input)
86) geomech_realization%geomech_discretization => GeomechDiscretizationCreate()
87)
88) geomech_realization%geomech_field => GeomechFieldCreate()
89) geomech_realization%output_option => OutputOptionCreate()
90) geomech_realization%geomech_debug => GeomechDebugCreate()
91)
92) allocate(geomech_realization%geomech_region_list)
93) call GeomechRegionInitList(geomech_realization%geomech_region_list)
94)
95) allocate(geomech_realization%geomech_conditions)
96) call GeomechConditionInitList(geomech_realization%geomech_conditions)
97)
98) nullify(geomech_realization%geomech_material_properties)
99) nullify(geomech_realization%geomech_material_property_array)
100)
101) nullify(geomech_realization%geomech_patch)
102) geomech_realization%dt_coupling = 0.d0
103)
104) GeomechRealizCreate => geomech_realization
105)
106) end function GeomechRealizCreate
107)
108) ! ************************************************************************** !
109)
110) subroutine GeomechRealizAddStrata(geomech_realization,strata)
111) !
112) ! Adds strata to a list
113) !
114) ! Author: Satish Karra, LANL
115) ! Date: 05/23/13
116) !
117)
118) use Geomechanics_Strata_module
119)
120) implicit none
121)
122) class(realization_geomech_type) :: geomech_realization
123) type(geomech_strata_type), pointer :: strata
124)
125) type(geomech_patch_type), pointer :: geomech_patch
126) type(geomech_strata_type), pointer :: new_strata
127)
128) geomech_patch => geomech_realization%geomech_patch
129)
130) if (.not.associated(geomech_patch)) return
131)
132) new_strata => GeomechStrataCreate(strata)
133) call GeomechStrataAddToList(new_strata,geomech_patch%geomech_strata_list)
134) nullify(new_strata)
135)
136) call GeomechStrataDestroy(strata)
137)
138) end subroutine GeomechRealizAddStrata
139)
140) ! ************************************************************************** !
141)
142) subroutine GeomechRealizLocalizeRegions(geomech_realization)
143) !
144) ! This routine localizes geomechanics regions
145) ! within each patch
146) !
147) ! Author: Satish Karra, LANL
148) ! Date: 06/07/13
149) !
150)
151) use Option_module
152) use String_module
153)
154) implicit none
155)
156) class(realization_geomech_type) :: geomech_realization
157) type(geomech_patch_type), pointer :: patch
158) type(option_type), pointer :: option
159)
160) option => geomech_realization%option
161)
162) ! localize the regions on each patch
163) patch => geomech_realization%geomech_patch
164) call GeomechPatchLocalizeRegions(patch, &
165) geomech_realization%geomech_region_list, &
166) option)
167)
168) end subroutine GeomechRealizLocalizeRegions
169)
170) ! ************************************************************************** !
171)
172) subroutine GeomechRealizProcessMatProp(geomech_realization)
173) !
174) ! Setup for material properties
175) !
176) ! Author: Satish Karra, LANL
177) ! Date: 06/13/13
178) !
179)
180) use String_module
181)
182) implicit none
183)
184) class(realization_geomech_type) :: geomech_realization
185) type(geomech_patch_type), pointer :: patch
186) type(option_type), pointer :: option
187)
188)
189) option => geomech_realization%option
190)
191) ! organize lists
192) call GeomechanicsMaterialPropConvertListToArray( &
193) geomech_realization%geomech_material_properties, &
194) geomech_realization%geomech_material_property_array, &
195) option)
196) ! set up mirrored pointer arrays within patches to saturation functions
197) ! and material properties
198) patch => geomech_realization%geomech_patch
199) patch%geomech_material_properties => geomech_realization% &
200) geomech_material_properties
201) call GeomechanicsMaterialPropConvertListToArray( &
202) patch%geomech_material_properties, &
203) patch%geomech_material_property_array, &
204) option)
205)
206) end subroutine GeomechRealizProcessMatProp
207)
208) ! ************************************************************************** !
209)
210) subroutine GeomechRealizCreateDiscretization(geomech_realization)
211) !
212) ! Creates grid
213) !
214) ! Author: Satish Karra, LANL
215) ! Date: 05/23/13
216) !
217)
218) use Geomechanics_Grid_Aux_module
219)
220) implicit none
221)
222) #include "petsc/finclude/petscvec.h"
223) #include "petsc/finclude/petscvec.h90"
224)
225) class(realization_geomech_type) :: geomech_realization
226) type(geomech_discretization_type), pointer :: geomech_discretization
227) type(geomech_grid_type), pointer :: grid
228) type(option_type), pointer :: option
229) type(geomech_field_type), pointer :: geomech_field
230) type(gmdm_ptr_type), pointer :: dm_ptr
231) PetscErrorCode :: ierr
232)
233) geomech_discretization => geomech_realization%geomech_discretization
234) grid => geomech_discretization%grid
235) option => geomech_realization%option
236) geomech_field => geomech_realization%geomech_field
237)
238) call GeomechDiscretizationCreateDMs(geomech_discretization,option)
239)
240) ! n degree of freedom, global
241) call GeomechDiscretizationCreateVector(geomech_discretization,NGEODOF, &
242) geomech_field%disp_xx, &
243) GLOBAL,option)
244) call VecSet(geomech_field%disp_xx,0.d0,ierr);CHKERRQ(ierr)
245)
246) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
247) geomech_field%disp_xx, &
248) geomech_field%disp_r)
249) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
250) geomech_field%disp_xx, &
251) geomech_field%work)
252)
253) ! 1 degree of freedom, global
254) call GeomechDiscretizationCreateVector(geomech_discretization,ONEDOF, &
255) geomech_field%press, &
256) GLOBAL,option)
257) call VecSet(geomech_field%press,0.d0,ierr);CHKERRQ(ierr)
258)
259) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
260) geomech_field%press, &
261) geomech_field%temp)
262)
263) ! n degrees of freedom, local
264) call GeomechDiscretizationCreateVector(geomech_discretization,NGEODOF, &
265) geomech_field%disp_xx_loc, &
266) LOCAL,option)
267) call VecSet(geomech_field%disp_xx_loc,0.d0,ierr);CHKERRQ(ierr)
268)
269) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
270) geomech_field%disp_xx_loc, &
271) geomech_field%work_loc)
272)
273) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
274) geomech_field%disp_xx_loc, &
275) geomech_field%disp_xx_init_loc)
276)
277) ! 1 degree of freedom, local
278) call GeomechDiscretizationCreateVector(geomech_discretization,ONEDOF, &
279) geomech_field%press_loc, &
280) LOCAL,option)
281)
282) call VecSet(geomech_field%press_loc,0.d0,ierr);CHKERRQ(ierr)
283)
284) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
285) geomech_field%press_loc, &
286) geomech_field%temp_loc)
287)
288) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
289) geomech_field%press_loc, &
290) geomech_field%press_init_loc)
291)
292) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
293) geomech_field%press_loc, &
294) geomech_field%temp_init_loc)
295)
296) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
297) geomech_field%press_loc, &
298) geomech_field%imech_loc)
299)
300) ! 6 dof for strain and stress
301) call GeomechDiscretizationCreateVector(geomech_discretization,SIX_INTEGER, &
302) geomech_field%strain_loc, &
303) LOCAL,option)
304)
305) call VecSet(geomech_field%strain_loc,0.d0,ierr);CHKERRQ(ierr)
306)
307) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
308) geomech_field%strain_loc, &
309) geomech_field%stress_loc)
310)
311) call GeomechDiscretizationCreateVector(geomech_discretization,SIX_INTEGER, &
312) geomech_field%strain, &
313) GLOBAL,option)
314)
315) call VecSet(geomech_field%strain,0.d0,ierr);CHKERRQ(ierr)
316)
317) call GeomechDiscretizationDuplicateVector(geomech_discretization, &
318) geomech_field%strain, &
319) geomech_field%stress)
320)
321) grid => geomech_discretization%grid
322)
323) ! set up nG2L, NL2G, etc.
324) call GMGridMapIndices(grid,geomech_discretization%dm_1dof%gmdm, &
325) grid%nG2L,grid%nL2G,grid%nG2A,option)
326)
327) ! SK, Need to add a subroutine to ensure right hand rule
328) ! SK, Need to add a subroutine equivalent to UGridComputeCoord
329)
330)
331) end subroutine GeomechRealizCreateDiscretization
332)
333) ! ************************************************************************** !
334)
335) subroutine GeomechRealizMapSubsurfGeomechGrid(realization, &
336) geomech_realization, &
337) option)
338) !
339) ! This routine creates scatter contexts
340) ! betweeen subsurface and geomech grids
341) !
342) ! Author: Satish Karra, LANL
343) ! Date: 09/09/13
344) !
345)
346) use Option_module
347) use Geomechanics_Grid_Aux_module
348) use Realization_Subsurface_class
349) use Grid_module
350)
351) implicit none
352)
353) #include "petsc/finclude/petscvec.h"
354) #include "petsc/finclude/petscvec.h90"
355) #include "petsc/finclude/petscdm.h"
356) #include "petsc/finclude/petscdm.h90"
357) #include "petsc/finclude/petscis.h"
358) #include "petsc/finclude/petscis.h90"
359) #include "petsc/finclude/petscviewer.h"
360)
361) class(realization_subsurface_type), pointer :: realization
362) class(realization_geomech_type), pointer :: geomech_realization
363) type(geomech_grid_type), pointer :: geomech_grid
364) type(option_type) :: option
365) type(grid_type), pointer :: grid
366) type(gmdm_type), pointer :: gmdm
367) type(gmdm_ptr_type), pointer :: dm_ptr
368) IS :: is_geomech, is_subsurf
369) IS :: is_subsurf_natural
370) IS :: is_subsurf_petsc
371) PetscViewer :: viewer
372) PetscErrorCode :: ierr
373) AO :: ao_geomech_to_subsurf_natural
374) PetscInt, allocatable :: int_array(:)
375) PetscInt :: local_id
376) VecScatter :: scatter
377) IS :: is_geomech_petsc
378) PetscInt, pointer :: int_ptr(:)
379) IS :: is_geomech_petsc_block
380) IS :: is_subsurf_petsc_block
381)
382) geomech_grid => geomech_realization%geomech_discretization%grid
383) grid => realization%discretization%grid
384)
385) ! Convert from 1-based to 0-based
386) call ISCreateGeneral(option%mycomm,geomech_grid%mapping_num_cells, &
387) geomech_grid%mapping_cell_ids_flow-1, &
388) PETSC_COPY_VALUES,is_subsurf,ierr);CHKERRQ(ierr)
389)
390) #if GEOMECH_DEBUG
391) call PetscViewerASCIIOpen(option%mycomm, &
392) 'geomech_is_mapping_cell_ids_flow.out', &
393) viewer,ierr);CHKERRQ(ierr)
394) call ISView(is_subsurf,viewer,ierr);CHKERRQ(ierr)
395) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
396) #endif
397)
398) call ISCreateGeneral(option%mycomm,geomech_grid%mapping_num_cells, &
399) geomech_grid%mapping_vertex_ids_geomech-1, &
400) PETSC_COPY_VALUES,is_geomech,ierr);CHKERRQ(ierr)
401)
402) #if GEOMECH_DEBUG
403) call PetscViewerASCIIOpen(option%mycomm, &
404) 'geomech_is_mapping_vertex_ids_geomech.out', &
405) viewer,ierr);CHKERRQ(ierr)
406) call ISView(is_geomech,viewer,ierr);CHKERRQ(ierr)
407) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
408) #endif
409)
410) call AOCreateMappingIS(is_geomech,is_subsurf,ao_geomech_to_subsurf_natural, &
411) ierr);CHKERRQ(ierr)
412) call ISDestroy(is_geomech,ierr);CHKERRQ(ierr)
413) call ISDestroy(is_subsurf,ierr);CHKERRQ(ierr)
414)
415) #if GEOMECH_DEBUG
416) call PetscViewerASCIIOpen(option%mycomm, &
417) 'geomech_ao_geomech_to_subsurf_natural.out', &
418) viewer,ierr);CHKERRQ(ierr)
419) call AOView(ao_geomech_to_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
420) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
421) #endif
422)
423) allocate(int_array(grid%nlmax))
424) do local_id = 1, grid%nlmax
425) int_array(local_id) = grid%nG2A(grid%nL2G(local_id)) - 1
426) enddo
427)
428) call ISCreateGeneral(option%mycomm,grid%nlmax, &
429) int_array,PETSC_COPY_VALUES,is_subsurf_natural, &
430) ierr);CHKERRQ(ierr)
431) deallocate(int_array)
432)
433) #if GEOMECH_DEBUG
434) call PetscViewerASCIIOpen(option%mycomm,'geomech_is_subsurf_natural.out', &
435) viewer,ierr);CHKERRQ(ierr)
436) call ISView(is_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
437) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
438) #endif
439)
440) allocate(int_array(grid%nlmax))
441) do local_id = 1, grid%nlmax
442) int_array(local_id) = (local_id-1) + grid%global_offset
443) enddo
444)
445) call ISCreateGeneral(option%mycomm,grid%nlmax, &
446) int_array,PETSC_COPY_VALUES,is_subsurf_petsc, &
447) ierr);CHKERRQ(ierr)
448) deallocate(int_array)
449)
450) #if GEOMECH_DEBUG
451) call PetscViewerASCIIOpen(option%mycomm,'geomech_is_subsurf_petsc.out', &
452) viewer,ierr);CHKERRQ(ierr)
453) call ISView(is_subsurf_natural,viewer,ierr);CHKERRQ(ierr)
454) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
455) #endif
456)
457) call ISDuplicate(is_subsurf_natural,is_geomech_petsc,ierr);CHKERRQ(ierr)
458) call ISCopy(is_subsurf_natural,is_geomech_petsc,ierr);CHKERRQ(ierr)
459)
460) call AOPetscToApplicationIS(ao_geomech_to_subsurf_natural,is_geomech_petsc, &
461) ierr);CHKERRQ(ierr)
462)
463) #if GEOMECH_DEBUG
464) call PetscViewerASCIIOpen(option%mycomm, &
465) 'geomech_is_subsurf_petsc_geomech_natural.out', &
466) viewer,ierr);CHKERRQ(ierr)
467) call ISView(is_geomech_petsc,viewer,ierr);CHKERRQ(ierr)
468) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
469) #endif
470)
471) call AOApplicationToPetscIS(geomech_grid%ao_natural_to_petsc_nodes, &
472) is_geomech_petsc,ierr);CHKERRQ(ierr)
473)
474) #if GEOMECH_DEBUG
475) call PetscViewerASCIIOpen(option%mycomm, &
476) 'geomech_is_subsurf_petsc_geomech_petsc.out', &
477) viewer,ierr);CHKERRQ(ierr)
478) call ISView(is_geomech_petsc,viewer,ierr);CHKERRQ(ierr)
479) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
480) #endif
481)
482) call VecScatterCreate(realization%field%porosity0,is_subsurf_petsc, &
483) geomech_realization%geomech_field%press, &
484) is_geomech_petsc,scatter,ierr);CHKERRQ(ierr)
485)
486) if (ierr /= 0) then
487) option%io_buffer = 'The number of cells specified in ' // &
488) 'input file might not be same as the ' // &
489) 'SUBSURF->GEOMECH mapping used.'
490) call printErrMsg(option)
491) endif
492)
493) #if GEOMECH_DEBUG
494) call PetscViewerASCIIOpen(option%mycomm, &
495) 'geomech_scatter_subsurf_to_geomech.out', &
496) viewer,ierr);CHKERRQ(ierr)
497) call VecScatterView(scatter,viewer,ierr);CHKERRQ(ierr)
498) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
499) #endif
500)
501) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
502) geomech_discretization, &
503) ONEDOF)
504)
505) call VecScatterCopy(scatter,dm_ptr%gmdm%scatter_subsurf_to_geomech_ndof, &
506) ierr);CHKERRQ(ierr)
507)
508) call VecScatterDestroy(scatter,ierr);CHKERRQ(ierr)
509)
510) ! Geomech to subsurf scatter
511)
512) allocate(int_array(grid%nlmax))
513) call ISGetIndicesF90(is_geomech_petsc,int_ptr,ierr);CHKERRQ(ierr)
514) do local_id = 1, grid%nlmax
515) int_array(local_id) = int_ptr(local_id)
516) enddo
517) call ISRestoreIndicesF90(is_geomech_petsc,int_ptr,ierr);CHKERRQ(ierr)
518) call ISCreateBlock(option%mycomm,SIX_INTEGER,grid%nlmax, &
519) int_array,PETSC_COPY_VALUES,is_geomech_petsc_block, &
520) ierr);CHKERRQ(ierr)
521) deallocate(int_array)
522)
523) #if GEOMECH_DEBUG
524) call PetscViewerASCIIOpen(option%mycomm, &
525) 'geomech_is_geomech_petsc_block.out', &
526) viewer,ierr);CHKERRQ(ierr)
527) call ISView(is_geomech_petsc_block,viewer,ierr);CHKERRQ(ierr)
528) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
529) #endif
530)
531) allocate(int_array(grid%nlmax))
532) call ISGetIndicesF90(is_subsurf_petsc,int_ptr,ierr);CHKERRQ(ierr)
533) do local_id = 1, grid%nlmax
534) int_array(local_id) = int_ptr(local_id)
535) enddo
536) call ISRestoreIndicesF90(is_subsurf_petsc,int_ptr,ierr);CHKERRQ(ierr)
537) call ISCreateBlock(option%mycomm,SIX_INTEGER,grid%nlmax, &
538) int_array,PETSC_COPY_VALUES,is_subsurf_petsc_block, &
539) ierr);CHKERRQ(ierr)
540) deallocate(int_array)
541)
542) #if GEOMECH_DEBUG
543) call PetscViewerASCIIOpen(option%mycomm, &
544) 'geomech_is_subsurf_petsc_block.out', &
545) viewer,ierr);CHKERRQ(ierr)
546) call ISView(is_subsurf_petsc_block,viewer,ierr);CHKERRQ(ierr)
547) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
548) #endif
549)
550) call VecScatterCreate(geomech_realization%geomech_field%strain, &
551) is_geomech_petsc_block, &
552) geomech_realization%geomech_field%strain_subsurf, &
553) is_subsurf_petsc_block,scatter,ierr);CHKERRQ(ierr)
554)
555) if (ierr /= 0) then
556) option%io_buffer = 'The number of cells specified in ' // &
557) 'input file might not be same as the ' // &
558) 'GEOMECH->SUBSURF mapping used.'
559) call printErrMsg(option)
560) endif
561)
562) #if GEOMECH_DEBUG
563) call PetscViewerASCIIOpen(option%mycomm, &
564) 'geomech_scatter_geomech_to_subsurf_block.out', &
565) viewer,ierr);CHKERRQ(ierr)
566) call VecScatterView(scatter,viewer,ierr);CHKERRQ(ierr)
567) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
568) #endif
569)
570) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_realization% &
571) geomech_discretization, &
572) ONEDOF)
573)
574) call VecScatterCopy(scatter,dm_ptr%gmdm%scatter_geomech_to_subsurf_ndof, &
575) ierr);CHKERRQ(ierr)
576)
577) call VecScatterDestroy(scatter,ierr);CHKERRQ(ierr)
578) call ISDestroy(is_geomech,ierr);CHKERRQ(ierr)
579) call ISDestroy(is_subsurf,ierr);CHKERRQ(ierr)
580) call ISDestroy(is_subsurf_natural,ierr);CHKERRQ(ierr)
581) call ISDestroy(is_geomech_petsc,ierr);CHKERRQ(ierr)
582) call ISDestroy(is_subsurf_petsc,ierr);CHKERRQ(ierr)
583) call AODestroy(ao_geomech_to_subsurf_natural,ierr);CHKERRQ(ierr)
584) call ISDestroy(is_subsurf_petsc_block,ierr);CHKERRQ(ierr)
585) call ISDestroy(is_geomech_petsc_block,ierr);CHKERRQ(ierr)
586)
587) end subroutine GeomechRealizMapSubsurfGeomechGrid
588)
589) ! ************************************************************************** !
590)
591) subroutine GeomechGridElemSharedByNodes(geomech_realization,option)
592) !
593) ! GeomechGridElemsSharedByNodes: Calculates the number of elements common
594) ! to a node (vertex)
595) !
596) ! Author: Satish Karra
597) ! Date: 09/17/13
598) !
599)
600) use Option_module
601) use Geomechanics_Grid_Aux_module
602)
603) implicit none
604)
605) #include "petsc/finclude/petscvec.h"
606) #include "petsc/finclude/petscvec.h90"
607)
608) class(realization_geomech_type) :: geomech_realization
609) type(geomech_grid_type), pointer :: grid
610) type(option_type) :: option
611)
612) PetscInt :: ielem
613) PetscInt :: ivertex
614) PetscInt :: ghosted_id
615) PetscInt :: elenodes(10)
616) PetscReal, pointer :: elem_sharing_node_loc_p(:)
617) PetscErrorCode :: ierr
618) PetscViewer :: viewer
619) character(len=MAXSTRINGLENGTH) :: string
620)
621) grid => geomech_realization%geomech_discretization%grid
622)
623) call VecGetArrayF90(grid%no_elems_sharing_node_loc,elem_sharing_node_loc_p, &
624) ierr);CHKERRQ(ierr)
625)
626) ! Calculate the common elements to a node on a process
627) do ielem = 1, grid%nlmax_elem
628) elenodes(1:grid%elem_nodes(0,ielem)) = &
629) grid%elem_nodes(1:grid%elem_nodes(0,ielem),ielem)
630) do ivertex = 1, grid%elem_nodes(0,ielem)
631) ghosted_id = elenodes(ivertex)
632) elem_sharing_node_loc_p(ghosted_id) = &
633) elem_sharing_node_loc_p(ghosted_id) + 1
634) enddo
635) enddo
636)
637) call VecRestoreArrayF90(grid%no_elems_sharing_node_loc, &
638) elem_sharing_node_loc_p,ierr);CHKERRQ(ierr)
639)
640) ! Local to global scatter
641) call GeomechDiscretizationLocalToGlobalAdd(&
642) geomech_realization%geomech_discretization, &
643) grid%no_elems_sharing_node_loc, &
644) grid%no_elems_sharing_node, &
645) ONEDOF)
646)
647) #if GEOMECH_DEBUG
648) write(string,*) option%myrank
649) string = 'no_elems_sharing_node_loc_' // trim(adjustl(string)) // '.out'
650)
651) call PetscViewerASCIIOpen(PETSC_COMM_SELF,trim(string), &
652) viewer,ierr);CHKERRQ(ierr)
653) call VecView(grid%no_elems_sharing_node_loc,viewer,ierr);CHKERRQ(ierr)
654) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
655) call PetscViewerASCIIOpen(option%mycomm,'no_elems_sharing_node.out', &
656) viewer,ierr);CHKERRQ(ierr)
657) call VecView(grid%no_elems_sharing_node,viewer,ierr);CHKERRQ(ierr)
658) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
659) #endif
660)
661) end subroutine GeomechGridElemSharedByNodes
662)
663) ! ************************************************************************** !
664)
665) subroutine GeomechRealizInitAllCouplerAuxVars(geomech_realization)
666) !
667) ! This routine initializez coupler
668) ! auxillary variables
669) !
670) ! Author: Satish Karra, LANL
671) ! Date: 06/17/13
672) !
673)
674) use Option_module
675)
676) implicit none
677)
678) class(realization_geomech_type) :: geomech_realization
679)
680) type(geomech_patch_type), pointer :: patch
681)
682) patch => geomech_realization%geomech_patch
683)
684) call GeomechPatchInitAllCouplerAuxVars(patch,geomech_realization%option)
685)
686) end subroutine GeomechRealizInitAllCouplerAuxVars
687)
688) ! ************************************************************************** !
689)
690) subroutine GeomechRealizLocalToLocalWithArray(geomech_realization,array_id)
691) !
692) ! This routine takes an F90 array that is
693) ! ghosted and updates the ghosted values
694) !
695) ! Author: Satish Karra, LANL
696) ! Date: 06/17/13
697) !
698)
699) use Geomechanics_Grid_Aux_module
700) use Geomechanics_Grid_module
701) use Geomechanics_Field_module
702)
703) implicit none
704)
705) class(realization_geomech_type) :: geomech_realization
706) PetscInt :: array_id
707)
708) type(geomech_patch_type), pointer :: patch
709) type(geomech_grid_type), pointer :: grid
710) type(geomech_field_type), pointer :: geomech_field
711)
712) geomech_field => geomech_realization%geomech_field
713) patch => geomech_realization%geomech_patch
714) grid => patch%geomech_grid
715)
716) select case(array_id)
717) case(MATERIAL_ID_ARRAY)
718) call GeomechGridCopyIntegerArrayToVec(grid,patch%imat, &
719) geomech_field%work_loc, &
720) grid%ngmax_node)
721) end select
722)
723) call GeomechDiscretizationLocalToLocal(&
724) geomech_realization%geomech_discretization, &
725) geomech_field%work_loc, &
726) geomech_field%work_loc,ONEDOF)
727)
728) select case(array_id)
729) case(MATERIAL_ID_ARRAY)
730) call GeomechGridCopyVecToIntegerArray(grid,patch%imat, &
731) geomech_field%work_loc, &
732) grid%ngmax_node)
733) end select
734)
735) end subroutine GeomechRealizLocalToLocalWithArray
736)
737) ! ************************************************************************** !
738)
739) subroutine GeomechRealizPrintCouplers(geomech_realization)
740) !
741) ! Print boundary data for geomechanics
742) !
743) ! Author: Satish Karra, LANL
744) ! Date: 06/17/13
745) !
746)
747) use Geomechanics_Coupler_module
748)
749) implicit none
750)
751) class(realization_geomech_type) :: geomech_realization
752)
753) type(geomech_patch_type), pointer :: patch
754) type(geomech_coupler_type), pointer :: cur_coupler
755) type(option_type), pointer :: option
756)
757) option => geomech_realization%option
758)
759) if (.not.OptionPrintToFile(option)) return
760)
761) patch => geomech_realization%geomech_patch
762)
763) cur_coupler => patch%geomech_boundary_condition_list%first
764) do
765) if (.not.associated(cur_coupler)) exit
766) call GeomechRealizPrintCoupler(cur_coupler,option)
767) cur_coupler => cur_coupler%next
768) enddo
769)
770) cur_coupler => patch%geomech_source_sink_list%first
771) do
772) if (.not.associated(cur_coupler)) exit
773) call GeomechRealizPrintCoupler(cur_coupler,option)
774) cur_coupler => cur_coupler%next
775) enddo
776)
777) end subroutine GeomechRealizPrintCouplers
778)
779) ! ************************************************************************** !
780)
781) subroutine GeomechRealizPrintCoupler(coupler,option)
782) !
783) ! Prints boundary condition coupler for geomechanics
784) !
785) ! Author: Satish Karra, LANL
786) ! Date: 06/17/13
787) !
788)
789) use Geomechanics_Coupler_module
790)
791) implicit none
792)
793) type(geomech_coupler_type) :: coupler
794) type(option_type) :: option
795)
796) character(len=MAXSTRINGLENGTH) :: string
797)
798) type(geomech_condition_type), pointer :: geomech_condition
799) type(gm_region_type), pointer :: region
800)
801) 98 format(40('=+'))
802) 99 format(80('-'))
803)
804) geomech_condition => coupler%geomech_condition
805) region => coupler%region
806)
807) write(option%fid_out,*)
808) write(option%fid_out,98)
809)
810)
811) select case(coupler%itype)
812) case(GM_BOUNDARY_COUPLER_TYPE)
813) string = 'Geomech Boundary Condition'
814) case(GM_SRC_SINK_COUPLER_TYPE)
815) string = 'Geomech Source Sink'
816) end select
817) write(option%fid_out,'(/,2x,a,/)') trim(string)
818)
819) write(option%fid_out,99)
820) 101 format(5x,' Geomech Condition: ',2x,a)
821) if (associated(geomech_condition)) &
822) write(option%fid_out,101) trim(geomech_condition%name)
823) 102 format(5x,' Region: ',2x,a)
824) if (associated(region)) &
825) write(option%fid_out,102) trim(region%name)
826) write(option%fid_out,99)
827)
828) if (associated(geomech_condition)) then
829) call GeomechConditionPrint(geomech_condition,option)
830) endif
831)
832) end subroutine GeomechRealizPrintCoupler
833)
834) ! ************************************************************************** !
835)
836) subroutine GeomechRealizPassFieldPtrToPatch(geomech_realization)
837) !
838) ! This subroutine passes field to patch
839) !
840) ! Author: Satish Karra, LANL
841) ! Date: 06/13/13
842) !
843)
844) use Option_module
845)
846) implicit none
847)
848) class(realization_geomech_type) :: geomech_realization
849)
850) type(geomech_patch_type), pointer :: patch
851)
852) patch => geomech_realization%geomech_patch
853)
854) patch%geomech_field => geomech_realization%geomech_field
855)
856) end subroutine GeomechRealizPassFieldPtrToPatch
857)
858) ! ************************************************************************** !
859)
860) subroutine GeomechRealizProcessGeomechCouplers(geomech_realization)
861) !
862) ! This subroutine sets up couplers in
863) ! geomech realization
864) !
865) ! Author: Satish Karra, LANL
866) ! Date: 06/14/13
867) !
868)
869) implicit none
870)
871) class(realization_geomech_type) :: geomech_realization
872)
873) type(geomech_patch_type), pointer :: patch
874)
875) patch => geomech_realization%geomech_patch
876)
877) call GeomechPatchProcessGeomechCouplers(patch, &
878) geomech_realization%geomech_conditions, &
879) geomech_realization%option)
880)
881) end subroutine GeomechRealizProcessGeomechCouplers
882)
883) ! ************************************************************************** !
884)
885) subroutine GeomechRealizProcessGeomechConditions(geomech_realization)
886) !
887) ! This subroutine sets up condition in
888) ! geomech realization
889) !
890) ! Author: Satish Karra, LANL
891) ! Date: 06/17/13
892) !
893)
894) use Dataset_Base_class
895) use Dataset_module
896)
897) implicit none
898)
899) class(realization_geomech_type), pointer :: geomech_realization
900)
901) type(geomech_condition_type), pointer :: cur_geomech_condition
902) type(geomech_sub_condition_type), pointer :: cur_geomech_sub_condition
903) type(option_type), pointer :: option
904) character(len=MAXSTRINGLENGTH) :: string
905) character(len=MAXWORDLENGTH) :: dataset_name
906) class(dataset_base_type), pointer :: dataset
907) PetscInt :: i
908)
909) option => geomech_realization%option
910)
911) ! loop over geomech conditions looking for linkage to datasets
912) cur_geomech_condition => geomech_realization%geomech_conditions%first
913) do
914) if (.not.associated(cur_geomech_condition)) exit
915) do i = 1, size(cur_geomech_condition%sub_condition_ptr)
916) ! find dataset
917) call DatasetFindInList(geomech_realization%geomech_datasets, &
918) cur_geomech_condition%sub_condition_ptr(i)%ptr%dataset, &
919) cur_geomech_condition%default_time_storage, &
920) string,option)
921) enddo
922) cur_geomech_condition => cur_geomech_condition%next
923) enddo
924)
925) end subroutine GeomechRealizProcessGeomechConditions
926)
927) ! ************************************************************************** !
928)
929) subroutine GeomechRealizGetDataset(geomech_realization,vec,ivar,isubvar, &
930) isubvar1)
931) !
932) ! This routine extracts variables indexed by
933) ! ivar and isubvar from geomechanics realization
934) !
935) ! Author: Satish Karra, LANL
936) ! Date: 07/03/13
937) !
938)
939) implicit none
940)
941) class(realization_geomech_type) :: geomech_realization
942) Vec :: vec
943) PetscInt :: ivar
944) PetscInt :: isubvar
945) PetscInt, optional :: isubvar1
946)
947) call GeomechPatchGetDataset(geomech_realization%geomech_patch, &
948) geomech_realization%geomech_field, &
949) geomech_realization%option, &
950) geomech_realization%output_option, &
951) vec,ivar,isubvar,isubvar1)
952)
953) end subroutine GeomechRealizGetDataset
954)
955) ! ************************************************************************** !
956)
957) subroutine GeomechRealizAddGeomechCoupler(geomech_realization,coupler)
958) !
959) ! This subroutine addes a geomechanics
960) ! coupler to a geomechanics realization
961) !
962) ! Author: Satish Karra, LANL
963) ! Date: 06/13/13
964) !
965)
966) use Geomechanics_Coupler_module
967)
968) implicit none
969)
970) class(realization_geomech_type) :: geomech_realization
971) type(geomech_coupler_type), pointer :: coupler
972)
973) type(geomech_patch_type), pointer :: patch
974) type(geomech_coupler_type), pointer :: new_coupler
975)
976) patch => geomech_realization%geomech_patch
977)
978) ! only add to geomech list for now, since they will be split out later
979) new_coupler => GeomechCouplerCreate(coupler)
980) select case(coupler%itype)
981) case(GM_BOUNDARY_COUPLER_TYPE)
982) call GeomechCouplerAddToList(new_coupler, &
983) patch%geomech_boundary_condition_list)
984) case(GM_SRC_SINK_COUPLER_TYPE)
985) call GeomechCouplerAddToList(new_coupler,patch%geomech_source_sink_list)
986) end select
987) nullify(new_coupler)
988)
989) call GeomechCouplerDestroy(coupler)
990)
991) end subroutine GeomechRealizAddGeomechCoupler
992)
993) ! ************************************************************************** !
994)
995) subroutine GeomechRealizAddWaypointsToList(geomech_realization,waypoint_list)
996) !
997) ! Adds waypoints from BCs and source/sink
998) ! to waypoint list
999) !
1000) ! Author: Satish Karra, LANL
1001) ! Date: 06/17/13
1002) !
1003)
1004) use Option_module
1005) use Waypoint_module
1006) use Time_Storage_module
1007)
1008) implicit none
1009)
1010) class(realization_geomech_type) :: geomech_realization
1011) type(waypoint_list_type), pointer :: waypoint_list
1012)
1013) type(geomech_condition_type), pointer :: cur_geomech_condition
1014) type(geomech_sub_condition_type), pointer :: sub_condition
1015) type(waypoint_type), pointer :: waypoint, cur_waypoint
1016) type(option_type), pointer :: option
1017) PetscInt :: itime, isub_condition
1018) PetscReal :: temp_real, final_time
1019) PetscReal, pointer :: times(:)
1020)
1021) option => geomech_realization%option
1022) nullify(times)
1023)
1024) ! set flag for final output
1025) cur_waypoint => waypoint_list%first
1026) do
1027) if (.not.associated(cur_waypoint)) exit
1028) if (cur_waypoint%final) then
1029) cur_waypoint%print_snap_output = &
1030) geomech_realization%output_option%print_final_snap
1031) exit
1032) endif
1033) cur_waypoint => cur_waypoint%next
1034) enddo
1035) ! use final time in conditional below
1036) if (associated(cur_waypoint)) then
1037) final_time = cur_waypoint%time
1038) else
1039) option%io_buffer = 'Final time not found in GeomechRealizAddWaypointsToList'
1040) call printErrMsg(option)
1041) endif
1042)
1043) ! add update of geomech conditions
1044) cur_geomech_condition => geomech_realization%geomech_conditions%first
1045) do
1046) if (.not.associated(cur_geomech_condition)) exit
1047) if (cur_geomech_condition%sync_time_with_update) then
1048) do isub_condition = 1, cur_geomech_condition%num_sub_conditions
1049) sub_condition => cur_geomech_condition% &
1050) sub_condition_ptr(isub_condition)%ptr
1051) call TimeStorageGetTimes(sub_condition%dataset%time_storage, option, &
1052) final_time, times)
1053) if (associated(times)) then
1054) if (size(times) > 1000) then
1055) option%io_buffer = 'For geomech condition "' // &
1056) trim(cur_geomech_condition%name) // &
1057) '" dataset "' // trim(sub_condition%name) // &
1058) '", the number of times is excessive for synchronization ' // &
1059) 'with waypoints.'
1060) call printErrMsg(option)
1061) endif
1062) do itime = 1, size(times)
1063) waypoint => WaypointCreate()
1064) waypoint%time = times(itime)
1065) waypoint%update_conditions = PETSC_TRUE
1066) call WaypointInsertInList(waypoint,waypoint_list)
1067) enddo
1068) deallocate(times)
1069) nullify(times)
1070) endif
1071) enddo
1072) endif
1073) cur_geomech_condition => cur_geomech_condition%next
1074) enddo
1075)
1076) end subroutine GeomechRealizAddWaypointsToList
1077)
1078) ! ************************************************************************** !
1079)
1080) subroutine GeomechRealizDestroy(geomech_realization)
1081) !
1082) ! This subroutine deallocates geomechanics realization
1083) !
1084) ! Author: Satish Karra, LANL
1085) ! Date: 05/23/13
1086) !
1087)
1088) implicit none
1089)
1090) class(realization_geomech_type), pointer :: geomech_realization
1091)
1092) if (.not.associated(geomech_realization)) return
1093)
1094) call GeomechFieldDestroy(geomech_realization%geomech_field)
1095)
1096) call OutputOptionDestroy(geomech_realization%output_option)
1097)
1098) call GeomechRegionDestroyList(geomech_realization%geomech_region_list)
1099)
1100) call GeomechConditionDestroyList(geomech_realization%geomech_conditions)
1101)
1102) if (associated(geomech_realization%geomech_debug)) &
1103) deallocate(geomech_realization%geomech_debug)
1104) nullify(geomech_realization%geomech_debug)
1105)
1106) if (associated(geomech_realization%geomech_material_property_array)) &
1107) deallocate(geomech_realization%geomech_material_property_array)
1108) nullify(geomech_realization%geomech_material_property_array)
1109) if (associated(geomech_realization%geomech_patch)) &
1110) call GeomechanicsPatchDestroy(geomech_realization%geomech_patch)
1111) call GeomechanicsMaterialPropertyDestroy(geomech_realization% &
1112) geomech_material_properties)
1113) call GeomechDiscretizationDestroy(geomech_realization%geomech_discretization)
1114)
1115) if (associated(geomech_realization%output_option)) &
1116) deallocate(geomech_realization%output_option)
1117) nullify(geomech_realization%output_option)
1118)
1119) if (associated(geomech_realization)) deallocate(geomech_realization)
1120) nullify(geomech_realization)
1121)
1122) end subroutine GeomechRealizDestroy
1123)
1124)
1125) end module Geomechanics_Realization_class