geomechanics_discretization.F90 coverage: 52.17 %func 53.94 %block
1) module Geomechanics_Discretization_module
2)
3) use Geomechanics_Grid_module
4) use Geomechanics_Grid_Aux_module
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12)
13) #include "petsc/finclude/petscvec.h"
14) #include "petsc/finclude/petscvec.h90"
15) #include "petsc/finclude/petscmat.h"
16) #include "petsc/finclude/petscmat.h90"
17) #include "petsc/finclude/petscdm.h"
18) #include "petsc/finclude/petscdm.h90"
19) #include "petsc/finclude/petscdmda.h"
20) #include "petsc/finclude/petscdmshell.h90"
21)
22) type, public :: gmdm_ptr_type
23) DM :: dm ! PETSc DM
24) type(gmdm_type), pointer :: gmdm
25) end type gmdm_ptr_type
26)
27) type, public :: geomech_discretization_type
28) PetscInt :: itype ! type of discretization (e.g. structured, unstructured, etc.)
29) character(len=MAXWORDLENGTH) :: ctype ! name of discretization
30) PetscReal :: origin(3) ! origin of global domain
31) type(geomech_grid_type), pointer :: grid ! pointer to a grid object
32) character(len=MAXSTRINGLENGTH) :: filename
33) PetscInt :: dm_index_to_ndof(3) ! mapping between a dm_ptr to the number of degrees of freedom
34) type(gmdm_ptr_type), pointer :: dm_1dof
35) type(gmdm_ptr_type), pointer :: dm_ngeodof
36) type(gmdm_ptr_type), pointer :: dm_n_stress_strain_dof ! For stress and strain
37) end type geomech_discretization_type
38)
39) public :: GeomechDiscretizationCreate, &
40) GeomechDiscretizationDestroy, &
41) GeomechDiscretizationCreateVector, &
42) GeomechDiscretizationDuplicateVector, &
43) GeomechDiscretizationCreateJacobian, &
44) GeomechDiscretizationGlobalToLocal, &
45) GeomechDiscretizationLocalToGlobal, &
46) GeomechDiscretizationLocalToGlobalAdd, &
47) GeomechDiscretizationLocalToLocal, &
48) GeomechDiscretizationGlobalToNatural, &
49) GeomechDiscretizationNaturalToGlobal, &
50) GeomechDiscretizationGlobalToLocalBegin, &
51) GeomechDiscretizationGlobalToLocalEnd, &
52) GeomechDiscretizationLocalToLocalBegin, &
53) GeomechDiscretizationLocalToLocalEnd, &
54) GeomechDiscretizGlobalToNaturalBegin, &
55) GeomechDiscretizGlobalToNaturalEnd, &
56) GeomechDiscretizNaturalToGlobalBegin, &
57) GeomechDiscretizNaturalToGlobalEnd, &
58) GeomechDiscretizationCreateDMs,&
59) GeomechDiscretizationGetDMPtrFromIndex, &
60) GeomechDiscretAOApplicationToPetsc
61)
62) contains
63)
64) ! ************************************************************************** !
65)
66) function GeomechDiscretizationCreate()
67) !
68) ! Creates a geomechanics discretization
69) !
70) ! Author: Satish Karra, LANL
71) ! Date: 05/23/2013
72) !
73)
74) implicit none
75)
76) type(geomech_discretization_type), pointer :: GeomechDiscretizationCreate
77) type(geomech_discretization_type), pointer :: geomech_discretization
78)
79) allocate(geomech_discretization)
80) geomech_discretization%ctype = ''
81) geomech_discretization%itype = 0
82) geomech_discretization%origin = 0.d0
83) geomech_discretization%filename = ''
84)
85) ! nullify DM pointers
86) allocate(geomech_discretization%dm_1dof)
87) allocate(geomech_discretization%dm_ngeodof)
88) allocate(geomech_discretization%dm_n_stress_strain_dof)
89) geomech_discretization%dm_1dof%dm = 0
90) geomech_discretization%dm_ngeodof%dm = 0
91) geomech_discretization%dm_n_stress_strain_dof%dm = 0
92) nullify(geomech_discretization%dm_1dof%gmdm)
93) nullify(geomech_discretization%dm_ngeodof%gmdm)
94) nullify(geomech_discretization%dm_n_stress_strain_dof%gmdm)
95) nullify(geomech_discretization%grid)
96)
97) GeomechDiscretizationCreate => geomech_discretization
98)
99) end function GeomechDiscretizationCreate
100)
101) ! ************************************************************************** !
102)
103) subroutine GeomechDiscretizationCreateDMs(geomech_discretization,option)
104) !
105) ! creates distributed, parallel meshes/grids
106) ! If there are multiple degrees of freedom per grid cell, this will call
107) ! GeomechDiscretizationCreateDM() multiple times to create the DMs corresponding
108) ! to one degree of freedom grid cell and those corresponding to multiple
109) ! degrees of freedom per cell for geomechanics.
110) !
111) ! Author: Satish Karra, LANL
112) ! Date: 06/02/13
113) !
114)
115) use Option_module
116)
117) implicit none
118)
119) type(geomech_discretization_type) :: geomech_discretization
120) type(option_type) :: option
121)
122) PetscInt :: ndof
123) PetscErrorCode :: ierr
124) type(geomech_grid_type), pointer :: geomech_grid
125)
126) !-----------------------------------------------------------------------
127) ! Generate the DM objects that will manage communication.
128) !-----------------------------------------------------------------------
129) ndof = 1
130) call GeomechDiscretizationCreateDM(geomech_discretization, &
131) geomech_discretization%dm_1dof, &
132) ndof,option)
133)
134) if (option%ngeomechdof > 0) then
135) ndof = option%ngeomechdof
136) call GeomechDiscretizationCreateDM(geomech_discretization, &
137) geomech_discretization%dm_ngeodof, &
138) ndof,option)
139)
140) call GeomechDiscretizationCreateDM(geomech_discretization, &
141) geomech_discretization%dm_n_stress_strain_dof, &
142) option%n_stress_strain_dof,option)
143) endif
144)
145)
146) end subroutine GeomechDiscretizationCreateDMs
147)
148) ! ************************************************************************** !
149)
150) subroutine GeomechDiscretizationCreateDM(geomech_discretization,dm_ptr, &
151) ndof,option)
152) !
153) ! creates a distributed, parallel mesh/grid
154) ! for geomechanics
155) !
156) ! Author: Satish Karra, LANL
157) ! Date: 06/02/13
158) !
159)
160) use Option_module
161)
162) implicit none
163)
164) type(geomech_discretization_type) :: geomech_discretization
165) type(gmdm_ptr_type), pointer :: dm_ptr
166) type(option_type) :: option
167) PetscInt :: ndof
168) PetscErrorCode :: ierr
169)
170) select case(geomech_discretization%itype)
171) case(STRUCTURED_GRID)
172) option%io_buffer = &
173) 'Geomechanics currently works only with unstructured grid.'
174) call printErrMsg(option)
175) case(UNSTRUCTURED_GRID)
176) #if !defined(PETSC_HAVE_PARMETIS)
177) option%io_buffer = &
178) 'Must compile with Parmetis in order to use Geomechanics ' // &
179) 'unstructured grids.'
180) call printErrMsg(option)
181) #endif
182) call GMCreateGMDM(geomech_discretization%grid, &
183) dm_ptr%gmdm,ndof,option)
184) call DMShellCreate(option%mycomm,dm_ptr%dm,ierr);CHKERRQ(ierr)
185) call DMShellSetGlobalToLocalVecScatter(dm_ptr%dm, &
186) dm_ptr%gmdm%scatter_gtol, &
187) ierr);CHKERRQ(ierr)
188) end select
189)
190) end subroutine GeomechDiscretizationCreateDM
191)
192) ! ************************************************************************** !
193)
194) subroutine GeomechDiscretizationCreateVector(geomech_discretization, &
195) dm_index,vector, &
196) vector_type,option)
197) !
198) ! Creates a PETSc vector for the nodes
199) !
200) ! Author: Satish Karra, LANL
201) ! Date: 06/02/13
202) !
203) use Option_module
204)
205) implicit none
206)
207) type(geomech_discretization_type) :: geomech_discretization
208) type(option_type) :: option
209) type(gmdm_ptr_type), pointer :: dm_ptr
210) PetscInt :: dm_index
211) Vec :: vector
212) PetscInt :: vector_type
213) PetscInt :: ndof
214) PetscErrorCode :: ierr
215)
216)
217) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
218) dm_index)
219)
220) call GMGridDMCreateVector(geomech_discretization%grid,dm_ptr%gmdm,vector, &
221) vector_type,option)
222)
223) call VecSet(vector,0.d0,ierr);CHKERRQ(ierr)
224)
225) end subroutine GeomechDiscretizationCreateVector
226)
227) ! ************************************************************************** !
228)
229) subroutine GeomechDiscretizationDuplicateVector(geomech_discretization, &
230) vector1,vector2)
231) !
232) ! Duplicates a Petsc vector
233) !
234) ! Author: Satish Karra, LANL
235) ! Date: 06/02/13
236) !
237)
238) implicit none
239)
240) type(geomech_discretization_type) :: geomech_discretization
241) Vec :: vector1
242) Vec :: vector2
243) PetscErrorCode :: ierr
244)
245) call VecDuplicate(vector1,vector2,ierr);CHKERRQ(ierr)
246) call VecCopy(vector1,vector2,ierr);CHKERRQ(ierr)
247)
248) end subroutine GeomechDiscretizationDuplicateVector
249)
250) ! ************************************************************************** !
251)
252) function GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization,dm_index)
253) !
254) ! Returns the integer pointer for
255) ! the Geomech DM referenced
256) !
257) ! Author: Satish Karra, LANL
258) ! Date: 06/02/13
259) !
260)
261) implicit none
262)
263) type(geomech_discretization_type) :: geomech_discretization
264) type(gmdm_ptr_type), pointer :: GeomechDiscretizationGetDMPtrFromIndex
265) PetscInt :: dm_index
266)
267) select case (dm_index)
268) case(ONEDOF)
269) GeomechDiscretizationGetDMPtrFromIndex => &
270) geomech_discretization%dm_1dof
271) case(NGEODOF)
272) GeomechDiscretizationGetDMPtrFromIndex => &
273) geomech_discretization%dm_ngeodof
274) case(SIX_INTEGER)
275) GeomechDiscretizationGetDMPtrFromIndex => &
276) geomech_discretization%dm_n_stress_strain_dof
277) end select
278)
279) end function GeomechDiscretizationGetDMPtrFromIndex
280)
281) ! ************************************************************************** !
282)
283) subroutine GeomechDiscretizationCreateJacobian(geomech_discretization, &
284) dm_index, &
285) mat_type,Jacobian,option)
286) !
287) ! Creates Jacobian matrix associated
288) ! with geomechanics discretization
289) !
290) ! Author: Satish Karra, LANL
291) ! Date: 06/05/13
292) !
293)
294) use Option_module
295)
296) implicit none
297)
298) type(geomech_discretization_type) :: geomech_discretization
299) type(option_type) :: option
300) type(gmdm_ptr_type), pointer :: dm_ptr
301) PetscInt :: dm_index
302) PetscErrorCode :: ierr
303) MatType :: mat_type
304) Mat :: Jacobian
305)
306) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
307) dm_index)
308)
309)
310) call GMGridDMCreateJacobian(geomech_discretization%grid,dm_ptr%gmdm, &
311) mat_type,Jacobian,option)
312) call MatSetOption(Jacobian,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE, &
313) ierr);CHKERRQ(ierr)
314) call MatSetOption(Jacobian,MAT_ROW_ORIENTED,PETSC_FALSE,ierr);CHKERRQ(ierr)
315)
316) end subroutine GeomechDiscretizationCreateJacobian
317)
318) ! ************************************************************************** !
319)
320) subroutine GeomechDiscretizationGlobalToLocal(geomech_discretization, &
321) global_vec, &
322) local_vec,dm_index)
323) !
324) ! Performs global to local communication
325) ! with geomech DM
326) !
327) ! Author: Satish Karra, LANL
328) ! Date: 06/02/13
329) !
330)
331) implicit none
332)
333) type(geomech_discretization_type) :: geomech_discretization
334) type(gmdm_ptr_type), pointer :: dm_ptr
335) Vec :: global_vec
336) Vec :: local_vec
337) PetscInt :: dm_index
338) PetscErrorCode :: ierr
339)
340) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
341) dm_index)
342)
343) call DMGlobalToLocalBegin(dm_ptr%dm,global_vec,INSERT_VALUES,local_vec, &
344) ierr);CHKERRQ(ierr)
345) call DMGlobalToLocalEnd(dm_ptr%dm,global_vec,INSERT_VALUES,local_vec, &
346) ierr);CHKERRQ(ierr)
347)
348) end subroutine GeomechDiscretizationGlobalToLocal
349)
350) ! ************************************************************************** !
351)
352) subroutine GeomechDiscretizationLocalToGlobal(geomech_discretization, &
353) local_vec, &
354) global_vec,dm_index)
355) !
356) ! Performs local to global communication
357) ! with DM
358) !
359) ! Author: Satish Karra, LANL
360) ! Date: 06/02/13
361) !
362)
363) implicit none
364)
365) type(geomech_discretization_type) :: geomech_discretization
366) type(gmdm_ptr_type), pointer :: dm_ptr
367) Vec :: local_vec
368) Vec :: global_vec
369) PetscInt :: dm_index
370) PetscErrorCode :: ierr
371)
372) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
373) dm_index)
374)
375) call VecScatterBegin(dm_ptr%gmdm%scatter_ltog,local_vec,global_vec, &
376) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
377) call VecScatterEnd(dm_ptr%gmdm%scatter_ltog,local_vec,global_vec, &
378) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
379)
380) end subroutine GeomechDiscretizationLocalToGlobal
381)
382) ! ************************************************************************** !
383)
384) subroutine GeomechDiscretizationLocalToGlobalAdd(geomech_discretization, &
385) local_vec, &
386) global_vec,dm_index)
387) !
388) ! Performs local to global communication
389) ! with DM and adds
390) !
391) ! Author: Satish Karra, LANL
392) ! Date: 09/17/13
393) !
394)
395) implicit none
396)
397) type(geomech_discretization_type) :: geomech_discretization
398) type(gmdm_ptr_type), pointer :: dm_ptr
399) Vec :: local_vec
400) Vec :: global_vec
401) PetscInt :: dm_index
402) PetscErrorCode :: ierr
403)
404) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
405) dm_index)
406)
407) call VecScatterBegin(dm_ptr%gmdm%scatter_ltog,local_vec,global_vec, &
408) ADD_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
409) call VecScatterEnd(dm_ptr%gmdm%scatter_ltog,local_vec,global_vec, &
410) ADD_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
411)
412) end subroutine GeomechDiscretizationLocalToGlobalAdd
413)
414) ! ************************************************************************** !
415)
416) subroutine GeomechDiscretizationLocalToLocal(geomech_discretization, &
417) local_vec1, &
418) local_vec2,dm_index)
419) !
420) ! Performs local to local communication
421) ! with geomech DM
422) !
423) ! Author: Satish Karra, LANL
424) ! Date: 06/02/13
425) !
426)
427) implicit none
428)
429) type(geomech_discretization_type) :: geomech_discretization
430) type(gmdm_ptr_type), pointer :: dm_ptr
431) Vec :: local_vec1
432) Vec :: local_vec2
433) PetscInt :: dm_index
434) PetscErrorCode :: ierr
435)
436) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
437) dm_index)
438)
439) call VecScatterBegin(dm_ptr%gmdm%scatter_ltol,local_vec1,local_vec2, &
440) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
441) call VecScatterEnd(dm_ptr%gmdm%scatter_ltol,local_vec1,local_vec2, &
442) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
443)
444) end subroutine GeomechDiscretizationLocalToLocal
445)
446) ! ************************************************************************** !
447)
448) subroutine GeomechDiscretizationGlobalToNatural(geomech_discretization, &
449) global_vec, &
450) natural_vec,dm_index)
451) !
452) ! Performs global to natural
453) ! communication with geomech DM
454) !
455) ! Author: Satish Karra, LANL
456) ! Date: 06/02/13
457) !
458)
459) implicit none
460)
461) type(geomech_discretization_type) :: geomech_discretization
462) type(gmdm_ptr_type), pointer :: dm_ptr
463) Vec :: global_vec
464) Vec :: natural_vec
465) PetscInt :: dm_index
466) PetscErrorCode :: ierr
467)
468) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
469) dm_index)
470)
471) call VecScatterBegin(dm_ptr%gmdm%scatter_gton,global_vec,natural_vec, &
472) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
473) call VecScatterEnd(dm_ptr%gmdm%scatter_gton,global_vec,natural_vec, &
474) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
475)
476) end subroutine GeomechDiscretizationGlobalToNatural
477)
478) ! ************************************************************************** !
479)
480) subroutine GeomechDiscretizationNaturalToGlobal(geomech_discretization, &
481) natural_vec, &
482) global_vec,dm_index)
483) !
484) ! Performs natural to global
485) ! communication with DM
486) !
487) ! Author: Satish Karra, LANL
488) ! Date: 06/02/13
489) !
490)
491) implicit none
492)
493) type(geomech_discretization_type) :: geomech_discretization
494) type(gmdm_ptr_type), pointer :: dm_ptr
495) Vec :: global_vec
496) Vec :: natural_vec
497) PetscInt :: dm_index
498) PetscErrorCode :: ierr
499)
500) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
501) dm_index)
502)
503) call VecScatterBegin(dm_ptr%gmdm%scatter_gton,natural_vec,global_vec, &
504) INSERT_VALUES,SCATTER_REVERSE,ierr);CHKERRQ(ierr)
505) call VecScatterEnd(dm_ptr%gmdm%scatter_gton,natural_vec,global_vec, &
506) INSERT_VALUES,SCATTER_REVERSE,ierr);CHKERRQ(ierr)
507)
508) end subroutine GeomechDiscretizationNaturalToGlobal
509)
510) ! ************************************************************************** !
511)
512) subroutine GeomechDiscretizationGlobalToLocalBegin(geomech_discretization, &
513) global_vec, &
514) local_vec,dm_index)
515) !
516) ! Begins global to local
517) ! communication with geomech DM
518) !
519) ! Author: Satish Karra, LANL
520) ! Date: 06/02/13
521) !
522)
523) implicit none
524)
525) type(geomech_discretization_type) :: geomech_discretization
526) type(gmdm_ptr_type), pointer :: dm_ptr
527) Vec :: local_vec
528) Vec :: global_vec
529) PetscInt :: dm_index
530) PetscErrorCode :: ierr
531)
532) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
533) dm_index)
534)
535) call VecScatterBegin(dm_ptr%gmdm%scatter_gtol,global_vec,local_vec, &
536) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
537)
538) end subroutine GeomechDiscretizationGlobalToLocalBegin
539)
540) ! ************************************************************************** !
541)
542) subroutine GeomechDiscretizationGlobalToLocalEnd(geomech_discretization, &
543) global_vec, &
544) local_vec,dm_index)
545) !
546) ! Ends global to local communication
547) ! with geomech DM
548) !
549) ! Author: Satish Karra, LANL
550) ! Date: 06/02/13
551) !
552)
553) implicit none
554)
555) type(geomech_discretization_type) :: geomech_discretization
556) type(gmdm_ptr_type), pointer :: dm_ptr
557) Vec :: local_vec
558) Vec :: global_vec
559) PetscInt :: dm_index
560) PetscErrorCode :: ierr
561)
562) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
563) dm_index)
564)
565) call VecScatterEnd(dm_ptr%gmdm%scatter_gtol,global_vec,local_vec, &
566) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
567)
568) end subroutine GeomechDiscretizationGlobalToLocalEnd
569)
570) ! ************************************************************************** !
571)
572) subroutine GeomechDiscretizationLocalToLocalBegin(geomech_discretization, &
573) local_vec1, &
574) local_vec2,dm_index)
575) !
576) ! Begins local to local communication
577) ! with geomech DM
578) !
579) ! Author: Satish Karra, LANL
580) ! Date: 06/02/13
581) !
582)
583) implicit none
584)
585) type(geomech_discretization_type) :: geomech_discretization
586) type(gmdm_ptr_type), pointer :: dm_ptr
587) Vec :: local_vec1
588) Vec :: local_vec2
589) PetscInt :: dm_index
590) PetscErrorCode :: ierr
591)
592) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
593) dm_index)
594)
595) call VecScatterBegin(dm_ptr%gmdm%scatter_ltol,local_vec1,local_vec2, &
596) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
597)
598) end subroutine GeomechDiscretizationLocalToLocalBegin
599)
600) ! ************************************************************************** !
601)
602) subroutine GeomechDiscretizationLocalToLocalEnd(geomech_discretization, &
603) local_vec1, &
604) local_vec2,dm_index)
605) !
606) ! Ends local to local communication
607) ! with geomech DM
608) !
609) ! Author: Satish Karra, LANL
610) ! Date: 06/02/13
611) !
612)
613) implicit none
614)
615) type(geomech_discretization_type) :: geomech_discretization
616) type(gmdm_ptr_type), pointer :: dm_ptr
617) Vec :: local_vec1
618) Vec :: local_vec2
619) PetscInt :: dm_index
620) PetscErrorCode :: ierr
621)
622) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
623) dm_index)
624)
625) call VecScatterEnd(dm_ptr%gmdm%scatter_ltol,local_vec1,local_vec2, &
626) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
627)
628) end subroutine GeomechDiscretizationLocalToLocalEnd
629)
630) ! ************************************************************************** !
631)
632) subroutine GeomechDiscretizGlobalToNaturalBegin(geomech_discretization, &
633) global_vec, &
634) natural_vec,dm_index)
635) !
636) ! Begins global to natural communication
637) ! with geomech DM
638) !
639) ! Author: Satish Karra, LANL
640) ! Date: 06/02/13
641) !
642)
643) implicit none
644)
645) type(geomech_discretization_type) :: geomech_discretization
646) type(gmdm_ptr_type), pointer :: dm_ptr
647) Vec :: global_vec
648) Vec :: natural_vec
649) PetscInt :: dm_index
650) PetscErrorCode :: ierr
651)
652) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
653) dm_index)
654)
655) call VecScatterBegin(dm_ptr%gmdm%scatter_gton,global_vec,natural_vec, &
656) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
657)
658) end subroutine GeomechDiscretizGlobalToNaturalBegin
659)
660) ! ************************************************************************** !
661)
662) subroutine GeomechDiscretizGlobalToNaturalEnd(geomech_discretization, &
663) global_vec, &
664) natural_vec,dm_index)
665) !
666) ! Ends global to natural communication
667) ! with geomech DM
668) !
669) ! Author: Satish Karra, LANL
670) ! Date: 06/02/13
671) !
672)
673) implicit none
674)
675) type(geomech_discretization_type) :: geomech_discretization
676) type(gmdm_ptr_type), pointer :: dm_ptr
677) Vec :: global_vec
678) Vec :: natural_vec
679) PetscInt :: dm_index
680) PetscErrorCode :: ierr
681)
682) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
683) dm_index)
684)
685) call VecScatterEnd(dm_ptr%gmdm%scatter_gton,global_vec,natural_vec, &
686) INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
687)
688) end subroutine GeomechDiscretizGlobalToNaturalEnd
689)
690) ! ************************************************************************** !
691)
692) subroutine GeomechDiscretizNaturalToGlobalBegin(geomech_discretization, &
693) natural_vec, &
694) global_vec,dm_index)
695) !
696) ! Begins natural to global communication
697) ! with geomech DM
698) !
699) ! Author: Satish Karra, LANL
700) ! Date: 06/02/13
701) !
702)
703) implicit none
704)
705) type(geomech_discretization_type) :: geomech_discretization
706) type(gmdm_ptr_type), pointer :: dm_ptr
707) Vec :: global_vec
708) Vec :: natural_vec
709) PetscInt :: dm_index
710) PetscErrorCode :: ierr
711)
712) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
713) dm_index)
714)
715) end subroutine GeomechDiscretizNaturalToGlobalBegin
716)
717) ! ************************************************************************** !
718)
719) subroutine GeomechDiscretizNaturalToGlobalEnd(geomech_discretization, &
720) natural_vec, &
721) global_vec,dm_index)
722) !
723) ! Ends natural to global communication
724) ! with geomech DM
725) !
726) ! Author: Satish Karra, LANL
727) ! Date: 06/02/13
728) !
729)
730) implicit none
731)
732) type(geomech_discretization_type) :: geomech_discretization
733) type(gmdm_ptr_type), pointer :: dm_ptr
734) Vec :: global_vec
735) Vec :: natural_vec
736) PetscInt :: dm_index
737) PetscErrorCode :: ierr
738)
739) dm_ptr => GeomechDiscretizationGetDMPtrFromIndex(geomech_discretization, &
740) dm_index)
741)
742) end subroutine GeomechDiscretizNaturalToGlobalEnd
743)
744) ! ************************************************************************** !
745)
746) subroutine GeomechDiscretAOApplicationToPetsc(geomech_discretization,int_array)
747) !
748) ! Maps application ordering to petsc
749) !
750) ! Author: Satish Karra, LANL
751) ! Date: 06/02/13
752) !
753)
754) implicit none
755)
756) #include "petsc/finclude/petscao.h"
757)
758) type(geomech_discretization_type) :: geomech_discretization
759) PetscInt :: int_array(:)
760) PetscErrorCode :: ierr
761) AO :: ao
762)
763) ao = geomech_discretization%grid%ao_natural_to_petsc_nodes
764)
765) call AOApplicationToPetsc(ao,size(int_array),int_array,ierr);CHKERRQ(ierr)
766)
767) end subroutine GeomechDiscretAOApplicationToPetsc
768)
769) ! ************************************************************************** !
770)
771) subroutine GeomechDiscretizationDestroy(geomech_discretization)
772) !
773) ! Deallocates a geomechanics discretization
774) !
775) ! Author: Satish Karra, LANL
776) ! Date: 05/23/2013
777) !
778)
779) implicit none
780)
781) type(geomech_discretization_type), pointer :: geomech_discretization
782)
783) PetscErrorCode :: ierr
784) PetscInt :: i
785)
786) if (.not.associated(geomech_discretization)) return
787)
788) if (associated(geomech_discretization%dm_1dof%gmdm)) &
789) call GMDMDestroy(geomech_discretization%dm_1dof%gmdm)
790) if (associated(geomech_discretization%dm_ngeodof%gmdm)) &
791) call GMDMDestroy(geomech_discretization%dm_ngeodof%gmdm)
792) if (associated(geomech_discretization%dm_n_stress_strain_dof%gmdm)) &
793) call GMDMDestroy(geomech_discretization%dm_n_stress_strain_dof%gmdm)
794)
795) if (associated(geomech_discretization%dm_1dof)) &
796) deallocate(geomech_discretization%dm_1dof)
797) nullify(geomech_discretization%dm_1dof)
798) if (associated(geomech_discretization%dm_ngeodof)) &
799) deallocate(geomech_discretization%dm_ngeodof)
800) nullify(geomech_discretization%dm_ngeodof)
801) if (associated(geomech_discretization%dm_n_stress_strain_dof)) &
802) deallocate(geomech_discretization%dm_n_stress_strain_dof)
803) nullify(geomech_discretization%dm_n_stress_strain_dof)
804)
805) call GMGridDestroy(geomech_discretization%grid)
806)
807) if (associated(geomech_discretization)) &
808) deallocate(geomech_discretization)
809) nullify(geomech_discretization)
810)
811)
812) end subroutine GeomechDiscretizationDestroy
813)
814) end module Geomechanics_Discretization_module