Actual source code: ex4f.F90

petsc-3.14.3 2021-01-09
Report Typos and Errors
  1: !
  2: !     Test for bug with ISGetIndicesF90() when length of indices is 0
  3: !
  4: !     Contributed by: Jakub Fabian
  5: !
  6: program main
  7: #include <petsc/finclude/petscis.h>
  8:   use petscis
  9:   implicit none

 11:   PetscErrorCode ierr
 12:   PetscInt n, bs
 13:   PetscInt, pointer :: indices(:)=>NULL()
 14:   PetscInt, pointer :: idx(:)=>NULL()
 15:   IS      is

 17:   n = 0
 18:   allocate(indices(n), source=n)

 20:   call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 22:   call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_USE_POINTER,is,ierr);CHKERRA(ierr)
 23:   call ISGetIndicesF90(is,idx,ierr);CHKERRA(ierr)
 24:   call ISRestoreIndicesF90(is,idx,ierr);CHKERRA(ierr)
 25:   call ISDestroy(is,ierr);CHKERRA(ierr)

 27:   bs = 2
 28:   call ISCreateBlock(PETSC_COMM_SELF,bs,n,indices,PETSC_USE_POINTER,is,ierr);CHKERRA(ierr)
 29:   call ISGetIndicesF90(is,idx,ierr);CHKERRA(ierr)
 30:   call ISRestoreIndicesF90(is,idx,ierr);CHKERRA(ierr)
 31:   call ISDestroy(is,ierr);CHKERRA(ierr)
 32:   call PetscFinalize(ierr)
 33: end

 35: !/*TEST
 36: !
 37: !   test:
 38: !
 39: !TEST*/