C @(#)joinmd.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:42 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 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