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