00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016 int rffti_(integer *n, doublereal *wsave)
00017 {
00018 extern int rffti1_(integer *, doublereal *, doublereal *)
00019 ;
00020
00021
00022
00023
00024 --wsave;
00025
00026
00027 if (*n == 1) {
00028 return 0;
00029 }
00030 rffti1_(n, &wsave[*n + 1], &wsave[(*n << 1) + 1]);
00031 return 0;
00032 }
00033
00034 int rffti1_(integer *n, doublereal *wa, integer *ifac)
00035 {
00036
00037
00038 static integer ntryh[4] = { 4,2,3,5 };
00039
00040
00041 integer i__1, i__2, i__3;
00042
00043
00044 double cos(doublereal), sin(doublereal);
00045
00046
00047 static doublereal argh;
00048 static integer ntry, i__, j;
00049 static doublereal argld;
00050 static integer k1, l1, l2, ib;
00051 static doublereal fi;
00052 static integer ld, ii, nf, ip, nl, is, nq, nr;
00053 static doublereal arg;
00054 static integer ido, ipm;
00055 static doublereal tpi;
00056 static integer nfm1;
00057
00058
00059
00060
00061 --ifac;
00062 --wa;
00063
00064
00065 nl = *n;
00066 nf = 0;
00067 j = 0;
00068 L101:
00069 ++j;
00070 if (j - 4 <= 0) {
00071 goto L102;
00072 } else {
00073 goto L103;
00074 }
00075 L102:
00076 ntry = ntryh[j - 1];
00077 goto L104;
00078 L103:
00079 ntry += 2;
00080 L104:
00081 nq = nl / ntry;
00082 nr = nl - ntry * nq;
00083 if (nr != 0) {
00084 goto L101;
00085 } else {
00086 goto L105;
00087 }
00088 L105:
00089 ++nf;
00090 ifac[nf + 2] = ntry;
00091 nl = nq;
00092 if (ntry != 2) {
00093 goto L107;
00094 }
00095 if (nf == 1) {
00096 goto L107;
00097 }
00098 i__1 = nf;
00099 for (i__ = 2; i__ <= i__1; ++i__) {
00100 ib = nf - i__ + 2;
00101 ifac[ib + 2] = ifac[ib + 1];
00102
00103 }
00104 ifac[3] = 2;
00105 L107:
00106 if (nl != 1) {
00107 goto L104;
00108 }
00109 ifac[1] = *n;
00110 ifac[2] = nf;
00111 tpi = (float)6.28318530717959;
00112 argh = tpi / (real) (*n);
00113 is = 0;
00114 nfm1 = nf - 1;
00115 l1 = 1;
00116 if (nfm1 == 0) {
00117 return 0;
00118 }
00119 i__1 = nfm1;
00120 for (k1 = 1; k1 <= i__1; ++k1) {
00121 ip = ifac[k1 + 2];
00122 ld = 0;
00123 l2 = l1 * ip;
00124 ido = *n / l2;
00125 ipm = ip - 1;
00126 i__2 = ipm;
00127 for (j = 1; j <= i__2; ++j) {
00128 ld += l1;
00129 i__ = is;
00130 argld = (real) ld * argh;
00131 fi = (float)0.;
00132 i__3 = ido;
00133 for (ii = 3; ii <= i__3; ii += 2) {
00134 i__ += 2;
00135 fi += (float)1.;
00136 arg = fi * argld;
00137 wa[i__ - 1] = cos(arg);
00138 wa[i__] = sin(arg);
00139
00140 }
00141 is += ido;
00142
00143 }
00144 l1 = l2;
00145
00146 }
00147 return 0;
00148 }
00149
00150 int rfftf_(integer *n, doublereal *r__, doublereal *wsave)
00151 {
00152 extern int rfftf1_(integer *, doublereal *, doublereal *,
00153 doublereal *, doublereal *);
00154
00155
00156
00157
00158 --wsave;
00159 --r__;
00160
00161
00162 if (*n == 1) {
00163 return 0;
00164 }
00165 rfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
00166 return 0;
00167 }
00168
00169 int rfftf1_(integer *n, doublereal *c__, doublereal *ch,
00170 doublereal *wa, integer *ifac)
00171 {
00172
00173 integer i__1;
00174
00175
00176 extern int radf2_(integer *, integer *, doublereal *,
00177 doublereal *, doublereal *), radf3_(integer *, integer *,
00178 doublereal *, doublereal *, doublereal *, doublereal *), radf4_(
00179 integer *, integer *, doublereal *, doublereal *, doublereal *,
00180 doublereal *, doublereal *), radf5_(integer *, integer *,
00181 doublereal *, doublereal *, doublereal *, doublereal *,
00182 doublereal *, doublereal *);
00183 static integer i__;
00184 extern int radfg_(integer *, integer *, integer *,
00185 integer *, doublereal *, doublereal *, doublereal *, doublereal *,
00186 doublereal *, doublereal *);
00187 static integer k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
00188
00189
00190
00191
00192 --ifac;
00193 --wa;
00194 --ch;
00195 --c__;
00196
00197
00198 nf = ifac[2];
00199 na = 1;
00200 l2 = *n;
00201 iw = *n;
00202 i__1 = nf;
00203 for (k1 = 1; k1 <= i__1; ++k1) {
00204 kh = nf - k1;
00205 ip = ifac[kh + 3];
00206 l1 = l2 / ip;
00207 ido = *n / l2;
00208 idl1 = ido * l1;
00209 iw -= (ip - 1) * ido;
00210 na = 1 - na;
00211 if (ip != 4) {
00212 goto L102;
00213 }
00214 ix2 = iw + ido;
00215 ix3 = ix2 + ido;
00216 if (na != 0) {
00217 goto L101;
00218 }
00219 radf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
00220 goto L110;
00221 L101:
00222 radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
00223 goto L110;
00224 L102:
00225 if (ip != 2) {
00226 goto L104;
00227 }
00228 if (na != 0) {
00229 goto L103;
00230 }
00231 radf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
00232 goto L110;
00233 L103:
00234 radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
00235 goto L110;
00236 L104:
00237 if (ip != 3) {
00238 goto L106;
00239 }
00240 ix2 = iw + ido;
00241 if (na != 0) {
00242 goto L105;
00243 }
00244 radf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
00245 goto L110;
00246 L105:
00247 radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
00248 goto L110;
00249 L106:
00250 if (ip != 5) {
00251 goto L108;
00252 }
00253 ix2 = iw + ido;
00254 ix3 = ix2 + ido;
00255 ix4 = ix3 + ido;
00256 if (na != 0) {
00257 goto L107;
00258 }
00259 radf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
00260 ix4]);
00261 goto L110;
00262 L107:
00263 radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
00264 ix4]);
00265 goto L110;
00266 L108:
00267 if (ido == 1) {
00268 na = 1 - na;
00269 }
00270 if (na != 0) {
00271 goto L109;
00272 }
00273 radfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
00274 1], &wa[iw]);
00275 na = 1;
00276 goto L110;
00277 L109:
00278 radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
00279 , &wa[iw]);
00280 na = 0;
00281 L110:
00282 l2 = l1;
00283
00284 }
00285 if (na == 1) {
00286 return 0;
00287 }
00288 i__1 = *n;
00289 for (i__ = 1; i__ <= i__1; ++i__) {
00290 c__[i__] = ch[i__];
00291
00292 }
00293 return 0;
00294 }
00295
00296 int radfg_(integer *ido, integer *ip, integer *l1, integer *
00297 idl1, doublereal *cc, doublereal *c1, doublereal *c2, doublereal *ch,
00298 doublereal *ch2, doublereal *wa)
00299 {
00300
00301
00302 static doublereal tpi = 6.28318530717959;
00303
00304
00305 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
00306 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
00307 i__1, i__2, i__3;
00308
00309
00310 double cos(doublereal), sin(doublereal);
00311
00312
00313 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
00314 static doublereal dc2, ai1, ai2, ar1, ar2, ds2;
00315 static integer nbd;
00316 static doublereal dcp, arg, dsp, ar1h, ar2h;
00317 static integer idp2, ipp2;
00318
00319
00320
00321
00322 ch_dim1 = *ido;
00323 ch_dim2 = *l1;
00324 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
00325 ch -= ch_offset;
00326 c1_dim1 = *ido;
00327 c1_dim2 = *l1;
00328 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
00329 c1 -= c1_offset;
00330 cc_dim1 = *ido;
00331 cc_dim2 = *ip;
00332 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
00333 cc -= cc_offset;
00334 ch2_dim1 = *idl1;
00335 ch2_offset = ch2_dim1 + 1;
00336 ch2 -= ch2_offset;
00337 c2_dim1 = *idl1;
00338 c2_offset = c2_dim1 + 1;
00339 c2 -= c2_offset;
00340 --wa;
00341
00342
00343 arg = tpi / (real) (*ip);
00344 dcp = cos(arg);
00345 dsp = sin(arg);
00346 ipph = (*ip + 1) / 2;
00347 ipp2 = *ip + 2;
00348 idp2 = *ido + 2;
00349 nbd = (*ido - 1) / 2;
00350 if (*ido == 1) {
00351 goto L119;
00352 }
00353 i__1 = *idl1;
00354 for (ik = 1; ik <= i__1; ++ik) {
00355 ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
00356
00357 }
00358 i__1 = *ip;
00359 for (j = 2; j <= i__1; ++j) {
00360 i__2 = *l1;
00361 for (k = 1; k <= i__2; ++k) {
00362 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
00363 c1_dim1 + 1];
00364
00365 }
00366
00367 }
00368 if (nbd > *l1) {
00369 goto L107;
00370 }
00371 is = -(*ido);
00372 i__1 = *ip;
00373 for (j = 2; j <= i__1; ++j) {
00374 is += *ido;
00375 idij = is;
00376 i__2 = *ido;
00377 for (i__ = 3; i__ <= i__2; i__ += 2) {
00378 idij += 2;
00379 i__3 = *l1;
00380 for (k = 1; k <= i__3; ++k) {
00381 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
00382 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
00383 c1[i__ + (k + j * c1_dim2) * c1_dim1];
00384 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
00385 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
00386 1 + (k + j * c1_dim2) * c1_dim1];
00387
00388 }
00389
00390 }
00391
00392 }
00393 goto L111;
00394 L107:
00395 is = -(*ido);
00396 i__1 = *ip;
00397 for (j = 2; j <= i__1; ++j) {
00398 is += *ido;
00399 i__2 = *l1;
00400 for (k = 1; k <= i__2; ++k) {
00401 idij = is;
00402 i__3 = *ido;
00403 for (i__ = 3; i__ <= i__3; i__ += 2) {
00404 idij += 2;
00405 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
00406 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
00407 c1[i__ + (k + j * c1_dim2) * c1_dim1];
00408 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
00409 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
00410 1 + (k + j * c1_dim2) * c1_dim1];
00411
00412 }
00413
00414 }
00415
00416 }
00417 L111:
00418 if (nbd < *l1) {
00419 goto L115;
00420 }
00421 i__1 = ipph;
00422 for (j = 2; j <= i__1; ++j) {
00423 jc = ipp2 - j;
00424 i__2 = *l1;
00425 for (k = 1; k <= i__2; ++k) {
00426 i__3 = *ido;
00427 for (i__ = 3; i__ <= i__3; i__ += 2) {
00428 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
00429 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
00430 ch_dim2) * ch_dim1];
00431 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
00432 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
00433 ch_dim1];
00434 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
00435 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
00436 ch_dim1];
00437 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
00438 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
00439 * ch_dim1];
00440
00441 }
00442
00443 }
00444
00445 }
00446 goto L121;
00447 L115:
00448 i__1 = ipph;
00449 for (j = 2; j <= i__1; ++j) {
00450 jc = ipp2 - j;
00451 i__2 = *ido;
00452 for (i__ = 3; i__ <= i__2; i__ += 2) {
00453 i__3 = *l1;
00454 for (k = 1; k <= i__3; ++k) {
00455 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
00456 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
00457 ch_dim2) * ch_dim1];
00458 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
00459 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
00460 ch_dim1];
00461 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
00462 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
00463 ch_dim1];
00464 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
00465 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
00466 * ch_dim1];
00467
00468 }
00469
00470 }
00471
00472 }
00473 goto L121;
00474 L119:
00475 i__1 = *idl1;
00476 for (ik = 1; ik <= i__1; ++ik) {
00477 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
00478
00479 }
00480 L121:
00481 i__1 = ipph;
00482 for (j = 2; j <= i__1; ++j) {
00483 jc = ipp2 - j;
00484 i__2 = *l1;
00485 for (k = 1; k <= i__2; ++k) {
00486 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
00487 ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
00488 c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) *
00489 ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
00490
00491 }
00492
00493 }
00494
00495 ar1 = (float)1.;
00496 ai1 = (float)0.;
00497 i__1 = ipph;
00498 for (l = 2; l <= i__1; ++l) {
00499 lc = ipp2 - l;
00500 ar1h = dcp * ar1 - dsp * ai1;
00501 ai1 = dcp * ai1 + dsp * ar1;
00502 ar1 = ar1h;
00503 i__2 = *idl1;
00504 for (ik = 1; ik <= i__2; ++ik) {
00505 ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
00506 c2_dim1 << 1)];
00507 ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1];
00508
00509 }
00510 dc2 = ar1;
00511 ds2 = ai1;
00512 ar2 = ar1;
00513 ai2 = ai1;
00514 i__2 = ipph;
00515 for (j = 3; j <= i__2; ++j) {
00516 jc = ipp2 - j;
00517 ar2h = dc2 * ar2 - ds2 * ai2;
00518 ai2 = dc2 * ai2 + ds2 * ar2;
00519 ar2 = ar2h;
00520 i__3 = *idl1;
00521 for (ik = 1; ik <= i__3; ++ik) {
00522 ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
00523 ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
00524
00525 }
00526
00527 }
00528
00529 }
00530 i__1 = ipph;
00531 for (j = 2; j <= i__1; ++j) {
00532 i__2 = *idl1;
00533 for (ik = 1; ik <= i__2; ++ik) {
00534 ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
00535
00536 }
00537
00538 }
00539
00540 if (*ido < *l1) {
00541 goto L132;
00542 }
00543 i__1 = *l1;
00544 for (k = 1; k <= i__1; ++k) {
00545 i__2 = *ido;
00546 for (i__ = 1; i__ <= i__2; ++i__) {
00547 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
00548 ch_dim1];
00549
00550 }
00551
00552 }
00553 goto L135;
00554 L132:
00555 i__1 = *ido;
00556 for (i__ = 1; i__ <= i__1; ++i__) {
00557 i__2 = *l1;
00558 for (k = 1; k <= i__2; ++k) {
00559 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
00560 ch_dim1];
00561
00562 }
00563
00564 }
00565 L135:
00566 i__1 = ipph;
00567 for (j = 2; j <= i__1; ++j) {
00568 jc = ipp2 - j;
00569 j2 = j + j;
00570 i__2 = *l1;
00571 for (k = 1; k <= i__2; ++k) {
00572 cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
00573 * ch_dim1 + 1];
00574 cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
00575 ch_dim1 + 1];
00576
00577 }
00578
00579 }
00580 if (*ido == 1) {
00581 return 0;
00582 }
00583 if (nbd < *l1) {
00584 goto L141;
00585 }
00586 i__1 = ipph;
00587 for (j = 2; j <= i__1; ++j) {
00588 jc = ipp2 - j;
00589 j2 = j + j;
00590 i__2 = *l1;
00591 for (k = 1; k <= i__2; ++k) {
00592 i__3 = *ido;
00593 for (i__ = 3; i__ <= i__3; i__ += 2) {
00594 ic = idp2 - i__;
00595 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
00596 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
00597 ch_dim2) * ch_dim1];
00598 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
00599 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
00600 ch_dim2) * ch_dim1];
00601 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
00602 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
00603 ch_dim1];
00604 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
00605 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
00606 ch_dim1];
00607
00608 }
00609
00610 }
00611
00612 }
00613 return 0;
00614 L141:
00615 i__1 = ipph;
00616 for (j = 2; j <= i__1; ++j) {
00617 jc = ipp2 - j;
00618 j2 = j + j;
00619 i__2 = *ido;
00620 for (i__ = 3; i__ <= i__2; i__ += 2) {
00621 ic = idp2 - i__;
00622 i__3 = *l1;
00623 for (k = 1; k <= i__3; ++k) {
00624 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
00625 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
00626 ch_dim2) * ch_dim1];
00627 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
00628 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
00629 ch_dim2) * ch_dim1];
00630 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
00631 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
00632 ch_dim1];
00633 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
00634 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
00635 ch_dim1];
00636
00637 }
00638
00639 }
00640
00641 }
00642 return 0;
00643 }
00644
00645 int radf5_(integer *ido, integer *l1, doublereal *cc,
00646 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3,
00647 doublereal *wa4)
00648 {
00649
00650
00651 static doublereal tr11 = .309016994374947;
00652 static doublereal ti11 = .951056516295154;
00653 static doublereal tr12 = -.809016994374947;
00654 static doublereal ti12 = .587785252292473;
00655
00656
00657 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
00658
00659
00660 static integer i__, k, ic;
00661 static doublereal ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2,
00662 dr3, dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
00663 static integer idp2;
00664
00665
00666
00667
00668 ch_dim1 = *ido;
00669 ch_offset = ch_dim1 * 6 + 1;
00670 ch -= ch_offset;
00671 cc_dim1 = *ido;
00672 cc_dim2 = *l1;
00673 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
00674 cc -= cc_offset;
00675 --wa1;
00676 --wa2;
00677 --wa3;
00678 --wa4;
00679
00680
00681 i__1 = *l1;
00682 for (k = 1; k <= i__1; ++k) {
00683 cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) *
00684 cc_dim1 + 1];
00685 ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) *
00686 cc_dim1 + 1];
00687 cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
00688 cc_dim1 + 1];
00689 ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) *
00690 cc_dim1 + 1];
00691 ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2
00692 + cr3;
00693 ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
00694 tr11 * cr2 + tr12 * cr3;
00695 ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
00696 ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
00697 tr12 * cr2 + tr11 * cr3;
00698 ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
00699
00700 }
00701 if (*ido == 1) {
00702 return 0;
00703 }
00704 idp2 = *ido + 2;
00705 i__1 = *l1;
00706 for (k = 1; k <= i__1; ++k) {
00707 i__2 = *ido;
00708 for (i__ = 3; i__ <= i__2; i__ += 2) {
00709 ic = idp2 - i__;
00710 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
00711 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
00712 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
00713 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
00714 cc_dim1];
00715 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
00716 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
00717 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
00718 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
00719 dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
00720 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
00721 di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
00722 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
00723 cc_dim1];
00724 dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] +
00725 wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
00726 di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
00727 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
00728 cr2 = dr2 + dr5;
00729 ci5 = dr5 - dr2;
00730 cr5 = di2 - di5;
00731 ci2 = di2 + di5;
00732 cr3 = dr3 + dr4;
00733 ci4 = dr4 - dr3;
00734 cr4 = di3 - di4;
00735 ci3 = di3 + di4;
00736 ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
00737 cc_dim1] + cr2 + cr3;
00738 ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
00739 cc_dim1] + ci2 + ci3;
00740 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 *
00741 cr3;
00742 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
00743 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 *
00744 cr3;
00745 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
00746 tr5 = ti11 * cr5 + ti12 * cr4;
00747 ti5 = ti11 * ci5 + ti12 * ci4;
00748 tr4 = ti12 * cr5 - ti11 * cr4;
00749 ti4 = ti12 * ci5 - ti11 * ci4;
00750 ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
00751 ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
00752 ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
00753 ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
00754 ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
00755 ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
00756 ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
00757 ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
00758
00759 }
00760
00761 }
00762 return 0;
00763 }
00764
00765 int radf3_(integer *ido, integer *l1, doublereal *cc,
00766 doublereal *ch, doublereal *wa1, doublereal *wa2)
00767 {
00768
00769
00770 static doublereal taur = -.5;
00771 static doublereal taui = .866025403784439;
00772
00773
00774 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
00775
00776
00777 static integer i__, k, ic;
00778 static doublereal ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
00779 static integer idp2;
00780
00781
00782
00783
00784 ch_dim1 = *ido;
00785 ch_offset = (ch_dim1 << 2) + 1;
00786 ch -= ch_offset;
00787 cc_dim1 = *ido;
00788 cc_dim2 = *l1;
00789 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
00790 cc -= cc_offset;
00791 --wa1;
00792 --wa2;
00793
00794
00795 i__1 = *l1;
00796 for (k = 1; k <= i__1; ++k) {
00797 cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
00798 cc_dim1 + 1];
00799 ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
00800 ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) *
00801 cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
00802 ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
00803 taur * cr2;
00804
00805 }
00806 if (*ido == 1) {
00807 return 0;
00808 }
00809 idp2 = *ido + 2;
00810 i__1 = *l1;
00811 for (k = 1; k <= i__1; ++k) {
00812 i__2 = *ido;
00813 for (i__ = 3; i__ <= i__2; i__ += 2) {
00814 ic = idp2 - i__;
00815 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
00816 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
00817 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
00818 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
00819 cc_dim1];
00820 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
00821 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
00822 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
00823 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
00824 cr2 = dr2 + dr3;
00825 ci2 = di2 + di3;
00826 ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
00827 cc_dim1] + cr2;
00828 ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
00829 cc_dim1] + ci2;
00830 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
00831 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
00832 tr3 = taui * (di2 - di3);
00833 ti3 = taui * (dr3 - dr2);
00834 ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
00835 ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
00836 ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
00837 ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
00838
00839 }
00840
00841 }
00842 return 0;
00843 }
00844
00845 int radf2_(integer *ido, integer *l1, doublereal *cc,
00846 doublereal *ch, doublereal *wa1)
00847 {
00848
00849 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
00850
00851
00852 static integer i__, k, ic;
00853 static doublereal ti2, tr2;
00854 static integer idp2;
00855
00856
00857
00858
00859 ch_dim1 = *ido;
00860 ch_offset = ch_dim1 * 3 + 1;
00861 ch -= ch_offset;
00862 cc_dim1 = *ido;
00863 cc_dim2 = *l1;
00864 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
00865 cc -= cc_offset;
00866 --wa1;
00867
00868
00869 i__1 = *l1;
00870 for (k = 1; k <= i__1; ++k) {
00871 ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
00872 cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
00873 ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
00874 - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
00875
00876 }
00877 if ((i__1 = *ido - 2) < 0) {
00878 goto L107;
00879 } else if (i__1 == 0) {
00880 goto L105;
00881 } else {
00882 goto L102;
00883 }
00884 L102:
00885 idp2 = *ido + 2;
00886 i__1 = *l1;
00887 for (k = 1; k <= i__1; ++k) {
00888 i__2 = *ido;
00889 for (i__ = 3; i__ <= i__2; i__ += 2) {
00890 ic = idp2 - i__;
00891 tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
00892 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
00893 ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
00894 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
00895 cc_dim1];
00896 ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
00897 cc_dim1] + ti2;
00898 ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
00899 cc_dim1];
00900 ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k +
00901 cc_dim2) * cc_dim1] + tr2;
00902 ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
00903 * cc_dim1] - tr2;
00904
00905 }
00906
00907 }
00908 if (*ido % 2 == 1) {
00909 return 0;
00910 }
00911 L105:
00912 i__1 = *l1;
00913 for (k = 1; k <= i__1; ++k) {
00914 ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) *
00915 cc_dim1];
00916 ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) *
00917 cc_dim1];
00918
00919 }
00920 L107:
00921 return 0;
00922 }
00923
00924 int radf4_(integer *ido, integer *l1, doublereal *cc,
00925 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3)
00926 {
00927
00928
00929 static doublereal hsqt2 = .7071067811865475;
00930
00931
00932 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
00933
00934
00935 static integer i__, k, ic;
00936 static doublereal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1,
00937 tr2, tr3, tr4;
00938 static integer idp2;
00939
00940
00941
00942
00943 ch_dim1 = *ido;
00944 ch_offset = ch_dim1 * 5 + 1;
00945 ch -= ch_offset;
00946 cc_dim1 = *ido;
00947 cc_dim2 = *l1;
00948 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
00949 cc -= cc_offset;
00950 --wa1;
00951 --wa2;
00952 --wa3;
00953
00954
00955 i__1 = *l1;
00956 for (k = 1; k <= i__1; ++k) {
00957 tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
00958 * cc_dim1 + 1];
00959 tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
00960 cc_dim1 + 1];
00961 ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
00962 ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
00963 ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
00964 - cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
00965 ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1
00966 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
00967
00968 }
00969 if ((i__1 = *ido - 2) < 0) {
00970 goto L107;
00971 } else if (i__1 == 0) {
00972 goto L105;
00973 } else {
00974 goto L102;
00975 }
00976 L102:
00977 idp2 = *ido + 2;
00978 i__1 = *l1;
00979 for (k = 1; k <= i__1; ++k) {
00980 i__2 = *ido;
00981 for (i__ = 3; i__ <= i__2; i__ += 2) {
00982 ic = idp2 - i__;
00983 cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
00984 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
00985 ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
00986 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
00987 cc_dim1];
00988 cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
00989 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
00990 ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
00991 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
00992 cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
00993 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
00994 ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
00995 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
00996 cc_dim1];
00997 tr1 = cr2 + cr4;
00998 tr4 = cr4 - cr2;
00999 ti1 = ci2 + ci4;
01000 ti4 = ci2 - ci4;
01001 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
01002 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
01003 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
01004 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
01005 ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
01006 ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
01007 ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
01008 ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
01009 ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
01010 ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
01011 ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
01012 ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
01013
01014 }
01015
01016 }
01017 if (*ido % 2 == 1) {
01018 return 0;
01019 }
01020 L105:
01021 i__1 = *l1;
01022 for (k = 1; k <= i__1; ++k) {
01023 ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido +
01024 (k + (cc_dim2 << 2)) * cc_dim1]);
01025 tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + (
01026 k + (cc_dim2 << 2)) * cc_dim1]);
01027 ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) *
01028 cc_dim1];
01029 ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) *
01030 cc_dim1] - tr1;
01031 ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) *
01032 cc_dim1];
01033 ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) *
01034 cc_dim1];
01035
01036 }
01037 L107:
01038 return 0;
01039 }
01040
01041 int rfftb_(integer *n, doublereal *r__, doublereal *wsave)
01042 {
01043 extern int rfftb1_(integer *, doublereal *, doublereal *,
01044 doublereal *, doublereal *);
01045
01046
01047
01048
01049 --wsave;
01050 --r__;
01051
01052
01053 if (*n == 1) {
01054 return 0;
01055 }
01056 rfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
01057 return 0;
01058 }
01059
01060 int rfftb1_(integer *n, doublereal *c__, doublereal *ch,
01061 doublereal *wa, integer *ifac)
01062 {
01063
01064 integer i__1;
01065
01066
01067 extern int radb2_(integer *, integer *, doublereal *,
01068 doublereal *, doublereal *), radb3_(integer *, integer *,
01069 doublereal *, doublereal *, doublereal *, doublereal *), radb4_(
01070 integer *, integer *, doublereal *, doublereal *, doublereal *,
01071 doublereal *, doublereal *), radb5_(integer *, integer *,
01072 doublereal *, doublereal *, doublereal *, doublereal *,
01073 doublereal *, doublereal *);
01074 static integer i__;
01075 extern int radbg_(integer *, integer *, integer *,
01076 integer *, doublereal *, doublereal *, doublereal *, doublereal *,
01077 doublereal *, doublereal *);
01078 static integer k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
01079
01080
01081
01082
01083 --ifac;
01084 --wa;
01085 --ch;
01086 --c__;
01087
01088
01089 nf = ifac[2];
01090 na = 0;
01091 l1 = 1;
01092 iw = 1;
01093 i__1 = nf;
01094 for (k1 = 1; k1 <= i__1; ++k1) {
01095 ip = ifac[k1 + 2];
01096 l2 = ip * l1;
01097 ido = *n / l2;
01098 idl1 = ido * l1;
01099 if (ip != 4) {
01100 goto L103;
01101 }
01102 ix2 = iw + ido;
01103 ix3 = ix2 + ido;
01104 if (na != 0) {
01105 goto L101;
01106 }
01107 radb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
01108 goto L102;
01109 L101:
01110 radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
01111 L102:
01112 na = 1 - na;
01113 goto L115;
01114 L103:
01115 if (ip != 2) {
01116 goto L106;
01117 }
01118 if (na != 0) {
01119 goto L104;
01120 }
01121 radb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
01122 goto L105;
01123 L104:
01124 radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
01125 L105:
01126 na = 1 - na;
01127 goto L115;
01128 L106:
01129 if (ip != 3) {
01130 goto L109;
01131 }
01132 ix2 = iw + ido;
01133 if (na != 0) {
01134 goto L107;
01135 }
01136 radb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
01137 goto L108;
01138 L107:
01139 radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
01140 L108:
01141 na = 1 - na;
01142 goto L115;
01143 L109:
01144 if (ip != 5) {
01145 goto L112;
01146 }
01147 ix2 = iw + ido;
01148 ix3 = ix2 + ido;
01149 ix4 = ix3 + ido;
01150 if (na != 0) {
01151 goto L110;
01152 }
01153 radb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
01154 ix4]);
01155 goto L111;
01156 L110:
01157 radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
01158 ix4]);
01159 L111:
01160 na = 1 - na;
01161 goto L115;
01162 L112:
01163 if (na != 0) {
01164 goto L113;
01165 }
01166 radbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
01167 1], &wa[iw]);
01168 goto L114;
01169 L113:
01170 radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
01171 , &wa[iw]);
01172 L114:
01173 if (ido == 1) {
01174 na = 1 - na;
01175 }
01176 L115:
01177 l1 = l2;
01178 iw += (ip - 1) * ido;
01179
01180 }
01181 if (na == 0) {
01182 return 0;
01183 }
01184 i__1 = *n;
01185 for (i__ = 1; i__ <= i__1; ++i__) {
01186 c__[i__] = ch[i__];
01187
01188 }
01189 return 0;
01190 }
01191
01192 int radbg_(integer *ido, integer *ip, integer *l1, integer *
01193 idl1, doublereal *cc, doublereal *c1, doublereal *c2, doublereal *ch,
01194 doublereal *ch2, doublereal *wa)
01195 {
01196
01197
01198 static doublereal tpi = 6.28318530717959;
01199
01200
01201 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
01202 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
01203 i__1, i__2, i__3;
01204
01205
01206 double cos(doublereal), sin(doublereal);
01207
01208
01209 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
01210 static doublereal dc2, ai1, ai2, ar1, ar2, ds2;
01211 static integer nbd;
01212 static doublereal dcp, arg, dsp, ar1h, ar2h;
01213 static integer idp2, ipp2;
01214
01215
01216
01217
01218 ch_dim1 = *ido;
01219 ch_dim2 = *l1;
01220 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
01221 ch -= ch_offset;
01222 c1_dim1 = *ido;
01223 c1_dim2 = *l1;
01224 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
01225 c1 -= c1_offset;
01226 cc_dim1 = *ido;
01227 cc_dim2 = *ip;
01228 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
01229 cc -= cc_offset;
01230 ch2_dim1 = *idl1;
01231 ch2_offset = ch2_dim1 + 1;
01232 ch2 -= ch2_offset;
01233 c2_dim1 = *idl1;
01234 c2_offset = c2_dim1 + 1;
01235 c2 -= c2_offset;
01236 --wa;
01237
01238
01239 arg = tpi / (real) (*ip);
01240 dcp = cos(arg);
01241 dsp = sin(arg);
01242 idp2 = *ido + 2;
01243 nbd = (*ido - 1) / 2;
01244 ipp2 = *ip + 2;
01245 ipph = (*ip + 1) / 2;
01246 if (*ido < *l1) {
01247 goto L103;
01248 }
01249 i__1 = *l1;
01250 for (k = 1; k <= i__1; ++k) {
01251 i__2 = *ido;
01252 for (i__ = 1; i__ <= i__2; ++i__) {
01253 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
01254 cc_dim1];
01255
01256 }
01257
01258 }
01259 goto L106;
01260 L103:
01261 i__1 = *ido;
01262 for (i__ = 1; i__ <= i__1; ++i__) {
01263 i__2 = *l1;
01264 for (k = 1; k <= i__2; ++k) {
01265 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
01266 cc_dim1];
01267
01268 }
01269
01270 }
01271 L106:
01272 i__1 = ipph;
01273 for (j = 2; j <= i__1; ++j) {
01274 jc = ipp2 - j;
01275 j2 = j + j;
01276 i__2 = *l1;
01277 for (k = 1; k <= i__2; ++k) {
01278 ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k *
01279 cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) *
01280 cc_dim1];
01281 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
01282 cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
01283
01284 }
01285
01286 }
01287 if (*ido == 1) {
01288 goto L116;
01289 }
01290 if (nbd < *l1) {
01291 goto L112;
01292 }
01293 i__1 = ipph;
01294 for (j = 2; j <= i__1; ++j) {
01295 jc = ipp2 - j;
01296 i__2 = *l1;
01297 for (k = 1; k <= i__2; ++k) {
01298 i__3 = *ido;
01299 for (i__ = 3; i__ <= i__3; i__ += 2) {
01300 ic = idp2 - i__;
01301 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
01302 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
01303 << 1) - 2 + k * cc_dim2) * cc_dim1];
01304 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
01305 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
01306 << 1) - 2 + k * cc_dim2) * cc_dim1];
01307 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
01308 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
01309 k * cc_dim2) * cc_dim1];
01310 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
01311 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
01312 k * cc_dim2) * cc_dim1];
01313
01314 }
01315
01316 }
01317
01318 }
01319 goto L116;
01320 L112:
01321 i__1 = ipph;
01322 for (j = 2; j <= i__1; ++j) {
01323 jc = ipp2 - j;
01324 i__2 = *ido;
01325 for (i__ = 3; i__ <= i__2; i__ += 2) {
01326 ic = idp2 - i__;
01327 i__3 = *l1;
01328 for (k = 1; k <= i__3; ++k) {
01329 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
01330 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
01331 << 1) - 2 + k * cc_dim2) * cc_dim1];
01332 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
01333 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
01334 << 1) - 2 + k * cc_dim2) * cc_dim1];
01335 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
01336 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
01337 k * cc_dim2) * cc_dim1];
01338 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
01339 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
01340 k * cc_dim2) * cc_dim1];
01341
01342 }
01343
01344 }
01345
01346 }
01347 L116:
01348 ar1 = (float)1.;
01349 ai1 = (float)0.;
01350 i__1 = ipph;
01351 for (l = 2; l <= i__1; ++l) {
01352 lc = ipp2 - l;
01353 ar1h = dcp * ar1 - dsp * ai1;
01354 ai1 = dcp * ai1 + dsp * ar1;
01355 ar1 = ar1h;
01356 i__2 = *idl1;
01357 for (ik = 1; ik <= i__2; ++ik) {
01358 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
01359 ch2_dim1 << 1)];
01360 c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1];
01361
01362 }
01363 dc2 = ar1;
01364 ds2 = ai1;
01365 ar2 = ar1;
01366 ai2 = ai1;
01367 i__2 = ipph;
01368 for (j = 3; j <= i__2; ++j) {
01369 jc = ipp2 - j;
01370 ar2h = dc2 * ar2 - ds2 * ai2;
01371 ai2 = dc2 * ai2 + ds2 * ar2;
01372 ar2 = ar2h;
01373 i__3 = *idl1;
01374 for (ik = 1; ik <= i__3; ++ik) {
01375 c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
01376 c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
01377
01378 }
01379
01380 }
01381
01382 }
01383 i__1 = ipph;
01384 for (j = 2; j <= i__1; ++j) {
01385 i__2 = *idl1;
01386 for (ik = 1; ik <= i__2; ++ik) {
01387 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
01388
01389 }
01390
01391 }
01392 i__1 = ipph;
01393 for (j = 2; j <= i__1; ++j) {
01394 jc = ipp2 - j;
01395 i__2 = *l1;
01396 for (k = 1; k <= i__2; ++k) {
01397 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
01398 c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
01399 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
01400 c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
01401
01402 }
01403
01404 }
01405 if (*ido == 1) {
01406 goto L132;
01407 }
01408 if (nbd < *l1) {
01409 goto L128;
01410 }
01411 i__1 = ipph;
01412 for (j = 2; j <= i__1; ++j) {
01413 jc = ipp2 - j;
01414 i__2 = *l1;
01415 for (k = 1; k <= i__2; ++k) {
01416 i__3 = *ido;
01417 for (i__ = 3; i__ <= i__3; i__ += 2) {
01418 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
01419 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
01420 * c1_dim1];
01421 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
01422 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
01423 c1_dim2) * c1_dim1];
01424 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
01425 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
01426 * c1_dim1];
01427 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
01428 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
01429 * c1_dim1];
01430
01431 }
01432
01433 }
01434
01435 }
01436 goto L132;
01437 L128:
01438 i__1 = ipph;
01439 for (j = 2; j <= i__1; ++j) {
01440 jc = ipp2 - j;
01441 i__2 = *ido;
01442 for (i__ = 3; i__ <= i__2; i__ += 2) {
01443 i__3 = *l1;
01444 for (k = 1; k <= i__3; ++k) {
01445 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
01446 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
01447 * c1_dim1];
01448 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
01449 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
01450 c1_dim2) * c1_dim1];
01451 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
01452 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
01453 * c1_dim1];
01454 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
01455 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
01456 * c1_dim1];
01457
01458 }
01459
01460 }
01461
01462 }
01463 L132:
01464 if (*ido == 1) {
01465 return 0;
01466 }
01467 i__1 = *idl1;
01468 for (ik = 1; ik <= i__1; ++ik) {
01469 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
01470
01471 }
01472 i__1 = *ip;
01473 for (j = 2; j <= i__1; ++j) {
01474 i__2 = *l1;
01475 for (k = 1; k <= i__2; ++k) {
01476 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
01477 ch_dim1 + 1];
01478
01479 }
01480
01481 }
01482 if (nbd > *l1) {
01483 goto L139;
01484 }
01485 is = -(*ido);
01486 i__1 = *ip;
01487 for (j = 2; j <= i__1; ++j) {
01488 is += *ido;
01489 idij = is;
01490 i__2 = *ido;
01491 for (i__ = 3; i__ <= i__2; i__ += 2) {
01492 idij += 2;
01493 i__3 = *l1;
01494 for (k = 1; k <= i__3; ++k) {
01495 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
01496 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
01497 ch[i__ + (k + j * ch_dim2) * ch_dim1];
01498 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
01499 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
01500 1 + (k + j * ch_dim2) * ch_dim1];
01501
01502 }
01503
01504 }
01505
01506 }
01507 goto L143;
01508 L139:
01509 is = -(*ido);
01510 i__1 = *ip;
01511 for (j = 2; j <= i__1; ++j) {
01512 is += *ido;
01513 i__2 = *l1;
01514 for (k = 1; k <= i__2; ++k) {
01515 idij = is;
01516 i__3 = *ido;
01517 for (i__ = 3; i__ <= i__3; i__ += 2) {
01518 idij += 2;
01519 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
01520 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
01521 ch[i__ + (k + j * ch_dim2) * ch_dim1];
01522 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
01523 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
01524 1 + (k + j * ch_dim2) * ch_dim1];
01525
01526 }
01527
01528 }
01529
01530 }
01531 L143:
01532 return 0;
01533 }
01534
01535 int radb5_(integer *ido, integer *l1, doublereal *cc,
01536 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3,
01537 doublereal *wa4)
01538 {
01539
01540
01541 static doublereal tr11 = .309016994374947;
01542 static doublereal ti11 = .951056516295154;
01543 static doublereal tr12 = -.809016994374947;
01544 static doublereal ti12 = .587785252292473;
01545
01546
01547 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
01548
01549
01550 static integer i__, k, ic;
01551 static doublereal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5,
01552 cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
01553 static integer idp2;
01554
01555
01556
01557
01558 ch_dim1 = *ido;
01559 ch_dim2 = *l1;
01560 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
01561 ch -= ch_offset;
01562 cc_dim1 = *ido;
01563 cc_offset = cc_dim1 * 6 + 1;
01564 cc -= cc_offset;
01565 --wa1;
01566 --wa2;
01567 --wa3;
01568 --wa4;
01569
01570
01571 i__1 = *l1;
01572 for (k = 1; k <= i__1; ++k) {
01573 ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
01574 ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
01575 tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) *
01576 cc_dim1];
01577 tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) *
01578 cc_dim1];
01579 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
01580 + tr3;
01581 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
01582 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
01583 ci5 = ti11 * ti5 + ti12 * ti4;
01584 ci4 = ti12 * ti5 - ti11 * ti4;
01585 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
01586 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
01587 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
01588 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
01589
01590 }
01591 if (*ido == 1) {
01592 return 0;
01593 }
01594 idp2 = *ido + 2;
01595 i__1 = *l1;
01596 for (k = 1; k <= i__1; ++k) {
01597 i__2 = *ido;
01598 for (i__ = 3; i__ <= i__2; i__ += 2) {
01599 ic = idp2 - i__;
01600 ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) *
01601 cc_dim1];
01602 ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) *
01603 cc_dim1];
01604 ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) *
01605 cc_dim1];
01606 ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) *
01607 cc_dim1];
01608 tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 +
01609 2) * cc_dim1];
01610 tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 +
01611 2) * cc_dim1];
01612 tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 +
01613 4) * cc_dim1];
01614 tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 +
01615 4) * cc_dim1];
01616 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
01617 cc_dim1] + tr2 + tr3;
01618 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
01619 cc_dim1] + ti2 + ti3;
01620 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
01621 tr3;
01622 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
01623 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
01624 tr3;
01625 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
01626 cr5 = ti11 * tr5 + ti12 * tr4;
01627 ci5 = ti11 * ti5 + ti12 * ti4;
01628 cr4 = ti12 * tr5 - ti11 * tr4;
01629 ci4 = ti12 * ti5 - ti11 * ti4;
01630 dr3 = cr3 - ci4;
01631 dr4 = cr3 + ci4;
01632 di3 = ci3 + cr4;
01633 di4 = ci3 - cr4;
01634 dr5 = cr2 + ci5;
01635 dr2 = cr2 - ci5;
01636 di5 = ci2 - cr5;
01637 di2 = ci2 + cr5;
01638 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
01639 - wa1[i__ - 1] * di2;
01640 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
01641 wa1[i__ - 1] * dr2;
01642 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
01643 wa2[i__ - 1] * di3;
01644 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
01645 i__ - 1] * dr3;
01646 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4
01647 - wa3[i__ - 1] * di4;
01648 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 +
01649 wa3[i__ - 1] * dr4;
01650 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 -
01651 wa4[i__ - 1] * di5;
01652 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
01653 i__ - 1] * dr5;
01654
01655 }
01656
01657 }
01658 return 0;
01659 }
01660
01661 int radb3_(integer *ido, integer *l1, doublereal *cc,
01662 doublereal *ch, doublereal *wa1, doublereal *wa2)
01663 {
01664
01665
01666 static doublereal taur = -.5;
01667 static doublereal taui = .866025403784439;
01668
01669
01670 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
01671
01672
01673 static integer i__, k, ic;
01674 static doublereal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
01675 static integer idp2;
01676
01677
01678
01679
01680 ch_dim1 = *ido;
01681 ch_dim2 = *l1;
01682 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
01683 ch -= ch_offset;
01684 cc_dim1 = *ido;
01685 cc_offset = (cc_dim1 << 2) + 1;
01686 cc -= cc_offset;
01687 --wa1;
01688 --wa2;
01689
01690
01691 i__1 = *l1;
01692 for (k = 1; k <= i__1; ++k) {
01693 tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) *
01694 cc_dim1];
01695 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
01696 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
01697 ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) *
01698 cc_dim1 + 1]);
01699 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
01700 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
01701
01702 }
01703 if (*ido == 1) {
01704 return 0;
01705 }
01706 idp2 = *ido + 2;
01707 i__1 = *l1;
01708 for (k = 1; k <= i__1; ++k) {
01709 i__2 = *ido;
01710 for (i__ = 3; i__ <= i__2; i__ += 2) {
01711 ic = idp2 - i__;
01712 tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 +
01713 2) * cc_dim1];
01714 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
01715 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
01716 cc_dim1] + tr2;
01717 ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) *
01718 cc_dim1];
01719 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
01720 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
01721 cc_dim1] + ti2;
01722 cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
01723 k * 3 + 2) * cc_dim1]);
01724 ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 +
01725 2) * cc_dim1]);
01726 dr2 = cr2 - ci3;
01727 dr3 = cr2 + ci3;
01728 di2 = ci2 + cr3;
01729 di3 = ci2 - cr3;
01730 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
01731 - wa1[i__ - 1] * di2;
01732 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
01733 wa1[i__ - 1] * dr2;
01734 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
01735 wa2[i__ - 1] * di3;
01736 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
01737 i__ - 1] * dr3;
01738
01739 }
01740
01741 }
01742 return 0;
01743 }
01744
01745 int radb2_(integer *ido, integer *l1, doublereal *cc,
01746 doublereal *ch, doublereal *wa1)
01747 {
01748
01749 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
01750
01751
01752 static integer i__, k, ic;
01753 static doublereal ti2, tr2;
01754 static integer idp2;
01755
01756
01757
01758
01759 ch_dim1 = *ido;
01760 ch_dim2 = *l1;
01761 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
01762 ch -= ch_offset;
01763 cc_dim1 = *ido;
01764 cc_offset = cc_dim1 * 3 + 1;
01765 cc -= cc_offset;
01766 --wa1;
01767
01768
01769 i__1 = *l1;
01770 for (k = 1; k <= i__1; ++k) {
01771 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
01772 cc[*ido + ((k << 1) + 2) * cc_dim1];
01773 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
01774 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1];
01775
01776 }
01777 if ((i__1 = *ido - 2) < 0) {
01778 goto L107;
01779 } else if (i__1 == 0) {
01780 goto L105;
01781 } else {
01782 goto L102;
01783 }
01784 L102:
01785 idp2 = *ido + 2;
01786 i__1 = *l1;
01787 for (k = 1; k <= i__1; ++k) {
01788 i__2 = *ido;
01789 for (i__ = 3; i__ <= i__2; i__ += 2) {
01790 ic = idp2 - i__;
01791 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
01792 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
01793 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
01794 1) + 2) * cc_dim1];
01795 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
01796 cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
01797 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2)
01798 * cc_dim1];
01799 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2
01800 - wa1[i__ - 1] * ti2;
01801 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 +
01802 wa1[i__ - 1] * tr2;
01803
01804 }
01805
01806 }
01807 if (*ido % 2 == 1) {
01808 return 0;
01809 }
01810 L105:
01811 i__1 = *l1;
01812 for (k = 1; k <= i__1; ++k) {
01813 ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) *
01814 cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1];
01815 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) *
01816 cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
01817
01818 }
01819 L107:
01820 return 0;
01821 }
01822
01823 int radb4_(integer *ido, integer *l1, doublereal *cc,
01824 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3)
01825 {
01826
01827
01828 static doublereal sqrt2 = 1.414213562373095;
01829
01830
01831 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
01832
01833
01834 static integer i__, k, ic;
01835 static doublereal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1,
01836 tr2, tr3, tr4;
01837 static integer idp2;
01838
01839
01840
01841
01842 ch_dim1 = *ido;
01843 ch_dim2 = *l1;
01844 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
01845 ch -= ch_offset;
01846 cc_dim1 = *ido;
01847 cc_offset = cc_dim1 * 5 + 1;
01848 cc -= cc_offset;
01849 --wa1;
01850 --wa2;
01851 --wa3;
01852
01853
01854 i__1 = *l1;
01855 for (k = 1; k <= i__1; ++k) {
01856 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) *
01857 cc_dim1];
01858 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) *
01859 cc_dim1];
01860 tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) *
01861 cc_dim1];
01862 tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
01863 + 1];
01864 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
01865 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
01866 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
01867 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
01868
01869 }
01870 if ((i__1 = *ido - 2) < 0) {
01871 goto L107;
01872 } else if (i__1 == 0) {
01873 goto L105;
01874 } else {
01875 goto L102;
01876 }
01877 L102:
01878 idp2 = *ido + 2;
01879 i__1 = *l1;
01880 for (k = 1; k <= i__1; ++k) {
01881 i__2 = *ido;
01882 for (i__ = 3; i__ <= i__2; i__ += 2) {
01883 ic = idp2 - i__;
01884 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4)
01885 * cc_dim1];
01886 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4)
01887 * cc_dim1];
01888 ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2)
01889 * cc_dim1];
01890 tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2)
01891 * cc_dim1];
01892 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
01893 2) + 4) * cc_dim1];
01894 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k <<
01895 2) + 4) * cc_dim1];
01896 ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k <<
01897 2) + 2) * cc_dim1];
01898 tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k <<
01899 2) + 2) * cc_dim1];
01900 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
01901 cr3 = tr2 - tr3;
01902 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
01903 ci3 = ti2 - ti3;
01904 cr2 = tr1 - tr4;
01905 cr4 = tr1 + tr4;
01906 ci2 = ti1 + ti4;
01907 ci4 = ti1 - ti4;
01908 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2
01909 - wa1[i__ - 1] * ci2;
01910 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 +
01911 wa1[i__ - 1] * cr2;
01912 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 -
01913 wa2[i__ - 1] * ci3;
01914 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
01915 i__ - 1] * cr3;
01916 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4
01917 - wa3[i__ - 1] * ci4;
01918 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 +
01919 wa3[i__ - 1] * cr4;
01920
01921 }
01922
01923 }
01924 if (*ido % 2 == 1) {
01925 return 0;
01926 }
01927 L105:
01928 i__1 = *l1;
01929 for (k = 1; k <= i__1; ++k) {
01930 ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
01931 + 1];
01932 ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
01933 + 1];
01934 tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) *
01935 cc_dim1];
01936 tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) *
01937 cc_dim1];
01938 ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2;
01939 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1);
01940 ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2;
01941 ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1);
01942
01943 }
01944 L107:
01945 return 0;
01946 }
01947
01948 int cffti_(integer *n, doublereal *wsave)
01949 {
01950 extern int cffti1_(integer *, doublereal *, doublereal *)
01951 ;
01952 static integer iw1, iw2;
01953
01954
01955
01956
01957 --wsave;
01958
01959
01960 if (*n == 1) {
01961 return 0;
01962 }
01963 iw1 = *n + *n + 1;
01964 iw2 = iw1 + *n + *n;
01965 cffti1_(n, &wsave[iw1], &wsave[iw2]);
01966 return 0;
01967 }
01968
01969 int cffti1_(integer *n, doublereal *wa, integer *ifac)
01970 {
01971
01972
01973 static integer ntryh[4] = { 3,4,2,5 };
01974
01975
01976 integer i__1, i__2, i__3;
01977
01978
01979 double cos(doublereal), sin(doublereal);
01980
01981
01982 static doublereal argh;
01983 static integer idot, ntry, i__, j;
01984 static doublereal argld;
01985 static integer i1, k1, l1, l2, ib;
01986 static doublereal fi;
01987 static integer ld, ii, nf, ip, nl, nq, nr;
01988 static doublereal arg;
01989 static integer ido, ipm;
01990 static doublereal tpi;
01991
01992
01993
01994
01995 --ifac;
01996 --wa;
01997
01998
01999 nl = *n;
02000 nf = 0;
02001 j = 0;
02002 L101:
02003 ++j;
02004 if (j - 4 <= 0) {
02005 goto L102;
02006 } else {
02007 goto L103;
02008 }
02009 L102:
02010 ntry = ntryh[j - 1];
02011 goto L104;
02012 L103:
02013 ntry += 2;
02014 L104:
02015 nq = nl / ntry;
02016 nr = nl - ntry * nq;
02017 if (nr != 0) {
02018 goto L101;
02019 } else {
02020 goto L105;
02021 }
02022 L105:
02023 ++nf;
02024 ifac[nf + 2] = ntry;
02025 nl = nq;
02026 if (ntry != 2) {
02027 goto L107;
02028 }
02029 if (nf == 1) {
02030 goto L107;
02031 }
02032 i__1 = nf;
02033 for (i__ = 2; i__ <= i__1; ++i__) {
02034 ib = nf - i__ + 2;
02035 ifac[ib + 2] = ifac[ib + 1];
02036
02037 }
02038 ifac[3] = 2;
02039 L107:
02040 if (nl != 1) {
02041 goto L104;
02042 }
02043 ifac[1] = *n;
02044 ifac[2] = nf;
02045 tpi = (float)6.28318530717959;
02046 argh = tpi / (real) (*n);
02047 i__ = 2;
02048 l1 = 1;
02049 i__1 = nf;
02050 for (k1 = 1; k1 <= i__1; ++k1) {
02051 ip = ifac[k1 + 2];
02052 ld = 0;
02053 l2 = l1 * ip;
02054 ido = *n / l2;
02055 idot = ido + ido + 2;
02056 ipm = ip - 1;
02057 i__2 = ipm;
02058 for (j = 1; j <= i__2; ++j) {
02059 i1 = i__;
02060 wa[i__ - 1] = (float)1.;
02061 wa[i__] = (float)0.;
02062 ld += l1;
02063 fi = (float)0.;
02064 argld = (real) ld * argh;
02065 i__3 = idot;
02066 for (ii = 4; ii <= i__3; ii += 2) {
02067 i__ += 2;
02068 fi += (float)1.;
02069 arg = fi * argld;
02070 wa[i__ - 1] = cos(arg);
02071 wa[i__] = sin(arg);
02072
02073 }
02074 if (ip <= 5) {
02075 goto L109;
02076 }
02077 wa[i1 - 1] = wa[i__ - 1];
02078 wa[i1] = wa[i__];
02079 L109:
02080 ;
02081 }
02082 l1 = l2;
02083
02084 }
02085 return 0;
02086 }
02087
02088 int cfftf_(integer *n, doublereal *c__, doublereal *wsave)
02089 {
02090 extern int cfftf1_(integer *, doublereal *, doublereal *,
02091 doublereal *, doublereal *);
02092 static integer iw1, iw2;
02093
02094
02095
02096
02097 --wsave;
02098 --c__;
02099
02100
02101 if (*n == 1) {
02102 return 0;
02103 }
02104 iw1 = *n + *n + 1;
02105 iw2 = iw1 + *n + *n;
02106 cfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
02107 return 0;
02108 }
02109
02110 int cfftf1_(integer *n, doublereal *c__, doublereal *ch,
02111 doublereal *wa, integer *ifac)
02112 {
02113
02114 integer i__1;
02115
02116
02117 static integer idot, i__;
02118 extern int passf_(integer *, integer *, integer *,
02119 integer *, integer *, doublereal *, doublereal *, doublereal *,
02120 doublereal *, doublereal *, doublereal *);
02121 static integer k1, l1, l2, n2;
02122 extern int passf2_(integer *, integer *, doublereal *,
02123 doublereal *, doublereal *), passf3_(integer *, integer *,
02124 doublereal *, doublereal *, doublereal *, doublereal *), passf4_(
02125 integer *, integer *, doublereal *, doublereal *, doublereal *,
02126 doublereal *, doublereal *), passf5_(integer *, integer *,
02127 doublereal *, doublereal *, doublereal *, doublereal *,
02128 doublereal *, doublereal *);
02129 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
02130
02131
02132
02133
02134 --ifac;
02135 --wa;
02136 --ch;
02137 --c__;
02138
02139
02140 nf = ifac[2];
02141 na = 0;
02142 l1 = 1;
02143 iw = 1;
02144 i__1 = nf;
02145 for (k1 = 1; k1 <= i__1; ++k1) {
02146 ip = ifac[k1 + 2];
02147 l2 = ip * l1;
02148 ido = *n / l2;
02149 idot = ido + ido;
02150 idl1 = idot * l1;
02151 if (ip != 4) {
02152 goto L103;
02153 }
02154 ix2 = iw + idot;
02155 ix3 = ix2 + idot;
02156 if (na != 0) {
02157 goto L101;
02158 }
02159 passf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
02160 goto L102;
02161 L101:
02162 passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
02163 L102:
02164 na = 1 - na;
02165 goto L115;
02166 L103:
02167 if (ip != 2) {
02168 goto L106;
02169 }
02170 if (na != 0) {
02171 goto L104;
02172 }
02173 passf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
02174 goto L105;
02175 L104:
02176 passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
02177 L105:
02178 na = 1 - na;
02179 goto L115;
02180 L106:
02181 if (ip != 3) {
02182 goto L109;
02183 }
02184 ix2 = iw + idot;
02185 if (na != 0) {
02186 goto L107;
02187 }
02188 passf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
02189 goto L108;
02190 L107:
02191 passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
02192 L108:
02193 na = 1 - na;
02194 goto L115;
02195 L109:
02196 if (ip != 5) {
02197 goto L112;
02198 }
02199 ix2 = iw + idot;
02200 ix3 = ix2 + idot;
02201 ix4 = ix3 + idot;
02202 if (na != 0) {
02203 goto L110;
02204 }
02205 passf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
02206 ix4]);
02207 goto L111;
02208 L110:
02209 passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
02210 ix4]);
02211 L111:
02212 na = 1 - na;
02213 goto L115;
02214 L112:
02215 if (na != 0) {
02216 goto L113;
02217 }
02218 passf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
02219 , &ch[1], &wa[iw]);
02220 goto L114;
02221 L113:
02222 passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
02223 &c__[1], &wa[iw]);
02224 L114:
02225 if (nac != 0) {
02226 na = 1 - na;
02227 }
02228 L115:
02229 l1 = l2;
02230 iw += (ip - 1) * idot;
02231
02232 }
02233 if (na == 0) {
02234 return 0;
02235 }
02236 n2 = *n + *n;
02237 i__1 = n2;
02238 for (i__ = 1; i__ <= i__1; ++i__) {
02239 c__[i__] = ch[i__];
02240
02241 }
02242 return 0;
02243 }
02244
02245 int passf_(integer *nac, integer *ido, integer *ip, integer *
02246 l1, integer *idl1, doublereal *cc, doublereal *c1, doublereal *c2,
02247 doublereal *ch, doublereal *ch2, doublereal *wa)
02248 {
02249
02250 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
02251 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
02252 i__1, i__2, i__3;
02253
02254
02255 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
02256 idl, inc, idp;
02257 static doublereal wai, war;
02258 static integer ipp2;
02259
02260
02261
02262
02263 ch_dim1 = *ido;
02264 ch_dim2 = *l1;
02265 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
02266 ch -= ch_offset;
02267 c1_dim1 = *ido;
02268 c1_dim2 = *l1;
02269 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
02270 c1 -= c1_offset;
02271 cc_dim1 = *ido;
02272 cc_dim2 = *ip;
02273 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
02274 cc -= cc_offset;
02275 ch2_dim1 = *idl1;
02276 ch2_offset = ch2_dim1 + 1;
02277 ch2 -= ch2_offset;
02278 c2_dim1 = *idl1;
02279 c2_offset = c2_dim1 + 1;
02280 c2 -= c2_offset;
02281 --wa;
02282
02283
02284 idot = *ido / 2;
02285 nt = *ip * *idl1;
02286 ipp2 = *ip + 2;
02287 ipph = (*ip + 1) / 2;
02288 idp = *ip * *ido;
02289
02290 if (*ido < *l1) {
02291 goto L106;
02292 }
02293 i__1 = ipph;
02294 for (j = 2; j <= i__1; ++j) {
02295 jc = ipp2 - j;
02296 i__2 = *l1;
02297 for (k = 1; k <= i__2; ++k) {
02298 i__3 = *ido;
02299 for (i__ = 1; i__ <= i__3; ++i__) {
02300 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
02301 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
02302 cc_dim1];
02303 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
02304 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
02305 cc_dim1];
02306
02307 }
02308
02309 }
02310
02311 }
02312 i__1 = *l1;
02313 for (k = 1; k <= i__1; ++k) {
02314 i__2 = *ido;
02315 for (i__ = 1; i__ <= i__2; ++i__) {
02316 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
02317 cc_dim1];
02318
02319 }
02320
02321 }
02322 goto L112;
02323 L106:
02324 i__1 = ipph;
02325 for (j = 2; j <= i__1; ++j) {
02326 jc = ipp2 - j;
02327 i__2 = *ido;
02328 for (i__ = 1; i__ <= i__2; ++i__) {
02329 i__3 = *l1;
02330 for (k = 1; k <= i__3; ++k) {
02331 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
02332 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
02333 cc_dim1];
02334 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
02335 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
02336 cc_dim1];
02337
02338 }
02339
02340 }
02341
02342 }
02343 i__1 = *ido;
02344 for (i__ = 1; i__ <= i__1; ++i__) {
02345 i__2 = *l1;
02346 for (k = 1; k <= i__2; ++k) {
02347 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
02348 cc_dim1];
02349
02350 }
02351
02352 }
02353 L112:
02354 idl = 2 - *ido;
02355 inc = 0;
02356 i__1 = ipph;
02357 for (l = 2; l <= i__1; ++l) {
02358 lc = ipp2 - l;
02359 idl += *ido;
02360 i__2 = *idl1;
02361 for (ik = 1; ik <= i__2; ++ik) {
02362 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
02363 + (ch2_dim1 << 1)];
02364 c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1];
02365
02366 }
02367 idlj = idl;
02368 inc += *ido;
02369 i__2 = ipph;
02370 for (j = 3; j <= i__2; ++j) {
02371 jc = ipp2 - j;
02372 idlj += inc;
02373 if (idlj > idp) {
02374 idlj -= idp;
02375 }
02376 war = wa[idlj - 1];
02377 wai = wa[idlj];
02378 i__3 = *idl1;
02379 for (ik = 1; ik <= i__3; ++ik) {
02380 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
02381 c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
02382
02383 }
02384
02385 }
02386
02387 }
02388 i__1 = ipph;
02389 for (j = 2; j <= i__1; ++j) {
02390 i__2 = *idl1;
02391 for (ik = 1; ik <= i__2; ++ik) {
02392 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
02393
02394 }
02395
02396 }
02397 i__1 = ipph;
02398 for (j = 2; j <= i__1; ++j) {
02399 jc = ipp2 - j;
02400 i__2 = *idl1;
02401 for (ik = 2; ik <= i__2; ik += 2) {
02402 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
02403 jc * c2_dim1];
02404 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
02405 jc * c2_dim1];
02406 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
02407 c2_dim1];
02408 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
02409 c2_dim1];
02410
02411 }
02412
02413 }
02414 *nac = 1;
02415 if (*ido == 2) {
02416 return 0;
02417 }
02418 *nac = 0;
02419 i__1 = *idl1;
02420 for (ik = 1; ik <= i__1; ++ik) {
02421 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
02422
02423 }
02424 i__1 = *ip;
02425 for (j = 2; j <= i__1; ++j) {
02426 i__2 = *l1;
02427 for (k = 1; k <= i__2; ++k) {
02428 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
02429 ch_dim1 + 1];
02430 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
02431 ch_dim1 + 2];
02432
02433 }
02434
02435 }
02436 if (idot > *l1) {
02437 goto L127;
02438 }
02439 idij = 0;
02440 i__1 = *ip;
02441 for (j = 2; j <= i__1; ++j) {
02442 idij += 2;
02443 i__2 = *ido;
02444 for (i__ = 4; i__ <= i__2; i__ += 2) {
02445 idij += 2;
02446 i__3 = *l1;
02447 for (k = 1; k <= i__3; ++k) {
02448 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
02449 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
02450 ch[i__ + (k + j * ch_dim2) * ch_dim1];
02451 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
02452 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
02453 1 + (k + j * ch_dim2) * ch_dim1];
02454
02455 }
02456
02457 }
02458
02459 }
02460 return 0;
02461 L127:
02462 idj = 2 - *ido;
02463 i__1 = *ip;
02464 for (j = 2; j <= i__1; ++j) {
02465 idj += *ido;
02466 i__2 = *l1;
02467 for (k = 1; k <= i__2; ++k) {
02468 idij = idj;
02469 i__3 = *ido;
02470 for (i__ = 4; i__ <= i__3; i__ += 2) {
02471 idij += 2;
02472 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
02473 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
02474 ch[i__ + (k + j * ch_dim2) * ch_dim1];
02475 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
02476 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
02477 1 + (k + j * ch_dim2) * ch_dim1];
02478
02479 }
02480
02481 }
02482
02483 }
02484 return 0;
02485 }
02486
02487 int passf5_(integer *ido, integer *l1, doublereal *cc,
02488 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3,
02489 doublereal *wa4)
02490 {
02491
02492
02493 static doublereal tr11 = .309016994374947;
02494 static doublereal ti11 = -.951056516295154;
02495 static doublereal tr12 = -.809016994374947;
02496 static doublereal ti12 = -.587785252292473;
02497
02498
02499 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
02500
02501
02502 static integer i__, k;
02503 static doublereal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5,
02504 cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
02505
02506
02507
02508
02509 ch_dim1 = *ido;
02510 ch_dim2 = *l1;
02511 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
02512 ch -= ch_offset;
02513 cc_dim1 = *ido;
02514 cc_offset = cc_dim1 * 6 + 1;
02515 cc -= cc_offset;
02516 --wa1;
02517 --wa2;
02518 --wa3;
02519 --wa4;
02520
02521
02522 if (*ido != 2) {
02523 goto L102;
02524 }
02525 i__1 = *l1;
02526 for (k = 1; k <= i__1; ++k) {
02527 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
02528 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
02529 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
02530 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
02531 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
02532 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
02533 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
02534 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
02535 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
02536 + tr3;
02537 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
02538 + ti3;
02539 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
02540 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
02541 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
02542 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
02543 cr5 = ti11 * tr5 + ti12 * tr4;
02544 ci5 = ti11 * ti5 + ti12 * ti4;
02545 cr4 = ti12 * tr5 - ti11 * tr4;
02546 ci4 = ti12 * ti5 - ti11 * ti4;
02547 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
02548 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
02549 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
02550 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
02551 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
02552 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
02553 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
02554 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
02555
02556 }
02557 return 0;
02558 L102:
02559 i__1 = *l1;
02560 for (k = 1; k <= i__1; ++k) {
02561 i__2 = *ido;
02562 for (i__ = 2; i__ <= i__2; i__ += 2) {
02563 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
02564 cc_dim1];
02565 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
02566 cc_dim1];
02567 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
02568 cc_dim1];
02569 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
02570 cc_dim1];
02571 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
02572 5) * cc_dim1];
02573 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
02574 5) * cc_dim1];
02575 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
02576 4) * cc_dim1];
02577 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
02578 4) * cc_dim1];
02579 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
02580 cc_dim1] + tr2 + tr3;
02581 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
02582 cc_dim1] + ti2 + ti3;
02583 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
02584 tr3;
02585 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
02586 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
02587 tr3;
02588 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
02589 cr5 = ti11 * tr5 + ti12 * tr4;
02590 ci5 = ti11 * ti5 + ti12 * ti4;
02591 cr4 = ti12 * tr5 - ti11 * tr4;
02592 ci4 = ti12 * ti5 - ti11 * ti4;
02593 dr3 = cr3 - ci4;
02594 dr4 = cr3 + ci4;
02595 di3 = ci3 + cr4;
02596 di4 = ci3 - cr4;
02597 dr5 = cr2 + ci5;
02598 dr2 = cr2 - ci5;
02599 di5 = ci2 - cr5;
02600 di2 = ci2 + cr5;
02601 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
02602 + wa1[i__] * di2;
02603 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
02604 wa1[i__] * dr2;
02605 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
02606 wa2[i__] * di3;
02607 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
02608 i__] * dr3;
02609 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
02610 + wa3[i__] * di4;
02611 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 -
02612 wa3[i__] * dr4;
02613 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 +
02614 wa4[i__] * di5;
02615 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
02616 i__] * dr5;
02617
02618 }
02619
02620 }
02621 return 0;
02622 }
02623
02624 int passf3_(integer *ido, integer *l1, doublereal *cc,
02625 doublereal *ch, doublereal *wa1, doublereal *wa2)
02626 {
02627
02628
02629 static doublereal taur = -.5;
02630 static doublereal taui = -.866025403784439;
02631
02632
02633 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
02634
02635
02636 static integer i__, k;
02637 static doublereal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
02638
02639
02640
02641
02642 ch_dim1 = *ido;
02643 ch_dim2 = *l1;
02644 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
02645 ch -= ch_offset;
02646 cc_dim1 = *ido;
02647 cc_offset = (cc_dim1 << 2) + 1;
02648 cc -= cc_offset;
02649 --wa1;
02650 --wa2;
02651
02652
02653 if (*ido != 2) {
02654 goto L102;
02655 }
02656 i__1 = *l1;
02657 for (k = 1; k <= i__1; ++k) {
02658 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
02659 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
02660 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
02661 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
02662 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
02663 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
02664 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
02665 cc_dim1 + 1]);
02666 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
02667 cc_dim1 + 2]);
02668 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
02669 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
02670 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
02671 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
02672
02673 }
02674 return 0;
02675 L102:
02676 i__1 = *l1;
02677 for (k = 1; k <= i__1; ++k) {
02678 i__2 = *ido;
02679 for (i__ = 2; i__ <= i__2; i__ += 2) {
02680 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
02681 3) * cc_dim1];
02682 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
02683 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
02684 cc_dim1] + tr2;
02685 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
02686 cc_dim1];
02687 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
02688 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
02689 cc_dim1] + ti2;
02690 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
02691 k * 3 + 3) * cc_dim1]);
02692 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
02693 3) * cc_dim1]);
02694 dr2 = cr2 - ci3;
02695 dr3 = cr2 + ci3;
02696 di2 = ci2 + cr3;
02697 di3 = ci2 - cr3;
02698 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
02699 wa1[i__] * dr2;
02700 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
02701 + wa1[i__] * di2;
02702 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
02703 i__] * dr3;
02704 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
02705 wa2[i__] * di3;
02706
02707 }
02708
02709 }
02710 return 0;
02711 }
02712
02713 int passf2_(integer *ido, integer *l1, doublereal *cc,
02714 doublereal *ch, doublereal *wa1)
02715 {
02716
02717 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
02718
02719
02720 static integer i__, k;
02721 static doublereal ti2, tr2;
02722
02723
02724
02725
02726 ch_dim1 = *ido;
02727 ch_dim2 = *l1;
02728 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
02729 ch -= ch_offset;
02730 cc_dim1 = *ido;
02731 cc_offset = cc_dim1 * 3 + 1;
02732 cc -= cc_offset;
02733 --wa1;
02734
02735
02736 if (*ido > 2) {
02737 goto L102;
02738 }
02739 i__1 = *l1;
02740 for (k = 1; k <= i__1; ++k) {
02741 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
02742 cc[((k << 1) + 2) * cc_dim1 + 1];
02743 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
02744 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
02745 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
02746 cc[((k << 1) + 2) * cc_dim1 + 2];
02747 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
02748 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
02749
02750 }
02751 return 0;
02752 L102:
02753 i__1 = *l1;
02754 for (k = 1; k <= i__1; ++k) {
02755 i__2 = *ido;
02756 for (i__ = 2; i__ <= i__2; i__ += 2) {
02757 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
02758 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
02759 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
02760 1) + 2) * cc_dim1];
02761 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
02762 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
02763 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
02764 * cc_dim1];
02765 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 -
02766 wa1[i__] * tr2;
02767 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
02768 + wa1[i__] * ti2;
02769
02770 }
02771
02772 }
02773 return 0;
02774 }
02775
02776 int passf4_(integer *ido, integer *l1, doublereal *cc,
02777 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3)
02778 {
02779
02780 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
02781
02782
02783 static integer i__, k;
02784 static doublereal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1,
02785 tr2, tr3, tr4;
02786
02787
02788
02789
02790 ch_dim1 = *ido;
02791 ch_dim2 = *l1;
02792 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
02793 ch -= ch_offset;
02794 cc_dim1 = *ido;
02795 cc_offset = cc_dim1 * 5 + 1;
02796 cc -= cc_offset;
02797 --wa1;
02798 --wa2;
02799 --wa3;
02800
02801
02802 if (*ido != 2) {
02803 goto L102;
02804 }
02805 i__1 = *l1;
02806 for (k = 1; k <= i__1; ++k) {
02807 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
02808 + 2];
02809 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
02810 + 2];
02811 tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1
02812 + 2];
02813 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
02814 + 2];
02815 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
02816 + 1];
02817 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
02818 + 1];
02819 ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
02820 + 1];
02821 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
02822 + 1];
02823 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
02824 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
02825 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
02826 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
02827 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
02828 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
02829 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
02830 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
02831
02832 }
02833 return 0;
02834 L102:
02835 i__1 = *l1;
02836 for (k = 1; k <= i__1; ++k) {
02837 i__2 = *ido;
02838 for (i__ = 2; i__ <= i__2; i__ += 2) {
02839 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
02840 * cc_dim1];
02841 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
02842 * cc_dim1];
02843 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
02844 * cc_dim1];
02845 tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
02846 * cc_dim1];
02847 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
02848 2) + 3) * cc_dim1];
02849 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
02850 2) + 3) * cc_dim1];
02851 ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
02852 2) + 2) * cc_dim1];
02853 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
02854 2) + 4) * cc_dim1];
02855 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
02856 cr3 = tr2 - tr3;
02857 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
02858 ci3 = ti2 - ti3;
02859 cr2 = tr1 + tr4;
02860 cr4 = tr1 - tr4;
02861 ci2 = ti1 + ti4;
02862 ci4 = ti1 - ti4;
02863 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
02864 + wa1[i__] * ci2;
02865 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 -
02866 wa1[i__] * cr2;
02867 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 +
02868 wa2[i__] * ci3;
02869 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
02870 i__] * cr3;
02871 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
02872 + wa3[i__] * ci4;
02873 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 -
02874 wa3[i__] * cr4;
02875
02876 }
02877
02878 }
02879 return 0;
02880 }
02881
02882 int cfftb_(integer *n, doublereal *c__, doublereal *wsave)
02883 {
02884 extern int cfftb1_(integer *, doublereal *, doublereal *,
02885 doublereal *, doublereal *);
02886 static integer iw1, iw2;
02887
02888
02889
02890
02891 --wsave;
02892 --c__;
02893
02894
02895 if (*n == 1) {
02896 return 0;
02897 }
02898 iw1 = *n + *n + 1;
02899 iw2 = iw1 + *n + *n;
02900 cfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
02901 return 0;
02902 }
02903
02904 int cfftb1_(integer *n, doublereal *c__, doublereal *ch,
02905 doublereal *wa, integer *ifac)
02906 {
02907
02908 integer i__1;
02909
02910
02911 static integer idot, i__;
02912 extern int passb_(integer *, integer *, integer *,
02913 integer *, integer *, doublereal *, doublereal *, doublereal *,
02914 doublereal *, doublereal *, doublereal *);
02915 static integer k1, l1, l2, n2;
02916 extern int passb2_(integer *, integer *, doublereal *,
02917 doublereal *, doublereal *), passb3_(integer *, integer *,
02918 doublereal *, doublereal *, doublereal *, doublereal *), passb4_(
02919 integer *, integer *, doublereal *, doublereal *, doublereal *,
02920 doublereal *, doublereal *), passb5_(integer *, integer *,
02921 doublereal *, doublereal *, doublereal *, doublereal *,
02922 doublereal *, doublereal *);
02923 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
02924
02925
02926
02927
02928 --ifac;
02929 --wa;
02930 --ch;
02931 --c__;
02932
02933
02934 nf = ifac[2];
02935 na = 0;
02936 l1 = 1;
02937 iw = 1;
02938 i__1 = nf;
02939 for (k1 = 1; k1 <= i__1; ++k1) {
02940 ip = ifac[k1 + 2];
02941 l2 = ip * l1;
02942 ido = *n / l2;
02943 idot = ido + ido;
02944 idl1 = idot * l1;
02945 if (ip != 4) {
02946 goto L103;
02947 }
02948 ix2 = iw + idot;
02949 ix3 = ix2 + idot;
02950 if (na != 0) {
02951 goto L101;
02952 }
02953 passb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
02954 goto L102;
02955 L101:
02956 passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
02957 L102:
02958 na = 1 - na;
02959 goto L115;
02960 L103:
02961 if (ip != 2) {
02962 goto L106;
02963 }
02964 if (na != 0) {
02965 goto L104;
02966 }
02967 passb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
02968 goto L105;
02969 L104:
02970 passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
02971 L105:
02972 na = 1 - na;
02973 goto L115;
02974 L106:
02975 if (ip != 3) {
02976 goto L109;
02977 }
02978 ix2 = iw + idot;
02979 if (na != 0) {
02980 goto L107;
02981 }
02982 passb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
02983 goto L108;
02984 L107:
02985 passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
02986 L108:
02987 na = 1 - na;
02988 goto L115;
02989 L109:
02990 if (ip != 5) {
02991 goto L112;
02992 }
02993 ix2 = iw + idot;
02994 ix3 = ix2 + idot;
02995 ix4 = ix3 + idot;
02996 if (na != 0) {
02997 goto L110;
02998 }
02999 passb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
03000 ix4]);
03001 goto L111;
03002 L110:
03003 passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
03004 ix4]);
03005 L111:
03006 na = 1 - na;
03007 goto L115;
03008 L112:
03009 if (na != 0) {
03010 goto L113;
03011 }
03012 passb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
03013 , &ch[1], &wa[iw]);
03014 goto L114;
03015 L113:
03016 passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
03017 &c__[1], &wa[iw]);
03018 L114:
03019 if (nac != 0) {
03020 na = 1 - na;
03021 }
03022 L115:
03023 l1 = l2;
03024 iw += (ip - 1) * idot;
03025
03026 }
03027 if (na == 0) {
03028 return 0;
03029 }
03030 n2 = *n + *n;
03031 i__1 = n2;
03032 for (i__ = 1; i__ <= i__1; ++i__) {
03033 c__[i__] = ch[i__];
03034
03035 }
03036 return 0;
03037 }
03038
03039 int passb_(integer *nac, integer *ido, integer *ip, integer *
03040 l1, integer *idl1, doublereal *cc, doublereal *c1, doublereal *c2,
03041 doublereal *ch, doublereal *ch2, doublereal *wa)
03042 {
03043
03044 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
03045 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
03046 i__1, i__2, i__3;
03047
03048
03049 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
03050 idl, inc, idp;
03051 static doublereal wai, war;
03052 static integer ipp2;
03053
03054
03055
03056
03057 ch_dim1 = *ido;
03058 ch_dim2 = *l1;
03059 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
03060 ch -= ch_offset;
03061 c1_dim1 = *ido;
03062 c1_dim2 = *l1;
03063 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
03064 c1 -= c1_offset;
03065 cc_dim1 = *ido;
03066 cc_dim2 = *ip;
03067 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
03068 cc -= cc_offset;
03069 ch2_dim1 = *idl1;
03070 ch2_offset = ch2_dim1 + 1;
03071 ch2 -= ch2_offset;
03072 c2_dim1 = *idl1;
03073 c2_offset = c2_dim1 + 1;
03074 c2 -= c2_offset;
03075 --wa;
03076
03077
03078 idot = *ido / 2;
03079 nt = *ip * *idl1;
03080 ipp2 = *ip + 2;
03081 ipph = (*ip + 1) / 2;
03082 idp = *ip * *ido;
03083
03084 if (*ido < *l1) {
03085 goto L106;
03086 }
03087 i__1 = ipph;
03088 for (j = 2; j <= i__1; ++j) {
03089 jc = ipp2 - j;
03090 i__2 = *l1;
03091 for (k = 1; k <= i__2; ++k) {
03092 i__3 = *ido;
03093 for (i__ = 1; i__ <= i__3; ++i__) {
03094 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
03095 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
03096 cc_dim1];
03097 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
03098 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
03099 cc_dim1];
03100
03101 }
03102
03103 }
03104
03105 }
03106 i__1 = *l1;
03107 for (k = 1; k <= i__1; ++k) {
03108 i__2 = *ido;
03109 for (i__ = 1; i__ <= i__2; ++i__) {
03110 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
03111 cc_dim1];
03112
03113 }
03114
03115 }
03116 goto L112;
03117 L106:
03118 i__1 = ipph;
03119 for (j = 2; j <= i__1; ++j) {
03120 jc = ipp2 - j;
03121 i__2 = *ido;
03122 for (i__ = 1; i__ <= i__2; ++i__) {
03123 i__3 = *l1;
03124 for (k = 1; k <= i__3; ++k) {
03125 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
03126 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
03127 cc_dim1];
03128 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
03129 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
03130 cc_dim1];
03131
03132 }
03133
03134 }
03135
03136 }
03137 i__1 = *ido;
03138 for (i__ = 1; i__ <= i__1; ++i__) {
03139 i__2 = *l1;
03140 for (k = 1; k <= i__2; ++k) {
03141 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
03142 cc_dim1];
03143
03144 }
03145
03146 }
03147 L112:
03148 idl = 2 - *ido;
03149 inc = 0;
03150 i__1 = ipph;
03151 for (l = 2; l <= i__1; ++l) {
03152 lc = ipp2 - l;
03153 idl += *ido;
03154 i__2 = *idl1;
03155 for (ik = 1; ik <= i__2; ++ik) {
03156 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
03157 + (ch2_dim1 << 1)];
03158 c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1];
03159
03160 }
03161 idlj = idl;
03162 inc += *ido;
03163 i__2 = ipph;
03164 for (j = 3; j <= i__2; ++j) {
03165 jc = ipp2 - j;
03166 idlj += inc;
03167 if (idlj > idp) {
03168 idlj -= idp;
03169 }
03170 war = wa[idlj - 1];
03171 wai = wa[idlj];
03172 i__3 = *idl1;
03173 for (ik = 1; ik <= i__3; ++ik) {
03174 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
03175 c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
03176
03177 }
03178
03179 }
03180
03181 }
03182 i__1 = ipph;
03183 for (j = 2; j <= i__1; ++j) {
03184 i__2 = *idl1;
03185 for (ik = 1; ik <= i__2; ++ik) {
03186 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
03187
03188 }
03189
03190 }
03191 i__1 = ipph;
03192 for (j = 2; j <= i__1; ++j) {
03193 jc = ipp2 - j;
03194 i__2 = *idl1;
03195 for (ik = 2; ik <= i__2; ik += 2) {
03196 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
03197 jc * c2_dim1];
03198 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
03199 jc * c2_dim1];
03200 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
03201 c2_dim1];
03202 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
03203 c2_dim1];
03204
03205 }
03206
03207 }
03208 *nac = 1;
03209 if (*ido == 2) {
03210 return 0;
03211 }
03212 *nac = 0;
03213 i__1 = *idl1;
03214 for (ik = 1; ik <= i__1; ++ik) {
03215 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
03216
03217 }
03218 i__1 = *ip;
03219 for (j = 2; j <= i__1; ++j) {
03220 i__2 = *l1;
03221 for (k = 1; k <= i__2; ++k) {
03222 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
03223 ch_dim1 + 1];
03224 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
03225 ch_dim1 + 2];
03226
03227 }
03228
03229 }
03230 if (idot > *l1) {
03231 goto L127;
03232 }
03233 idij = 0;
03234 i__1 = *ip;
03235 for (j = 2; j <= i__1; ++j) {
03236 idij += 2;
03237 i__2 = *ido;
03238 for (i__ = 4; i__ <= i__2; i__ += 2) {
03239 idij += 2;
03240 i__3 = *l1;
03241 for (k = 1; k <= i__3; ++k) {
03242 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
03243 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
03244 ch[i__ + (k + j * ch_dim2) * ch_dim1];
03245 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
03246 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
03247 1 + (k + j * ch_dim2) * ch_dim1];
03248
03249 }
03250
03251 }
03252
03253 }
03254 return 0;
03255 L127:
03256 idj = 2 - *ido;
03257 i__1 = *ip;
03258 for (j = 2; j <= i__1; ++j) {
03259 idj += *ido;
03260 i__2 = *l1;
03261 for (k = 1; k <= i__2; ++k) {
03262 idij = idj;
03263 i__3 = *ido;
03264 for (i__ = 4; i__ <= i__3; i__ += 2) {
03265 idij += 2;
03266 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
03267 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
03268 ch[i__ + (k + j * ch_dim2) * ch_dim1];
03269 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
03270 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
03271 1 + (k + j * ch_dim2) * ch_dim1];
03272
03273 }
03274
03275 }
03276
03277 }
03278 return 0;
03279 }
03280
03281 int passb5_(integer *ido, integer *l1, doublereal *cc,
03282 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3,
03283 doublereal *wa4)
03284 {
03285
03286
03287 static doublereal tr11 = .309016994374947;
03288 static doublereal ti11 = .951056516295154;
03289 static doublereal tr12 = -.809016994374947;
03290 static doublereal ti12 = .587785252292473;
03291
03292
03293 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
03294
03295
03296 static integer i__, k;
03297 static doublereal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5,
03298 cr4, ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
03299
03300
03301
03302
03303 ch_dim1 = *ido;
03304 ch_dim2 = *l1;
03305 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
03306 ch -= ch_offset;
03307 cc_dim1 = *ido;
03308 cc_offset = cc_dim1 * 6 + 1;
03309 cc -= cc_offset;
03310 --wa1;
03311 --wa2;
03312 --wa3;
03313 --wa4;
03314
03315
03316 if (*ido != 2) {
03317 goto L102;
03318 }
03319 i__1 = *l1;
03320 for (k = 1; k <= i__1; ++k) {
03321 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
03322 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
03323 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
03324 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
03325 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
03326 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
03327 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
03328 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
03329 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
03330 + tr3;
03331 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
03332 + ti3;
03333 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
03334 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
03335 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
03336 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
03337 cr5 = ti11 * tr5 + ti12 * tr4;
03338 ci5 = ti11 * ti5 + ti12 * ti4;
03339 cr4 = ti12 * tr5 - ti11 * tr4;
03340 ci4 = ti12 * ti5 - ti11 * ti4;
03341 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
03342 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
03343 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
03344 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
03345 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
03346 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
03347 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
03348 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
03349
03350 }
03351 return 0;
03352 L102:
03353 i__1 = *l1;
03354 for (k = 1; k <= i__1; ++k) {
03355 i__2 = *ido;
03356 for (i__ = 2; i__ <= i__2; i__ += 2) {
03357 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
03358 cc_dim1];
03359 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
03360 cc_dim1];
03361 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
03362 cc_dim1];
03363 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
03364 cc_dim1];
03365 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
03366 5) * cc_dim1];
03367 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
03368 5) * cc_dim1];
03369 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
03370 4) * cc_dim1];
03371 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
03372 4) * cc_dim1];
03373 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
03374 cc_dim1] + tr2 + tr3;
03375 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
03376 cc_dim1] + ti2 + ti3;
03377 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
03378 tr3;
03379 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
03380 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
03381 tr3;
03382 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
03383 cr5 = ti11 * tr5 + ti12 * tr4;
03384 ci5 = ti11 * ti5 + ti12 * ti4;
03385 cr4 = ti12 * tr5 - ti11 * tr4;
03386 ci4 = ti12 * ti5 - ti11 * ti4;
03387 dr3 = cr3 - ci4;
03388 dr4 = cr3 + ci4;
03389 di3 = ci3 + cr4;
03390 di4 = ci3 - cr4;
03391 dr5 = cr2 + ci5;
03392 dr2 = cr2 - ci5;
03393 di5 = ci2 - cr5;
03394 di2 = ci2 + cr5;
03395 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
03396 - wa1[i__] * di2;
03397 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
03398 wa1[i__] * dr2;
03399 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
03400 wa2[i__] * di3;
03401 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
03402 i__] * dr3;
03403 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
03404 - wa3[i__] * di4;
03405 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 +
03406 wa3[i__] * dr4;
03407 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 -
03408 wa4[i__] * di5;
03409 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
03410 i__] * dr5;
03411
03412 }
03413
03414 }
03415 return 0;
03416 }
03417
03418 int passb3_(integer *ido, integer *l1, doublereal *cc,
03419 doublereal *ch, doublereal *wa1, doublereal *wa2)
03420 {
03421
03422
03423 static doublereal taur = -.5;
03424 static doublereal taui = .866025403784439;
03425
03426
03427 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
03428
03429
03430 static integer i__, k;
03431 static doublereal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
03432
03433
03434
03435
03436 ch_dim1 = *ido;
03437 ch_dim2 = *l1;
03438 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
03439 ch -= ch_offset;
03440 cc_dim1 = *ido;
03441 cc_offset = (cc_dim1 << 2) + 1;
03442 cc -= cc_offset;
03443 --wa1;
03444 --wa2;
03445
03446
03447 if (*ido != 2) {
03448 goto L102;
03449 }
03450 i__1 = *l1;
03451 for (k = 1; k <= i__1; ++k) {
03452 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
03453 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
03454 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
03455 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
03456 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
03457 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
03458 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
03459 cc_dim1 + 1]);
03460 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
03461 cc_dim1 + 2]);
03462 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
03463 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
03464 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
03465 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
03466
03467 }
03468 return 0;
03469 L102:
03470 i__1 = *l1;
03471 for (k = 1; k <= i__1; ++k) {
03472 i__2 = *ido;
03473 for (i__ = 2; i__ <= i__2; i__ += 2) {
03474 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
03475 3) * cc_dim1];
03476 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
03477 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
03478 cc_dim1] + tr2;
03479 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
03480 cc_dim1];
03481 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
03482 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
03483 cc_dim1] + ti2;
03484 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
03485 k * 3 + 3) * cc_dim1]);
03486 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
03487 3) * cc_dim1]);
03488 dr2 = cr2 - ci3;
03489 dr3 = cr2 + ci3;
03490 di2 = ci2 + cr3;
03491 di3 = ci2 - cr3;
03492 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
03493 wa1[i__] * dr2;
03494 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
03495 - wa1[i__] * di2;
03496 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
03497 i__] * dr3;
03498 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
03499 wa2[i__] * di3;
03500
03501 }
03502
03503 }
03504 return 0;
03505 }
03506
03507 int passb2_(integer *ido, integer *l1, doublereal *cc,
03508 doublereal *ch, doublereal *wa1)
03509 {
03510
03511 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
03512
03513
03514 static integer i__, k;
03515 static doublereal ti2, tr2;
03516
03517
03518
03519
03520 ch_dim1 = *ido;
03521 ch_dim2 = *l1;
03522 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
03523 ch -= ch_offset;
03524 cc_dim1 = *ido;
03525 cc_offset = cc_dim1 * 3 + 1;
03526 cc -= cc_offset;
03527 --wa1;
03528
03529
03530 if (*ido > 2) {
03531 goto L102;
03532 }
03533 i__1 = *l1;
03534 for (k = 1; k <= i__1; ++k) {
03535 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
03536 cc[((k << 1) + 2) * cc_dim1 + 1];
03537 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
03538 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
03539 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
03540 cc[((k << 1) + 2) * cc_dim1 + 2];
03541 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
03542 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
03543
03544 }
03545 return 0;
03546 L102:
03547 i__1 = *l1;
03548 for (k = 1; k <= i__1; ++k) {
03549 i__2 = *ido;
03550 for (i__ = 2; i__ <= i__2; i__ += 2) {
03551 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
03552 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
03553 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
03554 1) + 2) * cc_dim1];
03555 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
03556 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
03557 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
03558 * cc_dim1];
03559 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 +
03560 wa1[i__] * tr2;
03561 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
03562 - wa1[i__] * ti2;
03563
03564 }
03565
03566 }
03567 return 0;
03568 }
03569
03570 int passb4_(integer *ido, integer *l1, doublereal *cc,
03571 doublereal *ch, doublereal *wa1, doublereal *wa2, doublereal *wa3)
03572 {
03573
03574 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
03575
03576
03577 static integer i__, k;
03578 static doublereal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1,
03579 tr2, tr3, tr4;
03580
03581
03582
03583
03584 ch_dim1 = *ido;
03585 ch_dim2 = *l1;
03586 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
03587 ch -= ch_offset;
03588 cc_dim1 = *ido;
03589 cc_offset = cc_dim1 * 5 + 1;
03590 cc -= cc_offset;
03591 --wa1;
03592 --wa2;
03593 --wa3;
03594
03595
03596 if (*ido != 2) {
03597 goto L102;
03598 }
03599 i__1 = *l1;
03600 for (k = 1; k <= i__1; ++k) {
03601 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
03602 + 2];
03603 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
03604 + 2];
03605 tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1
03606 + 2];
03607 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
03608 + 2];
03609 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
03610 + 1];
03611 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
03612 + 1];
03613 ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1
03614 + 1];
03615 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
03616 + 1];
03617 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
03618 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
03619 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
03620 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
03621 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
03622 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
03623 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
03624 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
03625
03626 }
03627 return 0;
03628 L102:
03629 i__1 = *l1;
03630 for (k = 1; k <= i__1; ++k) {
03631 i__2 = *ido;
03632 for (i__ = 2; i__ <= i__2; i__ += 2) {
03633 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
03634 * cc_dim1];
03635 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
03636 * cc_dim1];
03637 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
03638 * cc_dim1];
03639 tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
03640 * cc_dim1];
03641 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
03642 2) + 3) * cc_dim1];
03643 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
03644 2) + 3) * cc_dim1];
03645 ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
03646 2) + 4) * cc_dim1];
03647 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
03648 2) + 4) * cc_dim1];
03649 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
03650 cr3 = tr2 - tr3;
03651 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
03652 ci3 = ti2 - ti3;
03653 cr2 = tr1 + tr4;
03654 cr4 = tr1 - tr4;
03655 ci2 = ti1 + ti4;
03656 ci4 = ti1 - ti4;
03657 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
03658 - wa1[i__] * ci2;
03659 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 +
03660 wa1[i__] * cr2;
03661 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 -
03662 wa2[i__] * ci3;
03663 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
03664 i__] * cr3;
03665 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
03666 - wa3[i__] * ci4;
03667 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 +
03668 wa3[i__] * cr4;
03669
03670 }
03671
03672 }
03673 return 0;
03674 }
03675
03676 int sinti_(integer *n, doublereal *wsave)
03677 {
03678
03679
03680 static doublereal pi = 3.14159265358979;
03681
03682
03683 integer i__1;
03684
03685
03686 double sin(doublereal);
03687
03688
03689 static integer k;
03690 extern int rffti_(integer *, doublereal *);
03691 static doublereal dt;
03692 static integer np1, ns2;
03693
03694
03695
03696
03697 --wsave;
03698
03699
03700 if (*n <= 1) {
03701 return 0;
03702 }
03703 ns2 = *n / 2;
03704 np1 = *n + 1;
03705 dt = pi / (real) np1;
03706 i__1 = ns2;
03707 for (k = 1; k <= i__1; ++k) {
03708 wsave[k] = sin(k * dt) * (float)2.;
03709
03710 }
03711 rffti_(&np1, &wsave[ns2 + 1]);
03712 return 0;
03713 }
03714
03715 int sint_(integer *n, doublereal *x, doublereal *wsave)
03716 {
03717 extern int sint1_(integer *, doublereal *, doublereal *,
03718 doublereal *, doublereal *, doublereal *);
03719 static integer np1, iw1, iw2, iw3;
03720
03721
03722
03723
03724 --wsave;
03725 --x;
03726
03727
03728 np1 = *n + 1;
03729 iw1 = *n / 2 + 1;
03730 iw2 = iw1 + np1;
03731 iw3 = iw2 + np1;
03732 sint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], &wsave[iw3]);
03733 return 0;
03734 }
03735
03736 int sint1_(integer *n, doublereal *war, doublereal *was,
03737 doublereal *xh, doublereal *x, integer *ifac)
03738 {
03739
03740
03741 static doublereal sqrt3 = 1.73205080756888;
03742
03743
03744 integer i__1;
03745
03746
03747 static integer modn, i__, k;
03748 static doublereal xhold, t1, t2;
03749 extern int rfftf1_(integer *, doublereal *, doublereal *,
03750 doublereal *, integer *);
03751 static integer kc, np1, ns2;
03752
03753
03754
03755
03756 --ifac;
03757 --x;
03758 --xh;
03759 --was;
03760 --war;
03761
03762
03763 i__1 = *n;
03764 for (i__ = 1; i__ <= i__1; ++i__) {
03765 xh[i__] = war[i__];
03766 war[i__] = x[i__];
03767
03768 }
03769 if ((i__1 = *n - 2) < 0) {
03770 goto L101;
03771 } else if (i__1 == 0) {
03772 goto L102;
03773 } else {
03774 goto L103;
03775 }
03776 L101:
03777 xh[1] += xh[1];
03778 goto L106;
03779 L102:
03780 xhold = sqrt3 * (xh[1] + xh[2]);
03781 xh[2] = sqrt3 * (xh[1] - xh[2]);
03782 xh[1] = xhold;
03783 goto L106;
03784 L103:
03785 np1 = *n + 1;
03786 ns2 = *n / 2;
03787 x[1] = (float)0.;
03788 i__1 = ns2;
03789 for (k = 1; k <= i__1; ++k) {
03790 kc = np1 - k;
03791 t1 = xh[k] - xh[kc];
03792 t2 = was[k] * (xh[k] + xh[kc]);
03793 x[k + 1] = t1 + t2;
03794 x[kc + 1] = t2 - t1;
03795
03796 }
03797 modn = *n % 2;
03798 if (modn != 0) {
03799 x[ns2 + 2] = xh[ns2 + 1] * (float)4.;
03800 }
03801 rfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
03802 xh[1] = x[1] * (float).5;
03803 i__1 = *n;
03804 for (i__ = 3; i__ <= i__1; i__ += 2) {
03805 xh[i__ - 1] = -x[i__];
03806 xh[i__] = xh[i__ - 2] + x[i__ - 1];
03807
03808 }
03809 if (modn != 0) {
03810 goto L106;
03811 }
03812 xh[*n] = -x[*n + 1];
03813 L106:
03814 i__1 = *n;
03815 for (i__ = 1; i__ <= i__1; ++i__) {
03816 x[i__] = war[i__];
03817 war[i__] = xh[i__];
03818
03819 }
03820 return 0;
03821 }
03822
03823
03824 int frffti_(integer *n, real *wsave)
03825 {
03826 extern int frffti1_(integer *, real *, real *);
03827
03828
03829
03830
03831 --wsave;
03832
03833
03834 if (*n == 1) {
03835 return 0;
03836 }
03837 frffti1_(n, &wsave[*n + 1], &wsave[(*n << 1) + 1]);
03838 return 0;
03839 }
03840
03841 int frffti1_(integer *n, real *wa, integer *ifac)
03842 {
03843
03844
03845 static integer ntryh[4] = { 4,2,3,5 };
03846
03847
03848 integer i__1, i__2, i__3;
03849
03850
03851 double cos(doublereal), sin(doublereal);
03852
03853
03854 static real argh;
03855 static integer ntry, i__, j;
03856 static real argld;
03857 static integer k1, l1, l2, ib;
03858 static real fi;
03859 static integer ld, ii, nf, ip, nl, is, nq, nr;
03860 static real arg;
03861 static integer ido, ipm;
03862 static real tpi;
03863 static integer nfm1;
03864
03865
03866
03867
03868 --ifac;
03869 --wa;
03870
03871
03872 nl = *n;
03873 nf = 0;
03874 j = 0;
03875 L101:
03876 ++j;
03877 if (j - 4 <= 0) {
03878 goto L102;
03879 } else {
03880 goto L103;
03881 }
03882 L102:
03883 ntry = ntryh[j - 1];
03884 goto L104;
03885 L103:
03886 ntry += 2;
03887 L104:
03888 nq = nl / ntry;
03889 nr = nl - ntry * nq;
03890 if (nr != 0) {
03891 goto L101;
03892 } else {
03893 goto L105;
03894 }
03895 L105:
03896 ++nf;
03897 ifac[nf + 2] = ntry;
03898 nl = nq;
03899 if (ntry != 2) {
03900 goto L107;
03901 }
03902 if (nf == 1) {
03903 goto L107;
03904 }
03905 i__1 = nf;
03906 for (i__ = 2; i__ <= i__1; ++i__) {
03907 ib = nf - i__ + 2;
03908 ifac[ib + 2] = ifac[ib + 1];
03909
03910 }
03911 ifac[3] = 2;
03912 L107:
03913 if (nl != 1) {
03914 goto L104;
03915 }
03916 ifac[1] = *n;
03917 ifac[2] = nf;
03918 tpi = (float)6.28318530717959;
03919 argh = tpi / (real) (*n);
03920 is = 0;
03921 nfm1 = nf - 1;
03922 l1 = 1;
03923 if (nfm1 == 0) {
03924 return 0;
03925 }
03926 i__1 = nfm1;
03927 for (k1 = 1; k1 <= i__1; ++k1) {
03928 ip = ifac[k1 + 2];
03929 ld = 0;
03930 l2 = l1 * ip;
03931 ido = *n / l2;
03932 ipm = ip - 1;
03933 i__2 = ipm;
03934 for (j = 1; j <= i__2; ++j) {
03935 ld += l1;
03936 i__ = is;
03937 argld = (real) ld * argh;
03938 fi = (float)0.;
03939 i__3 = ido;
03940 for (ii = 3; ii <= i__3; ii += 2) {
03941 i__ += 2;
03942 fi += (float)1.;
03943 arg = fi * argld;
03944 wa[i__ - 1] = cos(arg);
03945 wa[i__] = sin(arg);
03946
03947 }
03948 is += ido;
03949
03950 }
03951 l1 = l2;
03952
03953 }
03954 return 0;
03955 }
03956
03957 int frfftf_(integer *n, real *r__, real *wsave)
03958 {
03959 extern int frfftf1_(integer *, real *, real *, real *,
03960 real *);
03961
03962
03963
03964
03965 --wsave;
03966 --r__;
03967
03968
03969 if (*n == 1) {
03970 return 0;
03971 }
03972 frfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
03973 return 0;
03974 }
03975
03976 int frfftf1_(integer *n, real *c__, real *ch, real *wa,
03977 integer *ifac)
03978 {
03979
03980 integer i__1;
03981
03982
03983 static integer i__, k1, l1, l2;
03984 extern int fradf2_(integer *, integer *, real *, real *,
03985 real *), fradf3_(integer *, integer *, real *, real *, real *,
03986 real *), fradf4_(integer *, integer *, real *, real *, real *,
03987 real *, real *), fradf5_(integer *, integer *, real *, real *,
03988 real *, real *, real *, real *);
03989 static integer na, kh, nf, ip;
03990 extern int fradfg_(integer *, integer *, integer *,
03991 integer *, real *, real *, real *, real *, real *, real *);
03992 static integer iw, ix2, ix3, ix4, ido, idl1;
03993
03994
03995
03996
03997 --ifac;
03998 --wa;
03999 --ch;
04000 --c__;
04001
04002
04003 nf = ifac[2];
04004 na = 1;
04005 l2 = *n;
04006 iw = *n;
04007 i__1 = nf;
04008 for (k1 = 1; k1 <= i__1; ++k1) {
04009 kh = nf - k1;
04010 ip = ifac[kh + 3];
04011 l1 = l2 / ip;
04012 ido = *n / l2;
04013 idl1 = ido * l1;
04014 iw -= (ip - 1) * ido;
04015 na = 1 - na;
04016 if (ip != 4) {
04017 goto L102;
04018 }
04019 ix2 = iw + ido;
04020 ix3 = ix2 + ido;
04021 if (na != 0) {
04022 goto L101;
04023 }
04024 fradf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
04025 goto L110;
04026 L101:
04027 fradf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
04028 goto L110;
04029 L102:
04030 if (ip != 2) {
04031 goto L104;
04032 }
04033 if (na != 0) {
04034 goto L103;
04035 }
04036 fradf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
04037 goto L110;
04038 L103:
04039 fradf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
04040 goto L110;
04041 L104:
04042 if (ip != 3) {
04043 goto L106;
04044 }
04045 ix2 = iw + ido;
04046 if (na != 0) {
04047 goto L105;
04048 }
04049 fradf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
04050 goto L110;
04051 L105:
04052 fradf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
04053 goto L110;
04054 L106:
04055 if (ip != 5) {
04056 goto L108;
04057 }
04058 ix2 = iw + ido;
04059 ix3 = ix2 + ido;
04060 ix4 = ix3 + ido;
04061 if (na != 0) {
04062 goto L107;
04063 }
04064 fradf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
04065 ix4]);
04066 goto L110;
04067 L107:
04068 fradf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
04069 ix4]);
04070 goto L110;
04071 L108:
04072 if (ido == 1) {
04073 na = 1 - na;
04074 }
04075 if (na != 0) {
04076 goto L109;
04077 }
04078 fradfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
04079 1], &wa[iw]);
04080 na = 1;
04081 goto L110;
04082 L109:
04083 fradfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[
04084 1], &wa[iw]);
04085 na = 0;
04086 L110:
04087 l2 = l1;
04088
04089 }
04090 if (na == 1) {
04091 return 0;
04092 }
04093 i__1 = *n;
04094 for (i__ = 1; i__ <= i__1; ++i__) {
04095 c__[i__] = ch[i__];
04096
04097 }
04098 return 0;
04099 }
04100
04101 int fradfg_(integer *ido, integer *ip, integer *l1, integer *
04102 idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
04103 {
04104
04105
04106 static real tpi = (float)6.28318530717959;
04107
04108
04109 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
04110 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
04111 i__1, i__2, i__3;
04112
04113
04114 double cos(doublereal), sin(doublereal);
04115
04116
04117 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
04118 static real dc2, ai1, ai2, ar1, ar2, ds2;
04119 static integer nbd;
04120 static real dcp, arg, dsp, ar1h, ar2h;
04121 static integer idp2, ipp2;
04122
04123
04124
04125
04126 ch_dim1 = *ido;
04127 ch_dim2 = *l1;
04128 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
04129 ch -= ch_offset;
04130 c1_dim1 = *ido;
04131 c1_dim2 = *l1;
04132 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
04133 c1 -= c1_offset;
04134 cc_dim1 = *ido;
04135 cc_dim2 = *ip;
04136 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
04137 cc -= cc_offset;
04138 ch2_dim1 = *idl1;
04139 ch2_offset = ch2_dim1 + 1;
04140 ch2 -= ch2_offset;
04141 c2_dim1 = *idl1;
04142 c2_offset = c2_dim1 + 1;
04143 c2 -= c2_offset;
04144 --wa;
04145
04146
04147 arg = tpi / (real) (*ip);
04148 dcp = cos(arg);
04149 dsp = sin(arg);
04150 ipph = (*ip + 1) / 2;
04151 ipp2 = *ip + 2;
04152 idp2 = *ido + 2;
04153 nbd = (*ido - 1) / 2;
04154 if (*ido == 1) {
04155 goto L119;
04156 }
04157 i__1 = *idl1;
04158 for (ik = 1; ik <= i__1; ++ik) {
04159 ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
04160
04161 }
04162 i__1 = *ip;
04163 for (j = 2; j <= i__1; ++j) {
04164 i__2 = *l1;
04165 for (k = 1; k <= i__2; ++k) {
04166 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
04167 c1_dim1 + 1];
04168
04169 }
04170
04171 }
04172 if (nbd > *l1) {
04173 goto L107;
04174 }
04175 is = -(*ido);
04176 i__1 = *ip;
04177 for (j = 2; j <= i__1; ++j) {
04178 is += *ido;
04179 idij = is;
04180 i__2 = *ido;
04181 for (i__ = 3; i__ <= i__2; i__ += 2) {
04182 idij += 2;
04183 i__3 = *l1;
04184 for (k = 1; k <= i__3; ++k) {
04185 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
04186 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
04187 c1[i__ + (k + j * c1_dim2) * c1_dim1];
04188 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
04189 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
04190 1 + (k + j * c1_dim2) * c1_dim1];
04191
04192 }
04193
04194 }
04195
04196 }
04197 goto L111;
04198 L107:
04199 is = -(*ido);
04200 i__1 = *ip;
04201 for (j = 2; j <= i__1; ++j) {
04202 is += *ido;
04203 i__2 = *l1;
04204 for (k = 1; k <= i__2; ++k) {
04205 idij = is;
04206 i__3 = *ido;
04207 for (i__ = 3; i__ <= i__3; i__ += 2) {
04208 idij += 2;
04209 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
04210 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
04211 c1[i__ + (k + j * c1_dim2) * c1_dim1];
04212 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
04213 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
04214 1 + (k + j * c1_dim2) * c1_dim1];
04215
04216 }
04217
04218 }
04219
04220 }
04221 L111:
04222 if (nbd < *l1) {
04223 goto L115;
04224 }
04225 i__1 = ipph;
04226 for (j = 2; j <= i__1; ++j) {
04227 jc = ipp2 - j;
04228 i__2 = *l1;
04229 for (k = 1; k <= i__2; ++k) {
04230 i__3 = *ido;
04231 for (i__ = 3; i__ <= i__3; i__ += 2) {
04232 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
04233 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
04234 ch_dim2) * ch_dim1];
04235 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
04236 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
04237 ch_dim1];
04238 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
04239 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
04240 ch_dim1];
04241 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
04242 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
04243 * ch_dim1];
04244
04245 }
04246
04247 }
04248
04249 }
04250 goto L121;
04251 L115:
04252 i__1 = ipph;
04253 for (j = 2; j <= i__1; ++j) {
04254 jc = ipp2 - j;
04255 i__2 = *ido;
04256 for (i__ = 3; i__ <= i__2; i__ += 2) {
04257 i__3 = *l1;
04258 for (k = 1; k <= i__3; ++k) {
04259 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
04260 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
04261 ch_dim2) * ch_dim1];
04262 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
04263 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
04264 ch_dim1];
04265 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
04266 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
04267 ch_dim1];
04268 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
04269 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
04270 * ch_dim1];
04271
04272 }
04273
04274 }
04275
04276 }
04277 goto L121;
04278 L119:
04279 i__1 = *idl1;
04280 for (ik = 1; ik <= i__1; ++ik) {
04281 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
04282
04283 }
04284 L121:
04285 i__1 = ipph;
04286 for (j = 2; j <= i__1; ++j) {
04287 jc = ipp2 - j;
04288 i__2 = *l1;
04289 for (k = 1; k <= i__2; ++k) {
04290 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
04291 ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
04292 c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) *
04293 ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
04294
04295 }
04296
04297 }
04298
04299 ar1 = (float)1.;
04300 ai1 = (float)0.;
04301 i__1 = ipph;
04302 for (l = 2; l <= i__1; ++l) {
04303 lc = ipp2 - l;
04304 ar1h = dcp * ar1 - dsp * ai1;
04305 ai1 = dcp * ai1 + dsp * ar1;
04306 ar1 = ar1h;
04307 i__2 = *idl1;
04308 for (ik = 1; ik <= i__2; ++ik) {
04309 ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
04310 c2_dim1 << 1)];
04311 ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1];
04312
04313 }
04314 dc2 = ar1;
04315 ds2 = ai1;
04316 ar2 = ar1;
04317 ai2 = ai1;
04318 i__2 = ipph;
04319 for (j = 3; j <= i__2; ++j) {
04320 jc = ipp2 - j;
04321 ar2h = dc2 * ar2 - ds2 * ai2;
04322 ai2 = dc2 * ai2 + ds2 * ar2;
04323 ar2 = ar2h;
04324 i__3 = *idl1;
04325 for (ik = 1; ik <= i__3; ++ik) {
04326 ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
04327 ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
04328
04329 }
04330
04331 }
04332
04333 }
04334 i__1 = ipph;
04335 for (j = 2; j <= i__1; ++j) {
04336 i__2 = *idl1;
04337 for (ik = 1; ik <= i__2; ++ik) {
04338 ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
04339
04340 }
04341
04342 }
04343
04344 if (*ido < *l1) {
04345 goto L132;
04346 }
04347 i__1 = *l1;
04348 for (k = 1; k <= i__1; ++k) {
04349 i__2 = *ido;
04350 for (i__ = 1; i__ <= i__2; ++i__) {
04351 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
04352 ch_dim1];
04353
04354 }
04355
04356 }
04357 goto L135;
04358 L132:
04359 i__1 = *ido;
04360 for (i__ = 1; i__ <= i__1; ++i__) {
04361 i__2 = *l1;
04362 for (k = 1; k <= i__2; ++k) {
04363 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
04364 ch_dim1];
04365
04366 }
04367
04368 }
04369 L135:
04370 i__1 = ipph;
04371 for (j = 2; j <= i__1; ++j) {
04372 jc = ipp2 - j;
04373 j2 = j + j;
04374 i__2 = *l1;
04375 for (k = 1; k <= i__2; ++k) {
04376 cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
04377 * ch_dim1 + 1];
04378 cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
04379 ch_dim1 + 1];
04380
04381 }
04382
04383 }
04384 if (*ido == 1) {
04385 return 0;
04386 }
04387 if (nbd < *l1) {
04388 goto L141;
04389 }
04390 i__1 = ipph;
04391 for (j = 2; j <= i__1; ++j) {
04392 jc = ipp2 - j;
04393 j2 = j + j;
04394 i__2 = *l1;
04395 for (k = 1; k <= i__2; ++k) {
04396 i__3 = *ido;
04397 for (i__ = 3; i__ <= i__3; i__ += 2) {
04398 ic = idp2 - i__;
04399 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
04400 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
04401 ch_dim2) * ch_dim1];
04402 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
04403 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
04404 ch_dim2) * ch_dim1];
04405 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
04406 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
04407 ch_dim1];
04408 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
04409 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
04410 ch_dim1];
04411
04412 }
04413
04414 }
04415
04416 }
04417 return 0;
04418 L141:
04419 i__1 = ipph;
04420 for (j = 2; j <= i__1; ++j) {
04421 jc = ipp2 - j;
04422 j2 = j + j;
04423 i__2 = *ido;
04424 for (i__ = 3; i__ <= i__2; i__ += 2) {
04425 ic = idp2 - i__;
04426 i__3 = *l1;
04427 for (k = 1; k <= i__3; ++k) {
04428 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
04429 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
04430 ch_dim2) * ch_dim1];
04431 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
04432 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
04433 ch_dim2) * ch_dim1];
04434 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
04435 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
04436 ch_dim1];
04437 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
04438 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
04439 ch_dim1];
04440
04441 }
04442
04443 }
04444
04445 }
04446 return 0;
04447 }
04448
04449 int fradf5_(integer *ido, integer *l1, real *cc, real *ch,
04450 real *wa1, real *wa2, real *wa3, real *wa4)
04451 {
04452
04453
04454 static real tr11 = (float).309016994374947;
04455 static real ti11 = (float).951056516295154;
04456 static real tr12 = (float)-.809016994374947;
04457 static real ti12 = (float).587785252292473;
04458
04459
04460 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
04461
04462
04463 static integer i__, k, ic;
04464 static real ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3,
04465 dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
04466 static integer idp2;
04467
04468
04469
04470
04471 ch_dim1 = *ido;
04472 ch_offset = ch_dim1 * 6 + 1;
04473 ch -= ch_offset;
04474 cc_dim1 = *ido;
04475 cc_dim2 = *l1;
04476 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
04477 cc -= cc_offset;
04478 --wa1;
04479 --wa2;
04480 --wa3;
04481 --wa4;
04482
04483
04484 i__1 = *l1;
04485 for (k = 1; k <= i__1; ++k) {
04486 cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) *
04487 cc_dim1 + 1];
04488 ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) *
04489 cc_dim1 + 1];
04490 cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
04491 cc_dim1 + 1];
04492 ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) *
04493 cc_dim1 + 1];
04494 ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2
04495 + cr3;
04496 ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
04497 tr11 * cr2 + tr12 * cr3;
04498 ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
04499 ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
04500 tr12 * cr2 + tr11 * cr3;
04501 ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
04502
04503 }
04504 if (*ido == 1) {
04505 return 0;
04506 }
04507 idp2 = *ido + 2;
04508 i__1 = *l1;
04509 for (k = 1; k <= i__1; ++k) {
04510 i__2 = *ido;
04511 for (i__ = 3; i__ <= i__2; i__ += 2) {
04512 ic = idp2 - i__;
04513 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
04514 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
04515 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
04516 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
04517 cc_dim1];
04518 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
04519 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
04520 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
04521 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
04522 dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
04523 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
04524 di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
04525 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
04526 cc_dim1];
04527 dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] +
04528 wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
04529 di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
04530 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
04531 cr2 = dr2 + dr5;
04532 ci5 = dr5 - dr2;
04533 cr5 = di2 - di5;
04534 ci2 = di2 + di5;
04535 cr3 = dr3 + dr4;
04536 ci4 = dr4 - dr3;
04537 cr4 = di3 - di4;
04538 ci3 = di3 + di4;
04539 ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
04540 cc_dim1] + cr2 + cr3;
04541 ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
04542 cc_dim1] + ci2 + ci3;
04543 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 *
04544 cr3;
04545 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
04546 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 *
04547 cr3;
04548 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
04549 tr5 = ti11 * cr5 + ti12 * cr4;
04550 ti5 = ti11 * ci5 + ti12 * ci4;
04551 tr4 = ti12 * cr5 - ti11 * cr4;
04552 ti4 = ti12 * ci5 - ti11 * ci4;
04553 ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
04554 ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
04555 ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
04556 ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
04557 ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
04558 ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
04559 ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
04560 ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
04561
04562 }
04563
04564 }
04565 return 0;
04566 }
04567
04568 int fradf3_(integer *ido, integer *l1, real *cc, real *ch,
04569 real *wa1, real *wa2)
04570 {
04571
04572
04573 static real taur = (float)-.5;
04574 static real taui = (float).866025403784439;
04575
04576
04577 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
04578
04579
04580 static integer i__, k, ic;
04581 static real ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
04582 static integer idp2;
04583
04584
04585
04586
04587 ch_dim1 = *ido;
04588 ch_offset = (ch_dim1 << 2) + 1;
04589 ch -= ch_offset;
04590 cc_dim1 = *ido;
04591 cc_dim2 = *l1;
04592 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
04593 cc -= cc_offset;
04594 --wa1;
04595 --wa2;
04596
04597
04598 i__1 = *l1;
04599 for (k = 1; k <= i__1; ++k) {
04600 cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
04601 cc_dim1 + 1];
04602 ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
04603 ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) *
04604 cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
04605 ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
04606 taur * cr2;
04607
04608 }
04609 if (*ido == 1) {
04610 return 0;
04611 }
04612 idp2 = *ido + 2;
04613 i__1 = *l1;
04614 for (k = 1; k <= i__1; ++k) {
04615 i__2 = *ido;
04616 for (i__ = 3; i__ <= i__2; i__ += 2) {
04617 ic = idp2 - i__;
04618 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
04619 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
04620 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
04621 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
04622 cc_dim1];
04623 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
04624 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
04625 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
04626 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
04627 cr2 = dr2 + dr3;
04628 ci2 = di2 + di3;
04629 ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
04630 cc_dim1] + cr2;
04631 ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
04632 cc_dim1] + ci2;
04633 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
04634 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
04635 tr3 = taui * (di2 - di3);
04636 ti3 = taui * (dr3 - dr2);
04637 ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
04638 ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
04639 ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
04640 ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
04641
04642 }
04643
04644 }
04645 return 0;
04646 }
04647
04648 int fradf2_(integer *ido, integer *l1, real *cc, real *ch,
04649 real *wa1)
04650 {
04651
04652 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
04653
04654
04655 static integer i__, k, ic;
04656 static real ti2, tr2;
04657 static integer idp2;
04658
04659
04660
04661
04662 ch_dim1 = *ido;
04663 ch_offset = ch_dim1 * 3 + 1;
04664 ch -= ch_offset;
04665 cc_dim1 = *ido;
04666 cc_dim2 = *l1;
04667 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
04668 cc -= cc_offset;
04669 --wa1;
04670
04671
04672 i__1 = *l1;
04673 for (k = 1; k <= i__1; ++k) {
04674 ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
04675 cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
04676 ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
04677 - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
04678
04679 }
04680 if ((i__1 = *ido - 2) < 0) {
04681 goto L107;
04682 } else if (i__1 == 0) {
04683 goto L105;
04684 } else {
04685 goto L102;
04686 }
04687 L102:
04688 idp2 = *ido + 2;
04689 i__1 = *l1;
04690 for (k = 1; k <= i__1; ++k) {
04691 i__2 = *ido;
04692 for (i__ = 3; i__ <= i__2; i__ += 2) {
04693 ic = idp2 - i__;
04694 tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
04695 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
04696 ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
04697 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
04698 cc_dim1];
04699 ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
04700 cc_dim1] + ti2;
04701 ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
04702 cc_dim1];
04703 ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k +
04704 cc_dim2) * cc_dim1] + tr2;
04705 ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
04706 * cc_dim1] - tr2;
04707
04708 }
04709
04710 }
04711 if (*ido % 2 == 1) {
04712 return 0;
04713 }
04714 L105:
04715 i__1 = *l1;
04716 for (k = 1; k <= i__1; ++k) {
04717 ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) *
04718 cc_dim1];
04719 ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) *
04720 cc_dim1];
04721
04722 }
04723 L107:
04724 return 0;
04725 }
04726
04727 int fradf4_(integer *ido, integer *l1, real *cc, real *ch,
04728 real *wa1, real *wa2, real *wa3)
04729 {
04730
04731
04732 static real hsqt2 = (float).7071067811865475;
04733
04734
04735 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
04736
04737
04738 static integer i__, k, ic;
04739 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
04740 tr3, tr4;
04741 static integer idp2;
04742
04743
04744
04745
04746 ch_dim1 = *ido;
04747 ch_offset = ch_dim1 * 5 + 1;
04748 ch -= ch_offset;
04749 cc_dim1 = *ido;
04750 cc_dim2 = *l1;
04751 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
04752 cc -= cc_offset;
04753 --wa1;
04754 --wa2;
04755 --wa3;
04756
04757
04758 i__1 = *l1;
04759 for (k = 1; k <= i__1; ++k) {
04760 tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
04761 * cc_dim1 + 1];
04762 tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
04763 cc_dim1 + 1];
04764 ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
04765 ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
04766 ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
04767 - cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
04768 ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1
04769 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
04770
04771 }
04772 if ((i__1 = *ido - 2) < 0) {
04773 goto L107;
04774 } else if (i__1 == 0) {
04775 goto L105;
04776 } else {
04777 goto L102;
04778 }
04779 L102:
04780 idp2 = *ido + 2;
04781 i__1 = *l1;
04782 for (k = 1; k <= i__1; ++k) {
04783 i__2 = *ido;
04784 for (i__ = 3; i__ <= i__2; i__ += 2) {
04785 ic = idp2 - i__;
04786 cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
04787 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
04788 ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
04789 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
04790 cc_dim1];
04791 cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
04792 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
04793 ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
04794 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
04795 cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
04796 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
04797 ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
04798 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
04799 cc_dim1];
04800 tr1 = cr2 + cr4;
04801 tr4 = cr4 - cr2;
04802 ti1 = ci2 + ci4;
04803 ti4 = ci2 - ci4;
04804 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
04805 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
04806 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
04807 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
04808 ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
04809 ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
04810 ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
04811 ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
04812 ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
04813 ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
04814 ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
04815 ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
04816
04817 }
04818
04819 }
04820 if (*ido % 2 == 1) {
04821 return 0;
04822 }
04823 L105:
04824 i__1 = *l1;
04825 for (k = 1; k <= i__1; ++k) {
04826 ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido +
04827 (k + (cc_dim2 << 2)) * cc_dim1]);
04828 tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + (
04829 k + (cc_dim2 << 2)) * cc_dim1]);
04830 ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) *
04831 cc_dim1];
04832 ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) *
04833 cc_dim1] - tr1;
04834 ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) *
04835 cc_dim1];
04836 ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) *
04837 cc_dim1];
04838
04839 }
04840 L107:
04841 return 0;
04842 }
04843
04844 int frfftb_(integer *n, real *r__, real *wsave)
04845 {
04846 extern int frfftb1_(integer *, real *, real *, real *,
04847 real *);
04848
04849
04850
04851
04852 --wsave;
04853 --r__;
04854
04855
04856 if (*n == 1) {
04857 return 0;
04858 }
04859 frfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
04860 return 0;
04861 }
04862
04863 int frfftb1_(integer *n, real *c__, real *ch, real *wa,
04864 integer *ifac)
04865 {
04866
04867 integer i__1;
04868
04869
04870 static integer i__, k1, l1, l2;
04871 extern int fradb2_(integer *, integer *, real *, real *,
04872 real *), fradb3_(integer *, integer *, real *, real *, real *,
04873 real *), fradb4_(integer *, integer *, real *, real *, real *,
04874 real *, real *), fradb5_(integer *, integer *, real *, real *,
04875 real *, real *, real *, real *);
04876 static integer na, nf;
04877 extern int fradbg_(integer *, integer *, integer *,
04878 integer *, real *, real *, real *, real *, real *, real *);
04879 static integer ip, iw, ix2, ix3, ix4, ido, idl1;
04880
04881
04882
04883
04884 --ifac;
04885 --wa;
04886 --ch;
04887 --c__;
04888
04889
04890 nf = ifac[2];
04891 na = 0;
04892 l1 = 1;
04893 iw = 1;
04894 i__1 = nf;
04895 for (k1 = 1; k1 <= i__1; ++k1) {
04896 ip = ifac[k1 + 2];
04897 l2 = ip * l1;
04898 ido = *n / l2;
04899 idl1 = ido * l1;
04900 if (ip != 4) {
04901 goto L103;
04902 }
04903 ix2 = iw + ido;
04904 ix3 = ix2 + ido;
04905 if (na != 0) {
04906 goto L101;
04907 }
04908 fradb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
04909 goto L102;
04910 L101:
04911 fradb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
04912 L102:
04913 na = 1 - na;
04914 goto L115;
04915 L103:
04916 if (ip != 2) {
04917 goto L106;
04918 }
04919 if (na != 0) {
04920 goto L104;
04921 }
04922 fradb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
04923 goto L105;
04924 L104:
04925 fradb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
04926 L105:
04927 na = 1 - na;
04928 goto L115;
04929 L106:
04930 if (ip != 3) {
04931 goto L109;
04932 }
04933 ix2 = iw + ido;
04934 if (na != 0) {
04935 goto L107;
04936 }
04937 fradb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
04938 goto L108;
04939 L107:
04940 fradb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
04941 L108:
04942 na = 1 - na;
04943 goto L115;
04944 L109:
04945 if (ip != 5) {
04946 goto L112;
04947 }
04948 ix2 = iw + ido;
04949 ix3 = ix2 + ido;
04950 ix4 = ix3 + ido;
04951 if (na != 0) {
04952 goto L110;
04953 }
04954 fradb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
04955 ix4]);
04956 goto L111;
04957 L110:
04958 fradb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
04959 ix4]);
04960 L111:
04961 na = 1 - na;
04962 goto L115;
04963 L112:
04964 if (na != 0) {
04965 goto L113;
04966 }
04967 fradbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
04968 1], &wa[iw]);
04969 goto L114;
04970 L113:
04971 fradbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[
04972 1], &wa[iw]);
04973 L114:
04974 if (ido == 1) {
04975 na = 1 - na;
04976 }
04977 L115:
04978 l1 = l2;
04979 iw += (ip - 1) * ido;
04980
04981 }
04982 if (na == 0) {
04983 return 0;
04984 }
04985 i__1 = *n;
04986 for (i__ = 1; i__ <= i__1; ++i__) {
04987 c__[i__] = ch[i__];
04988
04989 }
04990 return 0;
04991 }
04992
04993 int fradbg_(integer *ido, integer *ip, integer *l1, integer *
04994 idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
04995 {
04996
04997
04998 static real tpi = (float)6.28318530717959;
04999
05000
05001 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
05002 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
05003 i__1, i__2, i__3;
05004
05005
05006 double cos(doublereal), sin(doublereal);
05007
05008
05009 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
05010 static real dc2, ai1, ai2, ar1, ar2, ds2;
05011 static integer nbd;
05012 static real dcp, arg, dsp, ar1h, ar2h;
05013 static integer idp2, ipp2;
05014
05015
05016
05017
05018 ch_dim1 = *ido;
05019 ch_dim2 = *l1;
05020 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
05021 ch -= ch_offset;
05022 c1_dim1 = *ido;
05023 c1_dim2 = *l1;
05024 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
05025 c1 -= c1_offset;
05026 cc_dim1 = *ido;
05027 cc_dim2 = *ip;
05028 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
05029 cc -= cc_offset;
05030 ch2_dim1 = *idl1;
05031 ch2_offset = ch2_dim1 + 1;
05032 ch2 -= ch2_offset;
05033 c2_dim1 = *idl1;
05034 c2_offset = c2_dim1 + 1;
05035 c2 -= c2_offset;
05036 --wa;
05037
05038
05039 arg = tpi / (real) (*ip);
05040 dcp = cos(arg);
05041 dsp = sin(arg);
05042 idp2 = *ido + 2;
05043 nbd = (*ido - 1) / 2;
05044 ipp2 = *ip + 2;
05045 ipph = (*ip + 1) / 2;
05046 if (*ido < *l1) {
05047 goto L103;
05048 }
05049 i__1 = *l1;
05050 for (k = 1; k <= i__1; ++k) {
05051 i__2 = *ido;
05052 for (i__ = 1; i__ <= i__2; ++i__) {
05053 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
05054 cc_dim1];
05055
05056 }
05057
05058 }
05059 goto L106;
05060 L103:
05061 i__1 = *ido;
05062 for (i__ = 1; i__ <= i__1; ++i__) {
05063 i__2 = *l1;
05064 for (k = 1; k <= i__2; ++k) {
05065 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
05066 cc_dim1];
05067
05068 }
05069
05070 }
05071 L106:
05072 i__1 = ipph;
05073 for (j = 2; j <= i__1; ++j) {
05074 jc = ipp2 - j;
05075 j2 = j + j;
05076 i__2 = *l1;
05077 for (k = 1; k <= i__2; ++k) {
05078 ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k *
05079 cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) *
05080 cc_dim1];
05081 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
05082 cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
05083
05084 }
05085
05086 }
05087 if (*ido == 1) {
05088 goto L116;
05089 }
05090 if (nbd < *l1) {
05091 goto L112;
05092 }
05093 i__1 = ipph;
05094 for (j = 2; j <= i__1; ++j) {
05095 jc = ipp2 - j;
05096 i__2 = *l1;
05097 for (k = 1; k <= i__2; ++k) {
05098 i__3 = *ido;
05099 for (i__ = 3; i__ <= i__3; i__ += 2) {
05100 ic = idp2 - i__;
05101 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
05102 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
05103 << 1) - 2 + k * cc_dim2) * cc_dim1];
05104 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
05105 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
05106 << 1) - 2 + k * cc_dim2) * cc_dim1];
05107 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
05108 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
05109 k * cc_dim2) * cc_dim1];
05110 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
05111 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
05112 k * cc_dim2) * cc_dim1];
05113
05114 }
05115
05116 }
05117
05118 }
05119 goto L116;
05120 L112:
05121 i__1 = ipph;
05122 for (j = 2; j <= i__1; ++j) {
05123 jc = ipp2 - j;
05124 i__2 = *ido;
05125 for (i__ = 3; i__ <= i__2; i__ += 2) {
05126 ic = idp2 - i__;
05127 i__3 = *l1;
05128 for (k = 1; k <= i__3; ++k) {
05129 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
05130 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
05131 << 1) - 2 + k * cc_dim2) * cc_dim1];
05132 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
05133 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
05134 << 1) - 2 + k * cc_dim2) * cc_dim1];
05135 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
05136 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
05137 k * cc_dim2) * cc_dim1];
05138 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
05139 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
05140 k * cc_dim2) * cc_dim1];
05141
05142 }
05143
05144 }
05145
05146 }
05147 L116:
05148 ar1 = (float)1.;
05149 ai1 = (float)0.;
05150 i__1 = ipph;
05151 for (l = 2; l <= i__1; ++l) {
05152 lc = ipp2 - l;
05153 ar1h = dcp * ar1 - dsp * ai1;
05154 ai1 = dcp * ai1 + dsp * ar1;
05155 ar1 = ar1h;
05156 i__2 = *idl1;
05157 for (ik = 1; ik <= i__2; ++ik) {
05158 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
05159 ch2_dim1 << 1)];
05160 c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1];
05161
05162 }
05163 dc2 = ar1;
05164 ds2 = ai1;
05165 ar2 = ar1;
05166 ai2 = ai1;
05167 i__2 = ipph;
05168 for (j = 3; j <= i__2; ++j) {
05169 jc = ipp2 - j;
05170 ar2h = dc2 * ar2 - ds2 * ai2;
05171 ai2 = dc2 * ai2 + ds2 * ar2;
05172 ar2 = ar2h;
05173 i__3 = *idl1;
05174 for (ik = 1; ik <= i__3; ++ik) {
05175 c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
05176 c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
05177
05178 }
05179
05180 }
05181
05182 }
05183 i__1 = ipph;
05184 for (j = 2; j <= i__1; ++j) {
05185 i__2 = *idl1;
05186 for (ik = 1; ik <= i__2; ++ik) {
05187 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
05188
05189 }
05190
05191 }
05192 i__1 = ipph;
05193 for (j = 2; j <= i__1; ++j) {
05194 jc = ipp2 - j;
05195 i__2 = *l1;
05196 for (k = 1; k <= i__2; ++k) {
05197 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
05198 c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
05199 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
05200 c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
05201
05202 }
05203
05204 }
05205 if (*ido == 1) {
05206 goto L132;
05207 }
05208 if (nbd < *l1) {
05209 goto L128;
05210 }
05211 i__1 = ipph;
05212 for (j = 2; j <= i__1; ++j) {
05213 jc = ipp2 - j;
05214 i__2 = *l1;
05215 for (k = 1; k <= i__2; ++k) {
05216 i__3 = *ido;
05217 for (i__ = 3; i__ <= i__3; i__ += 2) {
05218 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
05219 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
05220 * c1_dim1];
05221 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
05222 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
05223 c1_dim2) * c1_dim1];
05224 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
05225 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
05226 * c1_dim1];
05227 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
05228 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
05229 * c1_dim1];
05230
05231 }
05232
05233 }
05234
05235 }
05236 goto L132;
05237 L128:
05238 i__1 = ipph;
05239 for (j = 2; j <= i__1; ++j) {
05240 jc = ipp2 - j;
05241 i__2 = *ido;
05242 for (i__ = 3; i__ <= i__2; i__ += 2) {
05243 i__3 = *l1;
05244 for (k = 1; k <= i__3; ++k) {
05245 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
05246 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
05247 * c1_dim1];
05248 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
05249 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
05250 c1_dim2) * c1_dim1];
05251 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
05252 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
05253 * c1_dim1];
05254 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
05255 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
05256 * c1_dim1];
05257
05258 }
05259
05260 }
05261
05262 }
05263 L132:
05264 if (*ido == 1) {
05265 return 0;
05266 }
05267 i__1 = *idl1;
05268 for (ik = 1; ik <= i__1; ++ik) {
05269 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
05270
05271 }
05272 i__1 = *ip;
05273 for (j = 2; j <= i__1; ++j) {
05274 i__2 = *l1;
05275 for (k = 1; k <= i__2; ++k) {
05276 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
05277 ch_dim1 + 1];
05278
05279 }
05280
05281 }
05282 if (nbd > *l1) {
05283 goto L139;
05284 }
05285 is = -(*ido);
05286 i__1 = *ip;
05287 for (j = 2; j <= i__1; ++j) {
05288 is += *ido;
05289 idij = is;
05290 i__2 = *ido;
05291 for (i__ = 3; i__ <= i__2; i__ += 2) {
05292 idij += 2;
05293 i__3 = *l1;
05294 for (k = 1; k <= i__3; ++k) {
05295 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
05296 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
05297 ch[i__ + (k + j * ch_dim2) * ch_dim1];
05298 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
05299 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
05300 1 + (k + j * ch_dim2) * ch_dim1];
05301
05302 }
05303
05304 }
05305
05306 }
05307 goto L143;
05308 L139:
05309 is = -(*ido);
05310 i__1 = *ip;
05311 for (j = 2; j <= i__1; ++j) {
05312 is += *ido;
05313 i__2 = *l1;
05314 for (k = 1; k <= i__2; ++k) {
05315 idij = is;
05316 i__3 = *ido;
05317 for (i__ = 3; i__ <= i__3; i__ += 2) {
05318 idij += 2;
05319 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
05320 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
05321 ch[i__ + (k + j * ch_dim2) * ch_dim1];
05322 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
05323 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
05324 1 + (k + j * ch_dim2) * ch_dim1];
05325
05326 }
05327
05328 }
05329
05330 }
05331 L143:
05332 return 0;
05333 }
05334
05335 int fradb5_(integer *ido, integer *l1, real *cc, real *ch,
05336 real *wa1, real *wa2, real *wa3, real *wa4)
05337 {
05338
05339
05340 static real tr11 = (float).309016994374947;
05341 static real ti11 = (float).951056516295154;
05342 static real tr12 = (float)-.809016994374947;
05343 static real ti12 = (float).587785252292473;
05344
05345
05346 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
05347
05348
05349 static integer i__, k, ic;
05350 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
05351 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
05352 static integer idp2;
05353
05354
05355
05356
05357 ch_dim1 = *ido;
05358 ch_dim2 = *l1;
05359 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
05360 ch -= ch_offset;
05361 cc_dim1 = *ido;
05362 cc_offset = cc_dim1 * 6 + 1;
05363 cc -= cc_offset;
05364 --wa1;
05365 --wa2;
05366 --wa3;
05367 --wa4;
05368
05369
05370 i__1 = *l1;
05371 for (k = 1; k <= i__1; ++k) {
05372 ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
05373 ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
05374 tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) *
05375 cc_dim1];
05376 tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) *
05377 cc_dim1];
05378 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
05379 + tr3;
05380 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
05381 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
05382 ci5 = ti11 * ti5 + ti12 * ti4;
05383 ci4 = ti12 * ti5 - ti11 * ti4;
05384 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
05385 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
05386 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
05387 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
05388
05389 }
05390 if (*ido == 1) {
05391 return 0;
05392 }
05393 idp2 = *ido + 2;
05394 i__1 = *l1;
05395 for (k = 1; k <= i__1; ++k) {
05396 i__2 = *ido;
05397 for (i__ = 3; i__ <= i__2; i__ += 2) {
05398 ic = idp2 - i__;
05399 ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) *
05400 cc_dim1];
05401 ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) *
05402 cc_dim1];
05403 ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) *
05404 cc_dim1];
05405 ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) *
05406 cc_dim1];
05407 tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 +
05408 2) * cc_dim1];
05409 tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 +
05410 2) * cc_dim1];
05411 tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 +
05412 4) * cc_dim1];
05413 tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 +
05414 4) * cc_dim1];
05415 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
05416 cc_dim1] + tr2 + tr3;
05417 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
05418 cc_dim1] + ti2 + ti3;
05419 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
05420 tr3;
05421 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
05422 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
05423 tr3;
05424 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
05425 cr5 = ti11 * tr5 + ti12 * tr4;
05426 ci5 = ti11 * ti5 + ti12 * ti4;
05427 cr4 = ti12 * tr5 - ti11 * tr4;
05428 ci4 = ti12 * ti5 - ti11 * ti4;
05429 dr3 = cr3 - ci4;
05430 dr4 = cr3 + ci4;
05431 di3 = ci3 + cr4;
05432 di4 = ci3 - cr4;
05433 dr5 = cr2 + ci5;
05434 dr2 = cr2 - ci5;
05435 di5 = ci2 - cr5;
05436 di2 = ci2 + cr5;
05437 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
05438 - wa1[i__ - 1] * di2;
05439 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
05440 wa1[i__ - 1] * dr2;
05441 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
05442 wa2[i__ - 1] * di3;
05443 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
05444 i__ - 1] * dr3;
05445 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4
05446 - wa3[i__ - 1] * di4;
05447 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 +
05448 wa3[i__ - 1] * dr4;
05449 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 -
05450 wa4[i__ - 1] * di5;
05451 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
05452 i__ - 1] * dr5;
05453
05454 }
05455
05456 }
05457 return 0;
05458 }
05459
05460 int fradb3_(integer *ido, integer *l1, real *cc, real *ch,
05461 real *wa1, real *wa2)
05462 {
05463
05464
05465 static real taur = (float)-.5;
05466 static real taui = (float).866025403784439;
05467
05468
05469 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
05470
05471
05472 static integer i__, k, ic;
05473 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
05474 static integer idp2;
05475
05476
05477
05478
05479 ch_dim1 = *ido;
05480 ch_dim2 = *l1;
05481 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
05482 ch -= ch_offset;
05483 cc_dim1 = *ido;
05484 cc_offset = (cc_dim1 << 2) + 1;
05485 cc -= cc_offset;
05486 --wa1;
05487 --wa2;
05488
05489
05490 i__1 = *l1;
05491 for (k = 1; k <= i__1; ++k) {
05492 tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) *
05493 cc_dim1];
05494 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
05495 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
05496 ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) *
05497 cc_dim1 + 1]);
05498 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
05499 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
05500
05501 }
05502 if (*ido == 1) {
05503 return 0;
05504 }
05505 idp2 = *ido + 2;
05506 i__1 = *l1;
05507 for (k = 1; k <= i__1; ++k) {
05508 i__2 = *ido;
05509 for (i__ = 3; i__ <= i__2; i__ += 2) {
05510 ic = idp2 - i__;
05511 tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 +
05512 2) * cc_dim1];
05513 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
05514 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
05515 cc_dim1] + tr2;
05516 ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) *
05517 cc_dim1];
05518 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
05519 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
05520 cc_dim1] + ti2;
05521 cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
05522 k * 3 + 2) * cc_dim1]);
05523 ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 +
05524 2) * cc_dim1]);
05525 dr2 = cr2 - ci3;
05526 dr3 = cr2 + ci3;
05527 di2 = ci2 + cr3;
05528 di3 = ci2 - cr3;
05529 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
05530 - wa1[i__ - 1] * di2;
05531 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
05532 wa1[i__ - 1] * dr2;
05533 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
05534 wa2[i__ - 1] * di3;
05535 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
05536 i__ - 1] * dr3;
05537
05538 }
05539
05540 }
05541 return 0;
05542 }
05543
05544 int fradb2_(integer *ido, integer *l1, real *cc, real *ch,
05545 real *wa1)
05546 {
05547
05548 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
05549
05550
05551 static integer i__, k, ic;
05552 static real ti2, tr2;
05553 static integer idp2;
05554
05555
05556
05557
05558 ch_dim1 = *ido;
05559 ch_dim2 = *l1;
05560 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
05561 ch -= ch_offset;
05562 cc_dim1 = *ido;
05563 cc_offset = cc_dim1 * 3 + 1;
05564 cc -= cc_offset;
05565 --wa1;
05566
05567
05568 i__1 = *l1;
05569 for (k = 1; k <= i__1; ++k) {
05570 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
05571 cc[*ido + ((k << 1) + 2) * cc_dim1];
05572 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
05573 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1];
05574
05575 }
05576 if ((i__1 = *ido - 2) < 0) {
05577 goto L107;
05578 } else if (i__1 == 0) {
05579 goto L105;
05580 } else {
05581 goto L102;
05582 }
05583 L102:
05584 idp2 = *ido + 2;
05585 i__1 = *l1;
05586 for (k = 1; k <= i__1; ++k) {
05587 i__2 = *ido;
05588 for (i__ = 3; i__ <= i__2; i__ += 2) {
05589 ic = idp2 - i__;
05590 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
05591 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
05592 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
05593 1) + 2) * cc_dim1];
05594 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
05595 cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
05596 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2)
05597 * cc_dim1];
05598 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2
05599 - wa1[i__ - 1] * ti2;
05600 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 +
05601 wa1[i__ - 1] * tr2;
05602
05603 }
05604
05605 }
05606 if (*ido % 2 == 1) {
05607 return 0;
05608 }
05609 L105:
05610 i__1 = *l1;
05611 for (k = 1; k <= i__1; ++k) {
05612 ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) *
05613 cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1];
05614 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) *
05615 cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
05616
05617 }
05618 L107:
05619 return 0;
05620 }
05621
05622 int fradb4_(integer *ido, integer *l1, real *cc, real *ch,
05623 real *wa1, real *wa2, real *wa3)
05624 {
05625
05626
05627 static real sqrt2 = (float)1.414213562373095;
05628
05629
05630 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
05631
05632
05633 static integer i__, k, ic;
05634 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
05635 tr3, tr4;
05636 static integer idp2;
05637
05638
05639
05640
05641 ch_dim1 = *ido;
05642 ch_dim2 = *l1;
05643 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
05644 ch -= ch_offset;
05645 cc_dim1 = *ido;
05646 cc_offset = cc_dim1 * 5 + 1;
05647 cc -= cc_offset;
05648 --wa1;
05649 --wa2;
05650 --wa3;
05651
05652
05653 i__1 = *l1;
05654 for (k = 1; k <= i__1; ++k) {
05655 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) *
05656 cc_dim1];
05657 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) *
05658 cc_dim1];
05659 tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) *
05660 cc_dim1];
05661 tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
05662 + 1];
05663 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
05664 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
05665 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
05666 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
05667
05668 }
05669 if ((i__1 = *ido - 2) < 0) {
05670 goto L107;
05671 } else if (i__1 == 0) {
05672 goto L105;
05673 } else {
05674 goto L102;
05675 }
05676 L102:
05677 idp2 = *ido + 2;
05678 i__1 = *l1;
05679 for (k = 1; k <= i__1; ++k) {
05680 i__2 = *ido;
05681 for (i__ = 3; i__ <= i__2; i__ += 2) {
05682 ic = idp2 - i__;
05683 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4)
05684 * cc_dim1];
05685 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4)
05686 * cc_dim1];
05687 ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2)
05688 * cc_dim1];
05689 tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2)
05690 * cc_dim1];
05691 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
05692 2) + 4) * cc_dim1];
05693 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k <<
05694 2) + 4) * cc_dim1];
05695 ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k <<
05696 2) + 2) * cc_dim1];
05697 tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k <<
05698 2) + 2) * cc_dim1];
05699 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
05700 cr3 = tr2 - tr3;
05701 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
05702 ci3 = ti2 - ti3;
05703 cr2 = tr1 - tr4;
05704 cr4 = tr1 + tr4;
05705 ci2 = ti1 + ti4;
05706 ci4 = ti1 - ti4;
05707 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2
05708 - wa1[i__ - 1] * ci2;
05709 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 +
05710 wa1[i__ - 1] * cr2;
05711 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 -
05712 wa2[i__ - 1] * ci3;
05713 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
05714 i__ - 1] * cr3;
05715 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4
05716 - wa3[i__ - 1] * ci4;
05717 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 +
05718 wa3[i__ - 1] * cr4;
05719
05720 }
05721
05722 }
05723 if (*ido % 2 == 1) {
05724 return 0;
05725 }
05726 L105:
05727 i__1 = *l1;
05728 for (k = 1; k <= i__1; ++k) {
05729 ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
05730 + 1];
05731 ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
05732 + 1];
05733 tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) *
05734 cc_dim1];
05735 tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) *
05736 cc_dim1];
05737 ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2;
05738 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1);
05739 ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2;
05740 ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1);
05741
05742 }
05743 L107:
05744 return 0;
05745 }
05746
05747 int fcffti_(integer *n, real *wsave)
05748 {
05749 static integer iw1, iw2;
05750 extern int fcffti1_(integer *, real *, real *);
05751
05752
05753
05754
05755 --wsave;
05756
05757
05758 if (*n == 1) {
05759 return 0;
05760 }
05761 iw1 = *n + *n + 1;
05762 iw2 = iw1 + *n + *n;
05763 fcffti1_(n, &wsave[iw1], &wsave[iw2]);
05764 return 0;
05765 }
05766
05767 int fcffti1_(integer *n, real *wa, integer *ifac)
05768 {
05769
05770
05771 static integer ntryh[4] = { 3,4,2,5 };
05772
05773
05774 integer i__1, i__2, i__3;
05775
05776
05777 double cos(doublereal), sin(doublereal);
05778
05779
05780 static real argh;
05781 static integer idot, ntry, i__, j;
05782 static real argld;
05783 static integer i1, k1, l1, l2, ib;
05784 static real fi;
05785 static integer ld, ii, nf, ip, nl, nq, nr;
05786 static real arg;
05787 static integer ido, ipm;
05788 static real tpi;
05789
05790
05791
05792
05793 --ifac;
05794 --wa;
05795
05796
05797 nl = *n;
05798 nf = 0;
05799 j = 0;
05800 L101:
05801 ++j;
05802 if (j - 4 <= 0) {
05803 goto L102;
05804 } else {
05805 goto L103;
05806 }
05807 L102:
05808 ntry = ntryh[j - 1];
05809 goto L104;
05810 L103:
05811 ntry += 2;
05812 L104:
05813 nq = nl / ntry;
05814 nr = nl - ntry * nq;
05815 if (nr != 0) {
05816 goto L101;
05817 } else {
05818 goto L105;
05819 }
05820 L105:
05821 ++nf;
05822 ifac[nf + 2] = ntry;
05823 nl = nq;
05824 if (ntry != 2) {
05825 goto L107;
05826 }
05827 if (nf == 1) {
05828 goto L107;
05829 }
05830 i__1 = nf;
05831 for (i__ = 2; i__ <= i__1; ++i__) {
05832 ib = nf - i__ + 2;
05833 ifac[ib + 2] = ifac[ib + 1];
05834
05835 }
05836 ifac[3] = 2;
05837 L107:
05838 if (nl != 1) {
05839 goto L104;
05840 }
05841 ifac[1] = *n;
05842 ifac[2] = nf;
05843 tpi = (float)6.28318530717959;
05844 argh = tpi / (real) (*n);
05845 i__ = 2;
05846 l1 = 1;
05847 i__1 = nf;
05848 for (k1 = 1; k1 <= i__1; ++k1) {
05849 ip = ifac[k1 + 2];
05850 ld = 0;
05851 l2 = l1 * ip;
05852 ido = *n / l2;
05853 idot = ido + ido + 2;
05854 ipm = ip - 1;
05855 i__2 = ipm;
05856 for (j = 1; j <= i__2; ++j) {
05857 i1 = i__;
05858 wa[i__ - 1] = (float)1.;
05859 wa[i__] = (float)0.;
05860 ld += l1;
05861 fi = (float)0.;
05862 argld = (real) ld * argh;
05863 i__3 = idot;
05864 for (ii = 4; ii <= i__3; ii += 2) {
05865 i__ += 2;
05866 fi += (float)1.;
05867 arg = fi * argld;
05868 wa[i__ - 1] = cos(arg);
05869 wa[i__] = sin(arg);
05870
05871 }
05872 if (ip <= 5) {
05873 goto L109;
05874 }
05875 wa[i1 - 1] = wa[i__ - 1];
05876 wa[i1] = wa[i__];
05877 L109:
05878 ;
05879 }
05880 l1 = l2;
05881
05882 }
05883 return 0;
05884 }
05885
05886 int fcfftf_(integer *n, real *c__, real *wsave)
05887 {
05888 extern int fcfftf1_(integer *, real *, real *, real *,
05889 real *);
05890 static integer iw1, iw2;
05891
05892
05893
05894
05895 --wsave;
05896 --c__;
05897
05898
05899 if (*n == 1) {
05900 return 0;
05901 }
05902 iw1 = *n + *n + 1;
05903 iw2 = iw1 + *n + *n;
05904 fcfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
05905 return 0;
05906 }
05907
05908 int fcfftf1_(integer *n, real *c__, real *ch, real *wa,
05909 integer *ifac)
05910 {
05911
05912 integer i__1;
05913
05914
05915 static integer idot, i__, k1, l1, l2, n2, na, nf, ip, iw;
05916 extern int fpassf_(integer *, integer *, integer *,
05917 integer *, integer *, real *, real *, real *, real *, real *,
05918 real *);
05919 static integer ix2, ix3, ix4;
05920 extern int fpassf2_(integer *, integer *, real *, real *,
05921 real *), fpassf3_(integer *, integer *, real *, real *, real *,
05922 real *), fpassf4_(integer *, integer *, real *, real *, real *,
05923 real *, real *), fpassf5_(integer *, integer *, real *, real *,
05924 real *, real *, real *, real *);
05925 static integer nac, ido, idl1;
05926
05927
05928
05929
05930 --ifac;
05931 --wa;
05932 --ch;
05933 --c__;
05934
05935
05936 nf = ifac[2];
05937 na = 0;
05938 l1 = 1;
05939 iw = 1;
05940 i__1 = nf;
05941 for (k1 = 1; k1 <= i__1; ++k1) {
05942 ip = ifac[k1 + 2];
05943 l2 = ip * l1;
05944 ido = *n / l2;
05945 idot = ido + ido;
05946 idl1 = idot * l1;
05947 if (ip != 4) {
05948 goto L103;
05949 }
05950 ix2 = iw + idot;
05951 ix3 = ix2 + idot;
05952 if (na != 0) {
05953 goto L101;
05954 }
05955 fpassf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
05956 goto L102;
05957 L101:
05958 fpassf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
05959 L102:
05960 na = 1 - na;
05961 goto L115;
05962 L103:
05963 if (ip != 2) {
05964 goto L106;
05965 }
05966 if (na != 0) {
05967 goto L104;
05968 }
05969 fpassf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
05970 goto L105;
05971 L104:
05972 fpassf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
05973 L105:
05974 na = 1 - na;
05975 goto L115;
05976 L106:
05977 if (ip != 3) {
05978 goto L109;
05979 }
05980 ix2 = iw + idot;
05981 if (na != 0) {
05982 goto L107;
05983 }
05984 fpassf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
05985 goto L108;
05986 L107:
05987 fpassf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
05988 L108:
05989 na = 1 - na;
05990 goto L115;
05991 L109:
05992 if (ip != 5) {
05993 goto L112;
05994 }
05995 ix2 = iw + idot;
05996 ix3 = ix2 + idot;
05997 ix4 = ix3 + idot;
05998 if (na != 0) {
05999 goto L110;
06000 }
06001 fpassf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &
06002 wa[ix4]);
06003 goto L111;
06004 L110:
06005 fpassf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &
06006 wa[ix4]);
06007 L111:
06008 na = 1 - na;
06009 goto L115;
06010 L112:
06011 if (na != 0) {
06012 goto L113;
06013 }
06014 fpassf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[
06015 1], &ch[1], &wa[iw]);
06016 goto L114;
06017 L113:
06018 fpassf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
06019 &c__[1], &wa[iw]);
06020 L114:
06021 if (nac != 0) {
06022 na = 1 - na;
06023 }
06024 L115:
06025 l1 = l2;
06026 iw += (ip - 1) * idot;
06027
06028 }
06029 if (na == 0) {
06030 return 0;
06031 }
06032 n2 = *n + *n;
06033 i__1 = n2;
06034 for (i__ = 1; i__ <= i__1; ++i__) {
06035 c__[i__] = ch[i__];
06036
06037 }
06038 return 0;
06039 }
06040
06041 int fpassf_(integer *nac, integer *ido, integer *ip, integer
06042 *l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2,
06043 real *wa)
06044 {
06045
06046 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
06047 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
06048 i__1, i__2, i__3;
06049
06050
06051 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
06052 idl, inc, idp;
06053 static real wai, war;
06054 static integer ipp2;
06055
06056
06057
06058
06059 ch_dim1 = *ido;
06060 ch_dim2 = *l1;
06061 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06062 ch -= ch_offset;
06063 c1_dim1 = *ido;
06064 c1_dim2 = *l1;
06065 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
06066 c1 -= c1_offset;
06067 cc_dim1 = *ido;
06068 cc_dim2 = *ip;
06069 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
06070 cc -= cc_offset;
06071 ch2_dim1 = *idl1;
06072 ch2_offset = ch2_dim1 + 1;
06073 ch2 -= ch2_offset;
06074 c2_dim1 = *idl1;
06075 c2_offset = c2_dim1 + 1;
06076 c2 -= c2_offset;
06077 --wa;
06078
06079
06080 idot = *ido / 2;
06081 nt = *ip * *idl1;
06082 ipp2 = *ip + 2;
06083 ipph = (*ip + 1) / 2;
06084 idp = *ip * *ido;
06085
06086 if (*ido < *l1) {
06087 goto L106;
06088 }
06089 i__1 = ipph;
06090 for (j = 2; j <= i__1; ++j) {
06091 jc = ipp2 - j;
06092 i__2 = *l1;
06093 for (k = 1; k <= i__2; ++k) {
06094 i__3 = *ido;
06095 for (i__ = 1; i__ <= i__3; ++i__) {
06096 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06097 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
06098 cc_dim1];
06099 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06100 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
06101 cc_dim1];
06102
06103 }
06104
06105 }
06106
06107 }
06108 i__1 = *l1;
06109 for (k = 1; k <= i__1; ++k) {
06110 i__2 = *ido;
06111 for (i__ = 1; i__ <= i__2; ++i__) {
06112 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
06113 cc_dim1];
06114
06115 }
06116
06117 }
06118 goto L112;
06119 L106:
06120 i__1 = ipph;
06121 for (j = 2; j <= i__1; ++j) {
06122 jc = ipp2 - j;
06123 i__2 = *ido;
06124 for (i__ = 1; i__ <= i__2; ++i__) {
06125 i__3 = *l1;
06126 for (k = 1; k <= i__3; ++k) {
06127 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06128 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
06129 cc_dim1];
06130 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06131 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
06132 cc_dim1];
06133
06134 }
06135
06136 }
06137
06138 }
06139 i__1 = *ido;
06140 for (i__ = 1; i__ <= i__1; ++i__) {
06141 i__2 = *l1;
06142 for (k = 1; k <= i__2; ++k) {
06143 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
06144 cc_dim1];
06145
06146 }
06147
06148 }
06149 L112:
06150 idl = 2 - *ido;
06151 inc = 0;
06152 i__1 = ipph;
06153 for (l = 2; l <= i__1; ++l) {
06154 lc = ipp2 - l;
06155 idl += *ido;
06156 i__2 = *idl1;
06157 for (ik = 1; ik <= i__2; ++ik) {
06158 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
06159 + (ch2_dim1 << 1)];
06160 c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1];
06161
06162 }
06163 idlj = idl;
06164 inc += *ido;
06165 i__2 = ipph;
06166 for (j = 3; j <= i__2; ++j) {
06167 jc = ipp2 - j;
06168 idlj += inc;
06169 if (idlj > idp) {
06170 idlj -= idp;
06171 }
06172 war = wa[idlj - 1];
06173 wai = wa[idlj];
06174 i__3 = *idl1;
06175 for (ik = 1; ik <= i__3; ++ik) {
06176 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
06177 c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
06178
06179 }
06180
06181 }
06182
06183 }
06184 i__1 = ipph;
06185 for (j = 2; j <= i__1; ++j) {
06186 i__2 = *idl1;
06187 for (ik = 1; ik <= i__2; ++ik) {
06188 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
06189
06190 }
06191
06192 }
06193 i__1 = ipph;
06194 for (j = 2; j <= i__1; ++j) {
06195 jc = ipp2 - j;
06196 i__2 = *idl1;
06197 for (ik = 2; ik <= i__2; ik += 2) {
06198 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
06199 jc * c2_dim1];
06200 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
06201 jc * c2_dim1];
06202 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
06203 c2_dim1];
06204 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
06205 c2_dim1];
06206
06207 }
06208
06209 }
06210 *nac = 1;
06211 if (*ido == 2) {
06212 return 0;
06213 }
06214 *nac = 0;
06215 i__1 = *idl1;
06216 for (ik = 1; ik <= i__1; ++ik) {
06217 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
06218
06219 }
06220 i__1 = *ip;
06221 for (j = 2; j <= i__1; ++j) {
06222 i__2 = *l1;
06223 for (k = 1; k <= i__2; ++k) {
06224 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
06225 ch_dim1 + 1];
06226 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
06227 ch_dim1 + 2];
06228
06229 }
06230
06231 }
06232 if (idot > *l1) {
06233 goto L127;
06234 }
06235 idij = 0;
06236 i__1 = *ip;
06237 for (j = 2; j <= i__1; ++j) {
06238 idij += 2;
06239 i__2 = *ido;
06240 for (i__ = 4; i__ <= i__2; i__ += 2) {
06241 idij += 2;
06242 i__3 = *l1;
06243 for (k = 1; k <= i__3; ++k) {
06244 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
06245 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
06246 ch[i__ + (k + j * ch_dim2) * ch_dim1];
06247 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
06248 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
06249 1 + (k + j * ch_dim2) * ch_dim1];
06250
06251 }
06252
06253 }
06254
06255 }
06256 return 0;
06257 L127:
06258 idj = 2 - *ido;
06259 i__1 = *ip;
06260 for (j = 2; j <= i__1; ++j) {
06261 idj += *ido;
06262 i__2 = *l1;
06263 for (k = 1; k <= i__2; ++k) {
06264 idij = idj;
06265 i__3 = *ido;
06266 for (i__ = 4; i__ <= i__3; i__ += 2) {
06267 idij += 2;
06268 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
06269 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
06270 ch[i__ + (k + j * ch_dim2) * ch_dim1];
06271 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
06272 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
06273 1 + (k + j * ch_dim2) * ch_dim1];
06274
06275 }
06276
06277 }
06278
06279 }
06280 return 0;
06281 }
06282
06283 int fpassf5_(integer *ido, integer *l1, real *cc, real *ch,
06284 real *wa1, real *wa2, real *wa3, real *wa4)
06285 {
06286
06287
06288 static real tr11 = (float).309016994374947;
06289 static real ti11 = (float)-.951056516295154;
06290 static real tr12 = (float)-.809016994374947;
06291 static real ti12 = (float)-.587785252292473;
06292
06293
06294 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
06295
06296
06297 static integer i__, k;
06298 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
06299 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
06300
06301
06302
06303
06304 ch_dim1 = *ido;
06305 ch_dim2 = *l1;
06306 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06307 ch -= ch_offset;
06308 cc_dim1 = *ido;
06309 cc_offset = cc_dim1 * 6 + 1;
06310 cc -= cc_offset;
06311 --wa1;
06312 --wa2;
06313 --wa3;
06314 --wa4;
06315
06316
06317 if (*ido != 2) {
06318 goto L102;
06319 }
06320 i__1 = *l1;
06321 for (k = 1; k <= i__1; ++k) {
06322 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
06323 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
06324 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
06325 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
06326 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
06327 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
06328 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
06329 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
06330 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
06331 + tr3;
06332 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
06333 + ti3;
06334 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
06335 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
06336 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
06337 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
06338 cr5 = ti11 * tr5 + ti12 * tr4;
06339 ci5 = ti11 * ti5 + ti12 * ti4;
06340 cr4 = ti12 * tr5 - ti11 * tr4;
06341 ci4 = ti12 * ti5 - ti11 * ti4;
06342 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
06343 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
06344 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
06345 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
06346 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
06347 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
06348 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
06349 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
06350
06351 }
06352 return 0;
06353 L102:
06354 i__1 = *l1;
06355 for (k = 1; k <= i__1; ++k) {
06356 i__2 = *ido;
06357 for (i__ = 2; i__ <= i__2; i__ += 2) {
06358 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
06359 cc_dim1];
06360 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
06361 cc_dim1];
06362 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
06363 cc_dim1];
06364 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
06365 cc_dim1];
06366 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
06367 5) * cc_dim1];
06368 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
06369 5) * cc_dim1];
06370 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
06371 4) * cc_dim1];
06372 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
06373 4) * cc_dim1];
06374 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
06375 cc_dim1] + tr2 + tr3;
06376 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
06377 cc_dim1] + ti2 + ti3;
06378 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
06379 tr3;
06380 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
06381 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
06382 tr3;
06383 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
06384 cr5 = ti11 * tr5 + ti12 * tr4;
06385 ci5 = ti11 * ti5 + ti12 * ti4;
06386 cr4 = ti12 * tr5 - ti11 * tr4;
06387 ci4 = ti12 * ti5 - ti11 * ti4;
06388 dr3 = cr3 - ci4;
06389 dr4 = cr3 + ci4;
06390 di3 = ci3 + cr4;
06391 di4 = ci3 - cr4;
06392 dr5 = cr2 + ci5;
06393 dr2 = cr2 - ci5;
06394 di5 = ci2 - cr5;
06395 di2 = ci2 + cr5;
06396 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
06397 + wa1[i__] * di2;
06398 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
06399 wa1[i__] * dr2;
06400 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
06401 wa2[i__] * di3;
06402 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
06403 i__] * dr3;
06404 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
06405 + wa3[i__] * di4;
06406 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 -
06407 wa3[i__] * dr4;
06408 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 +
06409 wa4[i__] * di5;
06410 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
06411 i__] * dr5;
06412
06413 }
06414
06415 }
06416 return 0;
06417 }
06418
06419 int fpassf3_(integer *ido, integer *l1, real *cc, real *ch,
06420 real *wa1, real *wa2)
06421 {
06422
06423
06424 static real taur = (float)-.5;
06425 static real taui = (float)-.866025403784439;
06426
06427
06428 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
06429
06430
06431 static integer i__, k;
06432 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
06433
06434
06435
06436
06437 ch_dim1 = *ido;
06438 ch_dim2 = *l1;
06439 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06440 ch -= ch_offset;
06441 cc_dim1 = *ido;
06442 cc_offset = (cc_dim1 << 2) + 1;
06443 cc -= cc_offset;
06444 --wa1;
06445 --wa2;
06446
06447
06448 if (*ido != 2) {
06449 goto L102;
06450 }
06451 i__1 = *l1;
06452 for (k = 1; k <= i__1; ++k) {
06453 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
06454 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
06455 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
06456 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
06457 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
06458 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
06459 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
06460 cc_dim1 + 1]);
06461 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
06462 cc_dim1 + 2]);
06463 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
06464 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
06465 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
06466 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
06467
06468 }
06469 return 0;
06470 L102:
06471 i__1 = *l1;
06472 for (k = 1; k <= i__1; ++k) {
06473 i__2 = *ido;
06474 for (i__ = 2; i__ <= i__2; i__ += 2) {
06475 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
06476 3) * cc_dim1];
06477 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
06478 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
06479 cc_dim1] + tr2;
06480 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
06481 cc_dim1];
06482 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
06483 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
06484 cc_dim1] + ti2;
06485 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
06486 k * 3 + 3) * cc_dim1]);
06487 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
06488 3) * cc_dim1]);
06489 dr2 = cr2 - ci3;
06490 dr3 = cr2 + ci3;
06491 di2 = ci2 + cr3;
06492 di3 = ci2 - cr3;
06493 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
06494 wa1[i__] * dr2;
06495 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
06496 + wa1[i__] * di2;
06497 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
06498 i__] * dr3;
06499 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
06500 wa2[i__] * di3;
06501
06502 }
06503
06504 }
06505 return 0;
06506 }
06507
06508 int fpassf2_(integer *ido, integer *l1, real *cc, real *ch,
06509 real *wa1)
06510 {
06511
06512 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
06513
06514
06515 static integer i__, k;
06516 static real ti2, tr2;
06517
06518
06519
06520
06521 ch_dim1 = *ido;
06522 ch_dim2 = *l1;
06523 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06524 ch -= ch_offset;
06525 cc_dim1 = *ido;
06526 cc_offset = cc_dim1 * 3 + 1;
06527 cc -= cc_offset;
06528 --wa1;
06529
06530
06531 if (*ido > 2) {
06532 goto L102;
06533 }
06534 i__1 = *l1;
06535 for (k = 1; k <= i__1; ++k) {
06536 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
06537 cc[((k << 1) + 2) * cc_dim1 + 1];
06538 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
06539 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
06540 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
06541 cc[((k << 1) + 2) * cc_dim1 + 2];
06542 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
06543 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
06544
06545 }
06546 return 0;
06547 L102:
06548 i__1 = *l1;
06549 for (k = 1; k <= i__1; ++k) {
06550 i__2 = *ido;
06551 for (i__ = 2; i__ <= i__2; i__ += 2) {
06552 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
06553 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
06554 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
06555 1) + 2) * cc_dim1];
06556 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
06557 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
06558 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
06559 * cc_dim1];
06560 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 -
06561 wa1[i__] * tr2;
06562 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
06563 + wa1[i__] * ti2;
06564
06565 }
06566
06567 }
06568 return 0;
06569 }
06570
06571 int fpassf4_(integer *ido, integer *l1, real *cc, real *ch,
06572 real *wa1, real *wa2, real *wa3)
06573 {
06574
06575 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
06576
06577
06578 static integer i__, k;
06579 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
06580 tr3, tr4;
06581
06582
06583
06584
06585 ch_dim1 = *ido;
06586 ch_dim2 = *l1;
06587 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06588 ch -= ch_offset;
06589 cc_dim1 = *ido;
06590 cc_offset = cc_dim1 * 5 + 1;
06591 cc -= cc_offset;
06592 --wa1;
06593 --wa2;
06594 --wa3;
06595
06596
06597 if (*ido != 2) {
06598 goto L102;
06599 }
06600 i__1 = *l1;
06601 for (k = 1; k <= i__1; ++k) {
06602 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
06603 + 2];
06604 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
06605 + 2];
06606 tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1
06607 + 2];
06608 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
06609 + 2];
06610 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
06611 + 1];
06612 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
06613 + 1];
06614 ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
06615 + 1];
06616 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
06617 + 1];
06618 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
06619 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
06620 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
06621 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
06622 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
06623 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
06624 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
06625 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
06626
06627 }
06628 return 0;
06629 L102:
06630 i__1 = *l1;
06631 for (k = 1; k <= i__1; ++k) {
06632 i__2 = *ido;
06633 for (i__ = 2; i__ <= i__2; i__ += 2) {
06634 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
06635 * cc_dim1];
06636 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
06637 * cc_dim1];
06638 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
06639 * cc_dim1];
06640 tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
06641 * cc_dim1];
06642 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
06643 2) + 3) * cc_dim1];
06644 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
06645 2) + 3) * cc_dim1];
06646 ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
06647 2) + 2) * cc_dim1];
06648 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
06649 2) + 4) * cc_dim1];
06650 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
06651 cr3 = tr2 - tr3;
06652 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
06653 ci3 = ti2 - ti3;
06654 cr2 = tr1 + tr4;
06655 cr4 = tr1 - tr4;
06656 ci2 = ti1 + ti4;
06657 ci4 = ti1 - ti4;
06658 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
06659 + wa1[i__] * ci2;
06660 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 -
06661 wa1[i__] * cr2;
06662 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 +
06663 wa2[i__] * ci3;
06664 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
06665 i__] * cr3;
06666 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
06667 + wa3[i__] * ci4;
06668 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 -
06669 wa3[i__] * cr4;
06670
06671 }
06672
06673 }
06674 return 0;
06675 }
06676
06677 int fcfftb_(integer *n, real *c__, real *wsave)
06678 {
06679 extern int fcfftb1_(integer *, real *, real *, real *,
06680 real *);
06681 static integer iw1, iw2;
06682
06683
06684
06685
06686 --wsave;
06687 --c__;
06688
06689
06690 if (*n == 1) {
06691 return 0;
06692 }
06693 iw1 = *n + *n + 1;
06694 iw2 = iw1 + *n + *n;
06695 fcfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
06696 return 0;
06697 }
06698
06699 int fcfftb1_(integer *n, real *c__, real *ch, real *wa,
06700 integer *ifac)
06701 {
06702
06703 integer i__1;
06704
06705
06706 static integer idot, i__, k1, l1, l2, n2, na, nf, ip, iw;
06707 extern int fpassb_(integer *, integer *, integer *,
06708 integer *, integer *, real *, real *, real *, real *, real *,
06709 real *);
06710 static integer ix2, ix3, ix4;
06711 extern int fpassb2_(integer *, integer *, real *, real *,
06712 real *), fpassb3_(integer *, integer *, real *, real *, real *,
06713 real *), fpassb4_(integer *, integer *, real *, real *, real *,
06714 real *, real *), fpassb5_(integer *, integer *, real *, real *,
06715 real *, real *, real *, real *);
06716 static integer nac, ido, idl1;
06717
06718
06719
06720
06721 --ifac;
06722 --wa;
06723 --ch;
06724 --c__;
06725
06726
06727 nf = ifac[2];
06728 na = 0;
06729 l1 = 1;
06730 iw = 1;
06731 i__1 = nf;
06732 for (k1 = 1; k1 <= i__1; ++k1) {
06733 ip = ifac[k1 + 2];
06734 l2 = ip * l1;
06735 ido = *n / l2;
06736 idot = ido + ido;
06737 idl1 = idot * l1;
06738 if (ip != 4) {
06739 goto L103;
06740 }
06741 ix2 = iw + idot;
06742 ix3 = ix2 + idot;
06743 if (na != 0) {
06744 goto L101;
06745 }
06746 fpassb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
06747 goto L102;
06748 L101:
06749 fpassb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
06750 L102:
06751 na = 1 - na;
06752 goto L115;
06753 L103:
06754 if (ip != 2) {
06755 goto L106;
06756 }
06757 if (na != 0) {
06758 goto L104;
06759 }
06760 fpassb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
06761 goto L105;
06762 L104:
06763 fpassb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
06764 L105:
06765 na = 1 - na;
06766 goto L115;
06767 L106:
06768 if (ip != 3) {
06769 goto L109;
06770 }
06771 ix2 = iw + idot;
06772 if (na != 0) {
06773 goto L107;
06774 }
06775 fpassb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
06776 goto L108;
06777 L107:
06778 fpassb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
06779 L108:
06780 na = 1 - na;
06781 goto L115;
06782 L109:
06783 if (ip != 5) {
06784 goto L112;
06785 }
06786 ix2 = iw + idot;
06787 ix3 = ix2 + idot;
06788 ix4 = ix3 + idot;
06789 if (na != 0) {
06790 goto L110;
06791 }
06792 fpassb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &
06793 wa[ix4]);
06794 goto L111;
06795 L110:
06796 fpassb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &
06797 wa[ix4]);
06798 L111:
06799 na = 1 - na;
06800 goto L115;
06801 L112:
06802 if (na != 0) {
06803 goto L113;
06804 }
06805 fpassb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[
06806 1], &ch[1], &wa[iw]);
06807 goto L114;
06808 L113:
06809 fpassb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
06810 &c__[1], &wa[iw]);
06811 L114:
06812 if (nac != 0) {
06813 na = 1 - na;
06814 }
06815 L115:
06816 l1 = l2;
06817 iw += (ip - 1) * idot;
06818
06819 }
06820 if (na == 0) {
06821 return 0;
06822 }
06823 n2 = *n + *n;
06824 i__1 = n2;
06825 for (i__ = 1; i__ <= i__1; ++i__) {
06826 c__[i__] = ch[i__];
06827
06828 }
06829 return 0;
06830 }
06831
06832 int fpassb_(integer *nac, integer *ido, integer *ip, integer
06833 *l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2,
06834 real *wa)
06835 {
06836
06837 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
06838 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
06839 i__1, i__2, i__3;
06840
06841
06842 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
06843 idl, inc, idp;
06844 static real wai, war;
06845 static integer ipp2;
06846
06847
06848
06849
06850 ch_dim1 = *ido;
06851 ch_dim2 = *l1;
06852 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
06853 ch -= ch_offset;
06854 c1_dim1 = *ido;
06855 c1_dim2 = *l1;
06856 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
06857 c1 -= c1_offset;
06858 cc_dim1 = *ido;
06859 cc_dim2 = *ip;
06860 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
06861 cc -= cc_offset;
06862 ch2_dim1 = *idl1;
06863 ch2_offset = ch2_dim1 + 1;
06864 ch2 -= ch2_offset;
06865 c2_dim1 = *idl1;
06866 c2_offset = c2_dim1 + 1;
06867 c2 -= c2_offset;
06868 --wa;
06869
06870
06871 idot = *ido / 2;
06872 nt = *ip * *idl1;
06873 ipp2 = *ip + 2;
06874 ipph = (*ip + 1) / 2;
06875 idp = *ip * *ido;
06876
06877 if (*ido < *l1) {
06878 goto L106;
06879 }
06880 i__1 = ipph;
06881 for (j = 2; j <= i__1; ++j) {
06882 jc = ipp2 - j;
06883 i__2 = *l1;
06884 for (k = 1; k <= i__2; ++k) {
06885 i__3 = *ido;
06886 for (i__ = 1; i__ <= i__3; ++i__) {
06887 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06888 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
06889 cc_dim1];
06890 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06891 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
06892 cc_dim1];
06893
06894 }
06895
06896 }
06897
06898 }
06899 i__1 = *l1;
06900 for (k = 1; k <= i__1; ++k) {
06901 i__2 = *ido;
06902 for (i__ = 1; i__ <= i__2; ++i__) {
06903 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
06904 cc_dim1];
06905
06906 }
06907
06908 }
06909 goto L112;
06910 L106:
06911 i__1 = ipph;
06912 for (j = 2; j <= i__1; ++j) {
06913 jc = ipp2 - j;
06914 i__2 = *ido;
06915 for (i__ = 1; i__ <= i__2; ++i__) {
06916 i__3 = *l1;
06917 for (k = 1; k <= i__3; ++k) {
06918 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06919 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
06920 cc_dim1];
06921 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
06922 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
06923 cc_dim1];
06924
06925 }
06926
06927 }
06928
06929 }
06930 i__1 = *ido;
06931 for (i__ = 1; i__ <= i__1; ++i__) {
06932 i__2 = *l1;
06933 for (k = 1; k <= i__2; ++k) {
06934 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
06935 cc_dim1];
06936
06937 }
06938
06939 }
06940 L112:
06941 idl = 2 - *ido;
06942 inc = 0;
06943 i__1 = ipph;
06944 for (l = 2; l <= i__1; ++l) {
06945 lc = ipp2 - l;
06946 idl += *ido;
06947 i__2 = *idl1;
06948 for (ik = 1; ik <= i__2; ++ik) {
06949 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
06950 + (ch2_dim1 << 1)];
06951 c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1];
06952
06953 }
06954 idlj = idl;
06955 inc += *ido;
06956 i__2 = ipph;
06957 for (j = 3; j <= i__2; ++j) {
06958 jc = ipp2 - j;
06959 idlj += inc;
06960 if (idlj > idp) {
06961 idlj -= idp;
06962 }
06963 war = wa[idlj - 1];
06964 wai = wa[idlj];
06965 i__3 = *idl1;
06966 for (ik = 1; ik <= i__3; ++ik) {
06967 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
06968 c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
06969
06970 }
06971
06972 }
06973
06974 }
06975 i__1 = ipph;
06976 for (j = 2; j <= i__1; ++j) {
06977 i__2 = *idl1;
06978 for (ik = 1; ik <= i__2; ++ik) {
06979 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
06980
06981 }
06982
06983 }
06984 i__1 = ipph;
06985 for (j = 2; j <= i__1; ++j) {
06986 jc = ipp2 - j;
06987 i__2 = *idl1;
06988 for (ik = 2; ik <= i__2; ik += 2) {
06989 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
06990 jc * c2_dim1];
06991 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
06992 jc * c2_dim1];
06993 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
06994 c2_dim1];
06995 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
06996 c2_dim1];
06997
06998 }
06999
07000 }
07001 *nac = 1;
07002 if (*ido == 2) {
07003 return 0;
07004 }
07005 *nac = 0;
07006 i__1 = *idl1;
07007 for (ik = 1; ik <= i__1; ++ik) {
07008 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
07009
07010 }
07011 i__1 = *ip;
07012 for (j = 2; j <= i__1; ++j) {
07013 i__2 = *l1;
07014 for (k = 1; k <= i__2; ++k) {
07015 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
07016 ch_dim1 + 1];
07017 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
07018 ch_dim1 + 2];
07019
07020 }
07021
07022 }
07023 if (idot > *l1) {
07024 goto L127;
07025 }
07026 idij = 0;
07027 i__1 = *ip;
07028 for (j = 2; j <= i__1; ++j) {
07029 idij += 2;
07030 i__2 = *ido;
07031 for (i__ = 4; i__ <= i__2; i__ += 2) {
07032 idij += 2;
07033 i__3 = *l1;
07034 for (k = 1; k <= i__3; ++k) {
07035 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
07036 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
07037 ch[i__ + (k + j * ch_dim2) * ch_dim1];
07038 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
07039 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
07040 1 + (k + j * ch_dim2) * ch_dim1];
07041
07042 }
07043
07044 }
07045
07046 }
07047 return 0;
07048 L127:
07049 idj = 2 - *ido;
07050 i__1 = *ip;
07051 for (j = 2; j <= i__1; ++j) {
07052 idj += *ido;
07053 i__2 = *l1;
07054 for (k = 1; k <= i__2; ++k) {
07055 idij = idj;
07056 i__3 = *ido;
07057 for (i__ = 4; i__ <= i__3; i__ += 2) {
07058 idij += 2;
07059 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
07060 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
07061 ch[i__ + (k + j * ch_dim2) * ch_dim1];
07062 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
07063 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
07064 1 + (k + j * ch_dim2) * ch_dim1];
07065
07066 }
07067
07068 }
07069
07070 }
07071 return 0;
07072 }
07073
07074 int fpassb5_(integer *ido, integer *l1, real *cc, real *ch,
07075 real *wa1, real *wa2, real *wa3, real *wa4)
07076 {
07077
07078
07079 static real tr11 = (float).309016994374947;
07080 static real ti11 = (float).951056516295154;
07081 static real tr12 = (float)-.809016994374947;
07082 static real ti12 = (float).587785252292473;
07083
07084
07085 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
07086
07087
07088 static integer i__, k;
07089 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
07090 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
07091
07092
07093
07094
07095 ch_dim1 = *ido;
07096 ch_dim2 = *l1;
07097 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
07098 ch -= ch_offset;
07099 cc_dim1 = *ido;
07100 cc_offset = cc_dim1 * 6 + 1;
07101 cc -= cc_offset;
07102 --wa1;
07103 --wa2;
07104 --wa3;
07105 --wa4;
07106
07107
07108 if (*ido != 2) {
07109 goto L102;
07110 }
07111 i__1 = *l1;
07112 for (k = 1; k <= i__1; ++k) {
07113 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
07114 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
07115 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
07116 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
07117 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
07118 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
07119 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
07120 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
07121 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
07122 + tr3;
07123 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
07124 + ti3;
07125 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
07126 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
07127 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
07128 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
07129 cr5 = ti11 * tr5 + ti12 * tr4;
07130 ci5 = ti11 * ti5 + ti12 * ti4;
07131 cr4 = ti12 * tr5 - ti11 * tr4;
07132 ci4 = ti12 * ti5 - ti11 * ti4;
07133 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
07134 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
07135 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
07136 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
07137 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
07138 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
07139 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
07140 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
07141
07142 }
07143 return 0;
07144 L102:
07145 i__1 = *l1;
07146 for (k = 1; k <= i__1; ++k) {
07147 i__2 = *ido;
07148 for (i__ = 2; i__ <= i__2; i__ += 2) {
07149 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
07150 cc_dim1];
07151 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
07152 cc_dim1];
07153 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
07154 cc_dim1];
07155 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
07156 cc_dim1];
07157 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
07158 5) * cc_dim1];
07159 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
07160 5) * cc_dim1];
07161 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
07162 4) * cc_dim1];
07163 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
07164 4) * cc_dim1];
07165 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
07166 cc_dim1] + tr2 + tr3;
07167 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
07168 cc_dim1] + ti2 + ti3;
07169 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
07170 tr3;
07171 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
07172 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
07173 tr3;
07174 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
07175 cr5 = ti11 * tr5 + ti12 * tr4;
07176 ci5 = ti11 * ti5 + ti12 * ti4;
07177 cr4 = ti12 * tr5 - ti11 * tr4;
07178 ci4 = ti12 * ti5 - ti11 * ti4;
07179 dr3 = cr3 - ci4;
07180 dr4 = cr3 + ci4;
07181 di3 = ci3 + cr4;
07182 di4 = ci3 - cr4;
07183 dr5 = cr2 + ci5;
07184 dr2 = cr2 - ci5;
07185 di5 = ci2 - cr5;
07186 di2 = ci2 + cr5;
07187 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
07188 - wa1[i__] * di2;
07189 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
07190 wa1[i__] * dr2;
07191 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
07192 wa2[i__] * di3;
07193 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
07194 i__] * dr3;
07195 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
07196 - wa3[i__] * di4;
07197 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 +
07198 wa3[i__] * dr4;
07199 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 -
07200 wa4[i__] * di5;
07201 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
07202 i__] * dr5;
07203
07204 }
07205
07206 }
07207 return 0;
07208 }
07209
07210 int fpassb3_(integer *ido, integer *l1, real *cc, real *ch,
07211 real *wa1, real *wa2)
07212 {
07213
07214
07215 static real taur = (float)-.5;
07216 static real taui = (float).866025403784439;
07217
07218
07219 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
07220
07221
07222 static integer i__, k;
07223 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
07224
07225
07226
07227
07228 ch_dim1 = *ido;
07229 ch_dim2 = *l1;
07230 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
07231 ch -= ch_offset;
07232 cc_dim1 = *ido;
07233 cc_offset = (cc_dim1 << 2) + 1;
07234 cc -= cc_offset;
07235 --wa1;
07236 --wa2;
07237
07238
07239 if (*ido != 2) {
07240 goto L102;
07241 }
07242 i__1 = *l1;
07243 for (k = 1; k <= i__1; ++k) {
07244 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
07245 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
07246 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
07247 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
07248 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
07249 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
07250 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
07251 cc_dim1 + 1]);
07252 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
07253 cc_dim1 + 2]);
07254 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
07255 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
07256 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
07257 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
07258
07259 }
07260 return 0;
07261 L102:
07262 i__1 = *l1;
07263 for (k = 1; k <= i__1; ++k) {
07264 i__2 = *ido;
07265 for (i__ = 2; i__ <= i__2; i__ += 2) {
07266 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
07267 3) * cc_dim1];
07268 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
07269 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
07270 cc_dim1] + tr2;
07271 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
07272 cc_dim1];
07273 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
07274 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
07275 cc_dim1] + ti2;
07276 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
07277 k * 3 + 3) * cc_dim1]);
07278 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
07279 3) * cc_dim1]);
07280 dr2 = cr2 - ci3;
07281 dr3 = cr2 + ci3;
07282 di2 = ci2 + cr3;
07283 di3 = ci2 - cr3;
07284 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
07285 wa1[i__] * dr2;
07286 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
07287 - wa1[i__] * di2;
07288 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
07289 i__] * dr3;
07290 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
07291 wa2[i__] * di3;
07292
07293 }
07294
07295 }
07296 return 0;
07297 }
07298
07299 int fpassb2_(integer *ido, integer *l1, real *cc, real *ch,
07300 real *wa1)
07301 {
07302
07303 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
07304
07305
07306 static integer i__, k;
07307 static real ti2, tr2;
07308
07309
07310
07311
07312 ch_dim1 = *ido;
07313 ch_dim2 = *l1;
07314 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
07315 ch -= ch_offset;
07316 cc_dim1 = *ido;
07317 cc_offset = cc_dim1 * 3 + 1;
07318 cc -= cc_offset;
07319 --wa1;
07320
07321
07322 if (*ido > 2) {
07323 goto L102;
07324 }
07325 i__1 = *l1;
07326 for (k = 1; k <= i__1; ++k) {
07327 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
07328 cc[((k << 1) + 2) * cc_dim1 + 1];
07329 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
07330 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
07331 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
07332 cc[((k << 1) + 2) * cc_dim1 + 2];
07333 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
07334 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
07335
07336 }
07337 return 0;
07338 L102:
07339 i__1 = *l1;
07340 for (k = 1; k <= i__1; ++k) {
07341 i__2 = *ido;
07342 for (i__ = 2; i__ <= i__2; i__ += 2) {
07343 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
07344 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
07345 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
07346 1) + 2) * cc_dim1];
07347 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
07348 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
07349 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
07350 * cc_dim1];
07351 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 +
07352 wa1[i__] * tr2;
07353 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
07354 - wa1[i__] * ti2;
07355
07356 }
07357
07358 }
07359 return 0;
07360 }
07361
07362 int fpassb4_(integer *ido, integer *l1, real *cc, real *ch,
07363 real *wa1, real *wa2, real *wa3)
07364 {
07365
07366 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
07367
07368
07369 static integer i__, k;
07370 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
07371 tr3, tr4;
07372
07373
07374
07375
07376 ch_dim1 = *ido;
07377 ch_dim2 = *l1;
07378 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
07379 ch -= ch_offset;
07380 cc_dim1 = *ido;
07381 cc_offset = cc_dim1 * 5 + 1;
07382 cc -= cc_offset;
07383 --wa1;
07384 --wa2;
07385 --wa3;
07386
07387
07388 if (*ido != 2) {
07389 goto L102;
07390 }
07391 i__1 = *l1;
07392 for (k = 1; k <= i__1; ++k) {
07393 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
07394 + 2];
07395 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
07396 + 2];
07397 tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1
07398 + 2];
07399 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
07400 + 2];
07401 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
07402 + 1];
07403 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
07404 + 1];
07405 ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1
07406 + 1];
07407 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
07408 + 1];
07409 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
07410 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
07411 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
07412 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
07413 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
07414 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
07415 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
07416 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
07417
07418 }
07419 return 0;
07420 L102:
07421 i__1 = *l1;
07422 for (k = 1; k <= i__1; ++k) {
07423 i__2 = *ido;
07424 for (i__ = 2; i__ <= i__2; i__ += 2) {
07425 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
07426 * cc_dim1];
07427 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
07428 * cc_dim1];
07429 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
07430 * cc_dim1];
07431 tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
07432 * cc_dim1];
07433 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
07434 2) + 3) * cc_dim1];
07435 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
07436 2) + 3) * cc_dim1];
07437 ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
07438 2) + 4) * cc_dim1];
07439 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
07440 2) + 4) * cc_dim1];
07441 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
07442 cr3 = tr2 - tr3;
07443 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
07444 ci3 = ti2 - ti3;
07445 cr2 = tr1 + tr4;
07446 cr4 = tr1 - tr4;
07447 ci2 = ti1 + ti4;
07448 ci4 = ti1 - ti4;
07449 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
07450 - wa1[i__] * ci2;
07451 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 +
07452 wa1[i__] * cr2;
07453 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 -
07454 wa2[i__] * ci3;
07455 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
07456 i__] * cr3;
07457 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
07458 - wa3[i__] * ci4;
07459 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 +
07460 wa3[i__] * cr4;
07461
07462 }
07463
07464 }
07465 return 0;
07466 }
07467
07468 int fsinti_(integer *n, real *wsave)
07469 {
07470
07471
07472 static real pi = (float)3.14159265358979;
07473
07474
07475 integer i__1;
07476
07477
07478 double sin(doublereal);
07479
07480
07481 static integer k;
07482 static real dt;
07483 extern int frffti_(integer *, real *);
07484 static integer np1, ns2;
07485
07486
07487
07488
07489 --wsave;
07490
07491
07492 if (*n <= 1) {
07493 return 0;
07494 }
07495 ns2 = *n / 2;
07496 np1 = *n + 1;
07497 dt = pi / (real) np1;
07498 i__1 = ns2;
07499 for (k = 1; k <= i__1; ++k) {
07500 wsave[k] = sin(k * dt) * (float)2.;
07501
07502 }
07503 frffti_(&np1, &wsave[ns2 + 1]);
07504 return 0;
07505 }
07506
07507 int fsint_(integer *n, real *x, real *wsave)
07508 {
07509 extern int fsint1_(integer *, real *, real *, real *,
07510 real *, real *);
07511 static integer np1, iw1, iw2, iw3;
07512
07513
07514
07515
07516 --wsave;
07517 --x;
07518
07519
07520 np1 = *n + 1;
07521 iw1 = *n / 2 + 1;
07522 iw2 = iw1 + np1;
07523 iw3 = iw2 + np1;
07524 fsint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], &wsave[iw3]);
07525 return 0;
07526 }
07527
07528 int fsint1_(integer *n, real *war, real *was, real *xh, real
07529 *x, integer *ifac)
07530 {
07531
07532
07533 static real sqrt3 = (float)1.73205080756888;
07534
07535
07536 integer i__1;
07537
07538
07539 static integer modn, i__, k;
07540 static real xhold, t1, t2;
07541 static integer kc, np1, ns2;
07542 extern int frfftf1_(integer *, real *, real *, real *,
07543 integer *);
07544
07545
07546
07547
07548 --ifac;
07549 --x;
07550 --xh;
07551 --was;
07552 --war;
07553
07554
07555 i__1 = *n;
07556 for (i__ = 1; i__ <= i__1; ++i__) {
07557 xh[i__] = war[i__];
07558 war[i__] = x[i__];
07559
07560 }
07561 if ((i__1 = *n - 2) < 0) {
07562 goto L101;
07563 } else if (i__1 == 0) {
07564 goto L102;
07565 } else {
07566 goto L103;
07567 }
07568 L101:
07569 xh[1] += xh[1];
07570 goto L106;
07571 L102:
07572 xhold = sqrt3 * (xh[1] + xh[2]);
07573 xh[2] = sqrt3 * (xh[1] - xh[2]);
07574 xh[1] = xhold;
07575 goto L106;
07576 L103:
07577 np1 = *n + 1;
07578 ns2 = *n / 2;
07579 x[1] = (float)0.;
07580 i__1 = ns2;
07581 for (k = 1; k <= i__1; ++k) {
07582 kc = np1 - k;
07583 t1 = xh[k] - xh[kc];
07584 t2 = was[k] * (xh[k] + xh[kc]);
07585 x[k + 1] = t1 + t2;
07586 x[kc + 1] = t2 - t1;
07587
07588 }
07589 modn = *n % 2;
07590 if (modn != 0) {
07591 x[ns2 + 2] = xh[ns2 + 1] * (float)4.;
07592 }
07593 frfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
07594 xh[1] = x[1] * (float).5;
07595 i__1 = *n;
07596 for (i__ = 3; i__ <= i__1; i__ += 2) {
07597 xh[i__ - 1] = -x[i__];
07598 xh[i__] = xh[i__ - 2] + x[i__ - 1];
07599
07600 }
07601 if (modn != 0) {
07602 goto L106;
07603 }
07604 xh[*n] = -x[*n + 1];
07605 L106:
07606 i__1 = *n;
07607 for (i__ = 1; i__ <= i__1; ++i__) {
07608 x[i__] = war[i__];
07609 war[i__] = xh[i__];
07610
07611 }
07612 return 0;
07613 }
07614
07615 #ifdef __cplusplus
07616 }
07617 #endif
07618
07619
07620
07621
07622
07623
07624
