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,start
11: PetscInt stride,ssize,first
12: IS is
13: PetscBool flag
14: PetscInt, pointer :: ii(:)
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: PetscCheckA(n .eq. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISCreateStride')
26: PetscCallA(ISStrideGetInfo(is,start,stride,ierr))
27: PetscCheckA(start .eq. 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISStrideGetInfo')
28: PetscCheckA(stride .eq. 2,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISStrideGetInfo')
30: PetscCallA(PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr))
31: PetscCheckA(flag,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from PetscObjectTypeCompare')
32: PetscCallA(ISGetIndicesF90(is,ii,ierr))
33: PetscCallA(ISRestoreIndicesF90(is,ii,ierr))
34: PetscCallA(ISDestroy(is,ierr))
36: ! Test ISGetIndices()
38: ssize = 10000
39: stride = -8
40: first = 3
41: PetscCallA(ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr))
42: PetscCallA(ISGetLocalSize(is,n,ierr))
43: PetscCallA(ISGetIndicesF90(is,ii,ierr))
44: do 10, i=1,n
45: PetscCheckA(ii(i) .eq. -11 + 3*i,PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISGetIndices')
46: 10 continue
47: PetscCallA(ISRestoreIndicesF90(is,ii,ierr))
48: PetscCallA(ISDestroy(is,ierr))
50: PetscCallA(PetscFinalize(ierr))
51: end
53: !/*TEST
54: !
55: ! test:
56: ! output_file: output/ex1_1.out
57: !
58: !TEST*/