pspline 5.0.5 → 5.1.0

data/ext/pspline/include/basis/fft_complex.h

@@ -0,0 +1,215 @@
+/*******************************************************************************
+	複素高速フーリエ変換（実数配列の引数）
+	Fast Fourier Transformation / Cooley-Tukey Method
+*******************************************************************************/
+template <typename T>
+void wft2(varray<T>& work, const varray<T>& data, int f)
+{
+	work[0] = data[0] + data[2]; work[2] = data[0] - data[2];
+	work[1] = data[1] + data[3]; work[3] = data[1] - data[3];
+}
+
+template <typename T>
+void wft3(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	varray<T> t(size_t(6), A); real<T> F = c * (double)(-f);
+	t[0] = data[2] + data[4]; t[2] = data[0] - 0.5 * t[0]; t[4] = F * (data[2] - data[4]);
+	t[1] = data[3] + data[5]; t[3] = data[1] - 0.5 * t[1]; t[5] = F * (data[3] - data[5]);
+	work[0] = data[0] + t[0]; work[2] = t[2] - t[5]; work[4] = t[2] + t[5];
+	work[1] = data[1] + t[1]; work[3] = t[3] + t[4]; work[5] = t[3] - t[4];
+}
+
+template <typename T>
+void wft4(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	varray<T> t(size_t(8), A); real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = data[0] + data[4]; t[2] = data[2] + data[6];
+	t[1] = data[1] + data[5]; t[3] = data[3] + data[7];
+	t[4] = data[0] - data[4]; t[6] = data[2] - data[6];
+	t[5] = data[1] - data[5]; t[7] = data[3] - data[7];
+	work[0] = t[0] + t[2]; work[2] = t[4] - F * t[7];
+	work[1] = t[1] + t[3]; work[3] = t[5] + F * t[6];
+	work[4] = t[0] - t[2]; work[6] = t[4] + F * t[7];
+	work[5] = t[1] - t[3]; work[7] = t[5] - F * t[6];
+}
+
+template <typename T> inline
+void wft5(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c0 = sqrt(real<T>(5.0, A))/4.0, c1 = sin(_2pi[A]/5.0), c2 = sin(_pi[A]/5.0);
+	varray<T> t(size_t(10), A), s(size_t(8), A);;
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = data[2] + data[8]; t[2] = data[4] + data[6];
+	t[1] = data[3] + data[9]; t[3] = data[5] + data[7];
+	t[4] = data[2] - data[8]; t[6] = data[4] - data[6];
+	t[5] = data[3] - data[9]; t[7] = data[5] - data[7];
+	t[8] = t[0] + t[2]; s[0] = c0 * (t[0] - t[2]); s[2] = data[0] - 0.25 * t[8];
+	t[9] = t[1] + t[3]; s[1] = c0 * (t[1] - t[3]); s[3] = data[1] - 0.25 * t[9];
+	s[4] = s[2] + s[0]; s[6] = s[2] - s[0];
+	s[5] = s[3] + s[1]; s[7] = s[3] - s[1];
+	s[0] = F * (c1 * t[4] + c2 * t[6]); s[2] = F * (c2 * t[4] - c1 * t[6]);
+	s[1] = F * (c1 * t[5] + c2 * t[7]); s[3] = F * (c2 * t[5] - c1 * t[7]);
+	work[0] = data[0] + t[8];
+	work[1] = data[1] + t[9];
+	work[2] = s[4] - s[1]; work[4] = s[6] - s[3];
+	work[3] = s[5] + s[0]; work[5] = s[7] + s[2];
+	work[6] = s[6] + s[3]; work[8] = s[4] + s[1];
+	work[7] = s[7] - s[2]; work[9] = s[5] - s[0];
+}
+
+template <typename T>
+void wft6(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	varray<T> t(size_t(12), A), s(size_t(12), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	s[0] = data[ 4] + data[8]; s[2] = data[0] - 0.5 * s[0]; s[ 4] = c * (data[ 4] - data[8]);
+	s[1] = data[ 5] + data[9]; s[3] = data[1] - 0.5 * s[1]; s[ 5] = c * (data[ 5] - data[9]);
+	s[6] = data[10] + data[2]; s[8] = data[6] - 0.5 * s[6]; s[10] = c * (data[10] - data[2]);
+	s[7] = data[11] + data[3]; s[9] = data[7] - 0.5 * s[7]; s[11] = c * (data[11] - data[3]);
+	t[0] = data[0] + s[0]; t[2] = s[2] + F * s[ 5]; t[ 4] = s[2] - F * s[ 5];
+	t[1] = data[1] + s[1]; t[3] = s[3] - F * s[ 4]; t[ 5] = s[3] + F * s[ 4];
+	t[6] = data[6] + s[6]; t[8] = s[8] + F * s[11]; t[10] = s[8] - F * s[11];
+	t[7] = data[7] + s[7]; t[9] = s[9] - F * s[10]; t[11] = s[9] + F * s[10];
+	work[0] = t[0] + t[6]; work[2] = t[4] - t[10]; work[ 4] = t[2] + t[8];
+	work[1] = t[1] + t[7]; work[3] = t[5] - t[11]; work[ 5] = t[3] + t[9];
+	work[6] = t[0] - t[6]; work[8] = t[4] + t[10]; work[10] = t[2] - t[8];
+	work[7] = t[1] - t[7]; work[9] = t[5] + t[11]; work[11] = t[3] - t[9];
+}
+
+template <typename T>
+void wft(size_t r, varray<T>& work, const varray<T>& data, const real<T>& wp, const real<T>& wq)
+{
+	size_t h, i, j, k, r2 = (r >> 1) + (r%2), A = data.atom();
+	real<T> ap, am, bp, bm, sw = -1.0;
+	varray<T> t(size_t(8), A);
+	work[0] = data[0]; work[1] = data[1];
+	for (k = 1; k < r; ++k) { i = k << 1; work[0] += data[i]; work[1] += data[i+1]; }
+	real<T> xr = wp, xi = wq; 			// W = W0 = exp(-2πi/r);
+	for (h = 1; h < r2; ++h) {
+		real<T> cw2 = 2.0 * xr;
+		for (i = 0; i < 8; ++i) t[i] = 0.0;
+		for (k = r2-1; k > 0; --k) {
+			i = k << 1; j = (r-k) << 1;
+			ap = data[ i ] + data[ j ] + t[0] * cw2 - t[4]; t[4] = t[0]; t[0] = ap;
+			am = data[i+1] - data[j+1] + t[2] * cw2 - t[6]; t[6] = t[2]; t[2] = am;
+			bp = data[i+1] + data[j+1] + t[1] * cw2 - t[5]; t[5] = t[1]; t[1] = bp;
+			bm = data[ i ] - data[ j ] + t[3] * cw2 - t[7]; t[7] = t[3]; t[3] = bm;
+		}	t[6] = t[7] = 0.0;
+		if (r%2 == 0) { i = r2 << 1; t[6] = sw * data[i]; t[7] = sw * data[i+1]; sw *= -1.0; }
+		ap = data[0] + t[0] * xr - t[4] + t[6]; am = t[2] * xi;
+		bp = data[1] + t[1] * xr - t[5] + t[7]; bm = t[3] * xi;
+		relat(xr, xi, wp, wq);	// W *= W0;
+		i = h << 1; j = (r-h) << 1;
+		work[i] = ap - am; work[i+1] = bp + bm;
+		work[j] = ap + am; work[j+1] = bp - bm;
+	}
+	if (r%2 == 0) {
+		sw = -1.0;
+		i = h << 1;
+		work[i] = data[0]; work[i+1] = data[1];
+		for (k = 1; k < r; ++k) {
+			j = k << 1;
+			work[i] += sw * data[j]; work[i+1] += sw * data[j+1];
+			sw *= -1.0;
+		}
+	}
+}
+
+template <typename T>
+void cft(size_t *R, size_t *M, size_t o, varray<T>& data, size_t n, int f)
+{
+	size_t l, m, r, s, N = n >> 1, A = data.atom();
+	real<T> wr, wi, wc, ws, wp, wq;
+
+	size_t h, i, j, k;
+	varray<T> work(n, A); varray<T> *w0 = &data, *w1 = &work;
+	real<T> F = static_cast<real<T>>((double)(-f)), K;
+	real<T> theta = _2pi[A] * F, theta0 = theta;
+	size_t Nj = 1, L, Li, Bj, Mj, Pj;
+	for (s = 0, l = M[0]; s < o; (--l == 0) && (l = M[++s])) {
+		r = R[s]; m = N / r;
+		K = static_cast<real<T>>((double)r);
+		sincos(theta0/K, wq, wp);	// W0 = (wp, wq) = exp(2*PI*F/R);
+		Pj = Nj * r;
+		theta /= K;
+		sincos(theta, ws, wc);	// W1 = (wc, ws) = exp(2*PI*F/R^j);
+		varray<T> &b0 = *w0, &b1 = *w1;
+		varray<T> &gw = *(new varray<T>(r << 1, A));
+		varray<T> &tw = *(new varray<T>(r << 1, A));
+		wr = wc; wi = ws;				// WL = (wr, wi) = W1;
+		for (L = 0; L < Nj; ++L) {
+			for (Mj = L, Bj = L; Bj < N; Bj += Pj, Mj += Nj) {
+				i = Mj << 1;
+				tw[0] = b0[i]; tw[1] = b0[i+1];
+				real<T> xr = wr, xi = wi;
+				for (Li = Mj+m, k = 1; k < r; ++k, Li += m) {
+					i = k << 1; j = Li << 1;
+					if (L == 0) {
+						tw[i] = b0[j]; tw[i+1] = b0[j+1];
+					} else {
+						tw[ i ] = b0[j] * xr - b0[j+1] * xi;
+						tw[i+1] = b0[j] * xi + b0[j+1] * xr;
+						relat(xr, xi, wr, wi);
+					}
+				}
+				switch (r) {
+					case 2: wft2(gw, tw, f); break;
+					case 3: wft3(gw, tw, f); break;
+					case 4: wft4(gw, tw, f); break;
+					case 5: wft5(gw, tw, f); break;
+					case 6: wft6(gw, tw, f); break;
+				   default: wft(r, gw, tw, wp, wq);
+				}
+				for (Li = Bj, h = 0; h < r; ++h, Li += Nj) {
+					i = Li << 1; j = h << 1;
+					b1[i] = gw[j]; b1[i+1] = gw[j+1];
+				}
+			}
+			if (L > 0) relat(wr, wi, wc, ws);	// WL *= W1;
+		}
+		Nj = Pj;
+		delete &tw;
+		delete &gw;
+		varray<T> *w2 = w0; w0 = w1; w1 = w2;
+	}
+	if (w1 == &data) for (i = 0; i < n; ++i) data[i] = work[i];
+}
+
+#define SDIM 10
+// Chinese Remainder Theorem
+void crt(const size_t N, size_t& s, const size_t *r, size_t *R, size_t *Ni, size_t *M)
+{
+	size_t Nres = N, i = 0; R[0] = r[i];
+	do {
+		Ni[s] = 1; M[s] = 0;
+		while (Nres % R[s] == 0) {
+			 M[s]++;
+			Ni[s] *= R[s];	// Ni = R^M;
+			Nres  /= R[s];
+		}
+		int rnew = R[s];
+		if (Nres != 1) {
+			if (M[s] > 0) s++;
+			if (s < SDIM) { 	// 素因数分解
+				while (Nres % rnew != 0) if (r[i] > 2) rnew = r[++i]; else rnew += (rnew == 2 ? 1 : 2);
+				R[s] = rnew;
+			}
+		}
+	} while (Nres > 1 && s < SDIM);
+}
+
+template <typename T>
+bool cfft(varray<T>& data, size_t n, int f)
+{
+	size_t s = 0, m[] = {6, 4, 2}, N = n >> 1, R[SDIM], M[SDIM], Ni[SDIM];
+	crt(N, s, m, R, Ni, M);
+	cft<T>(R, M, s+1, data, n, f > 0 ? 1 : -1);
+	if (f < 0) for (size_t i = 0; i < n; ++i) data[i] /= N;
+	return true;
+}

data/ext/pspline/include/basis/fft_real.h

@@ -0,0 +1,625 @@
+/*******************************************************************************
+	実数値高速フーリエ変換
+	Fast Fourier Transformation
+*******************************************************************************/
+template <typename T> inline
+void xft2(varray<T>& work, const varray<T>& data, int f)
+{
+	work[0] = data[0] + data[1]; work[1] = data[0] - data[1];
+}
+
+template <typename T> inline
+void xft3(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	const real<T> F = c * (double)(-f);
+	real<T> t1 = data[1] + data[2];
+	work[0] = data[0] + t1;
+	work[1] = data[0] - 0.5 * t1;
+	work[2] = F * (data[1] - data[2]);
+}
+
+template <typename T> inline
+void xbt3(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	const real<T> F = c * (double)(-f);
+	real<T> t1 = 2.0 * data[1];
+	real<T> t2 = data[0] - 0.5 * t1, t3 = 2.0 * F * data[2];
+	work[0] = data[0] + t1;
+	work[1] = t2 - t3;
+	work[2] = t2 + t3;
+}
+
+template <typename T> inline
+void xft4(varray<T>& work, const varray<T>& data, int f)
+{
+	real<T> F = static_cast<real<T>>((double)(-f));
+	real<T> t1 = data[0] + data[2], t2 = data[1] + data[3];
+	real<T> t3 = data[0] - data[2], t4 = data[1] - data[3];
+	work[0] = t1 + t2; work[1] = t3;
+	work[2] = t1 - t2; work[3] = F * t4;
+}
+
+template <typename T> inline
+void xbt4(varray<T>& work, const varray<T>& data, int f)
+{
+	real<T> F = static_cast<real<T>>((double)(-f));
+	real<T> t1 = data[0] + data[2], t2 = 2.0 * data[1];
+	real<T> t3 = data[0] - data[2], t4 = 2.0 * data[3] * F;
+	work[0] = t1 + t2; work[1] = t3 - t4;
+	work[2] = t1 - t2; work[3] = t3 + t4;
+}
+
+template <typename T> inline
+void xft5(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c0 = sqrt(real<T>(5.0, A))/4.0, c1 = sin(_2pi[A]/5.0), c2 = sin(_pi[A]/5.0);
+	varray<T> t(size_t(7), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = data[1] + data[4]; t[2] = data[2] + data[3];
+	t[1] = data[1] - data[4]; t[3] = data[2] - data[3];
+	t[4] = t[0] + t[2]; t[5] = data[0] - 0.25 * t[4]; t[6] = c0 * (t[0] - t[2]);
+	work[0] = data[0] + t[4];
+	work[1] = t[5] + t[6]; work[4] = F * (c1 * t[1] + c2 * t[3]);
+	work[2] = t[5] - t[6]; work[3] = F * (c2 * t[1] - c1 * t[3]);
+}
+
+template <typename T> inline
+void xbt5(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c0 = sqrt(real<T>(5.0, A))/4.0, c1 = sin(_2pi[A]/5.0), c2 = sin(_pi[A]/5.0);
+	varray<T> t(size_t(9), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = 2.0 * data[1]; t[2] = 2.0 * data[2];
+	t[1] = 2.0 * data[4]; t[3] = 2.0 * data[3];
+	t[4] = t[0] + t[2]; t[5] = data[0] - 0.25 * t[4]; t[6] = c0 * (t[0] - t[2]);
+	t[0] = t[5] + t[6]; t[7] = F * (c1 * t[1] + c2 * t[3]);
+	t[2] = t[5] - t[6]; t[8] = F * (c2 * t[1] - c1 * t[3]);
+	work[0] = data[0] + t[4];
+	work[1] = t[0] - t[7]; work[2] = t[2] - t[8];
+	work[4] = t[0] + t[7]; work[3] = t[2] + t[8];
+}
+
+template <typename T> inline
+void xft6(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	varray<T> t(size_t(6), A);
+	real<T> F = c * (double)(-f);
+	t[0] = data[2] + data[4]; t[2] = data[0] - 0.5 * t[0]; t[4] = data[2] - data[4];
+	t[1] = data[5] + data[1]; t[3] = data[3] - 0.5 * t[1]; t[5] = data[5] - data[1];
+	t[0] += data[0]; t[1] += data[3];
+	work[0] = t[0] + t[1];
+	work[1] = t[2] - t[3]; work[5] =  F * (t[4] - t[5]);
+	work[2] = t[2] + t[3]; work[4] = -F * (t[4] + t[5]);
+	work[3] = t[0] - t[1];
+}
+
+template <typename T> inline
+void xbt6(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	varray<T> t(size_t(10), A);
+	real<T> F = c * (double)(-f);
+	t[0] = 2.0 * data[2]; t[2] = data[0] - data[2]; t[4] = 2.0 * F * data[4];
+	t[1] = 2.0 * data[1]; t[3] = data[3] - data[1]; t[5] = 2.0 * F * data[5];
+	t[6] = t[2] - t[4]; t[8] = t[3] + t[5];
+	t[7] = t[2] + t[4]; t[9] = t[3] - t[5];
+	t[0] += data[0]; t[1] += data[3];
+	work[0] = t[0] + t[1]; work[1] = t[6] - t[8]; work[2] = t[7] + t[9];
+	work[3] = t[0] - t[1]; work[4] = t[6] + t[8]; work[5] = t[7] - t[9];
+}
+
+template <typename T>
+void xft(size_t r, varray<T>& work, const varray<T>& data, const real<T>& wp, const real<T>& wq)
+{
+	size_t i, j, k, r2 = (r >> 1) + (r%2), A = data.atom();
+	real<T> xr = wp, xi = wq, sw = -1.0;	// W = (xr, xi) = W0;
+	varray<T> w(size_t(6), A);
+	work[0] = data[0]; for (i = 1; i < r; ++i) work[0] += data[i];
+	for (i = 1; i < r2; ++i) {
+		real<T> cw2 = 2.0 * xr;
+		for (j = 0; j < 4; ++j) w[j] = 0.0;
+		for (j = r2-1; j > 0; --j) {
+			w[4] = data[j] + data[r-j] + w[0] * cw2 - w[2]; w[2] = w[0]; w[0] = w[4];
+			w[5] = data[j] - data[r-j] + w[1] * cw2 - w[3]; w[3] = w[1]; w[1] = w[5];
+		}	w[3] = 0.0;
+		if (r%2 == 0) { w[3] = sw * data[r2]; sw *= -1.0; }
+		work[i] = data[0] + w[0] * xr - w[2] + w[3]; work[r-i] = w[1] * xi;
+		relat(xr, xi, wp, wq);
+	}
+	if (r%2 == 0) {
+		work[i] = data[0];
+		for (k = 1; k < r; ++k)
+			if (k%2) work[i] -= data[k];
+			else	 work[i] += data[k];
+	}
+}
+
+template <typename T>
+void xbt(size_t r, varray<T>& work, const varray<T>& data, const real<T>& wp, const real<T>& wq)
+{
+	size_t i, j, r2 = (r >> 1) + (r%2), A = data.atom();
+	real<T> sw = -1.0, cw = 2.0;
+	varray<T> w(size_t(6), A);
+	work[0] = data[0];
+	for (j = 1; j < r2; ++j) {
+		work[0] += cw * data[j];
+	}
+	if (r%2 == 0) {
+		work[0] += data[j];
+	}
+	real<T> wr = wp, wi = wq;				// W = (wr, wi) = W0;
+	for (i = 1; i < r2; ++i) {
+		real<T> cw2 = 2.0 * wr;
+		for (j = 0; j < 4; ++j) w[j] = 0.0;
+		for (j = r2-1; j > 0; --j) {
+			w[4] = data[ j ] * cw + w[0] * cw2 - w[2]; w[2] = w[0]; w[0] = w[4];
+			w[5] = data[r-j] * cw + w[1] * cw2 - w[3]; w[3] = w[1]; w[1] = w[5];
+		}	w[3] = (r%2) ? 0.0 : sw * data[r2];
+			w[4] = data[0] + w[0] * wr - w[2] + w[3]; w[5] = w[1] * wi;
+		work[i] = w[4] - w[5]; work[r-i] = w[4] + w[5];
+		relat(wr, wi, wp, wq);	// W *= W0;
+		sw *= -1.0;
+	}
+	if (r%2 == 0) {
+		sw = -cw;
+		work[i] = data[0];
+		for (j = 1; j < r2; ++j) {
+			work[i] += sw * data[j];
+			sw *= -1.0;
+		}
+		work[i] += 0.5 * sw * data[j];
+	}
+}
+
+template <typename T> inline
+void zft2(varray<T>& work, const varray<T>& data, int f)
+{
+	real<T> F = static_cast<real<T>>((double)(-f));
+	work[0] = data[0]; work[1] = F * data[1];
+}
+
+template <typename T> inline
+void zbt2(varray<T>& work, const varray<T>& data, int f)
+{
+	real<T> F = static_cast<real<T>>((double)(-f));
+	work[0] = 2.0 * data[0]; work[1] = -2.0 * F * data[1];
+}
+
+template <typename T> inline
+void zft3(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	real<T> F = c * (double)(-f);
+	real<T> t = data[1] - data[2];
+	work[0] = data[0] + 0.5 * t;
+	work[1] = data[0] - t;
+	work[2] = F * (data[1] + data[2]);
+}
+
+template <typename T> inline
+void zbt3(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	static const real<T> c = sqrt(real<T>(3.0, A));
+	real<T> F = c * (double)(-f);
+	real<T> t1 = data[0] - data[1], t2 = F * data[2];
+	work[0] = 2.0 * data[0] + data[1];
+	work[1] =  t1 - t2;
+	work[2] = -t1 - t2;
+}
+
+template <typename T> inline
+void zft4(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	static const real<T> c = sqrt(real<T>(2.0, A));
+	real<T> F = c * (double)(-f);
+	real<T> t1 = (data[1] - data[3]) / F, t2 = (data[1] + data[3]) / F;
+	work[0] = data[0] - t1; work[3] = t2 - data[2];
+	work[1] = data[0] + t1; work[2] = t2 + data[2];
+}
+
+template <typename T> inline
+void zbt4(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(2.0, A));
+	real<T> F = c * (double)(-f);
+	real<T> t1 = F * (data[3] + data[2]), t2 = F * (data[0] - data[1]);
+	work[0] = 2.0 * (data[0] + data[1]); work[1] =  t2 - t1;
+	work[2] = 2.0 * (data[2] - data[3]); work[3] = -t2 - t1;
+}
+
+template <typename T> inline
+void zft5(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c0 = sqrt(real<T>(5.0, A))/4.0, c1 = sin(_2pi[A]/5.0), c2 = sin(_pi[A]/5.0);
+	varray<T> t(size_t(7), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = data[1] - data[4]; t[1] = data[1] + data[4];
+	t[2] = data[2] - data[3]; t[3] = data[2] + data[3];
+	t[4] = t[0] - t[2]; t[5] = data[0] + 0.25 * t[4]; t[6] = c0 * (t[0] + t[2]);
+	work[0] = t[5] + t[6]; work[4] = F * (c2 * t[1] + c1 * t[3]);
+	work[1] = t[5] - t[6]; work[3] = F * (c1 * t[1] - c2 * t[3]);
+	work[2] = data[0] - t[4];
+}
+
+template <typename T> inline
+void zbt5(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c0 = sqrt(real<T>(5.0, A))/2.0, c1 = sin(_2pi[A]/5.0), c2 = sin(_pi[A]/5.0);
+	varray<T> t(size_t(7), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = 2.0 * (data[0] + data[1]); t[1] = 0.25 * t[0] - data[2];
+	t[2] =  c0 * (data[0] - data[1]);
+	t[3] = 2.0 * F * (c2 * data[4] + c1 * data[3]);
+	t[4] = 2.0 * F * (c1 * data[4] - c2 * data[3]);
+	t[5] = t[2] + t[1]; t[6] = t[2] - t[1];
+	work[0] = t[0] + data[2];
+	work[1] = t[5] - t[3]; work[4] = -(t[5] + t[3]);
+	work[2] = t[6] - t[4]; work[3] = -(t[6] + t[4]);
+}
+
+template <typename T> inline
+void zft6(varray<T>& work, const varray<T>& data, int f)
+{
+	const size_t A = data.atom();
+	const real<T> c = sqrt(real<T>(0.75, A));
+	varray<T> t(size_t(6), A);
+	real<T> F = static_cast<real<T>>((double)(-f));
+	t[0] = c * (data[5] - data[1]); t[2] = data[2] - data[4];
+	t[1] = c * (data[2] + data[4]); t[3] = data[1] + data[5];
+	t[4] = data[0] + 0.5 * t[2]; t[5] = - data[3] - 0.5 * t[3];
+	work[0] = t[4] + F * t[0]; work[1] = data[0] - t[2]; work[2] = t[4] - F * t[0];
+	work[5] = t[5] + F * t[1]; work[4] = data[3] - t[3]; work[3] = t[5] - F * t[1];
+}
+
+template <typename T>
+void zft(size_t r, varray<T>& work, const varray<T>& data, const real<T>& wr, const real<T>& wi, const real<T>& wp, const real<T>& wq)
+{
+	size_t i, j, r2 = r >> 1, A = data.atom();	// r2 = r/2
+	real<T> xr = wr, xi = wi;
+	varray<T> w(size_t(3), A);
+	for (i = 0; i < r2; ++i) {			// W = (xr, xi) = WL;
+		real<T> cw2 = 2.0 * xr; w[0] = w[1] = 0.0;
+		for (j = r-1; j > 0; --j) {
+			w[2] = data[j] + w[0] * cw2 - w[1]; w[1] = w[0]; w[0] = w[2];
+		}
+		work[i] = data[0] + w[0] * xr - w[1]; work[r-1-i] = w[0] * xi;
+		relat(xr, xi, wp, wq);		// W *= W0;
+	}
+	if (r%2) {		// i == r/2;
+		work[i] = data[0];
+		for (j = 1; j < r; ++j)
+			if (j%2 == 0) work[i] += data[j]; else work[i] -= data[j];
+	}
+}
+
+template <typename T>
+void zbt(size_t r, varray<T>& work, const varray<T>& data, const real<T>& wr, const real<T>& wi, const real<T>& wp, const real<T>& wq)
+{
+	size_t i, j, k, r2 = r >> 1, A = data.atom();	// r2 = r/2
+	work[0] = data[0] * 2.0;
+	for (k = 1; k < r2; ++k) {
+		work[0] += data[k] * 2.0;
+	}
+	if (r%2) {
+		work[0] += data[k];
+	}
+	real<T> xr = wp, xi = wq, yr = wr, yi = wi;
+	varray<T> w(size_t(6), A);
+	for (i = 1; i < r; ++i) {
+		real<T> cw2 = 2.0 * xr;
+		for (j = 0; j < 4; ++j) w[j] = 0.0;
+		for (k = r-1; k > 0; --k) {
+			bool g = (k == r2) && (r%2);
+			j = r-1-k;
+			w[4] = data[k < r2 || g ? k : j];
+			w[5] = k < r2 ? data[j] : g ? 0.0 : -data[k];
+			w[4] = w[4] + w[0] * cw2 - w[2]; w[2] = w[0]; w[0] = w[4];
+			w[5] = w[5] + w[1] * cw2 - w[3]; w[3] = w[1]; w[1] = w[5];
+		}	w[4] = data[ 0 ] + w[0] * xr - w[1] * xi - w[2];
+			w[5] = data[r-1] + w[0] * xi + w[1] * xr - w[3];
+		relat(xr, xi, wp, wq);	// W *= W0;
+		work[i] = w[4] * yr - w[5] * yi;
+		relat(yr, yi, wr, wi);	// WL *= W1^L;
+	}
+}
+
+template <typename T>
+void rsft(size_t *R, size_t *M, size_t n, varray<T>& data, size_t N, int f = 1)
+{
+	size_t l, m, r, s, A = data.atom();
+	real<T> wr, wi, wp, wq, wc, ws;
+
+	size_t i, k;
+	real<T> F = static_cast<real<T>>((double)(-f)), K;
+	real<T> theta0 = _2pi[A] * F, theta = theta0;
+	varray<T> work(N, A); varray<T> *w0 = &data, *w1 = &work;
+	size_t Nj = 1, L, Li, Lj, Bj, Mj, Pj, Wi, Wj;	// Nj = R^(j-1); j = 1...M
+	for (s = 0, l = M[0]; s < n; (--l == 0) && (l = M[++s])) {
+		r = R[s]; m = N / r;
+		K = static_cast<real<T>>((double)r);
+		theta /= K;
+		sincos(theta0/K, wq, wp);	// W0 = (wp, wq) = exp(2*PI*F/R);
+		Pj = Nj * r;
+		sincos(theta, ws, wc);		// W1 = (wc, ws) = exp(2*PI*F/R^j);
+		varray<T> &b0 = *w0; varray<T> &b1 = *w1;
+		varray<T> &gw = *(new varray<T>(r << 1, A));
+		varray<T> &tw = *(new varray<T>(r << 1, A));
+		for (Bj = 0, Mj = 0; Bj < N; Mj += Nj, Bj += Pj) {
+			for (Li = Mj, i = 0; i < r; ++i, Li += m) {
+				tw[i] = b0[Li];
+			}
+			switch (r) {
+				case 2: xft2(gw, tw, f); break;
+				case 3: xft3(gw, tw, f); break;
+				case 4: xft4(gw, tw, f); break;
+				case 5: xft5(gw, tw, f); break;
+				case 6: xft6(gw, tw, f); break;
+			   default: xft(r, gw, tw, wp, wq);
+			}
+			b1[Bj] = gw[0];
+			for (Li = Nj, Lj = Pj-Nj, k = 1; Li < Lj; ++k, Lj -= Nj, Li += Nj) {
+#ifdef FFTPACK
+				Wi = (Li < Lj) ? Li : Lj; Wj = Bj + (Wi << 1); Wi = Wj - 1;
+#else
+				Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+				b1[Wi] = gw[k]; b1[Wj] = gw[r-k];
+			}
+			if (Li == Lj) {
+#ifdef FFTPACK
+				Wi = Bj + (Li << 1) - 1;
+#else
+				Wi = Bj + Li;
+#endif
+				b1[Wi] = gw[k];
+			}
+		}
+		wr = wc; wi = ws; 							// WL = (wr, wi) = W1;
+		for (L = 1; L <= Nj/2; ++L) {
+			for (Mj = 0, Bj = 0; Bj < N; Bj += Pj, Mj += Nj) {
+				if (Nj%2 || L < Nj/2) {
+					real<T> xr = wr, xi = wi;					// W = (xr, xi) = WL;
+#ifdef FFTPACK
+					Lj = Mj + (L << 1); Li = Lj - 1;
+#else
+					Li = Mj + L; Lj = Mj + Nj - L;
+#endif
+					tw[0] = b0[Li]; tw[1] = b0[Lj];
+
+					for (Li = Mj+m, i = 1; i < r; ++i, Li += m) {
+#ifdef FFTPACK
+						Wj = Li + (L << 1); Wi = Wj - 1;
+#else
+						Wi = Li + L; Wj = Li + Nj - L;
+#endif
+						k = i << 1;
+						tw[ k ] = b0[Wi] * xr - b0[Wj] * xi;
+						tw[k+1] = b0[Wi] * xi + b0[Wj] * xr;
+						relat(xr, xi, wr, wi);	// W *= WL;
+					}
+					switch (r) {
+						case 2: wft2(gw, tw, f); break;
+						case 3: wft3(gw, tw, f); break;
+						case 4: wft4(gw, tw, f); break;
+						case 5: wft5(gw, tw, f); break;
+						case 6: wft6(gw, tw, f); break;
+					   default: wft(r, gw, tw, wp, wq);
+					}
+					for (Li = L, Lj = Pj-L, i = 0; i < r; ++i, Lj -= Nj, Li += Nj) {
+#ifdef FFTPACK
+						if (Li < Lj) { Wj = Bj + (Li << 1); Wi = Wj - 1; }
+						else		 { Wi = Bj + (Lj << 1); Wj = Wi - 1; }
+#else
+						Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+						k = i << 1;
+						if (Li < Lj) {
+							b1[Wi] = gw[k]; b1[Wj] = gw[k+1];
+						} else {
+							b1[Wj] = gw[k]; b1[Wi] = -gw[k+1];
+						}
+					}
+				} else {				// L == Nj/2;
+					for (Li = Mj, i = 0; i < r; ++i, Li += m) {
+#ifdef FFTPACK
+						Wi = Li + (L << 1) - 1;
+#else
+						Wi = Li + L;
+#endif
+						tw[i] = b0[Wi];
+					}
+					switch (r) {
+						case 2: zft2(gw, tw, f); break;
+						case 3: zft3(gw, tw, f); break;
+						case 4: zft4(gw, tw, f); break;
+						case 5: zft5(gw, tw, f); break;
+						case 6: zft6(gw, tw, f); break;
+					   default: zft(r, gw, tw, wr, wi, wp, wq);
+					}
+					for (Li = L, Lj = Pj-L, k = 0; Li < Lj; ++k, Lj -= Nj, Li += Nj) {
+#ifdef FFTPACK
+						Wj = Bj + (Li << 1); Wi = Wj - 1;
+#else
+						Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+						b1[Wi] = gw[k]; b1[Wj] = gw[r-1-k];
+					}
+					if (Li == Lj) {
+#ifdef FFTPACK
+						Wi = Bj + (Li << 1) - 1;
+#else
+						Wi = Bj + Li;
+#endif
+						b1[Wi] = gw[k];
+					}
+				}
+			}
+			relat(wr, wi, wc, ws);	// WL *= W1;
+		}
+		Nj = Pj;
+		delete &tw;
+		delete &gw;
+		varray<T> *w2 = w0; w0 = w1; w1 = w2;
+	}
+	if (w0 != &data) for (i = 0; i < N; ++i) data[i] = work[i];
+}
+
+template <typename T>
+void rbft(size_t *R, size_t *M, size_t n, varray<T>& data, size_t N, int f = -1)
+{
+	size_t l, m, r, s, A = data.atom();
+	real<T> wr, wi, wp, wq, wc, ws;
+
+	size_t i, k;
+	real<T> F = static_cast<real<T>>((double)(-f)), K;
+	real<T> theta0 = _2pi[A] * F, theta = theta0 / N;
+	varray<T> work(N, A); varray<T> *w0 = &data, *w1 = &work;
+	size_t Pj = N, L, Li, Lj, Bj, Nj, Mj, Wi, Wj;	// Pj = R^j; j = M...1
+	for (s = n, l = M[n-1]; s > 0; (--l == 0) && (l = M[--s-1])) {
+		r = R[s-1]; m = N / r;
+		K = static_cast<real<T>>((double)r);
+		sincos(theta0/K, wq, wp);	// W0 = (wp, wq) = exp(2*PI*F/R);
+		Nj = Pj / r;
+		sincos(theta, ws, wc);	// W1 = (wc, ws) = exp(2*PI*F/R^j);
+		varray<T> &b0 = *w0; varray<T> &b1 = *w1;
+		varray<T> &gw = *(new varray<T>(r << 1, A));
+		varray<T> &tw = *(new varray<T>(r << 1, A));
+		for (Bj = 0, Mj = 0; Bj < N; Bj += Pj, Mj += Nj) {
+			tw[0] = b0[Bj];
+			for (Li = Nj, Lj = Pj-Nj, k = 1; Li < Lj; ++k, Lj -= Nj, Li += Nj) {
+#ifdef FFTPACK
+				Wi = (Li < Lj) ? Li : Lj; Wj = Bj + (Wi << 1); Wi = Wj - 1;
+#else
+				Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+				tw[k] = b0[Wi]; tw[r-k] = b0[Wj];
+			}
+			if (Li == Lj) {
+#ifdef FFTPACK
+				Wi = Bj + (Li << 1) - 1;
+#else
+				Wi = Bj + Li;
+#endif
+				tw[k] = b0[Wi];
+			}
+			switch (r) {
+				case 2: xft2(gw, tw, f); break;
+				case 3: xbt3(gw, tw, f); break;
+				case 4: xbt4(gw, tw, f); break;
+				case 5: xbt5(gw, tw, f); break;
+				case 6: xbt6(gw, tw, f); break;
+				default: xbt(r, gw, tw, wp, wq);
+			}
+			for (Li = Mj, i = 0; i < r; ++i, Li += m) b1[Li] = gw[i];
+		}
+		wr = wc; wi = ws;
+		for (L = 1; L <= Nj/2; ++L) {
+			for (Mj = 0, Bj = 0; Bj < N; Bj += Pj, Mj += Nj) {
+				real<T> yr = wr, yi = wi; 		// WL = (yr, yi) = W1;
+				if (Nj%2 || L < Nj/2) {
+					for (Li = L, Lj = Pj-L, i = 0; i < r; ++i, Li += Nj, Lj -= Nj) {
+#ifdef FFTPACK
+						if (Li < Lj) { Wj = Bj + (Li << 1); Wi = Wj - 1; }
+						else		 { Wi = Bj + (Lj << 1); Wj = Wi - 1; }
+#else
+						Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+						k = i << 1;
+						if (Li < Lj) { tw[k] = b0[Wi]; tw[k+1] =  b0[Wj]; }
+						else		 { tw[k] = b0[Wj]; tw[k+1] = -b0[Wi]; }
+					}
+					switch (r) {
+						case 2: wft2(gw, tw, f); break;
+						case 3: wft3(gw, tw, f); break;
+						case 4: wft4(gw, tw, f); break;
+						case 5: wft5(gw, tw, f); break;
+						case 6: wft6(gw, tw, f); break;
+					   default: wft(r, gw, tw, wp, wq);
+					}
+#ifdef FFTPACK
+					Lj = Mj + (L << 1); Li = Lj - 1;
+#else
+					Li = Mj + L; Lj = Mj + Nj - L;
+#endif
+					b1[Li] = gw[0]; b1[Lj] = gw[1];
+					for (Li = Mj+m, i = 1; i < r; ++i, Li += m) {
+#ifdef FFTPACK
+						Wj = Li + (L << 1); Wi = Wj - 1;
+#else
+						Wi = Li + L; Wj = Li + Nj - L;
+#endif
+						k = i << 1;
+						b1[Wi] = gw[k] * yr - gw[k+1] * yi;
+						b1[Wj] = gw[k] * yi + gw[k+1] * yr;
+						relat(yr, yi, wr, wi);	// WL *= W1^L;
+					}
+				} else {
+					for ( Li = L, Lj = Pj-L, k = 0; Li < Lj; ++k, Lj -= Nj, Li += Nj) {
+#ifdef FFTPACK
+						Wj = Bj + (Li << 1); Wi = Wj - 1;
+#else
+						Wi = Bj + Li; Wj = Bj + Lj;
+#endif
+						tw[k] = b0[Wi]; tw[r-1-k] = b0[Wj];
+					}
+					if (Li == Lj) {
+#ifdef FFTPACK
+						Wi = Bj + (Li << 1) - 1;
+#else
+						Wi = Bj + Li;
+#endif
+						tw[k] = b0[Wi];
+					}
+					switch (r) {
+						case 2: zbt2(gw, tw, f); break;
+						case 3: zbt3(gw, tw, f); break;
+						case 4: zbt4(gw, tw, f); break;
+						case 5: zbt5(gw, tw, f); break;
+					   default: zbt(r, gw, tw, wr, wi, wp, wq);
+					}
+					for (Li = Mj, i = 0; i < r; ++i, Li += m) {
+#ifdef FFTPACK
+						Wi = Li + (L << 1) - 1;
+#else
+						Wi = Li + L;
+#endif
+						b1[Wi] = gw[i];
+					}
+				}
+			}
+			relat(wr, wi, wc, ws);	// WL *= W1;
+		}
+		theta *= K;
+		Pj = Nj;
+		delete &tw;
+		delete &gw;
+		varray<T> *w2 = w0; w0 = w1; w1 = w2;
+	}
+	if (w0 != &data) for (i = 0; i < N; ++i) data[i] = work[i];
+}
+
+template <typename T>
+bool rfft(varray<T>& data, size_t N, int f)
+{
+	size_t s = 0, m[] = {2}, R[SDIM], M[SDIM], Ni[SDIM];
+	crt(N, s, m, R, Ni, M);
+	if (f > 0) rsft<T>(R, M, s+1, data, N);
+	else	   rbft<T>(R, M, s+1, data, N);
+	if (f < 0) for (size_t i = 0; i < N; ++i) data[i] /= N;
+	return true;
+}