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