Actual source code: ex4f.F90

  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:   PetscCallA(PetscInitialize(ierr))

 22:   PetscCallA(ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_USE_POINTER,is,ierr))
 23:   PetscCallA(ISGetIndicesF90(is,idx,ierr))
 24:   PetscCallA(ISRestoreIndicesF90(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(ISGetIndicesF90(is,idx,ierr))
 30:   PetscCallA(ISRestoreIndicesF90(is,idx,ierr))
 31:   PetscCallA(ISDestroy(is,ierr))
 32:   PetscCallA(PetscFinalize(ierr))
 33: end

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