C @(#)apfftc.for	17.1.1.1 (ES0-DMD) 01/25/02 17:18:59
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
C.IDENTIFICATION:
C  SUBROUTINE  APFFTC            VERSION 1.1             FEB  15, 1988
C  P.GROSBOL                     ESO-GARCHING
C
C.PURPOSE
C  COMPUTE FOURIER COMPONENTS FOR AN AZIMUTHAL PROFILE OF A GALAXY 
C  EXTRACTED ALONG AN ELLIPSE WITH (PA,AI).
C
C.ALGORITHM
C  POINTS A INTERPOLATED BILINEAR ALONG AN ELLIPSE. THIS PROFILE IS
C  FOURIER TRANSFORMED AND THE FIRST 'NF' COMPONENTS ARE SAVED.
C
C.INPUT/OUTPUT
C  THE SUBROUTINE IS CALLED AS
C
C   CALL APFFTC( AR, NX, NY, XC, YC, R, PA, AI, NF, MF, AMP, PHA, AN)
C
C  WHERE THE PARAMETERS ARE
C     AR(NX,NY) :  ARRAY CONTAINING THE IMAGE                      (I)
C     NX        :  NO. OF X PIXELS                                 (I)
C     NY        :  NO. OF Y PIXELS                                 (I)
C     XC        :  X CENTER OF ELLIPSE IN PIXELS                   (I)
C     YC        :  Y CENTER OF ELLIPSE IN PIXELS                   (I)
C     R         :  MAJOR AXIS OF ELLIPSE IN PIXELS                 (I)
C     PA        :  POSITION ANGLE (MATH) IN RAD.                   (I)
C     AI        :  INCLINATION ANGLE IN RAD.                       (I)
C     NF        :  NO. OF FFT COMPONENT TO COMPUTE                 (I)
C     MF        :  HIGHEST FFT COEFFICIENT AVAILABLE               (O)
C     AMP(NF)   :  AMPLITUDES (N=0,1,2,...,NF-1)                   (O)
C     PHA(NF)   :  PHASES (N=0,1,2,...NF-1)                        (O)
C     AN        :  AMPLITUDE OF HIGHEST FFT FREQUENCE (NOISE)      (O)
C
C----------------------------------------------------------------------
      SUBROUTINE APFFTC(AR,NX,NY,XC,YC,R,PA,AI,NF,MF,AMP,PHA,AN)
C
      IMPLICIT  NONE
      INTEGER   NX
      INTEGER   NY
      REAL      AR(NX,NY)
      REAL      XC
      REAL      YC
      REAL      R
      REAL      PA
      REAL      AI
      INTEGER   NF
      INTEGER   MF
      REAL      AMP(NF)
      REAL      PHA(NF)
      REAL      AN
C
      INTEGER   I, IERR
      INTEGER   L
      INTEGER   MP
      PARAMETER (MP=2048)
      INTEGER   NP, NP2, NC
      REAL      FNR
      REAL      PROF(MP)
      REAL      AAA, BBB
      CHARACTER*80 MSG
C
C     INITIATE VARIABLES AND CHECK NO. OF FFT COEFFICIENT
C
      DO 100, I = 1,NF
         AMP(I) = 0.0
         PHA(I) = 0.0
  100 CONTINUE
      MF = 0
      AN = 0.0
      IF (NF.LT.1) RETURN
C
C     EXTRACT PROFINE
C
      CALL EXTELL(AR,NX,NY,XC,YC,R,PA,AI,MP,PROF,NP)
      CALL STTPUT(MSG,IERR)
      IF (NP.LE.0) RETURN
C
C     COMPUTE FFT AND COEFFICIENTS
C
      NP2 = INT( LOG(FLOAT(NP))/LOG(2.0)+0.5 )
      MF  = 2**(NP2-1)
      NC  = MIN( NF , MF )
      CALL FFA(NP2,PROF)
      FNR = 2.0 / FLOAT(NP)
      AMP(1) = 0.5 * FNR * PROF(1)
      AN     = FNR * ABS(PROF(2))
      DO 200, I = 2,NC
         L = 2*I - 1
         AMP(I) = FNR * SQRT(PROF(L)**2+PROF(L+1)**2)
C Next line gives compiler error with F77 5.1 in SunOS 5.6. CG.
C         PHA(I) = ATAN2( PROF(L+1), PROF(L) )
         AAA = PROF(L+1)
         BBB = PROF(L)
         PHA(I) = ATAN2( AAA, BBB )
  200 CONTINUE
      CALL STTPUT(MSG,IERR)
      RETURN
      END