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

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody