BINARYSEARCHSYM Subroutine

public subroutine BINARYSEARCHSYM(VAL, TAB, LEN, LOC)

Arguments

Type IntentOptional Attributes Name
type(Symmetry) :: VAL
type(Symmetry) :: TAB(LEN)
integer :: LEN
integer :: LOC

Contents

Source Code


Source Code

    SUBROUTINE BINARYSEARCHSYM(VAL, TAB, LEN, LOC)
        IMPLICIT NONE
        TYPE(Symmetry) VAL
        INTEGER LOC, LEN
        type(Symmetry) TAB(LEN)
        INTEGER I, J, IFIRST, N, ILAST
        I = 1
        J = LEN
        IFIRST = I
        ILAST = J
        DO WHILE (J - I >= 1)
            N = (I + J) / 2
!            write(stdout,"(3I4)",advance='no') I,J,N
!            CALL writesym(stdout,TAB(1,I),.FALSE.)
!            CALL writesym(stdout,TAB(1,J),.FALSE.)
!            CALL writesym(stdout,TAB(1,N),.TRUE.)
            IF (SYMLT(TAB(N), VAL) .AND. I /= N) THEN
                IF (SYMNE(TAB(N), TAB(IFIRST))) IFIRST = N
!   reset the lower limit
                I = N
            else if (SYMGT(TAB(N), VAL)) THEN
                IF (SYMNE(TAB(N), TAB(ILAST))) ILAST = N
!   reset the upper limit
                J = N
            else if (SYMEQ(TAB(N), VAL)) THEN
!   bingo, we've got it!
                LOC = 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
        IF (SYMEQ(TAB(I), VAL)) THEN
            LOC = I
        else if (SYMEQ(TAB(J), VAL)) THEN
            LOC = J
        ELSE
!   Failure
            LOC = 0
        end if
    END SUBROUTINE BINARYSEARCHSYM