Actual source code: ex2f.F

  1: !
  2: !  Formatted Test for IS stride routines
  3: !
  4:       program main
  5:       implicit none
 6:  #include finclude/petscsys.h
 7:  #include finclude/petscis.h

  9:       PetscErrorCode ierr
 10:       PetscInt  i,n,ii(1),start
 11:       PetscInt  stride,ssize,first
 12:       IS          is
 13:       PetscTruth  flag
 14:       PetscOffset iis

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 18: !     Test IS of size 0
 19:       ssize = 0
 20:       stride = 0
 21:       first = 2
 22:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 23:       call ISGetLocalSize(is,n,ierr)
 24:       if (n .ne. 0) then
 25:         SETERRQ(1,0,ierr)
 26:       endif
 27:       call ISStrideGetInfo(is,start,stride,ierr)
 28:       if (start .ne. 0) then
 29:          SETERRQ(1,0,ierr)
 30:       endif
 31:       if (stride .ne. 2) then
 32:         SETERRQ(1,0,ierr)
 33:       endif
 34:       call ISStride(is,flag,ierr)
 35:       if (.not. flag) then
 36:         SETERRQ(1,0,ierr)
 37:       endif
 38:       call ISGetIndices(is,ii,iis,ierr)
 39:       call ISRestoreIndices(is,ii,iis,ierr)
 40:       call ISDestroy(is,ierr)

 42: !     Test ISGetIndices()

 44:       ssize = 10000
 45:       stride = -8
 46:       first = 3
 47:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 48:       call ISGetLocalSize(is,n,ierr)
 49:       call ISGetIndices(is,ii,iis,ierr)
 50:       do 10, i=1,10000
 51:         if (ii(i+iis) .ne. -11 + 3*i) then
 52:           SETERRQ(1,0,ierr)
 53:         endif
 54:  10   continue
 55:       call ISRestoreIndices(is,ii,iis,ierr)
 56:       call ISDestroy(is,ierr)

 58:       call PetscFinalize(ierr)
 59:       end
 60: