Actual source code: ex6f.F90

      1: !
      2: !     Demonstrates use of MatShellSetContext() and MatShellGetContext()
      3: !
      4: !     Contributed by:  Samuel Lanthaler
      5: !
      6: MODULE 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
     15: END MODULE solver_context_ex6f

     17: MODULE solver_context_interfaces_ex6f
     18:   USE solver_context_ex6f
     19:   IMPLICIT NONE

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

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

     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

     55: END MODULE solver_context_interfaces_ex6f

     57: ! ----------------------------------------------------
     58: !                    main program
     59: ! ----------------------------------------------------
     60: PROGRAM 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

     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

     76:   PetscCallA(MatShellGetContext(F, ctxF_pt, ierr))
     77:   PRINT *, 'ctxF_pt%lambda = ', ctxF_pt%lambda

     79:   PetscCallA(MatDestroy(F, ierr))
     80:   PetscCallA(PetscFinalize(ierr))
     81: END PROGRAM main

     83: !/*TEST
     84: !
     85: !     build:
     86: !       requires: double
     87: !
     88: !     test:
     89: !
     90: !TEST*/