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

 64:     PetscCallA(MatCreateShell(PETSC_COMM_SELF, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 0_PETSC_INT_KIND, B, ierr))
 65:     PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
 66:     PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))

 68:     print *, 'Called MatTranspose'
 69:   end

 71:   subroutine mymatgetdiagonal(A, x, ierr)
 72:     Mat A
 73:     Vec x
 74:     PetscErrorCode ierr

 76:     print *, 'Called MatGetDiagonal'
 77:   end

 79:   subroutine mymatdiagonalscale(A, x, y, ierr)
 80:     Mat A
 81:     Vec x, y
 82:     PetscErrorCode ierr

 84:     print *, 'Called MatDiagonalScale'
 85:   end

 87:   subroutine mymatzeroentries(A, ierr)
 88:     Mat A
 89:     PetscErrorCode ierr

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

 94:   subroutine mymataxpy(A, alpha, B, str, ierr)
 95:     Mat A, B
 96:     PetscScalar alpha
 97:     MatStructure str
 98:     PetscErrorCode ierr

100:     print *, 'Called MatAXPY'
101:   end

103:   subroutine mymatshift(A, alpha, ierr)
104:     Mat A
105:     PetscScalar alpha
106:     PetscErrorCode ierr

108:     print *, 'Called MatShift'
109:   end

111:   subroutine mymatdiagonalset(A, x, ins, ierr)
112:     Mat A
113:     Vec x
114:     InsertMode ins
115:     PetscErrorCode ierr

117:     print *, 'Called MatDiagonalSet'
118:   end

120:   subroutine mymatdestroy(A, ierr)
121:     Mat A
122:     PetscErrorCode ierr

124:     print *, 'Called MatDestroy'
125:   end

127:   subroutine mymatview(A, viewer, ierr)
128:     Mat A
129:     PetscViewer viewer
130:     PetscErrorCode ierr

132:     print *, 'Called MatView'
133:   end

135:   subroutine mymatgetvecs(A, x, y, ierr)
136:     Mat A
137:     Vec x, y
138:     PetscErrorCode ierr

140:     print *, 'Called MatCreateVecs'
141:   end

143: end module ex201fmodule

145: program main
146:   use petscmat
147:   use ex201fmodule
148:   implicit none

150:   Mat m, mt
151:   Vec x, y, z
152:   PetscScalar, parameter :: a = 102.
153:   PetscViewer viewer
154:   MatOperation op
155:   PetscErrorCode ierr

157:   PetscCallA(PetscInitialize(ierr))

159:   viewer = PETSC_VIEWER_STDOUT_SELF
160:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, 12_PETSC_INT_KIND, x, ierr))
161:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, 12_PETSC_INT_KIND, y, ierr))
162:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, 12_PETSC_INT_KIND, z, ierr))
163:   PetscCallA(MatCreateShell(PETSC_COMM_SELF, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 12_PETSC_INT_KIND, 0_PETSC_INT_KIND, m, ierr))
164:   PetscCallA(MatShellSetManageScalingShifts(m, ierr))
165:   PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
166:   PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))

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

201:   PetscCallA(MatMult(m, x, y, ierr))
202:   PetscCallA(MatMultAdd(m, x, y, z, ierr))
203:   PetscCallA(MatMultTranspose(m, x, y, ierr))
204:   PetscCallA(MatMultHermitianTranspose(m, x, y, ierr))
205:   PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr))
206:   PetscCallA(MatMultHermitianTransposeAdd(m, x, y, z, ierr))
207:   PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr))
208:   PetscCallA(MatGetDiagonal(m, x, ierr))
209:   PetscCallA(MatDiagonalScale(m, x, y, ierr))
210:   PetscCallA(MatZeroEntries(m, ierr))
211:   PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr))
212:   PetscCallA(MatShift(m, a, ierr))
213:   PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr))
214:   PetscCallA(MatView(m, viewer, ierr))
215:   PetscCallA(MatCreateVecs(m, x, y, ierr))
216:   PetscCallA(MatDestroy(m, ierr))
217:   PetscCallA(MatDestroy(mt, ierr))
218:   PetscCallA(VecDestroy(x, ierr))
219:   PetscCallA(VecDestroy(y, ierr))
220:   PetscCallA(VecDestroy(z, ierr))

222:   PetscCallA(PetscFinalize(ierr))
223: end

225: !/*TEST
226: !
227: !   testset:
228: !     args: -malloc_dump
229: !     filter: sort -b
230: !     filter_output: sort -b
231: !     test:
232: !       suffix: 1
233: !       requires: !complex
234: !     test:
235: !       suffix: 2
236: !       requires: complex
237: !
238: !TEST*/