Main Page | Modules | File List | Globals

fftpack.c

00001 /*
00002  *  This file is part of Healpix_cxx.
00003  *
00004  *  Healpix_cxx 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  *  Healpix_cxx 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 Healpix_cxx; if not, write to the Free Software
00016  *  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
00017  *
00018  *  For more information about HEALPix, see http://healpix.jpl.nasa.gov
00019  */
00020 
00021 /*
00022  *  Healpix_cxx is being developed at the Max-Planck-Institut fuer Astrophysik
00023  *  and financially supported by the Deutsches Zentrum fuer Luft- und Raumfahrt
00024  *  (DLR).
00025  */
00026 
00027 /*
00028  * This file was originally part of tela the Tensor Language.
00029  * Copyright(c)1994-1995 Pekka Janhunen
00030  */
00031 
00032 /*
00033   fftpack.c : A set of FFT routines in C.
00034   Algorithmically based on Fortran-77 FFTPACK by Paul N. Swarztrauber
00035   (Version 4, 1985).
00036 
00037   Pekka Janhunen 23.2.1995
00038 
00039   (reformatted by joerg arndt)
00040 
00041   reformatted and slightly enhanced by Martin Reinecke (2004)
00042  */
00043 
00044 #include <math.h>
00045 #include <stdlib.h>
00046 #include <string.h>
00047 #include "fftpack.h"
00048 
00049 static void passf2(int ido, int l1, const double *cc, double *ch,
00050   const double *wa1)
00051   {
00052   int i, k, ah, ac;
00053   double ti2, tr2;
00054 
00055   if(ido<=2)
00056     {
00057     for(k=0; k<l1; k++)
00058       {
00059       ah=k*ido;
00060       ac=2*k*ido;
00061       ch[ah]=cc[ac]+cc[ac+ido];
00062       ch[ah+ido*l1]=cc[ac]-cc[ac+ido];
00063       ch[ah+1]=cc[ac+1]+cc[ac+ido+1];
00064       ch[ah+ido*l1+1]=cc[ac+1]-cc[ac+ido+1];
00065       }
00066     }
00067   else
00068     {
00069     for(k=0; k<l1; k++)
00070       {
00071       for(i=0; i<ido-1; i+=2)
00072         {
00073         ah=i+k*ido;
00074         ac=i+2*k*ido;
00075         ch[ah]=cc[ac]+cc[ac+ido];
00076         tr2=cc[ac]-cc[ac+ido];
00077         ch[ah+1]=cc[ac+1]+cc[ac+1+ido];
00078         ti2=cc[ac+1]-cc[ac+1+ido];
00079         ch[ah+l1*ido+1]=wa1[i]*ti2-wa1[i+1]*tr2;
00080         ch[ah+l1*ido]=wa1[i]*tr2+wa1[i+1]*ti2;
00081         }
00082       }
00083     }
00084   }
00085 
00086 static void passb2(int ido, int l1, const double *cc, double *ch,
00087   const double *wa1)
00088   {
00089   int i, k, ah, ac;
00090   double ti2, tr2;
00091 
00092   if(ido<=2)
00093     {
00094     for(k=0; k<l1; k++)
00095       {
00096       ah=k*ido;
00097       ac=2*k*ido;
00098       ch[ah]=cc[ac]+cc[ac+ido];
00099       ch[ah+ido*l1]=cc[ac]-cc[ac+ido];
00100       ch[ah+1]=cc[ac+1]+cc[ac+ido+1];
00101       ch[ah+ido*l1+1]=cc[ac+1]-cc[ac+ido+1];
00102       }
00103     }
00104   else
00105     {
00106     for(k=0; k<l1; k++)
00107       {
00108       for(i=0; i<ido-1; i+=2)
00109         {
00110         ah=i+k*ido;
00111         ac=i+2*k*ido;
00112         ch[ah]=cc[ac]+cc[ac+ido];
00113         tr2=cc[ac]-cc[ac+ido];
00114         ch[ah+1]=cc[ac+1]+cc[ac+1+ido];
00115         ti2=cc[ac+1]-cc[ac+1+ido];
00116         ch[ah+l1*ido+1]=wa1[i]*ti2+wa1[i+1]*tr2;
00117         ch[ah+l1*ido]=wa1[i]*tr2-wa1[i+1]*ti2;
00118         }
00119       }
00120     }
00121   }
00122 
00123 static void passf3(int ido, int l1, const double *cc, double *ch,
00124   const double *wa1, const double *wa2)
00125   {
00126   static const double taur=-0.5, taui=0.86602540378443864676;
00127   int i, k, ac, ah;
00128   double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
00129 
00130   if(ido==2)
00131     {
00132     for(k=1; k<=l1; k++)
00133       {
00134       ac=(3*k-2)*ido;
00135       tr2=cc[ac]+cc[ac+ido];
00136       cr2=cc[ac-ido]+taur*tr2;
00137       ah=(k-1)*ido;
00138       ch[ah]=cc[ac-ido]+tr2;
00139 
00140       ti2=cc[ac+1]+cc[ac+ido+1];
00141       ci2=cc[ac-ido+1]+taur*ti2;
00142       ch[ah+1]=cc[ac-ido+1]+ti2;
00143 
00144       cr3=-taui*(cc[ac]-cc[ac+ido]);
00145       ci3=-taui*(cc[ac+1]-cc[ac+ido+1]);
00146       ch[ah+l1*ido]=cr2-ci3;
00147       ch[ah+2*l1*ido]=cr2+ci3;
00148       ch[ah+l1*ido+1]=ci2+cr3;
00149       ch[ah+2*l1*ido+1]=ci2-cr3;
00150       }
00151     }
00152   else
00153     {
00154     for(k=1; k<=l1; k++)
00155       {
00156       for(i=0; i<ido-1; i+=2)
00157         {
00158         ac=i+(3*k-2)*ido;
00159         tr2=cc[ac]+cc[ac+ido];
00160         cr2=cc[ac-ido]+taur*tr2;
00161         ah=i+(k-1)*ido;
00162         ch[ah]=cc[ac-ido]+tr2;
00163         ti2=cc[ac+1]+cc[ac+ido+1];
00164         ci2=cc[ac-ido+1]+taur*ti2;
00165         ch[ah+1]=cc[ac-ido+1]+ti2;
00166         cr3=-taui*(cc[ac]-cc[ac+ido]);
00167         ci3=-taui*(cc[ac+1]-cc[ac+ido+1]);
00168         dr2=cr2-ci3;
00169         dr3=cr2+ci3;
00170         di2=ci2+cr3;
00171         di3=ci2-cr3;
00172         ch[ah+l1*ido+1]=wa1[i]*di2-wa1[i+1]*dr2;
00173         ch[ah+l1*ido]=wa1[i]*dr2+wa1[i+1]*di2;
00174         ch[ah+2*l1*ido+1]=wa2[i]*di3-wa2[i+1]*dr3;
00175         ch[ah+2*l1*ido]=wa2[i]*dr3+wa2[i+1]*di3;
00176         }
00177       }
00178     }
00179   }
00180 
00181 static void passb3(int ido, int l1, const double *cc, double *ch,
00182   const double *wa1, const double *wa2)
00183   {
00184   static const double taur=-0.5, taui=0.86602540378443864676;
00185   int i, k, ac, ah;
00186   double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
00187 
00188   if(ido==2)
00189     {
00190     for(k=1; k<=l1; k++)
00191       {
00192       ac=(3*k-2)*ido;
00193       tr2=cc[ac]+cc[ac+ido];
00194       cr2=cc[ac-ido]+taur*tr2;
00195       ah=(k-1)*ido;
00196       ch[ah]=cc[ac-ido]+tr2;
00197 
00198       ti2=cc[ac+1]+cc[ac+ido+1];
00199       ci2=cc[ac-ido+1]+taur*ti2;
00200       ch[ah+1]=cc[ac-ido+1]+ti2;
00201 
00202       cr3=taui*(cc[ac]-cc[ac+ido]);
00203       ci3=taui*(cc[ac+1]-cc[ac+ido+1]);
00204       ch[ah+l1*ido]=cr2-ci3;
00205       ch[ah+2*l1*ido]=cr2+ci3;
00206       ch[ah+l1*ido+1]=ci2+cr3;
00207       ch[ah+2*l1*ido+1]=ci2-cr3;
00208       }
00209     }
00210   else
00211     {
00212     for(k=1; k<=l1; k++)
00213       {
00214       for(i=0; i<ido-1; i+=2)
00215         {
00216         ac=i+(3*k-2)*ido;
00217         tr2=cc[ac]+cc[ac+ido];
00218         cr2=cc[ac-ido]+taur*tr2;
00219         ah=i+(k-1)*ido;
00220         ch[ah]=cc[ac-ido]+tr2;
00221         ti2=cc[ac+1]+cc[ac+ido+1];
00222         ci2=cc[ac-ido+1]+taur*ti2;
00223         ch[ah+1]=cc[ac-ido+1]+ti2;
00224         cr3=taui*(cc[ac]-cc[ac+ido]);
00225         ci3=taui*(cc[ac+1]-cc[ac+ido+1]);
00226         dr2=cr2-ci3;
00227         dr3=cr2+ci3;
00228         di2=ci2+cr3;
00229         di3=ci2-cr3;
00230         ch[ah+l1*ido+1]=wa1[i]*di2+wa1[i+1]*dr2;
00231         ch[ah+l1*ido]=wa1[i]*dr2-wa1[i+1]*di2;
00232         ch[ah+2*l1*ido+1]=wa2[i]*di3+wa2[i+1]*dr3;
00233         ch[ah+2*l1*ido]=wa2[i]*dr3-wa2[i+1]*di3;
00234         }
00235       }
00236     }
00237   }
00238 
00239 static void passf4(int ido, int l1, const double *cc, double *ch,
00240   const double *wa1, const double *wa2, const double *wa3)
00241   {
00242   int i, k, ac, ah;
00243   double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
00244         
00245   if(ido==2)
00246     {
00247     for(k=0; k<l1; k++)
00248       {
00249       ac=4*k*ido+1;
00250       ti1=cc[ac]-cc[ac+2*ido];
00251       ti2=cc[ac]+cc[ac+2*ido];
00252       tr4=cc[ac+3*ido]-cc[ac+ido];
00253       ti3=cc[ac+ido]+cc[ac+3*ido];
00254       tr1=cc[ac-1]-cc[ac+2*ido-1];
00255       tr2=cc[ac-1]+cc[ac+2*ido-1];
00256       ti4=cc[ac+ido-1]-cc[ac+3*ido-1];
00257       tr3=cc[ac+ido-1]+cc[ac+3*ido-1];
00258       ah=k*ido;
00259       ch[ah]=tr2+tr3;
00260       ch[ah+2*l1*ido]=tr2-tr3;
00261       ch[ah+1]=ti2+ti3;
00262       ch[ah+2*l1*ido+1]=ti2-ti3;
00263       ch[ah+l1*ido]=tr1-tr4;
00264       ch[ah+3*l1*ido]=tr1+tr4;
00265       ch[ah+l1*ido+1]=ti1-ti4;
00266       ch[ah+3*l1*ido+1]=ti1+ti4;
00267       }
00268     }
00269   else
00270     {
00271     for(k=0; k<l1; k++)
00272       {
00273       for(i=0; i<ido-1; i+=2)
00274         {
00275         ac=i+1+4*k*ido;
00276         ti1=cc[ac]-cc[ac+2*ido];
00277         ti2=cc[ac]+cc[ac+2*ido];
00278         ti3=cc[ac+ido]+cc[ac+3*ido];
00279         tr4=cc[ac+3*ido]-cc[ac+ido];
00280         tr1=cc[ac-1]-cc[ac+2*ido-1];
00281         tr2=cc[ac-1]+cc[ac+2*ido-1];
00282         ti4=cc[ac+ido-1]-cc[ac+3*ido-1];
00283         tr3=cc[ac+ido-1]+cc[ac+3*ido-1];
00284         ah=i+k*ido;
00285         ch[ah]=tr2+tr3;
00286         cr3=tr2-tr3;
00287         ch[ah+1]=ti2+ti3;
00288         ci3=ti2-ti3;
00289         cr2=tr1-tr4;
00290         cr4=tr1+tr4;
00291         ci2=ti1-ti4;
00292         ci4=ti1+ti4;
00293         ch[ah+l1*ido]=wa1[i]*cr2+wa1[i+1]*ci2;
00294         ch[ah+l1*ido+1]=wa1[i]*ci2-wa1[i+1]*cr2;
00295         ch[ah+2*l1*ido]=wa2[i]*cr3+wa2[i+1]*ci3;
00296         ch[ah+2*l1*ido+1]=wa2[i]*ci3-wa2[i+1]*cr3;
00297         ch[ah+3*l1*ido]=wa3[i]*cr4+wa3[i+1]*ci4;
00298         ch[ah+3*l1*ido+1]=wa3[i]*ci4-wa3[i+1]*cr4;
00299         }
00300       }
00301     }
00302   }
00303 
00304 static void passb4(int ido, int l1, const double *cc, double *ch,
00305   const double *wa1, const double *wa2, const double *wa3)
00306   {
00307   int i, k, ac, ah;
00308   double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
00309         
00310   if(ido==2)
00311     {
00312     for(k=0; k<l1; k++)
00313       {
00314       ac=4*k*ido+1;
00315       ti1=cc[ac]-cc[ac+2*ido];
00316       ti2=cc[ac]+cc[ac+2*ido];
00317       tr4=cc[ac+3*ido]-cc[ac+ido];
00318       ti3=cc[ac+ido]+cc[ac+3*ido];
00319       tr1=cc[ac-1]-cc[ac+2*ido-1];
00320       tr2=cc[ac-1]+cc[ac+2*ido-1];
00321       ti4=cc[ac+ido-1]-cc[ac+3*ido-1];
00322       tr3=cc[ac+ido-1]+cc[ac+3*ido-1];
00323       ah=k*ido;
00324       ch[ah]=tr2+tr3;
00325       ch[ah+2*l1*ido]=tr2-tr3;
00326       ch[ah+1]=ti2+ti3;
00327       ch[ah+2*l1*ido+1]=ti2-ti3;
00328       ch[ah+l1*ido]=tr1+tr4;
00329       ch[ah+3*l1*ido]=tr1-tr4;
00330       ch[ah+l1*ido+1]=ti1+ti4;
00331       ch[ah+3*l1*ido+1]=ti1-ti4;
00332       }
00333     }
00334   else
00335     {
00336     for(k=0; k<l1; k++)
00337       {
00338       for(i=0; i<ido-1; i+=2)
00339         {
00340         ac=i+1+4*k*ido;
00341         ti1=cc[ac]-cc[ac+2*ido];
00342         ti2=cc[ac]+cc[ac+2*ido];
00343         ti3=cc[ac+ido]+cc[ac+3*ido];
00344         tr4=cc[ac+3*ido]-cc[ac+ido];
00345         tr1=cc[ac-1]-cc[ac+2*ido-1];
00346         tr2=cc[ac-1]+cc[ac+2*ido-1];
00347         ti4=cc[ac+ido-1]-cc[ac+3*ido-1];
00348         tr3=cc[ac+ido-1]+cc[ac+3*ido-1];
00349         ah=i+k*ido;
00350         ch[ah]=tr2+tr3;
00351         cr3=tr2-tr3;
00352         ch[ah+1]=ti2+ti3;
00353         ci3=ti2-ti3;
00354         cr2=tr1+tr4;
00355         cr4=tr1-tr4;
00356         ci2=ti1+ti4;
00357         ci4=ti1-ti4;
00358         ch[ah+l1*ido]=wa1[i]*cr2-wa1[i+1]*ci2;
00359         ch[ah+l1*ido+1]=wa1[i]*ci2+wa1[i+1]*cr2;
00360         ch[ah+2*l1*ido]=wa2[i]*cr3-wa2[i+1]*ci3;
00361         ch[ah+2*l1*ido+1]=wa2[i]*ci3+wa2[i+1]*cr3;
00362         ch[ah+3*l1*ido]=wa3[i]*cr4-wa3[i+1]*ci4;
00363         ch[ah+3*l1*ido+1]=wa3[i]*ci4+wa3[i+1]*cr4;
00364         }
00365       }
00366     }
00367   }
00368 
00369 static void passf5(int ido, int l1, const double *cc, double *ch,
00370   const double *wa1, const double *wa2, const double *wa3,
00371   const double *wa4)
00372   {
00373   static const double tr11= 0.3090169943749474241, ti11=0.95105651629515357212;
00374   static const double tr12=-0.8090169943749474241, ti12=0.58778525229247312917;
00375   int i, k, ac, ah;
00376   double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
00377          ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
00378 
00379   if(ido==2)
00380     {
00381     for(k=1; k<=l1;++k)
00382       {
00383       ac=(5*k-4)*ido+1;
00384       ti5=cc[ac]-cc[ac+3*ido];
00385       ti2=cc[ac]+cc[ac+3*ido];
00386       ti4=cc[ac+ido]-cc[ac+2*ido];
00387       ti3=cc[ac+ido]+cc[ac+2*ido];
00388       tr5=cc[ac-1]-cc[ac+3*ido-1];
00389       tr2=cc[ac-1]+cc[ac+3*ido-1];
00390       tr4=cc[ac+ido-1]-cc[ac+2*ido-1];
00391       tr3=cc[ac+ido-1]+cc[ac+2*ido-1];
00392       ah=(k-1)*ido;
00393       ch[ah]=cc[ac-ido-1]+tr2+tr3;
00394       ch[ah+1]=cc[ac-ido]+ti2+ti3;
00395       cr2=cc[ac-ido-1]+tr11*tr2+tr12*tr3;
00396       ci2=cc[ac-ido]+tr11*ti2+tr12*ti3;
00397       cr3=cc[ac-ido-1]+tr12*tr2+tr11*tr3;
00398       ci3=cc[ac-ido]+tr12*ti2+tr11*ti3;
00399       cr5=-(ti11*tr5+ti12*tr4);
00400       ci5=-(ti11*ti5+ti12*ti4);
00401       cr4=-(ti12*tr5-ti11*tr4);
00402       ci4=-(ti12*ti5-ti11*ti4);
00403       ch[ah+l1*ido]=cr2-ci5;
00404       ch[ah+4*l1*ido]=cr2+ci5;
00405       ch[ah+l1*ido+1]=ci2+cr5;
00406       ch[ah+2*l1*ido+1]=ci3+cr4;
00407       ch[ah+2*l1*ido]=cr3-ci4;
00408       ch[ah+3*l1*ido]=cr3+ci4;
00409       ch[ah+3*l1*ido+1]=ci3-cr4;
00410       ch[ah+4*l1*ido+1]=ci2-cr5;
00411       }
00412     }
00413   else
00414     {
00415     for(k=1; k<=l1; k++)
00416       {
00417       for(i=0; i<ido-1; i+=2)
00418         {
00419         ac=i+1+(k*5-4)*ido;
00420         ti5=cc[ac]-cc[ac+3*ido];
00421         ti2=cc[ac]+cc[ac+3*ido];
00422         ti4=cc[ac+ido]-cc[ac+2*ido];
00423         ti3=cc[ac+ido]+cc[ac+2*ido];
00424         tr5=cc[ac-1]-cc[ac+3*ido-1];
00425         tr2=cc[ac-1]+cc[ac+3*ido-1];
00426         tr4=cc[ac+ido-1]-cc[ac+2*ido-1];
00427         tr3=cc[ac+ido-1]+cc[ac+2*ido-1];
00428         ah=i+(k-1)*ido;
00429         ch[ah]=cc[ac-ido-1]+tr2+tr3;
00430         ch[ah+1]=cc[ac-ido]+ti2+ti3;
00431         cr2=cc[ac-ido-1]+tr11*tr2+tr12*tr3;
00432 
00433         ci2=cc[ac-ido]+tr11*ti2+tr12*ti3;
00434         cr3=cc[ac-ido-1]+tr12*tr2+tr11*tr3;
00435 
00436         ci3=cc[ac-ido]+tr12*ti2+tr11*ti3;
00437         cr5=-(ti11*tr5+ti12*tr4);
00438         ci5=-(ti11*ti5+ti12*ti4);
00439         cr4=-(ti12*tr5-ti11*tr4);
00440         ci4=-(ti12*ti5-ti11*ti4);
00441         dr3=cr3-ci4;
00442         dr4=cr3+ci4;
00443         di3=ci3+cr4;
00444         di4=ci3-cr4;
00445         dr5=cr2+ci5;
00446         dr2=cr2-ci5;
00447         di5=ci2-cr5;
00448         di2=ci2+cr5;
00449         ch[ah+l1*ido]=wa1[i]*dr2+wa1[i+1]*di2;
00450         ch[ah+l1*ido+1]=wa1[i]*di2-wa1[i+1]*dr2;
00451         ch[ah+2*l1*ido]=wa2[i]*dr3+wa2[i+1]*di3;
00452         ch[ah+2*l1*ido+1]=wa2[i]*di3-wa2[i+1]*dr3;
00453         ch[ah+3*l1*ido]=wa3[i]*dr4+wa3[i+1]*di4;
00454         ch[ah+3*l1*ido+1]=wa3[i]*di4-wa3[i+1]*dr4;
00455         ch[ah+4*l1*ido]=wa4[i]*dr5+wa4[i+1]*di5;
00456         ch[ah+4*l1*ido+1]=wa4[i]*di5-wa4[i+1]*dr5;
00457         }
00458       }
00459     }
00460   }
00461 
00462 static void passb5(int ido, int l1, const double *cc, double *ch,
00463   const double *wa1, const double *wa2, const double *wa3,
00464   const double *wa4)
00465   {
00466   static const double tr11= 0.3090169943749474241, ti11=0.95105651629515357212;
00467   static const double tr12=-0.8090169943749474241, ti12=0.58778525229247312917;
00468   int i, k, ac, ah;
00469   double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
00470          ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
00471 
00472   if(ido==2)
00473     {
00474     for(k=1; k<=l1;++k)
00475       {
00476       ac=(5*k-4)*ido+1;
00477       ti5=cc[ac]-cc[ac+3*ido];
00478       ti2=cc[ac]+cc[ac+3*ido];
00479       ti4=cc[ac+ido]-cc[ac+2*ido];
00480       ti3=cc[ac+ido]+cc[ac+2*ido];
00481       tr5=cc[ac-1]-cc[ac+3*ido-1];
00482       tr2=cc[ac-1]+cc[ac+3*ido-1];
00483       tr4=cc[ac+ido-1]-cc[ac+2*ido-1];
00484       tr3=cc[ac+ido-1]+cc[ac+2*ido-1];
00485       ah=(k-1)*ido;
00486       ch[ah]=cc[ac-ido-1]+tr2+tr3;
00487       ch[ah+1]=cc[ac-ido]+ti2+ti3;
00488       cr2=cc[ac-ido-1]+tr11*tr2+tr12*tr3;
00489       ci2=cc[ac-ido]+tr11*ti2+tr12*ti3;
00490       cr3=cc[ac-ido-1]+tr12*tr2+tr11*tr3;
00491       ci3=cc[ac-ido]+tr12*ti2+tr11*ti3;
00492       cr5=ti11*tr5+ti12*tr4;
00493       ci5=ti11*ti5+ti12*ti4;
00494       cr4=ti12*tr5-ti11*tr4;
00495       ci4=ti12*ti5-ti11*ti4;
00496       ch[ah+l1*ido]=cr2-ci5;
00497       ch[ah+4*l1*ido]=cr2+ci5;
00498       ch[ah+l1*ido+1]=ci2+cr5;
00499       ch[ah+2*l1*ido+1]=ci3+cr4;
00500       ch[ah+2*l1*ido]=cr3-ci4;
00501       ch[ah+3*l1*ido]=cr3+ci4;
00502       ch[ah+3*l1*ido+1]=ci3-cr4;
00503       ch[ah+4*l1*ido+1]=ci2-cr5;
00504       }
00505     }
00506   else
00507     {
00508     for(k=1; k<=l1; k++)
00509       {
00510       for(i=0; i<ido-1; i+=2)
00511         {
00512         ac=i+1+(k*5-4)*ido;
00513         ti5=cc[ac]-cc[ac+3*ido];
00514         ti2=cc[ac]+cc[ac+3*ido];
00515         ti4=cc[ac+ido]-cc[ac+2*ido];
00516         ti3=cc[ac+ido]+cc[ac+2*ido];
00517         tr5=cc[ac-1]-cc[ac+3*ido-1];
00518         tr2=cc[ac-1]+cc[ac+3*ido-1];
00519         tr4=cc[ac+ido-1]-cc[ac+2*ido-1];
00520         tr3=cc[ac+ido-1]+cc[ac+2*ido-1];
00521         ah=i+(k-1)*ido;
00522         ch[ah]=cc[ac-ido-1]+tr2+tr3;
00523         ch[ah+1]=cc[ac-ido]+ti2+ti3;
00524         cr2=cc[ac-ido-1]+tr11*tr2+tr12*tr3;
00525 
00526         ci2=cc[ac-ido]+tr11*ti2+tr12*ti3;
00527         cr3=cc[ac-ido-1]+tr12*tr2+tr11*tr3;
00528 
00529         ci3=cc[ac-ido]+tr12*ti2+tr11*ti3;
00530         cr5=ti11*tr5+ti12*tr4;
00531         ci5=ti11*ti5+ti12*ti4;
00532         cr4=ti12*tr5-ti11*tr4;
00533         ci4=ti12*ti5-ti11*ti4;
00534         dr3=cr3-ci4;
00535         dr4=cr3+ci4;
00536         di3=ci3+cr4;
00537         di4=ci3-cr4;
00538         dr5=cr2+ci5;
00539         dr2=cr2-ci5;
00540         di5=ci2-cr5;
00541         di2=ci2+cr5;
00542         ch[ah+l1*ido]=wa1[i]*dr2-wa1[i+1]*di2;
00543         ch[ah+l1*ido+1]=wa1[i]*di2+wa1[i+1]*dr2;
00544         ch[ah+2*l1*ido]=wa2[i]*dr3-wa2[i+1]*di3;
00545         ch[ah+2*l1*ido+1]=wa2[i]*di3+wa2[i+1]*dr3;
00546         ch[ah+3*l1*ido]=wa3[i]*dr4-wa3[i+1]*di4;
00547         ch[ah+3*l1*ido+1]=wa3[i]*di4+wa3[i+1]*dr4;
00548         ch[ah+4*l1*ido]=wa4[i]*dr5-wa4[i+1]*di5;
00549         ch[ah+4*l1*ido+1]=wa4[i]*di5+wa4[i+1]*dr5;
00550         }
00551       }
00552     }
00553   }
00554 
00555 static void passfg(int *nac, int ido, int ip, int l1, int idl1,
00556   double *cc, double *ch, const double *wa)
00557   {
00558   int idij, idlj, ipph, i, j, k, l, jc, lc, ik, idj, idl, inc, idp, idx;
00559   double wai, war;
00560 
00561   ipph=(ip+1)/ 2;
00562   idp=ip*ido;
00563   for(j=1; j<ipph; j++)
00564     {
00565     jc=ip-j;
00566     for(k=0; k<l1; k++)
00567       {
00568       for(i=0; i<ido; i++)
00569         {
00570         ch[i+(k+j*l1)*ido] = cc[i+(j+k*ip)*ido]+cc[i+(jc+k*ip)*ido];
00571         ch[i+(k+jc*l1)*ido]= cc[i+(j+k*ip)*ido]-cc[i+(jc+k*ip)*ido];
00572         }
00573       }
00574     }
00575   for(k=0; k<l1; k++)
00576     memcpy (ch+k*ido, cc+k*ip*ido, ido*sizeof(double));
00577 
00578   idl=2-ido;
00579   inc=0;
00580   for(l=1; l<ipph; l++)
00581     {
00582     lc=ip-l;
00583     idl+=ido;
00584     for(ik=0; ik<idl1; ik++)
00585       {
00586       cc[ik+l*idl1]=ch[ik]+wa[idl-2]*ch[ik+idl1];
00587       cc[ik+lc*idl1]=-wa[idl-1]*ch[ik+(ip-1)*idl1];
00588       }
00589     idlj=idl;
00590     inc+=ido;
00591     for(j=2; j<ipph; j++)
00592       {
00593       jc=ip-j;
00594       idlj+=inc;
00595       if(idlj>idp)
00596         idlj-=idp;
00597       war=wa[idlj-2];
00598       wai=wa[idlj-1];
00599       for(ik=0; ik<idl1; ik++)
00600         {
00601         cc[ik+l*idl1]+=war*ch[ik+j*idl1];
00602         cc[ik+lc*idl1]-=wai*ch[ik+jc*idl1];
00603         }
00604       }
00605     }
00606   for(j=1; j<ipph; j++)
00607     for(ik=0; ik<idl1; ik++)
00608       ch[ik]+=ch[ik+j*idl1];
00609   for(j=1; j<ipph; j++)
00610     {
00611     jc=ip-j;
00612     for(ik=1; ik<idl1; ik+=2)
00613       {
00614       ch[ik-1+j *idl1]=cc[ik-1+j*idl1]-cc[ik  +jc*idl1];
00615       ch[ik-1+jc*idl1]=cc[ik-1+j*idl1]+cc[ik  +jc*idl1];
00616       ch[ik  +j *idl1]=cc[ik  +j*idl1]+cc[ik-1+jc*idl1];
00617       ch[ik  +jc*idl1]=cc[ik  +j*idl1]-cc[ik-1+jc*idl1];
00618       }
00619     }
00620   *nac=1;
00621   if(ido==2)
00622     return;
00623   *nac=0;
00624   for(ik=0; ik<idl1; ik++)
00625     cc[ik]=ch[ik];
00626   for(j=1; j<ip; j++)
00627     {
00628     for(k=0; k<l1; k++)
00629       {
00630       cc[(k+j*l1)*ido  ]=ch[(k+j*l1)*ido  ];
00631       cc[(k+j*l1)*ido+1]=ch[(k+j*l1)*ido+1];
00632       }
00633     }
00634 
00635   idj=2-ido;
00636   for(j=1; j<ip; j++)
00637     {
00638     idj+=ido;
00639     for(k=0; k<l1; k++)
00640       {
00641       idij=idj;
00642       for(i=3; i<ido; i+=2)
00643         {
00644         idij+=2;
00645         idx = (k+j*l1)*ido;
00646         cc[i-1+idx] = wa[idij-2]*ch[i-1+idx]+wa[idij-1]*ch[i  +idx];
00647         cc[i  +idx] = wa[idij-2]*ch[i  +idx]-wa[idij-1]*ch[i-1+idx];
00648         }
00649       }
00650     }
00651   }
00652 
00653 static void passbg(int *nac, int ido, int ip, int l1, int idl1,
00654   double *cc, double *ch, const double *wa)
00655   {
00656   int idij, idlj, ipph, i, j, k, l, jc, lc, ik, idj, idl, inc, idp, idx;
00657   double wai, war;
00658 
00659   ipph=(ip+1)/ 2;
00660   idp=ip*ido;
00661   for(j=1; j<ipph; j++)
00662     {
00663     jc=ip-j;
00664     for(k=0; k<l1; k++)
00665       {
00666       for(i=0; i<ido; i++)
00667         {
00668         ch[i+(k+j*l1)*ido] = cc[i+(j+k*ip)*ido]+cc[i+(jc+k*ip)*ido];
00669         ch[i+(k+jc*l1)*ido]= cc[i+(j+k*ip)*ido]-cc[i+(jc+k*ip)*ido];
00670         }
00671       }
00672     }
00673   for(k=0; k<l1; k++)
00674     memcpy (ch+k*ido, cc+k*ip*ido, ido*sizeof(double));
00675 
00676   idl=2-ido;
00677   inc=0;
00678   for(l=1; l<ipph; l++)
00679     {
00680     lc=ip-l;
00681     idl+=ido;
00682     for(ik=0; ik<idl1; ik++)
00683       {
00684       cc[ik+l*idl1]=ch[ik]+wa[idl-2]*ch[ik+idl1];
00685       cc[ik+lc*idl1]=wa[idl-1]*ch[ik+(ip-1)*idl1];
00686       }
00687     idlj=idl;
00688     inc+=ido;
00689     for(j=2; j<ipph; j++)
00690       {
00691       jc=ip-j;
00692       idlj+=inc;
00693       if(idlj>idp)
00694         idlj-=idp;
00695       war=wa[idlj-2];
00696       wai=wa[idlj-1];
00697       for(ik=0; ik<idl1; ik++)
00698         {
00699         cc[ik+l*idl1]+=war*ch[ik+j*idl1];
00700         cc[ik+lc*idl1]+=wai*ch[ik+jc*idl1];
00701         }
00702       }
00703     }
00704   for(j=1; j<ipph; j++)
00705     for(ik=0; ik<idl1; ik++)
00706       ch[ik]+=ch[ik+j*idl1];
00707   for(j=1; j<ipph; j++)
00708     {
00709     jc=ip-j;
00710     for(ik=1; ik<idl1; ik+=2)
00711       {
00712       ch[ik-1+j *idl1]=cc[ik-1+j*idl1]-cc[ik  +jc*idl1];
00713       ch[ik-1+jc*idl1]=cc[ik-1+j*idl1]+cc[ik  +jc*idl1];
00714       ch[ik  +j *idl1]=cc[ik  +j*idl1]+cc[ik-1+jc*idl1];
00715       ch[ik  +jc*idl1]=cc[ik  +j*idl1]-cc[ik-1+jc*idl1];
00716       }
00717     }
00718   *nac=1;
00719   if(ido==2)
00720     return;
00721   *nac=0;
00722   for(ik=0; ik<idl1; ik++)
00723     cc[ik]=ch[ik];
00724   for(j=1; j<ip; j++)
00725     {
00726     for(k=0; k<l1; k++)
00727       {
00728       cc[(k+j*l1)*ido  ]=ch[(k+j*l1)*ido  ];
00729       cc[(k+j*l1)*ido+1]=ch[(k+j*l1)*ido+1];
00730       }
00731     }
00732 
00733   idj=2-ido;
00734   for(j=1; j<ip; j++)
00735     {
00736     idj+=ido;
00737     for(k=0; k<l1; k++)
00738       {
00739       idij=idj;
00740       for(i=3; i<ido; i+=2)
00741         {
00742         idij+=2;
00743         idx = (k+j*l1)*ido;
00744         cc[i-1+idx] = wa[idij-2]*ch[i-1+idx]-wa[idij-1]*ch[i  +idx];
00745         cc[i  +idx] = wa[idij-2]*ch[i  +idx]+wa[idij-1]*ch[i-1+idx];
00746         }
00747       }
00748     }
00749   }
00750 
00751 
00752 static void radf2 (int ido, int l1, const double *cc, double *ch,
00753   const double *wa1)
00754   {
00755   int i, k, ic;
00756   double ti2, tr2;
00757 
00758   for(k=0; k<l1; k++)
00759     {
00760     ch[2*k*ido] = cc[k*ido]+cc[(k+l1)*ido];
00761     ch[(2*k+1)*ido+ido-1] = cc[k*ido]-cc[(k+l1)*ido];
00762     }
00763   if(ido<2)
00764     return;
00765   if(ido !=2)
00766     {
00767     for(k=0; k<l1; k++)
00768       {
00769       for(i=2; i<ido; i+=2)
00770         {
00771         ic=ido-i;
00772         tr2=wa1[i-2]*cc[i-1+(k+l1)*ido]+wa1[i-1]*cc[i+(k+l1)*ido];
00773         ti2=wa1[i-2]*cc[i+(k+l1)*ido]-wa1[i-1]*cc[i-1+(k+l1)*ido];
00774         ch[i+2*k*ido]=cc[i+k*ido]+ti2;
00775         ch[ic+(2*k+1)*ido]=ti2-cc[i+k*ido];
00776         ch[i-1+2*k*ido]=cc[i-1+k*ido]+tr2;
00777         ch[ic-1+(2*k+1)*ido]=cc[i-1+k*ido]-tr2;
00778         }
00779       }
00780     if(ido%2==1)
00781       return;
00782     }
00783   for(k=0; k<l1; k++)
00784     {
00785     ch[(2*k+1)*ido] = -cc[ido-1+(k+l1)*ido];
00786     ch[ido-1+2*k*ido] = cc[ido-1+k*ido];
00787     }
00788   }
00789 
00790 static void radb2(int ido, int l1, const double *cc, double *ch,
00791   const double *wa1)
00792   {
00793   int i, k, ic;
00794   double ti2, tr2;
00795 
00796   for(k=0; k<l1; k++)
00797     {
00798     ch[k*ido] = cc[2*k*ido]+cc[ido-1+(2*k+1)*ido];
00799     ch[(k+l1)*ido] = cc[2*k*ido]-cc[ido-1+(2*k+1)*ido];
00800     }
00801   if(ido<2)
00802     return;
00803   if(ido !=2)
00804     {
00805     for(k=0; k<l1;++k)
00806       {
00807       for(i=2; i<ido; i+=2)
00808         {
00809         ic=ido-i;
00810         ch[i-1+k*ido] = cc[i-1+2*k*ido]+cc[ic-1+(2*k+1)*ido];
00811         tr2 = cc[i-1+2*k*ido]-cc[ic-1+(2*k+1)*ido];
00812         ch[i+k*ido] = cc[i+2*k*ido]-cc[ic+(2*k+1)*ido];
00813         ti2 = cc[i+(2*k)*ido]+cc[ic+(2*k+1)*ido];
00814         ch[i-1+(k+l1)*ido] = wa1[i-2]*tr2-wa1[i-1]*ti2;
00815         ch[i+(k+l1)*ido] = wa1[i-2]*ti2+wa1[i-1]*tr2;
00816         }
00817       }
00818     if(ido%2==1)
00819       return;
00820     }
00821   for(k=0; k<l1; k++)
00822     {
00823     ch[ido-1+k*ido]=2*cc[ido-1+2*k*ido];
00824     ch[ido-1+(k+l1)*ido]=-2*cc[(2*k+1)*ido];
00825     }
00826   }
00827 
00828 static void radf3(int ido, int l1, const double *cc, double *ch,
00829   const double *wa1, const double *wa2)
00830   {
00831   static const double taur=-0.5, taui=0.86602540378443864676;
00832   int i, k, ic;
00833   double ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
00834 
00835   for(k=0; k<l1; k++)
00836     {
00837     cr2=cc[(k+l1)*ido]+cc[(k+2*l1)*ido];
00838     ch[3*k*ido]=cc[k*ido]+cr2;
00839     ch[(3*k+2)*ido]=taui*(cc[(k+l1*2)*ido]-cc[(k+l1)*ido]);
00840     ch[ido-1+(3*k+1)*ido]=cc[k*ido]+taur*cr2;
00841     }
00842   if(ido==1)
00843     return;
00844   for(k=0; k<l1; k++)
00845     {
00846     for(i=2; i<ido; i+=2)
00847       {
00848       ic=ido-i;
00849       dr2=wa1[i-2]*cc[i-1+(k+l1)*ido]+
00850           wa1[i-1]*cc[i+(k+l1)*ido];
00851       di2=wa1[i-2]*cc[i+(k+l1)*ido]-wa1[i-1]*cc[i-1+(k+l1)*ido];
00852       dr3=wa2[i-2]*cc[i-1+(k+l1*2)*ido]+wa2[i-1]*cc[i+(k+l1*2)*ido];
00853       di3=wa2[i-2]*cc[i+(k+l1*2)*ido]-wa2[i-1]*cc[i-1+(k+l1*2)*ido];
00854       cr2=dr2+dr3;
00855       ci2=di2+di3;
00856       ch[i-1+3*k*ido]=cc[i-1+k*ido]+cr2;
00857       ch[i+3*k*ido]=cc[i+k*ido]+ci2;
00858       tr2=cc[i-1+k*ido]+taur*cr2;
00859       ti2=cc[i+k*ido]+taur*ci2;
00860       tr3=taui*(di2-di3);
00861       ti3=taui*(dr3-dr2);
00862       ch[i-1+(3*k+2)*ido]=tr2+tr3;
00863       ch[ic-1+(3*k+1)*ido]=tr2-tr3;
00864       ch[i+(3*k+2)*ido]=ti2+ti3;
00865       ch[ic+(3*k+1)*ido]=ti3-ti2;
00866       }
00867     }
00868   }
00869 
00870 static void radb3(int ido, int l1, const double *cc, double *ch,
00871   const double *wa1, const double *wa2)
00872   {
00873   static const double taur=-0.5, taui=0.86602540378443864676;
00874   int i, k, ic;
00875   double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
00876 
00877   for(k=0; k<l1; k++)
00878     {
00879     tr2=2*cc[ido-1+(3*k+1)*ido];
00880     cr2=cc[3*k*ido]+taur*tr2;
00881     ch[k*ido]=cc[3*k*ido]+tr2;
00882     ci3=2*taui*cc[(3*k+2)*ido];
00883     ch[(k+l1)*ido]=cr2-ci3;
00884     ch[(k+2*l1)*ido]=cr2+ci3;
00885     }
00886   if(ido==1)
00887     return;
00888   for(k=0; k<l1; k++)
00889     {
00890     for(i=2; i<ido; i+=2)
00891       {
00892       ic=ido-i;
00893       tr2=cc[i-1+(3*k+2)*ido]+cc[ic-1+(3*k+1)*ido];
00894       cr2=cc[i-1+3*k*ido]+taur*tr2;
00895       ch[i-1+k*ido]=cc[i-1+3*k*ido]+tr2;
00896       ti2=cc[i+(3*k+2)*ido]-cc[ic+(3*k+1)*ido];
00897       ci2=cc[i+3*k*ido]+taur*ti2;
00898       ch[i+k*ido]=cc[i+3*k*ido]+ti2;
00899       cr3=taui*(cc[i-1+(3*k+2)*ido]-cc[ic-1+(3*k+1)*ido]);
00900       ci3=taui*(cc[i+(3*k+2)*ido]+cc[ic+(3*k+1)*ido]);
00901       dr2=cr2-ci3;
00902       dr3=cr2+ci3;
00903       di2=ci2+cr3;
00904       di3=ci2-cr3;
00905       ch[i-1+(k+l1)*ido]=wa1[i-2]*dr2-wa1[i-1]*di2;
00906       ch[i+(k+l1)*ido]=wa1[i-2]*di2+wa1[i-1]*dr2;
00907       ch[i-1+(k+2*l1)*ido]=wa2[i-2]*dr3-wa2[i-1]*di3;
00908       ch[i+(k+2*l1)*ido]=wa2[i-2]*di3+wa2[i-1]*dr3;
00909       }
00910     }
00911   }
00912 
00913 static void radf4(int ido, int l1, const double *cc, double *ch,
00914   const double *wa1, const double *wa2, const double *wa3)
00915   {
00916   static const double hsqt2=0.70710678118654752440;
00917   int i, k, ic;
00918   double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
00919 
00920   for(k=0; k<l1; k++)
00921     {
00922     tr1=cc[(k+l1)*ido]+cc[(k+3*l1)*ido];
00923     tr2=cc[k*ido]+cc[(k+2*l1)*ido];
00924     ch[4*k*ido]=tr1+tr2;
00925     ch[ido-1+(4*k+3)*ido]=tr2-tr1;
00926     ch[ido-1+(4*k+1)*ido]=cc[k*ido]-cc[(k+2*l1)*ido];
00927     ch[(4*k+2)*ido]=cc[(k+3*l1)*ido]-cc[(k+l1)*ido];
00928     }
00929   if(ido<2)
00930     return;
00931   if(ido !=2)
00932     {
00933     for(k=0; k<l1; k++)
00934       {
00935       for(i=2; i<ido; i+=2)
00936         {
00937         ic=ido-i;
00938         cr2=wa1[i-2]*cc[i-1+(k+l1)*ido]+wa1[i-1]*cc[i+(k+l1)*ido];
00939         ci2=wa1[i-2]*cc[i+(k+l1)*ido]-wa1[i-1]*cc[i-1+(k+l1)*ido];
00940         cr3=wa2[i-2]*cc[i-1+(k+2*l1)*ido]+wa2[i-1]*cc[i+(k+2*l1)*ido];
00941         ci3=wa2[i-2]*cc[i+(k+2*l1)*ido]-wa2[i-1]*cc[i-1+(k+2*l1)*ido];
00942         cr4=wa3[i-2]*cc[i-1+(k+3*l1)*ido]+wa3[i-1]*cc[i+(k+3*l1)*ido];
00943         ci4=wa3[i-2]*cc[i+(k+3*l1)*ido]-wa3[i-1]*cc[i-1+(k+3*l1)*ido];
00944         tr1=cr2+cr4;
00945         tr4=cr4-cr2;
00946         ti1=ci2+ci4;
00947         ti4=ci2-ci4;
00948         ti2=cc[i+k*ido]+ci3;
00949         ti3=cc[i+k*ido]-ci3;
00950         tr2=cc[i-1+k*ido]+cr3;
00951         tr3=cc[i-1+k*ido]-cr3;
00952         ch[i-1+4*k*ido]=tr1+tr2;
00953         ch[ic-1+(4*k+3)*ido]=tr2-tr1;
00954         ch[i+4*k*ido]=ti1+ti2;
00955         ch[ic+(4*k+3)*ido]=ti1-ti2;
00956         ch[i-1+(4*k+2)*ido]=ti4+tr3;
00957         ch[ic-1+(4*k+1)*ido]=tr3-ti4;
00958         ch[i+(4*k+2)*ido]=tr4+ti3;
00959         ch[ic+(4*k+1)*ido]=tr4-ti3;
00960         }
00961       }
00962     if(ido%2==1)
00963       return;
00964     }
00965   for(k=0; k<l1; k++)
00966     {
00967     ti1=-hsqt2*(cc[ido-1+(k+l1)*ido]+cc[ido-1+(k+3*l1)*ido]);
00968     tr1=hsqt2*(cc[ido-1+(k+l1)*ido]-cc[ido-1+(k+3*l1)*ido]);
00969     ch[ido-1+4*k*ido]=tr1+cc[ido-1+k*ido];
00970     ch[ido-1+(4*k+2)*ido]=cc[ido-1+k*ido]-tr1;
00971     ch[(4*k+1)*ido]=ti1-cc[ido-1+(k+2*l1)*ido];
00972     ch[(4*k+3)*ido]=ti1+cc[ido-1+(k+2*l1)*ido];
00973     }
00974   }
00975 
00976 static void radb4(int ido, int l1, const double *cc, double *ch,
00977   const double *wa1, const double *wa2, const double *wa3)
00978   {
00979   static const double sqrt2=1.41421356237309504880;
00980   int i, k, ic;
00981   double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
00982 
00983   for(k=0; k<l1; k++)
00984     {
00985     tr1=cc[4*k*ido]-cc[ido-1+(4*k+3)*ido];
00986     tr2=cc[4*k*ido]+cc[ido-1+(4*k+3)*ido];
00987     tr3=cc[ido-1+(4*k+1)*ido]+cc[ido-1+(4*k+1)*ido];
00988     tr4=cc[(4*k+2)*ido]+cc[(4*k+2)*ido];
00989     ch[k*ido]=tr2+tr3;
00990     ch[(k+l1)*ido]=tr1-tr4;
00991     ch[(k+2*l1)*ido]=tr2-tr3;
00992     ch[(k+3*l1)*ido]=tr1+tr4;
00993     }
00994   if(ido<2)
00995     return;
00996   if(ido !=2)
00997     {
00998     for(k=0; k<l1;++k)
00999       {
01000       for(i=2; i<ido; i+=2)
01001         {
01002         ic=ido-i;
01003         ti1=cc[i+4*k*ido]+cc[ic+(4*k+3)*ido];
01004         ti2=cc[i+4*k*ido]-cc[ic+(4*k+3)*ido];
01005         ti3=cc[i+(4*k+2)*ido]-cc[ic+(4*k+1)*ido];
01006         tr4=cc[i+(4*k+2)*ido]+cc[ic+(4*k+1)*ido];
01007         tr1=cc[i-1+4*k*ido]-cc[ic-1+(4*k+3)*ido];
01008         tr2=cc[i-1+4*k*ido]+cc[ic-1+(4*k+3)*ido];
01009         ti4=cc[i-1+(4*k+2)*ido]-cc[ic-1+(4*k+1)*ido];
01010         tr3=cc[i-1+(4*k+2)*ido]+cc[ic-1+(4*k+1)*ido];
01011         ch[i-1+k*ido]=tr2+tr3;
01012         cr3=tr2-tr3;
01013         ch[i+k*ido]=ti2+ti3;
01014         ci3=ti2-ti3;
01015         cr2=tr1-tr4;
01016         cr4=tr1+tr4;
01017         ci2=ti1+ti4;
01018         ci4=ti1-ti4;
01019         ch[i-1+(k+l1)*ido]=wa1[i-2]*cr2-wa1[i-1]*ci2;
01020         ch[i+(k+l1)*ido]=wa1[i-2]*ci2+wa1[i-1]*cr2;
01021         ch[i-1+(k+2*l1)*ido]=wa2[i-2]*cr3-wa2[i-1]*ci3;
01022         ch[i+(k+2*l1)*ido]=wa2[i-2]*ci3+wa2[i-1]*cr3;
01023         ch[i-1+(k+3*l1)*ido]=wa3[i-2]*cr4-wa3[i-1]*ci4;
01024         ch[i+(k+3*l1)*ido]=wa3[i-2]*ci4+wa3[i-1]*cr4;
01025         }
01026       }
01027     if(ido%2==1)
01028       return;
01029     }
01030   for(k=0; k<l1; k++)
01031     {
01032     ti1=cc[(4*k+1)*ido]+cc[(4*k+3)*ido];
01033     ti2=cc[(4*k+3)*ido]-cc[(4*k+1)*ido];
01034     tr1=cc[ido-1+4*k*ido]-cc[ido-1+(4*k+2)*ido];
01035     tr2=cc[ido-1+4*k*ido]+cc[ido-1+(4*k+2)*ido];
01036     ch[ido-1+k*ido]=tr2+tr2;
01037     ch[ido-1+(k+l1)*ido]=sqrt2*(tr1-ti1);
01038     ch[ido-1+(k+2*l1)*ido]=ti2+ti2;
01039     ch[ido-1+(k+3*l1)*ido]=-sqrt2*(tr1+ti1);
01040     }
01041   }
01042 
01043 static void radf5(int ido, int l1, const double *cc, double *ch,
01044   const double *wa1, const double *wa2, const double *wa3, const double *wa4)
01045   {
01046   static const double tr11=0.3090169943749474241;
01047   static const double ti11=0.95105651629515357212;
01048   static const double tr12=-0.8090169943749474241;
01049   static const double ti12=0.58778525229247312917;
01050   int i, k, ic;
01051   double ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3,
01052          dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
01053 
01054   for(k=0; k<l1; k++)
01055     {
01056     cr2=cc[(k+4*l1)*ido]+cc[(k+l1)*ido];
01057     ci5=cc[(k+4*l1)*ido]-cc[(k+l1)*ido];
01058     cr3=cc[(k+3*l1)*ido]+cc[(k+2*l1)*ido];
01059     ci4=cc[(k+3*l1)*ido]-cc[(k+2*l1)*ido];
01060     ch[5*k*ido]=cc[k*ido]+cr2+cr3;
01061     ch[ido-1+(5*k+1)*ido]=cc[k*ido]+tr11*cr2+tr12*cr3;
01062     ch[(5*k+2)*ido]=ti11*ci5+ti12*ci4;
01063     ch[ido-1+(5*k+3)*ido]=cc[k*ido]+tr12*cr2+tr11*cr3;
01064     ch[(5*k+4)*ido]=ti12*ci5-ti11*ci4;
01065     }
01066   if(ido==1)
01067     return;
01068   for(k=0; k<l1;++k)
01069     {
01070     for(i=2; i<ido; i+=2)
01071       {
01072       ic=ido-i;
01073       dr2=wa1[i-2]*cc[i-1+(k+l1)*ido]+wa1[i-1]*cc[i+(k+l1)*ido];
01074       di2=wa1[i-2]*cc[i+(k+l1)*ido]-wa1[i-1]*cc[i-1+(k+l1)*ido];
01075       dr3=wa2[i-2]*cc[i-1+(k+2*l1)*ido]+wa2[i-1]*cc[i+(k+2*l1)*ido];
01076       di3=wa2[i-2]*cc[i+(k+2*l1)*ido]-wa2[i-1]*cc[i-1+(k+2*l1)*ido];
01077       dr4=wa3[i-2]*cc[i-1+(k+3*l1)*ido]+wa3[i-1]*cc[i+(k+3*l1)*ido];
01078       di4=wa3[i-2]*cc[i+(k+3*l1)*ido]-wa3[i-1]*cc[i-1+(k+3*l1)*ido];
01079       dr5=wa4[i-2]*cc[i-1+(k+4*l1)*ido]+wa4[i-1]*cc[i+(k+4*l1)*ido];
01080       di5=wa4[i-2]*cc[i+(k+4*l1)*ido]-wa4[i-1]*cc[i-1+(k+4*l1)*ido];
01081       cr2=dr2+dr5;
01082       ci5=dr5-dr2;
01083       cr5=di2-di5;
01084       ci2=di2+di5;
01085       cr3=dr3+dr4;
01086       ci4=dr4-dr3;
01087       cr4=di3-di4;
01088       ci3=di3+di4;
01089       ch[i-1+5*k*ido]=cc[i-1+k*ido]+cr2+cr3;
01090       ch[i+5*k*ido]=cc[i+k*ido]+ci2+ci3;
01091       tr2=cc[i-1+k*ido]+tr11*cr2+tr12*cr3;
01092       ti2=cc[i+k*ido]+tr11*ci2+tr12*ci3;
01093       tr3=cc[i-1+k*ido]+tr12*cr2+tr11*cr3;
01094       ti3=cc[i+k*ido]+tr12*ci2+tr11*ci3;
01095       tr5=ti11*cr5+ti12*cr4;
01096       ti5=ti11*ci5+ti12*ci4;
01097       tr4=ti12*cr5-ti11*cr4;
01098       ti4=ti12*ci5-ti11*ci4;
01099       ch[i-1+(5*k+2)*ido]=tr2+tr5;
01100       ch[ic-1+(5*k+1)*ido]=tr2-tr5;
01101       ch[i+(5*k+2)*ido]=ti2+ti5;
01102       ch[ic+(5*k+1)*ido]=ti5-ti2;
01103       ch[i-1+(5*k+4)*ido]=tr3+tr4;
01104       ch[ic-1+(5*k+3)*ido]=tr3-tr4;
01105       ch[i+(5*k+4)*ido]=ti3+ti4;
01106       ch[ic+(5*k+3)*ido]=ti4-ti3;
01107       }
01108     }
01109   }
01110 
01111 static void radb5(int ido, int l1, const double *cc, double *ch,
01112   const double *wa1, const double *wa2, const double *wa3, const double *wa4)
01113   {
01114   static const double tr11=0.3090169943749474241;
01115   static const double ti11=0.95105651629515357212;
01116   static const double tr12=-0.8090169943749474241;
01117   static const double ti12=0.58778525229247312917;
01118   int i, k, ic;
01119   double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
01120           ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
01121 
01122   for(k=0; k<l1; k++)
01123     {
01124     ti5=2*cc[(5*k+2)*ido];
01125     ti4=2*cc[(5*k+4)*ido];
01126     tr2=2*cc[ido-1+(5*k+1)*ido];
01127     tr3=2*cc[ido-1+(5*k+3)*ido];
01128     ch[k*ido]=cc[5*k*ido]+tr2+tr3;
01129     cr2=cc[5*k*ido]+tr11*tr2+tr12*tr3;
01130     cr3=cc[5*k*ido]+tr12*tr2+tr11*tr3;
01131     ci5=ti11*ti5+ti12*ti4;
01132     ci4=ti12*ti5-ti11*ti4;
01133     ch[(k+l1)*ido]=cr2-ci5;
01134     ch[(k+2*l1)*ido]=cr3-ci4;
01135     ch[(k+3*l1)*ido]=cr3+ci4;
01136     ch[(k+4*l1)*ido]=cr2+ci5;
01137     }
01138   if(ido==1)
01139     return;
01140   for(k=0; k<l1;++k)
01141     {
01142     for(i=2; i<ido; i+=2)
01143       {
01144       ic=ido-i;
01145       ti5=cc[i+(5*k+2)*ido]+cc[ic+(5*k+1)*ido];
01146       ti2=cc[i+(5*k+2)*ido]-cc[ic+(5*k+1)*ido];
01147       ti4=cc[i+(5*k+4)*ido]+cc[ic+(5*k+3)*ido];
01148       ti3=cc[i+(5*k+4)*ido]-cc[ic+(5*k+3)*ido];
01149       tr5=cc[i-1+(5*k+2)*ido]-cc[ic-1+(5*k+1)*ido];
01150       tr2=cc[i-1+(5*k+2)*ido]+cc[ic-1+(5*k+1)*ido];
01151       tr4=cc[i-1+(5*k+4)*ido]-cc[ic-1+(5*k+3)*ido];
01152       tr3=cc[i-1+(5*k+4)*ido]+cc[ic-1+(5*k+3)*ido];
01153       ch[i-1+k*ido]=cc[i-1+5*k*ido]+tr2+tr3;
01154       ch[i+k*ido]=cc[i+5*k*ido]+ti2+ti3;
01155       cr2=cc[i-1+5*k*ido]+tr11*tr2+tr12*tr3;
01156 
01157       ci2=cc[i+5*k*ido]+tr11*ti2+tr12*ti3;
01158       cr3=cc[i-1+5*k*ido]+tr12*tr2+tr11*tr3;
01159 
01160       ci3=cc[i+5*k*ido]+tr12*ti2+tr11*ti3;
01161       cr5=ti11*tr5+ti12*tr4;
01162       ci5=ti11*ti5+ti12*ti4;
01163       cr4=ti12*tr5-ti11*tr4;
01164       ci4=ti12*ti5-ti11*ti4;
01165       dr3=cr3-ci4;
01166       dr4=cr3+ci4;
01167       di3=ci3+cr4;
01168       di4=ci3-cr4;
01169       dr5=cr2+ci5;
01170       dr2=cr2-ci5;
01171       di5=ci2-cr5;
01172       di2=ci2+cr5;
01173       ch[i-1+(k+l1)*ido]=wa1[i-2]*dr2-wa1[i-1]*di2;
01174       ch[i+(k+l1)*ido]=wa1[i-2]*di2+wa1[i-1]*dr2;
01175       ch[i-1+(k+2*l1)*ido]=wa2[i-2]*dr3-wa2[i-1]*di3;
01176       ch[i+(k+2*l1)*ido]=wa2[i-2]*di3+wa2[i-1]*dr3;
01177       ch[i-1+(k+3*l1)*ido]=wa3[i-2]*dr4-wa3[i-1]*di4;
01178       ch[i+(k+3*l1)*ido]=wa3[i-2]*di4+wa3[i-1]*dr4;
01179       ch[i-1+(k+4*l1)*ido]=wa4[i-2]*dr5-wa4[i-1]*di5;
01180       ch[i+(k+4*l1)*ido]=wa4[i-2]*di5+wa4[i-1]*dr5;
01181       }
01182     }
01183   }
01184 
01185 static void radfg(int ido, int ip, int l1, int idl1,
01186   double *cc, double *ch, const double *wa)
01187   {
01188   static const double twopi=6.28318530717958647692;
01189   int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is;
01190   double ai1, ai2, ar1, ar2, arg;
01191   double *csarr;
01192   int aidx;
01193 
01194   ipph=(ip+1)/ 2;
01195   if(ido !=1)
01196     {
01197     for(ik=0; ik<idl1; ik++)
01198       ch[ik]=cc[ik];
01199     for(j=1; j<ip; j++)
01200       for(k=0; k<l1; k++)
01201         ch[(k+j*l1)*ido]=cc[(k+j*l1)*ido];
01202 
01203     is=-ido;
01204     for(j=1; j<ip; j++)
01205       {
01206       is+=ido;
01207       for(k=0; k<l1; k++)
01208         {
01209         idij=is-1;
01210         for(i=2; i<ido; i+=2)
01211           {
01212           idij+=2;
01213           ch[i-1+(k+j*l1)*ido]=
01214             wa[idij-1]*cc[i-1+(k+j*l1)*ido]+wa[idij]*cc[i+(k+j*l1)*ido];
01215           ch[i+(k+j*l1)*ido]=
01216             wa[idij-1]*cc[i+(k+j*l1)*ido]-wa[idij]*cc[i-1+(k+j*l1)*ido];
01217           }
01218         }
01219       }
01220 
01221     for(j=1; j<ipph; j++)
01222       {
01223       jc=ip-j;
01224       for(k=0; k<l1; k++)
01225         {
01226         for(i=2; i<ido; i+=2)
01227           {
01228           cc[i-1+(k+j*l1)*ido]=ch[i-1+(k+j*l1)*ido]+ch[i-1+(k+jc*l1)*ido];
01229           cc[i-1+(k+jc*l1)*ido]=ch[i+(k+j*l1)*ido]-ch[i+(k+jc*l1)*ido];
01230           cc[i+(k+j*l1)*ido]=ch[i+(k+j*l1)*ido]+ch[i+(k+jc*l1)*ido];
01231           cc[i+(k+jc*l1)*ido]=ch[i-1+(k+jc*l1)*ido]-ch[i-1+(k+j*l1)*ido];
01232           }
01233         }
01234       }
01235     }
01236   else
01237     {                           /*now ido==1*/
01238     for(ik=0; ik<idl1; ik++)
01239       cc[ik]=ch[ik];
01240     }
01241   for(j=1; j<ipph; j++)
01242     {
01243     jc=ip-j;
01244     for(k=0; k<l1; k++)
01245       {
01246       cc[(k+j*l1)*ido]=ch[(k+j*l1)*ido]+ch[(k+jc*l1)*ido];
01247       cc[(k+jc*l1)*ido]=ch[(k+jc*l1)*ido]-ch[(k+j*l1)*ido];
01248       }
01249     }
01250 
01251   csarr=(double *)malloc(2*ip*sizeof(double));
01252   arg=twopi / ip;
01253   csarr[0]=1.;
01254   csarr[1]=0.;
01255   csarr[2]=csarr[2*ip-2]=cos(arg);
01256   csarr[3]=sin(arg); csarr[2*ip-1]=-csarr[3];
01257   for (i=2; i<=ip/2; ++i)
01258     {
01259     csarr[2*i]=csarr[2*ip-2*i]=cos(i*arg);
01260     csarr[2*i+1]=sin(i*arg);
01261     csarr[2*ip-2*i+1]=-csarr[2*i+1];
01262     }
01263   for(l=1; l<ipph; l++)
01264     {
01265     lc=ip-l;
01266     ar1=csarr[2*l];
01267     ai1=csarr[2*l+1];
01268     for(ik=0; ik<idl1; ik++)
01269       {
01270       ch[ik+l*idl1]=cc[ik]+ar1*cc[ik+idl1];
01271       ch[ik+lc*idl1]=ai1*cc[ik+(ip-1)*idl1];
01272       }
01273     aidx=2*l;
01274     for(j=2; j<ipph; j++)
01275       {
01276       jc=ip-j;
01277       aidx+=2*l;
01278       if (aidx>=2*ip) aidx-=2*ip;
01279       ar2=csarr[aidx];
01280       ai2=csarr[aidx+1];
01281       for(ik=0; ik<idl1; ik++)
01282         {
01283         ch[ik+l*idl1]+=ar2*cc[ik+j*idl1];
01284         ch[ik+lc*idl1]+=ai2*cc[ik+jc*idl1];
01285         }
01286       }
01287     }
01288   free(csarr);
01289 
01290   for(j=1; j<ipph; j++)
01291     for(ik=0; ik<idl1; ik++)
01292       ch[ik]+=cc[ik+j*idl1];
01293 
01294   for(k=0; k<l1; k++)
01295     for(i=0; i<ido; i++)
01296       cc[i+k*ip*ido]=ch[i+k*ido];
01297   for(j=1; j<ipph; j++)
01298     {
01299     jc=ip-j;
01300     j2=2*j;
01301     for(k=0; k<l1; k++)
01302       {
01303       cc[ido-1+(j2-1+k*ip)*ido] = ch[(k+j*l1)*ido];
01304       cc[(j2+k*ip)*ido] = ch[(k+jc*l1)*ido];
01305       }
01306     }
01307   if(ido==1)
01308     return;
01309 
01310   for(j=1; j<ipph; j++)
01311     {
01312     jc=ip-j;
01313     j2=2*j;
01314     for(k=0; k<l1; k++)
01315       {
01316       for(i=2; i<ido; i+=2)
01317         {
01318         ic=ido-i;
01319         cc[i-1+(j2+k*ip)*ido]=ch[i-1+(k+j*l1)*ido]+ch[i-1+(k+jc*l1)*ido];
01320         cc[ic-1+(j2-1+k*ip)*ido]=ch[i-1+(k+j*l1)*ido]-ch[i-1+(k+jc*l1)*ido];
01321         cc[i+(j2+k*ip)*ido]=ch[i+(k+j*l1)*ido]+ch[i+(k+jc*l1)*ido];
01322         cc[ic+(j2-1+k*ip)*ido]=ch[i+(k+jc*l1)*ido]-ch[i+(k+j*l1)*ido];
01323         }
01324       }
01325     }
01326   }
01327 
01328 static void radbg(int ido, int ip, int l1, int idl1,
01329   double *cc, double *ch, const double *wa)
01330   {
01331   static const double twopi=6.28318530717958647692;
01332   int     idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is;
01333   double ai1, ai2, ar1, ar2, arg;
01334   double *csarr;
01335   int aidx;
01336 
01337   ipph=(ip+1)/ 2;
01338   for(k=0; k<l1; k++)
01339     for(i=0; i<ido; i++)
01340       ch[i+k*ido]=cc[i+k*ip*ido];
01341   for(j=1; j<ipph; j++)
01342     {
01343     jc=ip-j;
01344     j2=2*j;
01345     for(k=0; k<l1; k++)
01346       {
01347       ch[(k+j*l1)*ido]=cc[ido-1+(j2-1+k*ip)*ido]+cc[ido-1+(j2-1+k*ip)*ido];
01348       ch[(k+jc*l1)*ido]=cc[(j2+k*ip)*ido]+cc[(j2+k*ip)*ido];
01349       }
01350     }
01351 
01352   if(ido !=1)
01353     {
01354     for(j=1; j<ipph; j++)
01355       {
01356       jc=ip-j;
01357       for(k=0; k<l1; k++)
01358         {
01359         for(i=2; i<ido; i+=2)
01360           {
01361           ic=ido-i;
01362           ch[i-1+(k+j*l1)*ido] =
01363             cc[i-1+(2*j+k*ip)*ido]+cc[ic-1+(2*j-1+k*ip)*ido];
01364           ch[i-1+(k+jc*l1)*ido] =
01365             cc[i-1+(2*j+k*ip)*ido]-cc[ic-1+(2*j-1+k*ip)*ido];
01366           ch[i+(k+j*l1)*ido]=cc[i+(2*j+k*ip)*ido]-cc[ic+(2*j-1+k*ip)*ido];
01367           ch[i+(k+jc*l1)*ido]=cc[i+(2*j+k*ip)*ido]+cc[ic+(2*j-1+k*ip)*ido];
01368           }
01369         }
01370       }
01371     }
01372 
01373   csarr=(double *)malloc(2*ip*sizeof(double));
01374   arg=twopi / ip;
01375   csarr[0]=1.;
01376   csarr[1]=0.;
01377   csarr[2]=csarr[2*ip-2]=cos(arg);
01378   csarr[3]=sin(arg); csarr[2*ip-1]=-csarr[3];
01379   for (i=2; i<=ip/2; ++i)
01380     {
01381     csarr[2*i]=csarr[2*ip-2*i]=cos(i*arg);
01382     csarr[2*i+1]=sin(i*arg);
01383     csarr[2*ip-2*i+1]=-csarr[2*i+1];
01384     }
01385   for(l=1; l<ipph; l++)
01386     {
01387     lc=ip-l;
01388     ar1=csarr[2*l];
01389     ai1=csarr[2*l+1];
01390     for(ik=0; ik<idl1; ik++)
01391       {
01392       cc[ik+l*idl1]=ch[ik]+ar1*ch[ik+idl1];
01393       cc[ik+lc*idl1]=ai1*ch[ik+(ip-1)*idl1];
01394       }
01395     aidx=2*l;
01396     for(j=2; j<ipph; j++)
01397       {
01398       jc=ip-j;
01399       aidx+=2*l;
01400       if (aidx>=2*ip) aidx-=2*ip;
01401       ar2=csarr[aidx];
01402       ai2=csarr[aidx+1];
01403       for(ik=0; ik<idl1; ik++)
01404         {
01405         cc[ik+l*idl1]+=ar2*ch[ik+j*idl1];
01406         cc[ik+lc*idl1]+=ai2*ch[ik+jc*idl1];
01407         }
01408       }
01409     }
01410   free(csarr);
01411 
01412   for(j=1; j<ipph; j++)
01413     for(ik=0; ik<idl1; ik++)
01414       ch[ik]+=ch[ik+j*idl1];
01415 
01416   for(j=1; j<ipph; j++)
01417     {
01418     jc=ip-j;
01419     for(k=0; k<l1; k++)
01420       {
01421       ch[(k+j*l1)*ido]=cc[(k+j*l1)*ido]-cc[(k+jc*l1)*ido];
01422       ch[(k+jc*l1)*ido]=cc[(k+j*l1)*ido]+cc[(k+jc*l1)*ido];
01423       }
01424     }
01425 
01426   if(ido==1)
01427     return;
01428   for(j=1; j<ipph; j++)
01429     {
01430     jc=ip-j;
01431     for(k=0; k<l1; k++)
01432       {
01433       for(i=2; i<ido; i+=2)
01434         {
01435         ch[i-1+(k+j*l1)*ido]=cc[i-1+(k+j*l1)*ido]-cc[i+(k+jc*l1)*ido];
01436         ch[i-1+(k+jc*l1)*ido]=cc[i-1+(k+j*l1)*ido]+cc[i+(k+jc*l1)*ido];
01437         ch[i+(k+j*l1)*ido]=cc[i+(k+j*l1)*ido]+cc[i-1+(k+jc*l1)*ido];
01438         ch[i+(k+jc*l1)*ido]=cc[i+(k+j*l1)*ido]-cc[i-1+(k+jc*l1)*ido];
01439         }
01440       }
01441     }
01442   for(ik=0; ik<idl1; ik++)
01443     cc[ik]=ch[ik];
01444   for(j=1; j<ip; j++)
01445     for(k=0; k<l1; k++)
01446       cc[(k+j*l1)*ido]=ch[(k+j*l1)*ido];
01447 
01448   is=-ido;
01449   for(j=1; j<ip; j++)
01450     {
01451     is+=ido;
01452     for(k=0; k<l1; k++)
01453       {
01454       idij=is-1;
01455       for(i=2; i<ido; i+=2)
01456         {
01457         idij+=2;
01458         cc[i-1+(k+j*l1)*ido]=
01459           wa[idij-1]*ch[i-1+(k+j*l1)*ido]-wa[idij]*ch[i+(k+j*l1)*ido];
01460         cc[i+(k+j*l1)*ido]=
01461           wa[idij-1]*ch[i+(k+j*l1)*ido]+wa[idij]*ch[i-1+(k+j*l1)*ido];
01462         }
01463       }
01464     }
01465   }
01466 
01467 
01468 /*----------------------------------------------------------------------
01469    cfftf1, cfftb1, cfftf, cfftb, cffti1, cffti. Complex FFTs.
01470   ----------------------------------------------------------------------*/
01471 
01472 static void cfftf1(int n, double c[], double ch[], const double wa[],
01473   const int ifac[])
01474   {
01475   int idot, k1, l1, l2, na, nf, ip, iw, nac, ido, idl1;
01476   double *p1, *p2;
01477 
01478   nf=ifac[1];
01479   na=0;
01480   l1=1;
01481   iw=0;
01482   for(k1=2; k1<=nf+1; k1++)
01483     {
01484     ip=ifac[k1];
01485     l2=ip*l1;
01486     ido=n / l2;
01487     idot=ido+ido;
01488     idl1=idot*l1;
01489     p1 = (na==0) ? c : ch;
01490     p2 = (na==0) ? ch : c;
01491     if(ip==4)
01492       passf4(idot, l1, p1, p2, wa+iw, wa+iw+idot, wa+iw+2*idot);
01493     else if(ip==2)
01494       passf2(idot, l1, p1, p2, wa+iw);
01495     else if(ip==3)
01496       passf3(idot, l1, p1, p2, wa+iw, wa+iw+idot);
01497     else if(ip==5)
01498       passf5(idot, l1, p1, p2, wa+iw, wa+iw+idot, wa+iw+2*idot, wa+iw+3*idot);
01499     else
01500       {
01501       passfg(&nac, idot, ip, l1, idl1, p1, p2, &wa[iw]);
01502       if(nac==0)
01503         na=1-na;
01504       }
01505     na=1-na;
01506     l1=l2;
01507     iw+=(ip-1)*idot;
01508     }
01509   if(na!=0)
01510     memcpy (c,ch,2*n*sizeof(double));
01511   }
01512 
01513 static void cfftb1(int n, double c[], double ch[], const double wa[],
01514   const int ifac[])
01515   {
01516   int idot, k1, l1, l2, na, nf, ip, iw, nac, ido, idl1;
01517   double *p1, *p2;
01518 
01519   nf=ifac[1];
01520   na=0;
01521   l1=1;
01522   iw=0;
01523   for(k1=2; k1<=nf+1; k1++)
01524     {
01525     ip=ifac[k1];
01526     l2=ip*l1;
01527     ido=n / l2;
01528     idot=ido+ido;
01529     idl1=idot*l1;
01530     p1 = (na==0) ? c : ch;
01531     p2 = (na==0) ? ch : c;
01532     if(ip==4)
01533       passb4(idot, l1, p1, p2, wa+iw, wa+iw+idot, wa+iw+2*idot);
01534     else if(ip==2)
01535       passb2(idot, l1, p1, p2, wa+iw);
01536     else if(ip==3)
01537       passb3(idot, l1, p1, p2, wa+iw, wa+iw+idot);
01538     else if(ip==5)
01539       passb5(idot, l1, p1, p2, wa+iw, wa+iw+idot, wa+iw+2*idot, wa+iw+3*idot);
01540     else
01541       {
01542       passbg(&nac, idot, ip, l1, idl1, p1, p2, &wa[iw]);
01543       if(nac==0)
01544         na=1-na;
01545       }
01546     na=1-na;
01547     l1=l2;
01548     iw+=(ip-1)*idot;
01549     }
01550   if(na!=0)
01551     memcpy (c,ch,2*n*sizeof(double));
01552   }
01553 
01554 void cfftf(int n, double c[], double wsave[])
01555   {
01556   if(n!=1)
01557     cfftf1(n, c, wsave, wsave+2*n,(int*)(wsave+4*n));
01558   }
01559 
01560 void cfftb(int n, double c[], double wsave[])
01561   {
01562   if(n!=1)
01563     cfftb1(n, c, wsave, wsave+2*n,(int*)(wsave+4*n));
01564   }
01565 
01566 static void cffti1(int n, double wa[], int ifac[])
01567   {
01568   static const int ntryh[4]= {3, 4, 2, 5};
01569   static const double twopi=6.28318530717958647692;
01570   double argh, argld, arg, fi;
01571   int idot, ntry=0, i, j, i1, k1, l1, l2, ib;
01572   int ld, ii, nf, ip, nl, nq, nr, ido, ipm;
01573 
01574   nl=n;
01575   nf=0;
01576   j=0;
01577 startloop:
01578   j++;
01579   if(j<=4)
01580     ntry=ntryh[j-1];
01581   else
01582     ntry+=2;
01583   do
01584     {
01585     nq=nl / ntry;
01586     nr=nl-ntry*nq;
01587     if(nr !=0)
01588       goto startloop;
01589     nf++;
01590     ifac[nf+1]=ntry;
01591     nl=nq;
01592     if(ntry==2 && nf !=1)
01593       {
01594       for(i=2; i<=nf; i++)
01595         {
01596         ib=nf-i+2;
01597         ifac[ib+1]=ifac[ib];
01598         }
01599       ifac[2]=2;
01600       }
01601     }
01602   while(nl !=1);
01603   ifac[0]=n;
01604   ifac[1]=nf;
01605   argh=twopi /(double)n;
01606   i=1;
01607   l1=1;
01608   for(k1=1; k1<=nf; k1++)
01609     {
01610     ip=ifac[k1+1];
01611     ld=0;
01612     l2=l1*ip;
01613     ido=n / l2;
01614     idot=ido+ido+2;
01615     ipm=ip-1;
01616     for(j=1; j<=ipm; j++)
01617       {
01618       i1=i;
01619       wa[i-1]=1;
01620       wa[i]=0;
01621       ld+=l1;
01622       fi=0;
01623       argld=ld*argh;
01624       for(ii=4; ii<=idot; ii+=2)
01625         {
01626         i+=2;
01627         fi+=1;
01628         arg=fi*argld;
01629         wa[i-1]=cos(arg);
01630         wa[i]=sin(arg);
01631         }
01632       if(ip>5)
01633         {
01634         wa[i1-1]=wa[i-1];
01635         wa[i1]=wa[i];
01636         }
01637       }
01638     l1=l2;
01639     }
01640   }
01641 
01642 void cffti(int n, double wsave[])
01643   {
01644   if (n!=1)
01645     cffti1(n, wsave+2*n,(int*)(wsave+4*n));
01646   }
01647 
01648 
01649 /*----------------------------------------------------------------------
01650    rfftf1, rfftb1, rfftf, rfftb, rffti1, rffti. Real FFTs.
01651   ----------------------------------------------------------------------*/
01652 
01653 static void rfftf1(int n, double c[], double ch[], const double wa[],
01654   const int ifac[])
01655   {
01656   int i, k1, l1, l2, na, kh, nf, ip, iw, ido, idl1;
01657   double *p1, *p2;
01658 
01659   nf=ifac[1];
01660   na=1;
01661   l2=n;
01662   iw=n-1;
01663   for(k1=1; k1<=nf;++k1)
01664     {
01665     kh=nf-k1;
01666     ip=ifac[kh+2];
01667     l1=l2 / ip;
01668     ido=n / l2;
01669     idl1=ido*l1;
01670     iw-=(ip-1)*ido;
01671     na=1-na;
01672     p1 = (na==0) ? c : ch;
01673     p2 = (na==0) ? ch : c;
01674     if(ip==4)
01675       radf4(ido, l1, p1, p2, wa+iw, wa+iw+ido, wa+iw+2*ido);
01676     else if(ip==2)
01677       radf2(ido, l1, p1, p2, wa+iw);
01678     else if(ip==3)
01679       radf3(ido, l1, p1, p2, wa+iw, wa+iw+ido);
01680     else if(ip==5)
01681       radf5(ido, l1, p1, p2, wa+iw, wa+iw+ido, wa+iw+2*ido, wa+iw+3*ido);
01682     else
01683       {
01684       if(ido==1)
01685         na=1-na;
01686       if(na==0)
01687         radfg(ido, ip, l1, idl1, c, ch, wa+iw);
01688       else
01689         radfg(ido, ip, l1, idl1, ch, c, wa+iw);
01690       na=1-na;
01691       }
01692     l2=l1;
01693     }
01694   if(na==1)
01695     return;
01696   for(i=0; i<n; i++)
01697     c[i]=ch[i];
01698 }
01699 
01700 static void rfftb1(int n, double c[], double ch[], const double wa[],
01701   const int ifac[])
01702   {
01703   int k1, l1, l2, na, nf, ip, iw, ido, idl1;
01704   double *p1, *p2;
01705 
01706   nf=ifac[1];
01707   na=0;
01708   l1=1;
01709   iw=0;
01710   for(k1=1; k1<=nf; k1++)
01711     {
01712     ip=ifac[k1+1];
01713     l2=ip*l1;
01714     ido=n / l2;
01715     idl1=ido*l1;
01716     p1 = (na==0) ? c : ch;
01717     p2 = (na==0) ? ch : c;
01718     if(ip==4)
01719       radb4(ido, l1, p1, p2, wa+iw, wa+iw+ido, wa+iw+2*ido);
01720     else if(ip==2)
01721       radb2(ido, l1, p1, p2, wa+iw);
01722     else if(ip==3)
01723       radb3(ido, l1, p1, p2, wa+iw, wa+iw+ido);
01724     else if(ip==5)
01725       radb5(ido, l1, p1, p2, wa+iw, wa+iw+ido, wa+iw+2*ido, wa+iw+3*ido);
01726     else
01727       {
01728       radbg(ido, ip, l1, idl1, p1, p2, wa+iw);
01729       if(ido!=1)
01730         na=1-na;
01731       }
01732     na=1-na;
01733     l1=l2;
01734     iw+=(ip-1)*ido;
01735     }
01736   if(na!=0)
01737     memcpy (c,ch,n*sizeof(double));
01738   }
01739 
01740 void rfftf(int n, double r[], double wsave[])
01741   {
01742   if(n!=1)
01743     rfftf1(n, r, wsave, wsave+n,(int*)(wsave+2*n));
01744   }
01745 
01746 void rfftb(int n, double r[], double wsave[])
01747   {
01748   if(n!=1)
01749     rfftb1(n, r, wsave, wsave+n,(int*)(wsave+2*n));
01750   }
01751 
01752 static void rffti1(int n, double wa[], int ifac[])
01753   {
01754   static const int ntryh[4]={4, 2, 3, 5};
01755   static const double twopi=6.28318530717958647692;
01756   double argh, argld, arg, fi;
01757   int ntry=0, i, j, k1, l1, l2, ib, ld, ii, nf, ip, nl, is, nq, nr;
01758   int ido, ipm, nfm1;
01759 
01760   nl=n;
01761   nf=0;
01762   j=0;
01763 startloop:
01764  ++j;
01765   if(j<=4)
01766     ntry=ntryh[j-1];
01767   else
01768     ntry+=2;
01769   do
01770     {
01771     nq=nl / ntry;
01772     nr=nl-ntry*nq;
01773     if(nr !=0)
01774       goto startloop;
01775     ++nf;
01776     ifac[nf+1]=ntry;
01777     nl=nq;
01778     if(ntry==2 && nf !=1)
01779       {
01780       for(i=2; i<=nf; i++)
01781         {
01782         ib=nf-i+2;
01783         ifac[ib+1]=ifac[ib];
01784         }
01785       ifac[2]=2;
01786       }
01787     }
01788   while(nl !=1);
01789   ifac[0]=n;
01790   ifac[1]=nf;
01791   argh=twopi /(double)(n);
01792   is=0;
01793   nfm1=nf-1;
01794   l1=1;
01795   if(nfm1==0)
01796     return;
01797   for(k1=1; k1<=nfm1; k1++)
01798     {
01799     ip=ifac[k1+1];
01800     ld=0;
01801     l2=l1*ip;
01802     ido=n / l2;
01803     ipm=ip-1;
01804     for(j=1; j<=ipm;++j)
01805       {
01806       ld+=l1;
01807       i=is;
01808       argld=(double)ld*argh;
01809 
01810       fi=0;
01811       for(ii=3; ii<=ido; ii+=2)
01812         {
01813         i+=2;
01814         fi+=1;
01815         arg=fi*argld;
01816         wa[i-2]=cos(arg);
01817         wa[i-1]=sin(arg);
01818         }
01819       is+=ido;
01820       }
01821     l1=l2;
01822     }
01823   }
01824 
01825 void rffti(int n, double wsave[])
01826   {
01827   if (n!=1)
01828     rffti1(n, wsave+n,(int*)(wsave+2*n));
01829   }

Generated on Fri Jul 8 09:37:13 2005 for LevelS FFT library