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