geomech_grid_aux.F90 coverage: 88.89 %func 68.48 %block
1) module Geomechanics_Grid_Aux_module
2)
3) use Grid_Unstructured_Cell_module
4) use Gauss_module
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12) #include "petsc/finclude/petscvec.h"
13) #include "petsc/finclude/petscvec.h90"
14) #include "petsc/finclude/petscis.h"
15) #include "petsc/finclude/petscis.h90"
16) #if defined(SCORPIO)
17) include "scorpiof.h"
18) #endif
19)
20) type, public :: geomech_grid_type
21) ! variables for geomechanics grid (unstructured) for finite element formulation
22) ! The dofs (displacements, here) are solved at the nodes
23) ! Notation corresponding to finite volume: node implies cell vertex and element means cell
24) PetscInt :: global_offset ! offset in petsc ordering for the first vertex on a processor
25) PetscInt :: global_offset_elem ! offset in petsc ordering for the first element on a processor
26) PetscInt :: nmax_elem ! Total number of elements in the global domain
27) PetscInt :: nlmax_elem ! Total number of non-ghosted elements on a processor
28) PetscInt :: nmax_node ! Total number of nodes in the global domain
29) PetscInt :: nlmax_node ! Total number of non-ghosted nodes on a processor
30) PetscInt :: ngmax_node ! Total number of ghosted nodes on a processor
31) PetscInt :: num_ghost_nodes ! Number of ghost nodes on a processor
32) PetscInt, pointer :: elem_ids_natural(:) ! Natural numbering of elements on a processor
33) PetscInt, pointer :: elem_ids_petsc(:) ! Petsc numbering of elements on a processor
34) AO :: ao_natural_to_petsc ! mapping of natural to Petsc ordering
35) AO :: ao_natural_to_petsc_nodes ! mapping of natural to Petsc ordering of vertices
36) PetscInt :: max_ndual_per_elem ! Max. number of dual elements connected to an element
37) PetscInt :: max_nnode_per_elem ! Max. number of nodes per element
38) PetscInt :: max_elem_sharing_a_node ! Max. number of elements sharing a common node
39) PetscInt, pointer :: elem_type(:) ! Type of element
40) PetscInt, pointer :: elem_nodes(:,:) ! Node number on each element
41) type(point_type), pointer :: nodes(:) ! Coordinates of the nodes
42) PetscInt, pointer :: node_ids_ghosted_petsc(:) ! Petsc ids of ghosted local nodes
43) PetscInt, pointer :: node_ids_ghosted_natural(:) ! Natural ids of ghosted local nodes
44) PetscInt, pointer :: node_ids_local_natural(:) ! Natural ids of local nodes
45) PetscInt, pointer :: ghosted_node_ids_natural(:) ! Natural ids of the ghost nodes only
46) PetscInt, pointer :: ghosted_node_ids_petsc(:) ! Petsc ids of the ghost nodes only
47) PetscInt, pointer :: nL2G(:),nG2L(:),nG2A(:)
48) type(gauss_type), pointer :: gauss_node(:)
49) character(len=MAXSTRINGLENGTH) :: mapping_filename ! mapping between subsurf and geomech meshes
50) PetscInt :: mapping_num_cells
51) PetscInt, pointer :: mapping_cell_ids_flow(:)
52) PetscInt, pointer :: mapping_vertex_ids_geomech(:)
53) Vec :: no_elems_sharing_node_loc
54) Vec :: no_elems_sharing_node
55) end type geomech_grid_type
56)
57)
58) type, public :: gmdm_type ! Geomech. DM type
59) ! local: included both local (non-ghosted) and ghosted nodes
60) ! global: includes only local (non-ghosted) nodes
61) PetscInt :: ndof
62) ! for the below
63) ! ghosted = local (non-ghosted) and ghosted nodes
64) ! local = local (non-ghosted) nodes
65) IS :: is_ghosted_local ! IS for ghosted nodes with local on-processor numbering
66) IS :: is_local_local ! IS for local nodes with local on-processor numbering
67) IS :: is_ghosted_petsc ! IS for ghosted nodes with petsc numbering
68) IS :: is_local_petsc ! IS for local nodes with petsc numbering
69) IS :: is_ghosts_local ! IS for ghost nodes with local on-processor numbering
70) IS :: is_ghosts_petsc ! IS for ghost nodes with petsc numbering
71) IS :: is_local_natural ! IS for local nodes with natural (global) numbering
72) VecScatter :: scatter_ltog ! scatter context for local to global updates
73) VecScatter :: scatter_gtol ! scatter context for global to local updates
74) VecScatter :: scatter_ltol ! scatter context for local to local updates
75) VecScatter :: scatter_gton ! scatter context for global to natural updates
76) VecScatter :: scatter_gton_elem ! scatter context for global to natural updates for elements(cells)
77) ISLocalToGlobalMapping :: mapping_ltog ! petsc vec local to global mapping
78) !geh: deprecated in PETSc in spring 2014
79) ! ISLocalToGlobalMapping :: mapping_ltogb ! block form of mapping_ltog
80) ISLocalToGlobalMapping :: mapping_ltog_elem ! For elements
81) !geh: deprecated in PETSc in spring 2014
82) ! ISLocalToGlobalMapping :: mapping_ltogb_elem ! For elements
83) Vec :: global_vec ! global vec (no ghost nodes), petsc-ordering
84) Vec :: local_vec ! local vec (includes local and ghosted nodes), local ordering
85) Vec :: global_vec_elem
86) VecScatter :: scatter_subsurf_to_geomech_ndof ! scatter context between subsurface and
87) ! geomech grids for 1-DOF
88) VecScatter :: scatter_geomech_to_subsurf_ndof ! scatter context between geomech and
89) ! subsurface grids for N-DOFs (Ndof = ngeomechdof)
90)
91) end type gmdm_type
92)
93) ! PetscInt, parameter :: HEX_TYPE = 1
94) ! PetscInt, parameter :: TET_TYPE = 2
95) ! PetscInt, parameter :: WEDGE_TYPE = 3
96) ! PetscInt, parameter :: PYR_TYPE = 4
97) ! PetscInt, parameter :: TRI_FACE_TYPE = 1
98) ! PetscInt, parameter :: QUAD_FACE_TYPE = 2
99) ! PetscInt, parameter :: MAX_VERT_PER_FACE = 4
100)
101) public :: GMGridCreate, &
102) GMGridDestroy, &
103) GMDMCreate, &
104) GMDMDestroy, &
105) GMCreateGMDM, &
106) GMGridDMCreateVector, &
107) GMGridDMCreateVectorElem, &
108) GMGridDMCreateJacobian, &
109) GMGridMapIndices
110)
111)
112) contains
113)
114) ! ************************************************************************** !
115) !
116) ! GMDMCreate: Creates a geomech grid distributed mesh object
117) ! author: Satish Karra, LANL
118) ! date: 05/22/13
119) !
120) ! ************************************************************************** !
121) function GMDMCreate()
122)
123) implicit none
124)
125) type(gmdm_type), pointer :: GMDMCreate
126) type(gmdm_type), pointer :: gmdm
127)
128) allocate(gmdm)
129) gmdm%is_ghosted_local = 0
130) gmdm%is_local_local = 0
131) gmdm%is_ghosted_petsc = 0
132) gmdm%is_local_petsc = 0
133) gmdm%is_ghosts_local = 0
134) gmdm%is_ghosts_petsc = 0
135) gmdm%is_local_natural = 0
136) gmdm%scatter_ltog = 0
137) gmdm%scatter_gtol = 0
138) gmdm%scatter_ltol = 0
139) gmdm%scatter_gton = 0
140) gmdm%scatter_gton_elem = 0
141) gmdm%mapping_ltog = 0
142) gmdm%mapping_ltog_elem = 0
143) gmdm%global_vec = 0
144) gmdm%local_vec = 0
145) gmdm%global_vec_elem = 0
146) gmdm%scatter_subsurf_to_geomech_ndof = 0
147) gmdm%scatter_geomech_to_subsurf_ndof = 0
148)
149) GMDMCreate => gmdm
150)
151) end function GMDMCreate
152)
153) ! ************************************************************************** !
154) !
155) ! GMGridCreate: Creates a geomechanics grid object
156) ! author: Satish Karra, LANL
157) ! date: 05/22/13
158) !
159) ! ************************************************************************** !
160) function GMGridCreate()
161)
162) implicit none
163)
164) type(geomech_grid_type), pointer :: GMGridCreate
165) type(geomech_grid_type), pointer :: geomech_grid
166)
167) allocate(geomech_grid)
168)
169) ! variables for all unstructured grids
170)
171) geomech_grid%global_offset = 0
172) geomech_grid%global_offset_elem = 0
173) geomech_grid%nmax_elem = 0
174) geomech_grid%nlmax_elem = 0
175) geomech_grid%nmax_node = 0
176) geomech_grid%nlmax_node = 0
177) geomech_grid%num_ghost_nodes = 0
178) nullify(geomech_grid%elem_ids_natural)
179) nullify(geomech_grid%elem_ids_petsc)
180) geomech_grid%ao_natural_to_petsc = 0
181) geomech_grid%ao_natural_to_petsc_nodes = 0
182) geomech_grid%max_ndual_per_elem = 0
183) geomech_grid%max_nnode_per_elem = 0
184) geomech_grid%max_elem_sharing_a_node = 0
185) nullify(geomech_grid%elem_type)
186) nullify(geomech_grid%elem_nodes)
187) nullify(geomech_grid%nodes)
188) nullify(geomech_grid%node_ids_ghosted_petsc)
189) nullify(geomech_grid%node_ids_ghosted_natural)
190) nullify(geomech_grid%ghosted_node_ids_natural)
191) nullify(geomech_grid%ghosted_node_ids_petsc)
192) nullify(geomech_grid%gauss_node)
193) geomech_grid%no_elems_sharing_node_loc = 0
194) geomech_grid%no_elems_sharing_node = 0
195)
196) GMGridCreate => geomech_grid
197)
198) end function GMGridCreate
199)
200) ! ************************************************************************** !
201) !
202) ! GMCreateGMDM: Mapping/scatter contexts are created for PETSc DM object
203) ! author: Satish Karra, LANL
204) ! date: 05/30/13
205) !
206) ! ************************************************************************** !
207) subroutine GMCreateGMDM(geomech_grid,gmdm,ndof,option)
208)
209) use Option_module
210) use Utility_module, only: reallocateIntArray
211)
212) implicit none
213)
214) #include "petsc/finclude/petscvec.h"
215) #include "petsc/finclude/petscvec.h90"
216) #include "petsc/finclude/petscmat.h"
217) #include "petsc/finclude/petscmat.h90"
218) #include "petsc/finclude/petscdm.h"
219) #include "petsc/finclude/petscdm.h90"
220) #include "petsc/finclude/petscis.h"
221) #include "petsc/finclude/petscis.h90"
222) #include "petsc/finclude/petscviewer.h"
223)
224) type(geomech_grid_type) :: geomech_grid
225) type(option_type) :: option
226) type(gmdm_type), pointer :: gmdm
227) PetscInt :: ndof
228) PetscInt, pointer :: int_ptr(:)
229) PetscInt :: local_id, ghosted_id
230) PetscInt :: idof
231) IS :: is_tmp, is_tmp_petsc, is_tmp_natural
232) Vec :: vec_tmp
233) PetscErrorCode :: ierr
234) character(len=MAXWORDLENGTH) :: ndof_word
235) character(len=MAXSTRINGLENGTH) :: string
236) PetscViewer :: viewer
237) PetscInt, allocatable :: int_array(:), int_array2(:)
238)
239) gmdm => GMDMCreate()
240) gmdm%ndof = ndof
241)
242) #if GEOMECH_DEBUG
243) write(ndof_word,*) ndof
244) ndof_word = adjustl(ndof_word)
245) ndof_word = '_' // trim(ndof_word)
246) string = 'Vectors_nodes' // ndof_word
247) call printMsg(option,string)
248) #endif
249)
250) ! create global vec
251) call VecCreate(option%mycomm,gmdm%global_vec,ierr);CHKERRQ(ierr)
252) call VecSetSizes(gmdm%global_vec,geomech_grid%nlmax_node*ndof,PETSC_DECIDE,&
253) ierr);CHKERRQ(ierr)
254) call VecSetBlockSize(gmdm%global_vec,ndof,ierr);CHKERRQ(ierr)
255) call VecSetFromOptions(gmdm%global_vec,ierr);CHKERRQ(ierr)
256)
257) ! create local vec
258) call VecCreate(PETSC_COMM_SELF,gmdm%local_vec,ierr);CHKERRQ(ierr)
259) call VecSetSizes(gmdm%local_vec,geomech_grid%ngmax_node*ndof,PETSC_DECIDE, &
260) ierr);CHKERRQ(ierr)
261) call VecSetBlockSize(gmdm%local_vec,ndof,ierr);CHKERRQ(ierr)
262) call VecSetFromOptions(gmdm%local_vec,ierr);CHKERRQ(ierr)
263)
264)
265) ! IS for global numbering of local, non-ghosted vertices
266) ! ISCreateBlock requires block ids, not indices. Therefore, istart should be
267) ! the offset of the block from the beginning of the vector.
268)
269) #if GEOMECH_DEBUG
270) string = 'Index_sets_nodes' // ndof_word
271) call printMsg(option,string)
272) #endif
273)
274) ! SK, Note: All the numbering are to be 0-based before creating IS
275)
276) allocate(int_array(geomech_grid%nlmax_node))
277) do local_id = 1, geomech_grid%nlmax_node
278) int_array(local_id) = (local_id-1) + geomech_grid%global_offset
279) enddo
280)
281) ! arguments for ISCreateBlock():
282) ! option%mycomm - the MPI communicator
283) ! ndof - number of elements in each block
284) ! geomech_grid%nlmax - the length of the index set
285) ! (the number of blocks
286) ! int_array - the list of integers, one for each block and count
287) ! of block not indices
288) ! PETSC_COPY_VALUES - see PetscCopyMode, only PETSC_COPY_VALUES and
289) ! PETSC_OWN_POINTER are supported in this routine
290) ! gmdm%is_local_petsc - the new index set
291) ! ierr - PETScErrorCode
292) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_node, &
293) int_array,PETSC_COPY_VALUES,gmdm%is_local_petsc, &
294) ierr);CHKERRQ(ierr)
295) deallocate(int_array)
296)
297) #if GEOMECH_DEBUG
298) string = 'geomech_is_local_petsc' // trim(ndof_word) // '.out'
299) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
300) ierr);CHKERRQ(ierr)
301) call ISView(gmdm%is_local_petsc,viewer,ierr);CHKERRQ(ierr)
302) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
303) #endif
304)
305) ! IS for local numbering of ghost nodes
306) if (geomech_grid%num_ghost_nodes > 0) then
307) allocate(int_array(geomech_grid%num_ghost_nodes))
308) do ghosted_id = 1, geomech_grid%num_ghost_nodes
309) int_array(ghosted_id) = (ghosted_id+geomech_grid%nlmax_node-1)
310) enddo
311) else
312) allocate(int_array(1))
313) int_array(1) = 0
314) endif
315)
316) call ISCreateBlock(option%mycomm,ndof,geomech_grid%num_ghost_nodes, &
317) int_array,PETSC_COPY_VALUES,gmdm%is_ghosts_local, &
318) ierr);CHKERRQ(ierr)
319)
320) if (allocated(int_array)) deallocate(int_array)
321)
322) #if GEOMECH_DEBUG
323) string = 'geomech_is_ghosts_local' // trim(ndof_word) // '.out'
324) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
325) ierr);CHKERRQ(ierr)
326) call ISView(gmdm%is_ghosts_local,viewer,ierr);CHKERRQ(ierr)
327) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
328) #endif
329)
330) ! IS for petsc numbering of ghost nodes
331) if (geomech_grid%num_ghost_nodes > 0) then
332) allocate(int_array(geomech_grid%num_ghost_nodes))
333) do ghosted_id = 1, geomech_grid%num_ghost_nodes
334) int_array(ghosted_id) = &
335) (geomech_grid%ghosted_node_ids_petsc(ghosted_id)-1)
336) enddo
337) else
338) allocate(int_array(1))
339) int_array(1) = 0
340) endif
341)
342) call ISCreateBlock(option%mycomm,ndof,geomech_grid%num_ghost_nodes, &
343) int_array,PETSC_COPY_VALUES,gmdm%is_ghosts_petsc, &
344) ierr);CHKERRQ(ierr)
345)
346) if (allocated(int_array)) deallocate(int_array)
347)
348) #if GEOMECH_DEBUG
349) string = 'geomech_is_ghosts_petsc' // trim(ndof_word) // '.out'
350) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
351) ierr);CHKERRQ(ierr)
352) call ISView(gmdm%is_ghosts_petsc,viewer,ierr);CHKERRQ(ierr)
353) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
354) #endif
355)
356) ! IS for local numbering of local, non-ghosted cells
357) allocate(int_array(geomech_grid%nlmax_node))
358) do local_id = 1, geomech_grid%nlmax_node
359) int_array(local_id) = (local_id-1)
360) enddo
361) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_node, &
362) int_array,PETSC_COPY_VALUES,gmdm%is_local_local, &
363) ierr);CHKERRQ(ierr)
364) deallocate(int_array)
365)
366) #if GEOMECH_DEBUG
367) string = 'geomech_is_local_local' // trim(ndof_word) // '.out'
368) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
369) ierr);CHKERRQ(ierr)
370) call ISView(gmdm%is_local_local,viewer,ierr);CHKERRQ(ierr)
371) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
372) #endif
373)
374) ! IS for ghosted numbering of local ghosted cells
375) allocate(int_array(geomech_grid%ngmax_node))
376) do ghosted_id = 1, geomech_grid%ngmax_node
377) int_array(ghosted_id) = (ghosted_id-1)
378) enddo
379) call ISCreateBlock(option%mycomm,ndof,geomech_grid%ngmax_node, &
380) int_array,PETSC_COPY_VALUES,gmdm%is_ghosted_local, &
381) ierr);CHKERRQ(ierr)
382) deallocate(int_array)
383)
384) #if GEOMECH_DEBUG
385) string = 'geomech_is_ghosted_local' // trim(ndof_word) // '.out'
386) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
387) ierr);CHKERRQ(ierr)
388) call ISView(gmdm%is_ghosted_local,viewer,ierr);CHKERRQ(ierr)
389) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
390) #endif
391)
392) ! IS for petsc numbering of local ghosted cells
393) allocate(int_array(geomech_grid%ngmax_node))
394) do local_id = 1, geomech_grid%nlmax_node
395) int_array(local_id) = (local_id-1) + geomech_grid%global_offset
396) enddo
397) if (geomech_grid%num_ghost_nodes > 0) then
398) do ghosted_id = 1,geomech_grid%num_ghost_nodes
399) int_array(geomech_grid%nlmax_node+ghosted_id) = &
400) (geomech_grid%ghosted_node_ids_petsc(ghosted_id)-1)
401) enddo
402) endif
403) call ISCreateBlock(option%mycomm,ndof,geomech_grid%ngmax_node, &
404) int_array,PETSC_COPY_VALUES,gmdm%is_ghosted_petsc, &
405) ierr);CHKERRQ(ierr)
406) deallocate(int_array)
407)
408) #if GEOMECH_DEBUG
409) string = 'geomech_is_ghosted_petsc' // trim(ndof_word) // '.out'
410) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
411) ierr);CHKERRQ(ierr)
412) call ISView(gmdm%is_ghosted_petsc,viewer,ierr);CHKERRQ(ierr)
413) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
414) #endif
415)
416) ! create a local to global mapping
417) #if GEOMECH_DEBUG
418) string = 'geomech_ISLocalToGlobalMapping' // ndof_word
419) call printMsg(option,string)
420) #endif
421)
422) call ISLocalToGlobalMappingCreateIS(gmdm%is_ghosted_petsc, &
423) gmdm%mapping_ltog,ierr);CHKERRQ(ierr)
424)
425) #if GEOMECH_DEBUG
426) string = 'geomech_mapping_ltog' // trim(ndof_word) // '.out'
427) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
428) ierr);CHKERRQ(ierr)
429) call ISLocalToGlobalMappingView(gmdm%mapping_ltog,viewer,ierr);CHKERRQ(ierr)
430) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
431) #endif
432)
433) #if GEOMECH_DEBUG
434) string = 'geomech_local to global' // ndof_word
435) call printMsg(option,string)
436) #endif
437)
438) ! Create local to global scatter
439) ! Note this will also use the data from ghosted nodes on local rank into
440) ! a global vec
441) call VecScatterCreate(gmdm%local_vec,gmdm%is_ghosted_local,gmdm%global_vec, &
442) gmdm%is_ghosted_petsc,gmdm%scatter_ltog, &
443) ierr);CHKERRQ(ierr)
444)
445) #if GEOMECH_DEBUG
446) string = 'geomech_scatter_ltog' // trim(ndof_word) // '.out'
447) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
448) ierr);CHKERRQ(ierr)
449) call VecScatterView(gmdm%scatter_ltog,viewer,ierr);CHKERRQ(ierr)
450) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
451) #endif
452)
453) #if GEOMECH_DEBUG
454) string = 'geomech_global to local' // ndof_word
455) call printMsg(option,string)
456) #endif
457)
458) ! Create global to local scatter
459) call VecScatterCreate(gmdm%global_vec,gmdm%is_ghosted_petsc,gmdm%local_vec, &
460) gmdm%is_ghosted_local,gmdm%scatter_gtol, &
461) ierr);CHKERRQ(ierr)
462)
463) #if GEOMECH_DEBUG
464) string = 'geomech_scatter_gtol' // trim(ndof_word) // '.out'
465) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
466) ierr);CHKERRQ(ierr)
467) call VecScatterView(gmdm%scatter_gtol,viewer,ierr);CHKERRQ(ierr)
468) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
469) #endif
470)
471) #if GEOMECH_DEBUG
472) string = 'geomech_local to local' // ndof_word
473) call printMsg(option,string)
474) #endif
475)
476) ! Create local to local scatter. Essentially remap the global to local as
477) ! PETSc does in daltol.c
478) call VecScatterCopy(gmdm%scatter_gtol,gmdm%scatter_ltol,ierr);CHKERRQ(ierr)
479) call ISGetIndicesF90(gmdm%is_local_local,int_ptr,ierr);CHKERRQ(ierr)
480) call VecScatterRemap(gmdm%scatter_ltol,int_ptr,PETSC_NULL_INTEGER, &
481) ierr);CHKERRQ(ierr)
482) call ISRestoreIndicesF90(gmdm%is_local_local,int_ptr,ierr);CHKERRQ(ierr)
483)
484) #if GEOMECH_DEBUG
485) string = 'geomech_scatter_ltol' // trim(ndof_word) // '.out'
486) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
487) ierr);CHKERRQ(ierr)
488) call VecScatterView(gmdm%scatter_ltol,viewer,ierr);CHKERRQ(ierr)
489) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
490) #endif
491)
492) allocate(int_array(geomech_grid%nlmax_node))
493) do local_id = 1, geomech_grid%nlmax_node
494) int_array(local_id) = (local_id-1) + geomech_grid%global_offset
495) enddo
496) call ISCreateGeneral(option%mycomm,geomech_grid%nlmax_node, &
497) int_array,PETSC_COPY_VALUES,is_tmp,ierr);CHKERRQ(ierr)
498) deallocate(int_array)
499)
500) call AOPetscToApplicationIS(geomech_grid%ao_natural_to_petsc_nodes, &
501) is_tmp,ierr);CHKERRQ(ierr)
502)
503) allocate(int_array(geomech_grid%nlmax_node))
504) call ISGetIndicesF90(is_tmp,int_ptr,ierr);CHKERRQ(ierr)
505) do local_id = 1, geomech_grid%nlmax_node
506) int_array(local_id) = int_ptr(local_id)
507) enddo
508) call ISRestoreIndicesF90(is_tmp,int_ptr,ierr);CHKERRQ(ierr)
509) call ISDestroy(is_tmp,ierr);CHKERRQ(ierr)
510) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_node, &
511) int_array,PETSC_COPY_VALUES,gmdm%is_local_natural, &
512) ierr);CHKERRQ(ierr)
513) deallocate(int_array)
514)
515) #if GEOMECH_DEBUG
516) string = 'geomech_is_local_natural' // trim(ndof_word) // '.out'
517) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
518) ierr);CHKERRQ(ierr)
519) call ISView(gmdm%is_local_natural,viewer,ierr);CHKERRQ(ierr)
520) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
521) #endif
522)
523) call VecCreate(option%mycomm,vec_tmp,ierr);CHKERRQ(ierr)
524) call VecSetSizes(vec_tmp,geomech_grid%nlmax_node*ndof,PETSC_DECIDE, &
525) ierr);CHKERRQ(ierr)
526) call VecSetBlockSize(vec_tmp,ndof,ierr);CHKERRQ(ierr)
527) call VecSetFromOptions(vec_tmp,ierr);CHKERRQ(ierr)
528) call VecScatterCreate(gmdm%global_vec,gmdm%is_local_petsc,vec_tmp, &
529) gmdm%is_local_natural,gmdm%scatter_gton, &
530) ierr);CHKERRQ(ierr)
531) call VecDestroy(vec_tmp,ierr);CHKERRQ(ierr)
532)
533) #if GEOMECH_DEBUG
534) string = 'geomech_scatter_gton' // trim(ndof_word) // '.out'
535) call PetscViewerASCIIOpen(option%mycomm,trim(string),viewer, &
536) ierr);CHKERRQ(ierr)
537) call VecScatterView(gmdm%scatter_gton,viewer,ierr);CHKERRQ(ierr)
538) call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
539)
540) #endif
541)
542) ! Now for elements. Need this for writing tecplot output
543)
544) allocate(int_array(geomech_grid%nlmax_elem))
545) do local_id = 1, geomech_grid%nlmax_elem
546) int_array(local_id) = (local_id-1) + geomech_grid%global_offset_elem
547) enddo
548)
549) call ISCreateGeneral(option%mycomm,geomech_grid%nlmax_elem, &
550) int_array,PETSC_COPY_VALUES,is_tmp_petsc, &
551) ierr);CHKERRQ(ierr)
552)
553) call AOPetscToApplicationIS(geomech_grid%ao_natural_to_petsc, &
554) is_tmp_petsc,ierr);CHKERRQ(ierr)
555) allocate(int_array2(geomech_grid%nlmax_elem))
556) call ISGetIndicesF90(is_tmp_petsc,int_ptr,ierr);CHKERRQ(ierr)
557) do local_id = 1, geomech_grid%nlmax_elem
558) int_array2(local_id) = int_ptr(local_id)
559) enddo
560) call ISRestoreIndicesF90(is_tmp_petsc,int_ptr,ierr);CHKERRQ(ierr)
561) call ISDestroy(is_tmp_petsc,ierr);CHKERRQ(ierr)
562)
563) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_elem, &
564) int_array,PETSC_COPY_VALUES,is_tmp_petsc, &
565) ierr);CHKERRQ(ierr)
566) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_elem, &
567) int_array2,PETSC_COPY_VALUES,is_tmp_natural, &
568) ierr);CHKERRQ(ierr)
569)
570) ! create global vec
571) call VecCreate(option%mycomm,gmdm%global_vec_elem,ierr);CHKERRQ(ierr)
572) call VecSetSizes(gmdm%global_vec_elem,geomech_grid%nlmax_elem*ndof, &
573) PETSC_DECIDE,ierr);CHKERRQ(ierr)
574) call VecSetBlockSize(gmdm%global_vec_elem,ndof,ierr);CHKERRQ(ierr)
575) call VecSetFromOptions(gmdm%global_vec_elem,ierr);CHKERRQ(ierr)
576)
577) call VecCreate(option%mycomm,vec_tmp,ierr);CHKERRQ(ierr)
578) call VecSetSizes(vec_tmp,geomech_grid%nlmax_elem*ndof,PETSC_DECIDE, &
579) ierr);CHKERRQ(ierr)
580) call VecSetBlockSize(vec_tmp,ndof,ierr);CHKERRQ(ierr)
581) call VecSetFromOptions(vec_tmp,ierr);CHKERRQ(ierr)
582) call VecScatterCreate(gmdm%global_vec_elem,is_tmp_petsc,vec_tmp, &
583) is_tmp_natural,gmdm%scatter_gton_elem, &
584) ierr);CHKERRQ(ierr)
585) call VecDestroy(vec_tmp,ierr);CHKERRQ(ierr)
586) call ISDestroy(is_tmp_petsc,ierr);CHKERRQ(ierr)
587) call ISDestroy(is_tmp_natural,ierr);CHKERRQ(ierr)
588)
589) call ISCreateBlock(option%mycomm,ndof,geomech_grid%nlmax_elem, &
590) int_array,PETSC_COPY_VALUES,is_tmp_petsc, &
591) ierr);CHKERRQ(ierr)
592) deallocate(int_array)
593) deallocate(int_array2)
594)
595) ! create a local to global mapping
596) call ISLocalToGlobalMappingCreateIS(is_tmp_petsc, &
597) gmdm%mapping_ltog_elem, &
598) ierr);CHKERRQ(ierr)
599) ! call ISDestroy(is_tmp_petsc,ierr);CHKERRQ(ierr)
600)
601) end subroutine GMCreateGMDM
602)
603) ! ************************************************************************** !
604) !
605) ! GMGridDMCreateJacobian: Creates a Jacobian matrix
606) ! author: Satish Karra, LANL
607) ! date: 06/05/13
608) !
609) ! ************************************************************************** !
610) subroutine GMGridDMCreateJacobian(geomech_grid,gmdm,mat_type,J,option)
611)
612) use Option_module
613)
614) implicit none
615)
616) type(geomech_grid_type) :: geomech_grid
617) type(gmdm_type) :: gmdm
618) type(option_type) :: option
619) MatType :: mat_type
620) Mat :: J
621) IS :: is_tmp
622)
623) PetscInt, allocatable :: d_nnz(:), o_nnz(:)
624) PetscInt :: local_id, ineighbor, neighbor_id
625) PetscInt :: ndof_local
626) PetscInt :: ielem, node_count
627) PetscInt :: ivertex1, ivertex2
628) PetscInt :: local_id1, local_id2
629) PetscErrorCode :: ierr
630) character(len=MAXSTRINGLENGTH) :: string
631)
632) allocate(d_nnz(geomech_grid%nlmax_node))
633) allocate(o_nnz(geomech_grid%nlmax_node))
634)
635) ! The following is an approximate estimate only.
636) ! Need to come up with a more accurate way of calculating d_nnz, o_nnz
637) ! Assuming max vertices based on hex.
638) d_nnz = min(27,geomech_grid%nlmax_node)
639) o_nnz = min(27,geomech_grid%nmax_node - geomech_grid%nlmax_node)
640)
641) #ifdef GEOMECH_DEBUG
642) write(string,*) option%myrank
643) string = 'geomech_d_nnz_jacobian' // trim(adjustl(string)) // '.out'
644) open(unit=86,file=trim(string))
645) do local_id1 = 1, geomech_grid%nlmax_node
646) write(86,'(i5)') d_nnz(local_id1)
647) enddo
648) close(86)
649) write(string,*) option%myrank
650) string = 'geomech_o_nnz_jacobian' // trim(adjustl(string)) // '.out'
651) open(unit=86,file=trim(string))
652) do local_id1 = 1, geomech_grid%nlmax_node
653) write(86,'(i5)') o_nnz(local_id1)
654) enddo
655) close(86)
656) #endif
657)
658) ndof_local = geomech_grid%nlmax_node*gmdm%ndof
659) select case(mat_type)
660) case(MATAIJ)
661) d_nnz = d_nnz*gmdm%ndof
662) o_nnz = o_nnz*gmdm%ndof
663) case(MATBAIJ)
664) case default
665) option%io_buffer = 'MatType not recognized in GMGridDMCreateJacobian'
666) call printErrMsg(option)
667) end select
668)
669) call MatCreate(option%mycomm,J,ierr);CHKERRQ(ierr)
670) call MatSetType(J,mat_type,ierr);CHKERRQ(ierr)
671) call MatSetSizes(J,ndof_local,ndof_local,PETSC_DETERMINE,PETSC_DETERMINE, &
672) ierr);CHKERRQ(ierr)
673) call MatSetFromOptions(J,ierr);CHKERRQ(ierr)
674) call MatXAIJSetPreallocation(J,gmdm%ndof,d_nnz,o_nnz, &
675) PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
676) ierr); CHKERRQ(ierr)
677) call MatSetLocalToGlobalMapping(J,gmdm%mapping_ltog, &
678) gmdm%mapping_ltog,ierr);CHKERRQ(ierr)
679)
680)
681) deallocate(d_nnz)
682) deallocate(o_nnz)
683)
684) end subroutine GMGridDMCreateJacobian
685)
686) ! ************************************************************************** !
687) !
688) ! GMGridDMCreateVector: Creates a global vector with PETSc ordering
689) ! author: Satish Karra, LANL
690) ! date: 06/04/13
691) !
692) ! ************************************************************************** !
693) subroutine GMGridDMCreateVector(geomech_grid,gmdm,vec,vec_type,option)
694)
695) use Option_module
696)
697) implicit none
698)
699) type(geomech_grid_type) :: geomech_grid
700) type(gmdm_type) :: gmdm
701) type(option_type) :: option
702) Vec :: vec
703) PetscInt :: vec_type
704) PetscErrorCode :: ierr
705)
706) select case(vec_type)
707) case(GLOBAL)
708) call VecCreate(option%mycomm,vec,ierr);CHKERRQ(ierr)
709) call VecSetSizes(vec,geomech_grid%nlmax_node*gmdm%ndof, &
710) PETSC_DECIDE,ierr);CHKERRQ(ierr)
711) call VecSetLocalToGlobalMapping(vec,gmdm%mapping_ltog, &
712) ierr);CHKERRQ(ierr)
713) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
714) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
715) case(LOCAL)
716) call VecCreate(PETSC_COMM_SELF,vec,ierr);CHKERRQ(ierr)
717) call VecSetSizes(vec,geomech_grid%ngmax_node*gmdm%ndof, &
718) PETSC_DECIDE,ierr);CHKERRQ(ierr)
719) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
720) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
721) case(NATURAL)
722) call VecCreate(option%mycomm,vec,ierr);CHKERRQ(ierr)
723) call VecSetSizes(vec,geomech_grid%nlmax_node*gmdm%ndof, &
724) PETSC_DECIDE,ierr);CHKERRQ(ierr)
725) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
726) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
727) end select
728)
729) end subroutine GMGridDMCreateVector
730)
731) ! ************************************************************************** !
732) !
733) ! GMGridDMCreateVectorElem: Creates a global vector with PETSc ordering
734) ! with size of elements and not vertices
735) ! author: Satish Karra, LANL
736) ! date: 06/04/13
737) !
738) ! ************************************************************************** !
739) subroutine GMGridDMCreateVectorElem(geomech_grid,gmdm,vec,vec_type,option)
740)
741) use Option_module
742)
743) implicit none
744)
745) type(geomech_grid_type) :: geomech_grid
746) type(gmdm_type) :: gmdm
747) type(option_type) :: option
748) Vec :: vec
749) PetscInt :: vec_type
750) PetscErrorCode :: ierr
751)
752) select case(vec_type)
753) case(GLOBAL)
754) call VecCreate(option%mycomm,vec,ierr);CHKERRQ(ierr)
755) call VecSetSizes(vec,geomech_grid%nlmax_elem*gmdm%ndof, &
756) PETSC_DECIDE,ierr);CHKERRQ(ierr)
757) call VecSetLocalToGlobalMapping(vec,gmdm%mapping_ltog_elem, &
758) ierr);CHKERRQ(ierr)
759) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
760) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
761) case(LOCAL)
762) call VecCreate(PETSC_COMM_SELF,vec,ierr);CHKERRQ(ierr)
763) call VecSetSizes(vec,geomech_grid%nlmax_elem*gmdm%ndof, &
764) PETSC_DECIDE,ierr);CHKERRQ(ierr)
765) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
766) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
767) case(NATURAL)
768) call VecCreate(option%mycomm,vec,ierr);CHKERRQ(ierr)
769) call VecSetSizes(vec,geomech_grid%nlmax_elem*gmdm%ndof, &
770) PETSC_DECIDE,ierr);CHKERRQ(ierr)
771) call VecSetBlockSize(vec,gmdm%ndof,ierr);CHKERRQ(ierr)
772) call VecSetFromOptions(vec,ierr);CHKERRQ(ierr)
773) end select
774)
775) end subroutine GMGridDMCreateVectorElem
776)
777) ! ************************************************************************** !
778) !
779) ! GMGridMapIndices: Maps global, local and natural indices of nodes to
780) ! each other for geomech grid.
781) ! author: Satish Karra, LANL
782) ! date: 06/04/13
783) !
784) ! ************************************************************************** !
785) subroutine GMGridMapIndices(geomech_grid,gmdm,nG2L,nL2G,nG2A,option)
786)
787) use Option_module
788)
789) implicit none
790)
791) type(geomech_grid_type) :: geomech_grid
792) type(gmdm_type) :: gmdm
793) type(option_type) :: option
794) PetscInt, pointer :: nG2L(:)
795) PetscInt, pointer :: nL2G(:)
796) PetscInt, pointer :: nG2A(:)
797) PetscInt, pointer :: int_ptr(:)
798) PetscErrorCode :: ierr
799) PetscInt :: local_id
800) PetscInt :: ghosted_id
801)
802) ! The index mapping arrays are the following:
803) ! nL2G : not collective, local processor: local => ghosted local
804) ! nG2L : not collective, local processor: ghosted local => local
805) ! nG2A : not collective, ghosted local => natural
806)
807) allocate(nG2L(geomech_grid%ngmax_node))
808) allocate(nL2G(geomech_grid%nlmax_node))
809) allocate(nG2A(geomech_grid%ngmax_node))
810)
811) nG2L = 0
812)
813) do local_id = 1, geomech_grid%nlmax_node
814) nL2G(local_id) = local_id
815) nG2L(local_id) = local_id
816) enddo
817)
818) call ISGetIndicesF90(gmdm%is_ghosted_petsc,int_ptr,ierr);CHKERRQ(ierr)
819) do ghosted_id = 1, geomech_grid%ngmax_node
820) nG2A(ghosted_id) = int_ptr(ghosted_id)
821) enddo
822) call ISRestoreIndicesF90(gmdm%is_ghosted_petsc,int_ptr,ierr);CHKERRQ(ierr)
823) call AOPetscToApplication(geomech_grid%ao_natural_to_petsc_nodes, &
824) geomech_grid%ngmax_node, &
825) nG2A,ierr);CHKERRQ(ierr)
826) nG2A = nG2A + 1 ! 1-based
827)
828) end subroutine GMGridMapIndices
829)
830) ! ************************************************************************** !
831) !
832) ! GMDMDestroy: Deallocates a geomechanics grid distributed mesh object
833) ! author: Satish Karra, LANL
834) ! date: 05/22/13
835) !
836) ! ************************************************************************** !
837) subroutine GMGridDestroy(geomech_grid)
838)
839) use Utility_module, only : DeallocateArray
840)
841) implicit none
842)
843) type(geomech_grid_type), pointer :: geomech_grid
844)
845) PetscInt :: i
846) PetscErrorCode :: ierr
847)
848) if (.not.associated(geomech_grid)) return
849)
850) call DeallocateArray(geomech_grid%elem_ids_natural)
851) call DeallocateArray(geomech_grid%elem_ids_petsc)
852) call DeallocateArray(geomech_grid%elem_type)
853) call DeallocateArray(geomech_grid%elem_nodes)
854) call DeallocateArray(geomech_grid%node_ids_ghosted_petsc)
855) call DeallocateArray(geomech_grid%node_ids_ghosted_natural)
856) call DeallocateArray(geomech_grid%node_ids_local_natural)
857) call DeallocateArray(geomech_grid%ghosted_node_ids_natural)
858) call DeallocateArray(geomech_grid%ghosted_node_ids_petsc)
859) if (geomech_grid%ao_natural_to_petsc /= 0) &
860) call AODestroy(geomech_grid%ao_natural_to_petsc,ierr)
861) if (geomech_grid%ao_natural_to_petsc_nodes /= 0) then
862) call AODestroy(geomech_grid%ao_natural_to_petsc_nodes,ierr);CHKERRQ(ierr)
863) endif
864)
865) if (associated(geomech_grid%nodes)) &
866) deallocate(geomech_grid%nodes)
867) nullify(geomech_grid%nodes)
868)
869) if (associated(geomech_grid%gauss_node)) then
870) do i = 1, size(geomech_grid%gauss_node)
871) call GaussDestroy(geomech_grid%gauss_node(i))
872) enddo
873) deallocate(geomech_grid%gauss_node)
874) endif
875)
876) nullify(geomech_grid%gauss_node)
877)
878) if (geomech_grid%no_elems_sharing_node_loc /= 0) then
879) call VecDestroy(geomech_grid%no_elems_sharing_node_loc,ierr);CHKERRQ(ierr)
880) endif
881) if ( geomech_grid%no_elems_sharing_node /= 0) then
882) call VecDestroy(geomech_grid%no_elems_sharing_node,ierr);CHKERRQ(ierr)
883) endif
884)
885) deallocate(geomech_grid%nG2L)
886) deallocate(geomech_grid%nL2G)
887) deallocate(geomech_grid%nG2A)
888) deallocate(geomech_grid%mapping_cell_ids_flow)
889) deallocate(geomech_grid%mapping_vertex_ids_geomech)
890)
891) deallocate(geomech_grid)
892) nullify(geomech_grid)
893)
894) end subroutine GMGridDestroy
895)
896) ! ************************************************************************** !
897) !
898) ! GMGridDestroy: Deallocates a geomechanics grid object
899) ! author: Satish Karra, LANL
900) ! date: 05/22/13
901) !
902) ! ************************************************************************** !
903) subroutine GMDMDestroy(gmdm)
904)
905) implicit none
906)
907) type(gmdm_type), pointer :: gmdm
908)
909) PetscErrorCode :: ierr
910)
911) if (.not.associated(gmdm)) return
912)
913) call ISDestroy(gmdm%is_ghosted_local,ierr);CHKERRQ(ierr)
914) call ISDestroy(gmdm%is_local_local,ierr);CHKERRQ(ierr)
915) call ISDestroy(gmdm%is_ghosted_petsc,ierr);CHKERRQ(ierr)
916) call ISDestroy(gmdm%is_local_petsc,ierr);CHKERRQ(ierr)
917) call ISDestroy(gmdm%is_ghosts_local,ierr);CHKERRQ(ierr)
918) call ISDestroy(gmdm%is_ghosts_petsc,ierr);CHKERRQ(ierr)
919) call ISDestroy(gmdm%is_local_natural,ierr);CHKERRQ(ierr)
920) call VecScatterDestroy(gmdm%scatter_ltog,ierr);CHKERRQ(ierr)
921) call VecScatterDestroy(gmdm%scatter_gtol,ierr);CHKERRQ(ierr)
922) call VecScatterDestroy(gmdm%scatter_ltol,ierr);CHKERRQ(ierr)
923) call VecScatterDestroy(gmdm%scatter_gton,ierr);CHKERRQ(ierr)
924) call VecScatterDestroy(gmdm%scatter_gton_elem,ierr);CHKERRQ(ierr)
925) call ISLocalToGlobalMappingDestroy(gmdm%mapping_ltog,ierr);CHKERRQ(ierr)
926) call ISLocalToGlobalMappingDestroy(gmdm%mapping_ltog_elem, &
927) ierr);CHKERRQ(ierr)
928) call VecDestroy(gmdm%global_vec,ierr);CHKERRQ(ierr)
929) call VecDestroy(gmdm%local_vec,ierr);CHKERRQ(ierr)
930) call VecDestroy(gmdm%global_vec_elem,ierr);CHKERRQ(ierr)
931) call VecScatterDestroy(gmdm%scatter_subsurf_to_geomech_ndof, &
932) ierr);CHKERRQ(ierr)
933) call VecScatterDestroy(gmdm%scatter_geomech_to_subsurf_ndof, &
934) ierr);CHKERRQ(ierr)
935) deallocate(gmdm)
936) nullify(gmdm)
937)
938) end subroutine GMDMDestroy
939)
940) end module Geomechanics_Grid_Aux_module