1! 2! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3! 4! Contributed by: Samuel Lanthaler 5! 6MODULE 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 15END MODULE solver_context_ex6f 16 17MODULE solver_context_interfaces_ex6f 18 USE solver_context_ex6f 19 IMPLICIT NONE 20 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! ---------------------------------------------------- 33 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! ---------------------------------------------------- 44 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 54 55END MODULE solver_context_interfaces_ex6f 56 57! ---------------------------------------------------- 58! main program 59! ---------------------------------------------------- 60PROGRAM 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 69 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 75 76 PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 77 PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 78 79 PetscCallA(MatDestroy(F, ierr)) 80 PetscCallA(PetscFinalize(ierr)) 81END PROGRAM main 82 83!/*TEST 84! 85! build: 86! requires: double 87! 88! test: 89! 90!TEST*/ 91