C @(#)tdsearch.for	13.1.1.1 (ES0-DMD) 06/02/98 18:18:55
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  TBESEARCH.FOR              2.0   17FEB1988
C  J.D.PONZ                     ESO - GARCHING
C
C.KEYWORDS
C
C  TABLE, SEARCH
C
C.PURPOSE
C
C  SEARCHING IN TABLE COLUMNS
C  DOCUMENT MTS/2.0
C
C.INPUT/OUTPUT
C
C       TBESRC(TID, COLUMN, VALUE, ISTART, NCHAR, FIRST, NEXT, STATUS)
C       TBESRD(TID, COLUMN, VALUE, ERROR, FIRST, NEXT, STATUS)
C       TBESRI(TID, COLUMN, VALUE, ERROR, FIRST, NEXT, STATUS)
C       TBESRR(TID, COLUMN, VALUE, ERROR, FIRST, NEXT, STATUS)
C
C------------------------------------------------------------------
       SUBROUTINE TBESRC(TID,COLUMN,INVAL,ISTART,NCHAR,
     .                   FIRST,NEXT,STATUS)
C
C       SEARCH FOR VALUE IN COLUMNS
C       SEARCHING FIELD IS A SUBSTRING IN CHARACTER FORMAT COLUMN
C
       IMPLICIT NONE
       INTEGER        TID
       INTEGER        COLUMN
       CHARACTER*(*)  INVAL
       INTEGER        ISTART
       INTEGER        NCHAR
       INTEGER        FIRST
       INTEGER        NEXT
       INTEGER        STATUS
C
       INTEGER        MADRID(1), NCOL, NROW, NSC, NAC, NAR, LEN
       INTEGER*8      NEWADD
       INTEGER        IS, NW, NBYT2, TYPE
       LOGICAL        VALUE(256)
       CHARACTER*256  VALUEC
       CHARACTER*8         FORM
C
       INCLUDE        'MID_INCLUDE:TABLES.INC'
       COMMON/VMR/ MADRID
       INCLUDE        'MID_INCLUDE:TABLED.INC'
C
CCCC       EQUIVALENCE   (VALUEC,VALUE(1))
C
       VALUEC = INVAL
C
C ... CHECK ARGUMENTS
C
       CALL TBIGET(TID,NCOL,NROW,NSC,NAC,NAR,STATUS)
       IF (COLUMN.LT.0.OR.COLUMN.GT.NCOL) THEN
           STATUS = 1
           GO TO 1000
       ENDIF
       CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
       IF (TYPE.NE.D_C_FORMAT) THEN       
           STATUS = 1
           GO TO 1000
       ENDIF
C
C ... MAP COLUMN
C
       CALL TBCMAP(TID,COLUMN,NEWADD,STATUS)
       IS = NSC
C
C ... BINARY OR SEQUENTIAL SEARCH DEPENDING ON THE SORTED COLUMN
C
       NBYT2 = MIN(ISTART+NCHAR-1,LEN)
       NW    = (LEN+3)/4
       IF (IABS(IS) .EQ. COLUMN) THEN
         IF(IS.GT.0) THEN
           CALL TYSBAC(MADRID(NEWADD),NW,NROW,VALUE,ISTART,NBYT2,
     .                        FIRST,NEXT)
         ELSE
           CALL TYSBDC(MADRID(NEWADD),NW,NROW,VALUE,ISTART,NBYT2,
     .                        FIRST,NEXT)
         ENDIF
       ELSE
           CALL TYSSSC(MADRID(NEWADD),NW,NROW,VALUE,ISTART,NBYT2,
     .                        FIRST,NEXT)
       ENDIF
C
C ... ERROR HANDLING
C
1000   CONTINUE
C    CALL ERRCNTRL_ST('PUT',E_C,E_L,E_D)
C       IF (STATUS.NE.ERR_NORMAL)
C     .       CALL ERRSIGNAL_ST('TBL','TBL_SEARCHC',STATUS)
       RETURN
       END

       SUBROUTINE TBESRD(TID,COLUMN,VALUE,ERROR,FIRST,NEXT,STATUS)
C
C       SEARCH ELEMENT IN A COLUMN. 
C       DOUBLE PRECISION ARGUMENT
C
       IMPLICIT NONE
       INTEGER  TID          ! IN : TABLE ID
       INTEGER  COLUMN       ! IN : COLUMN NUMBER
       DOUBLE PRECISION VALUE        ! IN : VALUE TO SEARCH
       DOUBLE PRECISION ERROR        ! IN : ERROR IN THE SEARCH
       INTEGER  FIRST        ! IN : INDEX TO FIRST ROW TO SEARCH
       INTEGER  NEXT         ! OUT: INDEX TO THE VALUE
       INTEGER  STATUS       ! OUT: STATUS
C
       INTEGER  MADRID(1), NCOL, NROW, NSC, NAC, NAR, LEN, IS
       INTEGER*8   NEWADD
       INTEGER  TYPE
       REAL     RERR, RVAL
       CHARACTER*8         FORM
C
       INCLUDE        'MID_INCLUDE:TABLES.INC'
       COMMON/VMR/ MADRID
       INCLUDE        'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
       CALL TBIGET(TID,NCOL,NROW,NSC,NAC,NAR,STATUS)
       IF (COLUMN.LT.0.OR.COLUMN.GT.NCOL) THEN
           STATUS = 1
           GO TO 1000
       ENDIF
       CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
       IF (TYPE.EQ.D_C_FORMAT) THEN       
           STATUS = 1
           GO TO 1000
       ENDIF
C
C ... MAP COLUMN
C
       CALL TBCMAP(TID,COLUMN,NEWADD,STATUS)
       IS = NSC
C
C ... SEARCH ACCORDING TO INTRINSIC TYPE
C ... BINARY OR SEQUENTIAL SEARCH DEPENDING ON THE SORTED COLUMN
C
       IF (TYPE.EQ.D_R4_FORMAT) THEN
         RVAL = VALUE
         RERR = ERROR
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
           ELSE
             CALL TYSBDR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
         ENDIF
       ENDIF
       IF (TYPE.EQ.D_R8_FORMAT) THEN
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAD(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
           ELSE
             CALL TYSBDD(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSD(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
         ENDIF
       ENDIF
C
C ... ERROR HANDLING
C
1000   CONTINUE
C       CALL ERRCNTRL_ST('PUT',E_C,E_L,E_D)
C       IF (STATUS.NE.ERR_NORMAL)
C     .       CALL ERRSIGNAL_ST('TBL','TBL_SEARCH',STATUS)
       RETURN
       END

       SUBROUTINE TBESRI(TID,COLUMN,VALUE,ERROR,FIRST,NEXT,STATUS)
C
C       SEARCH ELEMENT IN A COLUMN. 
C       INTEGER ARGUMENT
C
       IMPLICIT NONE
       INTEGER  TID          ! IN : TABLE ID
       INTEGER  COLUMN       ! IN : COLUMN NUMBER
       INTEGER  VALUE        ! IN : VALUE TO SEARCH
       INTEGER  ERROR        ! IN : ERROR IN THE SEARCH
       INTEGER  FIRST        ! IN : INDEX TO FIRST ROW TO SEARCH
       INTEGER  NEXT         ! OUT: INDEX TO THE VALUE
       INTEGER  STATUS       ! OUT: STATUS
C
       INTEGER  MADRID(1), NCOL, NROW, NSC, NAC, NAR, LEN, IS
       INTEGER*8  NEWADD
       INTEGER             TYPE
       REAL                RERR, RVAL
       DOUBLE PRECISION    DERR, DVAL
       CHARACTER*8         FORM
C
       INCLUDE        'MID_INCLUDE:TABLES.INC'
       COMMON/VMR/ MADRID
       INCLUDE        'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
       CALL TBIGET(TID,NCOL,NROW,NSC,NAC,NAR,STATUS)
       IF (COLUMN.LT.0.OR.COLUMN.GT.NCOL) THEN
           STATUS = 1
           GO TO 1000
       ENDIF
       CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
       IF (TYPE.EQ.D_C_FORMAT) THEN       
           STATUS = 1
           GO TO 1000
       ENDIF
C
C ... MAP COLUMN
C
       CALL TBCMAP(TID,COLUMN,NEWADD,STATUS)
       IS = NSC
C
C ... SEARCH ACCORDING TO INTRINSIC TYPE
C ... BINARY OR SEQUENTIAL SEARCH DEPENDING ON THE SORTED COLUMN
C
       IF (TYPE.EQ.D_R8_FORMAT) THEN
         DVAL = VALUE
         DERR = ERROR
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
           ELSE
             CALL TYSBDD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
         ENDIF
       ENDIF
       IF (TYPE.EQ.D_R4_FORMAT) THEN
         RVAL = VALUE
         RERR = ERROR
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
           ELSE
             CALL TYSBDR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSR(MADRID(NEWADD),NROW,RVAL,RERR,FIRST,NEXT)
         ENDIF
       ENDIF
C
C ... ERROR HANDLING
C
1000   CONTINUE
C       CALL ERRCNTRL_ST('PUT',E_C,E_L,E_D)
C       IF (STATUS.NE.ERR_NORMAL)
C     .       CALL ERRSIGNAL_ST('TBL','TBL_SEARCH',STATUS)
       RETURN
       END

       SUBROUTINE TBESRR(TID,COLUMN,VALUE,ERROR,FIRST,NEXT,STATUS)
C
C       SEARCH ELEMENT IN A COLUMN. 
C
       IMPLICIT NONE
       INTEGER  TID          ! IN : TABLE ID
       INTEGER  COLUMN       ! IN : COLUMN NUMBER
       REAL     VALUE        ! IN : VALUE TO SEARCH
       REAL     ERROR        ! IN : ERROR IN THE SEARCH
       INTEGER  FIRST        ! IN : INDEX TO FIRST ROW TO SEARCH
       INTEGER  NEXT         ! OUT: INDEX TO THE VALUE
       INTEGER  STATUS       ! OUT: STATUS
C
       INTEGER  MADRID(1), NCOL, NROW, NSC, NAC, NAR, LEN, TYPE, IS
       INTEGER*8       NEWADD
       DOUBLE PRECISION    DERR, DVAL
       CHARACTER*8         FORM
C
       INCLUDE        'MID_INCLUDE:TABLES.INC'
       COMMON/VMR/ MADRID
       INCLUDE        'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
       CALL TBIGET(TID,NCOL,NROW,NSC,NAC,NAR,STATUS)
       IF (COLUMN.LT.0.OR.COLUMN.GT.NCOL) THEN
           STATUS = 1
           GO TO 1000
       ENDIF
       CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
       IF (TYPE.EQ.D_C_FORMAT) THEN       
           STATUS = 1
           GO TO 1000
       ENDIF
C
C ... MAP COLUMN
C
       CALL TBCMAP(TID,COLUMN,NEWADD,STATUS)
       IS = NSC
C
C ... SEARCH ACCORDING TO INTRINSIC TYPE
C ... BINARY OR SEQUENTIAL SEARCH DEPENDING ON THE SORTED COLUMN
C
       IF (TYPE.EQ.D_R8_FORMAT) THEN
         DVAL = VALUE
         DERR = ERROR
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
           ELSE
             CALL TYSBDD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSD(MADRID(NEWADD),NROW,DVAL,DERR,FIRST,NEXT)
         ENDIF
       ENDIF
       IF (TYPE.EQ.D_R4_FORMAT) THEN
         IF (IABS(IS) .EQ. COLUMN) THEN
           IF(IS.GT.0) THEN
             CALL TYSBAR(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
           ELSE
             CALL TYSBDR(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
           ENDIF
         ELSE
             CALL TYSSSR(MADRID(NEWADD),NROW,VALUE,ERROR,FIRST,NEXT)
         ENDIF
       ENDIF
C
C ... ERROR HANDLING
C
1000   CONTINUE
C       CALL ERRCNTRL_ST('PUT',E_C,E_L,E_D)
C       IF (STATUS.NE.ERR_NORMAL)
C     .       CALL ERRSIGNAL_ST('TBL','TBL_SEARCH',STATUS)
       RETURN
       END

       SUBROUTINE TYSSSR(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       SEQUENTIAL SEARCH OF VALUE IN THE ARRAY
C       SINGLE PRECISION VERSION
C
       IMPLICIT NONE
C
       INTEGER   N
       REAL      ARRAY(N)
       REAL      VALUE
       REAL      ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER   I
C
C ... INITIALIZE FLAG
C
       IPOS  = 0
C
C ... LOOP ON VALUES
C
       DO 10 I = IFIRST, N
         IF (ABS(ARRAY(I)-VALUE).LE.ERROR) THEN
           IPOS = I
           RETURN
         ENDIF
10     CONTINUE
       RETURN
       END

       SUBROUTINE TYSBAR(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       SINGLE PRECISION VERSION
C       ASCENDING ORDER
C
       IMPLICIT NONE
       INTEGER   N
       REAL      ARRAY(N)
       REAL      VALUE
       REAL      ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER   LOWER, UPPER, I
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (ABS(VALUE-ARRAY(I)).LE.ERROR) THEN
           IPOS = I
           GO TO 10
         ELSE
           IF (VALUE.LT.ARRAY(I)) THEN
             UPPER = I - 1
           ELSE
             LOWER = I + 1
           ENDIF
         ENDIF
       IF (LOWER.LE.UPPER) GO TO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
10     IF (IPOS.LE.IFIRST) RETURN
       IF (ABS(VALUE-ARRAY(IPOS-1)).GT.ERROR) RETURN
20     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (ABS(VALUE-ARRAY(IPOS-1)).LE.ERROR) GOTO 20
       RETURN
       END

       SUBROUTINE TYSBDR(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       SINGLE PRECISION VERSION
C       DESCENDING ORDER
C
       IMPLICIT NONE
       INTEGER   N
       REAL      ARRAY(N)
       REAL      VALUE
       REAL      ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER   LOWER, UPPER, I
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (ABS(VALUE-ARRAY(I)).LE.ERROR) THEN
           IPOS = I
           GO TO 10
         ELSE
           IF (VALUE.GT.ARRAY(I)) THEN
             UPPER = I - 1
           ELSE
             LOWER = I + 1
           ENDIF
         ENDIF
       IF (LOWER.LE.UPPER) GOTO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
10     IF (IPOS.LE.IFIRST) RETURN
       IF (ABS(VALUE-ARRAY(IPOS-1)).GT.ERROR) RETURN
20     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (ABS(VALUE-ARRAY(IPOS-1)).LE.ERROR) GOTO 20
       RETURN
       END

       SUBROUTINE TYSSSD(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       SEQUENTIAL SEARCH OF VALUE IN THE ARRAY
C       DOUBLE PRECISION VERSION
C
       IMPLICIT NONE
       INTEGER   N
       DOUBLE PRECISION ARRAY(N)
       DOUBLE PRECISION VALUE
       DOUBLE PRECISION ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER   I
C
C ... INITIALIZE FLAG
C
       IPOS  = 0
C
C ... LOOP ON VALUES
C
       DO 10 I = IFIRST, N
         IF (DABS(ARRAY(I)-VALUE).LE.ERROR) THEN
           IPOS = I
           RETURN
         ENDIF
10     CONTINUE
       RETURN
       END

       SUBROUTINE TYSBAD(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       DOUBLE  PRECISION VERSION
C       ASCENDING ORDER
C
       IMPLICIT NONE
       INTEGER   N
       DOUBLE PRECISION ARRAY(N)
       DOUBLE PRECISION VALUE
       DOUBLE PRECISION ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER I, LOWER, UPPER
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (DABS(VALUE-ARRAY(I)).LE.ERROR) THEN
           IPOS = I
           GO TO 10
         ELSE
           IF (VALUE.LT.ARRAY(I)) THEN
             UPPER = I - 1
           ELSE
             LOWER = I + 1
           ENDIF
         ENDIF
       IF (LOWER.LE.UPPER) GO TO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
10     IF (IPOS.LE.IFIRST) RETURN
       IF (DABS(VALUE-ARRAY(IPOS-1)).GT.ERROR) RETURN
20     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (DABS(VALUE-ARRAY(IPOS-1)).LE.ERROR) GOTO 20
       RETURN
       END

       SUBROUTINE TYSBDD(ARRAY, N, VALUE, ERROR, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       SINGLE PRECISION VERSION
C       DESCENDING ORDER
C
       IMPLICIT NONE
       INTEGER   N
       DOUBLE PRECISION ARRAY(N)
       DOUBLE PRECISION VALUE
       DOUBLE PRECISION ERROR
       INTEGER   IFIRST
       INTEGER   IPOS
C
       INTEGER   LOWER, UPPER, I
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (DABS(VALUE-ARRAY(I)).LE.ERROR) THEN
           IPOS = I
           GO TO 10
         ELSE
           IF (VALUE.GT.ARRAY(I)) THEN
             UPPER = I - 1
           ELSE
             LOWER = I + 1
           ENDIF
         ENDIF
       IF (LOWER.LE.UPPER) GOTO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
10     IF (IPOS.LE.IFIRST) RETURN
       IF (DABS(VALUE-ARRAY(IPOS-1)).GT.ERROR) RETURN
20     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (DABS(VALUE-ARRAY(IPOS-1)).LE.ERROR) GOTO 20
       RETURN
       END

       SUBROUTINE TYSSSC(ARRAY, NW, N, VALUE, IST,IEN, IFIRST,IPOS)
C
C       SEQUENTIAL SEARCH OF VALUE IN THE ARRAY
C       CHARACTER ARRAY
C
       IMPLICIT NONE
       INTEGER NW
       INTEGER N
       REAL    ARRAY(NW,N)
       REAL    VALUE(1)
       INTEGER IST
       INTEGER IEN
       INTEGER IFIRST
       INTEGER IPOS
C
       INTEGER I
       INTEGER TYSORD
C
C ... INITIALIZE FLAG
C
       IPOS  = 0
C
C ... LOOP ON VALUES
C
       DO 10 I = IFIRST, N
         IF (TYSORD(IST,IEN,ARRAY(1,I),VALUE)) 10,20,10
10       CONTINUE
       RETURN
20       IPOS = I
       RETURN
       END

       SUBROUTINE TYSBAC(ARRAY, NW, N, VALUE, IST,IEN, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       CHARACTER ARRAY
C       ASCENDING ORDER
C
       IMPLICIT NONE
       INTEGER NW
       INTEGER N
       REAL    ARRAY(NW,N)
       REAL    VALUE(1)
       INTEGER IST
       INTEGER IEN
       INTEGER IFIRST
       INTEGER IPOS
C
       INTEGER I, LOWER, UPPER
       INTEGER TYSORD
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (TYSORD(IST,IEN,VALUE,ARRAY(1,I))) 20,10,30
10         IPOS = I
         GOTO 50
20         UPPER = I - 1
         GOTO 40
30         LOWER = I + 1
40         CONTINUE
       IF (LOWER.LE.UPPER) GOTO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
50     IF (IPOS.LE.IFIRST) RETURN
60     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (TYSORD(IST,IEN,ARRAY(1,IPOS),VALUE).EQ.0) GOTO 60
       RETURN
       END

       SUBROUTINE TYSBDC(ARRAY, NW, N, VALUE, IST,IEN, IFIRST,IPOS)
C
C       BINARY SEARCH OF ELEMENTS IN THE ARRAY
C       CHARACTER ARRAY
C       DESCENDING ORDER
C
       IMPLICIT NONE
       INTEGER NW
       INTEGER N
       REAL    ARRAY(NW,N)
       REAL    VALUE(1)
       INTEGER IST
       INTEGER IEN
       INTEGER IFIRST
       INTEGER IPOS
C
       INTEGER I, LOWER, UPPER
       INTEGER TYSORD
C
C ... INITIALIZE COUNTERS
C
       LOWER = IFIRST
       UPPER = N
       IPOS  = 0
C
C ... LOOP
C
5      CONTINUE
         I = (LOWER + UPPER)/2
C
C ... COMPARE KEYS
C
         IF (TYSORD(IST,IEN,VALUE,ARRAY(1,I))) 30,10,20
10         IPOS = I
         GOTO 50
20         UPPER = I - 1
         GOTO 40
30         LOWER = I + 1
40         CONTINUE
       IF (LOWER.LE.UPPER) GOTO 5
C
C ... FIND FIRST ENTRY IN A SET OF EQUAL KEYS
C
50       IF (IPOS.LE.IFIRST) RETURN
60     CONTINUE
         IPOS = IPOS - 1
         IF (IPOS.EQ.IFIRST) RETURN
       IF (TYSORD(IST,IEN,ARRAY(1,IPOS),VALUE).EQ.0) GOTO 60
       RETURN
       END

       INTEGER FUNCTION TYSORD(IST,IEN,IX,IY)
C
C       RETURNS THE VALUES -1,0,+1 IF THE ALPHANUMERIC CHARACTER
C       STRING IN
C       IX IS < , = , > TO THAT IN IY, IN THE SENSE THAT
C       0<1<2,...<9<SPACE<A<B<...<Z   .
C
       IMPLICIT NONE
       INTEGER        IST
       INTEGER        IEN
C       BYTE           IX(IEN)
C       BYTE           IY(IEN)
       INTEGER           IX(IEN)
       INTEGER           IY(IEN)
C
       INTEGER        K
       DO 10 K=IST, IEN
         IF(IX(K).GT.IY(K)) GO TO 20
         IF(IX(K).LT.IY(K)) GO TO 30
10     CONTINUE
       TYSORD = 0
       RETURN
20     TYSORD = 1
       RETURN
30     TYSORD = -1
       RETURN
       END