fftpack_inc.c

00001 /*
00002  *  This file is part of libfftpack.
00003  *
00004  *  libfftpack is free software; you can redistribute it and/or modify
00005  *  it under the terms of the GNU General Public License as published by
00006  *  the Free Software Foundation; either version 2 of the License, or
00007  *  (at your option) any later version.
00008  *
00009  *  libfftpack is distributed in the hope that it will be useful,
00010  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012  *  GNU General Public License for more details.
00013  *
00014  *  You should have received a copy of the GNU General Public License
00015  *  along with libfftpack; if not, write to the Free Software
00016  *  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
00017  */
00018 
00019 /*
00020  *  libfftpack is being developed at the Max-Planck-Institut fuer Astrophysik
00021  *  and financially supported by the Deutsches Zentrum fuer Luft- und Raumfahrt
00022  *  (DLR).
00023  */
00024 
00025 /*
00026   fftpack.c : A set of FFT routines in C.
00027   Algorithmically based on Fortran-77 FFTPACK by Paul N. Swarztrauber
00028   (Version 4, 1985).
00029 
00030   C port by Martin Reinecke (2010)
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 /* a = b*c */
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 /* a = conj(b)*c */
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

Generated on Thu Oct 8 14:48:49 2015 for LevelS FFT library