BINARYSEARCH Subroutine

    SUBROUTINE BINARYSEARCH(VAL, TAB, A, B, LOC, LOC1, LOC2)
!   A binary search to find VAL in TAB.  TAB is sorted, but can have
!   multiple entries being the same.  If the search terminated unsuccessfully,
!   the entry indicated is one after half-way through the set of entries which
!   would be immediately prior to it.  From here until the label changes
!   should be filled with VAL if it is to be entered into the table.
!   A and B are the limits of the table.
!   If the search is successful, the location of VAL in TAB is returned in LOC
!   (and LOC1,LOC2).
!   If the search fails, then VAL should fit between LOC1 and LOC2 in TAB.
        INTEGER VAL, A, B, LOC, LOC1, LOC2
        INTEGER TAB(A:B)
        INTEGER I, J, IFIRST, N, ILAST
!         DO I=A,B
!            write(stdout,*) I,TAB(I)
!         end do
        I = A
        J = B
        IFIRST = I
        ILAST = J
        DO WHILE (J - I >= 1)
            N = (I + J) / 2
!            write(stdout,"(A,5I3)") "TN",I,J,N,TAB(N),VAL
            IF (TAB(N) < VAL .AND. TAB(N) /= 0 .AND. I /= N) THEN
                IF (TAB(N) /= TAB(IFIRST)) IFIRST = N
!   reset the lower limit
                I = N
            else if (TAB(N) > VAL .OR. TAB(N) == 0) THEN
                IF (TAB(N) /= TAB(ILAST)) ILAST = N
!   reset the upper limit
                J = N
            else if (TAB(N) == VAL) THEN
!   bingo, we've got it!
                LOC = N
!         DO I=A,B
!            write(stdout,*) I,TAB(I),I.EQ.LOC
!         end do
                LOC1 = N
                LOC2 = N
                RETURN
            ELSE
!   we've reached a situation where I and J's entries have the same value, and it's
!   not the one we want.  Leave the loop.
                I = J
            end if
        end do
!Finally, check the last element of the array, as it can still be there.
        IF (TAB(B) == VAL) THEN
            LOC = B
            LOC1 = B
            LOC2 = B
            RETURN
        end if
!   We've failed.  However, the new value should sit between I and J.
!   Split whichever of the prior or after slots which has the most duplicates
!         write(stdout,*) "FAIL:",IFIRST,I,J,ILAST
        LOC1 = IFIRST + 1
        LOC2 = ILAST - 1
        IF (TAB(IFIRST) == TAB(ILAST)) THEN
            LOC = (IFIRST + ILAST) / 2
            LOC1 = IFIRST
            LOC2 = ILAST
        else if (I - IFIRST >= ILAST - J) THEN
            LOC = (IFIRST + I) / 2
        ELSE
            LOC = (ILAST + J) / 2
        end if
!         DO I=A,B
!            write(stdout,*) I,TAB(I),I.EQ.LOC
!         end do
    END SUBROUTINE BinarySearch