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 mymatmulttransposeadd(A, x, y, z, ierr) 41 use petscmat 42 implicit none 43 Mat A 44 Vec x, y, z 45 PetscErrorCode ierr 46 47 print*, 'Called MatMultTransposeAdd' 48 return 49 end 50 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 58 59 i12 = 12 60 i0 = 0 61 PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,B,ierr)) 62 PetscCallA(MatAssemblyBegin(B, MAT_FINAL_ASSEMBLY, ierr)) 63 PetscCallA(MatAssemblyEnd(B, MAT_FINAL_ASSEMBLY, ierr)) 64 65 print*, 'Called MatTranspose' 66 return 67 end 68 69 subroutine mymatgetdiagonal(A, x, ierr) 70 use petscmat 71 implicit none 72 Mat A 73 Vec x 74 PetscErrorCode ierr 75 76 print*, 'Called MatGetDiagonal' 77 return 78 end 79 80 subroutine mymatdiagonalscale(A, x, y, ierr) 81 use petscmat 82 implicit none 83 Mat A 84 Vec x, y 85 PetscErrorCode ierr 86 87 print*, 'Called MatDiagonalScale' 88 return 89 end 90 91 subroutine mymatzeroentries(A, ierr) 92 use petscmat 93 implicit none 94 Mat A 95 PetscErrorCode ierr 96 97 print*, 'Called MatZeroEntries' 98 return 99 end 100 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 108 109 print*, 'Called MatAXPY' 110 return 111 end 112 113 subroutine mymatshift(A, alpha, ierr) 114 use petscmat 115 implicit none 116 Mat A 117 PetscScalar alpha 118 PetscErrorCode ierr 119 120 print*, 'Called MatShift' 121 return 122 end 123 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 131 132 print*, 'Called MatDiagonalSet' 133 return 134 end 135 136 subroutine mymatdestroy(A, ierr) 137 use petscmat 138 implicit none 139 Mat A 140 PetscErrorCode ierr 141 142 print*, 'Called MatDestroy' 143 return 144 end 145 146 subroutine mymatview(A, viewer, ierr) 147 use petscmat 148 implicit none 149 Mat A 150 PetscViewer viewer 151 PetscErrorCode ierr 152 153 print*, 'Called MatView' 154 return 155 end 156 157 subroutine mymatgetvecs(A, x, y, ierr) 158 use petscmat 159 implicit none 160 Mat A 161 Vec x, y 162 PetscErrorCode ierr 163 164 print*, 'Called MatCreateVecs' 165 return 166 end 167 168 program main 169 use petscmat 170 implicit none 171 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 193 194 PetscCallA(PetscInitialize(ierr)) 195 196 viewer = PETSC_VIEWER_STDOUT_SELF 197 i12 = 12 198 i0 = 0 199 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, x, ierr)) 200 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, y, ierr)) 201 PetscCallA(VecCreateSeq(PETSC_COMM_SELF, i12, z, ierr)) 202 PetscCallA(MatCreateShell(PETSC_COMM_SELF,i12,i12,i12,i12,i0,m,ierr)) 203 PetscCallA(MatShellSetManageScalingShifts(m,ierr)) 204 PetscCallA(MatAssemblyBegin(m, MAT_FINAL_ASSEMBLY, ierr)) 205 PetscCallA(MatAssemblyEnd(m, MAT_FINAL_ASSEMBLY, ierr)) 206 207 op = MATOP_MULT 208 PetscCallA(MatShellSetOperation(m, op, mymatmult, ierr)) 209 op = MATOP_MULT_ADD 210 PetscCallA(MatShellSetOperation(m, op, mymatmultadd, ierr)) 211 op = MATOP_MULT_TRANSPOSE 212 PetscCallA(MatShellSetOperation(m, op, mymatmulttranspose, ierr)) 213 op = MATOP_MULT_TRANSPOSE_ADD 214 PetscCallA(MatShellSetOperation(m, op, mymatmulttransposeadd, ierr)) 215 op = MATOP_TRANSPOSE 216 PetscCallA(MatShellSetOperation(m, op, mymattranspose, ierr)) 217 op = MATOP_GET_DIAGONAL 218 PetscCallA(MatShellSetOperation(m, op, mymatgetdiagonal, ierr)) 219 op = MATOP_DIAGONAL_SCALE 220 PetscCallA(MatShellSetOperation(m, op, mymatdiagonalscale, ierr)) 221 op = MATOP_ZERO_ENTRIES 222 PetscCallA(MatShellSetOperation(m, op, mymatzeroentries, ierr)) 223 op = MATOP_AXPY 224 PetscCallA(MatShellSetOperation(m, op, mymataxpy, ierr)) 225 op = MATOP_SHIFT 226 PetscCallA(MatShellSetOperation(m, op, mymatshift, ierr)) 227 op = MATOP_DIAGONAL_SET 228 PetscCallA(MatShellSetOperation(m, op, mymatdiagonalset, ierr)) 229 op = MATOP_DESTROY 230 PetscCallA(MatShellSetOperation(m, op, mymatdestroy, ierr)) 231 op = MATOP_VIEW 232 PetscCallA(MatShellSetOperation(m, op, mymatview, ierr)) 233 op = MATOP_CREATE_VECS 234 PetscCallA(MatShellSetOperation(m, op, mymatgetvecs, ierr)) 235 236 PetscCallA(MatMult(m, x, y, ierr)) 237 PetscCallA(MatMultAdd(m, x, y, z, ierr)) 238 PetscCallA(MatMultTranspose(m, x, y, ierr)) 239 PetscCallA(MatMultTransposeAdd(m, x, y, z, ierr)) 240 PetscCallA(MatTranspose(m, MAT_INITIAL_MATRIX, mt, ierr)) 241 PetscCallA(MatGetDiagonal(m, x, ierr)) 242 PetscCallA(MatDiagonalScale(m, x, y, ierr)) 243 PetscCallA(MatZeroEntries(m, ierr)) 244 a = 102. 245 PetscCallA(MatAXPY(m, a, mt, SAME_NONZERO_PATTERN, ierr)) 246 PetscCallA(MatShift(m, a, ierr)) 247 PetscCallA(MatDiagonalSet(m, x, INSERT_VALUES, ierr)) 248 PetscCallA(MatView(m, viewer, ierr)) 249 PetscCallA(MatCreateVecs(m, x, y, ierr)) 250 PetscCallA(MatDestroy(m,ierr)) 251 PetscCallA(MatDestroy(mt, ierr)) 252 PetscCallA(VecDestroy(x, ierr)) 253 PetscCallA(VecDestroy(y, ierr)) 254 PetscCallA(VecDestroy(z, ierr)) 255 256 PetscCallA(PetscFinalize(ierr)) 257 end 258 259!/*TEST 260! 261! test: 262! args: -malloc_dump 263! filter: sort -b 264! filter_output: sort -b 265! 266!TEST*/ 267