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: return
16: end
18: subroutine mymatmultadd(A, x, y, z, ierr)
19: use petscmat
20: implicit none
21: Mat A
22: Vec x, y, z
23: PetscErrorCode ierr
25: print*, "Called MatMultAdd"
26: return
27: end
29: subroutine mymatmulttranspose(A, x, y, ierr)
30: use petscmat
31: implicit none
32: Mat A
33: Vec x, y
34: PetscErrorCode ierr
36: print*, "Called MatMultTranspose"
37: return
38: end
40: subroutine mymatmulttransposeadd(A, x, y, z, ierr)
41: use petscmat
42: implicit none
43: Mat A
44: Vec x, y, z
45: PetscErrorCode ierr
47: print*, "Called MatMultTransposeAdd"
48: return
49: end
51: subroutine mymattranspose(A, reuse, B, ierr)
52: use petscmat
53: implicit none
54: Mat A, B
55: MatReuse reuse
56: PetscErrorCode ierr
57: PetscInt i12,i0
59: i12 = 12
60: i0 = 0
61: PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr))
62: PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
63: PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))
65: print*, "Called MatTranspose"
66: return
67: end
69: subroutine mymatgetdiagonal(A, x, ierr)
70: use petscmat
71: implicit none
72: Mat A
73: Vec x
74: PetscErrorCode ierr
76: print*, "Called MatGetDiagonal"
77: return
78: end
80: subroutine mymatdiagonalscale(A, x, y, ierr)
81: use petscmat
82: implicit none
83: Mat A
84: Vec x, y
85: PetscErrorCode ierr
87: print*, "Called MatDiagonalScale"
88: return
89: end
91: subroutine mymatzeroentries(A, ierr)
92: use petscmat
93: implicit none
94: Mat A
95: PetscErrorCode ierr
97: print*, "Called MatZeroEntries"
98: return
99: end
101: subroutine mymataxpy(A, alpha, B, str, ierr)
102: use petscmat
103: implicit none
104: Mat A, B
105: PetscScalar alpha
106: MatStructure str
107: PetscErrorCode ierr
109: print*, "Called MatAXPY"
110: return
111: end
113: subroutine mymatshift(A, alpha, ierr)
114: use petscmat
115: implicit none
116: Mat A
117: PetscScalar alpha
118: PetscErrorCode ierr
120: print*, "Called MatShift"
121: return
122: end
124: subroutine mymatdiagonalset(A, x, ins, ierr)
125: use petscmat
126: implicit none
127: Mat A
128: Vec x
129: InsertMode ins
130: PetscErrorCode ierr
132: print*, "Called MatDiagonalSet"
133: return
134: end
136: subroutine mymatdestroy(A, ierr)
137: use petscmat
138: implicit none
139: Mat A
140: PetscErrorCode ierr
142: print*, "Called MatDestroy"
143: return
144: end
146: subroutine mymatview(A, viewer, ierr)
147: use petscmat
148: implicit none
149: Mat A
150: PetscViewer viewer
151: PetscErrorCode ierr
153: print*, "Called MatView"
154: return
155: end
157: subroutine mymatgetvecs(A, x, y, ierr)
158: use petscmat
159: implicit none
160: Mat A
161: Vec x, y
162: PetscErrorCode ierr
164: print*, "Called MatCreateVecs"
165: return
166: end
168: program main
169: use petscmat
170: implicit none
172: Mat m, mt
173: Vec x, y, z
174: PetscScalar a
175: PetscViewer viewer
176: MatOperation op
177: PetscErrorCode ierr
178: PetscInt i12,i0
179: external mymatmult
180: external mymatmultadd
181: external mymatmulttranspose
182: external mymatmulttransposeadd
183: external mymattranspose
184: external mymatgetdiagonal
185: external mymatdiagonalscale
186: external mymatzeroentries
187: external mymataxpy
188: external mymatshift
189: external mymatdiagonalset
190: external mymatdestroy
191: external mymatview
192: external mymatgetvecs
194: PetscCallA(PetscInitialize(ierr))
196: viewer = PETSC_VIEWER_STDOUT_SELF
197: i12 = 12
198: i0 = 0
199: PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr))
200: PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr))
201: PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr))
202: PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr))
203: PetscCallA(MatShellSetManageScalingShifts(m,ierr))
204: PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
205: PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))
207: op = MATOP_MULT
208: PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr))
209: op = MATOP_MULT_ADD
210: PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr))
211: op = MATOP_MULT_TRANSPOSE
212: PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr))
213: op = MATOP_MULT_TRANSPOSE_ADD
214: PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr))
215: op = MATOP_TRANSPOSE
216: PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr))
217: op = MATOP_GET_DIAGONAL
218: PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr))
219: op = MATOP_DIAGONAL_SCALE
220: PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr))
221: op = MATOP_ZERO_ENTRIES
222: PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr))
223: op = MATOP_AXPY
224: PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr))
225: op = MATOP_SHIFT
226: PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr))
227: op = MATOP_DIAGONAL_SET
228: PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr))
229: op = MATOP_DESTROY
230: PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr))
231: op = MATOP_VIEW
232: PetscCallA(MatShellSetOperation(m, op, mymatview, ierr))
233: op = MATOP_CREATE_VECS
234: PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr))
236: PetscCallA(MatMult(m, x, y, ierr))
237: PetscCallA(MatMultAdd(m, x, y, z, ierr))
238: PetscCallA(MatMultTranspose(m, x, y, ierr))
239: PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr))
240: PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr))
241: PetscCallA(MatGetDiagonal(m, x, ierr))
242: PetscCallA(MatDiagonalScale(m, x, y, ierr))
243: PetscCallA(MatZeroEntries(m, ierr))
244: a = 102.
245: PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr))
246: PetscCallA(MatShift(m, a, ierr))
247: PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr))
248: PetscCallA(MatView(m, viewer, ierr))
249: PetscCallA(MatCreateVecs(m, x, y, ierr))
250: PetscCallA(MatDestroy(m,ierr))
251: PetscCallA(MatDestroy(mt, ierr))
252: PetscCallA(VecDestroy(x, ierr))
253: PetscCallA(VecDestroy(y, ierr))
254: PetscCallA(VecDestroy(z, ierr))
256: PetscCallA(PetscFinalize(ierr))
257: end
259: !/*TEST
260: !
261: ! test:
262: ! args: -malloc_dump
263: ! filter: sort -b
264: ! filter_output: sort -b
265: !
266: !TEST*/