C @(#)cfaint.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.IDENIFICATION C C subroutine CFAINT version 1.2 870729 C A. Kruszewski ESO Garching C C.PURPOSE C C classifies unsaturated objects into stars, galaxies and image defects C C.INPUT/OUTPUT C C input arguments C C PMTR real*4 array array holding classifiers C BRGT logical array array indicating saturated objects C M integer*4 number of objects C STPR real*4 array one-dimensional point spread function C of stallar objects C TRSH real*4 detection treshold above the sky C background C C output arguments C C ICLS integer*4 array array holding the classification C coded: 0-defect or not classified, C 1-star, 2-galaxy. for each object C the first element gives a seed value, C the second gives a current value. C FAIL logical fail flag C----------------------------------------------------------------------- SUBROUTINE CFAINT(PMTR,BRGT,ICLS,M,STPR,TRSH,FAIL) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C REAL PMTR(30,MAXCNT) LOGICAL BRGT(MAXCNT) INTEGER ICLS(2,MAXCNT) INTEGER M REAL STPR(MAXCNT) REAL TRSH LOGICAL FAIL C INTEGER ITER INTEGER KZ6901 REAL PCLA(0:13,MAXCNT) C LOGICAL DONE C C sets seed samples of stars and galaxies C CALL STSEED(PMTR,BRGT,ICLS,M,TRSH,FAIL) IF (FAIL) THEN RETURN END IF C C corrects radius parameters for distortions due to C finite sizes of objects C CALL RADCOR(PMTR,PCLA,M,STPR,TRSH) C C transforms parameters in order to make them more independend C and to assure similar ranges of variability C CALL TRSFRM(PMTR,PCLA,M) C C performs classification C DONE = .FALSE. ITER = 0 DO 10 KZ6901 = 1,100000000 IF ( .NOT. (.NOT.DONE.AND.ITER.LE.20)) GO TO 20 CALL CLASFY(PCLA,BRGT,ICLS,M,ITER,DONE) 10 CONTINUE 20 CONTINUE C C seed classification is coded in ICLS(1,*) C final classification is coded in ICLS(2,*) C 0-defect or unclassified, 1-star, 2-galaxy C RETURN END