Actual source code: ex2f.F90
petsc-3.12.2 2019-11-22
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: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
17: if (ierr .ne. 0) then
18: print*,'Unable to initialize PETSc'
19: stop
20: endif
21:
22: ! Test IS of size 0
23: ssize = 0
24: stride = 0
25: first = 2
26: call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
27: call ISGetLocalSize(is,n,ierr)
28: if (n .ne. 0) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISCreateStride'); endif
30: call ISStrideGetInfo(is,start,stride,ierr)
31: if (start .ne. 0) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISStrideGetInfo'); endif
33: if (stride .ne. 2) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISStrideGetInfo') ; endif
35: call PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr)
36: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from PetscObjectTypeCompare'); 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,n
50: if (ii(i+iis) .ne. -11 + 3*i) then; SETERRA(PETSC_COMM_SELF,1,'Wrong result from ISGetIndices'); endif
51: 10 continue
52: call ISRestoreIndices(is,ii,iis,ierr)
53: call ISDestroy(is,ierr)
55: call PetscFinalize(ierr)
56: end
58: !/*TEST
59: !
60: ! test:
61: ! output_file: output/ex1_1.out
62: !
63: !TEST*/