1: !
  2: !     Demonstrates use of MatShellSetContext() and MatShellGetContext()
  3: !
  4: !     Contributed by:  Samuel Lanthaler
  5: !
  6: #include "petsc/finclude/petscmat.h"
  7: module solver_context_ex6f
  8:   use petscsys
  9:   implicit none
 10:   type :: MatCtx
 11:     PetscReal :: lambda, kappa
 12:     PetscReal :: h
 13:   end type MatCtx

 15: ! ----------------------------------------------------
 16:   interface
 17:     subroutine MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr)
 18:       use petscmat
 19:       import MatCtx
 20:       implicit none
 21:       MPI_Comm :: comm
 22:       PetscInt :: mloc, nloc, m, n
 23:       type(MatCtx) :: ctx
 24:       Mat :: mat
 25:       PetscErrorCode :: ierr
 26:     end subroutine MatCreateShell
 27: ! ----------------------------------------------------
 28:     subroutine MatShellSetContext(mat, ctx, ierr)
 29:       use petscmat
 30:       import MatCtx
 31:       implicit none
 32:       MPI_Comm :: comm
 33:       Mat :: mat
 34:       type(MatCtx) :: ctx
 35:       PetscErrorCode :: ierr
 36:     end subroutine MatShellSetContext
 37: ! ----------------------------------------------------
 38:     subroutine MatShellGetContext(mat, ctx, ierr)
 39:       use petscmat
 40:       import MatCtx
 41:       implicit none
 42:       MPI_Comm :: comm
 43:       Mat :: mat
 44:       type(MatCtx), pointer :: ctx
 45:       PetscErrorCode :: ierr
 46:     end subroutine MatShellGetContext
 47:   end interface

 49: end module solver_context_ex6f

 51: ! ----------------------------------------------------
 52: !                    main program
 53: ! ----------------------------------------------------
 54: program main
 55:   use petscmat
 56:   use solver_context_ex6f
 57:   implicit none
 58:   Mat :: F
 59:   type(MatCtx) :: ctxF
 60:   type(MatCtx), pointer :: ctxF_pt
 61:   PetscErrorCode :: ierr
 62:   PetscInt :: n = 128

 64:   PetscCallA(PetscInitialize(ierr))
 65:   ctxF%lambda = 3.14d0
 66:   PetscCallA(MatCreateShell(PETSC_COMM_WORLD, n, n, n, n, ctxF, F, ierr))
 67:   PetscCallA(MatShellSetContext(F, ctxF, ierr))
 68:   print *, 'ctxF%lambda = ', ctxF%lambda

 70:   PetscCallA(MatShellGetContext(F, ctxF_pt, ierr))
 71:   print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda

 73:   PetscCallA(MatDestroy(F, ierr))
 74:   PetscCallA(PetscFinalize(ierr))
 75: end program main

 77: !/*TEST
 78: !
 79: !     build:
 80: !       requires: double
 81: !
 82: !     test:
 83: !
 84: !TEST*/