1 2 /* 3 This provides a simple shell for Fortran (and C programmers) to 4 create a very simple matrix class for use with KSP without coding 5 much of anything. 6 */ 7 8 #include <petsc/private/matimpl.h> /*I "petscmat.h" I*/ 9 10 struct _MatShellOps { 11 /* 0 */ 12 PetscErrorCode (*mult)(Mat,Vec,Vec); 13 /* 5 */ 14 PetscErrorCode (*multtranspose)(Mat,Vec,Vec); 15 /* 10 */ 16 /* 15 */ 17 PetscErrorCode (*getdiagonal)(Mat,Vec); 18 /* 20 */ 19 /* 24 */ 20 /* 29 */ 21 /* 34 */ 22 /* 39 */ 23 PetscErrorCode (*axpy)(Mat,PetscScalar,Mat,MatStructure); 24 PetscErrorCode (*copy)(Mat,Mat,MatStructure); 25 /* 44 */ 26 PetscErrorCode (*diagonalset)(Mat,Vec,InsertMode); 27 /* 49 */ 28 /* 54 */ 29 /* 59 */ 30 PetscErrorCode (*destroy)(Mat); 31 /* 64 */ 32 /* 69 */ 33 /* 74 */ 34 /* 79 */ 35 /* 84 */ 36 /* 89 */ 37 /* 94 */ 38 /* 99 */ 39 /* 104 */ 40 /* 109 */ 41 /* 114 */ 42 /* 119 */ 43 /* 124 */ 44 /* 129 */ 45 /* 134 */ 46 /* 139 */ 47 /* 144 */ 48 }; 49 50 typedef struct { 51 struct _MatShellOps ops[1]; 52 53 PetscScalar vscale,vshift; 54 Vec dshift; 55 Vec left,right; 56 Vec left_work,right_work; 57 Vec left_add_work,right_add_work; 58 Mat axpy; 59 PetscScalar axpy_vscale; 60 PetscBool managescalingshifts; /* The user will manage the scaling and shifts for the MATSHELL, not the default */ 61 void *ctx; 62 } Mat_Shell; 63 64 /* 65 xx = diag(left)*x 66 */ 67 static PetscErrorCode MatShellPreScaleLeft(Mat A,Vec x,Vec *xx) 68 { 69 Mat_Shell *shell = (Mat_Shell*)A->data; 70 PetscErrorCode ierr; 71 72 PetscFunctionBegin; 73 *xx = NULL; 74 if (!shell->left) { 75 *xx = x; 76 } else { 77 if (!shell->left_work) {ierr = VecDuplicate(shell->left,&shell->left_work);CHKERRQ(ierr);} 78 ierr = VecPointwiseMult(shell->left_work,x,shell->left);CHKERRQ(ierr); 79 *xx = shell->left_work; 80 } 81 PetscFunctionReturn(0); 82 } 83 84 /* 85 xx = diag(right)*x 86 */ 87 static PetscErrorCode MatShellPreScaleRight(Mat A,Vec x,Vec *xx) 88 { 89 Mat_Shell *shell = (Mat_Shell*)A->data; 90 PetscErrorCode ierr; 91 92 PetscFunctionBegin; 93 *xx = NULL; 94 if (!shell->right) { 95 *xx = x; 96 } else { 97 if (!shell->right_work) {ierr = VecDuplicate(shell->right,&shell->right_work);CHKERRQ(ierr);} 98 ierr = VecPointwiseMult(shell->right_work,x,shell->right);CHKERRQ(ierr); 99 *xx = shell->right_work; 100 } 101 PetscFunctionReturn(0); 102 } 103 104 /* 105 x = diag(left)*x 106 */ 107 static PetscErrorCode MatShellPostScaleLeft(Mat A,Vec x) 108 { 109 Mat_Shell *shell = (Mat_Shell*)A->data; 110 PetscErrorCode ierr; 111 112 PetscFunctionBegin; 113 if (shell->left) {ierr = VecPointwiseMult(x,x,shell->left);CHKERRQ(ierr);} 114 PetscFunctionReturn(0); 115 } 116 117 /* 118 x = diag(right)*x 119 */ 120 static PetscErrorCode MatShellPostScaleRight(Mat A,Vec x) 121 { 122 Mat_Shell *shell = (Mat_Shell*)A->data; 123 PetscErrorCode ierr; 124 125 PetscFunctionBegin; 126 if (shell->right) {ierr = VecPointwiseMult(x,x,shell->right);CHKERRQ(ierr);} 127 PetscFunctionReturn(0); 128 } 129 130 /* 131 Y = vscale*Y + diag(dshift)*X + vshift*X 132 133 On input Y already contains A*x 134 */ 135 static PetscErrorCode MatShellShiftAndScale(Mat A,Vec X,Vec Y) 136 { 137 Mat_Shell *shell = (Mat_Shell*)A->data; 138 PetscErrorCode ierr; 139 140 PetscFunctionBegin; 141 if (shell->dshift) { /* get arrays because there is no VecPointwiseMultAdd() */ 142 PetscInt i,m; 143 const PetscScalar *x,*d; 144 PetscScalar *y; 145 ierr = VecGetLocalSize(X,&m);CHKERRQ(ierr); 146 ierr = VecGetArrayRead(shell->dshift,&d);CHKERRQ(ierr); 147 ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr); 148 ierr = VecGetArray(Y,&y);CHKERRQ(ierr); 149 for (i=0; i<m; i++) y[i] = shell->vscale*y[i] + d[i]*x[i]; 150 ierr = VecRestoreArrayRead(shell->dshift,&d);CHKERRQ(ierr); 151 ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr); 152 ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr); 153 } else { 154 ierr = VecScale(Y,shell->vscale);CHKERRQ(ierr); 155 } 156 if (shell->vshift != 0.0) {ierr = VecAXPY(Y,shell->vshift,X);CHKERRQ(ierr);} /* if test is for non-square matrices */ 157 PetscFunctionReturn(0); 158 } 159 160 /*@ 161 MatShellGetContext - Returns the user-provided context associated with a shell matrix. 162 163 Not Collective 164 165 Input Parameter: 166 . mat - the matrix, should have been created with MatCreateShell() 167 168 Output Parameter: 169 . ctx - the user provided context 170 171 Level: advanced 172 173 Fortran Notes: To use this from Fortran you must write a Fortran interface definition for this 174 function that tells Fortran the Fortran derived data type that you are passing in as the ctx argument. 175 176 .keywords: matrix, shell, get, context 177 178 .seealso: MatCreateShell(), MatShellSetOperation(), MatShellSetContext() 179 @*/ 180 PetscErrorCode MatShellGetContext(Mat mat,void *ctx) 181 { 182 PetscErrorCode ierr; 183 PetscBool flg; 184 185 PetscFunctionBegin; 186 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 187 PetscValidPointer(ctx,2); 188 ierr = PetscObjectTypeCompare((PetscObject)mat,MATSHELL,&flg);CHKERRQ(ierr); 189 if (flg) *(void**)ctx = ((Mat_Shell*)(mat->data))->ctx; 190 else SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get context from non-shell matrix"); 191 PetscFunctionReturn(0); 192 } 193 194 PetscErrorCode MatDestroy_Shell(Mat mat) 195 { 196 PetscErrorCode ierr; 197 Mat_Shell *shell = (Mat_Shell*)mat->data; 198 199 PetscFunctionBegin; 200 if (shell->ops->destroy) { 201 ierr = (*shell->ops->destroy)(mat);CHKERRQ(ierr); 202 } 203 ierr = VecDestroy(&shell->left);CHKERRQ(ierr); 204 ierr = VecDestroy(&shell->right);CHKERRQ(ierr); 205 ierr = VecDestroy(&shell->dshift);CHKERRQ(ierr); 206 ierr = VecDestroy(&shell->left_work);CHKERRQ(ierr); 207 ierr = VecDestroy(&shell->right_work);CHKERRQ(ierr); 208 ierr = VecDestroy(&shell->left_add_work);CHKERRQ(ierr); 209 ierr = VecDestroy(&shell->right_add_work);CHKERRQ(ierr); 210 ierr = MatDestroy(&shell->axpy);CHKERRQ(ierr); 211 ierr = PetscFree(mat->data);CHKERRQ(ierr); 212 PetscFunctionReturn(0); 213 } 214 215 PetscErrorCode MatCopy_Shell(Mat A,Mat B,MatStructure str) 216 { 217 Mat_Shell *shellA = (Mat_Shell*)A->data,*shellB = (Mat_Shell*)B->data; 218 PetscErrorCode ierr; 219 PetscBool matflg; 220 221 PetscFunctionBegin; 222 ierr = PetscObjectTypeCompare((PetscObject)B,MATSHELL,&matflg);CHKERRQ(ierr); 223 if (!matflg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_NOTSAMETYPE,"Output matrix must be a MATSHELL"); 224 225 ierr = PetscMemcpy(B->ops,A->ops,sizeof(struct _MatOps));CHKERRQ(ierr); 226 ierr = PetscMemcpy(shellB->ops,shellA->ops,sizeof(struct _MatShellOps));CHKERRQ(ierr); 227 228 if (shellA->ops->copy) { 229 ierr = (*shellA->ops->copy)(A,B,str);CHKERRQ(ierr); 230 } 231 shellB->vscale = shellA->vscale; 232 shellB->vshift = shellA->vshift; 233 if (shellA->dshift) { 234 if (!shellB->dshift) { 235 ierr = VecDuplicate(shellA->dshift,&shellB->dshift);CHKERRQ(ierr); 236 } 237 ierr = VecCopy(shellA->dshift,shellB->dshift);CHKERRQ(ierr); 238 } else { 239 ierr = VecDestroy(&shellB->dshift);CHKERRQ(ierr); 240 } 241 if (shellA->left) { 242 if (!shellB->left) { 243 ierr = VecDuplicate(shellA->left,&shellB->left);CHKERRQ(ierr); 244 } 245 ierr = VecCopy(shellA->left,shellB->left);CHKERRQ(ierr); 246 } else { 247 ierr = VecDestroy(&shellB->left);CHKERRQ(ierr); 248 } 249 if (shellA->right) { 250 if (!shellB->right) { 251 ierr = VecDuplicate(shellA->right,&shellB->right);CHKERRQ(ierr); 252 } 253 ierr = VecCopy(shellA->right,shellB->right);CHKERRQ(ierr); 254 } else { 255 ierr = VecDestroy(&shellB->right);CHKERRQ(ierr); 256 } 257 ierr = MatDestroy(&shellB->axpy);CHKERRQ(ierr); 258 if (shellA->axpy) { 259 ierr = PetscObjectReference((PetscObject)shellA->axpy);CHKERRQ(ierr); 260 shellB->axpy = shellA->axpy; 261 shellB->axpy_vscale = shellA->axpy_vscale; 262 } 263 PetscFunctionReturn(0); 264 } 265 266 PetscErrorCode MatDuplicate_Shell(Mat mat,MatDuplicateOption op,Mat *M) 267 { 268 PetscErrorCode ierr; 269 void *ctx; 270 271 PetscFunctionBegin; 272 ierr = MatShellGetContext(mat,&ctx);CHKERRQ(ierr); 273 ierr = MatCreateShell(PetscObjectComm((PetscObject)mat),mat->rmap->n,mat->cmap->n,mat->rmap->N,mat->cmap->N,ctx,M);CHKERRQ(ierr); 274 ierr = MatCopy(mat,*M,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 275 PetscFunctionReturn(0); 276 } 277 278 PetscErrorCode MatMult_Shell(Mat A,Vec x,Vec y) 279 { 280 Mat_Shell *shell = (Mat_Shell*)A->data; 281 PetscErrorCode ierr; 282 Vec xx; 283 PetscObjectState instate,outstate; 284 285 PetscFunctionBegin; 286 ierr = MatShellPreScaleRight(A,x,&xx);CHKERRQ(ierr); 287 ierr = PetscObjectStateGet((PetscObject)y, &instate);CHKERRQ(ierr); 288 ierr = (*shell->ops->mult)(A,xx,y);CHKERRQ(ierr); 289 ierr = PetscObjectStateGet((PetscObject)y, &outstate);CHKERRQ(ierr); 290 if (instate == outstate) { 291 /* increase the state of the output vector since the user did not update its state themself as should have been done */ 292 ierr = PetscObjectStateIncrease((PetscObject)y);CHKERRQ(ierr); 293 } 294 ierr = MatShellShiftAndScale(A,xx,y);CHKERRQ(ierr); 295 ierr = MatShellPostScaleLeft(A,y);CHKERRQ(ierr); 296 297 if (shell->axpy) { 298 if (!shell->left_work) {ierr = MatCreateVecs(A,&shell->left_work,NULL);CHKERRQ(ierr);} 299 ierr = MatMult(shell->axpy,x,shell->left_work);CHKERRQ(ierr); 300 ierr = VecAXPY(y,shell->axpy_vscale,shell->left_work);CHKERRQ(ierr); 301 } 302 PetscFunctionReturn(0); 303 } 304 305 PetscErrorCode MatMultAdd_Shell(Mat A,Vec x,Vec y,Vec z) 306 { 307 Mat_Shell *shell = (Mat_Shell*)A->data; 308 PetscErrorCode ierr; 309 310 PetscFunctionBegin; 311 if (y == z) { 312 if (!shell->right_add_work) {ierr = VecDuplicate(z,&shell->right_add_work);CHKERRQ(ierr);} 313 ierr = MatMult(A,x,shell->right_add_work);CHKERRQ(ierr); 314 ierr = VecAXPY(z,1.0,shell->right_add_work);CHKERRQ(ierr); 315 } else { 316 ierr = MatMult(A,x,z);CHKERRQ(ierr); 317 ierr = VecAXPY(z,1.0,y);CHKERRQ(ierr); 318 } 319 PetscFunctionReturn(0); 320 } 321 322 PetscErrorCode MatMultTranspose_Shell(Mat A,Vec x,Vec y) 323 { 324 Mat_Shell *shell = (Mat_Shell*)A->data; 325 PetscErrorCode ierr; 326 Vec xx; 327 PetscObjectState instate,outstate; 328 329 PetscFunctionBegin; 330 ierr = MatShellPreScaleLeft(A,x,&xx);CHKERRQ(ierr); 331 ierr = PetscObjectStateGet((PetscObject)y, &instate);CHKERRQ(ierr); 332 if (!shell->ops->multtranspose) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONGSTATE,"Have not provided a MatMultTranspose() for this MATSHELL"); 333 ierr = (*shell->ops->multtranspose)(A,xx,y);CHKERRQ(ierr); 334 ierr = PetscObjectStateGet((PetscObject)y, &outstate);CHKERRQ(ierr); 335 if (instate == outstate) { 336 /* increase the state of the output vector since the user did not update its state themself as should have been done */ 337 ierr = PetscObjectStateIncrease((PetscObject)y);CHKERRQ(ierr); 338 } 339 ierr = MatShellShiftAndScale(A,xx,y);CHKERRQ(ierr); 340 ierr = MatShellPostScaleRight(A,y);CHKERRQ(ierr); 341 PetscFunctionReturn(0); 342 } 343 344 PetscErrorCode MatMultTransposeAdd_Shell(Mat A,Vec x,Vec y,Vec z) 345 { 346 Mat_Shell *shell = (Mat_Shell*)A->data; 347 PetscErrorCode ierr; 348 349 PetscFunctionBegin; 350 if (y == z) { 351 if (!shell->left_add_work) {ierr = VecDuplicate(z,&shell->left_add_work);CHKERRQ(ierr);} 352 ierr = MatMultTranspose(A,x,shell->left_add_work);CHKERRQ(ierr); 353 ierr = VecWAXPY(z,1.0,shell->left_add_work,y);CHKERRQ(ierr); 354 } else { 355 ierr = MatMultTranspose(A,x,z);CHKERRQ(ierr); 356 ierr = VecAXPY(z,1.0,y);CHKERRQ(ierr); 357 } 358 PetscFunctionReturn(0); 359 } 360 361 /* 362 diag(left)(vscale*A + diag(dshift) + vshift I)diag(right) 363 */ 364 PetscErrorCode MatGetDiagonal_Shell(Mat A,Vec v) 365 { 366 Mat_Shell *shell = (Mat_Shell*)A->data; 367 PetscErrorCode ierr; 368 369 PetscFunctionBegin; 370 if (shell->ops->getdiagonal) { 371 ierr = (*shell->ops->getdiagonal)(A,v);CHKERRQ(ierr); 372 } else { 373 ierr = VecSet(v,0.0);CHKERRQ(ierr); 374 } 375 ierr = VecScale(v,shell->vscale);CHKERRQ(ierr); 376 if (shell->dshift) { 377 ierr = VecAXPY(v,1.0,shell->dshift);CHKERRQ(ierr); 378 } 379 ierr = VecShift(v,shell->vshift);CHKERRQ(ierr); 380 if (shell->left) {ierr = VecPointwiseMult(v,v,shell->left);CHKERRQ(ierr);} 381 if (shell->right) {ierr = VecPointwiseMult(v,v,shell->right);CHKERRQ(ierr);} 382 if (shell->axpy) { 383 if (!shell->left_work) {ierr = VecDuplicate(v,&shell->left_work);CHKERRQ(ierr);} 384 ierr = MatGetDiagonal(shell->axpy,shell->left_work);CHKERRQ(ierr); 385 ierr = VecAXPY(v,shell->axpy_vscale,shell->left_work);CHKERRQ(ierr); 386 } 387 PetscFunctionReturn(0); 388 } 389 390 PetscErrorCode MatShift_Shell(Mat Y,PetscScalar a) 391 { 392 Mat_Shell *shell = (Mat_Shell*)Y->data; 393 PetscErrorCode ierr; 394 395 PetscFunctionBegin; 396 if (shell->left || shell->right) { 397 if (!shell->dshift) { 398 ierr = VecDuplicate(shell->left ? shell->left : shell->right, &shell->dshift);CHKERRQ(ierr); 399 ierr = VecSet(shell->dshift,a);CHKERRQ(ierr); 400 } else { 401 if (shell->left) {ierr = VecPointwiseMult(shell->dshift,shell->dshift,shell->left);CHKERRQ(ierr);} 402 if (shell->right) {ierr = VecPointwiseMult(shell->dshift,shell->dshift,shell->right);CHKERRQ(ierr);} 403 ierr = VecShift(shell->dshift,a);CHKERRQ(ierr); 404 } 405 if (shell->left) {ierr = VecPointwiseDivide(shell->dshift,shell->dshift,shell->left);CHKERRQ(ierr);} 406 if (shell->right) {ierr = VecPointwiseDivide(shell->dshift,shell->dshift,shell->right);CHKERRQ(ierr);} 407 } else shell->vshift += a; 408 PetscFunctionReturn(0); 409 } 410 411 PetscErrorCode MatDiagonalSet_Shell(Mat A,Vec D,InsertMode ins) 412 { 413 Mat_Shell *shell = (Mat_Shell*)A->data; 414 PetscErrorCode ierr; 415 416 PetscFunctionBegin; 417 if (ins == INSERT_VALUES) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONGSTATE, "Operation not supported with INSERT_VALUES"); 418 if (!shell->dshift) {ierr = VecDuplicate(D,&shell->dshift);CHKERRQ(ierr);} 419 if (shell->left || shell->right) { 420 if (!shell->right_work) {ierr = VecDuplicate(shell->left ? shell->left : shell->right, &shell->right_work);CHKERRQ(ierr);} 421 if (shell->left && shell->right) { 422 ierr = VecPointwiseDivide(shell->right_work,D,shell->left);CHKERRQ(ierr); 423 ierr = VecPointwiseDivide(shell->right_work,shell->right_work,shell->right);CHKERRQ(ierr); 424 } else if (shell->left) { 425 ierr = VecPointwiseDivide(shell->right_work,D,shell->left);CHKERRQ(ierr); 426 } else { 427 ierr = VecPointwiseDivide(shell->right_work,D,shell->right);CHKERRQ(ierr); 428 } 429 if (!shell->dshift) { 430 ierr = VecDuplicate(shell->left ? shell->left : shell->right, &shell->dshift);CHKERRQ(ierr); 431 ierr = VecCopy(shell->dshift,shell->right_work);CHKERRQ(ierr); 432 } else { 433 ierr = VecAXPY(shell->dshift,1.0,shell->right_work);CHKERRQ(ierr); 434 } 435 } else { 436 ierr = VecAXPY(shell->dshift,1.0,D);CHKERRQ(ierr); 437 } 438 PetscFunctionReturn(0); 439 } 440 441 PetscErrorCode MatScale_Shell(Mat Y,PetscScalar a) 442 { 443 Mat_Shell *shell = (Mat_Shell*)Y->data; 444 PetscErrorCode ierr; 445 446 PetscFunctionBegin; 447 shell->vscale *= a; 448 shell->vshift *= a; 449 if (shell->dshift) { 450 ierr = VecScale(shell->dshift,a);CHKERRQ(ierr); 451 } 452 shell->axpy_vscale *= a; 453 PetscFunctionReturn(0); 454 } 455 456 static PetscErrorCode MatDiagonalScale_Shell(Mat Y,Vec left,Vec right) 457 { 458 Mat_Shell *shell = (Mat_Shell*)Y->data; 459 PetscErrorCode ierr; 460 461 PetscFunctionBegin; 462 if (shell->axpy) SETERRQ(PetscObjectComm((PetscObject)Y),PETSC_ERR_SUP,"Cannot diagonal scale MATSHELL after MatAXPY operation"); 463 if (left) { 464 if (!shell->left) { 465 ierr = VecDuplicate(left,&shell->left);CHKERRQ(ierr); 466 ierr = VecCopy(left,shell->left);CHKERRQ(ierr); 467 } else { 468 ierr = VecPointwiseMult(shell->left,shell->left,left);CHKERRQ(ierr); 469 } 470 } 471 if (right) { 472 if (!shell->right) { 473 ierr = VecDuplicate(right,&shell->right);CHKERRQ(ierr); 474 ierr = VecCopy(right,shell->right);CHKERRQ(ierr); 475 } else { 476 ierr = VecPointwiseMult(shell->right,shell->right,right);CHKERRQ(ierr); 477 } 478 } 479 PetscFunctionReturn(0); 480 } 481 482 PetscErrorCode MatAssemblyEnd_Shell(Mat Y,MatAssemblyType t) 483 { 484 Mat_Shell *shell = (Mat_Shell*)Y->data; 485 PetscErrorCode ierr; 486 487 PetscFunctionBegin; 488 if (t == MAT_FINAL_ASSEMBLY) { 489 shell->vshift = 0.0; 490 shell->vscale = 1.0; 491 ierr = VecDestroy(&shell->dshift);CHKERRQ(ierr); 492 ierr = VecDestroy(&shell->left);CHKERRQ(ierr); 493 ierr = VecDestroy(&shell->right);CHKERRQ(ierr); 494 ierr = MatDestroy(&shell->axpy);CHKERRQ(ierr); 495 } 496 PetscFunctionReturn(0); 497 } 498 499 PETSC_INTERN PetscErrorCode MatConvert_Shell(Mat, MatType,MatReuse,Mat*); 500 501 static PetscErrorCode MatMissingDiagonal_Shell(Mat A,PetscBool *missing,PetscInt *d) 502 { 503 PetscFunctionBegin; 504 *missing = PETSC_FALSE; 505 PetscFunctionReturn(0); 506 } 507 508 PetscErrorCode MatAXPY_Shell(Mat Y,PetscScalar a,Mat X,MatStructure str) 509 { 510 Mat_Shell *shell = (Mat_Shell*)Y->data; 511 PetscErrorCode ierr; 512 513 PetscFunctionBegin; 514 ierr = PetscObjectReference((PetscObject)X);CHKERRQ(ierr); 515 ierr = MatDestroy(&shell->axpy);CHKERRQ(ierr); 516 shell->axpy = X; 517 shell->axpy_vscale = a; 518 PetscFunctionReturn(0); 519 } 520 521 static struct _MatOps MatOps_Values = {0, 522 0, 523 0, 524 0, 525 /* 4*/ MatMultAdd_Shell, 526 0, 527 MatMultTransposeAdd_Shell, 528 0, 529 0, 530 0, 531 /*10*/ 0, 532 0, 533 0, 534 0, 535 0, 536 /*15*/ 0, 537 0, 538 MatGetDiagonal_Shell, 539 MatDiagonalScale_Shell, 540 0, 541 /*20*/ 0, 542 MatAssemblyEnd_Shell, 543 0, 544 0, 545 /*24*/ 0, 546 0, 547 0, 548 0, 549 0, 550 /*29*/ 0, 551 0, 552 0, 553 0, 554 0, 555 /*34*/ MatDuplicate_Shell, 556 0, 557 0, 558 0, 559 0, 560 /*39*/ MatAXPY_Shell, 561 0, 562 0, 563 0, 564 MatCopy_Shell, 565 /*44*/ 0, 566 MatScale_Shell, 567 MatShift_Shell, 568 MatDiagonalSet_Shell, 569 0, 570 /*49*/ 0, 571 0, 572 0, 573 0, 574 0, 575 /*54*/ 0, 576 0, 577 0, 578 0, 579 0, 580 /*59*/ 0, 581 MatDestroy_Shell, 582 0, 583 0, 584 0, 585 /*64*/ 0, 586 0, 587 0, 588 0, 589 0, 590 /*69*/ 0, 591 0, 592 MatConvert_Shell, 593 0, 594 0, 595 /*74*/ 0, 596 0, 597 0, 598 0, 599 0, 600 /*79*/ 0, 601 0, 602 0, 603 0, 604 0, 605 /*84*/ 0, 606 0, 607 0, 608 0, 609 0, 610 /*89*/ 0, 611 0, 612 0, 613 0, 614 0, 615 /*94*/ 0, 616 0, 617 0, 618 0, 619 0, 620 /*99*/ 0, 621 0, 622 0, 623 0, 624 0, 625 /*104*/ 0, 626 0, 627 0, 628 0, 629 0, 630 /*109*/ 0, 631 0, 632 0, 633 0, 634 MatMissingDiagonal_Shell, 635 /*114*/ 0, 636 0, 637 0, 638 0, 639 0, 640 /*119*/ 0, 641 0, 642 0, 643 0, 644 0, 645 /*124*/ 0, 646 0, 647 0, 648 0, 649 0, 650 /*129*/ 0, 651 0, 652 0, 653 0, 654 0, 655 /*134*/ 0, 656 0, 657 0, 658 0, 659 0, 660 /*139*/ 0, 661 0, 662 0 663 }; 664 665 /*MC 666 MATSHELL - MATSHELL = "shell" - A matrix type to be used to define your own matrix type -- perhaps matrix free. 667 668 Level: advanced 669 670 .seealso: MatCreateShell() 671 M*/ 672 673 PETSC_EXTERN PetscErrorCode MatCreate_Shell(Mat A) 674 { 675 Mat_Shell *b; 676 PetscErrorCode ierr; 677 678 PetscFunctionBegin; 679 ierr = PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr); 680 681 ierr = PetscNewLog(A,&b);CHKERRQ(ierr); 682 A->data = (void*)b; 683 684 ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr); 685 ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr); 686 687 b->ctx = 0; 688 b->vshift = 0.0; 689 b->vscale = 1.0; 690 b->managescalingshifts = PETSC_TRUE; 691 A->assembled = PETSC_TRUE; 692 A->preallocated = PETSC_FALSE; 693 694 ierr = PetscObjectChangeTypeName((PetscObject)A,MATSHELL);CHKERRQ(ierr); 695 PetscFunctionReturn(0); 696 } 697 698 /*@C 699 MatCreateShell - Creates a new matrix class for use with a user-defined 700 private data storage format. 701 702 Collective on MPI_Comm 703 704 Input Parameters: 705 + comm - MPI communicator 706 . m - number of local rows (must be given) 707 . n - number of local columns (must be given) 708 . M - number of global rows (may be PETSC_DETERMINE) 709 . N - number of global columns (may be PETSC_DETERMINE) 710 - ctx - pointer to data needed by the shell matrix routines 711 712 Output Parameter: 713 . A - the matrix 714 715 Level: advanced 716 717 Usage: 718 $ extern int mult(Mat,Vec,Vec); 719 $ MatCreateShell(comm,m,n,M,N,ctx,&mat); 720 $ MatShellSetOperation(mat,MATOP_MULT,(void(*)(void))mult); 721 $ [ Use matrix for operations that have been set ] 722 $ MatDestroy(mat); 723 724 Notes: 725 The shell matrix type is intended to provide a simple class to use 726 with KSP (such as, for use with matrix-free methods). You should not 727 use the shell type if you plan to define a complete matrix class. 728 729 Fortran Notes: To use this from Fortran with a ctx you must write an interface definition for this 730 function and for MatShellGetContext() that tells Fortran the Fortran derived data type you are passing 731 in as the ctx argument. 732 733 PETSc requires that matrices and vectors being used for certain 734 operations are partitioned accordingly. For example, when 735 creating a shell matrix, A, that supports parallel matrix-vector 736 products using MatMult(A,x,y) the user should set the number 737 of local matrix rows to be the number of local elements of the 738 corresponding result vector, y. Note that this is information is 739 required for use of the matrix interface routines, even though 740 the shell matrix may not actually be physically partitioned. 741 For example, 742 743 $ 744 $ Vec x, y 745 $ extern int mult(Mat,Vec,Vec); 746 $ Mat A 747 $ 748 $ VecCreateMPI(comm,PETSC_DECIDE,M,&y); 749 $ VecCreateMPI(comm,PETSC_DECIDE,N,&x); 750 $ VecGetLocalSize(y,&m); 751 $ VecGetLocalSize(x,&n); 752 $ MatCreateShell(comm,m,n,M,N,ctx,&A); 753 $ MatShellSetOperation(mat,MATOP_MULT,(void(*)(void))mult); 754 $ MatMult(A,x,y); 755 $ MatDestroy(A); 756 $ VecDestroy(y); VecDestroy(x); 757 $ 758 759 760 MATSHELL handles MatShift(), MatDiagonalSet(), MatDiagonalScale(), MatAXPY(), and MatScale() internally so these 761 operations cannot be overwritten unless MatShellSetManageScalingShifts() is called. 762 763 764 For rectangular matrices do all the scalings and shifts make sense? 765 766 Developers Notes: Regarding shifting and scaling. The general form is 767 768 diag(left)(vscale*A + diag(dshift) + vshift I)diag(right) 769 770 The order you apply the operations is important. For example if you have a dshift then 771 apply a MatScale(s) you get s*vscale*A + s*diag(shift). But if you first scale and then shift 772 you get s*vscale*A + diag(shift) 773 774 A is the user provided function. 775 776 .keywords: matrix, shell, create 777 778 .seealso: MatShellSetOperation(), MatHasOperation(), MatShellGetContext(), MatShellSetContext(), MATSHELL, MatShellSetManageScalingShifts() 779 @*/ 780 PetscErrorCode MatCreateShell(MPI_Comm comm,PetscInt m,PetscInt n,PetscInt M,PetscInt N,void *ctx,Mat *A) 781 { 782 PetscErrorCode ierr; 783 784 PetscFunctionBegin; 785 ierr = MatCreate(comm,A);CHKERRQ(ierr); 786 ierr = MatSetSizes(*A,m,n,M,N);CHKERRQ(ierr); 787 ierr = MatSetType(*A,MATSHELL);CHKERRQ(ierr); 788 ierr = MatShellSetContext(*A,ctx);CHKERRQ(ierr); 789 ierr = MatSetUp(*A);CHKERRQ(ierr); 790 PetscFunctionReturn(0); 791 } 792 793 /*@ 794 MatShellSetContext - sets the context for a shell matrix 795 796 Logically Collective on Mat 797 798 Input Parameters: 799 + mat - the shell matrix 800 - ctx - the context 801 802 Level: advanced 803 804 Fortran Notes: To use this from Fortran you must write a Fortran interface definition for this 805 function that tells Fortran the Fortran derived data type that you are passing in as the ctx argument. 806 807 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation() 808 @*/ 809 PetscErrorCode MatShellSetContext(Mat mat,void *ctx) 810 { 811 Mat_Shell *shell = (Mat_Shell*)mat->data; 812 PetscErrorCode ierr; 813 PetscBool flg; 814 815 PetscFunctionBegin; 816 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 817 ierr = PetscObjectTypeCompare((PetscObject)mat,MATSHELL,&flg);CHKERRQ(ierr); 818 if (flg) { 819 shell->ctx = ctx; 820 } else SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot attach context to non-shell matrix"); 821 PetscFunctionReturn(0); 822 } 823 824 /*@ 825 MatShellSetManageScalingShifts - Allows the user to control the scaling and shift operations of the MATSHELL. Must be called immediately 826 after MatCreateShell() 827 828 Logically Collective on Mat 829 830 Input Parameter: 831 . mat - the shell matrix 832 833 Level: advanced 834 835 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellSetContext(), MatShellSetOperation() 836 @*/ 837 PetscErrorCode MatShellSetManageScalingShifts(Mat A) 838 { 839 PetscErrorCode ierr; 840 Mat_Shell *shell = (Mat_Shell*)A->data; 841 PetscBool flg; 842 843 PetscFunctionBegin; 844 PetscValidHeaderSpecific(A,MAT_CLASSID,1); 845 ierr = PetscObjectTypeCompare((PetscObject)A,MATSHELL,&flg);CHKERRQ(ierr); 846 if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Can only use with MATSHELL matrices"); 847 shell->managescalingshifts = PETSC_FALSE; 848 A->ops->diagonalscale = 0; 849 A->ops->scale = 0; 850 A->ops->shift = 0; 851 A->ops->diagonalset = 0; 852 PetscFunctionReturn(0); 853 } 854 855 /*@C 856 MatShellTestMult - Compares the multiply routine provided to the MATSHELL with differencing on a given function. 857 858 Logically Collective on Mat 859 860 Input Parameters: 861 + mat - the shell matrix 862 . f - the function 863 . base - differences are computed around this vector, see MatMFFDSetBase(), for Jacobians this is the point at which the Jacobian is being evaluated 864 - ctx - an optional context for the function 865 866 Output Parameter: 867 . flg - PETSC_TRUE if the multiply is likely correct 868 869 Options Database: 870 . -mat_shell_test_mult_view - print if any differences are detected between the products and print the difference 871 872 Level: advanced 873 874 Fortran Notes: Not supported from Fortran 875 876 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellTestMultTranspose() 877 @*/ 878 PetscErrorCode MatShellTestMult(Mat mat,PetscErrorCode (*f)(void*,Vec,Vec),Vec base,void *ctx,PetscBool *flg) 879 { 880 PetscErrorCode ierr; 881 PetscInt m,n; 882 Mat mf,Dmf,Dmat,Ddiff; 883 PetscReal Diffnorm,Dmfnorm; 884 PetscBool v = PETSC_FALSE, flag = PETSC_TRUE; 885 886 PetscFunctionBegin; 887 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 888 ierr = PetscOptionsHasName(NULL,((PetscObject)mat)->prefix,"-mat_shell_test_mult_view",&v);CHKERRQ(ierr); 889 ierr = MatGetLocalSize(mat,&m,&n);CHKERRQ(ierr); 890 ierr = MatCreateMFFD(PetscObjectComm((PetscObject)mat),m,n,PETSC_DECIDE,PETSC_DECIDE,&mf);CHKERRQ(ierr); 891 ierr = MatMFFDSetFunction(mf,f,ctx);CHKERRQ(ierr); 892 ierr = MatMFFDSetBase(mf,base,NULL);CHKERRQ(ierr); 893 894 ierr = MatComputeExplicitOperator(mf,&Dmf);CHKERRQ(ierr); 895 ierr = MatComputeExplicitOperator(mat,&Dmat);CHKERRQ(ierr); 896 897 ierr = MatDuplicate(Dmat,MAT_COPY_VALUES,&Ddiff);CHKERRQ(ierr); 898 ierr = MatAXPY(Ddiff,-1.0,Dmf,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 899 ierr = MatNorm(Ddiff,NORM_FROBENIUS,&Diffnorm);CHKERRQ(ierr); 900 ierr = MatNorm(Dmf,NORM_FROBENIUS,&Dmfnorm);CHKERRQ(ierr); 901 if (Diffnorm/Dmfnorm > 10*PETSC_SQRT_MACHINE_EPSILON) { 902 flag = PETSC_FALSE; 903 if (v) { 904 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"MATSHELL and matrix free multiple appear to produce different results.\n Norm Ratio %g Difference results followed by finite difference one\n",(double)(Diffnorm/Dmfnorm)); 905 ierr = MatViewFromOptions(Ddiff,(PetscObject)mat,"-mat_shell_test_mult_view");CHKERRQ(ierr); 906 ierr = MatViewFromOptions(Dmf,(PetscObject)mat,"-mat_shell_test_mult_view");CHKERRQ(ierr); 907 ierr = MatViewFromOptions(Dmat,(PetscObject)mat,"-mat_shell_test_mult_view");CHKERRQ(ierr); 908 } 909 } else if (v) { 910 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"MATSHELL and matrix free multiple appear to produce the same results\n"); 911 } 912 if (flg) *flg = flag; 913 ierr = MatDestroy(&Ddiff);CHKERRQ(ierr); 914 ierr = MatDestroy(&mf);CHKERRQ(ierr); 915 ierr = MatDestroy(&Dmf);CHKERRQ(ierr); 916 ierr = MatDestroy(&Dmat);CHKERRQ(ierr); 917 PetscFunctionReturn(0); 918 } 919 920 /*@C 921 MatShellTestMultTranpose - Compares the multiply transpose routine provided to the MATSHELL with differencing on a given function. 922 923 Logically Collective on Mat 924 925 Input Parameters: 926 + mat - the shell matrix 927 . f - the function 928 . base - differences are computed around this vector, see MatMFFDSetBase(), for Jacobians this is the point at which the Jacobian is being evaluated 929 - ctx - an optional context for the function 930 931 Output Parameter: 932 . flg - PETSC_TRUE if the multiply is likely correct 933 934 Options Database: 935 . -mat_shell_test_mult_view - print if any differences are detected between the products and print the difference 936 937 Level: advanced 938 939 Fortran Notes: Not supported from Fortran 940 941 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellTestMult() 942 @*/ 943 PetscErrorCode MatShellTestMultTranspose(Mat mat,PetscErrorCode (*f)(void*,Vec,Vec),Vec base,void *ctx,PetscBool *flg) 944 { 945 PetscErrorCode ierr; 946 Vec x,y,z; 947 PetscInt m,n,M,N; 948 Mat mf,Dmf,Dmat,Ddiff; 949 PetscReal Diffnorm,Dmfnorm; 950 PetscBool v = PETSC_FALSE, flag = PETSC_TRUE; 951 952 PetscFunctionBegin; 953 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 954 ierr = PetscOptionsHasName(NULL,((PetscObject)mat)->prefix,"-mat_shell_test_mult_transpose_view",&v);CHKERRQ(ierr); 955 ierr = MatCreateVecs(mat,&x,&y);CHKERRQ(ierr); 956 ierr = VecDuplicate(y,&z);CHKERRQ(ierr); 957 ierr = MatGetLocalSize(mat,&m,&n);CHKERRQ(ierr); 958 ierr = MatGetSize(mat,&M,&N);CHKERRQ(ierr); 959 ierr = MatCreateMFFD(PetscObjectComm((PetscObject)mat),m,n,M,N,&mf);CHKERRQ(ierr); 960 ierr = MatMFFDSetFunction(mf,f,ctx);CHKERRQ(ierr); 961 ierr = MatMFFDSetBase(mf,base,NULL);CHKERRQ(ierr); 962 ierr = MatComputeExplicitOperator(mf,&Dmf);CHKERRQ(ierr); 963 ierr = MatTranspose(Dmf,MAT_INPLACE_MATRIX,&Dmf);CHKERRQ(ierr); 964 ierr = MatComputeExplicitOperatorTranspose(mat,&Dmat);CHKERRQ(ierr); 965 966 ierr = MatDuplicate(Dmat,MAT_COPY_VALUES,&Ddiff);CHKERRQ(ierr); 967 ierr = MatAXPY(Ddiff,-1.0,Dmf,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 968 ierr = MatNorm(Ddiff,NORM_FROBENIUS,&Diffnorm);CHKERRQ(ierr); 969 ierr = MatNorm(Dmf,NORM_FROBENIUS,&Dmfnorm);CHKERRQ(ierr); 970 if (Diffnorm/Dmfnorm > 10*PETSC_SQRT_MACHINE_EPSILON) { 971 flag = PETSC_FALSE; 972 if (v) { 973 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"MATSHELL and matrix free multiple appear to produce different results.\n Norm Ratio %g Difference results followed by finite difference one\n",(double)(Diffnorm/Dmfnorm)); 974 ierr = MatViewFromOptions(Ddiff,(PetscObject)mat,"-mat_shell_test_mult_transpose_view");CHKERRQ(ierr); 975 ierr = MatViewFromOptions(Dmf,(PetscObject)mat,"-mat_shell_test_mult_transpose_view");CHKERRQ(ierr); 976 ierr = MatViewFromOptions(Dmat,(PetscObject)mat,"-mat_shell_test_mult_transpose_view");CHKERRQ(ierr); 977 } 978 } else if (v) { 979 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"MATSHELL transpose and matrix free multiple appear to produce the same results\n"); 980 } 981 if (flg) *flg = flag; 982 ierr = MatDestroy(&mf);CHKERRQ(ierr); 983 ierr = MatDestroy(&Dmat);CHKERRQ(ierr); 984 ierr = MatDestroy(&Ddiff);CHKERRQ(ierr); 985 ierr = MatDestroy(&Dmf);CHKERRQ(ierr); 986 ierr = VecDestroy(&x);CHKERRQ(ierr); 987 ierr = VecDestroy(&y);CHKERRQ(ierr); 988 ierr = VecDestroy(&z);CHKERRQ(ierr); 989 PetscFunctionReturn(0); 990 } 991 992 /*@C 993 MatShellSetOperation - Allows user to set a matrix operation for a shell matrix. 994 995 Logically Collective on Mat 996 997 Input Parameters: 998 + mat - the shell matrix 999 . op - the name of the operation 1000 - f - the function that provides the operation. 1001 1002 Level: advanced 1003 1004 Usage: 1005 $ extern PetscErrorCode usermult(Mat,Vec,Vec); 1006 $ ierr = MatCreateShell(comm,m,n,M,N,ctx,&A); 1007 $ ierr = MatShellSetOperation(A,MATOP_MULT,(void(*)(void))usermult); 1008 1009 Notes: 1010 See the file include/petscmat.h for a complete list of matrix 1011 operations, which all have the form MATOP_<OPERATION>, where 1012 <OPERATION> is the name (in all capital letters) of the 1013 user interface routine (e.g., MatMult() -> MATOP_MULT). 1014 1015 All user-provided functions (except for MATOP_DESTROY) should have the same calling 1016 sequence as the usual matrix interface routines, since they 1017 are intended to be accessed via the usual matrix interface 1018 routines, e.g., 1019 $ MatMult(Mat,Vec,Vec) -> usermult(Mat,Vec,Vec) 1020 1021 In particular each function MUST return an error code of 0 on success and 1022 nonzero on failure. 1023 1024 Within each user-defined routine, the user should call 1025 MatShellGetContext() to obtain the user-defined context that was 1026 set by MatCreateShell(). 1027 1028 Fortran Notes: For MatCreateVecs() the user code should check if the input left or right matrix is -1 and in that case not 1029 generate a matrix. See src/mat/examples/tests/ex120f.F 1030 1031 Use MatSetOperation() to set an operation for any matrix type 1032 1033 .keywords: matrix, shell, set, operation 1034 1035 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellSetContext(), MatSetOperation(), MatShellSetManageScalingShifts() 1036 @*/ 1037 PetscErrorCode MatShellSetOperation(Mat mat,MatOperation op,void (*f)(void)) 1038 { 1039 PetscErrorCode ierr; 1040 PetscBool flg; 1041 Mat_Shell *shell = (Mat_Shell*)mat->data; 1042 1043 PetscFunctionBegin; 1044 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 1045 ierr = PetscObjectTypeCompare((PetscObject)mat,MATSHELL,&flg);CHKERRQ(ierr); 1046 if (!flg) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Can only use with MATSHELL matrices"); 1047 switch (op) { 1048 case MATOP_DESTROY: 1049 shell->ops->destroy = (PetscErrorCode (*)(Mat))f; 1050 break; 1051 case MATOP_DIAGONAL_SET: 1052 case MATOP_DIAGONAL_SCALE: 1053 case MATOP_SHIFT: 1054 case MATOP_SCALE: 1055 case MATOP_AXPY: 1056 if (shell->managescalingshifts) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"MATSHELL is managing scalings and shifts, see MatShellSetManageScalingShifts()"); 1057 (((void(**)(void))mat->ops)[op]) = f; 1058 break; 1059 case MATOP_GET_DIAGONAL: 1060 if (shell->managescalingshifts) shell->ops->getdiagonal = (PetscErrorCode (*)(Mat,Vec))f; 1061 else mat->ops->getdiagonal = (PetscErrorCode (*)(Mat,Vec))f; 1062 case MATOP_VIEW: 1063 if (!mat->ops->viewnative) { 1064 mat->ops->viewnative = mat->ops->view; 1065 } 1066 mat->ops->view = (PetscErrorCode (*)(Mat,PetscViewer))f; 1067 break; 1068 case MATOP_MULT: 1069 if (shell->managescalingshifts){ 1070 shell->ops->mult = (PetscErrorCode (*)(Mat,Vec,Vec))f; 1071 mat->ops->mult = MatMult_Shell; 1072 } else mat->ops->mult = (PetscErrorCode (*)(Mat,Vec,Vec))f; 1073 break; 1074 case MATOP_MULT_TRANSPOSE: 1075 if (shell->managescalingshifts) { 1076 shell->ops->multtranspose = (PetscErrorCode (*)(Mat,Vec,Vec))f; 1077 mat->ops->multtranspose = MatMultTranspose_Shell; 1078 } else mat->ops->multtranspose = (PetscErrorCode (*)(Mat,Vec,Vec))f; 1079 break; 1080 default: 1081 (((void(**)(void))mat->ops)[op]) = f; 1082 } 1083 PetscFunctionReturn(0); 1084 } 1085 1086 /*@C 1087 MatShellGetOperation - Gets a matrix function for a shell matrix. 1088 1089 Not Collective 1090 1091 Input Parameters: 1092 + mat - the shell matrix 1093 - op - the name of the operation 1094 1095 Output Parameter: 1096 . f - the function that provides the operation. 1097 1098 Level: advanced 1099 1100 Notes: 1101 See the file include/petscmat.h for a complete list of matrix 1102 operations, which all have the form MATOP_<OPERATION>, where 1103 <OPERATION> is the name (in all capital letters) of the 1104 user interface routine (e.g., MatMult() -> MATOP_MULT). 1105 1106 All user-provided functions have the same calling 1107 sequence as the usual matrix interface routines, since they 1108 are intended to be accessed via the usual matrix interface 1109 routines, e.g., 1110 $ MatMult(Mat,Vec,Vec) -> usermult(Mat,Vec,Vec) 1111 1112 Within each user-defined routine, the user should call 1113 MatShellGetContext() to obtain the user-defined context that was 1114 set by MatCreateShell(). 1115 1116 .keywords: matrix, shell, set, operation 1117 1118 .seealso: MatCreateShell(), MatShellGetContext(), MatShellSetOperation(), MatShellSetContext() 1119 @*/ 1120 PetscErrorCode MatShellGetOperation(Mat mat,MatOperation op,void(**f)(void)) 1121 { 1122 PetscErrorCode ierr; 1123 PetscBool flg; 1124 1125 PetscFunctionBegin; 1126 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 1127 switch (op) { 1128 case MATOP_DESTROY: 1129 ierr = PetscObjectTypeCompare((PetscObject)mat,MATSHELL,&flg);CHKERRQ(ierr); 1130 if (flg) { 1131 Mat_Shell *shell = (Mat_Shell*)mat->data; 1132 *f = (void (*)(void))shell->ops->destroy; 1133 } else { 1134 *f = (void (*)(void))mat->ops->destroy; 1135 } 1136 break; 1137 case MATOP_DIAGONAL_SET: 1138 ierr = PetscObjectTypeCompare((PetscObject)mat,MATSHELL,&flg);CHKERRQ(ierr); 1139 if (flg) { 1140 Mat_Shell *shell = (Mat_Shell*)mat->data; 1141 *f = (void (*)(void))shell->ops->diagonalset; 1142 } else { 1143 *f = (void (*)(void))mat->ops->diagonalset; 1144 } 1145 break; 1146 case MATOP_VIEW: 1147 *f = (void (*)(void))mat->ops->view; 1148 break; 1149 default: 1150 *f = (((void (**)(void))mat->ops)[op]); 1151 } 1152 PetscFunctionReturn(0); 1153 } 1154 1155 /*@C 1156 MatSetOperation - Allows user to set a matrix operation for any matrix type 1157 1158 Logically Collective on Mat 1159 1160 Input Parameters: 1161 + mat - the shell matrix 1162 . op - the name of the operation 1163 - f - the function that provides the operation. 1164 1165 Level: developer 1166 1167 Usage: 1168 $ extern PetscErrorCode usermult(Mat,Vec,Vec); 1169 $ ierr = MatCreateXXX(comm,...&A); 1170 $ ierr = MatShellSetOperation(A,MATOP_MULT,(void(*)(void))usermult); 1171 1172 Notes: 1173 See the file include/petscmat.h for a complete list of matrix 1174 operations, which all have the form MATOP_<OPERATION>, where 1175 <OPERATION> is the name (in all capital letters) of the 1176 user interface routine (e.g., MatMult() -> MATOP_MULT). 1177 1178 All user-provided functions (except for MATOP_DESTROY) should have the same calling 1179 sequence as the usual matrix interface routines, since they 1180 are intended to be accessed via the usual matrix interface 1181 routines, e.g., 1182 $ MatMult(Mat,Vec,Vec) -> usermult(Mat,Vec,Vec) 1183 1184 In particular each function MUST return an error code of 0 on success and 1185 nonzero on failure. 1186 1187 This routine is distinct from MatShellSetOperation() in that it can be called on any matrix type. 1188 1189 .keywords: matrix, shell, set, operation 1190 1191 .seealso: MatCreateShell(), MatShellGetContext(), MatShellGetOperation(), MatShellSetContext(), MatShellSetOperation() 1192 @*/ 1193 PetscErrorCode MatSetOperation(Mat mat,MatOperation op,void (*f)(void)) 1194 { 1195 PetscFunctionBegin; 1196 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 1197 (((void(**)(void))mat->ops)[op]) = f; 1198 PetscFunctionReturn(0); 1199 } 1200