PROGRAM TestOESort
       IMPLICIT NONE
       integer myvalue0,myvalue1
       integer p
       character*8 progname
       logical passed
       logical output
       parameter (output=.FALSE.)

       passed=.TRUE.
       if (2**pflog2ceil(nProc).NE.nProc) then
          if (myProc.EQ.0) then
             write(6,*) 'bitonic skips non-power of 2 procs: ',nProc
          endif
          goto 100
       endif

       myvalue0 = MOD(17*myProc,7)
       myvalue1 = myvalue0

       if (output) call OutputList('OddEven In',myvalue0)
       call OddEvenSort(myvalue0)
       if (output) call OutputList('OddEven Out',myvalue0)

       if (output) call OutputList('Bitonic In',myvalue1)
       call BitonicSort(myvalue1)
       if (output) call OutputList('Bitonic Out',myvalue1)

c check results
      progname = 'pfsort'
      if (myvalue0.NE.myvalue1) then
          passed = .FALSE.
          write(6,*) 'Failed with: ',myvalue0,myvalue1
      endif
100   continue

       DO p = 0, nproc0
          if (p.EQ.myProc) then
             if (passed) then
                 write(6,610) myProc,progname
             else
                 write(6,611) myProc,progname
             endif
          endif
          call pf_sync
       ENDDO
610    format(I5,' passed test program ',A)
611    format(I5,' failed test program ',A) 

       STOP
       END
    
       SUBROUTINE OutputList(s,myvalue)
       IMPLICIT NONE
       character*(*) s
       integer myvalue, p
       if (myProc.EQ.0) write(6,*) ' --- ',s,' --- '
       do p = 0, nProc0
         if (myProc.EQ.p) write(6,15) p,myvalue
         call pf_sync
       enddo
       RETURN
15     FORMAT(I5,2X,I5)
       END

       SUBROUTINE OddEvenSort(element)
       IMPLICIT NONE
       INTEGER element
       integer oddeven, evenodd
       integer hiElement, i, tmp, n, b, src
       logical ODD,EVEN
       ODD = (myProc-(myProc/2)*2 .EQ. 1)
       EVEN = .NOT.ODD

       n = nProc
       DO i = 1, n/2
c   odd-even exchange
          tmp@myProc = element@oddEven(myProc)
          if (ODD) then
            element = MIN(tmp,element) 
          else
            element = MAX(tmp,element) 
          endif
c   even-odd exchange
          tmp@myProc = element@evenOdd(myProc)
          if (EVEN) then
            element = MIN(tmp,element) 
          else
            element = MAX(tmp,element) 
          endif
       ENDDO
       RETURN
       END

       INTEGER FUNCTION oddEven(me)
       IMPLICIT NONE
       INTEGER me 
       integer b
        b = MOD(me,2) + me 
        if (me.EQ.0.OR.me.EQ.nProc0) then
           oddEven = me
        else
           oddEven = b - MOD(me+1,2)
        endif
       RETURN
       END

       INTEGER FUNCTION evenOdd(me)
       IMPLICIT NONE
       INTEGER me 
       integer b
          b = MOD(me+1,2) + me 
          evenOdd = b - MOD(me,2)
       RETURN
       END

      SUBROUTINE BitonicSort(element)
      IMPLICIT NONE
      INTEGER element
      integer d,notd,ieven,iodd,iswch,locdim,i,j
      integer minot,miand,mior,ibit
      integer tmp
      locdim=1
      DO j=0,cubedim-1
        d=locdim
        locdim = locdim*2
        DO i=0,j
          notd=minot(d)
          ieven=miand(myProc,notd)
          iodd=mior(myProc,d)
          tmp@ieven = element@iodd
          tmp@iodd  = element@ieven
          iswch=ibit(myProc,locdim)+ibit(myProc,d)
          iswch=MOD(iswch,2)
          IF ( iswch .EQ. 1 ) THEN 
             element=MAX(tmp,element)
          ELSE
             element=MIN(tmp,element)
          ENDIF
          d=d/2
        ENDDO
      ENDDO
      RETURN
      END