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