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*e7a95102SMartin DiehlMODULE ex20f_mod 6aca0776fSJose E. Roman USE petscmat 7aca0776fSJose E. Roman IMPLICIT NONE 8aca0776fSJose E. Roman TYPE :: MatCtx 9aca0776fSJose E. Roman PetscReal :: lambda 10aca0776fSJose E. Roman END TYPE MatCtx 11aca0776fSJose E. Roman 12*e7a95102SMartin Diehl interface 13aca0776fSJose E. Roman SUBROUTINE MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr) 14*e7a95102SMartin Diehl use petscmat 15*e7a95102SMartin Diehl import MatCtx 16*e7a95102SMartin Diehl implicit none 17aca0776fSJose E. Roman MPI_Comm :: comm 18aca0776fSJose E. Roman PetscInt :: mloc, nloc, m, n 19aca0776fSJose E. Roman TYPE(MatCtx) :: ctx 20aca0776fSJose E. Roman Mat :: mat 21aca0776fSJose E. Roman PetscErrorCode :: ierr 22aca0776fSJose E. Roman END SUBROUTINE MatCreateShell 23aca0776fSJose E. Roman 24aca0776fSJose E. Roman SUBROUTINE MatShellSetContext(mat, ctx, ierr) 25*e7a95102SMartin Diehl use petscmat 26*e7a95102SMartin Diehl import MatCtx 27*e7a95102SMartin Diehl implicit none 28aca0776fSJose E. Roman Mat :: mat 29aca0776fSJose E. Roman TYPE(MatCtx) :: ctx 30aca0776fSJose E. Roman PetscErrorCode :: ierr 31aca0776fSJose E. Roman END SUBROUTINE MatShellSetContext 32aca0776fSJose E. Roman 33aca0776fSJose E. Roman SUBROUTINE MatShellGetContext(mat, ctx, ierr) 34*e7a95102SMartin Diehl use petscmat 35*e7a95102SMartin Diehl import MatCtx 36*e7a95102SMartin Diehl implicit none 37aca0776fSJose E. Roman Mat :: mat 38aca0776fSJose E. Roman TYPE(MatCtx), POINTER :: ctx 39aca0776fSJose E. Roman PetscErrorCode :: ierr 40aca0776fSJose E. Roman END SUBROUTINE MatShellGetContext 41*e7a95102SMartin Diehl end interface 42aca0776fSJose E. Roman 43*e7a95102SMartin Diehlcontains 44*e7a95102SMartin Diehl SUBROUTINE MatDuplicate_F(F, opt, M, ierr) 45*e7a95102SMartin Diehl 46*e7a95102SMartin Diehl Mat :: F, M 47*e7a95102SMartin Diehl MatDuplicateOption :: opt 48*e7a95102SMartin Diehl PetscErrorCode :: ierr 49*e7a95102SMartin Diehl PetscInt :: ml, nl 50*e7a95102SMartin Diehl TYPE(MatCtx), POINTER :: ctxM, ctxF_pt 51*e7a95102SMartin Diehl 52*e7a95102SMartin Diehl PetscCall(MatGetLocalSize(F, ml, nl, ierr)) 53*e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 54*e7a95102SMartin Diehl allocate (ctxM) 55*e7a95102SMartin Diehl ctxM%lambda = ctxF_pt%lambda 56*e7a95102SMartin Diehl PetscCall(MatCreateShell(PETSC_COMM_WORLD, ml, nl, PETSC_DETERMINE, PETSC_DETERMINE, ctxM, M, ierr)) 57*e7a95102SMartin Diehl! PetscCall(MatShellSetOperation(M,MATOP_DUPLICATE,MatDuplicate_F,ierr)) 58*e7a95102SMartin Diehl PetscCall(MatShellSetOperation(M, MATOP_DESTROY, MatDestroy_F, ierr)) 59*e7a95102SMartin Diehl END SUBROUTINE MatDuplicate_F 60*e7a95102SMartin Diehl 61*e7a95102SMartin Diehl SUBROUTINE MatDestroy_F(F, ierr) 62*e7a95102SMartin Diehl 63*e7a95102SMartin Diehl Mat :: F 64*e7a95102SMartin Diehl PetscErrorCode :: ierr 65*e7a95102SMartin Diehl TYPE(MatCtx), POINTER :: ctxF_pt 66*e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 67*e7a95102SMartin Diehl deallocate (ctxF_pt) 68*e7a95102SMartin Diehl END SUBROUTINE MatDestroy_F 69*e7a95102SMartin Diehl 70*e7a95102SMartin DiehlEND MODULE ex20f_mod 71aca0776fSJose E. Roman 72aca0776fSJose E. Roman! ---------------------------------------------------- 73aca0776fSJose E. Roman! main program 74aca0776fSJose E. Roman! ---------------------------------------------------- 75aca0776fSJose E. RomanPROGRAM main 76*e7a95102SMartin Diehl use ex20f_mod 77*e7a95102SMartin Diehl implicit none 78aca0776fSJose E. Roman Mat :: F, Fcopy 79aca0776fSJose E. Roman TYPE(MatCtx) :: ctxF 80aca0776fSJose E. Roman TYPE(MatCtx), POINTER :: ctxF_pt, ctxFcopy_pt 81aca0776fSJose E. Roman PetscErrorCode :: ierr 82aca0776fSJose E. Roman PetscInt :: n = 128 83aca0776fSJose E. Roman 84aca0776fSJose E. Roman PetscCallA(PetscInitialize(ierr)) 85aca0776fSJose E. Roman ctxF%lambda = 3.14d0 86aca0776fSJose E. Roman PetscCallA(MatCreateShell(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, ctxF, F, ierr)) 87aca0776fSJose E. Roman PetscCallA(MatShellSetOperation(F, MATOP_DUPLICATE, MatDuplicate_F, ierr)) 88aca0776fSJose E. Roman PRINT *, 'ctxF%lambda = ', ctxF%lambda 89aca0776fSJose E. Roman 90aca0776fSJose E. Roman PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 91aca0776fSJose E. Roman PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 92aca0776fSJose E. Roman 93aca0776fSJose E. Roman PetscCallA(MatDuplicate(F, MAT_DO_NOT_COPY_VALUES, Fcopy, ierr)) 94aca0776fSJose E. Roman PetscCallA(MatShellGetContext(Fcopy, ctxFcopy_pt, ierr)) 95aca0776fSJose E. Roman PRINT *, 'ctxFcopy_pt%lambda = ', ctxFcopy_pt%lambda 96aca0776fSJose E. Roman 97aca0776fSJose E. Roman PetscCallA(MatDestroy(F, ierr)) 98aca0776fSJose E. Roman PetscCallA(MatDestroy(Fcopy, ierr)) 99aca0776fSJose E. Roman PetscCallA(PetscFinalize(ierr)) 100aca0776fSJose E. RomanEND PROGRAM main 101aca0776fSJose E. Roman 102aca0776fSJose E. Roman!/*TEST 103aca0776fSJose E. Roman! 104aca0776fSJose E. Roman! build: 105aca0776fSJose E. Roman! requires: double 106aca0776fSJose E. Roman! 107aca0776fSJose E. Roman! test: 108aca0776fSJose E. Roman! 109aca0776fSJose E. Roman!TEST*/ 110