1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3c4762a1bSJed Brown! 4c4762a1bSJed Brown! Contributed by: Samuel Lanthaler 5c4762a1bSJed Brown! 6c4762a1bSJed Brown MODULE solver_context 7c4762a1bSJed Brown#include "petsc/finclude/petsc.h" 8c4762a1bSJed Brown USE petscsys 9c4762a1bSJed Brown USE petscmat 10c4762a1bSJed Brown IMPLICIT NONE 11c4762a1bSJed Brown TYPE :: MatCtx 12c4762a1bSJed Brown PetscReal :: lambda,kappa 13c4762a1bSJed Brown PetscReal :: h 14c4762a1bSJed Brown END TYPE MatCtx 15c4762a1bSJed Brown END MODULE solver_context 16c4762a1bSJed Brown 17c4762a1bSJed Brown MODULE solver_context_interfaces 18c4762a1bSJed Brown USE solver_context 19c4762a1bSJed Brown IMPLICIT NONE 20c4762a1bSJed Brown 21c4762a1bSJed Brown! ---------------------------------------------------- 22c4762a1bSJed Brown INTERFACE MatCreateShell 23c4762a1bSJed Brown SUBROUTINE MatCreateShell(comm,mloc,nloc,m,n,ctx,mat,ierr) 24c4762a1bSJed Brown USE solver_context 25c4762a1bSJed Brown MPI_Comm :: comm 26c4762a1bSJed Brown PetscInt :: mloc,nloc,m,n 27c4762a1bSJed Brown TYPE(MatCtx) :: ctx 28c4762a1bSJed Brown Mat :: mat 29c4762a1bSJed Brown PetscErrorCode :: ierr 30c4762a1bSJed Brown END SUBROUTINE MatCreateShell 31c4762a1bSJed Brown END INTERFACE MatCreateShell 32c4762a1bSJed Brown! ---------------------------------------------------- 33c4762a1bSJed Brown 34c4762a1bSJed Brown! ---------------------------------------------------- 35c4762a1bSJed Brown INTERFACE MatShellSetContext 36c4762a1bSJed Brown SUBROUTINE MatShellSetContext(mat,ctx,ierr) 37c4762a1bSJed Brown USE solver_context 38c4762a1bSJed Brown Mat :: mat 39c4762a1bSJed Brown TYPE(MatCtx) :: ctx 40c4762a1bSJed Brown PetscErrorCode :: ierr 41c4762a1bSJed Brown END SUBROUTINE MatShellSetContext 42c4762a1bSJed Brown END INTERFACE MatShellSetContext 43c4762a1bSJed Brown! ---------------------------------------------------- 44c4762a1bSJed Brown 45c4762a1bSJed Brown! ---------------------------------------------------- 46c4762a1bSJed Brown INTERFACE MatShellGetContext 47c4762a1bSJed Brown SUBROUTINE MatShellGetContext(mat,ctx,ierr) 48c4762a1bSJed Brown USE solver_context 49c4762a1bSJed Brown Mat :: mat 50c4762a1bSJed Brown TYPE(MatCtx), POINTER :: ctx 51c4762a1bSJed Brown PetscErrorCode :: ierr 52c4762a1bSJed Brown END SUBROUTINE MatShellGetContext 53c4762a1bSJed Brown END INTERFACE MatShellGetContext 54c4762a1bSJed Brown 55c4762a1bSJed Brown END MODULE solver_context_interfaces 56c4762a1bSJed Brown 57c4762a1bSJed Brown! ---------------------------------------------------- 58c4762a1bSJed Brown! main program 59c4762a1bSJed Brown! ---------------------------------------------------- 60c4762a1bSJed Brown PROGRAM main 61c4762a1bSJed Brown#include "petsc/finclude/petsc.h" 62c4762a1bSJed Brown USE solver_context_interfaces 63c4762a1bSJed Brown IMPLICIT NONE 64c4762a1bSJed Brown Mat :: F 65c4762a1bSJed Brown TYPE(MatCtx) :: ctxF 66c4762a1bSJed Brown TYPE(MatCtx),POINTER :: ctxF_pt 67c4762a1bSJed Brown PetscErrorCode :: ierr 68c4762a1bSJed Brown PetscInt :: n=128 69c4762a1bSJed Brown 70*d8606c27SBarry Smith PetscCallA(PetscInitialize(ierr)) 71c4762a1bSJed Brown ctxF%lambda = 3.14d0 72*d8606c27SBarry Smith PetscCallA(MatCreateShell(PETSC_COMM_WORLD,n,n,n,n,ctxF,F,ierr)) 73*d8606c27SBarry Smith PetscCallA(MatShellSetContext(F,ctxF,ierr)) 74c4762a1bSJed Brown PRINT*,'ctxF%lambda = ',ctxF%lambda 75c4762a1bSJed Brown 76*d8606c27SBarry Smith PetscCallA(MatShellGetContext(F,ctxF_pt,ierr)) 77c4762a1bSJed Brown PRINT*,'ctxF_pt%lambda = ',ctxF_pt%lambda 78c4762a1bSJed Brown 79*d8606c27SBarry Smith PetscCallA(MatDestroy(F,ierr)) 80*d8606c27SBarry Smith PetscCallA(PetscFinalize(ierr)) 81c4762a1bSJed Brown END PROGRAM main 82c4762a1bSJed Brown 83c4762a1bSJed Brown!/*TEST 84c4762a1bSJed Brown! 85c4762a1bSJed Brown! build: 86c4762a1bSJed Brown! requires: double 87c4762a1bSJed Brown! 88c4762a1bSJed Brown! test: 89c4762a1bSJed Brown! 90c4762a1bSJed Brown!TEST*/ 91