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 return 16 end 17 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 24 25 print*, 'Called MatMultAdd' 26 return 27 end 28 29 subroutine mymatmulttranspose(A, x, y, ierr) 30 use petscmat 31 implicit none 32 Mat A 33 Vec x, y 34 PetscErrorCode ierr 35 36 print*, 'Called MatMultTranspose' 37 return 38 end 39 40 subroutine mymatmulthermitiantranspose(A, x, y, ierr) 41 use petscmat 42 implicit none 43 Mat A 44 Vec x, y 45 PetscErrorCode ierr 46 47 print*, 'Called MatMultHermitianTranspose' 48 return 49 end 50 51 subroutine mymatmulttransposeadd(A, x, y, z, ierr) 52 use petscmat 53 implicit none 54 Mat A 55 Vec x, y, z 56 PetscErrorCode ierr 57 58 print*, 'Called MatMultTransposeAdd' 59 return 60 end 61 62 subroutine mymatmulthermitiantransposeadd(A, x, y, z, ierr) 63 use petscmat 64 implicit none 65 Mat A 66 Vec x, y, z 67 PetscErrorCode ierr 68 69 print*, 'Called MatMultHermitianTransposeAdd' 70 return 71 end 72 73 subroutine mymattranspose(A, reuse, B, ierr) 74 use petscmat 75 implicit none 76 Mat A, B 77 MatReuse reuse 78 PetscErrorCode ierr 79 PetscInt i12,i0 80 81 i12 = 12 82 i0 = 0 83 PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr)) 84 PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr)) 85 PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr)) 86 87 print*, 'Called MatTranspose' 88 return 89 end 90 91 subroutine mymatgetdiagonal(A, x, ierr) 92 use petscmat 93 implicit none 94 Mat A 95 Vec x 96 PetscErrorCode ierr 97 98 print*, 'Called MatGetDiagonal' 99 return 100 end 101 102 subroutine mymatdiagonalscale(A, x, y, ierr) 103 use petscmat 104 implicit none 105 Mat A 106 Vec x, y 107 PetscErrorCode ierr 108 109 print*, 'Called MatDiagonalScale' 110 return 111 end 112 113 subroutine mymatzeroentries(A, ierr) 114 use petscmat 115 implicit none 116 Mat A 117 PetscErrorCode ierr 118 119 print*, 'Called MatZeroEntries' 120 return 121 end 122 123 subroutine mymataxpy(A, alpha, B, str, ierr) 124 use petscmat 125 implicit none 126 Mat A, B 127 PetscScalar alpha 128 MatStructure str 129 PetscErrorCode ierr 130 131 print*, 'Called MatAXPY' 132 return 133 end 134 135 subroutine mymatshift(A, alpha, ierr) 136 use petscmat 137 implicit none 138 Mat A 139 PetscScalar alpha 140 PetscErrorCode ierr 141 142 print*, 'Called MatShift' 143 return 144 end 145 146 subroutine mymatdiagonalset(A, x, ins, ierr) 147 use petscmat 148 implicit none 149 Mat A 150 Vec x 151 InsertMode ins 152 PetscErrorCode ierr 153 154 print*, 'Called MatDiagonalSet' 155 return 156 end 157 158 subroutine mymatdestroy(A, ierr) 159 use petscmat 160 implicit none 161 Mat A 162 PetscErrorCode ierr 163 164 print*, 'Called MatDestroy' 165 return 166 end 167 168 subroutine mymatview(A, viewer, ierr) 169 use petscmat 170 implicit none 171 Mat A 172 PetscViewer viewer 173 PetscErrorCode ierr 174 175 print*, 'Called MatView' 176 return 177 end 178 179 subroutine mymatgetvecs(A, x, y, ierr) 180 use petscmat 181 implicit none 182 Mat A 183 Vec x, y 184 PetscErrorCode ierr 185 186 print*, 'Called MatCreateVecs' 187 return 188 end 189 190 program main 191 use petscmat 192 implicit none 193 194 Mat m, mt 195 Vec x, y, z 196 PetscScalar a 197 PetscViewer viewer 198 MatOperation op 199 PetscErrorCode ierr 200 PetscInt i12,i0 201 external mymatmult 202 external mymatmultadd 203 external mymatmulttranspose 204 external mymatmulthermitiantranspose 205 external mymatmulttransposeadd 206 external mymatmulthermitiantransposeadd 207 external mymattranspose 208 external mymatgetdiagonal 209 external mymatdiagonalscale 210 external mymatzeroentries 211 external mymataxpy 212 external mymatshift 213 external mymatdiagonalset 214 external mymatdestroy 215 external mymatview 216 external mymatgetvecs 217 218 PetscCallA(PetscInitialize(ierr)) 219 220 viewer = PETSC_VIEWER_STDOUT_SELF 221 i12 = 12 222 i0 = 0 223 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr)) 224 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr)) 225 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr)) 226 PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr)) 227 PetscCallA(MatShellSetManageScalingShifts(m,ierr)) 228 PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr)) 229 PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr)) 230 231 op = MATOP_MULT 232 PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr)) 233 op = MATOP_MULT_ADD 234 PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr)) 235 op = MATOP_MULT_TRANSPOSE 236 PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr)) 237 op = MATOP_MULT_HERMITIAN_TRANSPOSE 238 PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantranspose, ierr)) 239 op = MATOP_MULT_TRANSPOSE_ADD 240 PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr)) 241 op = MATOP_MULT_HERMITIAN_TRANS_ADD 242 PetscCallA(MatShellSetOperation(m, op, mymatmulthermitiantransposeadd, ierr)) 243 op = MATOP_TRANSPOSE 244 PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr)) 245 op = MATOP_GET_DIAGONAL 246 PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr)) 247 op = MATOP_DIAGONAL_SCALE 248 PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr)) 249 op = MATOP_ZERO_ENTRIES 250 PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr)) 251 op = MATOP_AXPY 252 PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr)) 253 op = MATOP_SHIFT 254 PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr)) 255 op = MATOP_DIAGONAL_SET 256 PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr)) 257 op = MATOP_DESTROY 258 PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr)) 259 op = MATOP_VIEW 260 PetscCallA(MatShellSetOperation(m, op, mymatview, ierr)) 261 op = MATOP_CREATE_VECS 262 PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr)) 263 264 PetscCallA(MatMult(m, x, y, ierr)) 265 PetscCallA(MatMultAdd(m, x, y, z, ierr)) 266 PetscCallA(MatMultTranspose(m, x, y, ierr)) 267 PetscCallA(MatMultHermitianTranspose(m, x, y, ierr)) 268 PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr)) 269 PetscCallA(MatMultHermitianTransposeAdd(m, x, y, z, ierr)) 270 PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr)) 271 PetscCallA(MatGetDiagonal(m, x, ierr)) 272 PetscCallA(MatDiagonalScale(m, x, y, ierr)) 273 PetscCallA(MatZeroEntries(m, ierr)) 274 a = 102. 275 PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr)) 276 PetscCallA(MatShift(m, a, ierr)) 277 PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr)) 278 PetscCallA(MatView(m, viewer, ierr)) 279 PetscCallA(MatCreateVecs(m, x, y, ierr)) 280 PetscCallA(MatDestroy(m,ierr)) 281 PetscCallA(MatDestroy(mt, ierr)) 282 PetscCallA(VecDestroy(x, ierr)) 283 PetscCallA(VecDestroy(y, ierr)) 284 PetscCallA(VecDestroy(z, ierr)) 285 286 PetscCallA(PetscFinalize(ierr)) 287 end 288 289!/*TEST 290! 291! testset: 292! args: -malloc_dump 293! filter: sort -b 294! filter_output: sort -b 295! test: 296! suffix: 1 297! requires: !complex 298! test: 299! suffix: 2 300! requires: complex 301! 302!TEST*/ 303