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