1 | //$ newfft.cpp |
---|
2 | |
---|
3 | // This is originally by Sande and Gentleman in 1967! I have translated from |
---|
4 | // Fortran into C and a little bit of C++. |
---|
5 | |
---|
6 | // It takes about twice as long as fftw |
---|
7 | // (http://theory.lcs.mit.edu/~fftw/homepage.html) |
---|
8 | // but is much shorter than fftw and so despite its age |
---|
9 | // might represent a reasonable |
---|
10 | // compromise between speed and complexity. |
---|
11 | // If you really need the speed get fftw. |
---|
12 | |
---|
13 | |
---|
14 | // THIS SUBROUTINE WAS WRITTEN BY G.SANDE OF PRINCETON UNIVERSITY AND |
---|
15 | // W.M.GENTLMAN OF THE BELL TELEPHONE LAB. IT WAS BROUGHT TO LONDON |
---|
16 | // BY DR. M.D. GODFREY AT THE IMPERIAL COLLEGE AND WAS ADAPTED FOR |
---|
17 | // BURROUGHS 6700 BY D. R. BRILLINGER AND J. PEMBERTON |
---|
18 | // IT REPRESENTS THE STATE OF THE ART OF COMPUTING COMPLETE FINITE |
---|
19 | // DISCRETE FOURIER TRANSFORMS AS OF NOV.1967. |
---|
20 | // OTHER PROGRAMS REQUIRED. |
---|
21 | // ONLY THOSE SUBROUTINES INCLUDED HERE. |
---|
22 | // USAGE. |
---|
23 | // CALL AR1DFT(N,X,Y) |
---|
24 | // WHERE N IS THE NUMBER OF POINTS IN THE SEQUENCE . |
---|
25 | // X - IS A ONE-DIMENSIONAL ARRAY CONTAINING THE REAL |
---|
26 | // PART OF THE SEQUENCE. |
---|
27 | // Y - IS A ONE-DIMENSIONAL ARRAY CONTAINING THE |
---|
28 | // IMAGINARY PART OF THE SEQUENCE. |
---|
29 | // THE TRANSFORM IS RETURNED IN X AND Y. |
---|
30 | // METHOD |
---|
31 | // FOR A GENERAL DISCUSSION OF THESE TRANSFORMS AND OF |
---|
32 | // THE FAST METHOD FOR COMPUTING THEM, SEE GENTLEMAN AND SANDE, |
---|
33 | // @FAST FOURIER TRANSFORMS - FOR FUN AND PROFIT,@ 1966 FALL JOINT |
---|
34 | // COMPUTER CONFERENCE. |
---|
35 | // THIS PROGRAM COMPUTES THIS FOR A COMPLEX SEQUENCE Z(T) OF LENGTH |
---|
36 | // N WHOSE ELEMENTS ARE STORED AT(X(I) , Y(I)) AND RETURNS THE |
---|
37 | // TRANSFORM COEFFICIENTS AT (X(I), Y(I)). |
---|
38 | // DESCRIPTION |
---|
39 | // AR1DFT IS A HIGHLY MODULAR ROUTINE CAPABLE OF COMPUTING IN PLACE |
---|
40 | // THE COMPLETE FINITE DISCRETE FOURIER TRANSFORM OF A ONE- |
---|
41 | // DIMENSIONAL SEQUENCE OF RATHER GENERAL LENGTH N. |
---|
42 | // THE MAIN ROUTINE , AR1DFT ITSELF, FACTORS N. IT THEN CALLS ON |
---|
43 | // ON GR 1D FT TO COMPUTE THE ACTUAL TRANSFORMS, USING THESE FACTORS. |
---|
44 | // THIS GR 1D FT DOES, CALLING AT EACH STAGE ON THE APPROPRIATE KERN |
---|
45 | // EL R2FTK, R4FTK, R8FTK, R16FTK, R3FTK, R5FTK, OR RPFTK TO PERFORM |
---|
46 | // THE COMPUTATIONS FOR THIS PASS OVER THE SEQUENCE, DEPENDING ON |
---|
47 | // WHETHER THE CORRESPONDING FACTOR IS 2, 4, 8, 16, 3, 5, OR SOME |
---|
48 | // MORE GENERAL PRIME P. WHEN GR1DFT IS FINISHED THE TRANSFORM IS |
---|
49 | // COMPUTED, HOWEVER, THE RESULTS ARE STORED IN "DIGITS REVERSED" |
---|
50 | // ORDER. AR1DFT THEREFORE, CALLS UPON GR 1S FS TO SORT THEM OUT. |
---|
51 | // TO RETURN TO THE FACTORIZATION, SINGLETON HAS POINTED OUT THAT |
---|
52 | // THE TRANSFORMS ARE MORE EFFICIENT IF THE SAMPLE SIZE N, IS OF THE |
---|
53 | // FORM B*A**2 AND B CONSISTS OF A SINGLE FACTOR. IN SUCH A CASE |
---|
54 | // IF WE PROCESS THE FACTORS IN THE ORDER ABA THEN |
---|
55 | // THE REORDERING CAN BE DONE AS FAST IN PLACE, AS WITH SCRATCH |
---|
56 | // STORAGE. BUT AS B BECOMES MORE COMPLICATED, THE COST OF THE DIGIT |
---|
57 | // REVERSING DUE TO B PART BECOMES VERY EXPENSIVE IF WE TRY TO DO IT |
---|
58 | // IN PLACE. IN SUCH A CASE IT MIGHT BE BETTER TO USE EXTRA STORAGE |
---|
59 | // A ROUTINE TO DO THIS IS, HOWEVER, NOT INCLUDED HERE. |
---|
60 | // ANOTHER FEATURE INFLUENCING THE FACTORIZATION IS THAT FOR ANY FIXED |
---|
61 | // FACTOR N WE CAN PREPARE A SPECIAL KERNEL WHICH WILL COMPUTE |
---|
62 | // THAT STAGE OF THE TRANSFORM MORE EFFICIENTLY THAN WOULD A KERNEL |
---|
63 | // FOR GENERAL FACTORS, ESPECIALLY IF THE GENERAL KERNEL HAD TO BE |
---|
64 | // APPLIED SEVERAL TIMES. FOR EXAMPLE, FACTORS OF 4 ARE MORE |
---|
65 | // EFFICIENT THAN FACTORS OF 2, FACTORS OF 8 MORE EFFICIENT THAN 4,ETC |
---|
66 | // ON THE OTHER HAND DIMINISHING RETURNS RAPIDLY SET IN, ESPECIALLY |
---|
67 | // SINCE THE LENGTH OF THE KERNEL FOR A SPECIAL CASE IS ROUGHLY |
---|
68 | // PROPORTIONAL TO THE FACTOR IT DEALS WITH. HENCE THESE PROBABLY ARE |
---|
69 | // ALL THE KERNELS WE WISH TO HAVE. |
---|
70 | // RESTRICTIONS. |
---|
71 | // AN UNFORTUNATE FEATURE OF THE SORTING PROBLEM IS THAT THE MOST |
---|
72 | // EFFICIENT WAY TO DO IT IS WITH NESTED DO LOOPS, ONE FOR EACH |
---|
73 | // FACTOR. THIS PUTS A RESTRICTION ON N AS TO HOW MANY FACTORS IT |
---|
74 | // CAN HAVE. CURRENTLY THE LIMIT IS 16, BUT THE LIMIT CAN BE READILY |
---|
75 | // RAISED IF NECESSARY. |
---|
76 | // A SECOND RESTRICTION OF THE PROGRAM IS THAT LOCAL STORAGE OF THE |
---|
77 | // THE ORDER P**2 IS REQUIRED BY THE GENERAL KERNEL RPFTK, SO SOME |
---|
78 | // LIMIT MUST BE SET ON P. CURRENTLY THIS IS 19, BUT IT CAN BE INCRE |
---|
79 | // INCREASED BY TRIVIAL CHANGES. |
---|
80 | // OTHER COMMENTS. |
---|
81 | //(1) THE ROUTINE IS ADAPTED TO CHECK WHETHER A GIVEN N WILL MEET THE |
---|
82 | // ABOVE FACTORING REQUIREMENTS AN, IF NOT, TO RETURN THE NEXT HIGHER |
---|
83 | // NUMBER, NX, SAY, WHICH WILL MEET THESE REQUIREMENTS. |
---|
84 | // THIS CAN BE ACCHIEVED BY A STATEMENT OF THE FORM |
---|
85 | // CALL FACTR(N,X,Y). |
---|
86 | // IF A DIFFERENT N, SAY NX, IS RETURNED THEN THE TRANSFORMS COULD BE |
---|
87 | // OBTAINED BY EXTENDING THE SIZE OF THE X-ARRAY AND Y-ARRAY TO NX, |
---|
88 | // AND SETTING X(I) = Y(I) = 0., FOR I = N+1, NX. |
---|
89 | //(2) IF THE SEQUENCE Z IS ONLY A REAL SEQUENCE, THEN THE IMAGINARY PART |
---|
90 | // Y(I)=0., THIS WILL RETURN THE COSINE TRANSFORM OF THE REAL SEQUENCE |
---|
91 | // IN X, AND THE SINE TRANSFORM IN Y. |
---|
92 | |
---|
93 | |
---|
94 | #define WANT_STREAM |
---|
95 | |
---|
96 | #define WANT_MATH |
---|
97 | |
---|
98 | #include "newmatap.h" |
---|
99 | |
---|
100 | #ifdef use_namespace |
---|
101 | namespace NEWMAT { |
---|
102 | #endif |
---|
103 | |
---|
104 | #ifdef DO_REPORT |
---|
105 | #define REPORT { static ExeCounter ExeCount(__LINE__,20); ++ExeCount; } |
---|
106 | #else |
---|
107 | #define REPORT {} |
---|
108 | #endif |
---|
109 | |
---|
110 | inline Real square(Real x) { return x*x; } |
---|
111 | inline int square(int x) { return x*x; } |
---|
112 | |
---|
113 | static void GR_1D_FS (int PTS, int N_SYM, int N_UN_SYM, |
---|
114 | const SimpleIntArray& SYM, int P_SYM, const SimpleIntArray& UN_SYM, |
---|
115 | Real* X, Real* Y); |
---|
116 | static void GR_1D_FT (int N, int N_FACTOR, const SimpleIntArray& FACTOR, |
---|
117 | Real* X, Real* Y); |
---|
118 | static void R_P_FTK (int N, int M, int P, Real* X, Real* Y); |
---|
119 | static void R_2_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1); |
---|
120 | static void R_3_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
121 | Real* X2, Real* Y2); |
---|
122 | static void R_4_FTK (int N, int M, |
---|
123 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
124 | Real* X2, Real* Y2, Real* X3, Real* Y3); |
---|
125 | static void R_5_FTK (int N, int M, |
---|
126 | Real* X0, Real* Y0, Real* X1, Real* Y1, Real* X2, Real* Y2, |
---|
127 | Real* X3, Real* Y3, Real* X4, Real* Y4); |
---|
128 | static void R_8_FTK (int N, int M, |
---|
129 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
130 | Real* X2, Real* Y2, Real* X3, Real* Y3, |
---|
131 | Real* X4, Real* Y4, Real* X5, Real* Y5, |
---|
132 | Real* X6, Real* Y6, Real* X7, Real* Y7); |
---|
133 | static void R_16_FTK (int N, int M, |
---|
134 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
135 | Real* X2, Real* Y2, Real* X3, Real* Y3, |
---|
136 | Real* X4, Real* Y4, Real* X5, Real* Y5, |
---|
137 | Real* X6, Real* Y6, Real* X7, Real* Y7, |
---|
138 | Real* X8, Real* Y8, Real* X9, Real* Y9, |
---|
139 | Real* X10, Real* Y10, Real* X11, Real* Y11, |
---|
140 | Real* X12, Real* Y12, Real* X13, Real* Y13, |
---|
141 | Real* X14, Real* Y14, Real* X15, Real* Y15); |
---|
142 | static int BitReverse(int x, int prod, int n, const SimpleIntArray& f); |
---|
143 | |
---|
144 | |
---|
145 | bool FFT_Controller::ar_1d_ft (int PTS, Real* X, Real *Y) |
---|
146 | { |
---|
147 | // ARBITRARY RADIX ONE DIMENSIONAL FOURIER TRANSFORM |
---|
148 | |
---|
149 | REPORT |
---|
150 | |
---|
151 | int F,J,N,NF,P,PMAX,P_SYM,P_TWO,Q,R,TWO_GRP; |
---|
152 | |
---|
153 | // NP is maximum number of squared factors allows PTS up to 2**32 at least |
---|
154 | // NQ is number of not-squared factors - increase if we increase PMAX |
---|
155 | const int NP = 16, NQ = 10; |
---|
156 | SimpleIntArray PP(NP), QQ(NQ); |
---|
157 | |
---|
158 | TWO_GRP=16; PMAX=19; |
---|
159 | |
---|
160 | // PMAX is the maximum factor size |
---|
161 | // TWO_GRP is the maximum power of 2 handled as a single factor |
---|
162 | // Doesn't take advantage of combining powers of 2 when calculating |
---|
163 | // number of factors |
---|
164 | |
---|
165 | if (PTS<=1) return true; |
---|
166 | N=PTS; P_SYM=1; F=2; P=0; Q=0; |
---|
167 | |
---|
168 | // P counts the number of squared factors |
---|
169 | // Q counts the number of the rest |
---|
170 | // R = 0 for no non-squared factors; 1 otherwise |
---|
171 | |
---|
172 | // FACTOR holds all the factors - non-squared ones in the middle |
---|
173 | // - length is 2*P+Q |
---|
174 | // SYM also holds all the factors but with the non-squared ones |
---|
175 | // multiplied together - length is 2*P+R |
---|
176 | // PP holds the values of the squared factors - length is P |
---|
177 | // QQ holds the values of the rest - length is Q |
---|
178 | |
---|
179 | // P_SYM holds the product of the squared factors |
---|
180 | |
---|
181 | // find the factors - load into PP and QQ |
---|
182 | while (N > 1) |
---|
183 | { |
---|
184 | bool fail = true; |
---|
185 | for (J=F; J<=PMAX; J++) |
---|
186 | if (N % J == 0) { fail = false; F=J; break; } |
---|
187 | if (fail || P >= NP || Q >= NQ) return false; // can't factor |
---|
188 | N /= F; |
---|
189 | if (N % F != 0) QQ[Q++] = F; |
---|
190 | else { N /= F; PP[P++] = F; P_SYM *= F; } |
---|
191 | } |
---|
192 | |
---|
193 | R = (Q == 0) ? 0 : 1; // R = 0 if no not-squared factors, 1 otherwise |
---|
194 | |
---|
195 | NF = 2*P + Q; |
---|
196 | SimpleIntArray FACTOR(NF + 1), SYM(2*P + R); |
---|
197 | FACTOR[NF] = 0; // we need this in the "combine powers of 2" |
---|
198 | |
---|
199 | // load into SYM and FACTOR |
---|
200 | for (J=0; J<P; J++) |
---|
201 | { SYM[J]=FACTOR[J]=PP[P-1-J]; FACTOR[P+Q+J]=SYM[P+R+J]=PP[J]; } |
---|
202 | |
---|
203 | if (Q>0) |
---|
204 | { |
---|
205 | REPORT |
---|
206 | for (J=0; J<Q; J++) FACTOR[P+J]=QQ[J]; |
---|
207 | SYM[P]=PTS/square(P_SYM); |
---|
208 | } |
---|
209 | |
---|
210 | // combine powers of 2 |
---|
211 | P_TWO = 1; |
---|
212 | for (J=0; J < NF; J++) |
---|
213 | { |
---|
214 | if (FACTOR[J]!=2) continue; |
---|
215 | P_TWO=P_TWO*2; FACTOR[J]=1; |
---|
216 | if (P_TWO<TWO_GRP && FACTOR[J+1]==2) continue; |
---|
217 | FACTOR[J]=P_TWO; P_TWO=1; |
---|
218 | } |
---|
219 | |
---|
220 | if (P==0) R=0; |
---|
221 | if (Q<=1) Q=0; |
---|
222 | |
---|
223 | // do the analysis |
---|
224 | GR_1D_FT(PTS,NF,FACTOR,X,Y); // the transform |
---|
225 | GR_1D_FS(PTS,2*P+R,Q,SYM,P_SYM,QQ,X,Y); // the reshuffling |
---|
226 | |
---|
227 | return true; |
---|
228 | |
---|
229 | } |
---|
230 | |
---|
231 | static void GR_1D_FS (int PTS, int N_SYM, int N_UN_SYM, |
---|
232 | const SimpleIntArray& SYM, int P_SYM, const SimpleIntArray& UN_SYM, |
---|
233 | Real* X, Real* Y) |
---|
234 | { |
---|
235 | // GENERAL RADIX ONE DIMENSIONAL FOURIER SORT |
---|
236 | |
---|
237 | // PTS = number of points |
---|
238 | // N_SYM = length of SYM |
---|
239 | // N_UN_SYM = length of UN_SYM |
---|
240 | // SYM: squared factors + product of non-squared factors + squared factors |
---|
241 | // P_SYM = product of squared factors (each included only once) |
---|
242 | // UN_SYM: not-squared factors |
---|
243 | |
---|
244 | REPORT |
---|
245 | |
---|
246 | Real T; |
---|
247 | int JJ,KK,P_UN_SYM; |
---|
248 | |
---|
249 | // I have replaced the multiple for-loop used by Sande-Gentleman code |
---|
250 | // by the following code which does not limit the number of factors |
---|
251 | |
---|
252 | if (N_SYM > 0) |
---|
253 | { |
---|
254 | REPORT |
---|
255 | SimpleIntArray U(N_SYM); |
---|
256 | for(MultiRadixCounter MRC(N_SYM, SYM, U); !MRC.Finish(); ++MRC) |
---|
257 | { |
---|
258 | if (MRC.Swap()) |
---|
259 | { |
---|
260 | int P = MRC.Reverse(); int JJ = MRC.Counter(); Real T; |
---|
261 | T=X[JJ]; X[JJ]=X[P]; X[P]=T; T=Y[JJ]; Y[JJ]=Y[P]; Y[P]=T; |
---|
262 | } |
---|
263 | } |
---|
264 | } |
---|
265 | |
---|
266 | int J,JL,K,L,M,MS; |
---|
267 | |
---|
268 | // UN_SYM contains the non-squared factors |
---|
269 | // I have replaced the Sande-Gentleman code as it runs into |
---|
270 | // integer overflow problems |
---|
271 | // My code (and theirs) would be improved by using a bit array |
---|
272 | // as suggested by Van Loan |
---|
273 | |
---|
274 | if (N_UN_SYM==0) { REPORT return; } |
---|
275 | P_UN_SYM=PTS/square(P_SYM); JL=(P_UN_SYM-3)*P_SYM; MS=P_UN_SYM*P_SYM; |
---|
276 | |
---|
277 | for (J = P_SYM; J<=JL; J+=P_SYM) |
---|
278 | { |
---|
279 | K=J; |
---|
280 | do K = P_SYM * BitReverse(K / P_SYM, P_UN_SYM, N_UN_SYM, UN_SYM); |
---|
281 | while (K<J); |
---|
282 | |
---|
283 | if (K!=J) |
---|
284 | { |
---|
285 | REPORT |
---|
286 | for (L=0; L<P_SYM; L++) for (M=L; M<PTS; M+=MS) |
---|
287 | { |
---|
288 | JJ=M+J; KK=M+K; |
---|
289 | T=X[JJ]; X[JJ]=X[KK]; X[KK]=T; T=Y[JJ]; Y[JJ]=Y[KK]; Y[KK]=T; |
---|
290 | } |
---|
291 | } |
---|
292 | } |
---|
293 | |
---|
294 | return; |
---|
295 | } |
---|
296 | |
---|
297 | static void GR_1D_FT (int N, int N_FACTOR, const SimpleIntArray& FACTOR, |
---|
298 | Real* X, Real* Y) |
---|
299 | { |
---|
300 | // GENERAL RADIX ONE DIMENSIONAL FOURIER TRANSFORM; |
---|
301 | |
---|
302 | REPORT |
---|
303 | |
---|
304 | int M = N; |
---|
305 | |
---|
306 | for (int i = 0; i < N_FACTOR; i++) |
---|
307 | { |
---|
308 | int P = FACTOR[i]; M /= P; |
---|
309 | |
---|
310 | switch(P) |
---|
311 | { |
---|
312 | case 1: REPORT break; |
---|
313 | case 2: REPORT R_2_FTK (N,M,X,Y,X+M,Y+M); break; |
---|
314 | case 3: REPORT R_3_FTK (N,M,X,Y,X+M,Y+M,X+2*M,Y+2*M); break; |
---|
315 | case 4: REPORT R_4_FTK (N,M,X,Y,X+M,Y+M,X+2*M,Y+2*M,X+3*M,Y+3*M); break; |
---|
316 | case 5: |
---|
317 | REPORT |
---|
318 | R_5_FTK (N,M,X,Y,X+M,Y+M,X+2*M,Y+2*M,X+3*M,Y+3*M,X+4*M,Y+4*M); |
---|
319 | break; |
---|
320 | case 8: |
---|
321 | REPORT |
---|
322 | R_8_FTK (N,M,X,Y,X+M,Y+M,X+2*M,Y+2*M, |
---|
323 | X+3*M,Y+3*M,X+4*M,Y+4*M,X+5*M,Y+5*M, |
---|
324 | X+6*M,Y+6*M,X+7*M,Y+7*M); |
---|
325 | break; |
---|
326 | case 16: |
---|
327 | REPORT |
---|
328 | R_16_FTK (N,M,X,Y,X+M,Y+M,X+2*M,Y+2*M, |
---|
329 | X+3*M,Y+3*M,X+4*M,Y+4*M,X+5*M,Y+5*M, |
---|
330 | X+6*M,Y+6*M,X+7*M,Y+7*M,X+8*M,Y+8*M, |
---|
331 | X+9*M,Y+9*M,X+10*M,Y+10*M,X+11*M,Y+11*M, |
---|
332 | X+12*M,Y+12*M,X+13*M,Y+13*M,X+14*M,Y+14*M, |
---|
333 | X+15*M,Y+15*M); |
---|
334 | break; |
---|
335 | default: REPORT R_P_FTK (N,M,P,X,Y); break; |
---|
336 | } |
---|
337 | } |
---|
338 | |
---|
339 | } |
---|
340 | |
---|
341 | static void R_P_FTK (int N, int M, int P, Real* X, Real* Y) |
---|
342 | // RADIX PRIME FOURIER TRANSFORM KERNEL; |
---|
343 | // X and Y are treated as M * P matrices with Fortran storage |
---|
344 | { |
---|
345 | REPORT |
---|
346 | bool NO_FOLD,ZERO; |
---|
347 | Real ANGLE,IS,IU,RS,RU,T,TWOPI,XT,YT; |
---|
348 | int J,JJ,K0,K,M_OVER_2,MP,PM,PP,U,V; |
---|
349 | |
---|
350 | Real AA [9][9], BB [9][9]; |
---|
351 | Real A [18], B [18], C [18], S [18]; |
---|
352 | Real IA [9], IB [9], RA [9], RB [9]; |
---|
353 | |
---|
354 | TWOPI=8.0*atan(1.0); |
---|
355 | M_OVER_2=M/2+1; MP=M*P; PP=P/2; PM=P-1; |
---|
356 | |
---|
357 | for (U=0; U<PP; U++) |
---|
358 | { |
---|
359 | ANGLE=TWOPI*Real(U+1)/Real(P); |
---|
360 | JJ=P-U-2; |
---|
361 | A[U]=cos(ANGLE); B[U]=sin(ANGLE); |
---|
362 | A[JJ]=A[U]; B[JJ]= -B[U]; |
---|
363 | } |
---|
364 | |
---|
365 | for (U=1; U<=PP; U++) |
---|
366 | { |
---|
367 | for (V=1; V<=PP; V++) |
---|
368 | { JJ=U*V-U*V/P*P; AA[V-1][U-1]=A[JJ-1]; BB[V-1][U-1]=B[JJ-1]; } |
---|
369 | } |
---|
370 | |
---|
371 | for (J=0; J<M_OVER_2; J++) |
---|
372 | { |
---|
373 | NO_FOLD = (J==0 || 2*J==M); |
---|
374 | K0=J; |
---|
375 | ANGLE=TWOPI*Real(J)/Real(MP); ZERO=ANGLE==0.0; |
---|
376 | C[0]=cos(ANGLE); S[0]=sin(ANGLE); |
---|
377 | for (U=1; U<PM; U++) |
---|
378 | { |
---|
379 | C[U]=C[U-1]*C[0]-S[U-1]*S[0]; |
---|
380 | S[U]=S[U-1]*C[0]+C[U-1]*S[0]; |
---|
381 | } |
---|
382 | goto L700; |
---|
383 | L500: |
---|
384 | REPORT |
---|
385 | if (NO_FOLD) { REPORT goto L1500; } |
---|
386 | REPORT |
---|
387 | NO_FOLD=true; K0=M-J; |
---|
388 | for (U=0; U<PM; U++) |
---|
389 | { T=C[U]*A[U]+S[U]*B[U]; S[U]= -S[U]*A[U]+C[U]*B[U]; C[U]=T; } |
---|
390 | L700: |
---|
391 | REPORT |
---|
392 | for (K=K0; K<N; K+=MP) |
---|
393 | { |
---|
394 | XT=X[K]; YT=Y[K]; |
---|
395 | for (U=1; U<=PP; U++) |
---|
396 | { |
---|
397 | RA[U-1]=XT; IA[U-1]=YT; |
---|
398 | RB[U-1]=0.0; IB[U-1]=0.0; |
---|
399 | } |
---|
400 | for (U=1; U<=PP; U++) |
---|
401 | { |
---|
402 | JJ=P-U; |
---|
403 | RS=X[K+M*U]+X[K+M*JJ]; IS=Y[K+M*U]+Y[K+M*JJ]; |
---|
404 | RU=X[K+M*U]-X[K+M*JJ]; IU=Y[K+M*U]-Y[K+M*JJ]; |
---|
405 | XT=XT+RS; YT=YT+IS; |
---|
406 | for (V=0; V<PP; V++) |
---|
407 | { |
---|
408 | RA[V]=RA[V]+RS*AA[V][U-1]; IA[V]=IA[V]+IS*AA[V][U-1]; |
---|
409 | RB[V]=RB[V]+RU*BB[V][U-1]; IB[V]=IB[V]+IU*BB[V][U-1]; |
---|
410 | } |
---|
411 | } |
---|
412 | X[K]=XT; Y[K]=YT; |
---|
413 | for (U=1; U<=PP; U++) |
---|
414 | { |
---|
415 | if (!ZERO) |
---|
416 | { |
---|
417 | REPORT |
---|
418 | XT=RA[U-1]+IB[U-1]; YT=IA[U-1]-RB[U-1]; |
---|
419 | X[K+M*U]=XT*C[U-1]+YT*S[U-1]; Y[K+M*U]=YT*C[U-1]-XT*S[U-1]; |
---|
420 | JJ=P-U; |
---|
421 | XT=RA[U-1]-IB[U-1]; YT=IA[U-1]+RB[U-1]; |
---|
422 | X[K+M*JJ]=XT*C[JJ-1]+YT*S[JJ-1]; |
---|
423 | Y[K+M*JJ]=YT*C[JJ-1]-XT*S[JJ-1]; |
---|
424 | } |
---|
425 | else |
---|
426 | { |
---|
427 | REPORT |
---|
428 | X[K+M*U]=RA[U-1]+IB[U-1]; Y[K+M*U]=IA[U-1]-RB[U-1]; |
---|
429 | JJ=P-U; |
---|
430 | X[K+M*JJ]=RA[U-1]-IB[U-1]; Y[K+M*JJ]=IA[U-1]+RB[U-1]; |
---|
431 | } |
---|
432 | } |
---|
433 | } |
---|
434 | goto L500; |
---|
435 | L1500: ; |
---|
436 | } |
---|
437 | return; |
---|
438 | } |
---|
439 | |
---|
440 | static void R_2_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1) |
---|
441 | // RADIX TWO FOURIER TRANSFORM KERNEL; |
---|
442 | { |
---|
443 | REPORT |
---|
444 | bool NO_FOLD,ZERO; |
---|
445 | int J,K,K0,M2,M_OVER_2; |
---|
446 | Real ANGLE,C,IS,IU,RS,RU,S,TWOPI; |
---|
447 | |
---|
448 | M2=M*2; M_OVER_2=M/2+1; |
---|
449 | TWOPI=8.0*atan(1.0); |
---|
450 | |
---|
451 | for (J=0; J<M_OVER_2; J++) |
---|
452 | { |
---|
453 | NO_FOLD = (J==0 || 2*J==M); |
---|
454 | K0=J; |
---|
455 | ANGLE=TWOPI*Real(J)/Real(M2); ZERO=ANGLE==0.0; |
---|
456 | C=cos(ANGLE); S=sin(ANGLE); |
---|
457 | goto L200; |
---|
458 | L100: |
---|
459 | REPORT |
---|
460 | if (NO_FOLD) { REPORT goto L600; } |
---|
461 | REPORT |
---|
462 | NO_FOLD=true; K0=M-J; C= -C; |
---|
463 | L200: |
---|
464 | REPORT |
---|
465 | for (K=K0; K<N; K+=M2) |
---|
466 | { |
---|
467 | RS=X0[K]+X1[K]; IS=Y0[K]+Y1[K]; |
---|
468 | RU=X0[K]-X1[K]; IU=Y0[K]-Y1[K]; |
---|
469 | X0[K]=RS; Y0[K]=IS; |
---|
470 | if (!ZERO) { X1[K]=RU*C+IU*S; Y1[K]=IU*C-RU*S; } |
---|
471 | else { X1[K]=RU; Y1[K]=IU; } |
---|
472 | } |
---|
473 | goto L100; |
---|
474 | L600: ; |
---|
475 | } |
---|
476 | |
---|
477 | return; |
---|
478 | } |
---|
479 | |
---|
480 | static void R_3_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
481 | Real* X2, Real* Y2) |
---|
482 | // RADIX THREE FOURIER TRANSFORM KERNEL |
---|
483 | { |
---|
484 | REPORT |
---|
485 | bool NO_FOLD,ZERO; |
---|
486 | int J,K,K0,M3,M_OVER_2; |
---|
487 | Real ANGLE,A,B,C1,C2,S1,S2,T,TWOPI; |
---|
488 | Real I0,I1,I2,IA,IB,IS,R0,R1,R2,RA,RB,RS; |
---|
489 | |
---|
490 | M3=M*3; M_OVER_2=M/2+1; TWOPI=8.0*atan(1.0); |
---|
491 | A=cos(TWOPI/3.0); B=sin(TWOPI/3.0); |
---|
492 | |
---|
493 | for (J=0; J<M_OVER_2; J++) |
---|
494 | { |
---|
495 | NO_FOLD = (J==0 || 2*J==M); |
---|
496 | K0=J; |
---|
497 | ANGLE=TWOPI*Real(J)/Real(M3); ZERO=ANGLE==0.0; |
---|
498 | C1=cos(ANGLE); S1=sin(ANGLE); |
---|
499 | C2=C1*C1-S1*S1; S2=S1*C1+C1*S1; |
---|
500 | goto L200; |
---|
501 | L100: |
---|
502 | REPORT |
---|
503 | if (NO_FOLD) { REPORT goto L600; } |
---|
504 | REPORT |
---|
505 | NO_FOLD=true; K0=M-J; |
---|
506 | T=C1*A+S1*B; S1=C1*B-S1*A; C1=T; |
---|
507 | T=C2*A-S2*B; S2= -C2*B-S2*A; C2=T; |
---|
508 | L200: |
---|
509 | REPORT |
---|
510 | for (K=K0; K<N; K+=M3) |
---|
511 | { |
---|
512 | R0 = X0[K]; I0 = Y0[K]; |
---|
513 | RS=X1[K]+X2[K]; IS=Y1[K]+Y2[K]; |
---|
514 | X0[K]=R0+RS; Y0[K]=I0+IS; |
---|
515 | RA=R0+RS*A; IA=I0+IS*A; |
---|
516 | RB=(X1[K]-X2[K])*B; IB=(Y1[K]-Y2[K])*B; |
---|
517 | if (!ZERO) |
---|
518 | { |
---|
519 | REPORT |
---|
520 | R1=RA+IB; I1=IA-RB; R2=RA-IB; I2=IA+RB; |
---|
521 | X1[K]=R1*C1+I1*S1; Y1[K]=I1*C1-R1*S1; |
---|
522 | X2[K]=R2*C2+I2*S2; Y2[K]=I2*C2-R2*S2; |
---|
523 | } |
---|
524 | else { REPORT X1[K]=RA+IB; Y1[K]=IA-RB; X2[K]=RA-IB; Y2[K]=IA+RB; } |
---|
525 | } |
---|
526 | goto L100; |
---|
527 | L600: ; |
---|
528 | } |
---|
529 | |
---|
530 | return; |
---|
531 | } |
---|
532 | |
---|
533 | static void R_4_FTK (int N, int M, |
---|
534 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
535 | Real* X2, Real* Y2, Real* X3, Real* Y3) |
---|
536 | // RADIX FOUR FOURIER TRANSFORM KERNEL |
---|
537 | { |
---|
538 | REPORT |
---|
539 | bool NO_FOLD,ZERO; |
---|
540 | int J,K,K0,M4,M_OVER_2; |
---|
541 | Real ANGLE,C1,C2,C3,S1,S2,S3,T,TWOPI; |
---|
542 | Real I1,I2,I3,IS0,IS1,IU0,IU1,R1,R2,R3,RS0,RS1,RU0,RU1; |
---|
543 | |
---|
544 | M4=M*4; M_OVER_2=M/2+1; |
---|
545 | TWOPI=8.0*atan(1.0); |
---|
546 | |
---|
547 | for (J=0; J<M_OVER_2; J++) |
---|
548 | { |
---|
549 | NO_FOLD = (J==0 || 2*J==M); |
---|
550 | K0=J; |
---|
551 | ANGLE=TWOPI*Real(J)/Real(M4); ZERO=ANGLE==0.0; |
---|
552 | C1=cos(ANGLE); S1=sin(ANGLE); |
---|
553 | C2=C1*C1-S1*S1; S2=S1*C1+C1*S1; |
---|
554 | C3=C2*C1-S2*S1; S3=S2*C1+C2*S1; |
---|
555 | goto L200; |
---|
556 | L100: |
---|
557 | REPORT |
---|
558 | if (NO_FOLD) { REPORT goto L600; } |
---|
559 | REPORT |
---|
560 | NO_FOLD=true; K0=M-J; |
---|
561 | T=C1; C1=S1; S1=T; |
---|
562 | C2= -C2; |
---|
563 | T=C3; C3= -S3; S3= -T; |
---|
564 | L200: |
---|
565 | REPORT |
---|
566 | for (K=K0; K<N; K+=M4) |
---|
567 | { |
---|
568 | RS0=X0[K]+X2[K]; IS0=Y0[K]+Y2[K]; |
---|
569 | RU0=X0[K]-X2[K]; IU0=Y0[K]-Y2[K]; |
---|
570 | RS1=X1[K]+X3[K]; IS1=Y1[K]+Y3[K]; |
---|
571 | RU1=X1[K]-X3[K]; IU1=Y1[K]-Y3[K]; |
---|
572 | X0[K]=RS0+RS1; Y0[K]=IS0+IS1; |
---|
573 | if (!ZERO) |
---|
574 | { |
---|
575 | REPORT |
---|
576 | R1=RU0+IU1; I1=IU0-RU1; |
---|
577 | R2=RS0-RS1; I2=IS0-IS1; |
---|
578 | R3=RU0-IU1; I3=IU0+RU1; |
---|
579 | X2[K]=R1*C1+I1*S1; Y2[K]=I1*C1-R1*S1; |
---|
580 | X1[K]=R2*C2+I2*S2; Y1[K]=I2*C2-R2*S2; |
---|
581 | X3[K]=R3*C3+I3*S3; Y3[K]=I3*C3-R3*S3; |
---|
582 | } |
---|
583 | else |
---|
584 | { |
---|
585 | REPORT |
---|
586 | X2[K]=RU0+IU1; Y2[K]=IU0-RU1; |
---|
587 | X1[K]=RS0-RS1; Y1[K]=IS0-IS1; |
---|
588 | X3[K]=RU0-IU1; Y3[K]=IU0+RU1; |
---|
589 | } |
---|
590 | } |
---|
591 | goto L100; |
---|
592 | L600: ; |
---|
593 | } |
---|
594 | |
---|
595 | return; |
---|
596 | } |
---|
597 | |
---|
598 | static void R_5_FTK (int N, int M, |
---|
599 | Real* X0, Real* Y0, Real* X1, Real* Y1, Real* X2, Real* Y2, |
---|
600 | Real* X3, Real* Y3, Real* X4, Real* Y4) |
---|
601 | // RADIX FIVE FOURIER TRANSFORM KERNEL |
---|
602 | |
---|
603 | { |
---|
604 | REPORT |
---|
605 | bool NO_FOLD,ZERO; |
---|
606 | int J,K,K0,M5,M_OVER_2; |
---|
607 | Real ANGLE,A1,A2,B1,B2,C1,C2,C3,C4,S1,S2,S3,S4,T,TWOPI; |
---|
608 | Real R0,R1,R2,R3,R4,RA1,RA2,RB1,RB2,RS1,RS2,RU1,RU2; |
---|
609 | Real I0,I1,I2,I3,I4,IA1,IA2,IB1,IB2,IS1,IS2,IU1,IU2; |
---|
610 | |
---|
611 | M5=M*5; M_OVER_2=M/2+1; |
---|
612 | TWOPI=8.0*atan(1.0); |
---|
613 | A1=cos(TWOPI/5.0); B1=sin(TWOPI/5.0); |
---|
614 | A2=cos(2.0*TWOPI/5.0); B2=sin(2.0*TWOPI/5.0); |
---|
615 | |
---|
616 | for (J=0; J<M_OVER_2; J++) |
---|
617 | { |
---|
618 | NO_FOLD = (J==0 || 2*J==M); |
---|
619 | K0=J; |
---|
620 | ANGLE=TWOPI*Real(J)/Real(M5); ZERO=ANGLE==0.0; |
---|
621 | C1=cos(ANGLE); S1=sin(ANGLE); |
---|
622 | C2=C1*C1-S1*S1; S2=S1*C1+C1*S1; |
---|
623 | C3=C2*C1-S2*S1; S3=S2*C1+C2*S1; |
---|
624 | C4=C2*C2-S2*S2; S4=S2*C2+C2*S2; |
---|
625 | goto L200; |
---|
626 | L100: |
---|
627 | REPORT |
---|
628 | if (NO_FOLD) { REPORT goto L600; } |
---|
629 | REPORT |
---|
630 | NO_FOLD=true; K0=M-J; |
---|
631 | T=C1*A1+S1*B1; S1=C1*B1-S1*A1; C1=T; |
---|
632 | T=C2*A2+S2*B2; S2=C2*B2-S2*A2; C2=T; |
---|
633 | T=C3*A2-S3*B2; S3= -C3*B2-S3*A2; C3=T; |
---|
634 | T=C4*A1-S4*B1; S4= -C4*B1-S4*A1; C4=T; |
---|
635 | L200: |
---|
636 | REPORT |
---|
637 | for (K=K0; K<N; K+=M5) |
---|
638 | { |
---|
639 | R0=X0[K]; I0=Y0[K]; |
---|
640 | RS1=X1[K]+X4[K]; IS1=Y1[K]+Y4[K]; |
---|
641 | RU1=X1[K]-X4[K]; IU1=Y1[K]-Y4[K]; |
---|
642 | RS2=X2[K]+X3[K]; IS2=Y2[K]+Y3[K]; |
---|
643 | RU2=X2[K]-X3[K]; IU2=Y2[K]-Y3[K]; |
---|
644 | X0[K]=R0+RS1+RS2; Y0[K]=I0+IS1+IS2; |
---|
645 | RA1=R0+RS1*A1+RS2*A2; IA1=I0+IS1*A1+IS2*A2; |
---|
646 | RA2=R0+RS1*A2+RS2*A1; IA2=I0+IS1*A2+IS2*A1; |
---|
647 | RB1=RU1*B1+RU2*B2; IB1=IU1*B1+IU2*B2; |
---|
648 | RB2=RU1*B2-RU2*B1; IB2=IU1*B2-IU2*B1; |
---|
649 | if (!ZERO) |
---|
650 | { |
---|
651 | REPORT |
---|
652 | R1=RA1+IB1; I1=IA1-RB1; |
---|
653 | R2=RA2+IB2; I2=IA2-RB2; |
---|
654 | R3=RA2-IB2; I3=IA2+RB2; |
---|
655 | R4=RA1-IB1; I4=IA1+RB1; |
---|
656 | X1[K]=R1*C1+I1*S1; Y1[K]=I1*C1-R1*S1; |
---|
657 | X2[K]=R2*C2+I2*S2; Y2[K]=I2*C2-R2*S2; |
---|
658 | X3[K]=R3*C3+I3*S3; Y3[K]=I3*C3-R3*S3; |
---|
659 | X4[K]=R4*C4+I4*S4; Y4[K]=I4*C4-R4*S4; |
---|
660 | } |
---|
661 | else |
---|
662 | { |
---|
663 | REPORT |
---|
664 | X1[K]=RA1+IB1; Y1[K]=IA1-RB1; |
---|
665 | X2[K]=RA2+IB2; Y2[K]=IA2-RB2; |
---|
666 | X3[K]=RA2-IB2; Y3[K]=IA2+RB2; |
---|
667 | X4[K]=RA1-IB1; Y4[K]=IA1+RB1; |
---|
668 | } |
---|
669 | } |
---|
670 | goto L100; |
---|
671 | L600: ; |
---|
672 | } |
---|
673 | |
---|
674 | return; |
---|
675 | } |
---|
676 | |
---|
677 | static void R_8_FTK (int N, int M, |
---|
678 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
679 | Real* X2, Real* Y2, Real* X3, Real* Y3, |
---|
680 | Real* X4, Real* Y4, Real* X5, Real* Y5, |
---|
681 | Real* X6, Real* Y6, Real* X7, Real* Y7) |
---|
682 | // RADIX EIGHT FOURIER TRANSFORM KERNEL |
---|
683 | { |
---|
684 | REPORT |
---|
685 | bool NO_FOLD,ZERO; |
---|
686 | int J,K,K0,M8,M_OVER_2; |
---|
687 | Real ANGLE,C1,C2,C3,C4,C5,C6,C7,E,S1,S2,S3,S4,S5,S6,S7,T,TWOPI; |
---|
688 | Real R1,R2,R3,R4,R5,R6,R7,RS0,RS1,RS2,RS3,RU0,RU1,RU2,RU3; |
---|
689 | Real I1,I2,I3,I4,I5,I6,I7,IS0,IS1,IS2,IS3,IU0,IU1,IU2,IU3; |
---|
690 | Real RSS0,RSS1,RSU0,RSU1,RUS0,RUS1,RUU0,RUU1; |
---|
691 | Real ISS0,ISS1,ISU0,ISU1,IUS0,IUS1,IUU0,IUU1; |
---|
692 | |
---|
693 | M8=M*8; M_OVER_2=M/2+1; |
---|
694 | TWOPI=8.0*atan(1.0); E=cos(TWOPI/8.0); |
---|
695 | |
---|
696 | for (J=0;J<M_OVER_2;J++) |
---|
697 | { |
---|
698 | NO_FOLD= (J==0 || 2*J==M); |
---|
699 | K0=J; |
---|
700 | ANGLE=TWOPI*Real(J)/Real(M8); ZERO=ANGLE==0.0; |
---|
701 | C1=cos(ANGLE); S1=sin(ANGLE); |
---|
702 | C2=C1*C1-S1*S1; S2=C1*S1+S1*C1; |
---|
703 | C3=C2*C1-S2*S1; S3=S2*C1+C2*S1; |
---|
704 | C4=C2*C2-S2*S2; S4=S2*C2+C2*S2; |
---|
705 | C5=C4*C1-S4*S1; S5=S4*C1+C4*S1; |
---|
706 | C6=C4*C2-S4*S2; S6=S4*C2+C4*S2; |
---|
707 | C7=C4*C3-S4*S3; S7=S4*C3+C4*S3; |
---|
708 | goto L200; |
---|
709 | L100: |
---|
710 | REPORT |
---|
711 | if (NO_FOLD) { REPORT goto L600; } |
---|
712 | REPORT |
---|
713 | NO_FOLD=true; K0=M-J; |
---|
714 | T=(C1+S1)*E; S1=(C1-S1)*E; C1=T; |
---|
715 | T=S2; S2=C2; C2=T; |
---|
716 | T=(-C3+S3)*E; S3=(C3+S3)*E; C3=T; |
---|
717 | C4= -C4; |
---|
718 | T= -(C5+S5)*E; S5=(-C5+S5)*E; C5=T; |
---|
719 | T= -S6; S6= -C6; C6=T; |
---|
720 | T=(C7-S7)*E; S7= -(C7+S7)*E; C7=T; |
---|
721 | L200: |
---|
722 | REPORT |
---|
723 | for (K=K0; K<N; K+=M8) |
---|
724 | { |
---|
725 | RS0=X0[K]+X4[K]; IS0=Y0[K]+Y4[K]; |
---|
726 | RU0=X0[K]-X4[K]; IU0=Y0[K]-Y4[K]; |
---|
727 | RS1=X1[K]+X5[K]; IS1=Y1[K]+Y5[K]; |
---|
728 | RU1=X1[K]-X5[K]; IU1=Y1[K]-Y5[K]; |
---|
729 | RS2=X2[K]+X6[K]; IS2=Y2[K]+Y6[K]; |
---|
730 | RU2=X2[K]-X6[K]; IU2=Y2[K]-Y6[K]; |
---|
731 | RS3=X3[K]+X7[K]; IS3=Y3[K]+Y7[K]; |
---|
732 | RU3=X3[K]-X7[K]; IU3=Y3[K]-Y7[K]; |
---|
733 | RSS0=RS0+RS2; ISS0=IS0+IS2; |
---|
734 | RSU0=RS0-RS2; ISU0=IS0-IS2; |
---|
735 | RSS1=RS1+RS3; ISS1=IS1+IS3; |
---|
736 | RSU1=RS1-RS3; ISU1=IS1-IS3; |
---|
737 | RUS0=RU0-IU2; IUS0=IU0+RU2; |
---|
738 | RUU0=RU0+IU2; IUU0=IU0-RU2; |
---|
739 | RUS1=RU1-IU3; IUS1=IU1+RU3; |
---|
740 | RUU1=RU1+IU3; IUU1=IU1-RU3; |
---|
741 | T=(RUS1+IUS1)*E; IUS1=(IUS1-RUS1)*E; RUS1=T; |
---|
742 | T=(RUU1+IUU1)*E; IUU1=(IUU1-RUU1)*E; RUU1=T; |
---|
743 | X0[K]=RSS0+RSS1; Y0[K]=ISS0+ISS1; |
---|
744 | if (!ZERO) |
---|
745 | { |
---|
746 | REPORT |
---|
747 | R1=RUU0+RUU1; I1=IUU0+IUU1; |
---|
748 | R2=RSU0+ISU1; I2=ISU0-RSU1; |
---|
749 | R3=RUS0+IUS1; I3=IUS0-RUS1; |
---|
750 | R4=RSS0-RSS1; I4=ISS0-ISS1; |
---|
751 | R5=RUU0-RUU1; I5=IUU0-IUU1; |
---|
752 | R6=RSU0-ISU1; I6=ISU0+RSU1; |
---|
753 | R7=RUS0-IUS1; I7=IUS0+RUS1; |
---|
754 | X4[K]=R1*C1+I1*S1; Y4[K]=I1*C1-R1*S1; |
---|
755 | X2[K]=R2*C2+I2*S2; Y2[K]=I2*C2-R2*S2; |
---|
756 | X6[K]=R3*C3+I3*S3; Y6[K]=I3*C3-R3*S3; |
---|
757 | X1[K]=R4*C4+I4*S4; Y1[K]=I4*C4-R4*S4; |
---|
758 | X5[K]=R5*C5+I5*S5; Y5[K]=I5*C5-R5*S5; |
---|
759 | X3[K]=R6*C6+I6*S6; Y3[K]=I6*C6-R6*S6; |
---|
760 | X7[K]=R7*C7+I7*S7; Y7[K]=I7*C7-R7*S7; |
---|
761 | } |
---|
762 | else |
---|
763 | { |
---|
764 | REPORT |
---|
765 | X4[K]=RUU0+RUU1; Y4[K]=IUU0+IUU1; |
---|
766 | X2[K]=RSU0+ISU1; Y2[K]=ISU0-RSU1; |
---|
767 | X6[K]=RUS0+IUS1; Y6[K]=IUS0-RUS1; |
---|
768 | X1[K]=RSS0-RSS1; Y1[K]=ISS0-ISS1; |
---|
769 | X5[K]=RUU0-RUU1; Y5[K]=IUU0-IUU1; |
---|
770 | X3[K]=RSU0-ISU1; Y3[K]=ISU0+RSU1; |
---|
771 | X7[K]=RUS0-IUS1; Y7[K]=IUS0+RUS1; |
---|
772 | } |
---|
773 | } |
---|
774 | goto L100; |
---|
775 | L600: ; |
---|
776 | } |
---|
777 | |
---|
778 | return; |
---|
779 | } |
---|
780 | |
---|
781 | static void R_16_FTK (int N, int M, |
---|
782 | Real* X0, Real* Y0, Real* X1, Real* Y1, |
---|
783 | Real* X2, Real* Y2, Real* X3, Real* Y3, |
---|
784 | Real* X4, Real* Y4, Real* X5, Real* Y5, |
---|
785 | Real* X6, Real* Y6, Real* X7, Real* Y7, |
---|
786 | Real* X8, Real* Y8, Real* X9, Real* Y9, |
---|
787 | Real* X10, Real* Y10, Real* X11, Real* Y11, |
---|
788 | Real* X12, Real* Y12, Real* X13, Real* Y13, |
---|
789 | Real* X14, Real* Y14, Real* X15, Real* Y15) |
---|
790 | // RADIX SIXTEEN FOURIER TRANSFORM KERNEL |
---|
791 | { |
---|
792 | REPORT |
---|
793 | bool NO_FOLD,ZERO; |
---|
794 | int J,K,K0,M16,M_OVER_2; |
---|
795 | Real ANGLE,EI1,ER1,E2,EI3,ER3,EI5,ER5,T,TWOPI; |
---|
796 | Real RS0,RS1,RS2,RS3,RS4,RS5,RS6,RS7; |
---|
797 | Real IS0,IS1,IS2,IS3,IS4,IS5,IS6,IS7; |
---|
798 | Real RU0,RU1,RU2,RU3,RU4,RU5,RU6,RU7; |
---|
799 | Real IU0,IU1,IU2,IU3,IU4,IU5,IU6,IU7; |
---|
800 | Real RUS0,RUS1,RUS2,RUS3,RUU0,RUU1,RUU2,RUU3; |
---|
801 | Real ISS0,ISS1,ISS2,ISS3,ISU0,ISU1,ISU2,ISU3; |
---|
802 | Real RSS0,RSS1,RSS2,RSS3,RSU0,RSU1,RSU2,RSU3; |
---|
803 | Real IUS0,IUS1,IUS2,IUS3,IUU0,IUU1,IUU2,IUU3; |
---|
804 | Real RSSS0,RSSS1,RSSU0,RSSU1,RSUS0,RSUS1,RSUU0,RSUU1; |
---|
805 | Real ISSS0,ISSS1,ISSU0,ISSU1,ISUS0,ISUS1,ISUU0,ISUU1; |
---|
806 | Real RUSS0,RUSS1,RUSU0,RUSU1,RUUS0,RUUS1,RUUU0,RUUU1; |
---|
807 | Real IUSS0,IUSS1,IUSU0,IUSU1,IUUS0,IUUS1,IUUU0,IUUU1; |
---|
808 | Real R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11,R12,R13,R14,R15; |
---|
809 | Real I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15; |
---|
810 | Real C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15; |
---|
811 | Real S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15; |
---|
812 | |
---|
813 | M16=M*16; M_OVER_2=M/2+1; |
---|
814 | TWOPI=8.0*atan(1.0); |
---|
815 | ER1=cos(TWOPI/16.0); EI1=sin(TWOPI/16.0); |
---|
816 | E2=cos(TWOPI/8.0); |
---|
817 | ER3=cos(3.0*TWOPI/16.0); EI3=sin(3.0*TWOPI/16.0); |
---|
818 | ER5=cos(5.0*TWOPI/16.0); EI5=sin(5.0*TWOPI/16.0); |
---|
819 | |
---|
820 | for (J=0; J<M_OVER_2; J++) |
---|
821 | { |
---|
822 | NO_FOLD = (J==0 || 2*J==M); |
---|
823 | K0=J; |
---|
824 | ANGLE=TWOPI*Real(J)/Real(M16); |
---|
825 | ZERO=ANGLE==0.0; |
---|
826 | C1=cos(ANGLE); S1=sin(ANGLE); |
---|
827 | C2=C1*C1-S1*S1; S2=C1*S1+S1*C1; |
---|
828 | C3=C2*C1-S2*S1; S3=S2*C1+C2*S1; |
---|
829 | C4=C2*C2-S2*S2; S4=S2*C2+C2*S2; |
---|
830 | C5=C4*C1-S4*S1; S5=S4*C1+C4*S1; |
---|
831 | C6=C4*C2-S4*S2; S6=S4*C2+C4*S2; |
---|
832 | C7=C4*C3-S4*S3; S7=S4*C3+C4*S3; |
---|
833 | C8=C4*C4-S4*S4; S8=C4*S4+S4*C4; |
---|
834 | C9=C8*C1-S8*S1; S9=S8*C1+C8*S1; |
---|
835 | C10=C8*C2-S8*S2; S10=S8*C2+C8*S2; |
---|
836 | C11=C8*C3-S8*S3; S11=S8*C3+C8*S3; |
---|
837 | C12=C8*C4-S8*S4; S12=S8*C4+C8*S4; |
---|
838 | C13=C8*C5-S8*S5; S13=S8*C5+C8*S5; |
---|
839 | C14=C8*C6-S8*S6; S14=S8*C6+C8*S6; |
---|
840 | C15=C8*C7-S8*S7; S15=S8*C7+C8*S7; |
---|
841 | goto L200; |
---|
842 | L100: |
---|
843 | REPORT |
---|
844 | if (NO_FOLD) { REPORT goto L600; } |
---|
845 | REPORT |
---|
846 | NO_FOLD=true; K0=M-J; |
---|
847 | T=C1*ER1+S1*EI1; S1= -S1*ER1+C1*EI1; C1=T; |
---|
848 | T=(C2+S2)*E2; S2=(C2-S2)*E2; C2=T; |
---|
849 | T=C3*ER3+S3*EI3; S3= -S3*ER3+C3*EI3; C3=T; |
---|
850 | T=S4; S4=C4; C4=T; |
---|
851 | T=S5*ER1-C5*EI1; S5=C5*ER1+S5*EI1; C5=T; |
---|
852 | T=(-C6+S6)*E2; S6=(C6+S6)*E2; C6=T; |
---|
853 | T=S7*ER3-C7*EI3; S7=C7*ER3+S7*EI3; C7=T; |
---|
854 | C8= -C8; |
---|
855 | T= -(C9*ER1+S9*EI1); S9=S9*ER1-C9*EI1; C9=T; |
---|
856 | T= -(C10+S10)*E2; S10=(-C10+S10)*E2; C10=T; |
---|
857 | T= -(C11*ER3+S11*EI3); S11=S11*ER3-C11*EI3; C11=T; |
---|
858 | T= -S12; S12= -C12; C12=T; |
---|
859 | T= -S13*ER1+C13*EI1; S13= -(C13*ER1+S13*EI1); C13=T; |
---|
860 | T=(C14-S14)*E2; S14= -(C14+S14)*E2; C14=T; |
---|
861 | T= -S15*ER3+C15*EI3; S15= -(C15*ER3+S15*EI3); C15=T; |
---|
862 | L200: |
---|
863 | REPORT |
---|
864 | for (K=K0; K<N; K+=M16) |
---|
865 | { |
---|
866 | RS0=X0[K]+X8[K]; IS0=Y0[K]+Y8[K]; |
---|
867 | RU0=X0[K]-X8[K]; IU0=Y0[K]-Y8[K]; |
---|
868 | RS1=X1[K]+X9[K]; IS1=Y1[K]+Y9[K]; |
---|
869 | RU1=X1[K]-X9[K]; IU1=Y1[K]-Y9[K]; |
---|
870 | RS2=X2[K]+X10[K]; IS2=Y2[K]+Y10[K]; |
---|
871 | RU2=X2[K]-X10[K]; IU2=Y2[K]-Y10[K]; |
---|
872 | RS3=X3[K]+X11[K]; IS3=Y3[K]+Y11[K]; |
---|
873 | RU3=X3[K]-X11[K]; IU3=Y3[K]-Y11[K]; |
---|
874 | RS4=X4[K]+X12[K]; IS4=Y4[K]+Y12[K]; |
---|
875 | RU4=X4[K]-X12[K]; IU4=Y4[K]-Y12[K]; |
---|
876 | RS5=X5[K]+X13[K]; IS5=Y5[K]+Y13[K]; |
---|
877 | RU5=X5[K]-X13[K]; IU5=Y5[K]-Y13[K]; |
---|
878 | RS6=X6[K]+X14[K]; IS6=Y6[K]+Y14[K]; |
---|
879 | RU6=X6[K]-X14[K]; IU6=Y6[K]-Y14[K]; |
---|
880 | RS7=X7[K]+X15[K]; IS7=Y7[K]+Y15[K]; |
---|
881 | RU7=X7[K]-X15[K]; IU7=Y7[K]-Y15[K]; |
---|
882 | RSS0=RS0+RS4; ISS0=IS0+IS4; |
---|
883 | RSS1=RS1+RS5; ISS1=IS1+IS5; |
---|
884 | RSS2=RS2+RS6; ISS2=IS2+IS6; |
---|
885 | RSS3=RS3+RS7; ISS3=IS3+IS7; |
---|
886 | RSU0=RS0-RS4; ISU0=IS0-IS4; |
---|
887 | RSU1=RS1-RS5; ISU1=IS1-IS5; |
---|
888 | RSU2=RS2-RS6; ISU2=IS2-IS6; |
---|
889 | RSU3=RS3-RS7; ISU3=IS3-IS7; |
---|
890 | RUS0=RU0-IU4; IUS0=IU0+RU4; |
---|
891 | RUS1=RU1-IU5; IUS1=IU1+RU5; |
---|
892 | RUS2=RU2-IU6; IUS2=IU2+RU6; |
---|
893 | RUS3=RU3-IU7; IUS3=IU3+RU7; |
---|
894 | RUU0=RU0+IU4; IUU0=IU0-RU4; |
---|
895 | RUU1=RU1+IU5; IUU1=IU1-RU5; |
---|
896 | RUU2=RU2+IU6; IUU2=IU2-RU6; |
---|
897 | RUU3=RU3+IU7; IUU3=IU3-RU7; |
---|
898 | T=(RSU1+ISU1)*E2; ISU1=(ISU1-RSU1)*E2; RSU1=T; |
---|
899 | T=(RSU3+ISU3)*E2; ISU3=(ISU3-RSU3)*E2; RSU3=T; |
---|
900 | T=RUS1*ER3+IUS1*EI3; IUS1=IUS1*ER3-RUS1*EI3; RUS1=T; |
---|
901 | T=(RUS2+IUS2)*E2; IUS2=(IUS2-RUS2)*E2; RUS2=T; |
---|
902 | T=RUS3*ER5+IUS3*EI5; IUS3=IUS3*ER5-RUS3*EI5; RUS3=T; |
---|
903 | T=RUU1*ER1+IUU1*EI1; IUU1=IUU1*ER1-RUU1*EI1; RUU1=T; |
---|
904 | T=(RUU2+IUU2)*E2; IUU2=(IUU2-RUU2)*E2; RUU2=T; |
---|
905 | T=RUU3*ER3+IUU3*EI3; IUU3=IUU3*ER3-RUU3*EI3; RUU3=T; |
---|
906 | RSSS0=RSS0+RSS2; ISSS0=ISS0+ISS2; |
---|
907 | RSSS1=RSS1+RSS3; ISSS1=ISS1+ISS3; |
---|
908 | RSSU0=RSS0-RSS2; ISSU0=ISS0-ISS2; |
---|
909 | RSSU1=RSS1-RSS3; ISSU1=ISS1-ISS3; |
---|
910 | RSUS0=RSU0-ISU2; ISUS0=ISU0+RSU2; |
---|
911 | RSUS1=RSU1-ISU3; ISUS1=ISU1+RSU3; |
---|
912 | RSUU0=RSU0+ISU2; ISUU0=ISU0-RSU2; |
---|
913 | RSUU1=RSU1+ISU3; ISUU1=ISU1-RSU3; |
---|
914 | RUSS0=RUS0-IUS2; IUSS0=IUS0+RUS2; |
---|
915 | RUSS1=RUS1-IUS3; IUSS1=IUS1+RUS3; |
---|
916 | RUSU0=RUS0+IUS2; IUSU0=IUS0-RUS2; |
---|
917 | RUSU1=RUS1+IUS3; IUSU1=IUS1-RUS3; |
---|
918 | RUUS0=RUU0+RUU2; IUUS0=IUU0+IUU2; |
---|
919 | RUUS1=RUU1+RUU3; IUUS1=IUU1+IUU3; |
---|
920 | RUUU0=RUU0-RUU2; IUUU0=IUU0-IUU2; |
---|
921 | RUUU1=RUU1-RUU3; IUUU1=IUU1-IUU3; |
---|
922 | X0[K]=RSSS0+RSSS1; Y0[K]=ISSS0+ISSS1; |
---|
923 | if (!ZERO) |
---|
924 | { |
---|
925 | REPORT |
---|
926 | R1=RUUS0+RUUS1; I1=IUUS0+IUUS1; |
---|
927 | R2=RSUU0+RSUU1; I2=ISUU0+ISUU1; |
---|
928 | R3=RUSU0+RUSU1; I3=IUSU0+IUSU1; |
---|
929 | R4=RSSU0+ISSU1; I4=ISSU0-RSSU1; |
---|
930 | R5=RUUU0+IUUU1; I5=IUUU0-RUUU1; |
---|
931 | R6=RSUS0+ISUS1; I6=ISUS0-RSUS1; |
---|
932 | R7=RUSS0+IUSS1; I7=IUSS0-RUSS1; |
---|
933 | R8=RSSS0-RSSS1; I8=ISSS0-ISSS1; |
---|
934 | R9=RUUS0-RUUS1; I9=IUUS0-IUUS1; |
---|
935 | R10=RSUU0-RSUU1; I10=ISUU0-ISUU1; |
---|
936 | R11=RUSU0-RUSU1; I11=IUSU0-IUSU1; |
---|
937 | R12=RSSU0-ISSU1; I12=ISSU0+RSSU1; |
---|
938 | R13=RUUU0-IUUU1; I13=IUUU0+RUUU1; |
---|
939 | R14=RSUS0-ISUS1; I14=ISUS0+RSUS1; |
---|
940 | R15=RUSS0-IUSS1; I15=IUSS0+RUSS1; |
---|
941 | X8[K]=R1*C1+I1*S1; Y8[K]=I1*C1-R1*S1; |
---|
942 | X4[K]=R2*C2+I2*S2; Y4[K]=I2*C2-R2*S2; |
---|
943 | X12[K]=R3*C3+I3*S3; Y12[K]=I3*C3-R3*S3; |
---|
944 | X2[K]=R4*C4+I4*S4; Y2[K]=I4*C4-R4*S4; |
---|
945 | X10[K]=R5*C5+I5*S5; Y10[K]=I5*C5-R5*S5; |
---|
946 | X6[K]=R6*C6+I6*S6; Y6[K]=I6*C6-R6*S6; |
---|
947 | X14[K]=R7*C7+I7*S7; Y14[K]=I7*C7-R7*S7; |
---|
948 | X1[K]=R8*C8+I8*S8; Y1[K]=I8*C8-R8*S8; |
---|
949 | X9[K]=R9*C9+I9*S9; Y9[K]=I9*C9-R9*S9; |
---|
950 | X5[K]=R10*C10+I10*S10; Y5[K]=I10*C10-R10*S10; |
---|
951 | X13[K]=R11*C11+I11*S11; Y13[K]=I11*C11-R11*S11; |
---|
952 | X3[K]=R12*C12+I12*S12; Y3[K]=I12*C12-R12*S12; |
---|
953 | X11[K]=R13*C13+I13*S13; Y11[K]=I13*C13-R13*S13; |
---|
954 | X7[K]=R14*C14+I14*S14; Y7[K]=I14*C14-R14*S14; |
---|
955 | X15[K]=R15*C15+I15*S15; Y15[K]=I15*C15-R15*S15; |
---|
956 | } |
---|
957 | else |
---|
958 | { |
---|
959 | REPORT |
---|
960 | X8[K]=RUUS0+RUUS1; Y8[K]=IUUS0+IUUS1; |
---|
961 | X4[K]=RSUU0+RSUU1; Y4[K]=ISUU0+ISUU1; |
---|
962 | X12[K]=RUSU0+RUSU1; Y12[K]=IUSU0+IUSU1; |
---|
963 | X2[K]=RSSU0+ISSU1; Y2[K]=ISSU0-RSSU1; |
---|
964 | X10[K]=RUUU0+IUUU1; Y10[K]=IUUU0-RUUU1; |
---|
965 | X6[K]=RSUS0+ISUS1; Y6[K]=ISUS0-RSUS1; |
---|
966 | X14[K]=RUSS0+IUSS1; Y14[K]=IUSS0-RUSS1; |
---|
967 | X1[K]=RSSS0-RSSS1; Y1[K]=ISSS0-ISSS1; |
---|
968 | X9[K]=RUUS0-RUUS1; Y9[K]=IUUS0-IUUS1; |
---|
969 | X5[K]=RSUU0-RSUU1; Y5[K]=ISUU0-ISUU1; |
---|
970 | X13[K]=RUSU0-RUSU1; Y13[K]=IUSU0-IUSU1; |
---|
971 | X3[K]=RSSU0-ISSU1; Y3[K]=ISSU0+RSSU1; |
---|
972 | X11[K]=RUUU0-IUUU1; Y11[K]=IUUU0+RUUU1; |
---|
973 | X7[K]=RSUS0-ISUS1; Y7[K]=ISUS0+RSUS1; |
---|
974 | X15[K]=RUSS0-IUSS1; Y15[K]=IUSS0+RUSS1; |
---|
975 | } |
---|
976 | } |
---|
977 | goto L100; |
---|
978 | L600: ; |
---|
979 | } |
---|
980 | |
---|
981 | return; |
---|
982 | } |
---|
983 | |
---|
984 | // can the number of points be factorised sufficiently |
---|
985 | // for the fft to run |
---|
986 | |
---|
987 | bool FFT_Controller::CanFactor(int PTS) |
---|
988 | { |
---|
989 | REPORT |
---|
990 | const int NP = 16, NQ = 10, PMAX=19; |
---|
991 | |
---|
992 | if (PTS<=1) { REPORT return true; } |
---|
993 | |
---|
994 | int N = PTS, F = 2, P = 0, Q = 0; |
---|
995 | |
---|
996 | while (N > 1) |
---|
997 | { |
---|
998 | bool fail = true; |
---|
999 | for (int J = F; J <= PMAX; J++) |
---|
1000 | if (N % J == 0) { fail = false; F=J; break; } |
---|
1001 | if (fail || P >= NP || Q >= NQ) { REPORT return false; } |
---|
1002 | N /= F; |
---|
1003 | if (N % F != 0) Q++; else { N /= F; P++; } |
---|
1004 | } |
---|
1005 | |
---|
1006 | return true; // can factorise |
---|
1007 | |
---|
1008 | } |
---|
1009 | |
---|
1010 | bool FFT_Controller::OnlyOldFFT; // static variable |
---|
1011 | |
---|
1012 | // **************************** multi radix counter ********************** |
---|
1013 | |
---|
1014 | MultiRadixCounter::MultiRadixCounter(int nx, const SimpleIntArray& rx, |
---|
1015 | SimpleIntArray& vx) |
---|
1016 | : Radix(rx), Value(vx), n(nx), reverse(0), |
---|
1017 | product(1), counter(0), finish(false) |
---|
1018 | { |
---|
1019 | REPORT for (int k = 0; k < n; k++) { Value[k] = 0; product *= Radix[k]; } |
---|
1020 | } |
---|
1021 | |
---|
1022 | void MultiRadixCounter::operator++() |
---|
1023 | { |
---|
1024 | REPORT |
---|
1025 | counter++; int p = product; |
---|
1026 | for (int k = 0; k < n; k++) |
---|
1027 | { |
---|
1028 | Value[k]++; int p1 = p / Radix[k]; reverse += p1; |
---|
1029 | if (Value[k] == Radix[k]) { REPORT Value[k] = 0; reverse -= p; p = p1; } |
---|
1030 | else { REPORT return; } |
---|
1031 | } |
---|
1032 | finish = true; |
---|
1033 | } |
---|
1034 | |
---|
1035 | |
---|
1036 | static int BitReverse(int x, int prod, int n, const SimpleIntArray& f) |
---|
1037 | { |
---|
1038 | // x = c[0]+f[0]*(c[1]+f[1]*(c[2]+... |
---|
1039 | // return c[n-1]+f[n-1]*(c[n-2]+f[n-2]*(c[n-3]+... |
---|
1040 | // prod is the product of the f[i] |
---|
1041 | // n is the number of f[i] (don't assume f has the correct length) |
---|
1042 | |
---|
1043 | REPORT |
---|
1044 | const int* d = f.Data() + n; int sum = 0; int q = 1; |
---|
1045 | while (n--) |
---|
1046 | { |
---|
1047 | prod /= *(--d); |
---|
1048 | int c = x / prod; x-= c * prod; |
---|
1049 | sum += q * c; q *= *d; |
---|
1050 | } |
---|
1051 | return sum; |
---|
1052 | } |
---|
1053 | |
---|
1054 | |
---|
1055 | #ifdef use_namespace |
---|
1056 | } |
---|
1057 | #endif |
---|
1058 | |
---|
1059 | |
---|