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 MPI_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