Actual source code: ex201f.F
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: call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr)
62: call MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr)
63: call 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: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
195: if (ierr .ne. 0) then
196: print*,'Unable to initialize PETSc'
197: stop
198: endif
200: viewer = PETSC_VIEWER_STDOUT_SELF
201: i12 = 12
202: i0 = 0
203: call VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr)
204: call VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr)
205: call VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr)
206: call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr)
207: call MatShellSetManageScalingShifts(m,ierr)
208: call MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr)
209: call MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr)
211: op = MATOP_MULT
212: call MatShellSetOperation(m, op, mymatmult, ierr)
213: op = MATOP_MULT_ADD
214: call MatShellSetOperation(m, op, mymatmultadd, ierr)
215: op = MATOP_MULT_TRANSPOSE
216: call MatShellSetOperation(m, op, mymatmulttranspose, ierr)
217: op = MATOP_MULT_TRANSPOSE_ADD
218: call MatShellSetOperation(m, op, mymatmulttransposeadd, ierr)
219: op = MATOP_TRANSPOSE
220: call MatShellSetOperation(m, op, mymattranspose, ierr)
221: op = MATOP_GET_DIAGONAL
222: call MatShellSetOperation(m, op, mymatgetdiagonal, ierr)
223: op = MATOP_DIAGONAL_SCALE
224: call MatShellSetOperation(m, op, mymatdiagonalscale, ierr)
225: op = MATOP_ZERO_ENTRIES
226: call MatShellSetOperation(m, op, mymatzeroentries, ierr)
227: op = MATOP_AXPY
228: call MatShellSetOperation(m, op, mymataxpy, ierr)
229: op = MATOP_SHIFT
230: call MatShellSetOperation(m, op, mymatshift, ierr)
231: op = MATOP_DIAGONAL_SET
232: call MatShellSetOperation(m, op, mymatdiagonalset, ierr)
233: op = MATOP_DESTROY
234: call MatShellSetOperation(m, op, mymatdestroy, ierr)
235: op = MATOP_VIEW
236: call MatShellSetOperation(m, op, mymatview, ierr)
237: op = MATOP_CREATE_VECS
238: call MatShellSetOperation(m, op, mymatgetvecs, ierr)
240: call MatMult(m, x, y, ierr)
241: call MatMultAdd(m, x, y, z, ierr)
242: call MatMultTranspose(m, x, y, ierr)
243: call MatMultTransposeAdd(m, x, y, z, ierr)
244: call MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr)
245: call MatGetDiagonal(m, x, ierr)
246: call MatDiagonalScale(m, x, y, ierr)
247: call MatZeroEntries(m, ierr)
248: a = 102.
249: call MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr)
250: call MatShift(m, a, ierr)
251: call MatDiagonalSet(m, x, INSERT_VALUES, ierr)
252: call MatView(m, viewer, ierr)
253: call MatCreateVecs(m, x, y, ierr)
254: call MatDestroy(m,ierr)
255: call MatDestroy(mt, ierr)
256: call VecDestroy(x, ierr)
257: call VecDestroy(y, ierr)
258: call VecDestroy(z, ierr)
260: call PetscFinalize(ierr)
261: end
263: !/*TEST
264: !
265: ! test:
266: ! args: -malloc_dump
267: ! filter: sort -b
268: ! filter_output: sort -b
269: !
270: !TEST*/