1! 2! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3! 4! Contributed by: Samuel Lanthaler 5! 6#include "petsc/finclude/petscmat.h" 7module solver_context_ex6f 8 use petscsys 9 implicit none 10 type :: MatCtx 11 PetscReal :: lambda, kappa 12 PetscReal :: h 13 end type MatCtx 14 15! ---------------------------------------------------- 16 interface 17 subroutine MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr) 18 use petscmat 19 import MatCtx 20 implicit none 21 MPIU_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 MPIU_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 MPIU_Comm :: comm 43 Mat :: mat 44 type(MatCtx), pointer :: ctx 45 PetscErrorCode :: ierr 46 end subroutine MatShellGetContext 47 end interface 48 49end module solver_context_ex6f 50 51! ---------------------------------------------------- 52! main program 53! ---------------------------------------------------- 54program 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 63 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 69 70 PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 71 print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 72 73 PetscCallA(MatDestroy(F, ierr)) 74 PetscCallA(PetscFinalize(ierr)) 75end program main 76 77!/*TEST 78! 79! build: 80! requires: double 81! 82! test: 83! 84!TEST*/ 85