1! 2! This program demonstrates use of MatCreateSubMatrices() from Fortran 3! 4 program main 5#include <petsc/finclude/petscmat.h> 6 use petscmat 7 implicit none 8 9 Mat A 10 Mat, pointer :: B(:) 11 PetscErrorCode ierr 12 PetscInt nis,zero(1) 13 PetscViewer v 14 IS isrow 15 PetscMPIInt rank 16 17 PetscCallA(PetscInitialize(ierr)) 18 PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)) 19 20#if defined(PETSC_USE_64BIT_INDICES) 21 PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD,'${PETSC_DIR}/share/petsc/datafiles/matrices/' // 'ns-real-int64-float64',FILE_MODE_READ,v,ierr)) 22#else 23 PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD,'${PETSC_DIR}/share/petsc/datafiles/matrices/' // 'ns-real-int32-float64',FILE_MODE_READ,v,ierr)) 24#endif 25 26 PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr)) 27 PetscCallA(MatSetType(A, MATAIJ,ierr)) 28 PetscCallA(MatLoad(A,v,ierr)) 29 30 nis = 1 31 zero(1) = 0 32 if (rank .eq. 1) then 33 nis = 0 ! test nis = 0 34 endif 35 PetscCallA(ISCreateGeneral(PETSC_COMM_SELF,nis,zero,PETSC_COPY_VALUES,isrow,ierr)) 36 37 PetscCallA(MatCreateSubmatrices(A,nis,[isrow],[isrow],MAT_INITIAL_MATRIX,B,ierr)) 38 39 if (rank .eq. 0) then 40 PetscCallA(MatView(B(1),PETSC_VIEWER_STDOUT_SELF,ierr)) 41 endif 42 43 PetscCallA(MatCreateSubmatrices(A,nis,[isrow],[isrow],MAT_REUSE_MATRIX,B,ierr)) 44 45 if (rank .eq. 0) then 46 PetscCallA(MatView(B(1),PETSC_VIEWER_STDOUT_SELF,ierr)) 47 endif 48 49 PetscCallA(ISDestroy(isrow,ierr)) 50 PetscCallA(MatDestroy(A,ierr)) 51 PetscCallA(MatDestroySubMatrices(nis,B,ierr)) 52 PetscCallA(PetscViewerDestroy(v,ierr)) 53 54 PetscCallA(PetscFinalize(ierr)) 55 end 56 57!/*TEST 58! 59! test: 60! requires: double !complex 61! 62!TEST*/ 63