C @(#)mltobj.for	19.1 (ES0-DMD) 02/25/03 13:25:36
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.IDENTIFICATION
C.INPUT/OUTPUT
C  Input arguments
C  A        real*4 array        image buffer
C  JAPY     integer*4 array     pointers to buffer lines
C  IBUF     integer*4 array     limits of image buffer
C  JBE      integer*4           end of buffer
C  IXYU     integer*4 array     limits of used area
C  NC       integer*4           number of entries in catalog buffer
C  MCAT     integer*4 array     integer detections buffer
C  BCAT     real*4 array        real detections buffer
C  NL       integer*4           number of entries in detections buffer
C  M        integer*4           number of detections
C  MMB      integer*4           position in buffer
C  MOB      integer*4           buffer offset
C  IARR     integer*4 array     integer parameters
C  RARR     ral*4 array         real parameters
C  output parameters
C  ACAT     real*4 array        objects buffer
C  MM       integer*4           number of objects
C
C-----------------------------------------------------------------------
      SUBROUTINE MLTOBJ ( A , JAPY , IBUF , JBE , IXYU , ACAT , NC ,
     &            MCAT , BCAT , NL , M , MM , MMB , MOB , IARR , RARR )
C
      IMPLICIT NONE
      INTEGER   NC , NL, ISTAT
C
      INTEGER   IARR(32) , IAV , IAV1 , IAV2 , IBUF(4) , IDPM(5)
      INTEGER   II , II1 , II2 , IM , ISIZ , IXYU(4)
      INTEGER   JAPY(1) , JAV , JAV1 , JAV2 , JBE
      INTEGER   JJ , JJ1 , JJ2 , JM , JOFF
      INTEGER   M , MCAT(4,NL) , MINCR , MM , MMB , MOB
C
      REAL   A(1) , ACAT(5,NC) , ADLM
      REAL   AVBG , AVI , AVII , AVIJ , AVJ , AVJJ , AVM
      REAL   BCAT(2,NL) , GCUT , RARR(64)
      REAL   ELON , TEMP , THETA , TRLM , TRSH
C
      LOGICAL   OBJECT , SINGLE , UNUSED
C
      CHARACTER*80  TEXT
C
      JOFF = IBUF(2) - 1
      GCUT = 0.9 * RARR(2)
      TRSH = RARR(3)
      ADLM = RARR(42)
      MINCR = IARR(22)
C
C ******      Calculate parameters for multiple detection.
C
      OBJECT = .FALSE.
      SINGLE = .TRUE.
      CALL MLTDET( MCAT , BCAT , NL , M , MOB , AVI , AVJ , AVII ,
     &            AVIJ , AVJJ , AVBG , IM , JM , AVM , ISIZ , OBJECT )
      IF ( .NOT. OBJECT ) THEN
          RETURN
      ENDIF
C
C ******      Check if object is elongated.
C
      CALL OBJSHP( AVI , AVJ , AVII , AVIJ , AVJJ , ELON , THETA )
      IF ( ELON .LT. RARR(44) ) THEN
C
C ******          One object is catalogued.
C
          IF ( MMB .EQ. NC ) THEN
              WRITE (TEXT,'(A)') 'Too many detections'
              CALL STTPUT(TEXT,ISTAT)
c             CALL CTLG( ITF , START , STEP , ACAT , NC , MM , MMB )
c             MMB = 0
          ENDIF
          MMB = MMB + 1
          MM = MM + 1
          IF ( AVM .GT. (RARR(2)-AVBG)/1.1 ) THEN
              IM = NINT(AVI)
              JM = NINT(AVJ)
          ELSE
              AVI = FLOAT(IM)
              AVJ = FLOAT(JM)
          ENDIF
          ACAT(1,MMB) = AVI
          ACAT(2,MMB) = AVJ
          ACAT(3,MMB) = AVBG
          ACAT(4,MMB) = AVM
          TRLM = AVBG + TRSH
          CALL RADDET( A , JAPY , IBUF , IM , JM ,
     &                 IARR(22) , TRLM , AVM , TRSH , ACAT(5,MMB) )
          IF ( ACAT(5,MMB) .LE. 0.0 .AND. AVM .LT. GCUT ) THEN
              MMB = MMB - 1
              MM = MM - 1
          ENDIF
      ELSE
C
C ******          Try to find two objects.
C
          UNUSED = .TRUE.
          CALL DOUBLE( A , JAPY , JOFF , JBE , IXYU , IARR(8) ,
     &                  AVBG , AVI , AVJ , THETA , ISIZ , RARR(42) ,
     &                       RARR(45) , RARR(46) , RARR(3) , IDPM )
          AVI = AVI - 0.001
          AVJ = AVJ - 0.001
C
C ******          Array IDPM contains informations
C ******          about double components.
C
          IF ( IDPM(1) .EQ. 2 ) THEN
              IAV1 = NINT( AVI + IDPM(2) )
              JAV1 = NINT( AVJ + IDPM(3) )
              IF ( MAX( ABS(IAV1-IM) , ABS(JAV1-JM) ) .LE. 2 ) THEN
                  IAV1 = IM
                  JAV1 = JM
                  UNUSED = .FALSE.
              ENDIF
              IF ( IAV1 .GE. IARR(12) .AND. IAV1 .LE. IARR(14)
     &                  .AND. JAV1 .GE. IARR(13) .AND. JAV1 .LE.
     &                                          IARR(15) ) THEN
C
C ******                Subroutine DOUBLE has produced
C ******                at least one new position.
C
                  CALL OBJMNG( A , JAPY , IBUF , ACAT , NC ,
     &                         MM , MMB , IAV1 , JAV1 , AVBG ,
     &                         TRSH , GCUT , MINCR )
                  SINGLE = .FALSE.
                  IAV2 = NINT( AVI + IDPM(4) )
                  JAV2 = NINT( AVJ + IDPM(5) )
                  IF ( UNUSED .AND. MAX( ABS(IAV2-IM) , ABS(JAV2-JM) )
     &                                          .LE. 2 ) THEN
                      IAV2 = IM
                      JAV2 = JM
                  ELSE
                      TEMP = A(JAPY(JAV2-JOFF)+IAV2)
                      II1 = MAX( IAV2-2 , IBUF(1) )
                      II2 = MIN( IAV2+2 , IBUF(3) )
                      JJ1 = MAX( JAV2-2 , IBUF(2) )
                      JJ2 = MIN( IAV2+2 , IBUF(4) )
                      DO 10 JJ = JJ1 , JJ2
                          DO 20 II = II1 , II2
                              IF ( A(JAPY(JJ-JOFF)+II) .GT. TEMP )
     &                                                THEN
                                  IAV2 = II
                                  JAV2 = JJ
                                  TEMP = A(JAPY(JJ-JOFF)+II)
                              ENDIF
   20                     CONTINUE
   10                 CONTINUE
                  ENDIF
                  TEMP = SQRT( FLOAT( (IAV1-IAV2)*(IAV1-IAV2) +
     &                                   (JAV1-JAV2)*(JAV1-JAV2) ) )
                  IF ( TEMP .GE. ADLM .AND. IAV2 .GE. IARR(12) .AND.
     &                   IAV2 .LE. IARR(14) .AND. JAV2 .GE. IARR(13)
     &                                .AND. JAV2 .LE. IARR(15) ) THEN
C
C ******                  Fainter component is catalogued.
C
                       CALL OBJMNG( A , JAPY , IBUF , ACAT , NC ,
     &                              MM , MMB , IAV2 , JAV2 , AVBG ,
     &                              TRSH , GCUT , MINCR )
                       SINGLE = .FALSE.
                   ENDIF
               ENDIF
          ELSE IF ( IDPM(1) .EQ. 1 ) THEN
              SINGLE = .TRUE.
          ENDIF
          IF ( SINGLE ) THEN
C
C ******            Is case that subroutine DOUBLE has
C ******            produced no acceptable position
C ******            of an object, the highest out of
C ******            multiple detection is catalogued.
C
               IF ( AVM .LE. (RARR(2)-AVBG)/1.1 ) THEN
                   IAV = IM
                   JAV = JM
               ELSE
                   IAV = NINT(AVI)
                   JAV = NINT(AVJ)
               ENDIF
               CALL OBJMNG( A , JAPY , IBUF , ACAT , NC ,
     &                      MM , MMB , IAV , JAV , AVBG ,
     &                      TRSH , GCUT , MINCR )
          ENDIF
      ENDIF
C
      RETURN
C
      END


