Actual source code: ex201f.F90

  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:       PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr))
 62:       PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
 63:       PetscCallA(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:       PetscCallA(PetscInitialize(ierr))

196:       viewer = PETSC_VIEWER_STDOUT_SELF
197:       i12 = 12
198:       i0 = 0
199:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr))
200:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr))
201:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr))
202:       PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr))
203:       PetscCallA(MatShellSetManageScalingShifts(m,ierr))
204:       PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
205:       PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))

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

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

256:       PetscCallA(PetscFinalize(ierr))
257:       end

259: !/*TEST
260: !
261: !   test:
262: !     args: -malloc_dump
263: !     filter: sort -b
264: !     filter_output: sort -b
265: !
266: !TEST*/