1! 2! Demonstrates use of MatShellSetContext() and MatShellGetContext() 3! 4! Contributed by: Samuel Lanthaler 5! 6 MODULE solver_context 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 16 17 MODULE solver_context_interfaces 18 USE solver_context 19 IMPLICIT NONE 20 21! ---------------------------------------------------- 22 INTERFACE MatCreateShell 23 SUBROUTINE MatCreateShell(comm,mloc,nloc,m,n,ctx,mat,ierr) 24 USE solver_context 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 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 49 Mat :: mat 50 TYPE(MatCtx), POINTER :: ctx 51 PetscErrorCode :: ierr 52 END SUBROUTINE MatShellGetContext 53 END INTERFACE MatShellGetContext 54 55 END MODULE solver_context_interfaces 56 57! ---------------------------------------------------- 58! main program 59! ---------------------------------------------------- 60 PROGRAM main 61#include "petsc/finclude/petsc.h" 62 USE solver_context_interfaces 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 CALL PetscInitialize(PETSC_NULL_CHARACTER,ierr) 71 if (ierr .ne. 0) then 72 print*,'Unable to initialize PETSc' 73 stop 74 endif 75 76 ctxF%lambda = 3.14d0 77 CALL MatCreateShell(PETSC_COMM_WORLD,n,n,n,n,ctxF,F,ierr) 78 CALL MatShellSetContext(F,ctxF,ierr) 79 PRINT*,'ctxF%lambda = ',ctxF%lambda 80 81 CALL MatShellGetContext(F,ctxF_pt,ierr) 82 PRINT*,'ctxF_pt%lambda = ',ctxF_pt%lambda 83 84 call MatDestroy(F,ierr) 85 CALL PetscFinalize(ierr) 86 END PROGRAM main 87 88!/*TEST 89! 90! build: 91! requires: double 92! 93! test: 94! 95!TEST*/ 96