1! 2! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3! 4! Contributed by: Samuel Lanthaler 5! 6#include "petsc/finclude/petsc.h" 7MODULE solver_context_ex6f 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 USE solver_context_interfaces_ex6f 62 IMPLICIT NONE 63 Mat :: F 64 TYPE(MatCtx) :: ctxF 65 TYPE(MatCtx), POINTER :: ctxF_pt 66 PetscErrorCode :: ierr 67 PetscInt :: n = 128 68 69 PetscCallA(PetscInitialize(ierr)) 70 ctxF%lambda = 3.14d0 71 PetscCallA(MatCreateShell(PETSC_COMM_WORLD, n, n, n, n, ctxF, F, ierr)) 72 PetscCallA(MatShellSetContext(F, ctxF, ierr)) 73 PRINT *, 'ctxF%lambda = ', ctxF%lambda 74 75 PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 76 PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 77 78 PetscCallA(MatDestroy(F, ierr)) 79 PetscCallA(PetscFinalize(ierr)) 80END PROGRAM main 81 82!/*TEST 83! 84! build: 85! requires: double 86! 87! test: 88! 89!TEST*/ 90