C @(#)radcor.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 RADCOR version 1.2 870729 C A. Kruszewski ESO Garching C.PURPOSE C Correct different radial size parameters and isophotal magnitude C for influence of brightness dependent finite size of the used image. C A stellar object is assumed. C This subroutine should remove any brightness dependence of C corrected radial size parameters and isophotal magnitudes C for stellar objects. C It is irrelevant for galaxies. C It work for unsaturated objects only. 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 stallar objects C TRSH real*4 detection treshold C output arguments C PCLA real*4 array array holding corrected classifiers C----------------------------------------------------------------------- SUBROUTINE RADCOR(PMTR,PCLA,M,STPR,TRSH) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C REAL PMTR(30,MAXCNT) REAL PCLA(0:13,MAXCNT) INTEGER M REAL STPR(MAXCNT) REAL TRSH C INTEGER I, IR, IT INTEGER J INTEGER NPXL(0:MAXSUB) C REAL TEMP REAL FI, FRCT REAL SPIU(0:MAXSUB) REAL DIF1, DIF2 REAL ALIM REAL CTRS, CR, CM REAL CMAG(0:100) REAL CRAD(0:100),AIN0(0:MAXSUB) REAL AIN1(0:MAXSUB),AIN2(0:MAXSUB),AINK(0:MAXSUB) C DATA NPXL/1,8,12,16,32,28,40,40,48,68,56,72,68,88,88,84,112,112, + 112,116,112,144,140,144,144,168,164,160,184,172,200,192,188, + 208,224,224,228,224,248,236,264,248,264,276,264,288,276,304, + 304,312,316/ C C Transforms the differential logarithmic C *** point spread function STPR into profile C in intensity units SPIU. C SPIU(0) = 1.0 DO 10 I = 1,50 SPIU(I) = SPIU(I-1)* (10.0** (-STPR(I))) 10 CONTINUE C C *** Calculates integrated quantities. C AIN0(0) = 1.0 AIN1(0) = 0.333 AIN2(0) = 0.1 AINK(0) = 10.0 DO 20 I = 1,50 TEMP = SPIU(I)*NPXL(I) AIN0(I) = AIN0(I-1) + TEMP AIN1(I) = AIN1(I-1) + TEMP*I AIN2(I) = AIN2(I-1) + TEMP*I*I AINK(I) = AINK(I-1) + TEMP/ (I*I) 20 CONTINUE DO 30 I = 0,50 AIN1(I) = AIN1(I)/AIN0(I) AIN2(I) = AIN2(I)/AIN0(I) AINK(I) = AINK(I)/AIN0(I) 30 CONTINUE DO 40 I = 0,50 AIN1(I) = AIN1(25)/AIN1(I) AIN2(I) = AIN2(25)/AIN2(I) AIN2(I) = AIN2(I)**0.5 AINK(I) = AINK(25)/AINK(I) AINK(I) = AINK(I)**(-0.5) 40 CONTINUE C C *** Correct following parameters: "RADIUS1", "RADIUS2","KRON RADIUS". C DO 50 I = 1,M C C *** Store value of the limiting radius in variable TEMP. TEMP = PMTR(15,I) IR = INT(TEMP) FRCT = TEMP - IR C C *** Apply the corrections. C PCLA(4,I) = PMTR(6,I)* 2 (AIN1(IR)* (1.0-FRCT)+AIN1(IR+1)*FRCT) PCLA(5,I) = PMTR(7,I)* 2 (AIN2(IR)* (1.0-FRCT)+AIN2(IR+1)*FRCT) PCLA(12,I) = PMTR(18,I)* 2 (AINK(IR)* (1.0-FRCT)+AINK(IR+1)*FRCT) 50 CONTINUE C C Corrects parameters: "ISOPHOTAL MAGNITUDE", "LIMITING RADIUS". C it takes into account that the stellar profile is cut by C limiting treshold in a different way depending on stellar C *** brightness. Average of 9 central pixels is taken as a C measure of stellar brightness. Stellar profile is cut C horizontally by 100 eqidistant levels. Corrections are C calculated for each level and stored in arrays CMAG and C CRAD. Linear interpolation is used. C DO 80 I = 1,100 J = 0 CMAG(I) = 0.0 CRAD(I) = 0.0 FI = FLOAT(I) ALIM = (100.0-FI)*0.01 60 CONTINUE IF ( .NOT. (SPIU(J).GT.ALIM) ) GO TO 70 CMAG(I) = CMAG(I) + SPIU(J)*NPXL(J) J = J + 1 IF (J.GT.50) THEN J = 50 ELSE GO TO 60 ENDIF 70 CONTINUE DIF1 = SPIU(J-1) - ALIM DIF2 = SPIU(J-1) - SPIU(J) IF (DIF1.GT.0.0001 .AND. DIF2.GT.0.0001) THEN FRCT = DIF1/DIF2 ELSE FRCT = 0.0 END IF IF (FRCT.GT.1.0) THEN FRCT = 1.0 END IF CMAG(I) = CMAG(I) + FRCT*SPIU(J)*NPXL(J) CRAD(I) = J - 1 + FRCT 80 CONTINUE C DO 90 I = 1,100 CMAG(I) = 2.5*LOG10(CMAG(I)/CMAG(100)) CRAD(I) = CRAD(99) - CRAD(I) 90 CONTINUE C CMAG(0) = 3.0*CMAG(1) - 2.0*CMAG(2) CRAD(0) = 3.0*CRAD(1) - 2.0*CRAD(2) CTRS = (SPIU(0)+8.0*SPIU(1))* (TRSH/9) DO 100 I = 1,M IF (PMTR(2,I).GT.TRSH) THEN TEMP = (1.0-CTRS/PMTR(2,I))*100.0 IT = INT(TEMP) FRCT = TEMP - IT CM = CMAG(IT)* (1.0-FRCT) + CMAG(IT+1)*FRCT IF (IT.EQ.99) THEN CR = 0.0 ELSE CR = CRAD(IT)* (1.0-FRCT) + CRAD(IT+1)*FRCT END IF ELSE CM = 0.0 CR = 0.0 END IF PCLA(3,I) = PMTR(5,I) + CM PCLA(9,I) = PMTR(15,I) + CR 100 CONTINUE C RETURN END