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 9 10 Mat A 11 Vec x, y 12 PetscErrorCode ierr 13 14 print *, 'Called MatMult' 15 end 16 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 23 24 print *, 'Called MatMultAdd' 25 end 26 27 subroutine mymatmulttranspose(A, x, y, ierr) 28 use petscmat 29 implicit none 30 Mat A 31 Vec x, y 32 PetscErrorCode ierr 33 34 print *, 'Called MatMultTranspose' 35 end 36 37 subroutine mymatmulthermitiantranspose(A, x, y, ierr) 38 use petscmat 39 implicit none 40 Mat A 41 Vec x, y 42 PetscErrorCode ierr 43 44 print *, 'Called MatMultHermitianTranspose' 45 end 46 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 53 54 print *, 'Called MatMultTransposeAdd' 55 end 56 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 63 64 print *, 'Called MatMultHermitianTransposeAdd' 65 end 66 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 74 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)) 80 81 print *, 'Called MatTranspose' 82 end 83 84 subroutine mymatgetdiagonal(A, x, ierr) 85 use petscmat 86 implicit none 87 Mat A 88 Vec x 89 PetscErrorCode ierr 90 91 print *, 'Called MatGetDiagonal' 92 end 93 94 subroutine mymatdiagonalscale(A, x, y, ierr) 95 use petscmat 96 implicit none 97 Mat A 98 Vec x, y 99 PetscErrorCode ierr 100 101 print *, 'Called MatDiagonalScale' 102 end 103 104 subroutine mymatzeroentries(A, ierr) 105 use petscmat 106 implicit none 107 Mat A 108 PetscErrorCode ierr 109 110 print *, 'Called MatZeroEntries' 111 end 112 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 120 121 print *, 'Called MatAXPY' 122 end 123 124 subroutine mymatshift(A, alpha, ierr) 125 use petscmat 126 implicit none 127 Mat A 128 PetscScalar alpha 129 PetscErrorCode ierr 130 131 print *, 'Called MatShift' 132 end 133 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 141 142 print *, 'Called MatDiagonalSet' 143 end 144 145 subroutine mymatdestroy(A, ierr) 146 use petscmat 147 implicit none 148 Mat A 149 PetscErrorCode ierr 150 151 print *, 'Called MatDestroy' 152 end 153 154 subroutine mymatview(A, viewer, ierr) 155 use petscmat 156 implicit none 157 Mat A 158 PetscViewer viewer 159 PetscErrorCode ierr 160 161 print *, 'Called MatView' 162 end 163 164 subroutine mymatgetvecs(A, x, y, ierr) 165 use petscmat 166 implicit none 167 Mat A 168 Vec x, y 169 PetscErrorCode ierr 170 171 print *, 'Called MatCreateVecs' 172 end 173 174 program main 175 use petscmat 176 implicit none 177 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 201 202 PetscCallA(PetscInitialize(ierr)) 203 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)) 214 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)) 247 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)) 269 270 PetscCallA(PetscFinalize(ierr)) 271 end 272 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*/ 287