Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: orxonox.OLD/orxonox/trunk/src/lib/newmat/newfft.cpp @ 4630

Last change on this file since 4630 was 4565, checked in by patrick, 19 years ago

orxonox/trunk: added the newmat library to the project. needs some translation in directory, temp under util/newmat. is needed by the collision detection engine to perform lin alg operations such as eigenvector decomposition. perhaps we will make our own library to do that later.

File size: 33.7 KB
Line 
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
101namespace 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
110inline Real square(Real x) { return x*x; }
111inline int square(int x) { return x*x; }
112
113static 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);
116static void GR_1D_FT (int N, int N_FACTOR, const SimpleIntArray& FACTOR,
117   Real* X, Real* Y);
118static void R_P_FTK (int N, int M, int P, Real* X, Real* Y);
119static void R_2_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1);
120static void R_3_FTK (int N, int M, Real* X0, Real* Y0, Real* X1, Real* Y1,
121   Real* X2, Real* Y2);
122static 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);
125static 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);
128static 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);
133static 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);
142static int BitReverse(int x, int prod, int n, const SimpleIntArray& f);
143
144
145bool 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
231static 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
297static 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
341static 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;
435L1500: ;
436   }
437   return;
438}
439
440static 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
480static 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
533static 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
598static 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
677static 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
781static 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
987bool 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
1010bool FFT_Controller::OnlyOldFFT;         // static variable
1011
1012// **************************** multi radix counter **********************
1013
1014MultiRadixCounter::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
1022void 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
1036static 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
Note: See TracBrowser for help on using the repository browser.