C @(#)tdsearch1.for	17.1.1.1 (ES0-DMD) 01/25/02 17:47:17
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  TDSEARCH1.FOR              2.0   17OCT1985
C                            2.1   25OCT1985
C  J.D.PONZ                     ESO - GARCHING
C
C.KEYWORDS
C
C  TABLE, SEARCH
C
C.PURPOSE
C
C  SEARCHING IN TABLE COLUMNS USING TWO REAL OR DOUBLE PRECISION VALUES
C
C.INPUT/OUTPUT
C
C       TBES1D(TID, COLUMN, VALUE, ROW, ACTVAL, STATUS)
C       TBES1I(TID, COLUMN, VALUE, ROW, ACTVAL, STATUS)
C       TBES1R(TID, COLUMN, VALUE, ROW, ACTVAL, STATUS)
C       TBES2D(TID, COLUMN1, COLUMN2, VALUE, ROW, ACTVAL, STATUS)
C       TBES2I(TID, COLUMN1, COLUMN2, VALUE, ROW, ACTVAL, STATUS)
C       TBES2R(TID, COLUMN1, COLUMN2, VALUE, ROW, ACTVAL, STATUS)
C
C.ALGORTIHM
C
C   USE THE EUCLIDEAN DISTANCE
C
C------------------------------------------------------------------
       SUBROUTINE TBES1D(TID, COLUMN, VALUE, NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE.
C       DOUBLE PRECISION VERSION
C
        IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN
        DOUBLE PRECISION VALUE
        INTEGER  NEXT
        DOUBLE PRECISION ACTVAL
        INTEGER  STATUS
C
        LOGICAL NULL, SELECT
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1,TYPE
        DOUBLE PRECISION NEWVAL, DIST, DIST1
        CHARACTER*8   FORM
C
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        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
           RETURN
        ENDIF
        CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
        IF (TYPE.EQ.D_C_FORMAT) THEN
           STATUS = 1
           RETURN
        ENDIF
C
C ... START SEARCHING 
C
        NEXT = 0
        I1    = 0
10      I1    = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBERDD(TID, I1, COLUMN, NEWVAL, NULL, STATUS)
        IF (NULL.AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL = NEWVAL
        DIST   = DABS(ACTVAL-VALUE)
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBERDD(TID, I, COLUMN, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL) THEN
             DIST1 = DABS(NEWVAL-VALUE)
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL = NEWVAL
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END

       SUBROUTINE TBES1I(TID, COLUMN, VALUE, NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE.
C       INTEGER VERSION
C
        IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN
        INTEGER  VALUE
        INTEGER  NEXT
        INTEGER  ACTVAL
        INTEGER  STATUS
C
        LOGICAL NULL, SELECT
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1
        INTEGER NEWVAL, DIST, DIST1, TYPE
        CHARACTER*8   FORM
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        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
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
C
C ... START SEARCHING 
C
        NEXT = 0
        I1    = 0
10      I1    = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBERDI(TID, I1, COLUMN, NEWVAL, NULL, STATUS)
        IF (NULL.AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL = NEWVAL
        DIST   = IABS(ACTVAL-VALUE)
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBERDI(TID, I, COLUMN, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL) THEN
             DIST1 = IABS(NEWVAL-VALUE)
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL = NEWVAL
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END

       SUBROUTINE TBES1R(TID, COLUMN, VALUE, NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE.
C       SINGLE PRECISION  VERSION
C
       IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN
        REAL     VALUE
        INTEGER  NEXT
        REAL     ACTVAL
        INTEGER  STATUS
C
        LOGICAL NULL, SELECT
        INTEGER TYPE
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1
        REAL    NEWVAL, DIST, DIST1
        CHARACTER*8   FORM
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        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
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
C
C ... START SEARCHING 
C
        NEXT  = 0
        I1    = 0
10      I1    = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBERDR(TID, I1, COLUMN, NEWVAL, NULL, STATUS)
        IF (NULL.AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL = NEWVAL
        DIST   = ABS(ACTVAL-VALUE)
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBERDR(TID, I, COLUMN, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL) THEN
             DIST1 = ABS(NEWVAL-VALUE)
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL = NEWVAL
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END

       SUBROUTINE TBES2D(TID,COLUMN1,COLUMN2,VALUE,
     .                       NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE
C       DOUBLE PRECISION VERSION
C
       IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN1
        INTEGER  COLUMN2
        DOUBLE PRECISION VALUE(2)
        INTEGER  NEXT
        DOUBLE PRECISION ACTVAL(2)
        INTEGER  STATUS
C
        LOGICAL NULL(2), SELECT
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1, ICOL(2)
        INTEGER          TYPE
        DOUBLE PRECISION NEWVAL(2), DIST, DIST1
        CHARACTER*8      FORM
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        INCLUDE  'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
        CALL TBIGET(TID, NCOL, NROW, NSC, NAC, NAR, STATUS)
       IF (COLUMN1.LT.0.OR.COLUMN1.GT.NCOL.OR.
     .     COLUMN2.LT.0.OR.COLUMN2.GT.NCOL) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN1,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN2,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
C
C ... START SEARCHING 
C
        ICOL(1) = COLUMN1
        ICOL(2) = COLUMN2
        NEXT    = 0
        I1      = 0
10      I1      = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBRRDD(TID, I1, 2, ICOL, NEWVAL, NULL, STATUS)
        IF ((NULL(1).OR.NULL(2)).AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL(1) = NEWVAL(1)
        ACTVAL(2) = NEWVAL(2)
        DIST      = DSQRT((ACTVAL(1)-VALUE(1))**2 + 
     .                    (ACTVAL(2)-VALUE(2))**2)  
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBRRDD(TID, I, 2, ICOL, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL(1) .AND. .NOT. NULL(2)) THEN
            DIST1     = DSQRT((NEWVAL(1)-VALUE(1))**2 + 
     .                        (NEWVAL(2)-VALUE(2))**2)  
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL(1) = NEWVAL(1)
               ACTVAL(2) = NEWVAL(2)
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END

       SUBROUTINE TBES2I(TID,COLUMN1,COLUMN2,VALUE,
     .                       NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE
C       INTEGER  VERSION
C
       IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN1
        INTEGER  COLUMN2
        INTEGER  VALUE(2)
        INTEGER  NEXT
        INTEGER  ACTVAL(2)
        INTEGER  STATUS
C
        LOGICAL NULL(2), SELECT
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1, ICOL(2)
        INTEGER NEWVAL(2), TYPE
        DOUBLE PRECISION DIST, DIST1
        CHARACTER*8   FORM
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        INCLUDE  'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
        CALL TBIGET(TID, NCOL, NROW, NSC, NAC, NAR, STATUS)
       IF (COLUMN1.LT.0.OR.COLUMN1.GT.NCOL.OR.
     .     COLUMN2.LT.0.OR.COLUMN2.GT.NCOL) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN1,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN2,FORM,LEN,TYPE,STATUS)
        IF (TYPE.EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
C
C ... START SEARCHING 
C
        ICOL(1) = COLUMN1
        ICOL(2) = COLUMN2
        NEXT    = 0
        I1      = 0
10      I1      = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBRRDI(TID, I1, 2, ICOL, NEWVAL, NULL, STATUS)
        IF ((NULL(1).OR.NULL(2)).AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL(1) = NEWVAL(1)
        ACTVAL(2) = NEWVAL(2)
        DIST1     = (ACTVAL(1)-VALUE(1))**2 + (ACTVAL(2)-VALUE(2))**2  
        DIST      = DSQRT(DIST1) 
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBRRDI(TID, I, 2, ICOL, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL(1) .AND. .NOT. NULL(2)) THEN
            DIST1 = (NEWVAL(1)-VALUE(1))**2 + (NEWVAL(2)-VALUE(2))**2  
            DIST1 = DSQRT(DIST1)
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL(1) = NEWVAL(1)
               ACTVAL(2) = NEWVAL(2)
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END


       SUBROUTINE TBES2R(TID,COLUMN1,COLUMN2,VALUE,
     .                       NEXT, ACTVAL, STATUS)
C
C       SEARCH FOR ENTRY CLOSEST TO VALUE
C       SINGLE PRECISION VERSION
C
       IMPLICIT NONE
C
        INTEGER  TID
        INTEGER  COLUMN1
        INTEGER  COLUMN2
        REAL     VALUE(2)
        INTEGER  NEXT
        REAL     ACTVAL(2)
        INTEGER  STATUS
C
        LOGICAL NULL(2), SELECT
        INTEGER NCOL, NROW, NSC, NAC, NAR, LEN, I, I1, ICOL(2)
        INTEGER TYPE
        REAL    NEWVAL(2), DIST, DIST1
        CHARACTER*8   FORM
        INCLUDE  'MID_INCLUDE:TABLES.INC'
        INCLUDE  'MID_INCLUDE:TABLED.INC'
C
C ... CHECK ARGUMENTS
C
        CALL TBIGET(TID, NCOL, NROW, NSC, NAC, NAR, STATUS)
       IF (COLUMN1.LT.0.OR.COLUMN1.GT.NCOL.OR.
     .     COLUMN2.LT.0.OR.COLUMN2.GT.NCOL) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN1,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
        CALL TBFGET(TID,COLUMN2,FORM,LEN,TYPE,STATUS)
        IF (TYPE .EQ. D_C_FORMAT) THEN
           STATUS = 1
           RETURN
       ENDIF
C
C ... START SEARCHING 
C
        ICOL(1) = COLUMN1
        ICOL(2) = COLUMN2
        NEXT    = 0
        I1      = 0
10      I1      = I1+1
        CALL TBSGET(TID, I1, SELECT, STATUS)
        IF (.NOT.SELECT) GOTO 10
        CALL TBRRDR(TID, I1, 2, ICOL, NEWVAL, NULL, STATUS)
        IF ((NULL(1).OR.NULL(2)).AND.I1.LT.NROW) GOTO 10
        NEXT   = I1
        ACTVAL(1) = NEWVAL(1)
        ACTVAL(2) = NEWVAL(2)
        DIST      = SQRT((ACTVAL(1)-VALUE(1))**2 + 
     .                   (ACTVAL(2)-VALUE(2))**2)  
C
C ... ITERATION
C
        DO 20 I = I1, NROW
          CALL TBSGET(TID, I, SELECT, STATUS)
          IF (.NOT.SELECT) GOTO 20
          CALL TBRRDR(TID, I, 2, ICOL, NEWVAL, NULL, STATUS)
          IF (.NOT. NULL(1) .AND. .NOT. NULL(2)) THEN
            DIST1     = SQRT((NEWVAL(1)-VALUE(1))**2 + 
     .                       (NEWVAL(2)-VALUE(2))**2)  
             IF (DIST1.LT.DIST) THEN
               NEXT   = I            
               DIST   = DIST1
               ACTVAL(1) = NEWVAL(1)
               ACTVAL(2) = NEWVAL(2)
             ENDIF
          ENDIF
20      CONTINUE
       RETURN
       END