WSJT-X/xfft2.f

185 lines
5.1 KiB
Fortran

SUBROUTINE xfft2(DATA,NB)
c
c the cooley-tukey fast fourier transform in usasi basic fortran
c
C .. Scalar Arguments ..
INTEGER NB
C ..
C .. Array Arguments ..
REAL DATA(NB+2)
C ..
C .. Local Scalars ..
REAL DIFI,DIFR,RTHLF,SUMI,SUMR,T2I,T2R,T3I,T3R,T4I,
+ T4R,TEMPI,TEMPR,THETA,TWOPI,U1I,U1R,U2I,U2R,U3I,U3R,
+ U4I,U4R,W2I,W2R,W3I,W3R,WI,WR,WSTPI,WSTPR
INTEGER I,I2,IPAR,J,K1,K2,K3,K4,KDIF,KMIN,
+ KSTEP,L,LMAX,M,MMAX,NH
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,MAX0,REAL,SIN
C ..
C .. Data statements ..
DATA TWOPI/6.2831853071796/,RTHLF/0.70710678118655/
c
c 1. real transform for the 1st dimension, n even. method--
c transform a complex array of length n/2 whose real parts
c are the even numbered real values and whose imaginary parts
c are the odd numbered real values. separate and supply
c the second half by conjugate symmetry.
c
NH = NB/2
c
c shuffle data by bit reversal, since n=2**k.
c
J = 1
DO 131 I2 = 1,NB,2
IF (J-I2) 124,127,127
124 TEMPR = DATA(I2)
TEMPI = DATA(I2+1)
DATA(I2) = DATA(J)
DATA(I2+1) = DATA(J+1)
DATA(J) = TEMPR
DATA(J+1) = TEMPI
127 M = NH
128 IF (J-M) 130,130,129
129 J = J - M
M = M/2
IF (M-2) 130,128,128
130 J = J + M
131 CONTINUE
c
c main loop for factors of two. perform fourier transforms of
c length four, with one of length two if needed. the twiddle factor
c w=exp(-2*pi*sqrt(-1)*m/(4*mmax)). check for w=-sqrt(-1)
c and repeat for w=w*(1-sqrt(-1))/sqrt(2).
c
IF (NB-2) 174,174,143
143 IPAR = NH
144 IF (IPAR-2) 149,146,145
145 IPAR = IPAR/4
GO TO 144
146 DO 147 K1 = 1,NB,4
K2 = K1 + 2
TEMPR = DATA(K2)
TEMPI = DATA(K2+1)
DATA(K2) = DATA(K1) - TEMPR
DATA(K2+1) = DATA(K1+1) - TEMPI
DATA(K1) = DATA(K1) + TEMPR
DATA(K1+1) = DATA(K1+1) + TEMPI
147 CONTINUE
149 MMAX = 2
150 IF (MMAX-NH) 151,174,174
151 LMAX = MAX0(4,MMAX/2)
DO 173 L = 2,LMAX,4
M = L
IF (MMAX-2) 156,156,152
152 THETA = -TWOPI*REAL(L)/REAL(4*MMAX)
WR = COS(THETA)
WI = SIN(THETA)
155 W2R = WR*WR - WI*WI
W2I = 2.*WR*WI
W3R = W2R*WR - W2I*WI
W3I = W2R*WI + W2I*WR
156 KMIN = 1 + IPAR*M
IF (MMAX-2) 157,157,158
157 KMIN = 1
158 KDIF = IPAR*MMAX
159 KSTEP = 4*KDIF
IF (KSTEP-NB) 160,160,169
160 DO 168 K1 = KMIN,NB,KSTEP
K2 = K1 + KDIF
K3 = K2 + KDIF
K4 = K3 + KDIF
IF (MMAX-2) 161,161,164
161 U1R = DATA(K1) + DATA(K2)
U1I = DATA(K1+1) + DATA(K2+1)
U2R = DATA(K3) + DATA(K4)
U2I = DATA(K3+1) + DATA(K4+1)
U3R = DATA(K1) - DATA(K2)
U3I = DATA(K1+1) - DATA(K2+1)
U4R = DATA(K3+1) - DATA(K4+1)
U4I = DATA(K4) - DATA(K3)
GO TO 167
164 T2R = W2R*DATA(K2) - W2I*DATA(K2+1)
T2I = W2R*DATA(K2+1) + W2I*DATA(K2)
T3R = WR*DATA(K3) - WI*DATA(K3+1)
T3I = WR*DATA(K3+1) + WI*DATA(K3)
T4R = W3R*DATA(K4) - W3I*DATA(K4+1)
T4I = W3R*DATA(K4+1) + W3I*DATA(K4)
U1R = DATA(K1) + T2R
U1I = DATA(K1+1) + T2I
U2R = T3R + T4R
U2I = T3I + T4I
U3R = DATA(K1) - T2R
U3I = DATA(K1+1) - T2I
U4R = T3I - T4I
U4I = T4R - T3R
167 DATA(K1) = U1R + U2R
DATA(K1+1) = U1I + U2I
DATA(K2) = U3R + U4R
DATA(K2+1) = U3I + U4I
DATA(K3) = U1R - U2R
DATA(K3+1) = U1I - U2I
DATA(K4) = U3R - U4R
DATA(K4+1) = U3I - U4I
168 CONTINUE
KDIF = KSTEP
KMIN = 4*KMIN - 3
GO TO 159
169 M = M + LMAX
IF (M-MMAX) 170,170,173
170 TEMPR = WR
WR = (WR+WI)*RTHLF
WI = (WI-TEMPR)*RTHLF
GO TO 155
173 CONTINUE
IPAR = 3 - IPAR
MMAX = MMAX + MMAX
GO TO 150
c
c complete a real transform in the 1st dimension, n even, by con-
c jugate symmetries.
c
174 THETA = -TWOPI/REAL(NB)
WSTPR = COS(THETA)
WSTPI = SIN(THETA)
WR = WSTPR
WI = WSTPI
I = 3
J = NB - 1
GO TO 207
205 SUMR = (DATA(I)+DATA(J))/2.
SUMI = (DATA(I+1)+DATA(J+1))/2.
DIFR = (DATA(I)-DATA(J))/2.
DIFI = (DATA(I+1)-DATA(J+1))/2.
TEMPR = WR*SUMI + WI*DIFR
TEMPI = WI*SUMI - WR*DIFR
DATA(I) = SUMR + TEMPR
DATA(I+1) = DIFI + TEMPI
DATA(J) = SUMR - TEMPR
DATA(J+1) = -DIFI + TEMPI
I = I + 2
J = J - 2
TEMPR = WR
WR = WR*WSTPR - WI*WSTPI
WI = TEMPR*WSTPI + WI*WSTPR
207 IF (I-J) 205,208,211
208 DATA(I+1) = -DATA(I+1)
211 DATA(NB+1) = DATA(1) - DATA(2)
DATA(NB+2) = 0.
DATA(1) = DATA(1) + DATA(2)
DATA(2) = 0.
RETURN
END