Actual source code: ex201f.F

  1: !
  2: !
  3: !   This program demonstrates use of MatShellSetOperation()
  4: !
  5:       subroutine mymatmult(A, x, y, ierr)
  6: #include <petsc/finclude/petscmat.h>
  7:       use petscmat
  8:       implicit none

 10:       Mat A
 11:       Vec x, y
 12:       PetscErrorCode ierr

 14:       print*, "Called MatMult"
 15:       return
 16:       end

 18:       subroutine mymatmultadd(A, x, y, z, ierr)
 19:       use petscmat
 20:       implicit none
 21:       Mat A
 22:       Vec x, y, z
 23:       PetscErrorCode ierr

 25:       print*, "Called MatMultAdd"
 26:       return
 27:       end

 29:       subroutine mymatmulttranspose(A, x, y, ierr)
 30:       use petscmat
 31:       implicit none
 32:       Mat A
 33:       Vec x, y
 34:       PetscErrorCode ierr

 36:       print*, "Called MatMultTranspose"
 37:       return
 38:       end

 40:       subroutine mymatmulttransposeadd(A, x, y, z, ierr)
 41:       use petscmat
 42:       implicit none
 43:       Mat A
 44:       Vec x, y, z
 45:       PetscErrorCode ierr

 47:       print*, "Called MatMultTransposeAdd"
 48:       return
 49:       end

 51:       subroutine mymattranspose(A, reuse, B, ierr)
 52:       use petscmat
 53:       implicit none
 54:       Mat A, B
 55:       MatReuse reuse
 56:       PetscErrorCode ierr
 57:       PetscInt i12,i0

 59:       i12 = 12
 60:       i0 = 0
 61:       call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr)
 62:       call MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr)
 63:       call MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr)

 65:       print*, "Called MatTranspose"
 66:       return
 67:       end

 69:       subroutine mymatgetdiagonal(A, x, ierr)
 70:       use petscmat
 71:       implicit none
 72:       Mat A
 73:       Vec x
 74:       PetscErrorCode ierr

 76:       print*, "Called MatGetDiagonal"
 77:       return
 78:       end

 80:       subroutine mymatdiagonalscale(A, x, y, ierr)
 81:       use petscmat
 82:       implicit none
 83:       Mat A
 84:       Vec x, y
 85:       PetscErrorCode ierr

 87:       print*, "Called MatDiagonalScale"
 88:       return
 89:       end

 91:       subroutine mymatzeroentries(A, ierr)
 92:       use petscmat
 93:       implicit none
 94:       Mat A
 95:       PetscErrorCode ierr

 97:       print*, "Called MatZeroEntries"
 98:       return
 99:       end

101:       subroutine mymataxpy(A, alpha, B, str, ierr)
102:       use petscmat
103:       implicit none
104:       Mat A, B
105:       PetscScalar alpha
106:       MatStructure str
107:       PetscErrorCode ierr

109:       print*, "Called MatAXPY"
110:       return
111:       end

113:       subroutine mymatshift(A, alpha, ierr)
114:       use petscmat
115:       implicit none
116:       Mat A
117:       PetscScalar alpha
118:       PetscErrorCode ierr

120:       print*, "Called MatShift"
121:       return
122:       end

124:       subroutine mymatdiagonalset(A, x, ins, ierr)
125:       use petscmat
126:       implicit none
127:       Mat A
128:       Vec x
129:       InsertMode ins
130:       PetscErrorCode ierr

132:       print*, "Called MatDiagonalSet"
133:       return
134:       end

136:       subroutine mymatdestroy(A, ierr)
137:       use petscmat
138:       implicit none
139:       Mat A
140:       PetscErrorCode ierr

142:       print*, "Called MatDestroy"
143:       return
144:       end

146:       subroutine mymatview(A, viewer, ierr)
147:       use petscmat
148:       implicit none
149:       Mat A
150:       PetscViewer viewer
151:       PetscErrorCode ierr

153:       print*, "Called MatView"
154:       return
155:       end

157:       subroutine mymatgetvecs(A, x, y, ierr)
158:       use petscmat
159:       implicit none
160:       Mat A
161:       Vec x, y
162:       PetscErrorCode ierr

