blob: b6375a80dab4eb2f43b053da9d5c493b7d44bca5 [file] [log] [blame]
/*
compile with cc -DTESTING_FFTPACK fftpack.c in order to build the
test application.
This is an f2c translation of the full fftpack sources as found on
http://www.netlib.org/fftpack/ The translated code has been
slightlty edited to remove the ugliest artefacts of the translation
(a hundred of wild GOTOs were wiped during that operation).
The original fftpack file was written by Paul N. Swarztrauber
(Version 4, 1985), in fortran 77.
FFTPACK license:
http://www.cisl.ucar.edu/css/software/fftpack5/ftpk.html
Copyright (c) 2004 the University Corporation for Atmospheric
Research ("UCAR"). All rights reserved. Developed by NCAR's
Computational and Information Systems Laboratory, UCAR,
www.cisl.ucar.edu.
Redistribution and use of the Software in source and binary forms,
with or without modification, is permitted provided that the
following conditions are met:
- Neither the names of NCAR's Computational and Information Systems
Laboratory, the University Corporation for Atmospheric Research,
nor the names of its sponsors or contributors may be used to
endorse or promote products derived from this Software without
specific prior written permission.
- Redistributions of source code must retain the above copyright
notices, this list of conditions, and the disclaimer below.
- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions, and the disclaimer below in the
documentation and/or other materials provided with the
distribution.
THIS SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE
SOFTWARE.
ChangeLog:
2011/10/02: this is my first release of this file.
*/
#include "fftpack.h"
#include <math.h>
typedef fftpack_real real;
typedef fftpack_int integer;
typedef struct f77complex {
real r, i;
} f77complex;
#ifdef TESTING_FFTPACK
static real c_abs(f77complex *c) { return sqrt(c->r*c->r + c->i*c->i); }
static double dmax(double a, double b) { return a < b ? b : a; }
#endif
/* translated by f2c (version 20061008), and slightly edited */
static void passfb(integer *nac, integer ido, integer ip, integer l1, integer idl1,
real *cc, real *c1, real *c2, real *ch, real *ch2, const real *wa, real fsign)
{
/* System generated locals */
integer ch_offset, cc_offset,
c1_offset, c2_offset, ch2_offset;
/* Local variables */
integer i, j, k, l, jc, lc, ik, idj, idl, inc, idp;
real wai, war;
integer ipp2, idij, idlj, idot, ipph;
#define c1_ref(a_1,a_2,a_3) c1[((a_3)*l1 + (a_2))*ido + a_1]
#define c2_ref(a_1,a_2) c2[(a_2)*idl1 + a_1]
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*ip + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
#define ch2_ref(a_1,a_2) ch2[(a_2)*idl1 + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
c1_offset = 1 + ido * (1 + l1);
c1 -= c1_offset;
cc_offset = 1 + ido * (1 + ip);
cc -= cc_offset;
ch2_offset = 1 + idl1;
ch2 -= ch2_offset;
c2_offset = 1 + idl1;
c2 -= c2_offset;
--wa;
/* Function Body */
idot = ido / 2;
ipp2 = ip + 2;
ipph = (ip + 1) / 2;
idp = ip * ido;
if (ido >= l1) {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
for (i = 1; i <= ido; ++i) {
ch_ref(i, k, j) = cc_ref(i, j, k) + cc_ref(i, jc, k);
ch_ref(i, k, jc) = cc_ref(i, j, k) - cc_ref(i, jc, k);
}
}
}
for (k = 1; k <= l1; ++k) {
for (i = 1; i <= ido; ++i) {
ch_ref(i, k, 1) = cc_ref(i, 1, k);
}
}
} else {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (i = 1; i <= ido; ++i) {
for (k = 1; k <= l1; ++k) {
ch_ref(i, k, j) = cc_ref(i, j, k) + cc_ref(i, jc, k);
ch_ref(i, k, jc) = cc_ref(i, j, k) - cc_ref(i, jc, k);
}
}
}
for (i = 1; i <= ido; ++i) {
for (k = 1; k <= l1; ++k) {
ch_ref(i, k, 1) = cc_ref(i, 1, k);
}
}
}
idl = 2 - ido;
inc = 0;
for (l = 2; l <= ipph; ++l) {
lc = ipp2 - l;
idl += ido;
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, l) = ch2_ref(ik, 1) + wa[idl - 1] * ch2_ref(ik, 2);
c2_ref(ik, lc) = fsign*wa[idl] * ch2_ref(ik, ip);
}
idlj = idl;
inc += ido;
for (j = 3; j <= ipph; ++j) {
jc = ipp2 - j;
idlj += inc;
if (idlj > idp) {
idlj -= idp;
}
war = wa[idlj - 1];
wai = wa[idlj];
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, l) = c2_ref(ik, l) + war * ch2_ref(ik, j);
c2_ref(ik, lc) = c2_ref(ik, lc) + fsign*wai * ch2_ref(ik, jc);
}
}
}
for (j = 2; j <= ipph; ++j) {
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, 1) = ch2_ref(ik, 1) + ch2_ref(ik, j);
}
}
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (ik = 2; ik <= idl1; ik += 2) {
ch2_ref(ik - 1, j) = c2_ref(ik - 1, j) - c2_ref(ik, jc);
ch2_ref(ik - 1, jc) = c2_ref(ik - 1, j) + c2_ref(ik, jc);
ch2_ref(ik, j) = c2_ref(ik, j) + c2_ref(ik - 1, jc);
ch2_ref(ik, jc) = c2_ref(ik, j) - c2_ref(ik - 1, jc);
}
}
*nac = 1;
if (ido == 2) {
return;
}
*nac = 0;
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, 1) = ch2_ref(ik, 1);
}
for (j = 2; j <= ip; ++j) {
for (k = 1; k <= l1; ++k) {
c1_ref(1, k, j) = ch_ref(1, k, j);
c1_ref(2, k, j) = ch_ref(2, k, j);
}
}
if (idot <= l1) {
idij = 0;
for (j = 2; j <= ip; ++j) {
idij += 2;
for (i = 4; i <= ido; i += 2) {
idij += 2;
for (k = 1; k <= l1; ++k) {
c1_ref(i - 1, k, j) = wa[idij - 1] * ch_ref(i - 1, k, j) - fsign*wa[idij] * ch_ref(i, k, j);
c1_ref(i, k, j) = wa[idij - 1] * ch_ref(i, k, j) + fsign*wa[idij] * ch_ref(i - 1, k, j);
}
}
}
return;
}
idj = 2 - ido;
for (j = 2; j <= ip; ++j) {
idj += ido;
for (k = 1; k <= l1; ++k) {
idij = idj;
for (i = 4; i <= ido; i += 2) {
idij += 2;
c1_ref(i - 1, k, j) = wa[idij - 1] * ch_ref(i - 1, k, j) - fsign*wa[idij] * ch_ref(i, k, j);
c1_ref(i, k, j) = wa[idij - 1] * ch_ref(i, k, j) + fsign*wa[idij] * ch_ref(i - 1, k, j);
}
}
}
} /* passb */
#undef ch2_ref
#undef ch_ref
#undef cc_ref
#undef c2_ref
#undef c1_ref
static void passb2(integer ido, integer l1, const real *cc, real *ch, const real *wa1)
{
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ti2, tr2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*2 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 3;
cc -= cc_offset;
--wa1;
/* Function Body */
if (ido <= 2) {
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, 1) = cc_ref(1, 1, k) + cc_ref(1, 2, k);
ch_ref(1, k, 2) = cc_ref(1, 1, k) - cc_ref(1, 2, k);
ch_ref(2, k, 1) = cc_ref(2, 1, k) + cc_ref(2, 2, k);
ch_ref(2, k, 2) = cc_ref(2, 1, k) - cc_ref(2, 2, k);
}
return;
}
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + cc_ref(i - 1, 2, k);
tr2 = cc_ref(i - 1, 1, k) - cc_ref(i - 1, 2, k);
ch_ref(i, k, 1) = cc_ref(i, 1, k) + cc_ref(i, 2, k);
ti2 = cc_ref(i, 1, k) - cc_ref(i, 2, k);
ch_ref(i, k, 2) = wa1[i - 1] * ti2 + wa1[i] * tr2;
ch_ref(i - 1, k, 2) = wa1[i - 1] * tr2 - wa1[i] * ti2;
}
}
} /* passb2 */
#undef ch_ref
#undef cc_ref
static void passb3(integer ido, integer l1, const real *cc, real *ch, const real *wa1, const real *wa2)
{
static const real taur = -.5f;
static const real taui = .866025403784439f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*3 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + (ido << 2);
cc -= cc_offset;
--wa1;
--wa2;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
tr2 = cc_ref(1, 2, k) + cc_ref(1, 3, k);
cr2 = cc_ref(1, 1, k) + taur * tr2;
ch_ref(1, k, 1) = cc_ref(1, 1, k) + tr2;
ti2 = cc_ref(2, 2, k) + cc_ref(2, 3, k);
ci2 = cc_ref(2, 1, k) + taur * ti2;
ch_ref(2, k, 1) = cc_ref(2, 1, k) + ti2;
cr3 = taui * (cc_ref(1, 2, k) - cc_ref(1, 3, k));
ci3 = taui * (cc_ref(2, 2, k) - cc_ref(2, 3, k));
ch_ref(1, k, 2) = cr2 - ci3;
ch_ref(1, k, 3) = cr2 + ci3;
ch_ref(2, k, 2) = ci2 + cr3;
ch_ref(2, k, 3) = ci2 - cr3;
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
tr2 = cc_ref(i - 1, 2, k) + cc_ref(i - 1, 3, k);
cr2 = cc_ref(i - 1, 1, k) + taur * tr2;
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + tr2;
ti2 = cc_ref(i, 2, k) + cc_ref(i, 3, k);
ci2 = cc_ref(i, 1, k) + taur * ti2;
ch_ref(i, k, 1) = cc_ref(i, 1, k) + ti2;
cr3 = taui * (cc_ref(i - 1, 2, k) - cc_ref(i - 1, 3, k));
ci3 = taui * (cc_ref(i, 2, k) - cc_ref(i, 3, k));
dr2 = cr2 - ci3;
dr3 = cr2 + ci3;
di2 = ci2 + cr3;
di3 = ci2 - cr3;
ch_ref(i, k, 2) = wa1[i - 1] * di2 + wa1[i] * dr2;
ch_ref(i - 1, k, 2) = wa1[i - 1] * dr2 - wa1[i] * di2;
ch_ref(i, k, 3) = wa2[i - 1] * di3 + wa2[i] * dr3;
ch_ref(i - 1, k, 3) = wa2[i - 1] * dr3 - wa2[i] * di3;
}
}
}
} /* passb3 */
#undef ch_ref
#undef cc_ref
static void passb4(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3)
{
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*4 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 5;
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
ti1 = cc_ref(2, 1, k) - cc_ref(2, 3, k);
ti2 = cc_ref(2, 1, k) + cc_ref(2, 3, k);
tr4 = cc_ref(2, 4, k) - cc_ref(2, 2, k);
ti3 = cc_ref(2, 2, k) + cc_ref(2, 4, k);
tr1 = cc_ref(1, 1, k) - cc_ref(1, 3, k);
tr2 = cc_ref(1, 1, k) + cc_ref(1, 3, k);
ti4 = cc_ref(1, 2, k) - cc_ref(1, 4, k);
tr3 = cc_ref(1, 2, k) + cc_ref(1, 4, k);
ch_ref(1, k, 1) = tr2 + tr3;
ch_ref(1, k, 3) = tr2 - tr3;
ch_ref(2, k, 1) = ti2 + ti3;
ch_ref(2, k, 3) = ti2 - ti3;
ch_ref(1, k, 2) = tr1 + tr4;
ch_ref(1, k, 4) = tr1 - tr4;
ch_ref(2, k, 2) = ti1 + ti4;
ch_ref(2, k, 4) = ti1 - ti4;
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
ti1 = cc_ref(i, 1, k) - cc_ref(i, 3, k);
ti2 = cc_ref(i, 1, k) + cc_ref(i, 3, k);
ti3 = cc_ref(i, 2, k) + cc_ref(i, 4, k);
tr4 = cc_ref(i, 4, k) - cc_ref(i, 2, k);
tr1 = cc_ref(i - 1, 1, k) - cc_ref(i - 1, 3, k);
tr2 = cc_ref(i - 1, 1, k) + cc_ref(i - 1, 3, k);
ti4 = cc_ref(i - 1, 2, k) - cc_ref(i - 1, 4, k);
tr3 = cc_ref(i - 1, 2, k) + cc_ref(i - 1, 4, k);
ch_ref(i - 1, k, 1) = tr2 + tr3;
cr3 = tr2 - tr3;
ch_ref(i, k, 1) = ti2 + ti3;
ci3 = ti2 - ti3;
cr2 = tr1 + tr4;
cr4 = tr1 - tr4;
ci2 = ti1 + ti4;
ci4 = ti1 - ti4;
ch_ref(i - 1, k, 2) = wa1[i - 1] * cr2 - wa1[i] * ci2;
ch_ref(i, k, 2) = wa1[i - 1] * ci2 + wa1[i] * cr2;
ch_ref(i - 1, k, 3) = wa2[i - 1] * cr3 - wa2[i] * ci3;
ch_ref(i, k, 3) = wa2[i - 1] * ci3 + wa2[i] * cr3;
ch_ref(i - 1, k, 4) = wa3[i - 1] * cr4 - wa3[i] * ci4;
ch_ref(i, k, 4) = wa3[i - 1] * ci4 + wa3[i] * cr4;
}
}
}
} /* passb4 */
#undef ch_ref
#undef cc_ref
/* passf5 and passb5 merged */
static void passfb5(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3, const real *wa4, real fsign)
{
const real tr11 = .309016994374947f;
const real ti11 = .951056516295154f*fsign;
const real tr12 = -.809016994374947f;
const real ti12 = .587785252292473f*fsign;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*5 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 6;
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
--wa4;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
ti5 = cc_ref(2, 2, k) - cc_ref(2, 5, k);
ti2 = cc_ref(2, 2, k) + cc_ref(2, 5, k);
ti4 = cc_ref(2, 3, k) - cc_ref(2, 4, k);
ti3 = cc_ref(2, 3, k) + cc_ref(2, 4, k);
tr5 = cc_ref(1, 2, k) - cc_ref(1, 5, k);
tr2 = cc_ref(1, 2, k) + cc_ref(1, 5, k);
tr4 = cc_ref(1, 3, k) - cc_ref(1, 4, k);
tr3 = cc_ref(1, 3, k) + cc_ref(1, 4, k);
ch_ref(1, k, 1) = cc_ref(1, 1, k) + tr2 + tr3;
ch_ref(2, k, 1) = cc_ref(2, 1, k) + ti2 + ti3;
cr2 = cc_ref(1, 1, k) + tr11 * tr2 + tr12 * tr3;
ci2 = cc_ref(2, 1, k) + tr11 * ti2 + tr12 * ti3;
cr3 = cc_ref(1, 1, k) + tr12 * tr2 + tr11 * tr3;
ci3 = cc_ref(2, 1, k) + tr12 * ti2 + tr11 * ti3;
cr5 = ti11 * tr5 + ti12 * tr4;
ci5 = ti11 * ti5 + ti12 * ti4;
cr4 = ti12 * tr5 - ti11 * tr4;
ci4 = ti12 * ti5 - ti11 * ti4;
ch_ref(1, k, 2) = cr2 - ci5;
ch_ref(1, k, 5) = cr2 + ci5;
ch_ref(2, k, 2) = ci2 + cr5;
ch_ref(2, k, 3) = ci3 + cr4;
ch_ref(1, k, 3) = cr3 - ci4;
ch_ref(1, k, 4) = cr3 + ci4;
ch_ref(2, k, 4) = ci3 - cr4;
ch_ref(2, k, 5) = ci2 - cr5;
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
ti5 = cc_ref(i, 2, k) - cc_ref(i, 5, k);
ti2 = cc_ref(i, 2, k) + cc_ref(i, 5, k);
ti4 = cc_ref(i, 3, k) - cc_ref(i, 4, k);
ti3 = cc_ref(i, 3, k) + cc_ref(i, 4, k);
tr5 = cc_ref(i - 1, 2, k) - cc_ref(i - 1, 5, k);
tr2 = cc_ref(i - 1, 2, k) + cc_ref(i - 1, 5, k);
tr4 = cc_ref(i - 1, 3, k) - cc_ref(i - 1, 4, k);
tr3 = cc_ref(i - 1, 3, k) + cc_ref(i - 1, 4, k);
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + tr2 + tr3;
ch_ref(i, k, 1) = cc_ref(i, 1, k) + ti2 + ti3;
cr2 = cc_ref(i - 1, 1, k) + tr11 * tr2 + tr12 * tr3;
ci2 = cc_ref(i, 1, k) + tr11 * ti2 + tr12 * ti3;
cr3 = cc_ref(i - 1, 1, k) + tr12 * tr2 + tr11 * tr3;
ci3 = cc_ref(i, 1, k) + tr12 * ti2 + tr11 * ti3;
cr5 = ti11 * tr5 + ti12 * tr4;
ci5 = ti11 * ti5 + ti12 * ti4;
cr4 = ti12 * tr5 - ti11 * tr4;
ci4 = ti12 * ti5 - ti11 * ti4;
dr3 = cr3 - ci4;
dr4 = cr3 + ci4;
di3 = ci3 + cr4;
di4 = ci3 - cr4;
dr5 = cr2 + ci5;
dr2 = cr2 - ci5;
di5 = ci2 - cr5;
di2 = ci2 + cr5;
ch_ref(i - 1, k, 2) = wa1[i - 1] * dr2 - fsign*wa1[i] * di2;
ch_ref(i, k, 2) = wa1[i - 1] * di2 + fsign*wa1[i] * dr2;
ch_ref(i - 1, k, 3) = wa2[i - 1] * dr3 - fsign*wa2[i] * di3;
ch_ref(i, k, 3) = wa2[i - 1] * di3 + fsign*wa2[i] * dr3;
ch_ref(i - 1, k, 4) = wa3[i - 1] * dr4 - fsign*wa3[i] * di4;
ch_ref(i, k, 4) = wa3[i - 1] * di4 + fsign*wa3[i] * dr4;
ch_ref(i - 1, k, 5) = wa4[i - 1] * dr5 - fsign*wa4[i] * di5;
ch_ref(i, k, 5) = wa4[i - 1] * di5 + fsign*wa4[i] * dr5;
}
}
}
} /* passb5 */
#undef ch_ref
#undef cc_ref
static void passf2(integer ido, integer l1, const real *cc, real *ch, const real *wa1)
{
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ti2, tr2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*2 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 3;
cc -= cc_offset;
--wa1;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, 1) = cc_ref(1, 1, k) + cc_ref(1, 2, k);
ch_ref(1, k, 2) = cc_ref(1, 1, k) - cc_ref(1, 2, k);
ch_ref(2, k, 1) = cc_ref(2, 1, k) + cc_ref(2, 2, k);
ch_ref(2, k, 2) = cc_ref(2, 1, k) - cc_ref(2, 2, k);
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + cc_ref(i - 1, 2,
k);
tr2 = cc_ref(i - 1, 1, k) - cc_ref(i - 1, 2, k);
ch_ref(i, k, 1) = cc_ref(i, 1, k) + cc_ref(i, 2, k);
ti2 = cc_ref(i, 1, k) - cc_ref(i, 2, k);
ch_ref(i, k, 2) = wa1[i - 1] * ti2 - wa1[i] * tr2;
ch_ref(i - 1, k, 2) = wa1[i - 1] * tr2 + wa1[i] * ti2;
}
}
}
} /* passf2 */
#undef ch_ref
#undef cc_ref
static void passf3(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2)
{
static const real taur = -.5f;
static const real taui = -.866025403784439f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*3 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + (ido << 2);
cc -= cc_offset;
--wa1;
--wa2;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
tr2 = cc_ref(1, 2, k) + cc_ref(1, 3, k);
cr2 = cc_ref(1, 1, k) + taur * tr2;
ch_ref(1, k, 1) = cc_ref(1, 1, k) + tr2;
ti2 = cc_ref(2, 2, k) + cc_ref(2, 3, k);
ci2 = cc_ref(2, 1, k) + taur * ti2;
ch_ref(2, k, 1) = cc_ref(2, 1, k) + ti2;
cr3 = taui * (cc_ref(1, 2, k) - cc_ref(1, 3, k));
ci3 = taui * (cc_ref(2, 2, k) - cc_ref(2, 3, k));
ch_ref(1, k, 2) = cr2 - ci3;
ch_ref(1, k, 3) = cr2 + ci3;
ch_ref(2, k, 2) = ci2 + cr3;
ch_ref(2, k, 3) = ci2 - cr3;
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
tr2 = cc_ref(i - 1, 2, k) + cc_ref(i - 1, 3, k);
cr2 = cc_ref(i - 1, 1, k) + taur * tr2;
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + tr2;
ti2 = cc_ref(i, 2, k) + cc_ref(i, 3, k);
ci2 = cc_ref(i, 1, k) + taur * ti2;
ch_ref(i, k, 1) = cc_ref(i, 1, k) + ti2;
cr3 = taui * (cc_ref(i - 1, 2, k) - cc_ref(i - 1, 3, k));
ci3 = taui * (cc_ref(i, 2, k) - cc_ref(i, 3, k));
dr2 = cr2 - ci3;
dr3 = cr2 + ci3;
di2 = ci2 + cr3;
di3 = ci2 - cr3;
ch_ref(i, k, 2) = wa1[i - 1] * di2 - wa1[i] * dr2;
ch_ref(i - 1, k, 2) = wa1[i - 1] * dr2 + wa1[i] * di2;
ch_ref(i, k, 3) = wa2[i - 1] * di3 - wa2[i] * dr3;
ch_ref(i - 1, k, 3) = wa2[i - 1] * dr3 + wa2[i] * di3;
}
}
}
} /* passf3 */
#undef ch_ref
#undef cc_ref
static void passf4(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3)
{
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k;
real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*4 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 5;
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
/* Function Body */
if (ido == 2) {
for (k = 1; k <= l1; ++k) {
ti1 = cc_ref(2, 1, k) - cc_ref(2, 3, k);
ti2 = cc_ref(2, 1, k) + cc_ref(2, 3, k);
tr4 = cc_ref(2, 2, k) - cc_ref(2, 4, k);
ti3 = cc_ref(2, 2, k) + cc_ref(2, 4, k);
tr1 = cc_ref(1, 1, k) - cc_ref(1, 3, k);
tr2 = cc_ref(1, 1, k) + cc_ref(1, 3, k);
ti4 = cc_ref(1, 4, k) - cc_ref(1, 2, k);
tr3 = cc_ref(1, 2, k) + cc_ref(1, 4, k);
ch_ref(1, k, 1) = tr2 + tr3;
ch_ref(1, k, 3) = tr2 - tr3;
ch_ref(2, k, 1) = ti2 + ti3;
ch_ref(2, k, 3) = ti2 - ti3;
ch_ref(1, k, 2) = tr1 + tr4;
ch_ref(1, k, 4) = tr1 - tr4;
ch_ref(2, k, 2) = ti1 + ti4;
ch_ref(2, k, 4) = ti1 - ti4;
}
} else {
for (k = 1; k <= l1; ++k) {
for (i = 2; i <= ido; i += 2) {
ti1 = cc_ref(i, 1, k) - cc_ref(i, 3, k);
ti2 = cc_ref(i, 1, k) + cc_ref(i, 3, k);
ti3 = cc_ref(i, 2, k) + cc_ref(i, 4, k);
tr4 = cc_ref(i, 2, k) - cc_ref(i, 4, k);
tr1 = cc_ref(i - 1, 1, k) - cc_ref(i - 1, 3, k);
tr2 = cc_ref(i - 1, 1, k) + cc_ref(i - 1, 3, k);
ti4 = cc_ref(i - 1, 4, k) - cc_ref(i - 1, 2, k);
tr3 = cc_ref(i - 1, 2, k) + cc_ref(i - 1, 4, k);
ch_ref(i - 1, k, 1) = tr2 + tr3;
cr3 = tr2 - tr3;
ch_ref(i, k, 1) = ti2 + ti3;
ci3 = ti2 - ti3;
cr2 = tr1 + tr4;
cr4 = tr1 - tr4;
ci2 = ti1 + ti4;
ci4 = ti1 - ti4;
ch_ref(i - 1, k, 2) = wa1[i - 1] * cr2 + wa1[i] * ci2;
ch_ref(i, k, 2) = wa1[i - 1] * ci2 - wa1[i] * cr2;
ch_ref(i - 1, k, 3) = wa2[i - 1] * cr3 + wa2[i] * ci3;
ch_ref(i, k, 3) = wa2[i - 1] * ci3 - wa2[i] * cr3;
ch_ref(i - 1, k, 4) = wa3[i - 1] * cr4 + wa3[i] * ci4;
ch_ref(i, k, 4) = wa3[i - 1] * ci4 - wa3[i] * cr4;
}
}
}
} /* passf4 */
#undef ch_ref
#undef cc_ref
static void radb2(integer ido, integer l1, const real *cc, real *ch, const real *wa1)
{
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ti2, tr2;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*2 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 3;
cc -= cc_offset;
--wa1;
/* Function Body */
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, 1) = cc_ref(1, 1, k) + cc_ref(ido, 2, k);
ch_ref(1, k, 2) = cc_ref(1, 1, k) - cc_ref(ido, 2, k);
}
if (ido < 2) return;
else if (ido != 2) {
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + cc_ref(ic - 1, 2,
k);
tr2 = cc_ref(i - 1, 1, k) - cc_ref(ic - 1, 2, k);
ch_ref(i, k, 1) = cc_ref(i, 1, k) - cc_ref(ic, 2, k);
ti2 = cc_ref(i, 1, k) + cc_ref(ic, 2, k);
ch_ref(i - 1, k, 2) = wa1[i - 2] * tr2 - wa1[i - 1] * ti2;
ch_ref(i, k, 2) = wa1[i - 2] * ti2 + wa1[i - 1] * tr2;
}
}
if (ido % 2 == 1) return;
}
for (k = 1; k <= l1; ++k) {
ch_ref(ido, k, 1) = cc_ref(ido, 1, k) + cc_ref(ido, 1, k);
ch_ref(ido, k, 2) = -(cc_ref(1, 2, k) + cc_ref(1, 2, k));
}
} /* radb2 */
#undef ch_ref
#undef cc_ref
static void radb3(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2)
{
/* Initialized data */
static const real taur = -.5f;
static const real taui = .866025403784439f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*3 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + (ido << 2);
cc -= cc_offset;
--wa1;
--wa2;
/* Function Body */
for (k = 1; k <= l1; ++k) {
tr2 = cc_ref(ido, 2, k) + cc_ref(ido, 2, k);
cr2 = cc_ref(1, 1, k) + taur * tr2;
ch_ref(1, k, 1) = cc_ref(1, 1, k) + tr2;
ci3 = taui * (cc_ref(1, 3, k) + cc_ref(1, 3, k));
ch_ref(1, k, 2) = cr2 - ci3;
ch_ref(1, k, 3) = cr2 + ci3;
}
if (ido == 1) {
return;
}
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
tr2 = cc_ref(i - 1, 3, k) + cc_ref(ic - 1, 2, k);
cr2 = cc_ref(i - 1, 1, k) + taur * tr2;
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + tr2;
ti2 = cc_ref(i, 3, k) - cc_ref(ic, 2, k);
ci2 = cc_ref(i, 1, k) + taur * ti2;
ch_ref(i, k, 1) = cc_ref(i, 1, k) + ti2;
cr3 = taui * (cc_ref(i - 1, 3, k) - cc_ref(ic - 1, 2, k));
ci3 = taui * (cc_ref(i, 3, k) + cc_ref(ic, 2, k));
dr2 = cr2 - ci3;
dr3 = cr2 + ci3;
di2 = ci2 + cr3;
di3 = ci2 - cr3;
ch_ref(i - 1, k, 2) = wa1[i - 2] * dr2 - wa1[i - 1] * di2;
ch_ref(i, k, 2) = wa1[i - 2] * di2 + wa1[i - 1] * dr2;
ch_ref(i - 1, k, 3) = wa2[i - 2] * dr3 - wa2[i - 1] * di3;
ch_ref(i, k, 3) = wa2[i - 2] * di3 + wa2[i - 1] * dr3;
}
}
} /* radb3 */
#undef ch_ref
#undef cc_ref
static void radb4(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3)
{
/* Initialized data */
static const real sqrt2 = 1.414213562373095f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*4 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 5;
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
/* Function Body */
for (k = 1; k <= l1; ++k) {
tr1 = cc_ref(1, 1, k) - cc_ref(ido, 4, k);
tr2 = cc_ref(1, 1, k) + cc_ref(ido, 4, k);
tr3 = cc_ref(ido, 2, k) + cc_ref(ido, 2, k);
tr4 = cc_ref(1, 3, k) + cc_ref(1, 3, k);
ch_ref(1, k, 1) = tr2 + tr3;
ch_ref(1, k, 2) = tr1 - tr4;
ch_ref(1, k, 3) = tr2 - tr3;
ch_ref(1, k, 4) = tr1 + tr4;
}
if (ido < 2) return;
if (ido != 2) {
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
ti1 = cc_ref(i, 1, k) + cc_ref(ic, 4, k);
ti2 = cc_ref(i, 1, k) - cc_ref(ic, 4, k);
ti3 = cc_ref(i, 3, k) - cc_ref(ic, 2, k);
tr4 = cc_ref(i, 3, k) + cc_ref(ic, 2, k);
tr1 = cc_ref(i - 1, 1, k) - cc_ref(ic - 1, 4, k);
tr2 = cc_ref(i - 1, 1, k) + cc_ref(ic - 1, 4, k);
ti4 = cc_ref(i - 1, 3, k) - cc_ref(ic - 1, 2, k);
tr3 = cc_ref(i - 1, 3, k) + cc_ref(ic - 1, 2, k);
ch_ref(i - 1, k, 1) = tr2 + tr3;
cr3 = tr2 - tr3;
ch_ref(i, k, 1) = ti2 + ti3;
ci3 = ti2 - ti3;
cr2 = tr1 - tr4;
cr4 = tr1 + tr4;
ci2 = ti1 + ti4;
ci4 = ti1 - ti4;
ch_ref(i - 1, k, 2) = wa1[i - 2] * cr2 - wa1[i - 1] * ci2;
ch_ref(i, k, 2) = wa1[i - 2] * ci2 + wa1[i - 1] * cr2;
ch_ref(i - 1, k, 3) = wa2[i - 2] * cr3 - wa2[i - 1] * ci3;
ch_ref(i, k, 3) = wa2[i - 2] * ci3 + wa2[i - 1] * cr3;
ch_ref(i - 1, k, 4) = wa3[i - 2] * cr4 - wa3[i - 1] * ci4;
ch_ref(i, k, 4) = wa3[i - 2] * ci4 + wa3[i - 1] * cr4;
}
}
if (ido % 2 == 1) return;
}
for (k = 1; k <= l1; ++k) {
ti1 = cc_ref(1, 2, k) + cc_ref(1, 4, k);
ti2 = cc_ref(1, 4, k) - cc_ref(1, 2, k);
tr1 = cc_ref(ido, 1, k) - cc_ref(ido, 3, k);
tr2 = cc_ref(ido, 1, k) + cc_ref(ido, 3, k);
ch_ref(ido, k, 1) = tr2 + tr2;
ch_ref(ido, k, 2) = sqrt2 * (tr1 - ti1);
ch_ref(ido, k, 3) = ti2 + ti2;
ch_ref(ido, k, 4) = -sqrt2 * (tr1 + ti1);
}
} /* radb4 */
#undef ch_ref
#undef cc_ref
static void radb5(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3, const real *wa4)
{
/* Initialized data */
static const real tr11 = .309016994374947f;
static const real ti11 = .951056516295154f;
static const real tr12 = -.809016994374947f;
static const real ti12 = .587785252292473f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*5 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
cc_offset = 1 + ido * 6;
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
--wa4;
/* Function Body */
for (k = 1; k <= l1; ++k) {
ti5 = cc_ref(1, 3, k) + cc_ref(1, 3, k);
ti4 = cc_ref(1, 5, k) + cc_ref(1, 5, k);
tr2 = cc_ref(ido, 2, k) + cc_ref(ido, 2, k);
tr3 = cc_ref(ido, 4, k) + cc_ref(ido, 4, k);
ch_ref(1, k, 1) = cc_ref(1, 1, k) + tr2 + tr3;
cr2 = cc_ref(1, 1, k) + tr11 * tr2 + tr12 * tr3;
cr3 = cc_ref(1, 1, k) + tr12 * tr2 + tr11 * tr3;
ci5 = ti11 * ti5 + ti12 * ti4;
ci4 = ti12 * ti5 - ti11 * ti4;
ch_ref(1, k, 2) = cr2 - ci5;
ch_ref(1, k, 3) = cr3 - ci4;
ch_ref(1, k, 4) = cr3 + ci4;
ch_ref(1, k, 5) = cr2 + ci5;
}
if (ido == 1) {
return;
}
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
ti5 = cc_ref(i, 3, k) + cc_ref(ic, 2, k);
ti2 = cc_ref(i, 3, k) - cc_ref(ic, 2, k);
ti4 = cc_ref(i, 5, k) + cc_ref(ic, 4, k);
ti3 = cc_ref(i, 5, k) - cc_ref(ic, 4, k);
tr5 = cc_ref(i - 1, 3, k) - cc_ref(ic - 1, 2, k);
tr2 = cc_ref(i - 1, 3, k) + cc_ref(ic - 1, 2, k);
tr4 = cc_ref(i - 1, 5, k) - cc_ref(ic - 1, 4, k);
tr3 = cc_ref(i - 1, 5, k) + cc_ref(ic - 1, 4, k);
ch_ref(i - 1, k, 1) = cc_ref(i - 1, 1, k) + tr2 + tr3;
ch_ref(i, k, 1) = cc_ref(i, 1, k) + ti2 + ti3;
cr2 = cc_ref(i - 1, 1, k) + tr11 * tr2 + tr12 * tr3;
ci2 = cc_ref(i, 1, k) + tr11 * ti2 + tr12 * ti3;
cr3 = cc_ref(i - 1, 1, k) + tr12 * tr2 + tr11 * tr3;
ci3 = cc_ref(i, 1, k) + tr12 * ti2 + tr11 * ti3;
cr5 = ti11 * tr5 + ti12 * tr4;
ci5 = ti11 * ti5 + ti12 * ti4;
cr4 = ti12 * tr5 - ti11 * tr4;
ci4 = ti12 * ti5 - ti11 * ti4;
dr3 = cr3 - ci4;
dr4 = cr3 + ci4;
di3 = ci3 + cr4;
di4 = ci3 - cr4;
dr5 = cr2 + ci5;
dr2 = cr2 - ci5;
di5 = ci2 - cr5;
di2 = ci2 + cr5;
ch_ref(i - 1, k, 2) = wa1[i - 2] * dr2 - wa1[i - 1] * di2;
ch_ref(i, k, 2) = wa1[i - 2] * di2 + wa1[i - 1] * dr2;
ch_ref(i - 1, k, 3) = wa2[i - 2] * dr3 - wa2[i - 1] * di3;
ch_ref(i, k, 3) = wa2[i - 2] * di3 + wa2[i - 1] * dr3;
ch_ref(i - 1, k, 4) = wa3[i - 2] * dr4 - wa3[i - 1] * di4;
ch_ref(i, k, 4) = wa3[i - 2] * di4 + wa3[i - 1] * dr4;
ch_ref(i - 1, k, 5) = wa4[i - 2] * dr5 - wa4[i - 1] * di5;
ch_ref(i, k, 5) = wa4[i - 2] * di5 + wa4[i - 1] * dr5;
}
}
} /* radb5 */
#undef ch_ref
#undef cc_ref
static void radbg(integer ido, integer ip, integer l1, integer idl1,
const real *cc, real *c1, real *c2, real *ch, real *ch2, const real *wa)
{
/* System generated locals */
integer ch_offset, cc_offset,
c1_offset, c2_offset, ch2_offset;
/* Local variables */
integer i, j, k, l, j2, ic, jc, lc, ik, is;
real dc2, ai1, ai2, ar1, ar2, ds2;
integer nbd;
real dcp, arg, dsp, ar1h, ar2h;
integer idp2, ipp2, idij, ipph;
#define c1_ref(a_1,a_2,a_3) c1[((a_3)*l1 + (a_2))*ido + a_1]
#define c2_ref(a_1,a_2) c2[(a_2)*idl1 + a_1]
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*ip + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
#define ch2_ref(a_1,a_2) ch2[(a_2)*idl1 + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
c1_offset = 1 + ido * (1 + l1);
c1 -= c1_offset;
cc_offset = 1 + ido * (1 + ip);
cc -= cc_offset;
ch2_offset = 1 + idl1;
ch2 -= ch2_offset;
c2_offset = 1 + idl1;
c2 -= c2_offset;
--wa;
/* Function Body */
arg = (2*M_PI) / (real) (ip);
dcp = cos(arg);
dsp = sin(arg);
idp2 = ido + 2;
nbd = (ido - 1) / 2;
ipp2 = ip + 2;
ipph = (ip + 1) / 2;
if (ido >= l1) {
for (k = 1; k <= l1; ++k) {
for (i = 1; i <= ido; ++i) {
ch_ref(i, k, 1) = cc_ref(i, 1, k);
}
}
} else {
for (i = 1; i <= ido; ++i) {
for (k = 1; k <= l1; ++k) {
ch_ref(i, k, 1) = cc_ref(i, 1, k);
}
}
}
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
j2 = j + j;
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, j) = cc_ref(ido, j2 - 2, k) + cc_ref(ido, j2 - 2, k);
ch_ref(1, k, jc) = cc_ref(1, j2 - 1, k) + cc_ref(1, j2 - 1, k);
}
}
if (ido != 1) {
if (nbd >= l1) {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
ch_ref(i - 1, k, j) = cc_ref(i - 1, (j << 1) - 1, k) + cc_ref(ic - 1, (j << 1) - 2, k);
ch_ref(i - 1, k, jc) = cc_ref(i - 1, (j << 1) - 1, k) - cc_ref(ic - 1, (j << 1) - 2, k);
ch_ref(i, k, j) = cc_ref(i, (j << 1) - 1, k) - cc_ref(ic, (j << 1) - 2, k);
ch_ref(i, k, jc) = cc_ref(i, (j << 1) - 1, k) + cc_ref(ic, (j << 1) - 2, k);
}
}
}
} else {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
for (k = 1; k <= l1; ++k) {
ch_ref(i - 1, k, j) = cc_ref(i - 1, (j << 1) - 1, k) + cc_ref(ic - 1, (j << 1) - 2, k);
ch_ref(i - 1, k, jc) = cc_ref(i - 1, (j << 1) - 1, k) - cc_ref(ic - 1, (j << 1) - 2, k);
ch_ref(i, k, j) = cc_ref(i, (j << 1) - 1, k) - cc_ref(ic, (j << 1) - 2, k);
ch_ref(i, k, jc) = cc_ref(i, (j << 1) - 1, k) + cc_ref(ic, (j << 1) - 2, k);
}
}
}
}
}
ar1 = 1.f;
ai1 = 0.f;
for (l = 2; l <= ipph; ++l) {
lc = ipp2 - l;
ar1h = dcp * ar1 - dsp * ai1;
ai1 = dcp * ai1 + dsp * ar1;
ar1 = ar1h;
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, l) = ch2_ref(ik, 1) + ar1 * ch2_ref(ik, 2);
c2_ref(ik, lc) = ai1 * ch2_ref(ik, ip);
}
dc2 = ar1;
ds2 = ai1;
ar2 = ar1;
ai2 = ai1;
for (j = 3; j <= ipph; ++j) {
jc = ipp2 - j;
ar2h = dc2 * ar2 - ds2 * ai2;
ai2 = dc2 * ai2 + ds2 * ar2;
ar2 = ar2h;
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, l) = c2_ref(ik, l) + ar2 * ch2_ref(ik, j);
c2_ref(ik, lc) = c2_ref(ik, lc) + ai2 * ch2_ref(ik, jc);
}
}
}
for (j = 2; j <= ipph; ++j) {
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, 1) = ch2_ref(ik, 1) + ch2_ref(ik, j);
}
}
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, j) = c1_ref(1, k, j) - c1_ref(1, k, jc);
ch_ref(1, k, jc) = c1_ref(1, k, j) + c1_ref(1, k, jc);
}
}
if (ido != 1) {
if (nbd >= l1) {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ch_ref(i - 1, k, j) = c1_ref(i - 1, k, j) - c1_ref(i, k, jc);
ch_ref(i - 1, k, jc) = c1_ref(i - 1, k, j) + c1_ref(i, k, jc);
ch_ref(i, k, j) = c1_ref(i, k, j) + c1_ref(i - 1, k, jc);
ch_ref(i, k, jc) = c1_ref(i, k, j) - c1_ref(i - 1, k, jc);
}
}
}
} else {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (i = 3; i <= ido; i += 2) {
for (k = 1; k <= l1; ++k) {
ch_ref(i - 1, k, j) = c1_ref(i - 1, k, j) - c1_ref(i, k, jc);
ch_ref(i - 1, k, jc) = c1_ref(i - 1, k, j) + c1_ref(i, k, jc);
ch_ref(i, k, j) = c1_ref(i, k, j) + c1_ref(i - 1, k, jc);
ch_ref(i, k, jc) = c1_ref(i, k, j) - c1_ref(i - 1, k, jc);
}
}
}
}
}
if (ido == 1) {
return;
}
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, 1) = ch2_ref(ik, 1);
}
for (j = 2; j <= ip; ++j) {
for (k = 1; k <= l1; ++k) {
c1_ref(1, k, j) = ch_ref(1, k, j);
}
}
if (nbd <= l1) {
is = -(ido);
for (j = 2; j <= ip; ++j) {
is += ido;
idij = is;
for (i = 3; i <= ido; i += 2) {
idij += 2;
for (k = 1; k <= l1; ++k) {
c1_ref(i - 1, k, j) = wa[idij - 1] * ch_ref(i - 1, k, j)
- wa[idij] * ch_ref(i, k, j);
c1_ref(i, k, j) = wa[idij - 1] * ch_ref(i, k, j) + wa[idij] * ch_ref(i - 1, k, j);
}
}
}
} else {
is = -(ido);
for (j = 2; j <= ip; ++j) {
is += ido;
for (k = 1; k <= l1; ++k) {
idij = is;
for (i = 3; i <= ido; i += 2) {
idij += 2;
c1_ref(i - 1, k, j) = wa[idij - 1] * ch_ref(i - 1, k, j)
- wa[idij] * ch_ref(i, k, j);
c1_ref(i, k, j) = wa[idij - 1] * ch_ref(i, k, j) + wa[idij] * ch_ref(i - 1, k, j);
}
}
}
}
} /* radbg */
#undef ch2_ref
#undef ch_ref
#undef cc_ref
#undef c2_ref
#undef c1_ref
static void radf2(integer ido, integer l1, const real *cc, real *ch,
const real *wa1)
{
/* System generated locals */
integer ch_offset, cc_offset;
/* Local variables */
integer i, k, ic;
real ti2, tr2;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*l1 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*2 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * 3;
ch -= ch_offset;
cc_offset = 1 + ido * (1 + l1);
cc -= cc_offset;
--wa1;
/* Function Body */
for (k = 1; k <= l1; ++k) {
ch_ref(1, 1, k) = cc_ref(1, k, 1) + cc_ref(1, k, 2);
ch_ref(ido, 2, k) = cc_ref(1, k, 1) - cc_ref(1, k, 2);
}
if (ido < 2) return;
if (ido != 2) {
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
tr2 = wa1[i - 2] * cc_ref(i - 1, k, 2) + wa1[i - 1] *
cc_ref(i, k, 2);
ti2 = wa1[i - 2] * cc_ref(i, k, 2) - wa1[i - 1] * cc_ref(
i - 1, k, 2);
ch_ref(i, 1, k) = cc_ref(i, k, 1) + ti2;
ch_ref(ic, 2, k) = ti2 - cc_ref(i, k, 1);
ch_ref(i - 1, 1, k) = cc_ref(i - 1, k, 1) + tr2;
ch_ref(ic - 1, 2, k) = cc_ref(i - 1, k, 1) - tr2;
}
}
if (ido % 2 == 1) {
return;
}
}
for (k = 1; k <= l1; ++k) {
ch_ref(1, 2, k) = -cc_ref(ido, k, 2);
ch_ref(ido, 1, k) = cc_ref(ido, k, 1);
}
} /* radf2 */
#undef ch_ref
#undef cc_ref
static void radf3(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2)
{
static const real taur = -.5f;
static const real taui = .866025403784439f;
/* System generated locals */
integer ch_offset, cc_offset;
/* Local variables */
integer i, k, ic;
real ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*l1 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*3 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + (ido << 2);
ch -= ch_offset;
cc_offset = 1 + ido * (1 + l1);
cc -= cc_offset;
--wa1;
--wa2;
/* Function Body */
for (k = 1; k <= l1; ++k) {
cr2 = cc_ref(1, k, 2) + cc_ref(1, k, 3);
ch_ref(1, 1, k) = cc_ref(1, k, 1) + cr2;
ch_ref(1, 3, k) = taui * (cc_ref(1, k, 3) - cc_ref(1, k, 2));
ch_ref(ido, 2, k) = cc_ref(1, k, 1) + taur * cr2;
}
if (ido == 1) {
return;
}
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
dr2 = wa1[i - 2] * cc_ref(i - 1, k, 2) + wa1[i - 1] *
cc_ref(i, k, 2);
di2 = wa1[i - 2] * cc_ref(i, k, 2) - wa1[i - 1] * cc_ref(
i - 1, k, 2);
dr3 = wa2[i - 2] * cc_ref(i - 1, k, 3) + wa2[i - 1] *
cc_ref(i, k, 3);
di3 = wa2[i - 2] * cc_ref(i, k, 3) - wa2[i - 1] * cc_ref(
i - 1, k, 3);
cr2 = dr2 + dr3;
ci2 = di2 + di3;
ch_ref(i - 1, 1, k) = cc_ref(i - 1, k, 1) + cr2;
ch_ref(i, 1, k) = cc_ref(i, k, 1) + ci2;
tr2 = cc_ref(i - 1, k, 1) + taur * cr2;
ti2 = cc_ref(i, k, 1) + taur * ci2;
tr3 = taui * (di2 - di3);
ti3 = taui * (dr3 - dr2);
ch_ref(i - 1, 3, k) = tr2 + tr3;
ch_ref(ic - 1, 2, k) = tr2 - tr3;
ch_ref(i, 3, k) = ti2 + ti3;
ch_ref(ic, 2, k) = ti3 - ti2;
}
}
} /* radf3 */
#undef ch_ref
#undef cc_ref
static void radf4(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3)
{
/* Initialized data */
static const real hsqt2 = .7071067811865475f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*l1 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*4 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * 5;
ch -= ch_offset;
cc_offset = 1 + ido * (1 + l1);
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
/* Function Body */
for (k = 1; k <= l1; ++k) {
tr1 = cc_ref(1, k, 2) + cc_ref(1, k, 4);
tr2 = cc_ref(1, k, 1) + cc_ref(1, k, 3);
ch_ref(1, 1, k) = tr1 + tr2;
ch_ref(ido, 4, k) = tr2 - tr1;
ch_ref(ido, 2, k) = cc_ref(1, k, 1) - cc_ref(1, k, 3);
ch_ref(1, 3, k) = cc_ref(1, k, 4) - cc_ref(1, k, 2);
}
if (ido < 2) return;
if (ido != 2) {
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
cr2 = wa1[i - 2] * cc_ref(i - 1, k, 2) + wa1[i - 1] *
cc_ref(i, k, 2);
ci2 = wa1[i - 2] * cc_ref(i, k, 2) - wa1[i - 1] * cc_ref(
i - 1, k, 2);
cr3 = wa2[i - 2] * cc_ref(i - 1, k, 3) + wa2[i - 1] *
cc_ref(i, k, 3);
ci3 = wa2[i - 2] * cc_ref(i, k, 3) - wa2[i - 1] * cc_ref(
i - 1, k, 3);
cr4 = wa3[i - 2] * cc_ref(i - 1, k, 4) + wa3[i - 1] *
cc_ref(i, k, 4);
ci4 = wa3[i - 2] * cc_ref(i, k, 4) - wa3[i - 1] * cc_ref(
i - 1, k, 4);
tr1 = cr2 + cr4;
tr4 = cr4 - cr2;
ti1 = ci2 + ci4;
ti4 = ci2 - ci4;
ti2 = cc_ref(i, k, 1) + ci3;
ti3 = cc_ref(i, k, 1) - ci3;
tr2 = cc_ref(i - 1, k, 1) + cr3;
tr3 = cc_ref(i - 1, k, 1) - cr3;
ch_ref(i - 1, 1, k) = tr1 + tr2;
ch_ref(ic - 1, 4, k) = tr2 - tr1;
ch_ref(i, 1, k) = ti1 + ti2;
ch_ref(ic, 4, k) = ti1 - ti2;
ch_ref(i - 1, 3, k) = ti4 + tr3;
ch_ref(ic - 1, 2, k) = tr3 - ti4;
ch_ref(i, 3, k) = tr4 + ti3;
ch_ref(ic, 2, k) = tr4 - ti3;
}
}
if (ido % 2 == 1) {
return;
}
}
for (k = 1; k <= l1; ++k) {
ti1 = -hsqt2 * (cc_ref(ido, k, 2) + cc_ref(ido, k, 4));
tr1 = hsqt2 * (cc_ref(ido, k, 2) - cc_ref(ido, k, 4));
ch_ref(ido, 1, k) = tr1 + cc_ref(ido, k, 1);
ch_ref(ido, 3, k) = cc_ref(ido, k, 1) - tr1;
ch_ref(1, 2, k) = ti1 - cc_ref(ido, k, 3);
ch_ref(1, 4, k) = ti1 + cc_ref(ido, k, 3);
}
} /* radf4 */
#undef ch_ref
#undef cc_ref
static void radf5(integer ido, integer l1, const real *cc, real *ch,
const real *wa1, const real *wa2, const real *wa3, const real *wa4)
{
/* Initialized data */
static const real tr11 = .309016994374947f;
static const real ti11 = .951056516295154f;
static const real tr12 = -.809016994374947f;
static const real ti12 = .587785252292473f;
/* System generated locals */
integer cc_offset, ch_offset;
/* Local variables */
integer i, k, ic;
real ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5,
cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
integer idp2;
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*l1 + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*5 + (a_2))*ido + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * 6;
ch -= ch_offset;
cc_offset = 1 + ido * (1 + l1);
cc -= cc_offset;
--wa1;
--wa2;
--wa3;
--wa4;
/* Function Body */
for (k = 1; k <= l1; ++k) {
cr2 = cc_ref(1, k, 5) + cc_ref(1, k, 2);
ci5 = cc_ref(1, k, 5) - cc_ref(1, k, 2);
cr3 = cc_ref(1, k, 4) + cc_ref(1, k, 3);
ci4 = cc_ref(1, k, 4) - cc_ref(1, k, 3);
ch_ref(1, 1, k) = cc_ref(1, k, 1) + cr2 + cr3;
ch_ref(ido, 2, k) = cc_ref(1, k, 1) + tr11 * cr2 + tr12 * cr3;
ch_ref(1, 3, k) = ti11 * ci5 + ti12 * ci4;
ch_ref(ido, 4, k) = cc_ref(1, k, 1) + tr12 * cr2 + tr11 * cr3;
ch_ref(1, 5, k) = ti12 * ci5 - ti11 * ci4;
}
if (ido == 1) {
return;
}
idp2 = ido + 2;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
dr2 = wa1[i - 2] * cc_ref(i - 1, k, 2) + wa1[i - 1] * cc_ref(i, k, 2);
di2 = wa1[i - 2] * cc_ref(i, k, 2) - wa1[i - 1] * cc_ref(i - 1, k, 2);
dr3 = wa2[i - 2] * cc_ref(i - 1, k, 3) + wa2[i - 1] * cc_ref(i, k, 3);
di3 = wa2[i - 2] * cc_ref(i, k, 3) - wa2[i - 1] * cc_ref(i - 1, k, 3);
dr4 = wa3[i - 2] * cc_ref(i - 1, k, 4) + wa3[i - 1] * cc_ref(i, k, 4);
di4 = wa3[i - 2] * cc_ref(i, k, 4) - wa3[i - 1] * cc_ref(i - 1, k, 4);
dr5 = wa4[i - 2] * cc_ref(i - 1, k, 5) + wa4[i - 1] * cc_ref(i, k, 5);
di5 = wa4[i - 2] * cc_ref(i, k, 5) - wa4[i - 1] * cc_ref(i - 1, k, 5);
cr2 = dr2 + dr5;
ci5 = dr5 - dr2;
cr5 = di2 - di5;
ci2 = di2 + di5;
cr3 = dr3 + dr4;
ci4 = dr4 - dr3;
cr4 = di3 - di4;
ci3 = di3 + di4;
ch_ref(i - 1, 1, k) = cc_ref(i - 1, k, 1) + cr2 + cr3;
ch_ref(i, 1, k) = cc_ref(i, k, 1) + ci2 + ci3;
tr2 = cc_ref(i - 1, k, 1) + tr11 * cr2 + tr12 * cr3;
ti2 = cc_ref(i, k, 1) + tr11 * ci2 + tr12 * ci3;
tr3 = cc_ref(i - 1, k, 1) + tr12 * cr2 + tr11 * cr3;
ti3 = cc_ref(i, k, 1) + tr12 * ci2 + tr11 * ci3;
tr5 = ti11 * cr5 + ti12 * cr4;
ti5 = ti11 * ci5 + ti12 * ci4;
tr4 = ti12 * cr5 - ti11 * cr4;
ti4 = ti12 * ci5 - ti11 * ci4;
ch_ref(i - 1, 3, k) = tr2 + tr5;
ch_ref(ic - 1, 2, k) = tr2 - tr5;
ch_ref(i, 3, k) = ti2 + ti5;
ch_ref(ic, 2, k) = ti5 - ti2;
ch_ref(i - 1, 5, k) = tr3 + tr4;
ch_ref(ic - 1, 4, k) = tr3 - tr4;
ch_ref(i, 5, k) = ti3 + ti4;
ch_ref(ic, 4, k) = ti4 - ti3;
}
}
} /* radf5 */
#undef ch_ref
#undef cc_ref
static void radfg(integer ido, integer ip, integer l1, integer idl1,
real *cc, real *c1, real *c2, real *ch, real *ch2, const real *wa)
{
/* System generated locals */
integer ch_offset, cc_offset,
c1_offset, c2_offset, ch2_offset;
/* Local variables */
integer i, j, k, l, j2, ic, jc, lc, ik, is;
real dc2, ai1, ai2, ar1, ar2, ds2;
integer nbd;
real dcp, arg, dsp, ar1h, ar2h;
integer idp2, ipp2, idij, ipph;
#define c1_ref(a_1,a_2,a_3) c1[((a_3)*l1 + (a_2))*ido + a_1]
#define c2_ref(a_1,a_2) c2[(a_2)*idl1 + a_1]
#define cc_ref(a_1,a_2,a_3) cc[((a_3)*ip + (a_2))*ido + a_1]
#define ch_ref(a_1,a_2,a_3) ch[((a_3)*l1 + (a_2))*ido + a_1]
#define ch2_ref(a_1,a_2) ch2[(a_2)*idl1 + a_1]
/* Parameter adjustments */
ch_offset = 1 + ido * (1 + l1);
ch -= ch_offset;
c1_offset = 1 + ido * (1 + l1);
c1 -= c1_offset;
cc_offset = 1 + ido * (1 + ip);
cc -= cc_offset;
ch2_offset = 1 + idl1;
ch2 -= ch2_offset;
c2_offset = 1 + idl1;
c2 -= c2_offset;
--wa;
/* Function Body */
arg = (2*M_PI) / (real) (ip);
dcp = cos(arg);
dsp = sin(arg);
ipph = (ip + 1) / 2;
ipp2 = ip + 2;
idp2 = ido + 2;
nbd = (ido - 1) / 2;
if (ido == 1) {
for (ik = 1; ik <= idl1; ++ik) {
c2_ref(ik, 1) = ch2_ref(ik, 1);
}
} else {
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, 1) = c2_ref(ik, 1);
}
for (j = 2; j <= ip; ++j) {
for (k = 1; k <= l1; ++k) {
ch_ref(1, k, j) = c1_ref(1, k, j);
}
}
if (nbd <= l1) {
is = -(ido);
for (j = 2; j <= ip; ++j) {
is += ido;
idij = is;
for (i = 3; i <= ido; i += 2) {
idij += 2;
for (k = 1; k <= l1; ++k) {
ch_ref(i - 1, k, j) = wa[idij - 1] * c1_ref(i - 1, k, j)
+ wa[idij] * c1_ref(i, k, j);
ch_ref(i, k, j) = wa[idij - 1] * c1_ref(i, k, j) - wa[
idij] * c1_ref(i - 1, k, j);
}
}
}
} else {
is = -(ido);
for (j = 2; j <= ip; ++j) {
is += ido;
for (k = 1; k <= l1; ++k) {
idij = is;
for (i = 3; i <= ido; i += 2) {
idij += 2;
ch_ref(i - 1, k, j) = wa[idij - 1] * c1_ref(i - 1, k, j)
+ wa[idij] * c1_ref(i, k, j);
ch_ref(i, k, j) = wa[idij - 1] * c1_ref(i, k, j) - wa[
idij] * c1_ref(i - 1, k, j);
}
}
}
}
if (nbd >= l1) {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
c1_ref(i - 1, k, j) = ch_ref(i - 1, k, j) + ch_ref(i -
1, k, jc);
c1_ref(i - 1, k, jc) = ch_ref(i, k, j) - ch_ref(i, k,
jc);
c1_ref(i, k, j) = ch_ref(i, k, j) + ch_ref(i, k, jc);
c1_ref(i, k, jc) = ch_ref(i - 1, k, jc) - ch_ref(i - 1,
k, j);
}
}
}
} else {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (i = 3; i <= ido; i += 2) {
for (k = 1; k <= l1; ++k) {
c1_ref(i - 1, k, j) = ch_ref(i - 1, k, j) + ch_ref(i -
1, k, jc);
c1_ref(i - 1, k, jc) = ch_ref(i, k, j) - ch_ref(i, k,
jc);
c1_ref(i, k, j) = ch_ref(i, k, j) + ch_ref(i, k, jc);
c1_ref(i, k, jc) = ch_ref(i - 1, k, jc) - ch_ref(i - 1,
k, j);
}
}
}
}
}
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
for (k = 1; k <= l1; ++k) {
c1_ref(1, k, j) = ch_ref(1, k, j) + ch_ref(1, k, jc);
c1_ref(1, k, jc) = ch_ref(1, k, jc) - ch_ref(1, k, j);
}
}
ar1 = 1.f;
ai1 = 0.f;
for (l = 2; l <= ipph; ++l) {
lc = ipp2 - l;
ar1h = dcp * ar1 - dsp * ai1;
ai1 = dcp * ai1 + dsp * ar1;
ar1 = ar1h;
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, l) = c2_ref(ik, 1) + ar1 * c2_ref(ik, 2);
ch2_ref(ik, lc) = ai1 * c2_ref(ik, ip);
}
dc2 = ar1;
ds2 = ai1;
ar2 = ar1;
ai2 = ai1;
for (j = 3; j <= ipph; ++j) {
jc = ipp2 - j;
ar2h = dc2 * ar2 - ds2 * ai2;
ai2 = dc2 * ai2 + ds2 * ar2;
ar2 = ar2h;
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, l) = ch2_ref(ik, l) + ar2 * c2_ref(ik, j);
ch2_ref(ik, lc) = ch2_ref(ik, lc) + ai2 * c2_ref(ik, jc);
}
}
}
for (j = 2; j <= ipph; ++j) {
for (ik = 1; ik <= idl1; ++ik) {
ch2_ref(ik, 1) = ch2_ref(ik, 1) + c2_ref(ik, j);
}
}
if (ido >= l1) {
for (k = 1; k <= l1; ++k) {
for (i = 1; i <= ido; ++i) {
cc_ref(i, 1, k) = ch_ref(i, k, 1);
}
}
} else {
for (i = 1; i <= ido; ++i) {
for (k = 1; k <= l1; ++k) {
cc_ref(i, 1, k) = ch_ref(i, k, 1);
}
}
}
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
j2 = j + j;
for (k = 1; k <= l1; ++k) {
cc_ref(ido, j2 - 2, k) = ch_ref(1, k, j);
cc_ref(1, j2 - 1, k) = ch_ref(1, k, jc);
}
}
if (ido == 1) {
return;
}
if (nbd >= l1) {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
j2 = j + j;
for (k = 1; k <= l1; ++k) {
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
cc_ref(i - 1, j2 - 1, k) = ch_ref(i - 1, k, j) + ch_ref(
i - 1, k, jc);
cc_ref(ic - 1, j2 - 2, k) = ch_ref(i - 1, k, j) - ch_ref(
i - 1, k, jc);
cc_ref(i, j2 - 1, k) = ch_ref(i, k, j) + ch_ref(i, k,
jc);
cc_ref(ic, j2 - 2, k) = ch_ref(i, k, jc) - ch_ref(i, k, j)
;
}
}
}
} else {
for (j = 2; j <= ipph; ++j) {
jc = ipp2 - j;
j2 = j + j;
for (i = 3; i <= ido; i += 2) {
ic = idp2 - i;
for (k = 1; k <= l1; ++k) {
cc_ref(i - 1, j2 - 1, k) = ch_ref(i - 1, k, j) + ch_ref(
i - 1, k, jc);
cc_ref(ic - 1, j2 - 2, k) = ch_ref(i - 1, k, j) - ch_ref(
i - 1, k, jc);
cc_ref(i, j2 - 1, k) = ch_ref(i, k, j) + ch_ref(i, k,
jc);
cc_ref(ic, j2 - 2, k) = ch_ref(i, k, jc) - ch_ref(i, k, j)
;
}
}
}
}
} /* radfg */
#undef ch2_ref
#undef ch_ref
#undef cc_ref
#undef c2_ref
#undef c1_ref
static void cfftb1(integer n, real *c, real *ch, const real *wa, integer *ifac)
{
integer i, k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, nac, ido,
idl1, idot;
/* Function Body */
nf = ifac[1];
na = 0;
l1 = 1;
iw = 0;
for (k1 = 1; k1 <= nf; ++k1) {
ip = ifac[k1 + 1];
l2 = ip * l1;
ido = n / l2;
idot = ido + ido;
idl1 = idot * l1;
switch (ip) {
case 4:
ix2 = iw + idot;
ix3 = ix2 + idot;
passb4(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2], &wa[ix3]);
na = 1 - na;
break;
case 2:
passb2(idot, l1, na?ch:c, na?c:ch, &wa[iw]);
na = 1 - na;
break;
case 3:
ix2 = iw + idot;
passb3(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2]);
na = 1 - na;
break;
case 5:
ix2 = iw + idot;
ix3 = ix2 + idot;
ix4 = ix3 + idot;
passfb5(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4], +1);
na = 1 - na;
break;
default:
if (na == 0) {
passfb(&nac, idot, ip, l1, idl1, c, c, c, ch, ch, &wa[iw], +1);
} else {
passfb(&nac, idot, ip, l1, idl1, ch, ch, ch, c, c, &wa[iw], +1);
}
if (nac != 0) {
na = 1 - na;
}
break;
}
l1 = l2;
iw += (ip - 1) * idot;
}
if (na == 0) {
return;
}
for (i = 0; i < 2*n; ++i) {
c[i] = ch[i];
}
} /* cfftb1 */
void cfftb(integer n, real *c, real *wsave)
{
integer iw1, iw2;
/* Parameter adjustments */
--wsave;
--c;
/* Function Body */
if (n == 1) {
return;
}
iw1 = 2*n + 1;
iw2 = iw1 + 2*n;
cfftb1(n, &c[1], &wsave[1], &wsave[iw1], (int*)&wsave[iw2]);
} /* cfftb */
static void cfftf1(integer n, real *c, real *ch, const real *wa, integer *ifac)
{
/* Local variables */
integer i, k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, nac, ido,
idl1, idot;
/* Function Body */
nf = ifac[1];
na = 0;
l1 = 1;
iw = 0;
for (k1 = 1; k1 <= nf; ++k1) {
ip = ifac[k1 + 1];
l2 = ip * l1;
ido = n / l2;
idot = ido + ido;
idl1 = idot * l1;
switch (ip) {
case 4:
ix2 = iw + idot;
ix3 = ix2 + idot;
passf4(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2], &wa[ix3]);
na = 1 - na;
break;
case 2:
passf2(idot, l1, na?ch:c, na?c:ch, &wa[iw]);
na = 1 - na;
break;
case 3:
ix2 = iw + idot;
passf3(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2]);
na = 1 - na;
break;
case 5:
ix2 = iw + idot;
ix3 = ix2 + idot;
ix4 = ix3 + idot;
passfb5(idot, l1, na?ch:c, na?c:ch, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4], -1);
na = 1 - na;
break;
default:
if (na == 0) {
passfb(&nac, idot, ip, l1, idl1, c, c, c, ch, ch, &wa[iw], -1);
} else {
passfb(&nac, idot, ip, l1, idl1, ch, ch, ch, c, c, &wa[iw], -1);
}
if (nac != 0) {
na = 1 - na;
}
break;
}
l1 = l2;
iw += (ip - 1)*idot;
}
if (na == 0) {
return;
}
for (i = 0; i < 2*n; ++i) {
c[i] = ch[i];
}
} /* cfftf1 */
void cfftf(integer n, real *c, real *wsave)
{
integer iw1, iw2;
/* Parameter adjustments */
--wsave;
--c;
/* Function Body */
if (n == 1) {
return;
}
iw1 = 2*n + 1;
iw2 = iw1 + 2*n;
cfftf1(n, &c[1], &wsave[1], &wsave[iw1], (int*)&wsave[iw2]);
} /* cfftf */
static int decompose(integer n, integer *ifac, integer ntryh[4]) {
integer ntry=0, nl = n, nf = 0, nq, nr, i, j = 0;
do