C @(#)prflch.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:44 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 PRFLCH version 2.0 870725 C A. Kruszewski ESO Garching C.KEYWORDS C profiles C.PURPOSE C It checks if an average profile AVPR goes down with the increasing C radius K at least as steep as p.s.f. multiplied by a factor DNEB. C If not then a value of an image size LIM is adjusted. C.INPUT/OUTPUT C input arguments C AVPR real*4 array one-dimensional profile C LIM integer*4 number of significant profile rings C KSAT integer*4 number of saturated profile rings C HCUT real*4 saturation level C STPR real*4 array logarithmic p.s.f. C DNEB integer*4 rejection factor C output arguments C LIM integer*4 number of significant profile rings C----------------------------------------------------------------------- SUBROUTINE PRFLCH(AVPR, IHED, KSAT, HCUT, APSF, DNEB , LIM) C IMPLICIT NONE C INTEGER IHED REAL APSF(0:IHED) INTEGER KSAT REAL HCUT REAL AVPR(0:IHED) REAL DNEB INTEGER LIM C INTEGER IC INTEGER KK, KL REAL TEMP C IC = 0 KK = MAX(KSAT+2,3) IF (KK .GE. LIM) THEN RETURN ENDIF KL = KK - 1 IF (KL .LT. 0) THEN RETURN ENDIF C 10 CONTINUE IF (.NOT.(KK.LE.LIM .AND. AVPR(KK).GT.0.0 .AND. IC.EQ.0)) THEN GOTO 20 ENDIF TEMP = (AVPR(KL)/AVPR(KK)) - DNEB*(APSF(KL)/APSF(KK)) IF (TEMP .LT. 0.0) THEN IC = 1 ENDIF KK = KK + 1 GOTO 10 C 20 CONTINUE IF (IC .EQ. 1) THEN LIM = MAX(KK-1, 4) ENDIF C RETURN END