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*/