Actual source code: ex2f.F

  1: !
  2: !  "$Id: ex2f.F,v 1.19 2001/01/17 22:20:50 bsmith Exp $"
  3: !
  4: !  Formatted Test for IS stride routines
  5: !
  6:       program main
  7:       implicit none
 8:  #include finclude/petsc.h
 9:  #include finclude/petscis.h

 11:       integer     i,n,ierr,ii(1),start,stride
 12:       IS          is
 13:       PetscTruth  flag
 14:       PetscOffset iis

 16:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 18: !     Test IS of size 0

 20:       call ISCreateStride(PETSC_COMM_SELF,0,0,2,is,ierr)
 21:       call ISGetLocalSize(is,n,ierr)
 22:       if (n .ne. 0) then
 23:         SETERRQ(1,0,ierr)
 24:       endif
 25:       call ISStrideGetInfo(is,start,stride,ierr)
 26:       if (start .ne. 0) then
 27:          SETERRQ(1,0,ierr)
 28:       endif
 29:       if (stride .ne. 2) then
 30:         SETERRQ(1,0,ierr)
 31:       endif
 32:       call ISStride(is,flag,ierr)
 33:       if (flag .ne. PETSC_TRUE) then
 34:         SETERRQ(1,0,ierr)
 35:       endif
 36:       call ISGetIndices(is,ii,iis,ierr)
 37:       call ISRestoreIndices(is,ii,iis,ierr)
 38:       call ISDestroy(is,ierr)

 40: !     Test ISGetIndices()

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

 53:       call PetscFinalize(ierr)
 54:       end
 55: