Rboolean fft_work(double *a, double *b, int nseg, int n, int nspn, int isn,
double *work, int *iwork)
{
int nf, nspan, ntot;
/* check that factorization was successful */
if(old_n == 0) return FALSE;
/* check that the parameters match those of the factorization call */
if(n != old_n || nseg <= 0 || nspn <= 0 || isn == 0)
return FALSE;
/* perform the transform */
nf = n;
nspan = nf * nspn;
ntot = nspan * nseg;
fftmx(a, b, ntot, nf, nspan, isn, m_fac, kt,
&work[0], &work[maxf], &work[2*(size_t)maxf], &work[3*(size_t)maxf],
iwork, nfac);
return TRUE;
}
void
fft_(double *a, double *b, int nseg, int n, int nspn, int isn)
/* *a, pointer to array 'anal' */
/* *b; pointer to array 'banal' */
{
int nfac[16]; /* These are one bigger than needed */
/* because wish to use Fortran array */
/* index which runs 1 to n, not 0 to n */
int m = 0,
nf,
k,
kt,
ntot,
j,
jj,
maxf, maxp=-1;
/* work space pointers */
double *at, *ck, *bt, *sk;
int *np;
/* reduce the pointers to input arrays - by doing this, FFT uses FORTRAN
indexing but retains compatibility with C arrays */
a--; b--;
/*
* determine the factors of n
*/
k=nf=abs(n);
if (nf==1)
return;
nspn=abs(nf*nspn);
ntot=abs(nspn*nseg);
if (isn*ntot == 0) {
printf("\nerror - zero in fft parameters %d %d %d %d",
nseg, n, nspn, isn);
return;
}
for (m=0; !(k%16); nfac[++m]=4,k/=16);
for (j=3,jj=9; jj<=k; j+=2,jj=j*j)
for (; !(k%jj); nfac[++m]=j,k/=jj);
if (k<=4) {
kt = m;
nfac[m+1] = k;
if (k != 1)
m++;
}
else {
if (k%4==0) {
nfac[++m]=2;
k/=4;
}
kt = m;
maxp = (kt+kt+2 > k-1 ? kt+kt+2 : k-1);
for (j=2; j<=k; j=1+((j+1)/2)*2)
if (k%j==0) {
nfac[++m]=j;
k/=j;
}
}
if (m <= kt+1)
maxp = m + kt + 1;
if (m+kt > 15) {
printf("\nerror - fft parameter n has more than 15 factors : %d", n);
return;
}
if (kt!=0) {
j = kt;
while (j)
nfac[++m]=nfac[j--];
}
maxf = nfac[m-kt];
if (kt > 0 && maxf <nfac[kt])
maxf = nfac[kt];
/* allocate workspace - assume no errors! */
at = (double *) calloc(maxf,sizeof(double));
ck = (double *) calloc(maxf,sizeof(double));
bt = (double *) calloc(maxf,sizeof(double));
sk = (double *) calloc(maxf,sizeof(double));
np = (int *) calloc(maxp,sizeof(int));
/* decrement pointers to allow FORTRAN type usage in fftmx */
at--; bt--; ck--; sk--; np--;
/* call fft driver */
fftmx(a,b,ntot,nf,nspn,isn,m,&kt,at,ck,bt,sk,np,nfac);
/* restore pointers before releasing */
at++; bt++; ck++; sk++; np++;
/* release working storage before returning - assume no problems */
free(at);
free(sk);
free(bt);
free(ck);
free(np);
return;
}
