1aca0776fSJose E. Roman! 2aca0776fSJose E. Roman! Demonstrates use of MatDuplicate() for a shell matrix with a context 3aca0776fSJose E. Roman! 4aca0776fSJose E. Roman#include "petsc/finclude/petscmat.h" 5*02c639afSMartin Diehlmodule ex20fmodule 6*02c639afSMartin Diehl use petscmat 7*02c639afSMartin Diehl implicit none 8*02c639afSMartin Diehl type :: MatCtx 9aca0776fSJose E. Roman PetscReal :: lambda 10*02c639afSMartin Diehl end type MatCtx 11aca0776fSJose E. Roman 12e7a95102SMartin Diehlcontains 13*02c639afSMartin Diehl subroutine MatDuplicate_F(F, opt, M, ierr) 14e7a95102SMartin Diehl 15e7a95102SMartin Diehl Mat :: F, M 16e7a95102SMartin Diehl MatDuplicateOption :: opt 17e7a95102SMartin Diehl PetscErrorCode :: ierr 18e7a95102SMartin Diehl PetscInt :: ml, nl 19*02c639afSMartin Diehl type(MatCtx), pointer :: ctxM, ctxF_pt 20e7a95102SMartin Diehl 21e7a95102SMartin Diehl PetscCall(MatGetLocalSize(F, ml, nl, ierr)) 22e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 23e7a95102SMartin Diehl allocate (ctxM) 24e7a95102SMartin Diehl ctxM%lambda = ctxF_pt%lambda 25e7a95102SMartin Diehl PetscCall(MatCreateShell(PETSC_COMM_WORLD, ml, nl, PETSC_DETERMINE, PETSC_DETERMINE, ctxM, M, ierr)) 26e7a95102SMartin Diehl PetscCall(MatShellSetOperation(M, MATOP_DESTROY, MatDestroy_F, ierr)) 27*02c639afSMartin Diehl end subroutine MatDuplicate_F 28e7a95102SMartin Diehl 29*02c639afSMartin Diehl subroutine MatDestroy_F(F, ierr) 30e7a95102SMartin Diehl 31e7a95102SMartin Diehl Mat :: F 32e7a95102SMartin Diehl PetscErrorCode :: ierr 33*02c639afSMartin Diehl type(MatCtx), pointer :: ctxF_pt 34e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 35e7a95102SMartin Diehl deallocate (ctxF_pt) 36*02c639afSMartin Diehl end subroutine MatDestroy_F 37e7a95102SMartin Diehl 38*02c639afSMartin Diehlend module ex20fmodule 39aca0776fSJose E. Roman 40aca0776fSJose E. Roman! ---------------------------------------------------- 41aca0776fSJose E. Roman! main program 42aca0776fSJose E. Roman! ---------------------------------------------------- 43*02c639afSMartin Diehlprogram main 4401fa2b5aSMartin Diehl use ex20fmodule 45e7a95102SMartin Diehl implicit none 46aca0776fSJose E. Roman Mat :: F, Fcopy 47*02c639afSMartin Diehl type(MatCtx) :: ctxF 48*02c639afSMartin Diehl type(MatCtx), pointer :: ctxF_pt, ctxFcopy_pt 49aca0776fSJose E. Roman PetscErrorCode :: ierr 50aca0776fSJose E. Roman PetscInt :: n = 128 51aca0776fSJose E. Roman 52aca0776fSJose E. Roman PetscCallA(PetscInitialize(ierr)) 53aca0776fSJose E. Roman ctxF%lambda = 3.14d0 54aca0776fSJose E. Roman PetscCallA(MatCreateShell(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, ctxF, F, ierr)) 55aca0776fSJose E. Roman PetscCallA(MatShellSetOperation(F, MATOP_DUPLICATE, MatDuplicate_F, ierr)) 56*02c639afSMartin Diehl print *, 'ctxF%lambda = ', ctxF%lambda 57aca0776fSJose E. Roman 58aca0776fSJose E. Roman PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 59*02c639afSMartin Diehl print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 60aca0776fSJose E. Roman 61aca0776fSJose E. Roman PetscCallA(MatDuplicate(F, MAT_DO_NOT_COPY_VALUES, Fcopy, ierr)) 62aca0776fSJose E. Roman PetscCallA(MatShellGetContext(Fcopy, ctxFcopy_pt, ierr)) 63*02c639afSMartin Diehl print *, 'ctxFcopy_pt%lambda = ', ctxFcopy_pt%lambda 64aca0776fSJose E. Roman 65aca0776fSJose E. Roman PetscCallA(MatDestroy(F, ierr)) 66aca0776fSJose E. Roman PetscCallA(MatDestroy(Fcopy, ierr)) 67aca0776fSJose E. Roman PetscCallA(PetscFinalize(ierr)) 68*02c639afSMartin Diehlend program main 69aca0776fSJose E. Roman 70aca0776fSJose E. Roman!/*TEST 71aca0776fSJose E. Roman! 72aca0776fSJose E. Roman! build: 73aca0776fSJose E. Roman! requires: double 74aca0776fSJose E. Roman! 75aca0776fSJose E. Roman! test: 76aca0776fSJose E. Roman! 77aca0776fSJose E. Roman!TEST*/ 78