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*/