1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3c4762a1bSJed Brown! 4c4762a1bSJed Brown! Contributed by: Samuel Lanthaler 5c4762a1bSJed Brown! 6c4762a1bSJed Brown#include "petsc/finclude/petsc.h" 7*c5e229c2SMartin DiehlMODULE solver_context_ex6f 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 15aca0776fSJose E. RomanEND MODULE solver_context_ex6f 16c4762a1bSJed Brown 17aca0776fSJose E. RomanMODULE solver_context_interfaces_ex6f 18aca0776fSJose 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) 24aca0776fSJose 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) 37aca0776fSJose 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) 48aca0776fSJose 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 55aca0776fSJose E. RomanEND MODULE solver_context_interfaces_ex6f 56c4762a1bSJed Brown 57c4762a1bSJed Brown! ---------------------------------------------------- 58c4762a1bSJed Brown! main program 59c4762a1bSJed Brown! ---------------------------------------------------- 60c4762a1bSJed BrownPROGRAM main 61aca0776fSJose E. Roman USE solver_context_interfaces_ex6f 62c4762a1bSJed Brown IMPLICIT NONE 63c4762a1bSJed Brown Mat :: F 64c4762a1bSJed Brown TYPE(MatCtx) :: ctxF 65c4762a1bSJed Brown TYPE(MatCtx), POINTER :: ctxF_pt 66c4762a1bSJed Brown PetscErrorCode :: ierr 67c4762a1bSJed Brown PetscInt :: n = 128 68c4762a1bSJed Brown 69d8606c27SBarry Smith PetscCallA(PetscInitialize(ierr)) 70c4762a1bSJed Brown ctxF%lambda = 3.14d0 71d8606c27SBarry Smith PetscCallA(MatCreateShell(PETSC_COMM_WORLD, n, n, n, n, ctxF, F, ierr)) 72d8606c27SBarry Smith PetscCallA(MatShellSetContext(F, ctxF, ierr)) 73c4762a1bSJed Brown PRINT *, 'ctxF%lambda = ', ctxF%lambda 74c4762a1bSJed Brown 75d8606c27SBarry Smith PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 76c4762a1bSJed Brown PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 77c4762a1bSJed Brown 78d8606c27SBarry Smith PetscCallA(MatDestroy(F, ierr)) 79d8606c27SBarry Smith PetscCallA(PetscFinalize(ierr)) 80c4762a1bSJed BrownEND PROGRAM main 81c4762a1bSJed Brown 82c4762a1bSJed Brown!/*TEST 83c4762a1bSJed Brown! 84c4762a1bSJed Brown! build: 85c4762a1bSJed Brown! requires: double 86c4762a1bSJed Brown! 87c4762a1bSJed Brown! test: 88c4762a1bSJed Brown! 89c4762a1bSJed Brown!TEST*/ 90