Actual source code: ex1f.F90
petsc-3.13.4 2020-08-01
1: !
2: !
3: ! Formatted test for IS general routines
4: !
5: program main
6: #include <petsc/finclude/petscis.h>
7: use petscis
8: implicit none
10: PetscErrorCode ierr
11: PetscInt i,n,indices(1004),ii(1)
12: PetscMPIInt size,rank
13: PetscOffset iis
14: IS is,newis
15: PetscBool flag,compute,permanent
17: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
18: if (ierr .ne. 0) then
19: print*,'Unable to initialize PETSc'
20: stop
21: endif
22: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
23: call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
25: ! Test IS of size 0
27: n = 0
28: call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,is,ierr);CHKERRA(ierr)
29: call ISGetLocalSize(is,n,ierr);CHKERRA(ierr)
30: if (n .ne. 0) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error getting size of zero IS'); endif
31: call ISDestroy(is,ierr)
34: ! Create large IS and test ISGetIndices(,ierr)
35: ! fortran indices start from 1 - but IS indices start from 0
36: n = 1000 + rank
37: do 10, i=1,n
38: indices(i) = rank + i-1
39: 10 continue
40: call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,is,ierr);CHKERRA(ierr)
41: call ISGetIndices(is,ii,iis,ierr);CHKERRA(ierr)
42: do 20, i=1,n
43: if (ii(i+iis) .ne. indices(i)) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error getting indices'); endif
44: 20 continue
45: call ISRestoreIndices(is,ii,iis,ierr);CHKERRA(ierr)
47: ! Check identity and permutation
49: compute = PETSC_TRUE
50: permanent = PETSC_FALSE
51: call ISPermutation(is,flag,ierr);CHKERRA(ierr)
52: if (flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking permutation'); endif
53: call ISGetInfo(is,IS_PERMUTATION,IS_LOCAL,compute,flag,ierr);CHKERRA(ierr)
54: !if ((rank .eq. 0) .and. (.not. flag)) SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"ISGetInfo(IS_PERMUTATION,IS_LOCAL)")
55: !if (rank .eq. 0 .and. flag) SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"ISGetInfo(IS_PERMUTATION,IS_LOCAL)")
56: call ISIdentity(is,flag,ierr);CHKERRA(ierr)
57: if ((rank .eq. 0) .and. (.not. flag)) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking identity'); endif
58: if ((rank .ne. 0) .and. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking identity'); endif
59: call ISSetInfo(is,IS_PERMUTATION,IS_LOCAL,permanent,PETSC_TRUE,ierr);CHKERRA(ierr)
60: call ISSetInfo(is,IS_IDENTITY,IS_LOCAL,permanent,PETSC_TRUE,ierr);CHKERRA(ierr)
61: call ISGetInfo(is,IS_PERMUTATION,IS_LOCAL,compute,flag,ierr);CHKERRA(ierr)
62: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking permutation second time'); endif
63: call ISGetInfo(is,IS_IDENTITY,IS_LOCAL,compute,flag,ierr);CHKERRA(ierr)
64: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking identity second time'); endif
65: call ISClearInfoCache(is,PETSC_TRUE,ierr);CHKERRA(ierr)
67: ! Check equality of index sets
69: call ISEqual(is,is,flag,ierr);CHKERRA(ierr)
70: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking equal'); endif
72: ! Sorting
74: call ISSort(is,ierr);CHKERRA(ierr)
75: call ISSorted(is,flag,ierr);CHKERRA(ierr)
76: if (.not. flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking sorted'); endif
78: ! Thinks it is a different type?
80: call PetscObjectTypeCompare(is,ISSTRIDE,flag,ierr);CHKERRA(ierr)
81: if (flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking stride'); endif
82: call PetscObjectTypeCompare(is,ISBLOCK,flag,ierr);CHKERRA(ierr)
83: if (flag) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error checking block'); endif
85: call ISDestroy(is,ierr);CHKERRA(ierr)
87: ! Inverting permutation
89: do 30, i=1,n
90: indices(i) = n - i
91: 30 continue
93: call ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,is,ierr);CHKERRA(ierr)
94: call ISSetPermutation(is,ierr);CHKERRA(ierr)
95: call ISInvertPermutation(is,PETSC_DECIDE,newis,ierr);CHKERRA(ierr)
96: call ISGetIndices(newis,ii,iis,ierr);CHKERRA(ierr)
97: do 40, i=1,n
98: if (ii(iis+i) .ne. n - i) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Error getting permutation indices'); endif
99: 40 continue
100: call ISRestoreIndices(newis,ii,iis,ierr);CHKERRA(ierr)
101: call ISDestroy(newis,ierr);CHKERRA(ierr)
102: call ISDestroy(is,ierr);CHKERRA(ierr)
103: call PetscFinalize(ierr)
104: end
106: !/*TEST
107: !
108: ! test:
109: ! nsize: {{1 2 3 4 5}}
110: ! output_file: output/ex1_1.out
111: !
112: !TEST*/