communicator_structured.F90       coverage:  66.67 %func     34.52 %block


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

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