1! 2! Demonstrates use of MatDuplicate() for a shell matrix with a context 3! 4#include "petsc/finclude/petscmat.h" 5module ex20fmodule 6 use petscmat 7 implicit none 8 type :: MatCtx 9 PetscReal :: lambda 10 end type MatCtx 11 12 interface 13 subroutine MatCreateShell(comm, mloc, nloc, m, n, ctx, mat, ierr) 14 use petscmat 15 import MatCtx 16 implicit none 17 MPIU_Comm :: comm 18 PetscInt :: mloc, nloc, m, n 19 type(MatCtx) :: ctx 20 Mat :: mat 21 PetscErrorCode :: ierr 22 end subroutine MatCreateShell 23 24 subroutine MatShellSetContext(mat, ctx, ierr) 25 use petscmat 26 import MatCtx 27 implicit none 28 Mat :: mat 29 type(MatCtx) :: ctx 30 PetscErrorCode :: ierr 31 end subroutine MatShellSetContext 32 33 subroutine MatShellGetContext(mat, ctx, ierr) 34 use petscmat 35 import MatCtx 36 implicit none 37 Mat :: mat 38 type(MatCtx), pointer :: ctx 39 PetscErrorCode :: ierr 40 end subroutine MatShellGetContext 41 end interface 42 43contains 44 subroutine MatDuplicate_F(F, opt, M, ierr) 45 46 Mat :: F, M 47 MatDuplicateOption :: opt 48 PetscErrorCode :: ierr 49 PetscInt :: ml, nl 50 type(MatCtx), pointer :: ctxM, ctxF_pt 51 52 PetscCall(MatGetLocalSize(F, ml, nl, ierr)) 53 PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 54 allocate (ctxM) 55 ctxM%lambda = ctxF_pt%lambda 56 PetscCall(MatCreateShell(PETSC_COMM_WORLD, ml, nl, PETSC_DETERMINE, PETSC_DETERMINE, ctxM, M, ierr)) 57! PetscCall(MatShellSetOperation(M,MATOP_DUPLICATE,MatDuplicate_F,ierr)) 58 PetscCall(MatShellSetOperation(M, MATOP_DESTROY, MatDestroy_F, ierr)) 59 end subroutine MatDuplicate_F 60 61 subroutine MatDestroy_F(F, ierr) 62 63 Mat :: F 64 PetscErrorCode :: ierr 65 type(MatCtx), pointer :: ctxF_pt 66 PetscCall(MatShellGetContext(F, ctxF_pt, ierr)) 67 deallocate (ctxF_pt) 68 end subroutine MatDestroy_F 69 70end module ex20fmodule 71 72! ---------------------------------------------------- 73! main program 74! ---------------------------------------------------- 75program main 76 use ex20fmodule 77 implicit none 78 Mat :: F, Fcopy 79 type(MatCtx) :: ctxF 80 type(MatCtx), pointer :: ctxF_pt, ctxFcopy_pt 81 PetscErrorCode :: ierr 82 PetscInt :: n = 128 83 84 PetscCallA(PetscInitialize(ierr)) 85 ctxF%lambda = 3.14d0 86 PetscCallA(MatCreateShell(PETSC_COMM_WORLD, PETSC_DECIDE, PETSC_DECIDE, n, n, ctxF, F, ierr)) 87 PetscCallA(MatShellSetOperation(F, MATOP_DUPLICATE, MatDuplicate_F, ierr)) 88 print *, 'ctxF%lambda = ', ctxF%lambda 89 90 PetscCallA(MatShellGetContext(F, ctxF_pt, ierr)) 91 print *, 'ctxF_pt%lambda = ', ctxF_pt%lambda 92 93 PetscCallA(MatDuplicate(F, MAT_DO_NOT_COPY_VALUES, Fcopy, ierr)) 94 PetscCallA(MatShellGetContext(Fcopy, ctxFcopy_pt, ierr)) 95 print *, 'ctxFcopy_pt%lambda = ', ctxFcopy_pt%lambda 96 97 PetscCallA(MatDestroy(F, ierr)) 98 PetscCallA(MatDestroy(Fcopy, ierr)) 99 PetscCallA(PetscFinalize(ierr)) 100end program main 101 102!/*TEST 103! 104! build: 105! requires: double 106! 107! test: 108! 109!TEST*/ 110