1: !
  2: !     Demonstrates use of MatShellSetContext() and MatShellGetContext()
  3: !
  4: !     Contributed by:  Samuel Lanthaler
  5: !
  6: MODULE solver_context_ex6f
  7: #include "petsc/finclude/petsc.h"
  8:   USE petscsys
  9:   USE petscmat
 10:   IMPLICIT NONE
 11:   TYPE :: MatCtx
 12:     PetscReal :: lambda, kappa
 13:     PetscReal :: h
 14:   END TYPE MatCtx
 15: END MODULE solver_context_ex6f

 17: MODULE solver_context_interfaces_ex6f
 18:   USE solver_context_ex6f
 19:   IMPLICIT NONE

 21: ! ----------------------------------------------------
 22:   INTERFACE MatCreateShell
 23:     SUBROUTINE MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr)
 24:       USE solver_context_ex6f
 25:       MPI_Comm :: comm
 26:       PetscInt :: mloc, nloc, m, n
 27:       TYPE(MatCtx) :: ctx
 28:       Mat :: mat
 29:       PetscErrorCode :: ierr
 30:     END SUBROUTINE MatCreateShell
 31:   END INTERFACE MatCreateShell
 32: ! ----------------------------------------------------

 34: ! ----------------------------------------------------
 35:   INTERFACE MatShellSetContext
 36:     SUBROUTINE MatShellSetContext(mat, ctx, ierr)
 37:       USE solver_context_ex6f
 38:       Mat :: mat
 39:       TYPE(MatCtx) :: ctx
 40:       PetscErrorCode :: ierr
 41:     END SUBROUTINE MatShellSetContext
 42:   END INTERFACE MatShellSetContext
 43: ! ----------------------------------------------------

 45: ! ----------------------------------------------------
 46:   INTERFACE MatShellGetContext
 47:     SUBROUTINE MatShellGetContext(mat, ctx, ierr)
 48:       USE solver_context_ex6f
 49:       Mat :: mat
 50:       TYPE(MatCtx), POINTER :: ctx
 51:       PetscErrorCode :: ierr
 52:     END SUBROUTINE MatShellGetContext
 53:   END INTERFACE MatShellGetContext

 55: END MODULE solver_context_interfaces_ex6f

 57: ! ----------------------------------------------------
 58: !                    main program
 59: ! ----------------------------------------------------
 60: PROGRAM main
 61: #include "petsc/finclude/petsc.h"
 62:   USE solver_context_interfaces_ex6f
 63:   IMPLICIT NONE
 64:   Mat :: F
 65:   TYPE(MatCtx) :: ctxF
 66:   TYPE(MatCtx), POINTER :: ctxF_pt
 67:   PetscErrorCode :: ierr
 68:   PetscInt :: n = 128

 70:   PetscCallA(PetscInitialize(ierr))
 71:   ctxF%lambda = 3.14d0
 72:   PetscCallA(MatCreateShell(PETSC_COMM_WORLD, n, n, n, n, ctxF, F, ierr))
 73:   PetscCallA(MatShellSetContext(F, ctxF, ierr))
 74:   PRINT *, 'ctxF%lambda = ', ctxF%lambda

 76:   PetscCallA(MatShellGetContext(F, ctxF_pt, ierr))
 77:   PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda

 79:   PetscCallA(MatDestroy(F, ierr))
 80:   PetscCallA(PetscFinalize(ierr))
 81: END PROGRAM main

 83: !/*TEST
 84: !
 85: !     build:
 86: !       requires: double
 87: !
 88: !     test:
 89: !
 90: !TEST*/