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 == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISCreateStride')
26: PetscCallA(ISStrideGetInfo(is, start, stride, ierr))
27: PetscCheckA(start == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISStrideGetInfo')
28: PetscCheckA(stride == 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(ISGetIndices(is, ii, ierr))
33: PetscCallA(ISRestoreIndices(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(ISGetIndices(is, ii, ierr))
44: do 10, i = 1, n
45: PetscCheckA(ii(i) == -11 + 3*i, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Wrong result from ISGetIndices')
46: 10 continue
47: PetscCallA(ISRestoreIndices(is, ii, ierr))
48: PetscCallA(ISDestroy(is, ierr))
50: PetscCallA(PetscFinalize(ierr))
51: end
53: !/*TEST
54: !
55: ! test:
56: ! output_file: output/empty.out
57: !
58: !TEST*/