00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033 #ifdef BACKWARD
00034 #define PSIGN +
00035 #define PMSIGNC(a,b,c,d) { a.r=c.r+d.r; a.i=c.i+d.i; b.r=c.r-d.r; b.i=c.i-d.i; }
00036
00037 #define MULPMSIGNC(a,b,c) { a.r=b.r*c.r-b.i*c.i; a.i=b.r*c.i+b.i*c.r; }
00038 #else
00039 #define PSIGN -
00040 #define PMSIGNC(a,b,c,d) { a.r=c.r-d.r; a.i=c.i-d.i; b.r=c.r+d.r; b.i=c.i+d.i; }
00041
00042 #define MULPMSIGNC(a,b,c) { a.r=b.r*c.r+b.i*c.i; a.i=b.r*c.i-b.i*c.r; }
00043 #endif
00044
00045 static void X(2) (size_t ido, size_t l1, const cmplx *cc, cmplx *ch,
00046 const cmplx *wa)
00047 {
00048 const size_t cdim=2;
00049 size_t k,i;
00050 cmplx t;
00051 if (ido==1)
00052 for (k=0;k<l1;++k)
00053 PMC (CH(0,k,0),CH(0,k,1),CC(0,0,k),CC(0,1,k))
00054 else
00055 for (k=0;k<l1;++k)
00056 for (i=0;i<ido;++i)
00057 {
00058 PMC (CH(i,k,0),t,CC(i,0,k),CC(i,1,k))
00059 MULPMSIGNC (CH(i,k,1),WA(0,i),t)
00060 }
00061 }
00062
00063 static void X(3)(size_t ido, size_t l1, const cmplx *cc, cmplx *ch,
00064 const cmplx *wa)
00065 {
00066 const size_t cdim=3;
00067 static const double taur=-0.5, taui= PSIGN 0.86602540378443864676;
00068 size_t i, k;
00069 cmplx c2, c3, d2, d3, t2;
00070
00071 if (ido==1)
00072 for (k=0; k<l1; ++k)
00073 {
00074 PMC (t2,c3,CC(0,1,k),CC(0,2,k))
00075 ADDC (CH(0,k,0),t2,CC(0,0,k))
00076 SCALEC(t2,taur)
00077 ADDC(c2,CC(0,0,k),t2)
00078 SCALEC(c3,taui)
00079 CONJFLIPC(c3)
00080 PMC(CH(0,k,1),CH(0,k,2),c2,c3)
00081 }
00082 else
00083 for (k=0; k<l1; ++k)
00084 for (i=0; i<ido; ++i)
00085 {
00086 PMC (t2,c3,CC(i,1,k),CC(i,2,k))
00087 ADDC (CH(i,k,0),t2,CC(i,0,k))
00088 SCALEC(t2,taur)
00089 ADDC(c2,CC(i,0,k),t2)
00090 SCALEC(c3,taui)
00091 CONJFLIPC(c3)
00092 PMC(d2,d3,c2,c3)
00093 MULPMSIGNC(CH(i,k,1),WA(0,i),d2)
00094 MULPMSIGNC(CH(i,k,2),WA(1,i),d3)
00095 }
00096 }
00097
00098 static void X(4)(size_t ido, size_t l1, const cmplx *cc, cmplx *ch,
00099 const cmplx *wa)
00100 {
00101 const size_t cdim=4;
00102 size_t i, k;
00103 cmplx c2, c3, c4, t1, t2, t3, t4;
00104
00105 if (ido==1)
00106 for (k=0; k<l1; ++k)
00107 {
00108 PMC(t2,t1,CC(0,0,k),CC(0,2,k))
00109 PMC(t3,t4,CC(0,1,k),CC(0,3,k))
00110 CONJFLIPC(t4)
00111 PMC(CH(0,k,0),CH(0,k,2),t2,t3)
00112 PMSIGNC (CH(0,k,1),CH(0,k,3),t1,t4)
00113 }
00114 else
00115 for (k=0; k<l1; ++k)
00116 for (i=0; i<ido; ++i)
00117 {
00118 PMC(t2,t1,CC(i,0,k),CC(i,2,k))
00119 PMC(t3,t4,CC(i,1,k),CC(i,3,k))
00120 CONJFLIPC(t4)
00121 PMC(CH(i,k,0),c3,t2,t3)
00122 PMSIGNC (c2,c4,t1,t4)
00123 MULPMSIGNC (CH(i,k,1),WA(0,i),c2)
00124 MULPMSIGNC (CH(i,k,2),WA(1,i),c3)
00125 MULPMSIGNC (CH(i,k,3),WA(2,i),c4)
00126 }
00127 }
00128
00129 static void X(5)(size_t ido, size_t l1, const cmplx *cc, cmplx *ch,
00130 const cmplx *wa)
00131 {
00132 const size_t cdim=5;
00133 static const double tr11= 0.3090169943749474241,
00134 ti11= PSIGN 0.95105651629515357212,
00135 tr12=-0.8090169943749474241,
00136 ti12= PSIGN 0.58778525229247312917;
00137 size_t i, k;
00138 cmplx c2, c3, c4, c5, d2, d3, d4, d5, t2, t3, t4, t5;
00139
00140 if (ido==1)
00141 for (k=0; k<l1; ++k)
00142 {
00143 PMC (t2,t5,CC(0,1,k),CC(0,4,k))
00144 PMC (t3,t4,CC(0,2,k),CC(0,3,k))
00145 CH(0,k,0).r=CC(0,0,k).r+t2.r+t3.r;
00146 CH(0,k,0).i=CC(0,0,k).i+t2.i+t3.i;
00147 c2.r=CC(0,0,k).r+tr11*t2.r+tr12*t3.r;
00148 c2.i=CC(0,0,k).i+tr11*t2.i+tr12*t3.i;
00149 c3.r=CC(0,0,k).r+tr12*t2.r+tr11*t3.r;
00150 c3.i=CC(0,0,k).i+tr12*t2.i+tr11*t3.i;
00151 c5.r=ti11*t5.r+ti12*t4.r;
00152 c5.i=ti11*t5.i+ti12*t4.i;
00153 c4.r=ti12*t5.r-ti11*t4.r;
00154 c4.i=ti12*t5.i-ti11*t4.i;
00155 CONJFLIPC(c5)
00156 PMC(CH(0,k,1),CH(0,k,4),c2,c5)
00157 CONJFLIPC(c4)
00158 PMC(CH(0,k,2),CH(0,k,3),c3,c4)
00159 }
00160 else
00161 for (k=0; k<l1; ++k)
00162 for (i=0; i<ido; ++i)
00163 {
00164 PMC (t2,t5,CC(i,1,k),CC(i,4,k))
00165 PMC (t3,t4,CC(i,2,k),CC(i,3,k))
00166 CH(i,k,0).r=CC(i,0,k).r+t2.r+t3.r;
00167 CH(i,k,0).i=CC(i,0,k).i+t2.i+t3.i;
00168 c2.r=CC(i,0,k).r+tr11*t2.r+tr12*t3.r;
00169 c2.i=CC(i,0,k).i+tr11*t2.i+tr12*t3.i;
00170 c3.r=CC(i,0,k).r+tr12*t2.r+tr11*t3.r;
00171 c3.i=CC(i,0,k).i+tr12*t2.i+tr11*t3.i;
00172 c5.r=ti11*t5.r+ti12*t4.r;
00173 c5.i=ti11*t5.i+ti12*t4.i;
00174 c4.r=ti12*t5.r-ti11*t4.r;
00175 c4.i=ti12*t5.i-ti11*t4.i;
00176 CONJFLIPC(c5)
00177 PMC(d2,d5,c2,c5)
00178 CONJFLIPC(c4)
00179 PMC(d3,d4,c3,c4)
00180 MULPMSIGNC (CH(i,k,1),WA(0,i),d2)
00181 MULPMSIGNC (CH(i,k,2),WA(1,i),d3)
00182 MULPMSIGNC (CH(i,k,3),WA(2,i),d4)
00183 MULPMSIGNC (CH(i,k,4),WA(3,i),d5)
00184 }
00185 }
00186
00187 static void X(6)(size_t ido, size_t l1, const cmplx *cc, cmplx *ch,
00188 const cmplx *wa)
00189 {
00190 const size_t cdim=6;
00191 static const double taui= PSIGN 0.86602540378443864676;
00192 cmplx ta1,ta2,ta3,a0,a1,a2,tb1,tb2,tb3,b0,b1,b2,d1,d2,d3,d4,d5;
00193 size_t i, k;
00194
00195 if (ido==1)
00196 for (k=0; k<l1; ++k)
00197 {
00198 PMC(ta1,ta3,CC(0,2,k),CC(0,4,k))
00199 ta2.r = CC(0,0,k).r - .5*ta1.r;
00200 ta2.i = CC(0,0,k).i - .5*ta1.i;
00201 SCALEC(ta3,taui)
00202 ADDC(a0,CC(0,0,k),ta1)
00203 CONJFLIPC(ta3)
00204 PMC(a1,a2,ta2,ta3)
00205 PMC(tb1,tb3,CC(0,5,k),CC(0,1,k))
00206 tb2.r = CC(0,3,k).r - .5*tb1.r;
00207 tb2.i = CC(0,3,k).i - .5*tb1.i;
00208 SCALEC(tb3,taui)
00209 ADDC(b0,CC(0,3,k),tb1)
00210 CONJFLIPC(tb3)
00211 PMC(b1,b2,tb2,tb3)
00212 PMC(CH(0,k,0),CH(0,k,3),a0,b0)
00213 PMC(CH(0,k,4),CH(0,k,1),a1,b1)
00214 PMC(CH(0,k,2),CH(0,k,5),a2,b2)
00215 }
00216 else
00217 for (k=0; k<l1; ++k)
00218 for (i=0; i<ido; ++i)
00219 {
00220 PMC(ta1,ta3,CC(i,2,k),CC(i,4,k))
00221 ta2.r = CC(i,0,k).r - .5*ta1.r;
00222 ta2.i = CC(i,0,k).i - .5*ta1.i;
00223 SCALEC(ta3,taui)
00224 ADDC(a0,CC(i,0,k),ta1)
00225 CONJFLIPC(ta3)
00226 PMC(a1,a2,ta2,ta3)
00227 PMC(tb1,tb3,CC(i,5,k),CC(i,1,k))
00228 tb2.r = CC(i,3,k).r - .5*tb1.r;
00229 tb2.i = CC(i,3,k).i - .5*tb1.i;
00230 SCALEC(tb3,taui)
00231 ADDC(b0,CC(i,3,k),tb1)
00232 CONJFLIPC(tb3)
00233 PMC(b1,b2,tb2,tb3)
00234 PMC(CH(i,k,0),d3,a0,b0)
00235 PMC(d4,d1,a1,b1)
00236 PMC(d2,d5,a2,b2)
00237 MULPMSIGNC (CH(i,k,1),WA(0,i),d1)
00238 MULPMSIGNC (CH(i,k,2),WA(1,i),d2)
00239 MULPMSIGNC (CH(i,k,3),WA(2,i),d3)
00240 MULPMSIGNC (CH(i,k,4),WA(3,i),d4)
00241 MULPMSIGNC (CH(i,k,5),WA(4,i),d5)
00242 }
00243 }
00244
00245 static void X(g)(size_t ido, size_t ip, size_t l1, const cmplx *cc, cmplx *ch,
00246 const cmplx *wa)
00247 {
00248 const size_t cdim=ip;
00249 cmplx *tarr=RALLOC(cmplx,2*ip);
00250 cmplx *ccl=tarr, *wal=tarr+ip;
00251 size_t i,j,k,l,jc,lc;
00252 size_t ipph = (ip+1)/2;
00253
00254 for (i=1; i<ip; ++i)
00255 wal[i]=wa[ido*(i-1)];
00256 for (k=0; k<l1; ++k)
00257 for (i=0; i<ido; ++i)
00258 {
00259 cmplx s=CC(i,0,k);
00260 ccl[0] = CC(i,0,k);
00261 for(j=1,jc=ip-1; j<ipph; ++j,--jc)
00262 {
00263 PMC (ccl[j],ccl[jc],CC(i,j,k),CC(i,jc,k))
00264 ADDC (s,s,ccl[j])
00265 }
00266 CH(i,k,0) = s;
00267 for (j=1, jc=ip-1; j<=ipph; ++j,--jc)
00268 {
00269 cmplx abr=ccl[0], abi={0.,0.};
00270 size_t iang=0;
00271 for (l=1,lc=ip-1; l<ipph; ++l,--lc)
00272 {
00273 iang+=j;
00274 if (iang>ip) iang-=ip;
00275 abr.r += ccl[l ].r*wal[iang].r;
00276 abr.i += ccl[l ].i*wal[iang].r;
00277 abi.r += ccl[lc].r*wal[iang].i;
00278 abi.i += ccl[lc].i*wal[iang].i;
00279 }
00280 #ifndef BACKWARD
00281 { abi.i=-abi.i; abi.r=-abi.r; }
00282 #endif
00283 CONJFLIPC(abi)
00284 PMC(CH(i,k,j),CH(i,k,jc),abr,abi)
00285 }
00286 }
00287
00288 DEALLOC(tarr);
00289
00290 if (ido==1) return;
00291
00292 for (j=1; j<ip; ++j)
00293 for (k=0; k<l1; ++k)
00294 {
00295 size_t idij=(j-1)*ido+1;
00296 for(i=1; i<ido; ++i, ++idij)
00297 {
00298 cmplx t=CH(i,k,j);
00299 MULPMSIGNC (CH(i,k,j),wa[idij],t)
00300 }
00301 }
00302 }
00303
00304 #undef PSIGN
00305 #undef PMSIGNC
00306 #undef MULPMSIGNC