Actual source code: ex2f.F
1: !
2: ! Formatted Test for IS stride routines
3: !
4: program main
5: implicit none
6: #include finclude/petscsys.h
7: #include finclude/petscis.h
9: PetscErrorCode ierr
10: PetscInt i,n,ii(1),start
11: PetscInt stride,ssize,first
12: IS is
13: PetscTruth flag
14: PetscOffset iis
16: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
18: ! Test IS of size 0
19: ssize = 0
20: stride = 0
21: first = 2
22: call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
23: call ISGetLocalSize(is,n,ierr)
24: if (n .ne. 0) then
25: SETERRQ(1,0,ierr)
26: endif
27: call ISStrideGetInfo(is,start,stride,ierr)
28: if (start .ne. 0) then
29: SETERRQ(1,0,ierr)
30: endif
31: if (stride .ne. 2) then
32: SETERRQ(1,0,ierr)
33: endif
34: call ISStride(is,flag,ierr)
35: if (.not. flag) then
36: SETERRQ(1,0,ierr)
37: endif
38: call ISGetIndices(is,ii,iis,ierr)
39: call ISRestoreIndices(is,ii,iis,ierr)
40: call ISDestroy(is,ierr)
42: ! Test ISGetIndices()
44: ssize = 10000
45: stride = -8
46: first = 3
47: call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
48: call ISGetLocalSize(is,n,ierr)
49: call ISGetIndices(is,ii,iis,ierr)
50: do 10, i=1,10000
51: if (ii(i+iis) .ne. -11 + 3*i) then
52: SETERRQ(1,0,ierr)
53: endif
54: 10 continue
55: call ISRestoreIndices(is,ii,iis,ierr)
56: call ISDestroy(is,ierr)
58: call PetscFinalize(ierr)
59: end
60: