/* fftpackc.c is the fortran FFTPACK package retrieved from netlib */ /* allf.f -- translated by f2c (version 19970805). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ /* #include "f2c.h" -- Remplace par ce qui suit */ #include "fftpackc.h" #include /* ------ File cfftb.f ------ */ /* Subroutine */ int cfftb_(int_4 *n, r_4 *c__, r_4 *wsave) { extern /* Subroutine */ int cfftb1_(int_4 *, r_4 *, r_4 *, r_4 *, int_4 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; --c__; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_4 *)&wsave[iw2]); /* (int *) ajoute - Reza 29/11/99 */ return 0; } /* cfftb_ */ /* ------ File cfftb1.f ------ */ /* Subroutine */ int cfftb1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, int_4 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 idot, i__; extern /* Subroutine */ int passb_(int_4 *, int_4 *, int_4 *, int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 k1, l1, l2, n2; extern /* Subroutine */ int passb2_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *), passb3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *), passb4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *), passb5_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idot = ido + ido; idl1 = idot * l1; if (ip != 4) { goto L103; } ix2 = iw + idot; ix3 = ix2 + idot; if (na != 0) { goto L101; } passb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } passb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + idot; if (na != 0) { goto L107; } passb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + idot; ix3 = ix2 + idot; ix4 = ix3 + idot; if (na != 0) { goto L110; } passb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } passb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] , &ch[1], &wa[iw]); goto L114; L113: passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1], &wa[iw]); L114: if (nac != 0) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * idot; /* L116: */ } if (na == 0) { return 0; } n2 = *n + *n; i__1 = n2; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* cfftb1_ */ /* ------ File cfftf.f ------ */ /* Subroutine */ int cfftf_(int_4 *n, r_4 *c__, r_4 *wsave) { extern /* Subroutine */ int cfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, int_4 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; --c__; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_4 *)&wsave[iw2]); /* (int *) ajoute - Reza 29/11/99 */ return 0; } /* cfftf_ */ /* ------ File cfftf1.f ------ */ /* Subroutine */ int cfftf1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, int_4 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 idot, i__; extern /* Subroutine */ int passf_(int_4 *, int_4 *, int_4 *, int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 k1, l1, l2, n2; extern /* Subroutine */ int passf2_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *), passf3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *), passf4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *), passf5_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idot = ido + ido; idl1 = idot * l1; if (ip != 4) { goto L103; } ix2 = iw + idot; ix3 = ix2 + idot; if (na != 0) { goto L101; } passf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } passf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + idot; if (na != 0) { goto L107; } passf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + idot; ix3 = ix2 + idot; ix4 = ix3 + idot; if (na != 0) { goto L110; } passf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } passf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] , &ch[1], &wa[iw]); goto L114; L113: passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1], &wa[iw]); L114: if (nac != 0) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * idot; /* L116: */ } if (na == 0) { return 0; } n2 = *n + *n; i__1 = n2; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* cfftf1_ */ /* ------ File cffti.f ------ */ /* Subroutine */ int cffti_(int_4 *n, r_4 *wsave) { extern /* Subroutine */ int cffti1_(int_4 *, r_4 *, int_4 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cffti1_(n, &wsave[iw1], (int_4 *)&wsave[iw2]); /* (int *) ajoute Reza 29/11/99 */ return 0; } /* cffti_ */ /* ------ File cffti1.f ------ */ /* Subroutine */ int cffti1_(int_4 *n, r_4 *wa, int_4 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 3,4,2,5 }; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); commente, remplace par math.h - Reza 29/11/99 */ /* Local variables */ static r_4 argh; static int_4 idot, ntry, i__, j; static r_4 argld; static int_4 i1, k1, l1, l2, ib; static r_4 fi; static int_4 ld, ii, nf, ip, nl, nq, nr; static r_4 arg; static int_4 ido, ipm; static r_4 tpi; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; tpi = 6.28318530717959f; argh = tpi / (r_4) (*n); i__ = 2; l1 = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; ld = 0; l2 = l1 * ip; ido = *n / l2; idot = ido + ido + 2; ipm = ip - 1; i__2 = ipm; for (j = 1; j <= i__2; ++j) { i1 = i__; wa[i__ - 1] = 1.f; wa[i__] = 0.f; ld += l1; fi = 0.f; argld = (r_4) ld * argh; i__3 = idot; for (ii = 4; ii <= i__3; ii += 2) { i__ += 2; fi += 1.f; arg = fi * argld; wa[i__ - 1] = cos(arg); wa[i__] = sin(arg); /* L108: */ } if (ip <= 5) { goto L109; } wa[i1 - 1] = wa[i__ - 1]; wa[i1] = wa[i__]; L109: ; } l1 = l2; /* L110: */ } return 0; } /* cffti1_ */ /* ------ File cosqb.f ------ */ /* Subroutine */ int cosqb_(int_4 *n, r_4 *x, r_4 *wsave) { /* Initialized data */ static r_4 tsqrt2 = 2.82842712474619f; /* System generated locals */ int_4 i__1; /* Local variables */ static r_4 x1; extern /* Subroutine */ int cosqb1_(int_4 *, r_4 *, r_4 *, r_4 *); /* Parameter adjustments */ --wsave; --x; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: x[1] *= 4.f; return 0; L102: x1 = (x[1] + x[2]) * 4.f; x[2] = tsqrt2 * (x[1] - x[2]); x[1] = x1; return 0; L103: cosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]); return 0; } /* cosqb_ */ /* ------ File cosqb1.f ------ */ /* Subroutine */ int cosqb1_(int_4 *n, r_4 *x, r_4 *w, r_4 *xh) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int rfftb_(int_4 *, r_4 *, r_4 *); static int_4 kc, np2, ns2; static r_4 xim1; /* Parameter adjustments */ --xh; --w; --x; /* Function Body */ ns2 = (*n + 1) / 2; np2 = *n + 2; i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xim1 = x[i__ - 1] + x[i__]; x[i__] -= x[i__ - 1]; x[i__ - 1] = xim1; /* L101: */ } x[1] += x[1]; modn = *n % 2; if (modn == 0) { x[*n] += x[*n]; } rfftb_(n, &x[1], &xh[1]); i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k]; xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc]; /* L102: */ } if (modn == 0) { x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]); } i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; x[k] = xh[k] + xh[kc]; x[kc] = xh[k] - xh[kc]; /* L103: */ } x[1] += x[1]; return 0; } /* cosqb1_ */ /* ------ File cosqf.f ------ */ /* Subroutine */ int cosqf_(int_4 *n, r_4 *x, r_4 *wsave) { /* Initialized data */ static r_4 sqrt2 = 1.4142135623731f; /* System generated locals */ int_4 i__1; /* Local variables */ static r_4 tsqx; extern /* Subroutine */ int cosqf1_(int_4 *, r_4 *, r_4 *, r_4 *); /* Parameter adjustments */ --wsave; --x; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L102; } else if (i__1 == 0) { goto L101; } else { goto L103; } L101: tsqx = sqrt2 * x[2]; x[2] = x[1] - tsqx; x[1] += tsqx; L102: return 0; L103: cosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]); return 0; } /* cosqf_ */ /* ------ File cosqf1.f ------ */ /* Subroutine */ int cosqf1_(int_4 *n, r_4 *x, r_4 *w, r_4 *xh) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); static int_4 kc, np2, ns2; static r_4 xim1; /* Parameter adjustments */ --xh; --w; --x; /* Function Body */ ns2 = (*n + 1) / 2; np2 = *n + 2; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; xh[k] = x[k] + x[kc]; xh[kc] = x[k] - x[kc]; /* L101: */ } modn = *n % 2; if (modn == 0) { xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1]; } i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k]; x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc]; /* L102: */ } if (modn == 0) { x[ns2 + 1] = w[ns2] * xh[ns2 + 1]; } rfftf_(n, &x[1], &xh[1]); i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xim1 = x[i__ - 1] - x[i__]; x[i__] = x[i__ - 1] + x[i__]; x[i__ - 1] = xim1; /* L103: */ } return 0; } /* cosqf1_ */ /* ------ File cosqi.f ------ */ /* Subroutine */ int cosqi_(int_4 *n, r_4 *wsave) { /* Initialized data */ static r_4 pih = 1.57079632679491f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 cos(r_8truc); commente - Remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int rffti_(int_4 *, r_4 *); static r_4 fk, dt; /* Parameter adjustments */ --wsave; /* Function Body */ dt = pih / (r_4) (*n); fk = 0.f; i__1 = *n; for (k = 1; k <= i__1; ++k) { fk += 1.f; wsave[k] = cos(fk * dt); /* L101: */ } rffti_(n, &wsave[*n + 1]); return 0; } /* cosqi_ */ /* ------ File cost.f ------ */ /* Subroutine */ int cost_(int_4 *n, r_4 *x, r_4 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); static r_4 c1, t1, t2; static int_4 kc; static r_4 xi; static int_4 nm1, np1; static r_4 x1h; static int_4 ns2; static r_4 tx2, x1p3, xim2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ nm1 = *n - 1; np1 = *n + 1; ns2 = *n / 2; if ((i__1 = *n - 2) < 0) { goto L106; } else if (i__1 == 0) { goto L101; } else { goto L102; } L101: x1h = x[1] + x[2]; x[2] = x[1] - x[2]; x[1] = x1h; return 0; L102: if (*n > 3) { goto L103; } x1p3 = x[1] + x[3]; tx2 = x[2] + x[2]; x[2] = x[1] - x[3]; x[1] = x1p3 + tx2; x[3] = x1p3 - tx2; return 0; L103: c1 = x[1] - x[*n]; x[1] += x[*n]; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np1 - k; t1 = x[k] + x[kc]; t2 = x[k] - x[kc]; c1 += wsave[kc] * t2; t2 = wsave[k] * t2; x[k] = t1 - t2; x[kc] = t1 + t2; /* L104: */ } modn = *n % 2; if (modn != 0) { x[ns2 + 1] += x[ns2 + 1]; } rfftf_(&nm1, &x[1], &wsave[*n + 1]); xim2 = x[2]; x[2] = c1; i__1 = *n; for (i__ = 4; i__ <= i__1; i__ += 2) { xi = x[i__]; x[i__] = x[i__ - 2] - x[i__ - 1]; x[i__ - 1] = xim2; xim2 = xi; /* L105: */ } if (modn != 0) { x[*n] = xim2; } L106: return 0; } /* cost_ */ /* ------ File costi.f ------ */ /* Subroutine */ int costi_(int_4 *n, r_4 *wsave) { /* Initialized data */ static r_4 pi = 3.14159265358979f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 sin(r_8truc), cos(r_8truc); commente - Remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int rffti_(int_4 *, r_4 *); static int_4 kc; static r_4 fk, dt; static int_4 nm1, np1, ns2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n <= 3) { return 0; } nm1 = *n - 1; np1 = *n + 1; ns2 = *n / 2; dt = pi / (r_4) nm1; fk = 0.f; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np1 - k; fk += 1.f; wsave[k] = sin(fk * dt) * 2.f; wsave[kc] = cos(fk * dt) * 2.f; /* L101: */ } rffti_(&nm1, &wsave[*n + 1]); return 0; } /* costi_ */ /* ------ File ezfft1.f ------ */ /* Subroutine */ int ezfft1_(int_4 *n, r_4 *wa, int_4 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 4,2,3,5 }; static r_4 tpi = 6.28318530717959f; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); commente - Remplace par math.h Reza 29/11/99 */ /* Local variables */ static r_4 argh; static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr; static r_4 ch1, sh1; static int_4 ido, ipm; static r_4 dch1, ch1h, arg1, dsh1; static int_4 nfm1; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; argh = tpi / (r_4) (*n); is = 0; nfm1 = nf - 1; l1 = 1; if (nfm1 == 0) { return 0; } i__1 = nfm1; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = l1 * ip; ido = *n / l2; ipm = ip - 1; arg1 = (r_4) l1 * argh; ch1 = 1.f; sh1 = 0.f; dch1 = cos(arg1); dsh1 = sin(arg1); i__2 = ipm; for (j = 1; j <= i__2; ++j) { ch1h = dch1 * ch1 - dsh1 * sh1; sh1 = dch1 * sh1 + dsh1 * ch1; ch1 = ch1h; i__ = is + 2; wa[i__ - 1] = ch1; wa[i__] = sh1; if (ido < 5) { goto L109; } i__3 = ido; for (ii = 5; ii <= i__3; ii += 2) { i__ += 2; wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2]; wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3]; /* L108: */ } L109: is += ido; /* L110: */ } l1 = l2; /* L111: */ } return 0; } /* ezfft1_ */ /* ------ File ezfftb.f ------ */ /* Subroutine */ int ezfftb_(int_4 *n, r_4 *r__, r_4 *azero, r_4 *a, r_4 *b, r_4 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 i__; extern /* Subroutine */ int rfftb_(int_4 *, r_4 *, r_4 *); static int_4 ns2; /* Parameter adjustments */ --wsave; --b; --a; --r__; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: r__[1] = *azero; return 0; L102: r__[1] = *azero + a[1]; r__[2] = *azero - a[1]; return 0; L103: ns2 = (*n - 1) / 2; i__1 = ns2; for (i__ = 1; i__ <= i__1; ++i__) { r__[i__ * 2] = a[i__] * .5f; r__[(i__ << 1) + 1] = b[i__] * -.5f; /* L104: */ } r__[1] = *azero; if (*n % 2 == 0) { r__[*n] = a[ns2 + 1]; } rfftb_(n, &r__[1], &wsave[*n + 1]); return 0; } /* ezfftb_ */ /* ------ File ezfftf.f ------ */ /* Subroutine */ int ezfftf_(int_4 *n, r_4 *r__, r_4 *azero, r_4 *a, r_4 *b, r_4 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 i__; extern /* Subroutine */ int rfftf_(int_4 *, r_4 *, r_4 *); static r_4 cf; static int_4 ns2; static r_4 cfm; static int_4 ns2m; /* VERSION 3 JUNE 1979 */ /* Parameter adjustments */ --wsave; --b; --a; --r__; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: *azero = r__[1]; return 0; L102: *azero = (r__[1] + r__[2]) * .5f; a[1] = (r__[1] - r__[2]) * .5f; return 0; L103: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { wsave[i__] = r__[i__]; /* L104: */ } rfftf_(n, &wsave[1], &wsave[*n + 1]); cf = 2.f / (r_4) (*n); cfm = -cf; *azero = cf * .5f * wsave[1]; ns2 = (*n + 1) / 2; ns2m = ns2 - 1; i__1 = ns2m; for (i__ = 1; i__ <= i__1; ++i__) { a[i__] = cf * wsave[i__ * 2]; b[i__] = cfm * wsave[(i__ << 1) + 1]; /* L105: */ } if (*n % 2 == 1) { return 0; } a[ns2] = cf * .5f * wsave[*n]; b[ns2] = 0.f; return 0; } /* ezfftf_ */ /* ------ File ezffti.f ------ */ /* Subroutine */ int ezffti_(int_4 *n, r_4 *wsave) { extern /* Subroutine */ int ezfft1_(int_4 *, r_4 *, int_4 *); /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } ezfft1_(n, &wsave[(*n << 1) + 1], (int_4*)&wsave[*n * 3 + 1]); return 0; } /* ezffti_ */ /* ------ File passb.f ------ */ /* Subroutine */ int passb_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * l1, int_4 *idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) { /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Local variables */ static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp; static r_4 wai, war; static int_4 ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ idot = *ido / 2; nt = *ip * *idl1; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; idp = *ip * *ido; if (*ido < *l1) { goto L106; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 1; i__ <= i__3; ++i__) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L101: */ } /* L102: */ } /* L103: */ } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } goto L112; L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L107: */ } /* L108: */ } /* L109: */ } i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L110: */ } /* L111: */ } L112: idl = 2 - *ido; inc = 0; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; idl += *ido; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik + (ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1]; /* L113: */ } idlj = idl; inc += *ido; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; idlj += inc; if (idlj > idp) { idlj -= idp; } war = wa[idlj - 1]; wai = wa[idlj]; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1]; /* L114: */ } /* L115: */ } /* L116: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L117: */ } /* L118: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *idl1; for (ik = 2; ik <= i__2; ik += 2) { ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + jc * c2_dim1]; ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + jc * c2_dim1]; ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * c2_dim1]; ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * c2_dim1]; /* L119: */ } /* L120: */ } *nac = 1; if (*ido == 2) { return 0; } *nac = 0; i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L121: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * ch_dim1 + 2]; /* L122: */ } /* L123: */ } if (idot > *l1) { goto L127; } idij = 0; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idij += 2; i__2 = *ido; for (i__ = 4; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L124: */ } /* L125: */ } /* L126: */ } return 0; L127: idj = 2 - *ido; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idj += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = idj; i__3 = *ido; for (i__ = 4; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L128: */ } /* L129: */ } /* L130: */ } return 0; } /* passb_ */ /* ------ File passb2.f ------ */ /* Subroutine */ int passb2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ if (*ido > 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + cc[((k << 1) + 2) * cc_dim1 + 2]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 + wa1[i__] * tr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 - wa1[i__] * ti2; /* L103: */ } /* L104: */ } return 0; } /* passb2_ */ /* ------ File passb3.f ------ */ /* Subroutine */ int passb3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2) { /* Initialized data */ static r_4 taur = -.5f; static r_4 taui = .866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * cc_dim1 + 1]); ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * cc_dim1 + 2]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 3) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( k * 3 + 3) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 3) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + wa1[i__] * dr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 - wa1[i__] * di2; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ i__] * dr3; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - wa2[i__] * di3; /* L103: */ } /* L104: */ } return 0; } /* passb3_ */ /* ------ File passb4.f ------ */ /* Subroutine */ int passb4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 + 2]; ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 + 2]; tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1 + 2]; ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 + 2]; tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 + 1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1 + 1]; tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 + tr4; cr4 = tr1 - tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 - wa1[i__] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 + wa1[i__] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 - wa2[i__] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[ i__] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 - wa3[i__] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 + wa3[i__] * cr4; /* L103: */ } /* L104: */ } return 0; } /* passb4_ */ /* ------ File passb5.f ------ */ /* Subroutine */ int passb5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) { /* Initialized data */ static r_4 tr11 = .309016994374947f; static r_4 ti11 = .951056516295154f; static r_4 tr12 = -.809016994374947f; static r_4 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 + ti3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + 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[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 - wa1[i__] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + wa1[i__] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - wa2[i__] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ i__] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 - wa3[i__] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 + wa3[i__] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 - wa4[i__] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[ i__] * dr5; /* L103: */ } /* L104: */ } return 0; } /* passb5_ */ /* ------ File passf.f ------ */ /* Subroutine */ int passf_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * l1, int_4 *idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) { /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Local variables */ static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp; static r_4 wai, war; static int_4 ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ idot = *ido / 2; nt = *ip * *idl1; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; idp = *ip * *ido; if (*ido < *l1) { goto L106; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 1; i__ <= i__3; ++i__) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L101: */ } /* L102: */ } /* L103: */ } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } goto L112; L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L107: */ } /* L108: */ } /* L109: */ } i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L110: */ } /* L111: */ } L112: idl = 2 - *ido; inc = 0; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; idl += *ido; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik + (ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1]; /* L113: */ } idlj = idl; inc += *ido; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; idlj += inc; if (idlj > idp) { idlj -= idp; } war = wa[idlj - 1]; wai = wa[idlj]; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1]; /* L114: */ } /* L115: */ } /* L116: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L117: */ } /* L118: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *idl1; for (ik = 2; ik <= i__2; ik += 2) { ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + jc * c2_dim1]; ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + jc * c2_dim1]; ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * c2_dim1]; ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * c2_dim1]; /* L119: */ } /* L120: */ } *nac = 1; if (*ido == 2) { return 0; } *nac = 0; i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L121: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * ch_dim1 + 2]; /* L122: */ } /* L123: */ } if (idot > *l1) { goto L127; } idij = 0; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idij += 2; i__2 = *ido; for (i__ = 4; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L124: */ } /* L125: */ } /* L126: */ } return 0; L127: idj = 2 - *ido; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idj += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = idj; i__3 = *ido; for (i__ = 4; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L128: */ } /* L129: */ } /* L130: */ } return 0; } /* passf_ */ /* ------ File passf2.f ------ */ /* Subroutine */ int passf2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ if (*ido > 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + cc[((k << 1) + 2) * cc_dim1 + 2]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 - wa1[i__] * tr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 + wa1[i__] * ti2; /* L103: */ } /* L104: */ } return 0; } /* passf2_ */ /* ------ File passf3.f ------ */ /* Subroutine */ int passf3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2) { /* Initialized data */ static r_4 taur = -.5f; static r_4 taui = -.866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * cc_dim1 + 1]); ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * cc_dim1 + 2]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 3) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( k * 3 + 3) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 3) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - wa1[i__] * dr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 + wa1[i__] * di2; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ i__] * dr3; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + wa2[i__] * di3; /* L103: */ } /* L104: */ } return 0; } /* passf3_ */ /* ------ File passf4.f ------ */ /* Subroutine */ int passf4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 + 2]; ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 + 2]; tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1 + 2]; ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 + 2]; tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 + 1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 + 1]; tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 2) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 + tr4; cr4 = tr1 - tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 + wa1[i__] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 - wa1[i__] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 + wa2[i__] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[ i__] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 + wa3[i__] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 - wa3[i__] * cr4; /* L103: */ } /* L104: */ } return 0; } /* passf4_ */ /* ------ File passf5.f ------ */ /* Subroutine */ int passf5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) { /* Initialized data */ static r_4 tr11 = .309016994374947f; static r_4 ti11 = -.951056516295154f; static r_4 tr12 = -.809016994374947f; static r_4 ti12 = -.587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 + ti3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + 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[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 + wa1[i__] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - wa1[i__] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + wa2[i__] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ i__] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 + wa3[i__] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 - wa3[i__] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 + wa4[i__] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[ i__] * dr5; /* L103: */ } /* L104: */ } return 0; } /* passf5_ */ /* ------ File radb2.f ------ */ /* Subroutine */ int radb2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 1) + 2) * cc_dim1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2) * cc_dim1]; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2 - wa1[i__ - 1] * ti2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 + wa1[i__ - 1] * tr2; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) * cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1]; ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]); /* L106: */ } L107: return 0; } /* radb2_ */ /* ------ File radb3.f ------ */ /* Subroutine */ int radb3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2) { /* Initialized data */ static r_4 taur = -.5f; static r_4 taui = .866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) * cc_dim1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 + 2) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + ( k * 3 + 2) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 + 2) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 - wa1[i__ - 1] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + wa1[i__ - 1] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - wa2[i__ - 1] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ i__ - 1] * dr3; /* L102: */ } /* L103: */ } return 0; } /* radb3_ */ /* ------ File radb4.f ------ */ /* Subroutine */ int radb4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3) { /* Initialized data */ static r_4 sqrt2 = 1.414213562373095f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) * cc_dim1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) * cc_dim1]; tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) * cc_dim1]; tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k << 2) + 4) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k << 2) + 4) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k << 2) + 2) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k << 2) + 2) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 - tr4; cr4 = tr1 + tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2 - wa1[i__ - 1] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 + wa1[i__ - 1] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 - wa2[i__ - 1] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[ i__ - 1] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4 - wa3[i__ - 1] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 + wa3[i__ - 1] * cr4; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 + 1]; tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) * cc_dim1]; tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) * cc_dim1]; ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2; ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1); ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2; ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1); /* L106: */ } L107: return 0; } /* radb4_ */ /* ------ File radb5.f ------ */ /* Subroutine */ int radb5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) { /* Initialized data */ static r_4 tr11 = .309016994374947f; static r_4 ti11 = .951056516295154f; static r_4 tr12 = -.809016994374947f; static r_4 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1]; ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) * cc_dim1]; tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) * cc_dim1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci5 = ti11 * ti5 + ti12 * ti4; ci4 = ti12 * ti5 - ti11 * ti4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 + 2) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 + 2) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 - wa1[i__ - 1] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + wa1[i__ - 1] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - wa2[i__ - 1] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ i__ - 1] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4 - wa3[i__ - 1] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 + wa3[i__ - 1] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 - wa4[i__ - 1] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[ i__ - 1] * dr5; /* L102: */ } /* L103: */ } return 0; } /* radb5_ */ /* ------ File radbg.f ------ */ /* Subroutine */ int radbg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) { /* Initialized data */ static r_4 tpi = 6.28318530717959f; /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); commente - Remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; static r_4 dc2, ai1, ai2, ar1, ar2, ds2; static int_4 nbd; static r_4 dcp, arg, dsp, ar1h, ar2h; static int_4 idp2, ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ arg = tpi / (r_4) (*ip); dcp = cos(arg); dsp = sin(arg); idp2 = *ido + 2; nbd = (*ido - 1) / 2; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; if (*ido < *l1) { goto L103; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L101: */ } /* L102: */ } goto L106; L103: i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1]; ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1]; /* L107: */ } /* L108: */ } if (*ido == 1) { goto L116; } if (nbd < *l1) { goto L112; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ic = idp2 - i__; ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; /* L109: */ } /* L110: */ } /* L111: */ } goto L116; L112: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; /* L113: */ } /* L114: */ } /* L115: */ } L116: ar1 = 1.f; ai1 = 0.f; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; ar1h = dcp * ar1 - dsp * ai1; ai1 = dcp * ai1 + dsp * ar1; ar1 = ar1h; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + ( ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1]; /* L117: */ } dc2 = ar1; ds2 = ai1; ar2 = ar1; ai2 = ai1; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; ar2h = dc2 * ar2 - ds2 * ai2; ai2 = dc2 * ai2 + ds2 * ar2; ar2 = ar2h; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1]; /* L118: */ } /* L119: */ } /* L120: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L121: */ } /* L122: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1]; ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1]; /* L123: */ } /* L124: */ } if (*ido == 1) { goto L132; } if (nbd < *l1) { goto L128; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; /* L125: */ } /* L126: */ } /* L127: */ } goto L132; L128: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; /* L129: */ } /* L130: */ } /* L131: */ } L132: if (*ido == 1) { return 0; } i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L133: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; /* L134: */ } /* L135: */ } if (nbd > *l1) { goto L139; } is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; idij = is; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L136: */ } /* L137: */ } /* L138: */ } goto L143; L139: is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = is; i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L140: */ } /* L141: */ } /* L142: */ } L143: return 0; } /* radbg_ */ /* ------ File radf2.f ------ */ /* Subroutine */ int radf2_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1) { /* System generated locals */ int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 3 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ti2; ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) * cc_dim1]; ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr2; ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - tr2; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1]; ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) * cc_dim1]; /* L106: */ } L107: return 0; } /* radf2_ */ /* ------ File radf3.f ------ */ /* Subroutine */ int radf3_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2) { /* Initialized data */ static r_4 taur = -.5f; static r_4 taui = .866025403784439f; /* System generated locals */ int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = (ch_dim1 << 2) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2; ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]); ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + taur * cr2; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; cr2 = dr2 + dr3; ci2 = di2 + di3; ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr2; ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ci2; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2; tr3 = taui * (di2 - di3); ti3 = taui * (dr3 - dr2); ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3; ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3; ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3; ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2; /* L102: */ } /* L103: */ } return 0; } /* radf3_ */ /* ------ File radf4.f ------ */ /* Subroutine */ int radf4_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3) { /* Initialized data */ static r_4 hsqt2 = .7071067811865475f; /* System generated locals */ int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 5 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1]; tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2; ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]; tr1 = cr2 + cr4; tr4 = cr4 - cr2; ti1 = ci2 + ci4; ti4 = ci2 - ci4; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3; ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3; tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3; ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2; ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2; ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2; ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3; ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4; ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3; ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido + (k + (cc_dim2 << 2)) * cc_dim1]); tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + ( k + (cc_dim2 << 2)) * cc_dim1]); ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) * cc_dim1]; ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) * cc_dim1] - tr1; ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) * cc_dim1]; ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) * cc_dim1]; /* L106: */ } L107: return 0; } /* radf4_ */ /* ------ File radf5.f ------ */ /* Subroutine */ int radf5_(int_4 *ido, int_4 *l1, r_4 *cc, r_4 *ch, r_4 *wa1, r_4 *wa2, r_4 *wa3, r_4 *wa4) { /* Initialized data */ static r_4 tr11 = .309016994374947f; static r_4 ti11 = .951056516295154f; static r_4 tr12 = -.809016994374947f; static r_4 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_4 ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 6 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2 + cr3; ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + tr11 * cr2 + tr12 * cr3; ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4; ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + tr12 * cr2 + tr11 * cr3; ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]; dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] + wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1]; di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1]; 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[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr2 + cr3; ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ci2 + ci3; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 * cr3; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3; tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 * cr3; ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + 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[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5; ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5; ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5; ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2; ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4; ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4; ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4; ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3; /* L102: */ } /* L103: */ } return 0; } /* radf5_ */ /* ------ File radfg.f ------ */ /* Subroutine */ int radfg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * idl1, r_4 *cc, r_4 *c1, r_4 *c2, r_4 *ch, r_4 *ch2, r_4 *wa) { /* Initialized data */ static r_4 tpi = 6.28318530717959f; /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); */ /* Local variables */ static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; static r_4 dc2, ai1, ai2, ar1, ar2, ds2; static int_4 nbd; static r_4 dcp, arg, dsp, ar1h, ar2h; static int_4 idp2, ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ arg = tpi / (r_4) (*ip); dcp = cos(arg); dsp = sin(arg); ipph = (*ip + 1) / 2; ipp2 = *ip + 2; idp2 = *ido + 2; nbd = (*ido - 1) / 2; if (*ido == 1) { goto L119; } i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { ch2[ik + ch2_dim1] = c2[ik + c2_dim1]; /* L101: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1]; /* L102: */ } /* L103: */ } if (nbd > *l1) { goto L107; } is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; idij = is; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * c1[i__ + (k + j * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1]; /* L104: */ } /* L105: */ } /* L106: */ } goto L111; L107: is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = is; i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { idij += 2; ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * c1[i__ + (k + j * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1]; /* L108: */ } /* L109: */ } /* L110: */ } L111: if (nbd < *l1) { goto L115; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L112: */ } /* L113: */ } /* L114: */ } goto L121; L115: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L116: */ } /* L117: */ } /* L118: */ } goto L121; L119: i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L120: */ } L121: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1]; c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) * ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1]; /* L122: */ } /* L123: */ } ar1 = 1.f; ai1 = 0.f; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; ar1h = dcp * ar1 - dsp * ai1; ai1 = dcp * ai1 + dsp * ar1; ar1 = ar1h; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + ( c2_dim1 << 1)]; ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1]; /* L124: */ } dc2 = ar1; ds2 = ai1; ar2 = ar1; ai2 = ai1; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; ar2h = dc2 * ar2 - ds2 * ai2; ai2 = dc2 * ai2 + ds2 * ar2; ar2 = ar2h; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1]; ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1]; /* L125: */ } /* L126: */ } /* L127: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1]; /* L128: */ } /* L129: */ } if (*ido < *l1) { goto L132; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * ch_dim1]; /* L130: */ } /* L131: */ } goto L135; L132: i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * ch_dim1]; /* L133: */ } /* L134: */ } L135: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) * ch_dim1 + 1]; /* L136: */ } /* L137: */ } if (*ido == 1) { return 0; } if (nbd < *l1) { goto L141; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ic = idp2 - i__; cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * ch_dim1]; /* L138: */ } /* L139: */ } /* L140: */ } return 0; L141: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; i__3 = *l1; for (k = 1; k <= i__3; ++k) { cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * ch_dim1]; /* L142: */ } /* L143: */ } /* L144: */ } return 0; } /* radfg_ */ /* ------ File rfftb.f ------ */ /* Subroutine */ int rfftb_(int_4 *n, r_4 *r__, r_4 *wsave) { extern /* Subroutine */ int rfftb1_(int_4 *, r_4 *, r_4 *, r_4 *, int_4 *); /* Parameter adjustments */ --wsave; --r__; /* Function Body */ if (*n == 1) { return 0; } rfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* rfftb_ */ /* ------ File rfftb1.f ------ */ /* Subroutine */ int rfftb1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, int_4 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ extern /* Subroutine */ int radb2_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *), radb3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *), radb4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *), radb5_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 i__; extern /* Subroutine */ int radbg_(int_4 *, int_4 *, int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idl1 = ido * l1; if (ip != 4) { goto L103; } ix2 = iw + ido; ix3 = ix2 + ido; if (na != 0) { goto L101; } radb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } radb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + ido; if (na != 0) { goto L107; } radb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + ido; ix3 = ix2 + ido; ix4 = ix3 + ido; if (na != 0) { goto L110; } radb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } radbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ 1], &wa[iw]); goto L114; L113: radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] , &wa[iw]); L114: if (ido == 1) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * ido; /* L116: */ } if (na == 0) { return 0; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* rfftb1_ */ /* ------ File rfftf.f ------ */ /* Subroutine */ int rfftf_(int_4 *n, r_4 *r__, r_4 *wsave) { extern /* Subroutine */ int rfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, int_4 *); /* Parameter adjustments */ --wsave; --r__; /* Function Body */ if (*n == 1) { return 0; } rfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* rfftf_ */ /* ------ File rfftf1.f ------ */ /* Subroutine */ int rfftf1_(int_4 *n, r_4 *c__, r_4 *ch, r_4 *wa, int_4 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ extern /* Subroutine */ int radf2_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *), radf3_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *), radf4_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *), radf5_(int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 i__; extern /* Subroutine */ int radfg_(int_4 *, int_4 *, int_4 *, int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *, r_4 *); static int_4 k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 1; l2 = *n; iw = *n; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { kh = nf - k1; ip = ifac[kh + 3]; l1 = l2 / ip; ido = *n / l2; idl1 = ido * l1; iw -= (ip - 1) * ido; na = 1 - na; if (ip != 4) { goto L102; } ix2 = iw + ido; ix3 = ix2 + ido; if (na != 0) { goto L101; } radf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L110; L101: radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L110; L102: if (ip != 2) { goto L104; } if (na != 0) { goto L103; } radf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); goto L110; L103: radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); goto L110; L104: if (ip != 3) { goto L106; } ix2 = iw + ido; if (na != 0) { goto L105; } radf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L110; L105: radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); goto L110; L106: if (ip != 5) { goto L108; } ix2 = iw + ido; ix3 = ix2 + ido; ix4 = ix3 + ido; if (na != 0) { goto L107; } radf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L110; L107: radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L110; L108: if (ido == 1) { na = 1 - na; } if (na != 0) { goto L109; } radfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ 1], &wa[iw]); na = 1; goto L110; L109: radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] , &wa[iw]); na = 0; L110: l2 = l1; /* L111: */ } if (na == 1) { return 0; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L112: */ } return 0; } /* rfftf1_ */ /* ------ File rffti.f ------ */ /* Subroutine */ int rffti_(int_4 *n, r_4 *wsave) { extern /* Subroutine */ int rffti1_(int_4 *, r_4 *, int_4 *); /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } rffti1_(n, &wsave[*n + 1], (int_4 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* rffti_ */ /* ------ File rffti1.f ------ */ /* Subroutine */ int rffti1_(int_4 *n, r_4 *wa, int_4 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 4,2,3,5 }; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); Remplace par math.h , Reza 29/11/99 */ /* Local variables */ static r_4 argh; static int_4 ntry, i__, j; static r_4 argld; static int_4 k1, l1, l2, ib; static r_4 fi; static int_4 ld, ii, nf, ip, nl, is, nq, nr; static r_4 arg; static int_4 ido, ipm; static r_4 tpi; static int_4 nfm1; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; tpi = 6.28318530717959f; argh = tpi / (r_4) (*n); is = 0; nfm1 = nf - 1; l1 = 1; if (nfm1 == 0) { return 0; } i__1 = nfm1; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; ld = 0; l2 = l1 * ip; ido = *n / l2; ipm = ip - 1; i__2 = ipm; for (j = 1; j <= i__2; ++j) { ld += l1; i__ = is; argld = (r_4) ld * argh; fi = 0.f; i__3 = ido; for (ii = 3; ii <= i__3; ii += 2) { i__ += 2; fi += 1.f; arg = fi * argld; wa[i__ - 1] = cos(arg); wa[i__] = sin(arg); /* L108: */ } is += ido; /* L109: */ } l1 = l2; /* L110: */ } return 0; } /* rffti1_ */ /* ------ File sinqb.f ------ */ /* Subroutine */ int sinqb_(int_4 *n, r_4 *x, r_4 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 k; extern /* Subroutine */ int cosqb_(int_4 *, r_4 *, r_4 *); static r_4 xhold; static int_4 kc, ns2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ if (*n > 1) { goto L101; } x[1] *= 4.f; return 0; L101: ns2 = *n / 2; i__1 = *n; for (k = 2; k <= i__1; k += 2) { x[k] = -x[k]; /* L102: */ } cosqb_(n, &x[1], &wsave[1]); i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = *n - k; xhold = x[k]; x[k] = x[kc + 1]; x[kc + 1] = xhold; /* L103: */ } return 0; } /* sinqb_ */ /* ------ File sinqf.f ------ */ /* Subroutine */ int sinqf_(int_4 *n, r_4 *x, r_4 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 k; extern /* Subroutine */ int cosqf_(int_4 *, r_4 *, r_4 *); static r_4 xhold; static int_4 kc, ns2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ if (*n == 1) { return 0; } ns2 = *n / 2; i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = *n - k; xhold = x[k]; x[k] = x[kc + 1]; x[kc + 1] = xhold; /* L101: */ } cosqf_(n, &x[1], &wsave[1]); i__1 = *n; for (k = 2; k <= i__1; k += 2) { x[k] = -x[k]; /* L102: */ } return 0; } /* sinqf_ */ /* ------ File sinqi.f ------ */ /* Subroutine */ int sinqi_(int_4 *n, r_4 *wsave) { extern /* Subroutine */ int cosqi_(int_4 *, r_4 *); /* Parameter adjustments */ --wsave; /* Function Body */ cosqi_(n, &wsave[1]); return 0; } /* sinqi_ */ /* ------ File sint.f ------ */ /* Subroutine */ int sint_(int_4 *n, r_4 *x, r_4 *wsave) { extern /* Subroutine */ int sint1_(int_4 *, r_4 *, r_4 *, r_4 *, r_4 *, int_4 *); static int_4 np1, iw1, iw2, iw3; /* Parameter adjustments */ --wsave; --x; /* Function Body */ np1 = *n + 1; iw1 = *n / 2 + 1; iw2 = iw1 + np1; iw3 = iw2 + np1; sint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], (int_4 *)&wsave[iw3]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* sint_ */ /* ------ File sint1.f ------ */ /* Subroutine */ int sint1_(int_4 *n, r_4 *war, r_4 *was, r_4 *xh, r_4 * x, int_4 *ifac) { /* Initialized data */ static r_4 sqrt3 = 1.73205080756888f; /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; static r_4 xhold, t1, t2; extern /* Subroutine */ int rfftf1_(int_4 *, r_4 *, r_4 *, r_4 *, int_4 *); static int_4 kc, np1, ns2; /* Parameter adjustments */ --ifac; --x; --xh; --was; --war; /* Function Body */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { xh[i__] = war[i__]; war[i__] = x[i__]; /* L100: */ } if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: xh[1] += xh[1]; goto L106; L102: xhold = sqrt3 * (xh[1] + xh[2]); xh[2] = sqrt3 * (xh[1] - xh[2]); xh[1] = xhold; goto L106; L103: np1 = *n + 1; ns2 = *n / 2; x[1] = 0.f; i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = np1 - k; t1 = xh[k] - xh[kc]; t2 = was[k] * (xh[k] + xh[kc]); x[k + 1] = t1 + t2; x[kc + 1] = t2 - t1; /* L104: */ } modn = *n % 2; if (modn != 0) { x[ns2 + 2] = xh[ns2 + 1] * 4.f; } rfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]); xh[1] = x[1] * .5f; i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xh[i__ - 1] = -x[i__]; xh[i__] = xh[i__ - 2] + x[i__ - 1]; /* L105: */ } if (modn != 0) { goto L106; } xh[*n] = -x[*n + 1]; L106: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = war[i__]; war[i__] = xh[i__]; /* L107: */ } return 0; } /* sint1_ */ /* ------ File sinti.f ------ */ /* Subroutine */ int sinti_(int_4 *n, r_4 *wsave) { /* Initialized data */ static r_4 pi = 3.14159265358979f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 sin(r_8truc); remplace par math.h , Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int rffti_(int_4 *, r_4 *); static r_4 dt; static int_4 np1, ns2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n <= 1) { return 0; } ns2 = *n / 2; np1 = *n + 1; dt = pi / (r_4) np1; i__1 = ns2; for (k = 1; k <= i__1; ++k) { wsave[k] = sin(k * dt) * 2.f; /* L101: */ } rffti_(&np1, &wsave[ns2 + 1]); return 0; } /* sinti_ */ /* --------------------------------------------------------------- */ /* -------------- make a r_8 version of the library ----------- */ /* --------------------------------------------------------------- */ /* Subroutine */ int cdfftb_(int_4 *n, r_8 *c__, r_8 *wsave) { extern /* Subroutine */ int cdfftb1_(int_4 *, r_8 *, r_8 *, r_8 *, int_8 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; --c__; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cdfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* cdfftb_ */ /* ------ File cdfftb1.f ------ */ /* Subroutine */ int cdfftb1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, int_8 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 idot, i__; extern /* Subroutine */ int dpassb_(int_4 *, int_4 *, int_4 *, int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 k1, l1, l2, n2; extern /* Subroutine */ int dpassb2_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *), dpassb3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *), dpassb4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *), dpassb5_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idot = ido + ido; idl1 = idot * l1; if (ip != 4) { goto L103; } ix2 = iw + idot; ix3 = ix2 + idot; if (na != 0) { goto L101; } dpassb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: dpassb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } dpassb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: dpassb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + idot; if (na != 0) { goto L107; } dpassb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: dpassb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + idot; ix3 = ix2 + idot; ix4 = ix3 + idot; if (na != 0) { goto L110; } dpassb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: dpassb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } dpassb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] , &ch[1], &wa[iw]); goto L114; L113: dpassb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1], &wa[iw]); L114: if (nac != 0) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * idot; /* L116: */ } if (na == 0) { return 0; } n2 = *n + *n; i__1 = n2; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* cdfftb1_ */ /* ------ File cdfftf.f ------ */ /* Subroutine */ int cdfftf_(int_4 *n, r_8 *c__, r_8 *wsave) { extern /* Subroutine */ int cdfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, int_8 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; --c__; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cdfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* cdfftf_ */ /* ------ File cdfftf1.f ------ */ /* Subroutine */ int cdfftf1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, int_8 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 idot, i__; extern /* Subroutine */ int dpassf_(int_4 *, int_4 *, int_4 *, int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 k1, l1, l2, n2; extern /* Subroutine */ int dpassf2_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *), dpassf3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *), dpassf4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *), dpassf5_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idot = ido + ido; idl1 = idot * l1; if (ip != 4) { goto L103; } ix2 = iw + idot; ix3 = ix2 + idot; if (na != 0) { goto L101; } dpassf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: dpassf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } dpassf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: dpassf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + idot; if (na != 0) { goto L107; } dpassf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: dpassf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + idot; ix3 = ix2 + idot; ix4 = ix3 + idot; if (na != 0) { goto L110; } dpassf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: dpassf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } dpassf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1] , &ch[1], &wa[iw]); goto L114; L113: dpassf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1], &wa[iw]); L114: if (nac != 0) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * idot; /* L116: */ } if (na == 0) { return 0; } n2 = *n + *n; i__1 = n2; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* cdfftf1_ */ /* ------ File cdffti.f ------ */ /* Subroutine */ int cdffti_(int_4 *n, r_8 *wsave) { extern /* Subroutine */ int cdffti1_(int_4 *, r_8 *, int_8 *); static int_4 iw1, iw2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } iw1 = *n + *n + 1; iw2 = iw1 + *n + *n; cdffti1_(n, &wsave[iw1], (int_8 *)&wsave[iw2]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* cdffti_ */ /* ------ File cdffti1.f ------ */ /* Subroutine */ int cdffti1_(int_4 *n, r_8 *wa, int_8 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 3,4,2,5 }; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static r_8 argh; static int_4 idot, ntry, i__, j; static r_8 argld; static int_4 i1, k1, l1, l2, ib; static r_8 fi; static int_4 ld, ii, nf, ip, nl, nq, nr; static r_8 arg; static int_4 ido, ipm; static r_8 tpi; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; tpi = 6.28318530717959f; argh = tpi / (r_8) (*n); i__ = 2; l1 = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; ld = 0; l2 = l1 * ip; ido = *n / l2; idot = ido + ido + 2; ipm = ip - 1; i__2 = ipm; for (j = 1; j <= i__2; ++j) { i1 = i__; wa[i__ - 1] = 1.f; wa[i__] = 0.f; ld += l1; fi = 0.f; argld = (r_8) ld * argh; i__3 = idot; for (ii = 4; ii <= i__3; ii += 2) { i__ += 2; fi += 1.f; arg = fi * argld; wa[i__ - 1] = cos(arg); wa[i__] = sin(arg); /* L108: */ } if (ip <= 5) { goto L109; } wa[i1 - 1] = wa[i__ - 1]; wa[i1] = wa[i__]; L109: ; } l1 = l2; /* L110: */ } return 0; } /* cdffti1_ */ /* ------ File dcosqb.f ------ */ /* Subroutine */ int dcosqb_(int_4 *n, r_8 *x, r_8 *wsave) { /* Initialized data */ static r_8 tsqrt2 = 2.82842712474619f; /* System generated locals */ int_4 i__1; /* Local variables */ static r_8 x1; extern /* Subroutine */ int dcosqb1_(int_4 *, r_8 *, r_8 *, r_8 *); /* Parameter adjustments */ --wsave; --x; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: x[1] *= 4.f; return 0; L102: x1 = (x[1] + x[2]) * 4.f; x[2] = tsqrt2 * (x[1] - x[2]); x[1] = x1; return 0; L103: dcosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]); return 0; } /* dcosqb_ */ /* ------ File dcosqb1.f ------ */ /* Subroutine */ int dcosqb1_(int_4 *n, r_8 *x, r_8 *w, r_8 *xh) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int dfftb_(int_4 *, r_8 *, r_8 *); static int_4 kc, np2, ns2; static r_8 xim1; /* Parameter adjustments */ --xh; --w; --x; /* Function Body */ ns2 = (*n + 1) / 2; np2 = *n + 2; i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xim1 = x[i__ - 1] + x[i__]; x[i__] -= x[i__ - 1]; x[i__ - 1] = xim1; /* L101: */ } x[1] += x[1]; modn = *n % 2; if (modn == 0) { x[*n] += x[*n]; } dfftb_(n, &x[1], &xh[1]); i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k]; xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc]; /* L102: */ } if (modn == 0) { x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]); } i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; x[k] = xh[k] + xh[kc]; x[kc] = xh[k] - xh[kc]; /* L103: */ } x[1] += x[1]; return 0; } /* dcosqb1_ */ /* ------ File dcosqf.f ------ */ /* Subroutine */ int dcosqf_(int_4 *n, r_8 *x, r_8 *wsave) { /* Initialized data */ static r_8 sqrt2 = 1.4142135623731f; /* System generated locals */ int_4 i__1; /* Local variables */ static r_8 tsqx; extern /* Subroutine */ int dcosqf1_(int_4 *, r_8 *, r_8 *, r_8 *); /* Parameter adjustments */ --wsave; --x; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L102; } else if (i__1 == 0) { goto L101; } else { goto L103; } L101: tsqx = sqrt2 * x[2]; x[2] = x[1] - tsqx; x[1] += tsqx; L102: return 0; L103: dcosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]); return 0; } /* dcosqf_ */ /* ------ File dcosqf1.f ------ */ /* Subroutine */ int dcosqf1_(int_4 *n, r_8 *x, r_8 *w, r_8 *xh) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); static int_4 kc, np2, ns2; static r_8 xim1; /* Parameter adjustments */ --xh; --w; --x; /* Function Body */ ns2 = (*n + 1) / 2; np2 = *n + 2; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; xh[k] = x[k] + x[kc]; xh[kc] = x[k] - x[kc]; /* L101: */ } modn = *n % 2; if (modn == 0) { xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1]; } i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np2 - k; x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k]; x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc]; /* L102: */ } if (modn == 0) { x[ns2 + 1] = w[ns2] * xh[ns2 + 1]; } dfftf_(n, &x[1], &xh[1]); i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xim1 = x[i__ - 1] - x[i__]; x[i__] = x[i__ - 1] + x[i__]; x[i__ - 1] = xim1; /* L103: */ } return 0; } /* dcosqf1_ */ /* ------ File dcosqi.f ------ */ /* Subroutine */ int dcosqi_(int_4 *n, r_8 *wsave) { /* Initialized data */ static r_8 pih = 1.57079632679491f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 cos(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int dffti_(int_4 *, r_8 *); static r_8 fk, dt; /* Parameter adjustments */ --wsave; /* Function Body */ dt = pih / (r_8) (*n); fk = 0.f; i__1 = *n; for (k = 1; k <= i__1; ++k) { fk += 1.f; wsave[k] = cos(fk * dt); /* L101: */ } dffti_(n, &wsave[*n + 1]); return 0; } /* dcosqi_ */ /* ------ File dcost.f ------ */ /* Subroutine */ int dcost_(int_4 *n, r_8 *x, r_8 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); static r_8 c1, t1, t2; static int_4 kc; static r_8 xi; static int_4 nm1, np1; static r_8 x1h; static int_4 ns2; static r_8 tx2, x1p3, xim2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ nm1 = *n - 1; np1 = *n + 1; ns2 = *n / 2; if ((i__1 = *n - 2) < 0) { goto L106; } else if (i__1 == 0) { goto L101; } else { goto L102; } L101: x1h = x[1] + x[2]; x[2] = x[1] - x[2]; x[1] = x1h; return 0; L102: if (*n > 3) { goto L103; } x1p3 = x[1] + x[3]; tx2 = x[2] + x[2]; x[2] = x[1] - x[3]; x[1] = x1p3 + tx2; x[3] = x1p3 - tx2; return 0; L103: c1 = x[1] - x[*n]; x[1] += x[*n]; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np1 - k; t1 = x[k] + x[kc]; t2 = x[k] - x[kc]; c1 += wsave[kc] * t2; t2 = wsave[k] * t2; x[k] = t1 - t2; x[kc] = t1 + t2; /* L104: */ } modn = *n % 2; if (modn != 0) { x[ns2 + 1] += x[ns2 + 1]; } dfftf_(&nm1, &x[1], &wsave[*n + 1]); xim2 = x[2]; x[2] = c1; i__1 = *n; for (i__ = 4; i__ <= i__1; i__ += 2) { xi = x[i__]; x[i__] = x[i__ - 2] - x[i__ - 1]; x[i__ - 1] = xim2; xim2 = xi; /* L105: */ } if (modn != 0) { x[*n] = xim2; } L106: return 0; } /* dcost_ */ /* ------ File dcosti.f ------ */ /* Subroutine */ int dcosti_(int_4 *n, r_8 *wsave) { /* Initialized data */ static r_8 pi = 3.14159265358979f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 sin(r_8truc), cos(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int dffti_(int_4 *, r_8 *); static int_4 kc; static r_8 fk, dt; static int_4 nm1, np1, ns2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n <= 3) { return 0; } nm1 = *n - 1; np1 = *n + 1; ns2 = *n / 2; dt = pi / (r_8) nm1; fk = 0.f; i__1 = ns2; for (k = 2; k <= i__1; ++k) { kc = np1 - k; fk += 1.f; wsave[k] = sin(fk * dt) * 2.f; wsave[kc] = cos(fk * dt) * 2.f; /* L101: */ } dffti_(&nm1, &wsave[*n + 1]); return 0; } /* dcosti_ */ /* ------ File dezfft1.f ------ */ /* Subroutine */ int dezfft1_(int_4 *n, r_8 *wa, int_8 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 4,2,3,5 }; static r_8 tpi = 6.28318530717959f; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static r_8 argh; static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr; static r_8 ch1, sh1; static int_4 ido, ipm; static r_8 dch1, ch1h, arg1, dsh1; static int_4 nfm1; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; argh = tpi / (r_8) (*n); is = 0; nfm1 = nf - 1; l1 = 1; if (nfm1 == 0) { return 0; } i__1 = nfm1; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = l1 * ip; ido = *n / l2; ipm = ip - 1; arg1 = (r_8) l1 * argh; ch1 = 1.f; sh1 = 0.f; dch1 = cos(arg1); dsh1 = sin(arg1); i__2 = ipm; for (j = 1; j <= i__2; ++j) { ch1h = dch1 * ch1 - dsh1 * sh1; sh1 = dch1 * sh1 + dsh1 * ch1; ch1 = ch1h; i__ = is + 2; wa[i__ - 1] = ch1; wa[i__] = sh1; if (ido < 5) { goto L109; } i__3 = ido; for (ii = 5; ii <= i__3; ii += 2) { i__ += 2; wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2]; wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3]; /* L108: */ } L109: is += ido; /* L110: */ } l1 = l2; /* L111: */ } return 0; } /* dezfft1_ */ /* ------ File dezfftb.f ------ */ /* Subroutine */ int dezfftb_(int_4 *n, r_8 *r__, r_8 *azero, r_8 *a, r_8 *b, r_8 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 i__; extern /* Subroutine */ int dfftb_(int_4 *, r_8 *, r_8 *); static int_4 ns2; /* Parameter adjustments */ --wsave; --b; --a; --r__; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: r__[1] = *azero; return 0; L102: r__[1] = *azero + a[1]; r__[2] = *azero - a[1]; return 0; L103: ns2 = (*n - 1) / 2; i__1 = ns2; for (i__ = 1; i__ <= i__1; ++i__) { r__[i__ * 2] = a[i__] * .5f; r__[(i__ << 1) + 1] = b[i__] * -.5f; /* L104: */ } r__[1] = *azero; if (*n % 2 == 0) { r__[*n] = a[ns2 + 1]; } dfftb_(n, &r__[1], &wsave[*n + 1]); return 0; } /* dezfftb_ */ /* ------ File dezfftf.f ------ */ /* Subroutine */ int dezfftf_(int_4 *n, r_8 *r__, r_8 *azero, r_8 *a, r_8 *b, r_8 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 i__; extern /* Subroutine */ int dfftf_(int_4 *, r_8 *, r_8 *); static r_8 cf; static int_4 ns2; static r_8 cfm; static int_4 ns2m; /* VERSION 3 JUNE 1979 */ /* Parameter adjustments */ --wsave; --b; --a; --r__; /* Function Body */ if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: *azero = r__[1]; return 0; L102: *azero = (r__[1] + r__[2]) * .5f; a[1] = (r__[1] - r__[2]) * .5f; return 0; L103: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { wsave[i__] = r__[i__]; /* L104: */ } dfftf_(n, &wsave[1], &wsave[*n + 1]); cf = 2.f / (r_8) (*n); cfm = -cf; *azero = cf * .5f * wsave[1]; ns2 = (*n + 1) / 2; ns2m = ns2 - 1; i__1 = ns2m; for (i__ = 1; i__ <= i__1; ++i__) { a[i__] = cf * wsave[i__ * 2]; b[i__] = cfm * wsave[(i__ << 1) + 1]; /* L105: */ } if (*n % 2 == 1) { return 0; } a[ns2] = cf * .5f * wsave[*n]; b[ns2] = 0.f; return 0; } /* dezfftf_ */ /* ------ File dezffti.f ------ */ /* Subroutine */ int dezffti_(int_4 *n, r_8 *wsave) { extern /* Subroutine */ int dezfft1_(int_4 *, r_8 *, int_8 *); /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } dezfft1_(n, &wsave[(*n << 1) + 1], (int_8 *)&wsave[*n * 3 + 1]); return 0; } /* dezffti_ */ /* ------ File dpassb.f ------ */ /* Subroutine */ int dpassb_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * l1, int_4 *idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) { /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Local variables */ static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp; static r_8 wai, war; static int_4 ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ idot = *ido / 2; nt = *ip * *idl1; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; idp = *ip * *ido; if (*ido < *l1) { goto L106; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 1; i__ <= i__3; ++i__) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L101: */ } /* L102: */ } /* L103: */ } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } goto L112; L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L107: */ } /* L108: */ } /* L109: */ } i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L110: */ } /* L111: */ } L112: idl = 2 - *ido; inc = 0; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; idl += *ido; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik + (ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1]; /* L113: */ } idlj = idl; inc += *ido; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; idlj += inc; if (idlj > idp) { idlj -= idp; } war = wa[idlj - 1]; wai = wa[idlj]; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1]; /* L114: */ } /* L115: */ } /* L116: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L117: */ } /* L118: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *idl1; for (ik = 2; ik <= i__2; ik += 2) { ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + jc * c2_dim1]; ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + jc * c2_dim1]; ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * c2_dim1]; ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * c2_dim1]; /* L119: */ } /* L120: */ } *nac = 1; if (*ido == 2) { return 0; } *nac = 0; i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L121: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * ch_dim1 + 2]; /* L122: */ } /* L123: */ } if (idot > *l1) { goto L127; } idij = 0; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idij += 2; i__2 = *ido; for (i__ = 4; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L124: */ } /* L125: */ } /* L126: */ } return 0; L127: idj = 2 - *ido; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idj += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = idj; i__3 = *ido; for (i__ = 4; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L128: */ } /* L129: */ } /* L130: */ } return 0; } /* dpassb_ */ /* ------ File dpassb2.f ------ */ /* Subroutine */ int dpassb2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ if (*ido > 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + cc[((k << 1) + 2) * cc_dim1 + 2]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 + wa1[i__] * tr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 - wa1[i__] * ti2; /* L103: */ } /* L104: */ } return 0; } /* dpassb2_ */ /* ------ File dpassb3.f ------ */ /* Subroutine */ int dpassb3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2) { /* Initialized data */ static r_8 taur = -.5f; static r_8 taui = .866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * cc_dim1 + 1]); ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * cc_dim1 + 2]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 3) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( k * 3 + 3) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 3) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + wa1[i__] * dr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 - wa1[i__] * di2; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ i__] * dr3; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - wa2[i__] * di3; /* L103: */ } /* L104: */ } return 0; } /* dpassb3_ */ /* ------ File dpassb4.f ------ */ /* Subroutine */ int dpassb4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 + 2]; ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 + 2]; tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1 + 2]; ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 + 2]; tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 + 1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1 + 1]; tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 + tr4; cr4 = tr1 - tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 - wa1[i__] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 + wa1[i__] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 - wa2[i__] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[ i__] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 - wa3[i__] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 + wa3[i__] * cr4; /* L103: */ } /* L104: */ } return 0; } /* dpassb4_ */ /* ------ File dpassb5.f ------ */ /* Subroutine */ int dpassb5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) { /* Initialized data */ static r_8 tr11 = .309016994374947f; static r_8 ti11 = .951056516295154f; static r_8 tr12 = -.809016994374947f; static r_8 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 + ti3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + 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[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 - wa1[i__] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + wa1[i__] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - wa2[i__] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[ i__] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 - wa3[i__] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 + wa3[i__] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 - wa4[i__] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[ i__] * dr5; /* L103: */ } /* L104: */ } return 0; } /* dpassb5_ */ /* ------ File dpassf.f ------ */ /* Subroutine */ int dpassf_(int_4 *nac, int_4 *ido, int_4 *ip, int_4 * l1, int_4 *idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) { /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Local variables */ static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp; static r_8 wai, war; static int_4 ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ idot = *ido / 2; nt = *ip * *idl1; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; idp = *ip * *ido; if (*ido < *l1) { goto L106; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 1; i__ <= i__3; ++i__) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L101: */ } /* L102: */ } /* L103: */ } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } goto L112; L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * cc_dim1]; /* L107: */ } /* L108: */ } /* L109: */ } i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L110: */ } /* L111: */ } L112: idl = 2 - *ido; inc = 0; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; idl += *ido; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik + (ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1]; /* L113: */ } idlj = idl; inc += *ido; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; idlj += inc; if (idlj > idp) { idlj -= idp; } war = wa[idlj - 1]; wai = wa[idlj]; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1]; /* L114: */ } /* L115: */ } /* L116: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L117: */ } /* L118: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *idl1; for (ik = 2; ik <= i__2; ik += 2) { ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + jc * c2_dim1]; ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + jc * c2_dim1]; ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * c2_dim1]; ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * c2_dim1]; /* L119: */ } /* L120: */ } *nac = 1; if (*ido == 2) { return 0; } *nac = 0; i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L121: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * ch_dim1 + 2]; /* L122: */ } /* L123: */ } if (idot > *l1) { goto L127; } idij = 0; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idij += 2; i__2 = *ido; for (i__ = 4; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L124: */ } /* L125: */ } /* L126: */ } return 0; L127: idj = 2 - *ido; i__1 = *ip; for (j = 2; j <= i__1; ++j) { idj += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = idj; i__3 = *ido; for (i__ = 4; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L128: */ } /* L129: */ } /* L130: */ } return 0; } /* dpassf_ */ /* ------ File dpassf2.f ------ */ /* Subroutine */ int dpassf2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ if (*ido > 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + cc[((k << 1) + 2) * cc_dim1 + 2]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2]; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 - wa1[i__] * tr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 + wa1[i__] * ti2; /* L103: */ } /* L104: */ } return 0; } /* dpassf2_ */ /* ------ File dpassf3.f ------ */ /* Subroutine */ int dpassf3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2) { /* Initialized data */ static r_8 taur = -.5f; static r_8 taui = -.866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2]; ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2; cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * cc_dim1 + 1]); ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * cc_dim1 + 2]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 3) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + ( k * 3 + 3) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 3) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - wa1[i__] * dr2; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 + wa1[i__] * di2; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ i__] * dr3; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + wa2[i__] * di3; /* L103: */ } /* L104: */ } return 0; } /* dpassf3_ */ /* ------ File dpassf4.f ------ */ /* Subroutine */ int dpassf4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 + 2]; ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 + 2]; tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1 + 2]; ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 + 2]; tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 + 1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 + 1]; tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 3) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k << 2) + 2) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k << 2) + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 + tr4; cr4 = tr1 - tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 + wa1[i__] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 - wa1[i__] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 + wa2[i__] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[ i__] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 + wa3[i__] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 - wa3[i__] * cr4; /* L103: */ } /* L104: */ } return 0; } /* dpassf4_ */ /* ------ File dpassf5.f ------ */ /* Subroutine */ int dpassf5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) { /* Initialized data */ static r_8 tr11 = .309016994374947f; static r_8 ti11 = -.951056516295154f; static r_8 tr12 = -.809016994374947f; static r_8 ti12 = -.587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k; static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ if (*ido != 2) { goto L102; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2]; ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2]; ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2]; ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2]; tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1]; tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 + ti3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + 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[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5; ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4; ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5; /* L101: */ } return 0; L102: i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 2; i__ <= i__2; i__ += 2) { ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 5) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 + wa1[i__] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - wa1[i__] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + wa2[i__] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[ i__] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 + wa3[i__] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 - wa3[i__] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 + wa4[i__] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[ i__] * dr5; /* L103: */ } /* L104: */ } return 0; } /* dpassf5_ */ /* ------ File dadb2.f ------ */ /* Subroutine */ int dadb2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1) { /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 3 + 1; cc -= cc_offset; --wa1; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 1) + 2) * cc_dim1]; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k << 1) + 2) * cc_dim1]; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1]; ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2) * cc_dim1]; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2 - wa1[i__ - 1] * ti2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 + wa1[i__ - 1] * tr2; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) * cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1]; ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) * cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]); /* L106: */ } L107: return 0; } /* dadb2_ */ /* ------ File dadb3.f ------ */ /* Subroutine */ int dadb3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2) { /* Initialized data */ static r_8 taur = -.5f; static r_8 taui = .866025403784439f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = (cc_dim1 << 2) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) * cc_dim1]; cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2; ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1]); ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 + 2) * cc_dim1]; cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + tr2; ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) * cc_dim1]; ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * cc_dim1] + ti2; cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + ( k * 3 + 2) * cc_dim1]); ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 + 2) * cc_dim1]); dr2 = cr2 - ci3; dr3 = cr2 + ci3; di2 = ci2 + cr3; di3 = ci2 - cr3; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 - wa1[i__ - 1] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + wa1[i__ - 1] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - wa2[i__ - 1] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ i__ - 1] * dr3; /* L102: */ } /* L103: */ } return 0; } /* dadb3_ */ /* ------ File dadb4.f ------ */ /* Subroutine */ int dadb4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3) { /* Initialized data */ static r_8 sqrt2 = 1.414213562373095f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 5 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) * cc_dim1]; tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) * cc_dim1]; tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) * cc_dim1]; tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 + 1]; ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4) * cc_dim1]; ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4) * cc_dim1]; ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2) * cc_dim1]; tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2) * cc_dim1]; tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k << 2) + 4) * cc_dim1]; tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k << 2) + 4) * cc_dim1]; ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k << 2) + 2) * cc_dim1]; tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k << 2) + 2) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3; cr3 = tr2 - tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3; ci3 = ti2 - ti3; cr2 = tr1 - tr4; cr4 = tr1 + tr4; ci2 = ti1 + ti4; ci4 = ti1 - ti4; ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2 - wa1[i__ - 1] * ci2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 + wa1[i__ - 1] * cr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 - wa2[i__ - 1] * ci3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[ i__ - 1] * cr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4 - wa3[i__ - 1] * ci4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 + wa3[i__ - 1] * cr4; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 + 1]; ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 + 1]; tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) * cc_dim1]; tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) * cc_dim1]; ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2; ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1); ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2; ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1); /* L106: */ } L107: return 0; } /* dadb4_ */ /* ------ File dadb5.f ------ */ /* Subroutine */ int dadb5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) { /* Initialized data */ static r_8 tr11 = .309016994374947f; static r_8 ti11 = .951056516295154f; static r_8 tr12 = -.809016994374947f; static r_8 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_offset = cc_dim1 * 6 + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1]; ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1]; tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) * cc_dim1]; tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) * cc_dim1]; ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 + tr3; cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3; cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3; ci5 = ti11 * ti5 + ti12 * ti4; ci4 = ti12 * ti5 - ti11 * ti4; ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5; ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4; ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4; ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) * cc_dim1]; ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) * cc_dim1]; ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) * cc_dim1]; ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) * cc_dim1]; tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 + 2) * cc_dim1]; tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 + 2) * cc_dim1]; tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 + 4) * cc_dim1]; tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 + 4) * cc_dim1]; ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr2 + tr3; ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * cc_dim1] + ti2 + ti3; cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * tr3; ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3; cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * tr3; ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + 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[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 - wa1[i__ - 1] * di2; ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + wa1[i__ - 1] * dr2; ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - wa2[i__ - 1] * di3; ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[ i__ - 1] * dr3; ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4 - wa3[i__ - 1] * di4; ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 + wa3[i__ - 1] * dr4; ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 - wa4[i__ - 1] * di5; ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[ i__ - 1] * dr5; /* L102: */ } /* L103: */ } return 0; } /* dadb5_ */ /* ------ File dadbg.f ------ */ /* Subroutine */ int dadbg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) { /* Initialized data */ static r_8 tpi = 6.28318530717959f; /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; static r_8 dc2, ai1, ai2, ar1, ar2, ds2; static int_4 nbd; static r_8 dcp, arg, dsp, ar1h, ar2h; static int_4 idp2, ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ arg = tpi / (r_8) (*ip); dcp = cos(arg); dsp = sin(arg); idp2 = *ido + 2; nbd = (*ido - 1) / 2; ipp2 = *ip + 2; ipph = (*ip + 1) / 2; if (*ido < *l1) { goto L103; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L101: */ } /* L102: */ } goto L106; L103: i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * cc_dim1]; /* L104: */ } /* L105: */ } L106: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1]; ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1]; /* L107: */ } /* L108: */ } if (*ido == 1) { goto L116; } if (nbd < *l1) { goto L112; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ic = idp2 - i__; ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; /* L109: */ } /* L110: */ } /* L111: */ } goto L116; L112: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + k * cc_dim2) * cc_dim1]; /* L113: */ } /* L114: */ } /* L115: */ } L116: ar1 = 1.f; ai1 = 0.f; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; ar1h = dcp * ar1 - dsp * ai1; ai1 = dcp * ai1 + dsp * ar1; ar1 = ar1h; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + ( ch2_dim1 << 1)]; c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1]; /* L117: */ } dc2 = ar1; ds2 = ai1; ar2 = ar1; ai2 = ai1; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; ar2h = dc2 * ar2 - ds2 * ai2; ai2 = dc2 * ai2 + ds2 * ar2; ar2 = ar2h; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1]; c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1]; /* L118: */ } /* L119: */ } /* L120: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1]; /* L121: */ } /* L122: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1]; ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1]; /* L123: */ } /* L124: */ } if (*ido == 1) { goto L132; } if (nbd < *l1) { goto L128; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; /* L125: */ } /* L126: */ } /* L127: */ } goto L132; L128: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1]; /* L129: */ } /* L130: */ } /* L131: */ } L132: if (*ido == 1) { return 0; } i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L133: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; /* L134: */ } /* L135: */ } if (nbd > *l1) { goto L139; } is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; idij = is; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L136: */ } /* L137: */ } /* L138: */ } goto L143; L139: is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = is; i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { idij += 2; c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[ i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ + (k + j * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L140: */ } /* L141: */ } /* L142: */ } L143: return 0; } /* dadbg_ */ /* ------ File dadf2.f ------ */ /* Subroutine */ int dadf2_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1) { /* System generated locals */ int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ti2, tr2; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 3 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ti2; ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) * cc_dim1]; ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr2; ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - tr2; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1]; ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) * cc_dim1]; /* L106: */ } L107: return 0; } /* dadf2_ */ /* ------ File dadf3.f ------ */ /* Subroutine */ int dadf3_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2) { /* Initialized data */ static r_8 taur = -.5f; static r_8 taui = .866025403784439f; /* System generated locals */ int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = (ch_dim1 << 2) + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2; ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]); ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + taur * cr2; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; cr2 = dr2 + dr3; ci2 = di2 + di3; ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr2; ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ci2; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2; tr3 = taui * (di2 - di3); ti3 = taui * (dr3 - dr2); ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3; ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3; ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3; ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2; /* L102: */ } /* L103: */ } return 0; } /* dadf3_ */ /* ------ File dadf4.f ------ */ /* Subroutine */ int dadf4_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3) { /* Initialized data */ static r_8 hsqt2 = .7071067811865475f; /* System generated locals */ int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 5 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; --wa3; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1]; tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2; ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; /* L101: */ } if ((i__1 = *ido - 2) < 0) { goto L107; } else if (i__1 == 0) { goto L105; } else { goto L102; } L102: idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]; tr1 = cr2 + cr4; tr4 = cr4 - cr2; ti1 = ci2 + ci4; ti4 = ci2 - ci4; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3; ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3; tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3; ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2; ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1; ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2; ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2; ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3; ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4; ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3; ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3; /* L103: */ } /* L104: */ } if (*ido % 2 == 1) { return 0; } L105: i__1 = *l1; for (k = 1; k <= i__1; ++k) { ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido + (k + (cc_dim2 << 2)) * cc_dim1]); tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + ( k + (cc_dim2 << 2)) * cc_dim1]); ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) * cc_dim1]; ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) * cc_dim1] - tr1; ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) * cc_dim1]; ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) * cc_dim1]; /* L106: */ } L107: return 0; } /* dadf4_ */ /* ------ File dadf5.f ------ */ /* Subroutine */ int dadf5_(int_4 *ido, int_4 *l1, r_8 *cc, r_8 *ch, r_8 *wa1, r_8 *wa2, r_8 *wa3, r_8 *wa4) { /* Initialized data */ static r_8 tr11 = .309016994374947f; static r_8 ti11 = .951056516295154f; static r_8 tr12 = -.809016994374947f; static r_8 ti12 = .587785252292473f; /* System generated locals */ int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2; /* Local variables */ static int_4 i__, k, ic; static r_8 ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5; static int_4 idp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_offset = ch_dim1 * 6 + 1; ch -= ch_offset; cc_dim1 = *ido; cc_dim2 = *l1; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; --wa1; --wa2; --wa3; --wa4; /* Function Body */ i__1 = *l1; for (k = 1; k <= i__1; ++k) { cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]; cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * cc_dim1 + 1]; ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2 + cr3; ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + tr11 * cr2 + tr12 * cr3; ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4; ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + tr12 * cr2 + tr11 * cr3; ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4; /* L101: */ } if (*ido == 1) { return 0; } idp2 = *ido + 2; i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1]; di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]; dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1]; di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1]; dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1]; di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]; dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] + wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1]; di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[ i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1]; 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[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr2 + cr3; ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * cc_dim1] + ci2 + ci3; tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 * cr3; ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3; tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 * cr3; ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + 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[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5; ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5; ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5; ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2; ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4; ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4; ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4; ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3; /* L102: */ } /* L103: */ } return 0; } /* dadf5_ */ /* ------ File dadfg.f ------ */ /* Subroutine */ int dadfg_(int_4 *ido, int_4 *ip, int_4 *l1, int_4 * idl1, r_8 *cc, r_8 *c1, r_8 *c2, r_8 *ch, r_8 *ch2, r_8 *wa) { /* Initialized data */ static r_8 tpi = 6.28318530717959f; /* System generated locals */ int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1, c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); */ /* Local variables */ static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is; static r_8 dc2, ai1, ai2, ar1, ar2, ds2; static int_4 nbd; static r_8 dcp, arg, dsp, ar1h, ar2h; static int_4 idp2, ipp2; /* Parameter adjustments */ ch_dim1 = *ido; ch_dim2 = *l1; ch_offset = ch_dim1 * (ch_dim2 + 1) + 1; ch -= ch_offset; c1_dim1 = *ido; c1_dim2 = *l1; c1_offset = c1_dim1 * (c1_dim2 + 1) + 1; c1 -= c1_offset; cc_dim1 = *ido; cc_dim2 = *ip; cc_offset = cc_dim1 * (cc_dim2 + 1) + 1; cc -= cc_offset; ch2_dim1 = *idl1; ch2_offset = ch2_dim1 + 1; ch2 -= ch2_offset; c2_dim1 = *idl1; c2_offset = c2_dim1 + 1; c2 -= c2_offset; --wa; /* Function Body */ arg = tpi / (r_8) (*ip); dcp = cos(arg); dsp = sin(arg); ipph = (*ip + 1) / 2; ipp2 = *ip + 2; idp2 = *ido + 2; nbd = (*ido - 1) / 2; if (*ido == 1) { goto L119; } i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { ch2[ik + ch2_dim1] = c2[ik + c2_dim1]; /* L101: */ } i__1 = *ip; for (j = 2; j <= i__1; ++j) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * c1_dim1 + 1]; /* L102: */ } /* L103: */ } if (nbd > *l1) { goto L107; } is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; idij = is; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { idij += 2; i__3 = *l1; for (k = 1; k <= i__3; ++k) { ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * c1[i__ + (k + j * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1]; /* L104: */ } /* L105: */ } /* L106: */ } goto L111; L107: is = -(*ido); i__1 = *ip; for (j = 2; j <= i__1; ++j) { is += *ido; i__2 = *l1; for (k = 1; k <= i__2; ++k) { idij = is; i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { idij += 2; ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[ i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * c1[i__ + (k + j * c1_dim2) * c1_dim1]; ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1]; /* L108: */ } /* L109: */ } /* L110: */ } L111: if (nbd < *l1) { goto L115; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L112: */ } /* L113: */ } /* L114: */ } goto L121; L115: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { i__3 = *l1; for (k = 1; k <= i__3; ++k) { c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1]; /* L116: */ } /* L117: */ } /* L118: */ } goto L121; L119: i__1 = *idl1; for (ik = 1; ik <= i__1; ++ik) { c2[ik + c2_dim1] = ch2[ik + ch2_dim1]; /* L120: */ } L121: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1]; c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) * ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1]; /* L122: */ } /* L123: */ } ar1 = 1.f; ai1 = 0.f; i__1 = ipph; for (l = 2; l <= i__1; ++l) { lc = ipp2 - l; ar1h = dcp * ar1 - dsp * ai1; ai1 = dcp * ai1 + dsp * ar1; ar1 = ar1h; i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + ( c2_dim1 << 1)]; ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1]; /* L124: */ } dc2 = ar1; ds2 = ai1; ar2 = ar1; ai2 = ai1; i__2 = ipph; for (j = 3; j <= i__2; ++j) { jc = ipp2 - j; ar2h = dc2 * ar2 - ds2 * ai2; ai2 = dc2 * ai2 + ds2 * ar2; ar2 = ar2h; i__3 = *idl1; for (ik = 1; ik <= i__3; ++ik) { ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1]; ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1]; /* L125: */ } /* L126: */ } /* L127: */ } i__1 = ipph; for (j = 2; j <= i__1; ++j) { i__2 = *idl1; for (ik = 1; ik <= i__2; ++ik) { ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1]; /* L128: */ } /* L129: */ } if (*ido < *l1) { goto L132; } i__1 = *l1; for (k = 1; k <= i__1; ++k) { i__2 = *ido; for (i__ = 1; i__ <= i__2; ++i__) { cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * ch_dim1]; /* L130: */ } /* L131: */ } goto L135; L132: i__1 = *ido; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *l1; for (k = 1; k <= i__2; ++k) { cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * ch_dim1]; /* L133: */ } /* L134: */ } L135: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2) * ch_dim1 + 1]; cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) * ch_dim1 + 1]; /* L136: */ } /* L137: */ } if (*ido == 1) { return 0; } if (nbd < *l1) { goto L141; } i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *l1; for (k = 1; k <= i__2; ++k) { i__3 = *ido; for (i__ = 3; i__ <= i__3; i__ += 2) { ic = idp2 - i__; cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * ch_dim1]; /* L138: */ } /* L139: */ } /* L140: */ } return 0; L141: i__1 = ipph; for (j = 2; j <= i__1; ++j) { jc = ipp2 - j; j2 = j + j; i__2 = *ido; for (i__ = 3; i__ <= i__2; i__ += 2) { ic = idp2 - i__; i__3 = *l1; for (k = 1; k <= i__3; ++k) { cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + ( k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1]; cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j * ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * ch_dim1]; cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc * ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * ch_dim1]; /* L142: */ } /* L143: */ } /* L144: */ } return 0; } /* dadfg_ */ /* ------ File dfftb.f ------ */ /* Subroutine */ int dfftb_(int_4 *n, r_8 *r__, r_8 *wsave) { extern /* Subroutine */ int dfftb1_(int_4 *, r_8 *, r_8 *, r_8 *, int_8 *); /* Parameter adjustments */ --wsave; --r__; /* Function Body */ if (*n == 1) { return 0; } dfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* dfftb_ */ /* ------ File dfftb1.f ------ */ /* Subroutine */ int dfftb1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, int_8 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ extern /* Subroutine */ int dadb2_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *), dadb3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *), dadb4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *), dadb5_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 i__; extern /* Subroutine */ int dadbg_(int_4 *, int_4 *, int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 0; l1 = 1; iw = 1; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; l2 = ip * l1; ido = *n / l2; idl1 = ido * l1; if (ip != 4) { goto L103; } ix2 = iw + ido; ix3 = ix2 + ido; if (na != 0) { goto L101; } dadb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L102; L101: dadb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); L102: na = 1 - na; goto L115; L103: if (ip != 2) { goto L106; } if (na != 0) { goto L104; } dadb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); goto L105; L104: dadb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); L105: na = 1 - na; goto L115; L106: if (ip != 3) { goto L109; } ix2 = iw + ido; if (na != 0) { goto L107; } dadb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L108; L107: dadb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); L108: na = 1 - na; goto L115; L109: if (ip != 5) { goto L112; } ix2 = iw + ido; ix3 = ix2 + ido; ix4 = ix3 + ido; if (na != 0) { goto L110; } dadb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L111; L110: dadb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); L111: na = 1 - na; goto L115; L112: if (na != 0) { goto L113; } dadbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ 1], &wa[iw]); goto L114; L113: dadbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] , &wa[iw]); L114: if (ido == 1) { na = 1 - na; } L115: l1 = l2; iw += (ip - 1) * ido; /* L116: */ } if (na == 0) { return 0; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L117: */ } return 0; } /* dfftb1_ */ /* ------ File dfftf.f ------ */ /* Subroutine */ int dfftf_(int_4 *n, r_8 *r__, r_8 *wsave) { extern /* Subroutine */ int dfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, int_8 *); /* Parameter adjustments */ --wsave; --r__; /* Function Body */ if (*n == 1) { return 0; } dfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]);/* (int *) rajoute Reza 29/11/99 */ return 0; } /* dfftf_ */ /* ------ File dfftf1.f ------ */ /* Subroutine */ int dfftf1_(int_4 *n, r_8 *c__, r_8 *ch, r_8 *wa, int_8 *ifac) { /* System generated locals */ int_4 i__1; /* Local variables */ extern /* Subroutine */ int dadf2_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *), dadf3_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *), dadf4_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *), dadf5_(int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 i__; extern /* Subroutine */ int dadfg_(int_4 *, int_4 *, int_4 *, int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *, r_8 *); static int_4 k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1; /* Parameter adjustments */ --ifac; --wa; --ch; --c__; /* Function Body */ nf = ifac[2]; na = 1; l2 = *n; iw = *n; i__1 = nf; for (k1 = 1; k1 <= i__1; ++k1) { kh = nf - k1; ip = ifac[kh + 3]; l1 = l2 / ip; ido = *n / l2; idl1 = ido * l1; iw -= (ip - 1) * ido; na = 1 - na; if (ip != 4) { goto L102; } ix2 = iw + ido; ix3 = ix2 + ido; if (na != 0) { goto L101; } dadf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L110; L101: dadf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]); goto L110; L102: if (ip != 2) { goto L104; } if (na != 0) { goto L103; } dadf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]); goto L110; L103: dadf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]); goto L110; L104: if (ip != 3) { goto L106; } ix2 = iw + ido; if (na != 0) { goto L105; } dadf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]); goto L110; L105: dadf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]); goto L110; L106: if (ip != 5) { goto L108; } ix2 = iw + ido; ix3 = ix2 + ido; ix4 = ix3 + ido; if (na != 0) { goto L107; } dadf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L110; L107: dadf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[ ix4]); goto L110; L108: if (ido == 1) { na = 1 - na; } if (na != 0) { goto L109; } dadfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[ 1], &wa[iw]); na = 1; goto L110; L109: dadfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1] , &wa[iw]); na = 0; L110: l2 = l1; /* L111: */ } if (na == 1) { return 0; } i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { c__[i__] = ch[i__]; /* L112: */ } return 0; } /* dfftf1_ */ /* ------ File dffti.f ------ */ /* Subroutine */ int dffti_(int_4 *n, r_8 *wsave) { extern /* Subroutine */ int dffti1_(int_4 *, r_8 *, int_8 *); /* Parameter adjustments */ --wsave; /* Function Body */ if (*n == 1) { return 0; } dffti1_(n, &wsave[*n + 1], (int_8 *)&wsave[(*n << 1) + 1]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* dffti_ */ /* ------ File dffti1.f ------ */ /* Subroutine */ int dffti1_(int_4 *n, r_8 *wa, int_8 *ifac) { /* Initialized data */ static int_4 ntryh[4] = { 4,2,3,5 }; /* System generated locals */ int_4 i__1, i__2, i__3; /* Builtin functions */ /* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static r_8 argh; static int_4 ntry, i__, j; static r_8 argld; static int_4 k1, l1, l2, ib; static r_8 fi; static int_4 ld, ii, nf, ip, nl, is, nq, nr; static r_8 arg; static int_4 ido, ipm; static r_8 tpi; static int_4 nfm1; /* Parameter adjustments */ --ifac; --wa; /* Function Body */ nl = *n; nf = 0; j = 0; L101: ++j; if (j - 4 <= 0) { goto L102; } else { goto L103; } L102: ntry = ntryh[j - 1]; goto L104; L103: ntry += 2; L104: nq = nl / ntry; nr = nl - ntry * nq; if (nr != 0) { goto L101; } else { goto L105; } L105: ++nf; ifac[nf + 2] = ntry; nl = nq; if (ntry != 2) { goto L107; } if (nf == 1) { goto L107; } i__1 = nf; for (i__ = 2; i__ <= i__1; ++i__) { ib = nf - i__ + 2; ifac[ib + 2] = ifac[ib + 1]; /* L106: */ } ifac[3] = 2; L107: if (nl != 1) { goto L104; } ifac[1] = *n; ifac[2] = nf; tpi = 6.28318530717959f; argh = tpi / (r_8) (*n); is = 0; nfm1 = nf - 1; l1 = 1; if (nfm1 == 0) { return 0; } i__1 = nfm1; for (k1 = 1; k1 <= i__1; ++k1) { ip = ifac[k1 + 2]; ld = 0; l2 = l1 * ip; ido = *n / l2; ipm = ip - 1; i__2 = ipm; for (j = 1; j <= i__2; ++j) { ld += l1; i__ = is; argld = (r_8) ld * argh; fi = 0.f; i__3 = ido; for (ii = 3; ii <= i__3; ii += 2) { i__ += 2; fi += 1.f; arg = fi * argld; wa[i__ - 1] = cos(arg); wa[i__] = sin(arg); /* L108: */ } is += ido; /* L109: */ } l1 = l2; /* L110: */ } return 0; } /* dffti1_ */ /* ------ File dsinqb.f ------ */ /* Subroutine */ int dsinqb_(int_4 *n, r_8 *x, r_8 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 k; extern /* Subroutine */ int dcosqb_(int_4 *, r_8 *, r_8 *); static r_8 xhold; static int_4 kc, ns2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ if (*n > 1) { goto L101; } x[1] *= 4.f; return 0; L101: ns2 = *n / 2; i__1 = *n; for (k = 2; k <= i__1; k += 2) { x[k] = -x[k]; /* L102: */ } dcosqb_(n, &x[1], &wsave[1]); i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = *n - k; xhold = x[k]; x[k] = x[kc + 1]; x[kc + 1] = xhold; /* L103: */ } return 0; } /* dsinqb_ */ /* ------ File dsinqf.f ------ */ /* Subroutine */ int dsinqf_(int_4 *n, r_8 *x, r_8 *wsave) { /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 k; extern /* Subroutine */ int dcosqf_(int_4 *, r_8 *, r_8 *); static r_8 xhold; static int_4 kc, ns2; /* Parameter adjustments */ --wsave; --x; /* Function Body */ if (*n == 1) { return 0; } ns2 = *n / 2; i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = *n - k; xhold = x[k]; x[k] = x[kc + 1]; x[kc + 1] = xhold; /* L101: */ } dcosqf_(n, &x[1], &wsave[1]); i__1 = *n; for (k = 2; k <= i__1; k += 2) { x[k] = -x[k]; /* L102: */ } return 0; } /* dsinqf_ */ /* ------ File dsinqi.f ------ */ /* Subroutine */ int dsinqi_(int_4 *n, r_8 *wsave) { extern /* Subroutine */ int dcosqi_(int_4 *, r_8 *); /* Parameter adjustments */ --wsave; /* Function Body */ dcosqi_(n, &wsave[1]); return 0; } /* dsinqi_ */ /* ------ File dsint.f ------ */ /* Subroutine */ int dsint_(int_4 *n, r_8 *x, r_8 *wsave) { extern /* Subroutine */ int dsint1_(int_4 *, r_8 *, r_8 *, r_8 *, r_8 *, int_8 *); static int_4 np1, iw1, iw2, iw3; /* Parameter adjustments */ --wsave; --x; /* Function Body */ np1 = *n + 1; iw1 = *n / 2 + 1; iw2 = iw1 + np1; iw3 = iw2 + np1; dsint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], (int_8 *) &wsave[iw3]); /* (int *) rajoute Reza 29/11/99 */ return 0; } /* dsint_ */ /* ------ File dsint1.f ------ */ /* Subroutine */ int dsint1_(int_4 *n, r_8 *war, r_8 *was, r_8 *xh, r_8 * x, int_8 *ifac) { /* Initialized data */ static r_8 sqrt3 = 1.73205080756888f; /* System generated locals */ int_4 i__1; /* Local variables */ static int_4 modn, i__, k; static r_8 xhold, t1, t2; extern /* Subroutine */ int dfftf1_(int_4 *, r_8 *, r_8 *, r_8 *, int_8 *); static int_4 kc, np1, ns2; /* Parameter adjustments */ --ifac; --x; --xh; --was; --war; /* Function Body */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { xh[i__] = war[i__]; war[i__] = x[i__]; /* L100: */ } if ((i__1 = *n - 2) < 0) { goto L101; } else if (i__1 == 0) { goto L102; } else { goto L103; } L101: xh[1] += xh[1]; goto L106; L102: xhold = sqrt3 * (xh[1] + xh[2]); xh[2] = sqrt3 * (xh[1] - xh[2]); xh[1] = xhold; goto L106; L103: np1 = *n + 1; ns2 = *n / 2; x[1] = 0.f; i__1 = ns2; for (k = 1; k <= i__1; ++k) { kc = np1 - k; t1 = xh[k] - xh[kc]; t2 = was[k] * (xh[k] + xh[kc]); x[k + 1] = t1 + t2; x[kc + 1] = t2 - t1; /* L104: */ } modn = *n % 2; if (modn != 0) { x[ns2 + 2] = xh[ns2 + 1] * 4.f; } dfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]); xh[1] = x[1] * .5f; i__1 = *n; for (i__ = 3; i__ <= i__1; i__ += 2) { xh[i__ - 1] = -x[i__]; xh[i__] = xh[i__ - 2] + x[i__ - 1]; /* L105: */ } if (modn != 0) { goto L106; } xh[*n] = -x[*n + 1]; L106: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { x[i__] = war[i__]; war[i__] = xh[i__]; /* L107: */ } return 0; } /* dsint1_ */ /* ------ File dsinti.f ------ */ /* Subroutine */ int dsinti_(int_4 *n, r_8 *wsave) { /* Initialized data */ static r_8 pi = 3.14159265358979f; /* System generated locals */ int_4 i__1; /* Builtin functions */ /* r_8 sin(r_8truc); remplace par math.h Reza 29/11/99 */ /* Local variables */ static int_4 k; extern /* Subroutine */ int dffti_(int_4 *, r_8 *); static r_8 dt; static int_4 np1, ns2; /* Parameter adjustments */ --wsave; /* Function Body */ if (*n <= 1) { return 0; } ns2 = *n / 2; np1 = *n + 1; dt = pi / (r_8) np1; i__1 = ns2; for (k = 1; k <= i__1; ++k) { wsave[k] = sin(k * dt) * 2.f; /* L101: */ } dffti_(&np1, &wsave[ns2 + 1]); return 0; } /* dsinti_ */