End of file
Contents
Index

      SUBROUTINE FFT (ITAU, FRE, FIM, IR)
C
C*****************************************************************
C                                                                *
C  If IR = 0, this programm uses the fast Fourier transform      *
C  ( F F T ) in order to determine the discrete Fourier          *
C  coefficients   F^(-M/2), ... , F^(M/2-1)  for  M = 2**ITAU    *
C  given real or complex functional values F(0), F(1), ... ,     *
C  F(M-1).                                                       *
C  These coefficients define the discrete Fourier series         *
C                                                                *
C     (SUM from K=-M/2 to M/2-1)  F^(K)*EXP(I*K*OMEGA*X)         *
C                                                                *
C  ( I : imaginary unit with  I**2 = -1 ; OMEGA = 2*PI/L ,       *
C    L : period ) .                                              *
C  For  IR = 1  the inverse Fourier transform is performed.      *
C  The double precision vectors  FRE  and  FIM  contain the real *
C  and imaginary parts of  F  and  F^, respectively.             *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  ITAU   : the number of data points is  M = 2**ITAU            *
C  FRE, FIM : DOUBLE PRECISION vectors for the real and imaginary*
C             parts of M values.                                 *
C             Depending on IR, FRE, FIM  must contain the        *
C             following:                                         *
C             IR=0: FRE, FIM  contain the real and imaginary     *
C                   parts of the functional values               *
C             IR=1: FRE, FIM  contain the real and imaginary     *
C                   parts of the discrete Fourier coefficients   *
C                   as follows:                                  *
C                   FRE(K), FIM(K) : Real and imaginary parts of *
C                   F^(K)  for  K = 0 to M/2-1  and of F^(K-M)   *
C                   for  K = M/2 to M-1.                         *
C  IR     : determines the direction of the desired              *
C           transfornation                                       *
C           If IR=0, we compute the discrete Fourier             *
C                    coefficients                                *
C           If IR=1: we compute the function values              *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  FRE, FIM : DOUBLE PRECISION vectors for the real and          *
C             imaginary parts of M complex numbers.              *
C             Depending on IR the following values are returned: *
C             If IR=0: The vectors FRE and FIM contain the       *
C                      real and imaginary parts of the discrete  *
C                      Fourier coefficients as follows:          *
C                      FRE(K+M), FIM(K+M): The real and imaginary*
C                           parts of  F^(K) for  K = -M/2 to -1  *
C                      FRE(K), FIM(K) : The real and imaginary   *
C                           parts of  F^(K)  for  K = 0 to M/2-1 *
C             If IR=1: The functional values are returned in FRE *
C                      and FIM.                                  *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C  Reference: Niederdrenk, K., see [NIED84]                      *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Klaus Niederdrenk                                 *
C  Date      : 03.22.1993                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER ITAU, IR, SIGMA, M
      DIMENSION FRE(0:2**ITAU-1), FIM(0:2**ITAU-1)
C
C     Define FUNCTION for complex multiplication: real part
C
      CMLR(AR,AI,BR,BI)=AR*BR-AI*BI
C
C     Define FUNCTION for complex multiplication: real part
C
      CMLI(AR,AI,BR,BI)=AR*BI+AI*BR
C
      M=2**ITAU
      FAKTOR=1.0D0/DBLE(M)
      PI=4.0D0*ATAN(1.0D0)
      VZ=DBLE(2*IR-1)
      EWPHI=VZ*2.0D0*PI*FAKTOR
      EWR=COS(EWPHI)
      EWI=SIN(EWPHI)
      IF (IR .EQ. 1) FAKTOR=1.0D0
C
C*****************************************************************
C     Restore using bit reversal                                 *
C     ( normalize, if IR=0 )                                     *
C*****************************************************************
C
      DO 30 J = 0, M-1
        K=J
        SIGMA=0
        DO 20 N = 1, ITAU
          KD2=K/2
          SIGMA=2*SIGMA+K-2*KD2
          K=KD2
  20    CONTINUE
        IF (SIGMA .LT. J) GOTO 30
        UR=FRE(J)
        FRE(J)=FRE(SIGMA)*FAKTOR
        FRE(SIGMA)=UR*FAKTOR
        UI=FIM(J)
        FIM(J)=FIM(SIGMA)*FAKTOR
        FIM(SIGMA)=UI*FAKTOR
  30  CONTINUE
C
C*****************************************************************
C     Execute the (inverse) transformation                       *
C*****************************************************************
C
C*****  N min 1 = 2**( N - 1 )         *****
C*****  N min 0 = 2**( N )             *****
C*****     EW   = root of unity        *****
C*****     W    = EW**(2**(ITAU-N))    *****
C*****    EPS   = EW**(L*2**(ITAU-N))  *****
C
      NMIN1=1
      DO 130 N = 1, ITAU
        WR=EWR
        WI=EWI
        DO 100 K = 1, ITAU-N
           H  =CMLR(WR,WI,WR,WI)
           WI =CMLI(WR,WI,WR,WI)
           WR =H
  100   CONTINUE
        EPSR=1.0D0
        EPSI=0.0D0
        NMIN0=NMIN1+NMIN1
        DO 120 L = 0, NMIN1-1
          DO 110 J = 0, M-NMIN0, NMIN0
C
C     U=F(J+L+NMIN1)*EPS
C
            UR=CMLR(FRE(J+L+NMIN1),FIM(J+L+NMIN1),EPSR,EPSI)
            UI=CMLI(FRE(J+L+NMIN1),FIM(J+L+NMIN1),EPSR,EPSI)
            FRE(J+L+NMIN1)=FRE(J+L)-UR
            FIM(J+L+NMIN1)=FIM(J+L)-UI
            FRE(J+L)=FRE(J+L)+UR
            FIM(J+L)=FIM(J+L)+UI
  110     CONTINUE
          H    =CMLR(EPSR,EPSI,WR,WI)
          EPSI =CMLI(EPSR,EPSI,WR,WI)
          EPSR =H
  120   CONTINUE
        NMIN1=NMIN0
  130 CONTINUE
      RETURN
      END


Begin of file
Contents
Index