Actual source code: ex67f.F

petsc-3.13.4 2020-08-01
Report Typos and Errors
  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

  9:       Mat             A,B(2)
 10:       PetscErrorCode  ierr
 11:       PetscInt        nis,zero(1)
 12:       PetscViewer     v
 13:       IS              isrow
 14:       PetscMPIInt     rank

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 17:       if (ierr .ne. 0) then
 18:         print*,'Unable to initialize PETSc'
 19:         stop
 20:       endif
 21:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)

 23: #if defined(PETSC_USE_64BIT_INDICES)
 24:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,                          &
 25:      & '${PETSC_DIR}/share/petsc/datafiles/matrices/' //                       &
 26:      & 'ns-real-int64-float64',                                               &
 27:      &                          FILE_MODE_READ,v,ierr)
 28: #else
 29:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,                          &
 30:      & '${PETSC_DIR}/share/petsc/datafiles/matrices/' //                       &
 31:      & 'ns-real-int32-float64',                                               &
 32:      &                          FILE_MODE_READ,v,ierr)
 33: #endif

 35:       call MatCreate(PETSC_COMM_WORLD,A,ierr)
 36:       call MatSetType(A, MATAIJ,ierr)
 37:       call MatLoad(A,v,ierr)

 39:       nis     = 1
 40:       zero(1) = 0
 41:       if (rank .eq. 1) then
 42:          nis = 0 ! test nis = 0
 43:       endif
 44:       call ISCreateGeneral(PETSC_COMM_SELF,nis,zero,PETSC_COPY_VALUES,    &
 45:      &                     isrow,ierr)

 47:       call MatCreateSubmatrices(A,nis,isrow,isrow,                           &
 48:      &        MAT_INITIAL_MATRIX,B,ierr)

 50:       if (rank .eq. 0) then
 51:          call MatView(B(1),PETSC_VIEWER_STDOUT_SELF,ierr)
 52:       endif

 54:       call MatCreateSubmatrices(A,nis,isrow,isrow,                           &
 55:      &        MAT_REUSE_MATRIX,B,ierr)

 57:       if (rank .eq. 0) then
 58:          call MatView(B(1),PETSC_VIEWER_STDOUT_SELF,ierr)
 59:       endif

 61:       call ISDestroy(isrow,ierr)
 62:       call MatDestroy(A,ierr)
 63:       call MatDestroySubMatrices(nis,B,ierr)
 64:       call PetscViewerDestroy(v,ierr)

 66:       call PetscFinalize(ierr)
 67:       end

 69: !/*TEST
 70: !
 71: !     test:
 72: !        requires: double !complex
 73: !
 74: !TEST*/