Date: 2025-03-28T21:11:06+00:00

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*/