1: !
  2: !
  3: !   This program demonstrates use of MatShellSetOperation()
  4: !
  5: #include <petsc/finclude/petscmat.h>
  6: module ex201fmodule
  7:   use petscmat
  8:   implicit none

 10: contains
 11:   subroutine mymatmult(A, x, y, ierr)
 12:     Mat A
 13:     Vec x, y
 14:     PetscErrorCode ierr

 16:     print *, 'Called MatMult'
 17:   end

 19:   subroutine mymatmultadd(A, x, y, z, ierr)
 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:     Mat A
 29:     Vec x, y
 30:     PetscErrorCode ierr

 32:     print *, 'Called MatMultTranspose'
 33:   end

 35:   subroutine mymatmulthermitiantranspose(A, x, y, ierr)
 36:     Mat A
 37:     Vec x, y
 38:     PetscErrorCode ierr

 40:     print *, 'Called MatMultHermitianTranspose'
 41:   end

 43:   subroutine mymatmulttransposeadd(A, x, y, z, ierr)
 44:     Mat A
 45:     Vec x, y, z
 46:     PetscErrorCode ierr

 48:     print *, 'Called MatMultTransposeAdd'
 49:   end

 51:   subroutine mymatmulthermitiantransposeadd(A, x, y, z, ierr)
 52:     Mat A
 53:     Vec x, y, z
 54:     PetscErrorCode ierr

 56:     print *, 'Called MatMultHermitianTransposeAdd'
 57:   end

 59:   subroutine mymattranspose(A, reuse, B, ierr)
 60:     Mat A, B
 61:     MatReuse reuse
 62:     PetscErrorCode ierr
 63:     PetscInt i12, i0

 65:     i12 = 12
 66:     i0 = 0
 67:     PetscCallA(MatCreateShell(PETSC_COMM_SELF, i12, i12, i12, i12, i0, B, ierr))
 68:     PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
 69:     PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))

 71:     print *, 'Called MatTranspose'
 72:   end

 74:   subroutine mymatgetdiagonal(A, x, ierr)
 75:     Mat A
 76:     Vec x
 77:     PetscErrorCode ierr

 79:     print *, 'Called MatGetDiagonal'
 80:   end

 82:   subroutine mymatdiagonalscale(A, x, y, ierr)
 83:     Mat A
 84:     Vec x, y
 85:     PetscErrorCode ierr

 87:     print *, 'Called MatDiagonalScale'
 88:   end

 90:   subroutine mymatzeroentries(A, ierr)
 91:     Mat A
 92:     PetscErrorCode ierr

 94:     print *, 'Called MatZeroEntries'
 95:   end

 97:   subroutine mymataxpy(A, alpha, B, str, ierr)
 98:     Mat A, B
 99:     PetscScalar alpha
100:     MatStructure str
101:     PetscErrorCode ierr

103:     print *, 'Called MatAXPY'
104:   end

106:   subroutine mymatshift(A, alpha, ierr)
107:     Mat A
108:     PetscScalar alpha
109:     PetscErrorCode ierr

111:     print *, 'Called MatShift'
112:   end

114:   subroutine mymatdiagonalset(A, x, ins, ierr)
115:     Mat A
116:     Vec x
117:     InsertMode ins
118:     PetscErrorCode ierr

120:     print *, 'Called MatDiagonalSet'
121:   end

123:   subroutine mymatdestroy(A, ierr)
124:     Mat A
125:     PetscErrorCode ierr

127:     print *, 'Called MatDestroy'
128:   end

130:   subroutine mymatview(A, viewer, ierr)
131:     Mat A
132:     PetscViewer viewer
133:     PetscErrorCode ierr

135:     print *, 'Called MatView'
136:   end

138:   subroutine mymatgetvecs(A, x, y, ierr)
139:     Mat A
140:     Vec x, y
141:     PetscErrorCode ierr

143:     print *, 'Called MatCreateVecs'
144:   end

146: end module ex201fmodule

148: program main
149:   use petscmat
150:   use ex201fmodule
151:   implicit none

153:   Mat m, mt
154:   Vec x, y, z
155:   PetscScalar a
156:   PetscViewer viewer
157:   MatOperation op
158:   PetscErrorCode ierr
159:   PetscInt i12, i0

161:   PetscCallA(PetscInitialize(ierr))

163:   viewer = PETSC_VIEWER_STDOUT_SELF
164:   i12 = 12
165:   i0 = 0
166:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr))
167:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr))
168:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr))
169:   PetscCallA(MatCreateShell(PETSC_COMM_SELF, i12, i12, i12, i12, i0, m, ierr))
170:   PetscCallA(MatShellSetManageScalingShifts(m, ierr))
171:   PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
172:   PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))

174:   op = MATOP_MULT
175:   PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr))
176:   op = MATOP_MULT_ADD
177:   PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr))
178:   op = MATOP_MULT_TRANSPOSE
179:   PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr))
180:   op = MATOP_MULT_HERMITIAN_TRANSPOSE
181:   PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantranspose, ierr))
182:   op = MATOP_MULT_TRANSPOSE_ADD
183:   PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr))
184:   op = MATOP_MULT_HERMITIAN_TRANS_ADD
185:   PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantransposeadd, ierr))
186:   op = MATOP_TRANSPOSE
187:   PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr))
188:   op = MATOP_GET_DIAGONAL
189:   PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr))
190:   op = MATOP_DIAGONAL_SCALE
191:   PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr))
192:   op = MATOP_ZERO_ENTRIES
193:   PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr))
194:   op = MATOP_AXPY
195:   PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr))
196:   op = MATOP_SHIFT
197:   PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr))
198:   op = MATOP_DIAGONAL_SET
199:   PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr))
200:   op = MATOP_DESTROY
201:   PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr))
202:   op = MATOP_VIEW
203:   PetscCallA(MatShellSetOperation(m, op, mymatview, ierr))
204:   op = MATOP_CREATE_VECS
205:   PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr))

207:   PetscCallA(MatMult(m, x, y, ierr))
208:   PetscCallA(MatMultAdd(m, x, y, z, ierr))
209:   PetscCallA(MatMultTranspose(m, x, y, ierr))
210:   PetscCallA(MatMultHermitianTranspose(m, x, y, ierr))
211:   PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr))
212:   PetscCallA(MatMultHermitianTransposeAdd(m, x, y, z, ierr))
213:   PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr))
214:   PetscCallA(MatGetDiagonal(m, x, ierr))
215:   PetscCallA(MatDiagonalScale(m, x, y, ierr))
216:   PetscCallA(MatZeroEntries(m, ierr))
217:   a = 102.
218:   PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr))
219:   PetscCallA(MatShift(m, a, ierr))
220:   PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr))
221:   PetscCallA(MatView(m, viewer, ierr))
222:   PetscCallA(MatCreateVecs(m, x, y, ierr))
223:   PetscCallA(MatDestroy(m, ierr))
224:   PetscCallA(MatDestroy(mt, ierr))
225:   PetscCallA(VecDestroy(x, ierr))
226:   PetscCallA(VecDestroy(y, ierr))
227:   PetscCallA(VecDestroy(z, ierr))

229:   PetscCallA(PetscFinalize(ierr))
230: end

232: !/*TEST
233: !
234: !   testset:
235: !     args: -malloc_dump
236: !     filter: sort -b
237: !     filter_output: sort -b
238: !     test:
239: !       suffix: 1
240: !       requires: !complex
241: !     test:
242: !       suffix: 2
243: !       requires: complex
244: !
245: !TEST*/