1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3c4762a1bSJed Brown! 4c4762a1bSJed Brown! Contributed by: Samuel Lanthaler 5c4762a1bSJed Brown! 601fa2b5aSMartin Diehl#include "petsc/finclude/petscmat.h" 7*02c639afSMartin Diehlmodule solver_context_ex6f 801fa2b5aSMartin Diehl use petscsys 9*02c639afSMartin Diehl implicit none 10*02c639afSMartin Diehl type :: MatCtx 11c4762a1bSJed Brown PetscReal :: lambda, kappa 12c4762a1bSJed Brown PetscReal :: h 13*02c639afSMartin Diehl end type MatCtx 14c4762a1bSJed Brown 15c4762a1bSJed Brown! ---------------------------------------------------- 16*02c639afSMartin Diehl interface 17*02c639afSMartin Diehl subroutine MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr) 1801fa2b5aSMartin Diehl use petscmat 1901fa2b5aSMartin Diehl import MatCtx 2001fa2b5aSMartin Diehl implicit none 21c4762a1bSJed Brown MPI_Comm :: comm 22c4762a1bSJed Brown PetscInt :: mloc, nloc, m, n 23*02c639afSMartin Diehl type(MatCtx) :: ctx 24c4762a1bSJed Brown Mat :: mat 25c4762a1bSJed Brown PetscErrorCode :: ierr 26*02c639afSMartin Diehl end subroutine MatCreateShell 27c4762a1bSJed Brown! ---------------------------------------------------- 28*02c639afSMartin Diehl subroutine MatShellSetContext(mat, ctx, ierr) 2901fa2b5aSMartin Diehl use petscmat 3001fa2b5aSMartin Diehl import MatCtx 3101fa2b5aSMartin Diehl implicit none 3201fa2b5aSMartin Diehl MPI_Comm :: comm 33c4762a1bSJed Brown Mat :: mat 34*02c639afSMartin Diehl type(MatCtx) :: ctx 35c4762a1bSJed Brown PetscErrorCode :: ierr 36*02c639afSMartin Diehl end subroutine MatShellSetContext 37c4762a1bSJed Brown! ---------------------------------------------------- 38*02c639afSMartin Diehl subroutine MatShellGetContext(mat, ctx, ierr) 3901fa2b5aSMartin Diehl use petscmat 4001fa2b5aSMartin Diehl import MatCtx 4101fa2b5aSMartin Diehl implicit none 4201fa2b5aSMartin Diehl MPI_Comm :: comm 43c4762a1bSJed Brown Mat :: mat 44*02c639afSMartin Diehl type(MatCtx), pointer :: ctx 45c4762a1bSJed Brown PetscErrorCode :: ierr 46*02c639afSMartin Diehl end subroutine MatShellGetContext 47*02c639afSMartin Diehl end interface 48c4762a1bSJed Brown 49*02c639afSMartin Diehlend module solver_context_ex6f 50c4762a1bSJed Brown 51c4762a1bSJed Brown! ---------------------------------------------------- 52c4762a1bSJed Brown! main program 53c4762a1bSJed Brown! ---------------------------------------------------- 54*02c639afSMartin Diehlprogram main 5501fa2b5aSMartin Diehl use petscmat 56*02c639afSMartin Diehl use solver_context_ex6f 57*02c639afSMartin Diehl implicit none 58c4762a1bSJed Brown Mat :: F 59*02c639afSMartin Diehl type(MatCtx) :: ctxF 60*02c639afSMartin Diehl 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)) 68*02c639afSMartin Diehl print *, 'ctxF%lambda = ', ctxF%lambda 69c4762a1bSJed Brown 70d8606c27SBarry Smith PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 71*02c639afSMartin Diehl print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 72c4762a1bSJed Brown 73d8606c27SBarry Smith PetscCallA(MatDestroy(F, ierr)) 74d8606c27SBarry Smith PetscCallA(PetscFinalize(ierr)) 75*02c639afSMartin Diehlend 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