164:       print*, "Called MatCreateVecs"
165:       return
166:       end

168:       program main
169:       use petscmat
170:       implicit none

172:       Mat     m, mt
173:       Vec     x, y, z
174:       PetscScalar a
175:       PetscViewer viewer
176:       MatOperation op
177:       PetscErrorCode ierr
178:       PetscInt i12,i0
179:       external mymatmult
180:       external mymatmultadd
181:       external mymatmulttranspose
182:       external mymatmulttransposeadd
183:       external mymattranspose
184:       external mymatgetdiagonal
185:       external mymatdiagonalscale
186:       external mymatzeroentries
187:       external mymataxpy
188:       external mymatshift
189:       external mymatdiagonalset
190:       external mymatdestroy
191:       external mymatview
192:       external mymatgetvecs

194:       call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
195:       if (ierr .ne. 0) then
196:         print*,'Unable to initialize PETSc'
197:         stop
198:       endif

200:       viewer = PETSC_VIEWER_STDOUT_SELF
201:       i12 = 12
202:       i0 = 0
203:       call VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr)
204:       call VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr)
205:       call VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr)
206:       call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr)
207:       call MatShellSetManageScalingShifts(m,ierr)
208:       call MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr)
209:       call MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr)

211:       op = MATOP_MULT
212:       call MatShellSetOperation(m, op, mymatmult, ierr)
213:       op = MATOP_MULT_ADD
214:       call MatShellSetOperation(m, op, mymatmultadd, ierr)
215:       op = MATOP_MULT_TRANSPOSE
216:       call MatShellSetOperation(m, op, mymatmulttranspose, ierr)
217:       op = MATOP_MULT_TRANSPOSE_ADD
218:       call MatShellSetOperation(m, op, mymatmulttransposeadd, ierr)
219:       op = MATOP_TRANSPOSE
220:       call MatShellSetOperation(m, op, mymattranspose, ierr)
221:       op = MATOP_GET_DIAGONAL
222:       call MatShellSetOperation(m, op, mymatgetdiagonal, ierr)
223:       op = MATOP_DIAGONAL_SCALE
224:       call MatShellSetOperation(m, op, mymatdiagonalscale, ierr)
225:       op = MATOP_ZERO_ENTRIES
226:       call MatShellSetOperation(m, op, mymatzeroentries, ierr)
227:       op = MATOP_AXPY
228:       call MatShellSetOperation(m, op, mymataxpy, ierr)
229:       op = MATOP_SHIFT
230:       call MatShellSetOperation(m, op, mymatshift, ierr)
231:       op = MATOP_DIAGONAL_SET
232:       call MatShellSetOperation(m, op, mymatdiagonalset, ierr)
233:       op = MATOP_DESTROY
234:       call MatShellSetOperation(m, op, mymatdestroy, ierr)
235:       op = MATOP_VIEW
236:       call MatShellSetOperation(m, op, mymatview, ierr)
237:       op = MATOP_CREATE_VECS
238:       call MatShellSetOperation(m, op, mymatgetvecs, ierr)

240:       call MatMult(m, x, y, ierr)
241:       call MatMultAdd(m, x, y, z, ierr)
242:       call MatMultTranspose(m, x, y, ierr)
243:       call MatMultTransposeAdd(m, x, y, z, ierr)
244:       call MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr)
245:       call MatGetDiagonal(m, x, ierr)
246:       call MatDiagonalScale(m, x, y, ierr)
247:       call MatZeroEntries(m, ierr)
248:       a = 102.
249:       call MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr)
250:       call MatShift(m, a, ierr)
251:       call MatDiagonalSet(m, x, INSERT_VALUES, ierr)
252:       call MatView(m, viewer, ierr)
253:       call MatCreateVecs(m, x, y, ierr)
254:       call MatDestroy(m,ierr)
255:       call MatDestroy(mt, ierr)
256:       call VecDestroy(x, ierr)
257:       call VecDestroy(y, ierr)
258:       call VecDestroy(z, ierr)

260:       call PetscFinalize(ierr)
261:       end

263: !/*TEST
264: !
265: !   test:
266: !     args: -malloc_dump
267: !     filter: sort -b
268: !     filter_output: sort -b
269: !
270: !TEST*/