Actual source code: ex2f.F90
1: !
2: ! Formatted Test for IS stride routines
3: !
4: program main
5: #include <petsc/finclude/petscis.h>
6: use petscis
7: implicit none
9: PetscErrorCode ierr
10: PetscInt i,n,ii(1),start
11: PetscInt stride,ssize,first
12: IS is
13: PetscBool flag
14: PetscOffset iis
16: PetscCallA(PetscInitialize(ierr))
18: ! Test IS of size 0
19: ssize = 0
20: stride = 0
21: first = 2
22: PetscCallA(ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr))
23: PetscCallA(ISGetLocalSize(is,n,ierr))
24: if (n .ne. 0) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISCreateStride'); endif
26: PetscCallA(ISStrideGetInfo(is,start,stride,ierr))
27: if (start .ne. 0) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISStrideGetInfo'); endif
29: if (stride .ne. 2) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISStrideGetInfo') ; endif
31: PetscCallA(PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr))
32: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from PetscObjectTypeCompare'); endif
33: PetscCallA(ISGetIndices(is,ii,iis,ierr))
34: PetscCallA(ISRestoreIndices(is,ii,iis,ierr))
35: PetscCallA(ISDestroy(is,ierr))
37: ! Test ISGetIndices()
39: ssize = 10000
40: stride = -8
41: first = 3
42: PetscCallA(ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr))
43: PetscCallA(ISGetLocalSize(is,n,ierr))
44: PetscCallA(ISGetIndices(is,ii,iis,ierr))
45: do 10, i=1,n
46: if (ii(i+iis) .ne. -11 + 3*i) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISGetIndices'); endif
47: 10 continue
48: PetscCallA(ISRestoreIndices(is,ii,iis,ierr))
49: PetscCallA(ISDestroy(is,ierr))
51: PetscCallA(PetscFinalize(ierr))
52: end
54: !/*TEST
55: !
56: ! test:
57: ! output_file: output/ex1_1.out
58: !
59: !TEST*/