communicator_unstructured.F90       coverage:  66.67 %func     35.80 %block


     1) module Communicator_Unstructured_class
     2) 
     3)   use Communicator_Base_module
     4)   use Grid_Unstructured_module
     5)   use Grid_Unstructured_Aux_module
     6)   use Grid_Unstructured_Explicit_module  
     7)   
     8)   use PFLOTRAN_Constants_module
     9) 
    10)   implicit none
    11) 
    12)   private
    13) 
    14) #include "petsc/finclude/petscsys.h"
    15)   
    16) #include "petsc/finclude/petscvec.h"
    17) #include "petsc/finclude/petscvec.h90"
    18) #include "petsc/finclude/petscmat.h"
    19) #include "petsc/finclude/petscmat.h90"
    20) #include "petsc/finclude/petscdm.h"
    21) #include "petsc/finclude/petscdm.h90"
    22) #include "petsc/finclude/petscdmshell.h90"
    23) 
    24) 
    25)   type, public, extends(communicator_type) :: unstructured_communicator_type
    26)     DM :: dm
    27)     type(ugdm_type), pointer :: ugdm
    28)   contains
    29)     procedure, public :: SetDM => UnstructuredSetDM
    30)     procedure, public :: GlobalToLocal => UnstructuredGlobalToLocal
    31)     procedure, public :: LocalToGlobal => UnstructuredLocalToGlobal
    32)     procedure, public :: LocalToLocal => UnstructuredLocalToLocal
    33)     procedure, public :: GlobalToNatural => UnstructuredGlobalToNatural
    34)     procedure, public :: NaturalToGlobal => UnstructuredNaturalToGlobal
    35)     procedure, public :: AONaturalToPetsc => UnstructuredAONaturalToPetsc
    36) !geh: finalization not yet supported by gfortran.
    37) !    final :: UnstructuredCommunicatorDestroy
    38)     procedure, public :: Destroy => UnstructuredCommunicatorDestroy
    39)   end type unstructured_communicator_type
    40) 
    41)   public :: UnstructuredCommunicatorCreate
    42)   
    43) contains
    44) 
    45) ! ************************************************************************** !
    46) 
    47) function UnstructuredCommunicatorCreate()
    48)   ! 
    49)   ! Allocates and initializes a new communicator
    50)   ! object for unstructured grids
    51)   ! 
    52)   ! Author: Glenn Hammond
    53)   ! Date: 03/15/13
    54)   ! 
    55) 
    56)   implicit none
    57)   
    58)   class(unstructured_communicator_type), pointer :: &
    59)     UnstructuredCommunicatorCreate
    60)   
    61)   class(unstructured_communicator_type), pointer :: communicator
    62)   
    63)   allocate(communicator)
    64)   nullify(communicator%ugdm)
    65)   communicator%dm = 0
    66) 
    67)   UnstructuredCommunicatorCreate => communicator  
    68)   
    69) end function UnstructuredCommunicatorCreate
    70) 
    71) ! ************************************************************************** !
    72) 
    73) subroutine UnstructuredSetDM(this,dm_ptr)
    74)   ! 
    75)   ! Sets pointer to DM
    76)   ! 
    77)   ! Author: Glenn Hammond
    78)   ! Date: 03/18/13
    79)   ! 
    80) 
    81)   use DM_Kludge_module
    82) 
    83)   implicit none
    84)   
    85)   class(unstructured_communicator_type) :: this
    86)   type(dm_ptr_type) :: dm_ptr
    87) 
    88)   this%dm = dm_ptr%dm
    89)   this%ugdm => dm_ptr%ugdm
    90)   
    91) end subroutine UnstructuredSetDM
    92) 
    93) ! ************************************************************************** !
    94) 
    95) subroutine UnstructuredGlobalToLocal(this,source,destination)
    96)   ! 
    97)   ! Performs global to local communication
    98)   ! 
    99)   ! Author: Glenn Hammond
   100)   ! Date: 03/15/13
   101)   ! 
   102) 
   103) !TODO(geh): move to communicator_base.F90
   104) 
   105)   implicit none
   106)   
   107)   class(unstructured_communicator_type) :: this
   108)   Vec :: source
   109)   Vec :: destination
   110) 
   111)   PetscErrorCode :: ierr
   112)   
   113)   call DMGlobalToLocalBegin(this%dm,source,INSERT_VALUES,destination, &
   114)                             ierr);CHKERRQ(ierr)
   115)   call DMGlobalToLocalEnd(this%dm,source,INSERT_VALUES,destination, &
   116)                           ierr);CHKERRQ(ierr)
   117)   
   118) end subroutine UnstructuredGlobalToLocal
   119) 
   120) ! ************************************************************************** !
   121) 
   122) subroutine UnstructuredLocalToGlobal(this,source,destination)
   123)   ! 
   124)   ! Performs local to global communication
   125)   ! 
   126)   ! Author: Glenn Hammond
   127)   ! Date: 03/15/13
   128)   ! 
   129) 
   130)   implicit none
   131)   
   132)   class(unstructured_communicator_type) :: this
   133)   Vec :: source
   134)   Vec :: destination
   135) 
   136)   PetscErrorCode :: ierr
   137) 
   138)   call VecScatterBegin(this%ugdm%scatter_ltog,source,destination, &
   139)                        INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   140)   call VecScatterEnd(this%ugdm%scatter_ltog,source,destination, &
   141)                      INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   142)       
   143) end subroutine UnstructuredLocalToGlobal
   144) 
   145) ! ************************************************************************** !
   146) 
   147) subroutine UnstructuredLocalToLocal(this,source,destination)
   148)   ! 
   149)   ! Performs local to local communication
   150)   ! 
   151)   ! Author: Glenn Hammond
   152)   ! Date: 03/15/13
   153)   ! 
   154) 
   155)   implicit none
   156)   
   157)   class(unstructured_communicator_type) :: this
   158)   Vec :: source
   159)   Vec :: destination
   160) 
   161)   PetscErrorCode :: ierr
   162)   
   163)   call VecScatterBegin(this%ugdm%scatter_ltol,source,destination, &
   164)                        INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   165)   call VecScatterEnd(this%ugdm%scatter_ltol,source,destination, &
   166)                      INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   167)   
   168) end subroutine UnstructuredLocalToLocal
   169) 
   170) ! ************************************************************************** !
   171) 
   172) subroutine UnstructuredGlobalToNatural(this,source,destination)
   173)   ! 
   174)   ! Performs global to natural communication
   175)   ! 
   176)   ! Author: Glenn Hammond
   177)   ! Date: 03/15/13
   178)   ! 
   179) 
   180)   implicit none
   181)   
   182)   class(unstructured_communicator_type) :: this
   183)   Vec :: source
   184)   Vec :: destination
   185) 
   186)   PetscErrorCode :: ierr
   187) 
   188)   call VecScatterBegin(this%ugdm%scatter_gton,source,destination, &
   189)                        INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   190)   call VecScatterEnd(this%ugdm%scatter_gton,source,destination, &
   191)                      INSERT_VALUES,SCATTER_FORWARD,ierr);CHKERRQ(ierr)
   192)   
   193) end subroutine UnstructuredGlobalToNatural
   194) 
   195) ! ************************************************************************** !
   196) 
   197) subroutine UnstructuredNaturalToGlobal(this,source,destination)
   198)   ! 
   199)   ! Performs natural to global communication
   200)   ! 
   201)   ! Author: Glenn Hammond
   202)   ! Date: 03/15/13
   203)   ! 
   204) 
   205)   implicit none
   206)   
   207)   class(unstructured_communicator_type) :: this
   208)   Vec :: source
   209)   Vec :: destination
   210) 
   211)   PetscErrorCode :: ierr
   212) 
   213)   call VecScatterBegin(this%ugdm%scatter_gton,source,destination, &
   214)                        INSERT_VALUES,SCATTER_REVERSE,ierr);CHKERRQ(ierr)
   215)   call VecScatterEnd(this%ugdm%scatter_gton,source,destination, &
   216)                      INSERT_VALUES,SCATTER_REVERSE,ierr);CHKERRQ(ierr)
   217)   
   218) end subroutine UnstructuredNaturalToGlobal
   219) 
   220) ! ************************************************************************** !
   221) 
   222) subroutine UnstructuredAONaturalToPetsc(this,array)
   223)   ! 
   224)   ! Maps indices in natural numbering to petsc
   225)   ! 
   226)   ! Author: Glenn Hammond
   227)   ! Date: 03/19/15
   228)   ! 
   229) 
   230)   implicit none
   231)   
   232)   class(unstructured_communicator_type) :: this
   233)   PetscInt :: array(:)
   234) 
   235)   AO :: ao
   236)   PetscInt :: n
   237)   PetscErrorCode :: ierr
   238)   
   239)   n = size(array)
   240)   call AOApplicationToPetsc(this%ugdm%ao_natural_to_petsc,n,array, &
   241)                             ierr);CHKERRQ(ierr)
   242)   
   243) end subroutine UnstructuredAONaturalToPetsc
   244) 
   245) ! ************************************************************************** !
   246) 
   247) subroutine UnstructuredCommunicatorDestroy(this)
   248)   ! 
   249)   ! Deallocates a communicator object for
   250)   ! unstructured grids
   251)   ! 
   252)   ! Author: Glenn Hammond
   253)   ! Date: 03/15/13
   254)   ! 
   255) 
   256)   implicit none
   257)   
   258)   class(unstructured_communicator_type) :: this
   259)   
   260)   PetscErrorCode :: ierr
   261)   
   262)   !geh: all DMs are currently destroyed in realization.  This DM is solely
   263)   !     a pointer.  This will need to change, but skip for now.
   264)   if (associated(this%ugdm)) then
   265)     !call UGridDMDestroy(this%ugdm)
   266)   endif
   267)   nullify(this%ugdm)
   268)   if (this%dm /= 0) then
   269)     !call DMDestroy(this%dm,ierr)
   270)   endif
   271)   this%dm = 0  
   272)   
   273) end subroutine UnstructuredCommunicatorDestroy
   274) 
   275) end module Communicator_Unstructured_class

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