1*aca0776fSJose E. Roman! 2*aca0776fSJose E. Roman! Demonstrates use of MatDuplicate() for a shell matrix with a context 3*aca0776fSJose E. Roman! 4*aca0776fSJose E. Roman MODULE solver_context_ex20f 5*aca0776fSJose E. Roman#include "petsc/finclude/petscmat.h" 6*aca0776fSJose E. Roman USE petscmat 7*aca0776fSJose E. Roman IMPLICIT NONE 8*aca0776fSJose E. Roman TYPE :: MatCtx 9*aca0776fSJose E. Roman PetscReal :: lambda 10*aca0776fSJose E. Roman END TYPE MatCtx 11*aca0776fSJose E. Roman END MODULE solver_context_ex20f 12*aca0776fSJose E. Roman 13*aca0776fSJose E. Roman MODULE solver_context_interfaces_ex20f 14*aca0776fSJose E. Roman USE solver_context_ex20f 15*aca0776fSJose E. Roman IMPLICIT NONE 16*aca0776fSJose E. Roman 17*aca0776fSJose E. Roman INTERFACE MatCreateShell 18*aca0776fSJose E. Roman SUBROUTINE MatCreateShell(comm,mloc,nloc,m,n,ctx,mat,ierr) 19*aca0776fSJose E. Roman USE solver_context_ex20f 20*aca0776fSJose E. Roman MPI_Comm :: comm 21*aca0776fSJose E. Roman PetscInt :: mloc,nloc,m,n 22*aca0776fSJose E. Roman TYPE(MatCtx) :: ctx 23*aca0776fSJose E. Roman Mat :: mat 24*aca0776fSJose E. Roman PetscErrorCode :: ierr 25*aca0776fSJose E. Roman END SUBROUTINE MatCreateShell 26*aca0776fSJose E. Roman END INTERFACE MatCreateShell 27*aca0776fSJose E. Roman 28*aca0776fSJose E. Roman INTERFACE MatShellSetContext 29*aca0776fSJose E. Roman SUBROUTINE MatShellSetContext(mat,ctx,ierr) 30*aca0776fSJose E. Roman USE solver_context_ex20f 31*aca0776fSJose E. Roman Mat :: mat 32*aca0776fSJose E. Roman TYPE(MatCtx) :: ctx 33*aca0776fSJose E. Roman PetscErrorCode :: ierr 34*aca0776fSJose E. Roman END SUBROUTINE MatShellSetContext 35*aca0776fSJose E. Roman END INTERFACE MatShellSetContext 36*aca0776fSJose E. Roman 37*aca0776fSJose E. Roman INTERFACE MatShellGetContext 38*aca0776fSJose E. Roman SUBROUTINE MatShellGetContext(mat,ctx,ierr) 39*aca0776fSJose E. Roman USE solver_context_ex20f 40*aca0776fSJose E. Roman Mat :: mat 41*aca0776fSJose E. Roman TYPE(MatCtx), POINTER :: ctx 42*aca0776fSJose E. Roman PetscErrorCode :: ierr 43*aca0776fSJose E. Roman END SUBROUTINE MatShellGetContext 44*aca0776fSJose E. Roman END INTERFACE MatShellGetContext 45*aca0776fSJose E. Roman 46*aca0776fSJose E. Roman END MODULE solver_context_interfaces_ex20f 47*aca0776fSJose E. Roman 48*aca0776fSJose E. Roman! ---------------------------------------------------- 49*aca0776fSJose E. Roman! main program 50*aca0776fSJose E. Roman! ---------------------------------------------------- 51*aca0776fSJose E. Roman PROGRAM main 52*aca0776fSJose E. Roman#include "petsc/finclude/petscmat.h" 53*aca0776fSJose E. Roman USE solver_context_interfaces_ex20f 54*aca0776fSJose E. Roman IMPLICIT NONE 55*aca0776fSJose E. Roman Mat :: F, Fcopy 56*aca0776fSJose E. Roman TYPE(MatCtx) :: ctxF 57*aca0776fSJose E. Roman TYPE(MatCtx),POINTER :: ctxF_pt, ctxFcopy_pt 58*aca0776fSJose E. Roman PetscErrorCode :: ierr 59*aca0776fSJose E. Roman PetscInt :: n=128 60*aca0776fSJose E. Roman external MatDuplicate_F 61*aca0776fSJose E. Roman 62*aca0776fSJose E. Roman PetscCallA(PetscInitialize(ierr)) 63*aca0776fSJose E. Roman ctxF%lambda = 3.14d0 64*aca0776fSJose E. Roman PetscCallA(MatCreateShell(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,n,n,ctxF,F,ierr)) 65*aca0776fSJose E. Roman PetscCallA(MatShellSetOperation(F,MATOP_DUPLICATE,MatDuplicate_F,ierr)) 66*aca0776fSJose E. Roman PRINT*,'ctxF%lambda = ',ctxF%lambda 67*aca0776fSJose E. Roman 68*aca0776fSJose E. Roman PetscCallA(MatShellGetContext(F,ctxF_pt,ierr)) 69*aca0776fSJose E. Roman PRINT*,'ctxF_pt%lambda = ',ctxF_pt%lambda 70*aca0776fSJose E. Roman 71*aca0776fSJose E. Roman PetscCallA(MatDuplicate(F,MAT_DO_NOT_COPY_VALUES,Fcopy,ierr)) 72*aca0776fSJose E. Roman PetscCallA(MatShellGetContext(Fcopy,ctxFcopy_pt,ierr)) 73*aca0776fSJose E. Roman PRINT*,'ctxFcopy_pt%lambda = ',ctxFcopy_pt%lambda 74*aca0776fSJose E. Roman 75*aca0776fSJose E. Roman PetscCallA(MatDestroy(F,ierr)) 76*aca0776fSJose E. Roman PetscCallA(MatDestroy(Fcopy,ierr)) 77*aca0776fSJose E. Roman PetscCallA(PetscFinalize(ierr)) 78*aca0776fSJose E. Roman END PROGRAM main 79*aca0776fSJose E. Roman 80*aca0776fSJose E. Roman SUBROUTINE MatDuplicate_F(F, opt, M, ierr) 81*aca0776fSJose E. Roman USE solver_context_interfaces_ex20f 82*aca0776fSJose E. Roman IMPLICIT NONE 83*aca0776fSJose E. Roman 84*aca0776fSJose E. Roman Mat :: F, M 85*aca0776fSJose E. Roman MatDuplicateOption :: opt 86*aca0776fSJose E. Roman PetscErrorCode :: ierr 87*aca0776fSJose E. Roman PetscInt :: ml,nl 88*aca0776fSJose E. Roman TYPE(MatCtx),POINTER :: ctxM,ctxF_pt 89*aca0776fSJose E. Roman external MatDestroy_F 90*aca0776fSJose E. Roman 91*aca0776fSJose E. Roman PetscCall(MatGetLocalSize(F,ml,nl,ierr)); 92*aca0776fSJose E. Roman PetscCall(MatShellGetContext(F,ctxF_pt,ierr)) 93*aca0776fSJose E. Roman allocate(ctxM) 94*aca0776fSJose E. Roman ctxM%lambda = ctxF_pt%lambda 95*aca0776fSJose E. Roman PetscCall(MatCreateShell(PETSC_COMM_WORLD,ml,nl,PETSC_DETERMINE,PETSC_DETERMINE,ctxM,M,ierr)) 96*aca0776fSJose E. Roman! PetscCall(MatShellSetOperation(M,MATOP_DUPLICATE,MatDuplicate_F,ierr)) 97*aca0776fSJose E. Roman PetscCall(MatShellSetOperation(M,MATOP_DESTROY,MatDestroy_F,ierr)) 98*aca0776fSJose E. Roman END SUBROUTINE MatDuplicate_F 99*aca0776fSJose E. Roman 100*aca0776fSJose E. Roman SUBROUTINE MatDestroy_F(F, ierr) 101*aca0776fSJose E. Roman USE solver_context_interfaces_ex20f 102*aca0776fSJose E. Roman IMPLICIT NONE 103*aca0776fSJose E. Roman 104*aca0776fSJose E. Roman Mat :: F 105*aca0776fSJose E. Roman PetscErrorCode :: ierr 106*aca0776fSJose E. Roman TYPE(MatCtx),POINTER :: ctxF_pt 107*aca0776fSJose E. Roman PetscCall(MatShellGetContext(F,ctxF_pt,ierr)) 108*aca0776fSJose E. Roman deallocate(ctxF_pt) 109*aca0776fSJose E. Roman END SUBROUTINE MatDestroy_F 110*aca0776fSJose E. Roman 111*aca0776fSJose E. Roman!/*TEST 112*aca0776fSJose E. Roman! 113*aca0776fSJose E. Roman! build: 114*aca0776fSJose E. Roman! requires: double 115*aca0776fSJose E. Roman! 116*aca0776fSJose E. Roman! test: 117*aca0776fSJose E. Roman! 118*aca0776fSJose E. Roman!TEST*/ 119