C @(#)octfrr.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:43 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 OCTFRR version 1.2 830908 C A. Kruszewski ESO Garching C modified version 1.3 870303 C A. Kruszewski Obs. de Geneve C.KEYWORDS C profiles, Fourier coefficients C.PURPOSE C calculates Fourier coefficients of a profile "PRFL" as a function C of octants "COEF" C calculates also Fourier amplitudes "FAMP" C.INPUT/OUTPUT C input arguments C PRFL real*4 array two-dimensional profile C ICNT integer*4 array numbers of used pixels at calculating PRFL C AVPR real*4 array one dimensional profile C LIM integer*4 number of rings considered C LOUT integer*4 flag enabling output C output arguments C COEF real*4 array Fourier coefficients C FAMP real*4 array Fourier amplitudes C average profiles "AVPR" and Fourier amplitudes are outputted C into log file when "LOUT=3" C----------------------------------------------------------------------- SUBROUTINE OCTFRR(PRFL, ICNT, AVPR, LIM, COEF, FAMP) C IMPLICIT NONE C INTEGER LIM REAL PRFL(8,0:LIM) INTEGER ICNT(8,0:LIM) REAL AVPR(0:LIM) REAL COEF(7,LIM) REAL FAMP(3,LIM) C INTEGER K, L LOGICAL GOOD C DO 10 K = 1 , LIM DO 20 L = 1 , 7 COEF(L,K) = 0.0 20 CONTINUE DO 30 L = 1 , 3 FAMP(L,K) = 0.0 30 CONTINUE 10 CONTINUE C C ****** Calculate Fourier coefficients. C K = 1 GOOD = .TRUE. 40 CONTINUE COEF(1,K) = 0.25*PRFL(1,K) + 0.17677*PRFL(2,K) - & 0.17677*PRFL(4,K) - 0.25*PRFL(5,K) - & 0.17677*PRFL(6,K) + 0.17677*PRFL(8,K) COEF(2,K) = 0.17677*PRFL(2,K) + 0.25*PRFL(3,K) + & 0.17677*PRFL(4,K) - 0.17677*PRFL(6,K) - & 0.25*PRFL(7,K) - 0.17677*PRFL(8,K) COEF(3,K) = 0.25*PRFL(1,K) - 0.25*PRFL(3,K) + & 0.25*PRFL(5,K) - 0.25*PRFL(7,K) COEF(4,K) = 0.25*PRFL(2,K) - 0.25*PRFL(4,K) + & 0.25*PRFL(6,K) - 0.25*PRFL(8,K) COEF(5,K) = 0.25*PRFL(1,K) - 0.17677*PRFL(2,K) + & 0.17677*PRFL(4,K) - 0.25*PRFL(5,K) + & 0.17677*PRFL(6,K) - 0.17677*PRFL(8,K) COEF(6,K) = 0.17677*PRFL(2,K) - 0.17677*PRFL(3,K) + & 0.25*PRFL(4,K) - 0.17677*PRFL(6,K) + & 0.17677*PRFL(7,K) - 0.25*PRFL(8,K) COEF(7,K) = 0.25*PRFL(1,K) - 0.25*PRFL(2,K) + & 0.25*PRFL(3,K) - 0.25*PRFL(4,K) + & 0.25*PRFL(5,K) - 0.25*PRFL(6,K) + & 0.25*PRFL(7,K) - 0.25*PRFL(8,K) C C ****** Calculate Fourier amplitudes. C FAMP(1,K) = SQRT( COEF(1,K)*COEF(1,K) + & COEF(2,K)*COEF(2,K) ) FAMP(2,K) = SQRT( COEF(3,K)*COEF(3,K) + & COEF(4,K)*COEF(4,K) ) FAMP(3,K) = SQRT( COEF(5,K)*COEF(5,K) + & COEF(6,K)*COEF(6,K) ) K = K + 1 IF ( K .LE. LIM ) THEN IF ( MIN( ICNT(1,K) , ICNT(2,K) , ICNT(3,K) , & ICNT(4,K) , ICNT(5,K) , ICNT(6,K) , & ICNT(7,K) , ICNT(8,K) ) .EQ. 0 ) THEN GOOD = .FALSE. ENDIF ELSE GOOD = .FALSE. ENDIF IF ( K .LE. LIM .AND. GOOD ) GOTO 40 C RETURN END