Actual source code: ex201f.F

petsc-3.12.1 2019-10-22
Report Typos and Errors
  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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

261:       call PetscFinalize(ierr)
262:       end

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