Actual source code: ex6f.F90
petsc-3.12.4 2020-02-04
Report Typos and Errors

      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

     17:      MODULE solver_context_interfaces
     18:        USE solver_context
     19:        IMPLICIT NONE

     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: ! ----------------------------------------------------

     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: ! ----------------------------------------------------

     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

     55:      END MODULE solver_context_interfaces

     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

     70:        CALL PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     71:        if (ierr .ne. 0) then
     72:           print*,'Unable to initialize PETSc'
     73:           stop
     74:         endif

     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

     81:         CALL MatShellGetContext(F,ctxF_pt,ierr)
     82:         PRINT*,'ctxF_pt%lambda = ',ctxF_pt%lambda

     84:         call MatDestroy(F,ierr)
     85:         CALL PetscFinalize(ierr)
     86:       END PROGRAM main

     88: !/*TEST
     89: !
     90: !     build:
     91: !       requires: double
     92: !
     93: !     test:
     94: !
     95: !TEST*/