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