Actual source code: ex201f.F
petsc-3.8.4 2018-03-24
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
11: Mat A
12: Vec x, y
13: PetscErrorCode ierr
15: print*, "Called MatMult"
16: return
17: end
19: subroutine mymatmultadd(A, x, y, z, ierr)
20: use petscmat
21: implicit none
22: Mat A
23: Vec x, y, z
24: PetscErrorCode ierr
26: print*, "Called MatMultAdd"
27: return
28: end
30: subroutine mymatmulttranspose(A, x, y, ierr)
31: use petscmat
32: implicit none
33: Mat A
34: Vec x, y
35: PetscErrorCode ierr
37: print*, "Called MatMultTranspose"
38: return
39: end
41: subroutine mymatmulttransposeadd(A, x, y, z, ierr)
42: use petscmat
43: implicit none
44: Mat A
45: Vec x, y, z
46: PetscErrorCode ierr
48: print*, "Called MatMultTransposeAdd"
49: return
50: end
52: subroutine mymattranspose(A, reuse, B, ierr)
53: use petscmat
54: implicit none
55: Mat A, B
56: MatReuse reuse
57: PetscErrorCode ierr
58: PetscInt i12,i0
60: i12 = 12
61: i0 = 0
62: call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr)
63: call MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr)
64: call MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr)
66: print*, "Called MatTranspose"
67: return
68: end
70: subroutine mymatgetdiagonal(A, x, ierr)
71: use petscmat
72: implicit none
73: Mat A
74: Vec x
75: PetscErrorCode ierr
77: print*, "Called MatGetDiagonal"
78: return
79: end
81: subroutine mymatdiagonalscale(A, x, y, ierr)
82: use petscmat
83: implicit none
84: Mat A
85: Vec x, y
86: PetscErrorCode ierr
88: print*, "Called MatDiagonalScale"
89: return
90: end
92: subroutine mymatzeroentries(A, ierr)
93: use petscmat
94: implicit none
95: Mat A
96: PetscErrorCode ierr
98: print*, "Called MatZeroEntries"
99: return
100: end
102: subroutine mymataxpy(A, alpha, B, str, ierr)
103: use petscmat
104: implicit none
105: Mat A, B
106: PetscScalar alpha
107: MatStructure str
108: PetscErrorCode ierr
110: print*, "Called MatAXPY"
111: return
112: end
114: subroutine mymatshift(A, alpha, ierr)
115: use petscmat
116: implicit none
117: Mat A
118: PetscScalar alpha
119: PetscErrorCode ierr
121: print*, "Called MatShift"
122: return
123: end
125: subroutine mymatdiagonalset(A, x, ins, ierr)
126: use petscmat
127: implicit none
128: Mat A
129: Vec x
130: InsertMode ins
131: PetscErrorCode ierr
133: print*, "Called MatDiagonalSet"
134: return
135: end
137: subroutine mymatdestroy(A, ierr)
138: use petscmat
139: implicit none
140: Mat A
141: PetscErrorCode ierr
143: print*, "Called MatDestroy"
144: return
145: end
147: subroutine mymatview(A, viewer, ierr)
148: use petscmat
149: implicit none
150: Mat A
151: PetscViewer viewer
152: PetscErrorCode ierr
154: print*, "Called MatView"
155: return
156: end
158: subroutine mymatgetvecs(A, x, y, ierr)
159: use petscmat
160: implicit none
161: Mat A
162: Vec x, y
163: PetscErrorCode ierr
165: print*, "Called MatCreateVecs"
166: return
167: end
169: program main
170: use petscmat
171: implicit none
173: Mat m, mt
174: Vec x, y, z
175: PetscScalar a
176: PetscViewer viewer
177: MatOperation op
178: PetscErrorCode ierr
179: PetscInt i12,i0
180: external mymatmult
181: external mymatmultadd
182: external mymatmulttranspose
183: external mymatmulttransposeadd
184: external mymattranspose
185: external mymatgetdiagonal
186: external mymatdiagonalscale
187: external mymatzeroentries
188: external mymataxpy
189: external mymatshift
190: external mymatdiagonalset
191: external mymatdestroy
192: external mymatview
193: external mymatgetvecs
195: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
196: if (ierr .ne. 0) then
197: print*,'Unable to initialize PETSc'
198: stop
199: endif
201: viewer = PETSC_VIEWER_STDOUT_SELF
202: i12 = 12
203: i0 = 0
204: call VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr)
205: call VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr)
206: call VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr)
207: call MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,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