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*/