xref: /petsc/src/mat/tests/ex201f.F90 (revision 9b88ac225e01f016352a5f4cd90e158abe5f5675) ! 
1!
2!
3!   This program demonstrates use of MatShellSetOperation()
4!
5#include <petsc/finclude/petscmat.h>
6module ex201fmodule
7  use petscmat
8  implicit none
9
10contains
11  subroutine mymatmult(A, x, y, ierr)
12    Mat A
13    Vec x, y
14    PetscErrorCode ierr
15
16    print *, 'Called MatMult'
17  end
18
19  subroutine mymatmultadd(A, x, y, z, ierr)
20    Mat A
21    Vec x, y, z
22    PetscErrorCode ierr
23
24    print *, 'Called MatMultAdd'
25  end
26
27  subroutine mymatmulttranspose(A, x, y, ierr)
28    Mat A
29    Vec x, y
30    PetscErrorCode ierr
31
32    print *, 'Called MatMultTranspose'
33  end
34
35  subroutine mymatmulthermitiantranspose(A, x, y, ierr)
36    Mat A
37    Vec x, y
38    PetscErrorCode ierr
39
40    print *, 'Called MatMultHermitianTranspose'
41  end
42
43  subroutine mymatmulttransposeadd(A, x, y, z, ierr)
44    Mat A
45    Vec x, y, z
46    PetscErrorCode ierr
47
48    print *, 'Called MatMultTransposeAdd'
49  end
50
51  subroutine mymatmulthermitiantransposeadd(A, x, y, z, ierr)
52    Mat A
53    Vec x, y, z
54    PetscErrorCode ierr
55
56    print *, 'Called MatMultHermitianTransposeAdd'
57  end
58
59  subroutine mymattranspose(A, reuse, B, ierr)
60    Mat A, B
61    MatReuse reuse
62    PetscErrorCode ierr
63    PetscInt i12, i0
64
65    i12 = 12
66    i0 = 0
67    PetscCallA(MatCreateShell(PETSC_COMM_SELF, i12, i12, i12, i12, i0, B, ierr))
68    PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr))
69    PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr))
70
71    print *, 'Called MatTranspose'
72  end
73
74  subroutine mymatgetdiagonal(A, x, ierr)
75    Mat A
76    Vec x
77    PetscErrorCode ierr
78
79    print *, 'Called MatGetDiagonal'
80  end
81
82  subroutine mymatdiagonalscale(A, x, y, ierr)
83    Mat A
84    Vec x, y
85    PetscErrorCode ierr
86
87    print *, 'Called MatDiagonalScale'
88  end
89
90  subroutine mymatzeroentries(A, ierr)
91    Mat A
92    PetscErrorCode ierr
93
94    print *, 'Called MatZeroEntries'
95  end
96
97  subroutine mymataxpy(A, alpha, B, str, ierr)
98    Mat A, B
99    PetscScalar alpha
100    MatStructure str
101    PetscErrorCode ierr
102
103    print *, 'Called MatAXPY'
104  end
105
106  subroutine mymatshift(A, alpha, ierr)
107    Mat A
108    PetscScalar alpha
109    PetscErrorCode ierr
110
111    print *, 'Called MatShift'
112  end
113
114  subroutine mymatdiagonalset(A, x, ins, ierr)
115    Mat A
116    Vec x
117    InsertMode ins
118    PetscErrorCode ierr
119
120    print *, 'Called MatDiagonalSet'
121  end
122
123  subroutine mymatdestroy(A, ierr)
124    Mat A
125    PetscErrorCode ierr
126
127    print *, 'Called MatDestroy'
128  end
129
130  subroutine mymatview(A, viewer, ierr)
131    Mat A
132    PetscViewer viewer
133    PetscErrorCode ierr
134
135    print *, 'Called MatView'
136  end
137
138  subroutine mymatgetvecs(A, x, y, ierr)
139    Mat A
140    Vec x, y
141    PetscErrorCode ierr
142
143    print *, 'Called MatCreateVecs'
144  end
145
146end module ex201fmodule
147
148program main
149  use petscmat
150  use ex201fmodule
151  implicit none
152
153  Mat m, mt
154  Vec x, y, z
155  PetscScalar a
156  PetscViewer viewer
157  MatOperation op
158  PetscErrorCode ierr
159  PetscInt i12, i0
160
161  PetscCallA(PetscInitialize(ierr))
162
163  viewer = PETSC_VIEWER_STDOUT_SELF
164  i12 = 12
165  i0 = 0
166  PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr))
167  PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr))
168  PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr))
169  PetscCallA(MatCreateShell(PETSC_COMM_SELF, i12, i12, i12, i12, i0, m, ierr))
170  PetscCallA(MatShellSetManageScalingShifts(m, ierr))
171  PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr))
172  PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr))
173
174  op = MATOP_MULT
175  PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr))
176  op = MATOP_MULT_ADD
177  PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr))
178  op = MATOP_MULT_TRANSPOSE
179  PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr))
180  op = MATOP_MULT_HERMITIAN_TRANSPOSE
181  PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantranspose, ierr))
182  op = MATOP_MULT_TRANSPOSE_ADD
183  PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr))
184  op = MATOP_MULT_HERMITIAN_TRANS_ADD
185  PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantransposeadd, ierr))
186  op = MATOP_TRANSPOSE
187  PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr))
188  op = MATOP_GET_DIAGONAL
189  PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr))
190  op = MATOP_DIAGONAL_SCALE
191  PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr))
192  op = MATOP_ZERO_ENTRIES
193  PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr))
194  op = MATOP_AXPY
195  PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr))
196  op = MATOP_SHIFT
197  PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr))
198  op = MATOP_DIAGONAL_SET
199  PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr))
200  op = MATOP_DESTROY
201  PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr))
202  op = MATOP_VIEW
203  PetscCallA(MatShellSetOperation(m, op, mymatview, ierr))
204  op = MATOP_CREATE_VECS
205  PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr))
206
207  PetscCallA(MatMult(m, x, y, ierr))
208  PetscCallA(MatMultAdd(m, x, y, z, ierr))
209  PetscCallA(MatMultTranspose(m, x, y, ierr))
210  PetscCallA(MatMultHermitianTranspose(m, x, y, ierr))
211  PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr))
212  PetscCallA(MatMultHermitianTransposeAdd(m, x, y, z, ierr))
213  PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr))
214  PetscCallA(MatGetDiagonal(m, x, ierr))
215  PetscCallA(MatDiagonalScale(m, x, y, ierr))
216  PetscCallA(MatZeroEntries(m, ierr))
217  a = 102.
218  PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr))
219  PetscCallA(MatShift(m, a, ierr))
220  PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr))
221  PetscCallA(MatView(m, viewer, ierr))
222  PetscCallA(MatCreateVecs(m, x, y, ierr))
223  PetscCallA(MatDestroy(m, ierr))
224  PetscCallA(MatDestroy(mt, ierr))
225  PetscCallA(VecDestroy(x, ierr))
226  PetscCallA(VecDestroy(y, ierr))
227  PetscCallA(VecDestroy(z, ierr))
228
229  PetscCallA(PetscFinalize(ierr))
230end
231
232!/*TEST
233!
234!   testset:
235!     args: -malloc_dump
236!     filter: sort -b
237!     filter_output: sort -b
238!     test:
239!       suffix: 1
240!       requires: !complex
241!     test:
242!       suffix: 2
243!       requires: complex
244!
245!TEST*/
246