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:       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(ISGetIndicesF90(is,ii,ierr))
 34:       PetscCallA(ISRestoreIndicesF90(is,ii,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(ISGetIndicesF90(is,ii,ierr))
 45:       do 10, i=1,n
 46:         if (ii(i) .ne. -11 + 3*i) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Wrong result from ISGetIndices'); endif
 47:  10   continue
 48:       PetscCallA(ISRestoreIndicesF90(is,ii,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*/