C @(#)joinmd.for	19.1 (ES0-DMD) 02/25/03 13:25:35
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.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                         all rights reserved
C.IDENTIFICATION: JOINMD.FOR
C.LANGUAGE:       ESO-FOR
C.AUTHOR:         A. Kruszewski
C.KEYWORDS:       GALAXIES, IMAGES, SEARCH, STARS
C.ENVIRONMENT:    Portable MIDAS
C.COMMENTS:
C  subroutine JOINMD         version 3          820618
C  A. Kruszewski             ESO Garching
C  modified by               version 3.1        830905
C  Ch. Ounnas                ESO - Garching
C  modified to FX            version 3.2        870219
C  A. Kruszewski             Obs. de Geneve
C  modified to MSDOS         version 3.3        880610
C  A. Kruszewski             Warsaw U. Obs.
C.PURPOSE
C  joins together multiple detections of the same object
C  and checks if multiple detection corresponds to a single
C  or a double object
C.ALGORITHM
C  treats two detections as belonging to the same object if
C  they are no more than DLIM pixels apart
C.INPUT/OUTPUT
C  input arguments
C  A           real*4 array      image frame
C  JAPY        integer*4 array   pointers to image lines
C  IBUF        integer*4 array   limits of image buffer
C  IXYU        integer*4 array   limits of used area
C  NC          integer*4         number of entries in detection buffer
C  BCAT        real*4 array      real parameters of detections
C  MCAT        integer*4 array   integer parameters of detections
C  NL          integer*4         number of entries in catalog buffer
C  IDET        integer*4 array   rolling array with detections
C  NXS         integer*4         number of searched pixels in a line
C  ILIM        integer*4         maximal distance between detections of a
C                                single object
C  IARR        integer*4 array   values of integer keywords
C  RARR        real*4 array      values of real keywords
C  M           integer*4         number of detections
C  output arguments
C  ACAT        real*4 array      real parameters of detected objects
C  MM          integer*4         number of detected objects
C-----------------------------------------------------------------------
C
      SUBROUTINE JOINMD(A, JAPY, IBUF, IXYU, ACAT,
     &                  NC, BCAT, MCAT, NL, IDET,
     &                  NXS, ILIM, IARR, RARR, M, MM)
C
      IMPLICIT  NONE
      INTEGER   ILIM
      INTEGER   NC
      INTEGER   NL
      INTEGER   NXS
      REAL      A(1)
      INTEGER   JAPY(1)
      INTEGER   IBUF(4)
      INTEGER   IXYU(4)
      REAL      ACAT(5,NC)
      REAL      BCAT(2,NL)
      INTEGER   MCAT(4,NL)
      INTEGER   IDET(NXS,0:ILIM)
      INTEGER   IARR(32)
      REAL      RARR(64)
      INTEGER   M
      INTEGER   MM
C
      INTEGER   ISTAT
      INTEGER   JBE, JOFF
      INTEGER   K, L
      INTEGER   M1, M2, M3, M4
      INTEGER   MB
      INTEGER   MMB, MOB, MS
      REAL      B1, B2, GCUT
      REAL      TRLM , TRSH
C
      CHARACTER*80 TEXT
C
      TRSH = RARR(3)
      GCUT = 0.9 * RARR(2)
      JOFF = IBUF(2) - 1
      JBE = IBUF(4)
      MS = M - MOD( M-1 , NL ) - 1
      MMB = MOD( MM-1 , NC ) + 1
      M4 = 0
      M3 = 0
      M2 = 0
      M1 = 0
      B1 = 0.0
      B2 = 0.0
C
C ******      Find objects in last line of array IDET.
C
      DO 10 K = 1 , NXS
          MOB = IDET(K,ILIM)
          IF ( MOB .NE. 0 ) THEN
C
C ******            Read object's data.
C
            IF ( MOB .GT. MS ) THEN
                MB = MOB - MS
                M1 = MCAT(1,MB)
                M2 = MCAT(2,MB)
                M3 = MCAT(3,MB)
                M4 = MCAT(4,MB)
                B1 = BCAT(1,MB)
                B2 = BCAT(2,MB)
c            ELSE
c                READ ( ISF , REC=MOB ) M1, M2, M3, M4, B1, B2
            ENDIF
            IF ( M4 .EQ. 0 ) THEN
C
C ******                The object is identified.
C
                IF ( M3 .EQ. 0 ) THEN
C
C ******                  The detection is single.
C
                  IF ( MMB .EQ. NC ) THEN
                      WRITE (TEXT,'(A)') 'Too many detections'
                      CALL STTPUT(TEXT,ISTAT)
c                      CALL CTLG( ITF , START , STEP , ACAT ,
c     &                                          NC , MM , MMB )
c                      MMB = 0
                  ENDIF
                  MMB = MMB + 1
                  MM = MM + 1
                  ACAT(1,MMB) = FLOAT(M1)
                  ACAT(2,MMB) = FLOAT(M2)
                  ACAT(3,MMB) = B1
                  ACAT(4,MMB) = B2
                  TRLM = B1 + TRSH
                  CALL RADDET( A , JAPY , IBUF , M1 , M2 ,
     &                      IARR(22) , TRLM , B2 , TRSH , ACAT(5,MMB) )
                  IF ( ACAT(5,MMB) .LE. 0.0 .AND. B2 .LT. GCUT ) THEN
                      MMB = MMB - 1
                      MM = MM - 1
                  ENDIF
                ELSE
C
C ******                  The detection is multiple.
C
                  CALL MLTOBJ( A , JAPY , IBUF , JBE , IXYU ,
     &                        ACAT , NC , MCAT , BCAT , NL , M ,
     &                              MM , MMB , MOB , IARR , RARR )
                ENDIF
            ENDIF
          ENDIF
   10      CONTINUE
C
      DO 20 K = ILIM , 1 , -1
          DO 30 L = 1 , NXS
            IDET(L,K) = IDET(L,K-1)
   30          CONTINUE
   20      CONTINUE
        DO 40 L = 1 , NXS
          IDET(L,0) = 0
   40      CONTINUE
C
      RETURN
C
      END
