xref: /petsc/src/mat/tutorials/ex6f.F90 (revision 4e8208cbcbc709572b8abe32f33c78b69c819375) !
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!     Demonstrates use of MatShellSetContext() and MatShellGetContext()
3c4762a1bSJed Brown!
4c4762a1bSJed Brown!     Contributed by:  Samuel Lanthaler
5c4762a1bSJed Brown!
601fa2b5aSMartin Diehl#include "petsc/finclude/petscmat.h"
702c639afSMartin Diehlmodule solver_context_ex6f
801fa2b5aSMartin Diehl  use petscsys
902c639afSMartin Diehl  implicit none
1002c639afSMartin Diehl  type :: MatCtx
11c4762a1bSJed Brown    PetscReal :: lambda, kappa
12c4762a1bSJed Brown    PetscReal :: h
1302c639afSMartin Diehl  end type MatCtx
1402c639afSMartin Diehlend module solver_context_ex6f
15c4762a1bSJed Brown
16c4762a1bSJed Brown! ----------------------------------------------------
17c4762a1bSJed Brown!                    main program
18c4762a1bSJed Brown! ----------------------------------------------------
1902c639afSMartin Diehlprogram main
2001fa2b5aSMartin Diehl  use petscmat
2102c639afSMartin Diehl  use solver_context_ex6f
2202c639afSMartin Diehl  implicit none
23*2a8381b2SBarry Smith
24c4762a1bSJed Brown  Mat :: F
2502c639afSMartin Diehl  type(MatCtx) :: ctxF
2602c639afSMartin Diehl  type(MatCtx), pointer :: ctxF_pt
27c4762a1bSJed Brown  PetscErrorCode :: ierr
28c4762a1bSJed Brown  PetscInt :: n = 128
29c4762a1bSJed Brown
30d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
31c4762a1bSJed Brown  ctxF%lambda = 3.14d0
32d8606c27SBarry Smith  PetscCallA(MatCreateShell(PETSC_COMM_WORLD, n, n, n, n, ctxF, F, ierr))
33d8606c27SBarry Smith  PetscCallA(MatShellSetContext(F, ctxF, ierr))
3402c639afSMartin Diehl  print *, 'ctxF%lambda = ', ctxF%lambda
35c4762a1bSJed Brown
36d8606c27SBarry Smith  PetscCallA(MatShellGetContext(F, ctxF_pt, ierr))
3702c639afSMartin Diehl  print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda
38c4762a1bSJed Brown
39d8606c27SBarry Smith  PetscCallA(MatDestroy(F, ierr))
40d8606c27SBarry Smith  PetscCallA(PetscFinalize(ierr))
4102c639afSMartin Diehlend program main
42c4762a1bSJed Brown
43c4762a1bSJed Brown!/*TEST
44c4762a1bSJed Brown!
45c4762a1bSJed Brown!     build:
46c4762a1bSJed Brown!       requires: double
47c4762a1bSJed Brown!
48c4762a1bSJed Brown!     test:
49c4762a1bSJed Brown!
50c4762a1bSJed Brown!TEST*/
51