matrix_buffer.F90 coverage: 0.00 %func 0.00 %block
1) module Matrix_Buffer_module
2)
3) use Grid_module
4)
5) use PFLOTRAN_Constants_module
6)
7) implicit none
8)
9) private
10)
11) #include "petsc/finclude/petscsys.h"
12) #include "petsc/finclude/petscmat.h"
13) #include "petsc/finclude/petscmat.h90"
14) #include "petsc/finclude/petscvec.h"
15) #include "petsc/finclude/petscvec.h90"
16)
17)
18) type, public :: matrix_buffer_type
19) PetscInt :: matrix_type
20) type(grid_type), pointer :: grid
21) PetscInt :: i_width
22) PetscInt :: j_width
23) PetscInt :: k_width
24) PetscInt, pointer :: icol(:,:)
25) PetscReal, pointer :: values(:,:)
26) end type matrix_buffer_type
27)
28) PetscInt, parameter, public :: AIJ = 1
29) PetscInt, parameter, public :: HYPRESTRUCT = 2
30)
31) public :: MatrixBufferCreate, &
32) MatrixBufferInit, &
33) MatrixBufferDestroy, &
34) MatrixBufferZero, &
35) MatrixBufferAdd, &
36) MatrixBufferZeroRows, &
37) MatrixBufferSetValues
38)
39) contains
40)
41) ! ************************************************************************** !
42)
43) function MatrixBufferCreate()
44) !
45) ! Creates a matrix object
46) !
47) ! Author: Glenn Hammond
48) ! Date: 05/13/09
49) !
50)
51) implicit none
52)
53) type(matrix_buffer_type), pointer :: MatrixBufferCreate
54)
55) type(matrix_buffer_type), pointer :: matrix_buffer
56)
57) allocate(matrix_buffer)
58) matrix_buffer%matrix_type = 0
59) nullify(matrix_buffer%grid)
60) matrix_buffer%i_width = 0
61) matrix_buffer%j_width = 0
62) matrix_buffer%k_width = 0
63) nullify(matrix_buffer%values)
64) nullify(matrix_buffer%icol)
65) MatrixBufferCreate => matrix_buffer
66)
67) end function MatrixBufferCreate
68)
69) ! ************************************************************************** !
70)
71) subroutine MatrixBufferInit(A,matrix_buffer,grid)
72) !
73) ! Initializes matrix buffer object
74) !
75) ! Author: Glenn Hammond
76) ! Date: 05/13/09
77) !
78)
79) use Grid_Structured_module
80)
81) implicit none
82)
83) Mat :: A
84) type(matrix_buffer_type), pointer :: matrix_buffer
85) type(grid_type), target :: grid
86)
87) MatType :: mat_type
88) PetscInt :: local_id, ghosted_id
89) PetscInt :: i, j, k
90) type(grid_structured_type), pointer :: structured_grid
91) PetscErrorCode :: ierr
92)
93) matrix_buffer%grid => grid
94) structured_grid => grid%structured_grid
95)
96) call MatGetType(A,mat_type,ierr);CHKERRQ(ierr)
97)
98) select case(mat_type)
99) case(MATMPIAIJ,MATSEQAIJ,MATMPIBAIJ,MATSEQBAIJ)
100) matrix_buffer%matrix_type = AIJ
101) matrix_buffer%i_width = 1
102) matrix_buffer%j_width = structured_grid%ngx
103) matrix_buffer%k_width = structured_grid%ngxy
104) allocate(matrix_buffer%icol(7,structured_grid%ngmax))
105) allocate(matrix_buffer%values(7,structured_grid%ngmax))
106) ! compute fill indices
107) ! initialize all to zero
108) matrix_buffer%icol = 0
109) local_id = 0
110) do k=structured_grid%kstart,structured_grid%kend
111) do j=structured_grid%jstart,structured_grid%jend
112) do i=structured_grid%istart,structured_grid%iend
113) local_id = local_id + 1
114) ghosted_id = grid%nL2G(local_id)
115) if (k > 0) then
116) matrix_buffer%icol(1,ghosted_id) = ghosted_id - structured_grid%ngxy
117) endif
118) if (j > 0) then
119) matrix_buffer%icol(2,ghosted_id) = ghosted_id - structured_grid%ngx
120) endif
121) if (i > 0) then
122) matrix_buffer%icol(3,ghosted_id) = ghosted_id - 1
123) endif
124) matrix_buffer%icol(4,ghosted_id) = ghosted_id
125) if (i < structured_grid%iend .or. &
126) structured_grid%gxe-structured_grid%lxe > 0) then
127) matrix_buffer%icol(5,ghosted_id) = ghosted_id + 1
128) endif
129) if (j < structured_grid%jend .or. &
130) structured_grid%gye-structured_grid%lye > 0) then
131) matrix_buffer%icol(6,ghosted_id) = ghosted_id + structured_grid%ngx
132) endif
133) if (k < structured_grid%kend .or. &
134) structured_grid%gze-structured_grid%lze > 0) then
135) matrix_buffer%icol(7,ghosted_id) = ghosted_id + structured_grid%ngxy
136) endif
137) enddo
138) enddo
139) enddo
140) ! convert to zero-based
141) ! inactive entries will become -1, which is constistent with PETSc
142) matrix_buffer%icol = matrix_buffer%icol - 1
143) case(MATHYPRESTRUCT)
144) matrix_buffer%matrix_type = HYPRESTRUCT
145) matrix_buffer%i_width = 1
146) matrix_buffer%j_width = structured_grid%ngx
147) matrix_buffer%k_width = structured_grid%ngxy
148) allocate(matrix_buffer%values(7,structured_grid%ngmax))
149) end select
150) matrix_buffer%values = 0.d0
151)
152) end subroutine MatrixBufferInit
153)
154) ! ************************************************************************** !
155)
156) subroutine MatrixBufferZero(matrix_buffer)
157) !
158) ! Zeros matrix buffer values
159) !
160) ! Author: Glenn Hammond
161) ! Date: 05/13/09
162) !
163)
164) implicit none
165)
166) type(matrix_buffer_type), pointer :: matrix_buffer
167)
168) matrix_buffer%values = 0.d0
169)
170) end subroutine MatrixBufferZero
171)
172) ! ************************************************************************** !
173)
174) subroutine MatrixBufferAdd(matrix_buffer,irow,icol,value)
175) !
176) ! Adds values to matrix buffer object
177) !
178) ! Author: Glenn Hammond
179) ! Date: 05/13/09
180) !
181)
182) implicit none
183)
184) type(matrix_buffer_type), pointer :: matrix_buffer
185) PetscInt :: irow, icol
186) PetscReal :: value
187)
188) PetscInt :: index
189)
190) if (icol < 0) then
191) index = 4
192) else
193) index = irow-icol
194) if (index == 0) then
195) index = 4
196) else if (index == -matrix_buffer%i_width) then
197) index = 5
198) else if (index == matrix_buffer%i_width) then
199) index = 3
200) else if (index == -matrix_buffer%j_width) then
201) index = 6
202) else if (index == matrix_buffer%j_width) then
203) index = 2
204) else if (index == -matrix_buffer%k_width) then
205) index = 7
206) else if (index == matrix_buffer%k_width) then
207) index = 1
208) endif
209) endif
210) matrix_buffer%values(index,irow) = matrix_buffer%values(index,irow) + value
211)
212) end subroutine MatrixBufferAdd
213)
214) ! ************************************************************************** !
215)
216) subroutine MatrixBufferZeroRows(matrix_buffer,nrows,rows)
217) !
218) ! Zeros rows in a matrix buffer object, placing 1
219) ! on the diagonal
220) !
221) ! Author: Glenn Hammond
222) ! Date: 05/14/09
223) !
224)
225) implicit none
226)
227) type(matrix_buffer_type), pointer :: matrix_buffer
228) PetscInt :: nrows
229) PetscInt, pointer :: rows(:)
230)
231) PetscInt :: irow, irow_local
232)
233) select case(matrix_buffer%matrix_type)
234) case(AIJ)
235) do irow = 1, nrows
236) irow_local = matrix_buffer%grid%nG2L(rows(irow))
237) matrix_buffer%values(:,irow_local) = 0.d0
238) matrix_buffer%values(4,irow_local) = 1.d0
239) enddo
240) case(HYPRESTRUCT)
241) do irow = 1, nrows
242) matrix_buffer%values(:,rows(irow)) = 0.d0
243) matrix_buffer%values(4,rows(irow)) = 1.d0
244) enddo
245) end select
246)
247) end subroutine MatrixBufferZeroRows
248)
249) ! ************************************************************************** !
250)
251) subroutine MatrixBufferSetValues(A,matrix_buffer)
252) !
253) ! Sets values in PETSc matrix
254) !
255) ! Author: Glenn Hammond
256) ! Date: 05/14/09
257) !
258)
259) implicit none
260)
261) Mat :: A
262) type(matrix_buffer_type), pointer :: matrix_buffer
263)
264) select case(matrix_buffer%matrix_type)
265) case(AIJ)
266) call MatrixBufferSetValuesAij(A,matrix_buffer)
267) case(HYPRESTRUCT)
268) call MatrixBufferSetValuesHypre(A,matrix_buffer)
269) end select
270)
271) end subroutine MatrixBufferSetValues
272)
273) ! ************************************************************************** !
274)
275) subroutine MatrixBufferSetValuesHypre(A,matrix_buffer)
276) !
277) ! Sets values in PETSc Hypre matrix
278) !
279) ! Author: Glenn Hammond
280) ! Date: 05/13/09
281) !
282)
283) implicit none
284)
285) Mat :: A
286) type(matrix_buffer_type), pointer :: matrix_buffer
287)
288) PetscInt :: icol
289) PetscErrorCode :: ierr
290)
291) do icol = 1, 7
292) call MatSetValuesLocal(A,1,0,1,icol-1, &
293) matrix_buffer%values(icol,:),INSERT_VALUES, &
294) ierr);CHKERRQ(ierr)
295) enddo
296)
297) end subroutine MatrixBufferSetValuesHypre
298)
299) ! ************************************************************************** !
300)
301) subroutine MatrixBufferSetValuesAij(A,matrix_buffer)
302) !
303) ! MatrixBufferSetValues: Sets values in PETSc Aij matrix
304) !
305) ! Author: Glenn Hammond
306) ! Date: 05/13/09
307) !
308)
309) implicit none
310)
311) Mat :: A
312) type(matrix_buffer_type), pointer :: matrix_buffer
313)
314) PetscInt :: local_id, ghosted_id
315) PetscErrorCode :: ierr
316)
317) do local_id = 1, matrix_buffer%grid%nlmax
318) ghosted_id = matrix_buffer%grid%nL2G(local_id)
319) call MatSetValuesLocal(A,1,matrix_buffer%icol(4,ghosted_id), &
320) size(matrix_buffer%icol,1), &
321) matrix_buffer%icol(:,ghosted_id), &
322) matrix_buffer%values(:,ghosted_id),INSERT_VALUES, &
323) ierr);CHKERRQ(ierr)
324) enddo
325)
326) end subroutine MatrixBufferSetValuesAij
327)
328) ! ************************************************************************** !
329)
330) subroutine MatrixBufferDestroy(matrix_buffer)
331) !
332) ! Destroys a matrix buffer object
333) !
334) ! Author: Glenn Hammond
335) ! Date: 05/13/09
336) !
337)
338) implicit none
339)
340) type(matrix_buffer_type), pointer :: matrix_buffer
341)
342) if (.not.associated(matrix_buffer)) return
343)
344) if (associated(matrix_buffer%values)) deallocate(matrix_buffer%values)
345) nullify(matrix_buffer%values)
346) if (associated(matrix_buffer%icol)) deallocate(matrix_buffer%icol)
347) nullify(matrix_buffer%icol)
348)
349) deallocate(matrix_buffer)
350) nullify(matrix_buffer)
351)
352) end subroutine MatrixBufferDestroy
353)
354) end module Matrix_Buffer_module