C @(#)fppmtr.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:41 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 FPPMTR version 1.2 830908 C A. Kruszewski ESO Garching C modified version 1.3 870303 C A. Kruszewski Obs. de Geneve C.KEYWORDS C classifiers, positions, elongation, position angle C.PURPOSE C provides parameters which can be calculated only with help C of full eight octant profile C.ALGORITHM C corrections to the position "DX" and "DY" expressed in pixels C are calculated with help of Fourier expansion C.INPUT/OUTPUT C input arguments C PRFL real*4 array two-dimensional profile C ICNT integer*4 array numbers of pixels used to calculate PRFL C AVPR real*4 array one-dimensional profile C IAVR integer*4 array numbers of used pixels C LHED integer halfedge of local subarray C LIM integer*4 radial extent of profiles C KCLN integer*4 radial extend of clean profile C KSAT integer*4 extend of saturated part of profile C ID integer*4 identification number of object C L0 integer*4 offset to catalog buffers C TRSH real*4 limiting detection treshold C IVRF integer*4 verification flag C M0 integer*4 number of objects C ITT integer*4 total number of passes C NPAS integer*4 actual pass number C PMTR real*4 array holding classifiers C NP integer*4 size of catalog buffers C TWODIM logical not used C output parameters C PMTR real*4 array array holding classifiers C----------------------------------------------------------------------- SUBROUTINE FPPMTR(PRFL, ICNT, AVPR, IAVR, LHED, & LIM, KCLN, KSAT, ID, L0, & TRSH, IVRF, M0, ITT, NPAS, & NCAT, PMTR) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C REAL PRFL(8, 0:MAXSUB) INTEGER ICNT(8, 0:MAXSUB) REAL AVPR( 0:MAXSUB) INTEGER IAVR(0:MAXSUB) INTEGER LHED INTEGER LIM INTEGER KCLN INTEGER KSAT INTEGER ID INTEGER L0 REAL TRSH INTEGER IVRF INTEGER M0 INTEGER ITT INTEGER NPAS INTEGER NCAT(NIPAR,MAXCNT) REAL PMTR(NRPAR,MAXCNT) C INTEGER NP INTEGER KFB, KFE INTEGER K INTEGER LZ REAL SUM0, SUM1, SUM2, SUM3, SUM4 REAL DPRF REAL AT REAL TEMP REAL AMPL REAL COEF(7, MAXSUB) REAL FAMP(3, MAXSUB) C LOGICAL TWODIM C C *** NP = MAXCNT LZ = ID - L0 C C *** Isolate part of profile which is neither saturated nor blended. KFB = MAX( KSAT+1 , 1 ) KFE = MAX( KFB , KCLN ) KFE = MIN( KFE , LIM , LHED-1 ) C C *** Calculate Fourier coefficients. CALL OCTFRR( PRFL , ICNT , AVPR , LIM , COEF , FAMP ) C C *** Calculate classifiers. SUM0 = 0.0 SUM1 = 0.0 SUM2 = 0.0 SUM3 = 0.0 SUM4 = 0.0 DPRF = 0.0 DO 10 K = KFB , KFE SUM0 = SUM0 + AVPR(K) SUM1 = SUM1 + COEF(1,K) SUM2 = SUM2 + COEF(2,K) SUM3 = SUM3 + COEF(3,K) SUM4 = SUM4 + COEF(4,K) DPRF = DPRF + (AVPR(K-1)-AVPR(K+1)) / 2.0 10 CONTINUE C C *** Calculate corrections to the position. IF ( NCAT(9,LZ) .EQ. 0 .AND. DPRF .GT. 0.3*TRSH .AND. & ( .NOT. ( ( IVRF .EQ. 0 .AND. ID .LE. M0 ) & .OR. ( ITT .GT. 1 .AND. NPAS .EQ. 1 ) ) ) ) THEN TEMP = SUM1 / DPRF AT = ABS( TEMP ) IF ( AT .GT. 1.0 ) THEN TEMP = TEMP / AT ENDIF PMTR(10,LZ) = FLOAT( NINT( PMTR(10,LZ) ) ) + TEMP TEMP = SUM2 / DPRF AT = ABS( TEMP ) IF ( AT .GT. 1.0 ) THEN TEMP = TEMP / AT ENDIF PMTR(11,LZ) = FLOAT( NINT( PMTR(11,LZ) ) ) + TEMP ENDIF C C *** Calculate image elongation and position angle. IF ( SUM0 .GT. 0.01*TRSH ) THEN AMPL = SQRT( SUM3*SUM3 + SUM4*SUM4 ) PMTR(8,LZ) = AMPL / SUM0 IF ( AMPL .GT. 0.01*TRSH ) THEN PMTR(9,LZ) = 90.0 * ATAN2( SUM4 , SUM3 )/ 3.14159265 ELSE PMTR(9,LZ) = 90.0 ENDIF ELSE PMTR(8,LZ) = 0.0 PMTR(9,LZ) = 90.0 ENDIF C C *** Convert position angle into astronomical convention. PMTR(9,LZ) = 90.0 - PMTR(9,LZ) IF ( PMTR(9,LZ) .LT. 0.0 ) THEN PMTR(9,LZ) = PMTR(9,LZ) + 180.0 ENDIF C RETURN END