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: #include <petsc/finclude/petscis.h>
  7: program main
  8:   use petscis
  9:   implicit none

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

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

 19:   PetscCallA(PetscInitialize(ierr))

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

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

 33: !/*TEST
 34: !
 35: !   test:
 36: !      output_file: output/empty.out
 37: !
 38: !TEST*/