| 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 |  | 
|---|