1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3c4762a1bSJed Brown! 4c4762a1bSJed Brown! Contributed by: Samuel Lanthaler 5c4762a1bSJed Brown! 6*aca0776fSJose E. Roman MODULE solver_context_ex6f 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 15*aca0776fSJose E. Roman END MODULE solver_context_ex6f 16c4762a1bSJed Brown 17*aca0776fSJose E. Roman MODULE solver_context_interfaces_ex6f 18*aca0776fSJose E. Roman USE solver_context_ex6f 19c4762a1bSJed Brown IMPLICIT NONE 20c4762a1bSJed Brown 21c4762a1bSJed Brown! ---------------------------------------------------- 22c4762a1bSJed Brown INTERFACE MatCreateShell 23c4762a1bSJed Brown SUBROUTINE MatCreateShell(comm,mloc,nloc,m,n,ctx,mat,ierr) 24*aca0776fSJose E. Roman USE solver_context_ex6f 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) 37*aca0776fSJose E. Roman USE solver_context_ex6f 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) 48*aca0776fSJose E. Roman USE solver_context_ex6f 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 55*aca0776fSJose E. Roman END MODULE solver_context_interfaces_ex6f 56c4762a1bSJed Brown 57c4762a1bSJed Brown! ---------------------------------------------------- 58c4762a1bSJed Brown! main program 59c4762a1bSJed Brown! ---------------------------------------------------- 60c4762a1bSJed Brown PROGRAM main 61c4762a1bSJed Brown#include "petsc/finclude/petsc.h" 62*aca0776fSJose E. Roman USE solver_context_interfaces_ex6f 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 70d8606c27SBarry Smith PetscCallA(PetscInitialize(ierr)) 71c4762a1bSJed Brown ctxF%lambda = 3.14d0 72d8606c27SBarry Smith PetscCallA(MatCreateShell(PETSC_COMM_WORLD,n,n,n,n,ctxF,F,ierr)) 73d8606c27SBarry Smith PetscCallA(MatShellSetContext(F,ctxF,ierr)) 74c4762a1bSJed Brown PRINT*,'ctxF%lambda = ',ctxF%lambda 75c4762a1bSJed Brown 76d8606c27SBarry Smith PetscCallA(MatShellGetContext(F,ctxF_pt,ierr)) 77c4762a1bSJed Brown PRINT*,'ctxF_pt%lambda = ',ctxF_pt%lambda 78c4762a1bSJed Brown 79d8606c27SBarry Smith PetscCallA(MatDestroy(F,ierr)) 80d8606c27SBarry 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