CC    TSORT.FOR
CC    Tests SEED, RANDOM, SORTQQ, BSEARCHQQ

      INCLUDE   'FLIB.FI'
      INCLUDE   'FLIB.FD'

      INTEGER*4  array(10)
      INTEGER*4  count / 10 /
      INTEGER*4  oldcount
      INTEGER*4  i
      INTEGER*4  result, target
      REAL*4     temp
      CHARACTER*20 sarray(10)

      DATA       sarray / 'pear', 'banana', 'peach', 'tomato',
     +                    'celery', 'apple' , 'bread', 'beans',
     +                    'oranges', 'lettuce' /
C
C     First, generate an array of integer*4 values
C
      CALL SEED(RND$TIMESEED)
      DO I = 1, count
         CALL RANDOM(temp)
         array(i) = NINT(temp * count)

      END DO

      WRITE (*,*) 'Unsorted array'
      DO I = 1, count
         WRITE (*,'(I5, \)') array(i)
      END DO
C
C     Save the count to check the success of SORTQQ
C
      oldcount = count

      CALL SORTQQ(LOC(array), count, SRT$INTEGER4)

      IF (count .NE. oldcount) Then
C
C     Check outcome of SORTQQ
C
         WRITE (*,*) 'SORTQQ Failed; returned ', count
         STOP

      ELSE

         WRITE (*,*)
         WRITE (*,*) 'Sorted array'
         DO I = 1, count
            WRITE (*,'(I5, \)') array(i)
         END DO

         CALL SEED(7531)
         CALL RANDOM(temp)

         target = NINT(temp * count)

         WRITE (*,*)
         WRITE (*,'(A, I5)') ' Find element: ', target
C
C     Search for the target
C
         result = BSEARCHQQ(LOC(target),LOC(array),count,SRT$INTEGER4)
         IF (result .EQ. 0) THEN
            WRITE (*,*) 'Not Found'
         ELSE
            WRITE (*,'(A, I5)') ' Found element at position: ', result
         END IF

         WRITE (*,*)
         WRITE (*,*) 'Unsorted food array'
         DO I = 1, count
            WRITE (*,*) sarray(i)
         END DO

         CALL SORTQQ(LOC(sarray), count, 20)

         WRITE (*,*)
         WRITE (*,*) 'Sorted food array'
         DO I = 1, count
            WRITE (*,*) sarray(i)
         END DO

         CALL SEED(RND$TIMESEED)

         CALL RANDOM(temp)
         target = NINT(temp * count)

         WRITE (*,*)
         WRITE (*,*) ' Find element: ', sarray(target)
C
C     Search for the target
C
         result = BSEARCHQQ(LOC(sarray(target)),LOC(sarray),count,20)
         IF (result .EQ. 0) THEN
            WRITE (*,*) 'Not Found'
         ELSE
            WRITE (*,'(A, I5)') ' Found element at position: ', result
         END IF
      END IF
      END