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:       end

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

 24:       print*, 'Called MatMultAdd'
 25:       end

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

 34:       print*, 'Called MatMultTranspose'
 35:       end

 37:       subroutine mymatmulthermitiantranspose(A, x, y, ierr)
 38:       use petscmat
 39:       implicit none
 40:       Mat A
 41:       Vec x, y
 42:       PetscErrorCode ierr

 44:       print*, 'Called MatMultHermitianTranspose'
 45:       end

 47:       subroutine mymatmulttransposeadd(A, x, y, z, ierr)
 48:       use petscmat
 49:       implicit none
 50:       Mat A
 51:       Vec x, y, z
 52:       PetscErrorCode ierr

 54:       print*, 'Called MatMultTransposeAdd'
 55:       end

 57:       subroutine mymatmulthermitiantransposeadd(A, x, y, z, ierr)
 58:       use petscmat
 59:       implicit none
 60:       Mat A
 61:       Vec x, y, z
 62:       PetscErrorCode ierr

 64:       print*, 'Called MatMultHermitianTransposeAdd'
 65:       end

 67:       subroutine mymattranspose(A, reuse, B, ierr)
 68:       use petscmat
 69:       implicit none
 70:       Mat A, B
 71:       MatReuse reuse
 72:       PetscErrorCode ierr
 73:       PetscInt i12,i0

 75:       i12 = 12
 76:       i0 = 0
 77:       PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr))
 78:       PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
 79:       PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))

 81:       print*, 'Called MatTranspose'
 82:       end

 84:       subroutine mymatgetdiagonal(A, x, ierr)
 85:       use petscmat
 86:       implicit none
 87:       Mat A
 88:       Vec x
 89:       PetscErrorCode ierr

 91:       print*, 'Called MatGetDiagonal'
 92:       end

 94:       subroutine mymatdiagonalscale(A, x, y, ierr)
 95:       use petscmat
 96:       implicit none
 97:       Mat A
 98:       Vec x, y
 99:       PetscErrorCode ierr

101:       print*, 'Called MatDiagonalScale'
102:       end

104:       subroutine mymatzeroentries(A, ierr)
105:       use petscmat
106:       implicit none
107:       Mat A
108:       PetscErrorCode ierr

110:       print*, 'Called MatZeroEntries'
111:       end

113:       subroutine mymataxpy(A, alpha, B, str, ierr)
114:       use petscmat
115:       implicit none
116:       Mat A, B
117:       PetscScalar alpha
118:       MatStructure str
119:       PetscErrorCode ierr

121:       print*, 'Called MatAXPY'
122:       end

124:       subroutine mymatshift(A, alpha, ierr)
125:       use petscmat
126:       implicit none
127:       Mat A
128:       PetscScalar alpha
129:       PetscErrorCode ierr

131:       print*, 'Called MatShift'
132:       end

134:       subroutine mymatdiagonalset(A, x, ins, ierr)
135:       use petscmat
136:       implicit none
137:       Mat A
138:       Vec x
139:       InsertMode ins
140:       PetscErrorCode ierr

142:       print*, 'Called MatDiagonalSet'
143:       end

145:       subroutine mymatdestroy(A, ierr)
146:       use petscmat
147:       implicit none
148:       Mat A
149:       PetscErrorCode ierr

151:       print*, 'Called MatDestroy'
152:       end

154:       subroutine mymatview(A, viewer, ierr)
155:       use petscmat
156:       implicit none
157:       Mat A
158:       PetscViewer viewer
159:       PetscErrorCode ierr

161:       print*, 'Called MatView'
162:       end

164:       subroutine mymatgetvecs(A, x, y, ierr)
165:       use petscmat
166:       implicit none
167:       Mat A
168:       Vec x, y
169:       PetscErrorCode ierr

171:       print*, 'Called MatCreateVecs'
172:       end

174:       program main
175:       use petscmat
176:       implicit none

