Actual source code: ex4f.F90

  1: !
  2: !     Test for bug with ISGetIndices() 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:   PetscCallA(PetscInitialize(ierr))

 22:   PetscCallA(ISCreateGeneral(PETSC_COMM_SELF, n, indices, PETSC_USE_POINTER, is, ierr))
 23:   PetscCallA(ISGetIndices(is, idx, ierr))
 24:   PetscCallA(ISRestoreIndices(is, idx, ierr))
 25:   PetscCallA(ISDestroy(is, ierr))

 27:   bs = 2
 28:   PetscCallA(ISCreateBlock(PETSC_COMM_SELF, bs, n, indices, PETSC_USE_POINTER, is, ierr))
 29:   PetscCallA(ISGetIndices(is, idx, ierr))
 30:   PetscCallA(ISRestoreIndices(is, idx, ierr))
 31:   PetscCallA(ISDestroy(is, ierr))
 32:   PetscCallA(PetscFinalize(ierr))
 33: end

 35: !/*TEST
 36: !
 37: !   test:
 38: !      output_file: output/empty.out
 39: !
 40: !TEST*/