Actual source code: ex2f.F

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

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

 15:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 17: !     Test IS of size 0
 18:       ssize = 0
 19:       stride = 0
 20:       first = 2
 21:       call ISCreateStride(PETSC_COMM_SELF,ssize,stride,first,is,ierr)
 22:       call ISGetLocalSize(is,n,ierr)
 23:       if (n .ne. 0) then
 24:         SETERRQ(1,0,ierr)
 25:       endif
 26:       call ISStrideGetInfo(is,start,stride,ierr)
 27:       if (start .ne. 0) then
 28:          SETERRQ(1,0,ierr)
 29:       endif
 30:       if (stride .ne. 2) then
 31:         SETERRQ(1,0,ierr)
 32:       endif
 33:       call ISStride(is,flag,ierr)
 34:       if (flag .ne. PETSC_TRUE) then
 35:         SETERRQ(1,0,ierr)
 36:       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,10000
 50:         if (ii(i+iis) .ne. -11 + 3*i) then
 51:           SETERRQ(1,0,ierr)
 52:         endif
 53:  10   continue
 54:       call ISRestoreIndices(is,ii,iis,ierr)
 55:       call ISDestroy(is,ierr)

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