End of file
Contents
Index
SUBROUTINE FFTB (M, FRE, FIM, IR)
C
C*****************************************************************
C *
C For 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 an arbitrary *
C number M of given real or complex functional values F(0), *
C F(1), ... , 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 if M is even, or *
C *
C (SUM from K=-(M-1)/2 to (M-1)/2) F^(K)*EXP(I*K*OMEGA*X) , *
C *
C if M is odd. *
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 perfomed. *
C The double precision vectors FRE and FIM contain the real *
C and imaginary parts of the values F and F^. *
C The actual computations are performed using an FFT with radix *
C 2 and a discrete convolution. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C M : the number of data points *
C Due to the explicit declarations of the auxiliary *
C vectors F1RE, F1IM and GRE, GIM in the program, we *
C can only allow M with 1 <= M <= 1366. *
C Larger values for M require that redimensioning of *
C F1RE, F1IM and GRe, GIM to admit 0 : 2**TAU-1 *
C entries, so that M <= (2**TAU + 1)/3. *
C For example: *
C for M <= 2731 use indices between 0 and 8191, *
C for M <= 5462 use indices between 0 and 16383, *
C for M <= 10923 use indices between 0 and 32767, *
C for M <= 21846 use indices between 0 and 65535, *
C etc. *
C FRE, FIM : DOUBLE PRECISION vectors for the real and imaginary*
C parts of M complex numbers: *
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 if M is even, and *
C for K = 0 to (M-1)/2 if M is odd, *
C and of *
C F^(K-M) for K = M/2 to M-1 if M is even, and *
C for K = (M+1)/2 to M-1 if M is odd. *
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 of real and imaginary *
C parts of M complex numbers. *
C Depending on IR, these contain the following: *
C If IR=0: They contain the real and imaginary parts *
C of the discrete Fourier coefficients as *
C follows: *
C FRE(K+M), FIM(K+M) : real and imaginary parts of*
C F^(K) for K = -M/2, ..., -1 if M is even, or *
C for K = -(M-1)/2,..., -1 if M is odd; *
C F^(K) for K = 0, ..., M/2-1 if M is even, or *
C for K = 0, ..., (M-1)/2 if M is odd. *
C If IR=1: the function values are returned. *
C *
C----------------------------------------------------------------*
C *
C Required subroutines: FFT *
C *
C*****************************************************************
C *
C Authors : Klaus Niederdrenk *
C Date : 03.22.1992 *
C Source : FORTRAN 77 *
C *
C*****************************************************************
C
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INTEGER M, IR, ITAU
DIMENSION FRE(0:M-1), FIM(0:M-1)
DIMENSION F1RE(0:4095), F1IM(0:4095)
DIMENSION GRE(0:4095), GIM(0:4095)
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: imaginary part
C
CMLI(AR,AI,BR,BI)=AR*BI+AI*BR
C
FAKTOR=1.0D0/DBLE(M)
PI=4.0D0*ATAN(1.0D0)
VZ=DBLE(2*IR-1)
C
C EW1=EXP(CMPLX(0.0D0,VZ*PI*FAKTOR))
C
EWPHI=VZ*PI*FAKTOR
EW1R=COS(EWPHI)
EW1I=SIN(EWPHI)
C
C EW2=EW1*EW1
C
EW2R=CMLR(EW1R,EW1I,EW1R,EW1I)
EW2I=CMLI(EW1R,EW1I,EW1R,EW1I)
IF(IR .EQ. 1) FAKTOR=1.0D0
C
C*****************************************************************
C Determine the suitable power of two that shall become the *
C length of the auxiliary vectors F1RE, F1IM and GRE, GIM *
C*****************************************************************
C
ITAU=INT(LOG(3.0D0*DBLE(M)-2.0D0)/LOG(2.0D0))+1
L=2**ITAU
IF(L/2 .GE. 3*M-2) THEN
L=L/2
ITAU=ITAU-1
ENDIF
C
C*****************************************************************
C Initialize the vectors F1RE, F1IM and GRE, GIM *
C*****************************************************************
C
C***** EW1 = 2*M - th root of unity *****
C***** EWK = EW1 ** (J**2) *****
C
DO 10 J = 0, L-1
F1RE(J)=0.0D0
F1IM(J)=0.0D0
GRE(J)=0.0D0
GIM(J)=0.0D0
10 CONTINUE
F1RE(0)=FRE(0)
F1IM(0)=FIM(0)
GRE(M-1)=1.0D0
C
C EWK=EW1
C
EWKR=EW1R
EWKI=EW1I
C
C EW3=EW1
C
EW3R=EW1R
EW3I=EW1I
DO 20 J = 1, M-1
C
C F1(J)=F(J)*EWK
C
F1RE(J)=CMLR(FRE(J),FIM(J),EWKR,EWKI)
F1IM(J)=CMLI(FRE(J),FIM(J),EWKR,EWKI)
C
C G(M-1+J)=CONJG(EWK)
C
GRE(M-1+J)=EWKR
GIM(M-1+J)=-EWKI
C
C G(M-1-J)=G(M-1+J)
C
GRE(M-1-J)=GRE(M-1+J)
GIM(M-1-J)=GIM(M-1+J)
C
C EW3=EW3*EW2
C
H =CMLR(EW3R,EW3I,EW2R,EW2I)
EW3I=CMLI(EW3R,EW3I,EW2R,EW2I)
EW3R=H
C
C EWK=EWK*EW3
C
H =CMLR(EWKR,EWKI,EW3R,EW3I)
EWKI=CMLI(EWKR,EWKI,EW3R,EW3I)
EWKR=H
20 CONTINUE
C
C*****************************************************************
C Discrete convolution of the vectors F1RE, F1IM and GRE, GIM*
C using the FFT for radix two (via subroutine FFT) *
C*****************************************************************
C
CALL FFT (ITAU, F1RE, F1IM, 0)
CALL FFT (ITAU, GRE, GIM, 0)
DO 30 K = 0, L-1
C
C F1(K)=F1(K)*G(K)
C
H =CMLR(F1RE(K),F1IM(K),GRE(K),GIM(K))
F1IM(K)=CMLI(F1RE(K),F1IM(K),GRE(K),GIM(K))
F1RE(K)=H
30 CONTINUE
CALL FFT (ITAU, F1RE, F1IM, 1)
C
C*****************************************************************
C Store needed values in FRE, FIM *
C*****************************************************************
C
C***** EW1 = 2*M - th root of unity *****
C***** EWK = EW1 ** (K**2) *****
C
FAKTL=FAKTOR*DBLE(L)
FRE(0)=F1RE(M-1)*FAKTL
FIM(0)=F1IM(M-1)*FAKTL
EWKR=EW1R
EWKI=EW1I
EW3R=EW1R
EW3I=EW1I
DO 40 K = 1, M-1
C
C F(K)=F1(K+M-1)*EWK*FAKTL
C
FRE(K)=CMLR(F1RE(K+M-1),F1IM(K+M-1),EWKR*FAKTL,EWKI*FAKTL)
FIM(K)=CMLI(F1RE(K+M-1),F1IM(K+M-1),EWKR*FAKTL,EWKI*FAKTL)
C
C EW3=EW3*EW2
C
H =CMLR(EW3R,EW3I,EW2R,EW2I)
EW3I=CMLI(EW3R,EW3I,EW2R,EW2I)
EW3R=H
C
C EWK=EWK*EW3
C
H =CMLR(EWKR,EWKI,EW3R,EW3I)
EWKI=CMLI(EWKR,EWKI,EW3R,EW3I)
EWKR=H
40 CONTINUE
RETURN
END
Begin of file
Contents
Index