xref: /petsc/src/vec/is/tests/ex4f.F90 (revision 4e278199b78715991f5c71ebbd945c1489263e6c)
1!
2!     Test for bug with ISGetIndicesF90() when length of indices is 0
3!
4!     Contributed by: Jakub Fabian
5!
6program main
7#include <petsc/finclude/petscis.h>
8  use petscis
9  implicit none
10
11  PetscErrorCode ierr
12  PetscInt n, bs
13  PetscInt, pointer :: indices(:)=>NULL()
14  PetscInt, pointer :: idx(:)=>NULL()
15  IS      is
16
17  n = 0
18  allocate(indices(n), source=n)
19
20  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
21
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)
26
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)
33end
34
35!/*TEST
36!
37!   test:
38!
39!TEST*/
40