xref: /petsc/src/vec/is/tests/ex4f.F90 (revision 7aaa936abd98b72be50996694f41f3f368804f34)
1*7aaa936aSBarry Smith!
2*7aaa936aSBarry Smith!     Test for bug with ISGetIndicesF90() when length of indices is 0
3*7aaa936aSBarry Smith!
4*7aaa936aSBarry Smith!     Contributed by: Jakub Fabian
5*7aaa936aSBarry Smith!
6*7aaa936aSBarry Smithprogram main
7*7aaa936aSBarry Smith#include <petsc/finclude/petscis.h>
8*7aaa936aSBarry Smith  use petscis
9*7aaa936aSBarry Smith  implicit none
10*7aaa936aSBarry Smith
11*7aaa936aSBarry Smith  PetscErrorCode ierr
12*7aaa936aSBarry Smith  PetscInt n, bs
13*7aaa936aSBarry Smith  PetscInt, pointer :: indices(:)=>NULL()
14*7aaa936aSBarry Smith  PetscInt, pointer :: idx(:)=>NULL()
15*7aaa936aSBarry Smith  IS      is
16*7aaa936aSBarry Smith
17*7aaa936aSBarry Smith  n = 0
18*7aaa936aSBarry Smith  allocate(indices(n), source=n)
19*7aaa936aSBarry Smith
20*7aaa936aSBarry Smith  call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
21*7aaa936aSBarry Smith
22*7aaa936aSBarry Smith  call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_USE_POINTER,is,ierr);CHKERRA(ierr)
23*7aaa936aSBarry Smith  call ISGetIndicesF90(is,idx,ierr);CHKERRA(ierr)
24*7aaa936aSBarry Smith  call ISRestoreIndicesF90(is,idx,ierr);CHKERRA(ierr)
25*7aaa936aSBarry Smith  call ISDestroy(is,ierr);CHKERRA(ierr)
26*7aaa936aSBarry Smith
27*7aaa936aSBarry Smith  bs = 2
28*7aaa936aSBarry Smith  call ISCreateBlock(PETSC_COMM_SELF,bs,n,indices,PETSC_USE_POINTER,is,ierr);CHKERRA(ierr)
29*7aaa936aSBarry Smith  call ISGetIndicesF90(is,idx,ierr);CHKERRA(ierr)
30*7aaa936aSBarry Smith  call ISRestoreIndicesF90(is,idx,ierr);CHKERRA(ierr)
31*7aaa936aSBarry Smith  call ISDestroy(is,ierr);CHKERRA(ierr)
32*7aaa936aSBarry Smith  call PetscFinalize(ierr)
33*7aaa936aSBarry Smithend
34*7aaa936aSBarry Smith
35*7aaa936aSBarry Smith!/*TEST
36*7aaa936aSBarry Smith!
37*7aaa936aSBarry Smith!   test:
38*7aaa936aSBarry Smith!
39*7aaa936aSBarry Smith!TEST*/
40