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