178:       Mat     m, mt
179:       Vec     x, y, z
180:       PetscScalar a
181:       PetscViewer viewer
182:       MatOperation op
183:       PetscErrorCode ierr
184:       PetscInt i12,i0
185:       external mymatmult
186:       external mymatmultadd
187:       external mymatmulttranspose
188:       external mymatmulthermitiantranspose
189:       external mymatmulttransposeadd
190:       external mymatmulthermitiantransposeadd
191:       external mymattranspose
192:       external mymatgetdiagonal
193:       external mymatdiagonalscale
194:       external mymatzeroentries
195:       external mymataxpy
196:       external mymatshift
197:       external mymatdiagonalset
198:       external mymatdestroy
199:       external mymatview
200:       external mymatgetvecs

202:       PetscCallA(PetscInitialize(ierr))

204:       viewer = PETSC_VIEWER_STDOUT_SELF
205:       i12 = 12
206:       i0 = 0
207:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr))
208:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr))
209:       PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr))
210:       PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr))
211:       PetscCallA(MatShellSetManageScalingShifts(m,ierr))
212:       PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
213:       PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))

215:       op = MATOP_MULT
216:       PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr))
217:       op = MATOP_MULT_ADD
218:       PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr))
219:       op = MATOP_MULT_TRANSPOSE
220:       PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr))
221:       op = MATOP_MULT_HERMITIAN_TRANSPOSE
222:       PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantranspose, ierr))
223:       op = MATOP_MULT_TRANSPOSE_ADD
224:       PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr))
225:       op = MATOP_MULT_HERMITIAN_TRANS_ADD
226:       PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantransposeadd, ierr))
227:       op = MATOP_TRANSPOSE
228:       PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr))
229:       op = MATOP_GET_DIAGONAL
230:       PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr))
231:       op = MATOP_DIAGONAL_SCALE
232:       PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr))
233:       op = MATOP_ZERO_ENTRIES
234:       PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr))
235:       op = MATOP_AXPY
236:       PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr))
237:       op = MATOP_SHIFT
238:       PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr))
239:       op = MATOP_DIAGONAL_SET
240:       PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr))
241:       op = MATOP_DESTROY
242:       PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr))
243:       op = MATOP_VIEW
244:       PetscCallA(MatShellSetOperation(m, op, mymatview, ierr))
245:       op = MATOP_CREATE_VECS
246:       PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr))

248:       PetscCallA(MatMult(m, x, y, ierr))
249:       PetscCallA(MatMultAdd(m, x, y, z, ierr))
250:       PetscCallA(MatMultTranspose(m, x, y, ierr))
251:       PetscCallA(MatMultHermitianTranspose(m, x, y, ierr))
252:       PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr))
253:       PetscCallA(MatMultHermitianTransposeAdd(m, x, y, z, ierr))
254:       PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr))
255:       PetscCallA(MatGetDiagonal(m, x, ierr))
256:       PetscCallA(MatDiagonalScale(m, x, y, ierr))
257:       PetscCallA(MatZeroEntries(m, ierr))
258:       a = 102.
259:       PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr))
260:       PetscCallA(MatShift(m, a, ierr))
261:       PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr))
262:       PetscCallA(MatView(m, viewer, ierr))
263:       PetscCallA(MatCreateVecs(m, x, y, ierr))
264:       PetscCallA(MatDestroy(m,ierr))
265:       PetscCallA(MatDestroy(mt, ierr))
266:       PetscCallA(VecDestroy(x, ierr))
267:       PetscCallA(VecDestroy(y, ierr))
268:       PetscCallA(VecDestroy(z, ierr))

270:       PetscCallA(PetscFinalize(ierr))
271:       end

273: !/*TEST
274: !
275: !   testset:
276: !     args: -malloc_dump
277: !     filter: sort -b
278: !     filter_output: sort -b
279: !     test:
280: !       suffix: 1
281: !       requires: !complex
282: !     test:
283: !       suffix: 2
284: !       requires: complex
285: !
286: !TEST*/