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 Diehl interface 13*02c639afSMartin Diehl 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 19*02c639afSMartin Diehl type(MatCtx) :: ctx 20aca0776fSJose E. Roman Mat :: mat 21aca0776fSJose E. Roman PetscErrorCode :: ierr 22*02c639afSMartin Diehl end subroutine MatCreateShell 23aca0776fSJose E. Roman 24*02c639afSMartin Diehl subroutine MatShellSetContext(mat, ctx, ierr) 25e7a95102SMartin Diehl use petscmat 26e7a95102SMartin Diehl import MatCtx 27e7a95102SMartin Diehl implicit none 28aca0776fSJose E. Roman Mat :: mat 29*02c639afSMartin Diehl type(MatCtx) :: ctx 30aca0776fSJose E. Roman PetscErrorCode :: ierr 31*02c639afSMartin Diehl end subroutine MatShellSetContext 32aca0776fSJose E. Roman 33*02c639afSMartin Diehl subroutine MatShellGetContext(mat, ctx, ierr) 34e7a95102SMartin Diehl use petscmat 35e7a95102SMartin Diehl import MatCtx 36e7a95102SMartin Diehl implicit none 37aca0776fSJose E. Roman Mat :: mat 38*02c639afSMartin Diehl type(MatCtx), pointer :: ctx 39aca0776fSJose E. Roman PetscErrorCode :: ierr 40*02c639afSMartin Diehl end subroutine MatShellGetContext 41e7a95102SMartin Diehl end interface 42aca0776fSJose E. Roman 43e7a95102SMartin Diehlcontains 44*02c639afSMartin 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 50*02c639afSMartin 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)) 59*02c639afSMartin Diehl end subroutine MatDuplicate_F 60e7a95102SMartin Diehl 61*02c639afSMartin Diehl subroutine MatDestroy_F(F, ierr) 62e7a95102SMartin Diehl 63e7a95102SMartin Diehl Mat :: F 64e7a95102SMartin Diehl PetscErrorCode :: ierr 65*02c639afSMartin Diehl type(MatCtx), pointer :: ctxF_pt 66e7a95102SMartin Diehl PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 67e7a95102SMartin Diehl deallocate (ctxF_pt) 68*02c639afSMartin Diehl end subroutine MatDestroy_F 69e7a95102SMartin Diehl 70*02c639afSMartin Diehlend module ex20fmodule 71aca0776fSJose E. Roman 72aca0776fSJose E. Roman! ---------------------------------------------------- 73aca0776fSJose E. Roman! main program 74aca0776fSJose E. Roman! ---------------------------------------------------- 75*02c639afSMartin Diehlprogram main 7601fa2b5aSMartin Diehl use ex20fmodule 77e7a95102SMartin Diehl implicit none 78aca0776fSJose E. Roman Mat :: F, Fcopy 79*02c639afSMartin Diehl type(MatCtx) :: ctxF 80*02c639afSMartin Diehl 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)) 88*02c639afSMartin Diehl print *, 'ctxF%lambda = ', ctxF%lambda 89aca0776fSJose E. Roman 90aca0776fSJose E. Roman PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 91*02c639afSMartin Diehl 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)) 95*02c639afSMartin Diehl 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)) 100*02c639afSMartin Diehlend 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