C @(#)clpmtr.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:39 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.IDENT: subroutine CLPMTR version 1.2 870729 C A. Kruszewski ESO Garching C.PURPOSE: classifies objects into stars, galaxies and image defects C.INPUT/OUTPUT C input arguments C PMTR real*4 array array holding classifiers C M integer*4 number of objects C STPR real*4 array one-dimensional point spread function C of stellar objects C TRSH real*4 detection treshold above the sky C output arguments C ICLS integer*4 array array holding the classification C PMTR real*4 array modified array holding classifiers C FAIL logical fail flag C----------------------------------------------------------------------- SUBROUTINE CLPMTR(PMTR,ICLS,M,STPR,TRSH,FAIL) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C INTEGER ICTL(7) INTEGER ICLS(2,MAXCNT) INTEGER IAC INTEGER ISTAT INTEGER I, IB, IF INTEGER KUN, KNUL INTEGER M INTEGER MADRID(1) C REAL BLMT REAL PMTR(30,MAXCNT) REAL STPR(MAXSUB) REAL TRSH C LOGICAL BRGT(MAXCNT) LOGICAL FAIL C COMMON /VMR/MADRID C CALL STKRDR('INV_REAL', 8, 1, IAC, BLMT, KUN, KNUL, ISTAT) C C **** Set corresponding elements of BRGT to true for bright objects. C IB = 0 IF = 0 DO 10 I = 1,M IF (PMTR(5,I).LT.BLMT) THEN BRGT(I) = .TRUE. IB = IB + 1 ELSE BRGT(I) = .FALSE. IF = IF + 1 END IF 10 CONTINUE ICTL(1) = IF ICTL(2) = IB DO 20 I = 3,7 ICTL(I) = 0 20 CONTINUE C C classifies bright objects C CALL CLBRGT(PMTR, BRGT, ICLS, M) C C classifies faint objects C CALL CFAINT(PMTR, BRGT, ICLS, M, STPR, TRSH, FAIL) C C Elements of ICLS(1,*) are coded: 0-unclassified, 1-star, C 2-galaxy C **** and they describe the classification of seed objects. C Elements of ICLS(2,*) are coded: 0-defect, 1-star, 2-galaxy C and they describe current classification of objects. C RETURN END