C @(#)newobj.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  subroutine NEWOBJ         version 1         820624
C  A. Kruszewski             ESO Garching
C  modified for FX           version 1.1       870303
C  A. Kruszewski             Obs. de Geneve
C.PURPOSE
C  adds new objects detected by subroutine "PRANLZ" to a master list
C  of objects
C.INPUT/OUTPUT
C  input arguments
C  A           real*4 array      image frame
C  N1          integer*4         x-dimension of array A
C  N2          integer*4         y-dimension of array A
C  I           integer*4         x-position of object
C  J           integer*4         y-position of object
C  NCAT        integer*4 array   integer parameters of objects
C  PMTR        real*4 array      array holding objects' parameters
C  L           integer*4         identification number of an object
C  MM          integer*4         actual number of catalogued objects
C  TRSH        real*4            limiting threshold
C  ADLM        real*4            minimum acceptable separation
C                                between components in pixels
C  MCM         integer*4 array   array holding informations about
C                                new objects
C  output parameters
C  NCAT        integer*4 array   integer parameters of objects
C  PMTR        real*4 array      array holding objects' parameters
C  MM          integer*4         actual number of catalogued objects
C
C-----------------------------------------------------------------------
      SUBROUTINE NEWOBJ(A, JAPY, IBUF, I, J,
     &                  NREG, LSTP, NCAT, PMTR, PRCT,
     &                  L, L0, L1, LW, MM,
     &                  TRSH, ADLM, MCM)
C
      IMPLICIT  NONE
      INCLUDE   'MID_REL_INCL:INVENT.INC'
C
      REAL      A(1)
      INTEGER   JAPY(1)
      INTEGER   IBUF(4)
      INTEGER   I
      INTEGER   J
      INTEGER   NREG
      INTEGER   LSTP(0:4,0:NREG)
      INTEGER   NCAT(NIPAR,MAXCNT)
      REAL      PMTR(NRPAR,MAXCNT)
      REAL      PRCT(0:MAXSUB,MAXCNT)
      INTEGER   L
      INTEGER   L0
      INTEGER   L1
      INTEGER   LW
      INTEGER   MM
      REAL      TRSH
      REAL      ADLM
      INTEGER   MCM(21)
C
      INTEGER   ID(10)
      INTEGER   IDL, IDLM
      INTEGER   IDX, IDY
      INTEGER   II
      INTEGER   IL, IL1
      INTEGER   ILX, ILY
      INTEGER   IK, IK1, IK2
      INTEGER   JDLM
      INTEGER   JJ
      INTEGER   JK, JK1, JK2
      INTEGER   JOF
      INTEGER   K, KL , KL1
      INTEGER   LL, LZ
      INTEGER   LLX, LLY
      INTEGER   L1B, LWB, LACT, LAZ
      INTEGER   NI, NJ, NP
      INTEGER   MZ
      INTEGER   IXY(2,10)
      INTEGER   NCT(NIPAR) 
      INTEGER   NCT1(NIPAR)
C
      REAL      XOBJ, YOBJ
      REAL      XCMP, YCMP
      REAL      DIST
      REAL      SUM
      REAL      PMT(NRPAR)
      REAL      PMT1(NRPAR)
      REAL      PRC(0:MAXSUB) 
      REAL      PRC1(0:MAXSUB)
C
      LOGICAL   DONE
C
      NP = MAXCNT
      LZ = L - L0
      IDLM = MAX( 1 , NINT(ADLM)-1 )
      IDL = NINT(ADLM*ADLM)
      JDLM = NINT(ADLM) + 1
C
C *** Recall number of detected new objects KL.
C
      KL=MCM(1)
C
C *** Prepare blank arrays.
C
      IF ( MM+KL .GT. L0+NP ) THEN
          DO 5 K = 1 , NIPAR
              NCT(K) = 0
    5     CONTINUE
          DO 6 K = 1 , NRPAR
              PMT(K) = 0.0
    6     CONTINUE
          DO 7 K = 0 , MAXSUB
              PRC(K) = 0.0
    7     CONTINUE
      ENDIF
      DO 8 K = 1 , 10
          ID(K) = 0
    8 CONTINUE
C
C *** Form array with new objects coordinates.
C
      DO 10 IL = 1 , KL
          IXY(1,IL) = MCM(2*IL)
          IXY(2,IL) = MCM(2*IL+1)
   10 CONTINUE
C
C *** Mark existance of objects.
C
      DO 20 IL = 1 , KL
          ID(IL) = 1
   20 CONTINUE
C
C *** Parent object coordinates may be shifted.
C
      NI = I - NCAT(1,LZ)
      NJ = J - NCAT(2,LZ)
C
C *** Combine multiple detections.
C
      KL1 = KL - 1
      DO 30 IL = 1 , KL1
          IL1 = IL + 1
          DO 40 LL = IL1 , KL
              IDX = IXY(1,IL) - IXY(1,LL)
              IDY = IXY(2,IL) - IXY(2,LL)
              IF ( IDX*IDX+IDY*IDY .LT. IDL ) THEN
                  ILX = IXY(1,IL) + NI
                  ILY = IXY(2,IL) + NJ
                  LLX = IXY(1,LL) + NI
                  LLY = IXY(2,LL) + NJ
                  IF ( A(JAPY(LLY-IBUF(2)+1)+LLX) .GT.
     &                    A(JAPY(ILY-IBUF(2)+1)+ILX) ) THEN
                      ID(LL) = 0
                  ELSE
                      ID(IL) = 0
                  ENDIF
              ENDIF
   40     CONTINUE
   30 CONTINUE
C
C *** Look for already filed object closer than ADLM.
C
      DO 50 IL = 1 , KL
          IF ( ID(IL) .EQ. 1 ) THEN
C
C ***         Trial filing of a new object.
C
              L1B = L1
              LWB = LW
C              IF ( MM+1 .GT. L0 .AND. MM+1 .LE. L0+NP ) THEN
              L1 = MAX( L1 , MM+1 )
              NCAT(1,MM+1-L0) = IXY(1,IL)
              NCAT(2,MM+1-L0) = IXY(2,IL)
C              ELSE
C                  NCT(1) = IXY(1,IL)
C                  NCT(2) = IXY(2,IL)
C                  NCT(7) = 0
C                  NCT(8) = 0
C                  WRITE ( ISF , REC = MM+1 ) NCT , PMT , PRC
C                  LW = MAX( LW , MM+1 )
C              ENDIF
              CALL PUTLSS( MM+1 , NREG , LSTP , NCAT , PMTR , PRCT )
C              IF ( MM+1 .LE. L0 .OR. MM+1 .GT. L0+NP ) THEN
C                  READ ( ISF , REC = MM+1 ) NCT , PMT , PRC
C              ENDIF
C
C ***         Check if there is already another object closer than ADLM.
C
              LACT = 0
   72         CONTINUE
              CALL GETLST( MM+1 , L0 , L1 , JDLM , NREG , 
     &                     LSTP , NCAT , PMTR , PRCT , LACT ,
     &                     NCT1 , PMT1 , PRC1 , DONE )
              IF ( DONE ) THEN
                  XOBJ = FLOAT(IXY(1,IL))
                  YOBJ = FLOAT(IXY(2,IL))
C                  IF ( LACT .GT. L0 .AND. LACT .LE. L1 ) THEN
                      LAZ = LACT - L0
                      XCMP = PMTR(10,LAZ)
                      YCMP = PMTR(11,LAZ)
C                  ELSE
C                      XCMP = PMT1(10)
C                      YCMP = PMT1(11)
C                  ENDIF
                  DIST = SQRT( (XOBJ-XCMP)**2.0 + (YOBJ-YCMP)**2.0 )
                  IF ( DIST .LT. ADLM ) THEN
                      DONE = .TRUE.
                  ELSE
                      GOTO 72
                  ENDIF
              ENDIF
              IF ( .NOT. DONE ) THEN
C 
C ***             Catalogue new object.
C
                  MM = MM + 1
C                  IF ( MM .GT. L0 .AND. MM .LE. L0+NP ) THEN
                      MZ = MM - L0
                      NCAT(1,MZ) = MCM(2*IL)
                      NCAT(2,MZ) = MCM(2*IL+1)
                      PMTR(10,MZ) = FLOAT(NCAT(1,MZ))
                      PMTR(11,MZ) = FLOAT(NCAT(2,MZ))
c                      NCAT(4,MZ) = 0
                      PMTR(1,MZ) = PMTR(1,LZ)
                      IK = NCAT(1,MZ) + NI
                      JK = NCAT(2,MZ) + NJ
                      IF ( IK .LE. IBUF(1) .OR. IK .GE. IBUF(3)
     &                                     .OR. JK .LE. IBUF(2)
     &                                     .OR. JK .GE. IBUF(4) ) THEN
                          PMTR(2,MZ) = 0.0
                          GOTO 71
                      ENDIF
                      SUM = 0.0
                      IK1 = IK - 1
                      IK2 = IK + 1
                      JK1 = JK - 1
                      JK2 = JK + 1
                      DO 60 JJ = JK1 , JK2
                          JOF = JAPY(JJ-IBUF(2)+1)
                          DO 70 II = IK1 , IK2
                              SUM = SUM + A(JOF+II)
   70                     CONTINUE
   60                 CONTINUE
                      PMTR(2,MZ) = SUM / 9.0 - PMTR(1,MZ)
   71                 CONTINUE
                      IF ( PMTR(2,MZ) .LT. TRSH ) THEN
                          CALL RMFLST( MM , L0 , L1 , NREG ,
     &                                 LSTP , NCAT ) 
                          MM = MM - 1
                          L1 = L1B
                          LW = LWB
                      ENDIF
C                  ELSE
C                      NCT(1) = MCM(2*IL)
C                      NCT(2) = MCM(2*IL+1)
C                      PMT(10) = FLOAT(NCT(1))
C                      PMT(11) = FLOAT(NCT(2))
C                      NCT(4) = 0
C                      PMT(1) = PMTR(1,LZ)
C                      IK = NCT(1) + NI
C                      JK = NCT(2) + NJ
C                      IF ( IK .LE. IBUF(1) .OR. IK .GE. IBUF(3)
C     &                                     .OR. JK .LE. IBUF(2)
C     &                                     .OR. JK .GE. IBUF(4) ) THEN
C                          PMT(2) = 0.0
C                          GOTO 91
C                      ENDIF
C                      SUM = 0.0
C                      IK1 = IK - 1
C                      IK2 = IK + 1
C                      JK1 = JK - 1
C                      JK2 = JK + 1
C                      DO 80 JJ = JK1 , JK2
C                          JOF = JAPY(JJ-IBUF(2)+1)
C                          DO 90 II = IK1 , IK2
C                              SUM = SUM + A(JOF+II)
C   90                     CONTINUE
C   80                 CONTINUE
C                      PMT(2) = SUM / 9.0 - PMT(1)
C   91                 CONTINUE
C                      IF ( PMT(2) .LT. TRSH ) THEN
C                          CALL RMFLST( ISF , MM , L0 , L1 , NREG ,
C     &                                 LSTP , NCAT ) 
C                          MM = MM - 1
C                          L1 = L1B
C                          LW = LWB
C                      ELSE
C                          WRITE ( ISF , REC=MM ) NCT , PMT , PRC
C                      ENDIF
C                  ENDIF
              ELSE
C
C ***             Remove back an added object from the list.
C
                  CALL RMFLST( MM+1 , L0 , L1 , NREG ,
     &                         LSTP , NCAT )
                  L1 = L1B
                  LW = LWB
              ENDIF
          ENDIF
   50 CONTINUE
C
      RETURN
C
      END
C
