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*01fa2b5aSMartin DiehlMODULE ex20fmodule 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 12e7a95102SMartin Diehl interface 13aca0776fSJose E. Roman SUBROUTINE MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr) 14e7a95102SMartin Diehl use petscmat 15e7a95102SMartin Diehl import MatCtx 16e7a95102SMartin 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) 25e7a95102SMartin Diehl use petscmat 26e7a95102SMartin Diehl import MatCtx 27e7a95102SMartin 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) 34e7a95102SMartin Diehl use petscmat 35e7a95102SMartin Diehl import MatCtx 36e7a95102SMartin 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 41e7a95102SMartin Diehl end interface 42aca0776fSJose E. Roman 43e7a95102SMartin Diehlcontains 44e7a95102SMartin Diehl SUBROUTINE MatDuplicate_F(F, opt, M, ierr) 45e7a95102SMartin Diehl 46e7a95102SMartin Diehl Mat :: F, M 47e7a95102SMartin Diehl MatDuplicateOption :: opt 48e7a95102SMartin Diehl PetscErrorCode :: ierr 49e7a95102SMartin Diehl PetscInt :: ml, nl 50e7a95102SMartin Diehl TYPE(MatCtx), POINTER :: ctxM, ctxF_pt 51e7a95102SMartin Diehl 52e7a95102SMartin Diehl PetscCall(MatGetLocalSize(F, ml, nl, ierr)) 53e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 54e7a95102SMartin Diehl allocate (ctxM) 55e7a95102SMartin Diehl ctxM%lambda = ctxF_pt%lambda 56e7a95102SMartin Diehl PetscCall(MatCreateShell(PETSC_COMM_WORLD, ml, nl, PETSC_DETERMINE, PETSC_DETERMINE, ctxM, M, ierr)) 57e7a95102SMartin Diehl! PetscCall(MatShellSetOperation(M,MATOP_DUPLICATE,MatDuplicate_F,ierr)) 58e7a95102SMartin Diehl PetscCall(MatShellSetOperation(M, MATOP_DESTROY, MatDestroy_F, ierr)) 59e7a95102SMartin Diehl END SUBROUTINE MatDuplicate_F 60e7a95102SMartin Diehl 61e7a95102SMartin Diehl SUBROUTINE MatDestroy_F(F, ierr) 62e7a95102SMartin Diehl 63e7a95102SMartin Diehl Mat :: F 64e7a95102SMartin Diehl PetscErrorCode :: ierr 65e7a95102SMartin Diehl TYPE(MatCtx), POINTER :: ctxF_pt 66e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 67e7a95102SMartin Diehl deallocate (ctxF_pt) 68e7a95102SMartin Diehl END SUBROUTINE MatDestroy_F 69e7a95102SMartin Diehl 70*01fa2b5aSMartin DiehlEND MODULE ex20fmodule 71aca0776fSJose E. Roman 72aca0776fSJose E. Roman! ---------------------------------------------------- 73aca0776fSJose E. Roman! main program 74aca0776fSJose E. Roman! ---------------------------------------------------- 75aca0776fSJose E. RomanPROGRAM main 76*01fa2b5aSMartin Diehl use ex20fmodule 77e7a95102SMartin 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