# BINARYSEARCH Subroutine

## private subroutine BINARYSEARCH(VAL, TAB, A, B, LOC, LOC1, LOC2)

### Arguments

Type IntentOptional Attributes Name
integer :: VAL
integer :: TAB(A:B)
integer :: A
integer :: B
integer :: LOC
integer :: LOC1
integer :: LOC2

## Source Code

    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