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 MPI_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 MPI_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 MPI_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