source: Sophya/trunk/Poubelle/DPC:FitsIOServer/NTools/fftpackc.c@ 3309

Last change on this file since 3309 was 658, checked in by ansari, 26 years ago

no message
File size: 228.6 KB
RevLine 
[658]1/* fftpackc.c is the fortran FFTPACK package retrieved from netlib */
2
3/* allf.f -- translated by f2c (version 19970805).
4 You must link the resulting object file with the libraries:
5 -lf2c -lm (in that order)
6*/
7
8/* #include "f2c.h" -- Remplace par ce qui suit */
9#include "fftpackc.h"
10
11/* ------ File cfftb.f ------ */
12/* Subroutine */ int cfftb_(integer *n, real *c__, real *wsave)
13{
14 extern /* Subroutine */ int cfftb1_(integer *, real *, real *, real *,
15 integer *);
16 static integer iw1, iw2;
17
18 /* Parameter adjustments */
19 --wsave;
20 --c__;
21
22 /* Function Body */
23 if (*n == 1) {
24 return 0;
25 }
26 iw1 = *n + *n + 1;
27 iw2 = iw1 + *n + *n;
28 cfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
29 return 0;
30} /* cfftb_ */
31
32/* ------ File cfftb1.f ------ */
33/* Subroutine */ int cfftb1_(integer *n, real *c__, real *ch, real *wa,
34 integer *ifac)
35{
36 /* System generated locals */
37 integer i__1;
38
39 /* Local variables */
40 static integer idot, i__;
41 extern /* Subroutine */ int passb_(integer *, integer *, integer *,
42 integer *, integer *, real *, real *, real *, real *, real *,
43 real *);
44 static integer k1, l1, l2, n2;
45 extern /* Subroutine */ int passb2_(integer *, integer *, real *, real *,
46 real *), passb3_(integer *, integer *, real *, real *, real *,
47 real *), passb4_(integer *, integer *, real *, real *, real *,
48 real *, real *), passb5_(integer *, integer *, real *, real *,
49 real *, real *, real *, real *);
50 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
51
52 /* Parameter adjustments */
53 --ifac;
54 --wa;
55 --ch;
56 --c__;
57
58 /* Function Body */
59 nf = ifac[2];
60 na = 0;
61 l1 = 1;
62 iw = 1;
63 i__1 = nf;
64 for (k1 = 1; k1 <= i__1; ++k1) {
65 ip = ifac[k1 + 2];
66 l2 = ip * l1;
67 ido = *n / l2;
68 idot = ido + ido;
69 idl1 = idot * l1;
70 if (ip != 4) {
71 goto L103;
72 }
73 ix2 = iw + idot;
74 ix3 = ix2 + idot;
75 if (na != 0) {
76 goto L101;
77 }
78 passb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
79 goto L102;
80L101:
81 passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
82L102:
83 na = 1 - na;
84 goto L115;
85L103:
86 if (ip != 2) {
87 goto L106;
88 }
89 if (na != 0) {
90 goto L104;
91 }
92 passb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
93 goto L105;
94L104:
95 passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
96L105:
97 na = 1 - na;
98 goto L115;
99L106:
100 if (ip != 3) {
101 goto L109;
102 }
103 ix2 = iw + idot;
104 if (na != 0) {
105 goto L107;
106 }
107 passb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
108 goto L108;
109L107:
110 passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
111L108:
112 na = 1 - na;
113 goto L115;
114L109:
115 if (ip != 5) {
116 goto L112;
117 }
118 ix2 = iw + idot;
119 ix3 = ix2 + idot;
120 ix4 = ix3 + idot;
121 if (na != 0) {
122 goto L110;
123 }
124 passb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
125 ix4]);
126 goto L111;
127L110:
128 passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
129 ix4]);
130L111:
131 na = 1 - na;
132 goto L115;
133L112:
134 if (na != 0) {
135 goto L113;
136 }
137 passb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
138 , &ch[1], &wa[iw]);
139 goto L114;
140L113:
141 passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
142 &c__[1], &wa[iw]);
143L114:
144 if (nac != 0) {
145 na = 1 - na;
146 }
147L115:
148 l1 = l2;
149 iw += (ip - 1) * idot;
150/* L116: */
151 }
152 if (na == 0) {
153 return 0;
154 }
155 n2 = *n + *n;
156 i__1 = n2;
157 for (i__ = 1; i__ <= i__1; ++i__) {
158 c__[i__] = ch[i__];
159/* L117: */
160 }
161 return 0;
162} /* cfftb1_ */
163
164/* ------ File cfftf.f ------ */
165/* Subroutine */ int cfftf_(integer *n, real *c__, real *wsave)
166{
167 extern /* Subroutine */ int cfftf1_(integer *, real *, real *, real *,
168 integer *);
169 static integer iw1, iw2;
170
171 /* Parameter adjustments */
172 --wsave;
173 --c__;
174
175 /* Function Body */
176 if (*n == 1) {
177 return 0;
178 }
179 iw1 = *n + *n + 1;
180 iw2 = iw1 + *n + *n;
181 cfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
182 return 0;
183} /* cfftf_ */
184
185/* ------ File cfftf1.f ------ */
186/* Subroutine */ int cfftf1_(integer *n, real *c__, real *ch, real *wa,
187 integer *ifac)
188{
189 /* System generated locals */
190 integer i__1;
191
192 /* Local variables */
193 static integer idot, i__;
194 extern /* Subroutine */ int passf_(integer *, integer *, integer *,
195 integer *, integer *, real *, real *, real *, real *, real *,
196 real *);
197 static integer k1, l1, l2, n2;
198 extern /* Subroutine */ int passf2_(integer *, integer *, real *, real *,
199 real *), passf3_(integer *, integer *, real *, real *, real *,
200 real *), passf4_(integer *, integer *, real *, real *, real *,
201 real *, real *), passf5_(integer *, integer *, real *, real *,
202 real *, real *, real *, real *);
203 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
204
205 /* Parameter adjustments */
206 --ifac;
207 --wa;
208 --ch;
209 --c__;
210
211 /* Function Body */
212 nf = ifac[2];
213 na = 0;
214 l1 = 1;
215 iw = 1;
216 i__1 = nf;
217 for (k1 = 1; k1 <= i__1; ++k1) {
218 ip = ifac[k1 + 2];
219 l2 = ip * l1;
220 ido = *n / l2;
221 idot = ido + ido;
222 idl1 = idot * l1;
223 if (ip != 4) {
224 goto L103;
225 }
226 ix2 = iw + idot;
227 ix3 = ix2 + idot;
228 if (na != 0) {
229 goto L101;
230 }
231 passf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
232 goto L102;
233L101:
234 passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
235L102:
236 na = 1 - na;
237 goto L115;
238L103:
239 if (ip != 2) {
240 goto L106;
241 }
242 if (na != 0) {
243 goto L104;
244 }
245 passf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
246 goto L105;
247L104:
248 passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
249L105:
250 na = 1 - na;
251 goto L115;
252L106:
253 if (ip != 3) {
254 goto L109;
255 }
256 ix2 = iw + idot;
257 if (na != 0) {
258 goto L107;
259 }
260 passf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
261 goto L108;
262L107:
263 passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
264L108:
265 na = 1 - na;
266 goto L115;
267L109:
268 if (ip != 5) {
269 goto L112;
270 }
271 ix2 = iw + idot;
272 ix3 = ix2 + idot;
273 ix4 = ix3 + idot;
274 if (na != 0) {
275 goto L110;
276 }
277 passf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
278 ix4]);
279 goto L111;
280L110:
281 passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
282 ix4]);
283L111:
284 na = 1 - na;
285 goto L115;
286L112:
287 if (na != 0) {
288 goto L113;
289 }
290 passf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
291 , &ch[1], &wa[iw]);
292 goto L114;
293L113:
294 passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
295 &c__[1], &wa[iw]);
296L114:
297 if (nac != 0) {
298 na = 1 - na;
299 }
300L115:
301 l1 = l2;
302 iw += (ip - 1) * idot;
303/* L116: */
304 }
305 if (na == 0) {
306 return 0;
307 }
308 n2 = *n + *n;
309 i__1 = n2;
310 for (i__ = 1; i__ <= i__1; ++i__) {
311 c__[i__] = ch[i__];
312/* L117: */
313 }
314 return 0;
315} /* cfftf1_ */
316
317/* ------ File cffti.f ------ */
318/* Subroutine */ int cffti_(integer *n, real *wsave)
319{
320 extern /* Subroutine */ int cffti1_(integer *, real *, integer *);
321 static integer iw1, iw2;
322
323 /* Parameter adjustments */
324 --wsave;
325
326 /* Function Body */
327 if (*n == 1) {
328 return 0;
329 }
330 iw1 = *n + *n + 1;
331 iw2 = iw1 + *n + *n;
332 cffti1_(n, &wsave[iw1], &wsave[iw2]);
333 return 0;
334} /* cffti_ */
335
336/* ------ File cffti1.f ------ */
337/* Subroutine */ int cffti1_(integer *n, real *wa, integer *ifac)
338{
339 /* Initialized data */
340
341 static integer ntryh[4] = { 3,4,2,5 };
342
343 /* System generated locals */
344 integer i__1, i__2, i__3;
345
346 /* Builtin functions */
347 double cos(doublereal), sin(doublereal);
348
349 /* Local variables */
350 static real argh;
351 static integer idot, ntry, i__, j;
352 static real argld;
353 static integer i1, k1, l1, l2, ib;
354 static real fi;
355 static integer ld, ii, nf, ip, nl, nq, nr;
356 static real arg;
357 static integer ido, ipm;
358 static real tpi;
359
360 /* Parameter adjustments */
361 --ifac;
362 --wa;
363
364 /* Function Body */
365 nl = *n;
366 nf = 0;
367 j = 0;
368L101:
369 ++j;
370 if (j - 4 <= 0) {
371 goto L102;
372 } else {
373 goto L103;
374 }
375L102:
376 ntry = ntryh[j - 1];
377 goto L104;
378L103:
379 ntry += 2;
380L104:
381 nq = nl / ntry;
382 nr = nl - ntry * nq;
383 if (nr != 0) {
384 goto L101;
385 } else {
386 goto L105;
387 }
388L105:
389 ++nf;
390 ifac[nf + 2] = ntry;
391 nl = nq;
392 if (ntry != 2) {
393 goto L107;
394 }
395 if (nf == 1) {
396 goto L107;
397 }
398 i__1 = nf;
399 for (i__ = 2; i__ <= i__1; ++i__) {
400 ib = nf - i__ + 2;
401 ifac[ib + 2] = ifac[ib + 1];
402/* L106: */
403 }
404 ifac[3] = 2;
405L107:
406 if (nl != 1) {
407 goto L104;
408 }
409 ifac[1] = *n;
410 ifac[2] = nf;
411 tpi = 6.28318530717959f;
412 argh = tpi / (real) (*n);
413 i__ = 2;
414 l1 = 1;
415 i__1 = nf;
416 for (k1 = 1; k1 <= i__1; ++k1) {
417 ip = ifac[k1 + 2];
418 ld = 0;
419 l2 = l1 * ip;
420 ido = *n / l2;
421 idot = ido + ido + 2;
422 ipm = ip - 1;
423 i__2 = ipm;
424 for (j = 1; j <= i__2; ++j) {
425 i1 = i__;
426 wa[i__ - 1] = 1.f;
427 wa[i__] = 0.f;
428 ld += l1;
429 fi = 0.f;
430 argld = (real) ld * argh;
431 i__3 = idot;
432 for (ii = 4; ii <= i__3; ii += 2) {
433 i__ += 2;
434 fi += 1.f;
435 arg = fi * argld;
436 wa[i__ - 1] = cos(arg);
437 wa[i__] = sin(arg);
438/* L108: */
439 }
440 if (ip <= 5) {
441 goto L109;
442 }
443 wa[i1 - 1] = wa[i__ - 1];
444 wa[i1] = wa[i__];
445L109:
446 ;
447 }
448 l1 = l2;
449/* L110: */
450 }
451 return 0;
452} /* cffti1_ */
453
454/* ------ File cosqb.f ------ */
455/* Subroutine */ int cosqb_(integer *n, real *x, real *wsave)
456{
457 /* Initialized data */
458
459 static real tsqrt2 = 2.82842712474619f;
460
461 /* System generated locals */
462 integer i__1;
463
464 /* Local variables */
465 static real x1;
466 extern /* Subroutine */ int cosqb1_(integer *, real *, real *, real *);
467
468 /* Parameter adjustments */
469 --wsave;
470 --x;
471
472 /* Function Body */
473 if ((i__1 = *n - 2) < 0) {
474 goto L101;
475 } else if (i__1 == 0) {
476 goto L102;
477 } else {
478 goto L103;
479 }
480L101:
481 x[1] *= 4.f;
482 return 0;
483L102:
484 x1 = (x[1] + x[2]) * 4.f;
485 x[2] = tsqrt2 * (x[1] - x[2]);
486 x[1] = x1;
487 return 0;
488L103:
489 cosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
490 return 0;
491} /* cosqb_ */
492
493/* ------ File cosqb1.f ------ */
494/* Subroutine */ int cosqb1_(integer *n, real *x, real *w, real *xh)
495{
496 /* System generated locals */
497 integer i__1;
498
499 /* Local variables */
500 static integer modn, i__, k;
501 extern /* Subroutine */ int rfftb_(integer *, real *, real *);
502 static integer kc, np2, ns2;
503 static real xim1;
504
505 /* Parameter adjustments */
506 --xh;
507 --w;
508 --x;
509
510 /* Function Body */
511 ns2 = (*n + 1) / 2;
512 np2 = *n + 2;
513 i__1 = *n;
514 for (i__ = 3; i__ <= i__1; i__ += 2) {
515 xim1 = x[i__ - 1] + x[i__];
516 x[i__] -= x[i__ - 1];
517 x[i__ - 1] = xim1;
518/* L101: */
519 }
520 x[1] += x[1];
521 modn = *n % 2;
522 if (modn == 0) {
523 x[*n] += x[*n];
524 }
525 rfftb_(n, &x[1], &xh[1]);
526 i__1 = ns2;
527 for (k = 2; k <= i__1; ++k) {
528 kc = np2 - k;
529 xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k];
530 xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc];
531/* L102: */
532 }
533 if (modn == 0) {
534 x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]);
535 }
536 i__1 = ns2;
537 for (k = 2; k <= i__1; ++k) {
538 kc = np2 - k;
539 x[k] = xh[k] + xh[kc];
540 x[kc] = xh[k] - xh[kc];
541/* L103: */
542 }
543 x[1] += x[1];
544 return 0;
545} /* cosqb1_ */
546
547/* ------ File cosqf.f ------ */
548/* Subroutine */ int cosqf_(integer *n, real *x, real *wsave)
549{
550 /* Initialized data */
551
552 static real sqrt2 = 1.4142135623731f;
553
554 /* System generated locals */
555 integer i__1;
556
557 /* Local variables */
558 static real tsqx;
559 extern /* Subroutine */ int cosqf1_(integer *, real *, real *, real *);
560
561 /* Parameter adjustments */
562 --wsave;
563 --x;
564
565 /* Function Body */
566 if ((i__1 = *n - 2) < 0) {
567 goto L102;
568 } else if (i__1 == 0) {
569 goto L101;
570 } else {
571 goto L103;
572 }
573L101:
574 tsqx = sqrt2 * x[2];
575 x[2] = x[1] - tsqx;
576 x[1] += tsqx;
577L102:
578 return 0;
579L103:
580 cosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
581 return 0;
582} /* cosqf_ */
583
584/* ------ File cosqf1.f ------ */
585/* Subroutine */ int cosqf1_(integer *n, real *x, real *w, real *xh)
586{
587 /* System generated locals */
588 integer i__1;
589
590 /* Local variables */
591 static integer modn, i__, k;
592 extern /* Subroutine */ int rfftf_(integer *, real *, real *);
593 static integer kc, np2, ns2;
594 static real xim1;
595
596 /* Parameter adjustments */
597 --xh;
598 --w;
599 --x;
600
601 /* Function Body */
602 ns2 = (*n + 1) / 2;
603 np2 = *n + 2;
604 i__1 = ns2;
605 for (k = 2; k <= i__1; ++k) {
606 kc = np2 - k;
607 xh[k] = x[k] + x[kc];
608 xh[kc] = x[k] - x[kc];
609/* L101: */
610 }
611 modn = *n % 2;
612 if (modn == 0) {
613 xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1];
614 }
615 i__1 = ns2;
616 for (k = 2; k <= i__1; ++k) {
617 kc = np2 - k;
618 x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k];
619 x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc];
620/* L102: */
621 }
622 if (modn == 0) {
623 x[ns2 + 1] = w[ns2] * xh[ns2 + 1];
624 }
625 rfftf_(n, &x[1], &xh[1]);
626 i__1 = *n;
627 for (i__ = 3; i__ <= i__1; i__ += 2) {
628 xim1 = x[i__ - 1] - x[i__];
629 x[i__] = x[i__ - 1] + x[i__];
630 x[i__ - 1] = xim1;
631/* L103: */
632 }
633 return 0;
634} /* cosqf1_ */
635
636/* ------ File cosqi.f ------ */
637/* Subroutine */ int cosqi_(integer *n, real *wsave)
638{
639 /* Initialized data */
640
641 static real pih = 1.57079632679491f;
642
643 /* System generated locals */
644 integer i__1;
645
646 /* Builtin functions */
647 double cos(doublereal);
648
649 /* Local variables */
650 static integer k;
651 extern /* Subroutine */ int rffti_(integer *, real *);
652 static real fk, dt;
653
654 /* Parameter adjustments */
655 --wsave;
656
657 /* Function Body */
658 dt = pih / (real) (*n);
659 fk = 0.f;
660 i__1 = *n;
661 for (k = 1; k <= i__1; ++k) {
662 fk += 1.f;
663 wsave[k] = cos(fk * dt);
664/* L101: */
665 }
666 rffti_(n, &wsave[*n + 1]);
667 return 0;
668} /* cosqi_ */
669
670/* ------ File cost.f ------ */
671/* Subroutine */ int cost_(integer *n, real *x, real *wsave)
672{
673 /* System generated locals */
674 integer i__1;
675
676 /* Local variables */
677 static integer modn, i__, k;
678 extern /* Subroutine */ int rfftf_(integer *, real *, real *);
679 static real c1, t1, t2;
680 static integer kc;
681 static real xi;
682 static integer nm1, np1;
683 static real x1h;
684 static integer ns2;
685 static real tx2, x1p3, xim2;
686
687 /* Parameter adjustments */
688 --wsave;
689 --x;
690
691 /* Function Body */
692 nm1 = *n - 1;
693 np1 = *n + 1;
694 ns2 = *n / 2;
695 if ((i__1 = *n - 2) < 0) {
696 goto L106;
697 } else if (i__1 == 0) {
698 goto L101;
699 } else {
700 goto L102;
701 }
702L101:
703 x1h = x[1] + x[2];
704 x[2] = x[1] - x[2];
705 x[1] = x1h;
706 return 0;
707L102:
708 if (*n > 3) {
709 goto L103;
710 }
711 x1p3 = x[1] + x[3];
712 tx2 = x[2] + x[2];
713 x[2] = x[1] - x[3];
714 x[1] = x1p3 + tx2;
715 x[3] = x1p3 - tx2;
716 return 0;
717L103:
718 c1 = x[1] - x[*n];
719 x[1] += x[*n];
720 i__1 = ns2;
721 for (k = 2; k <= i__1; ++k) {
722 kc = np1 - k;
723 t1 = x[k] + x[kc];
724 t2 = x[k] - x[kc];
725 c1 += wsave[kc] * t2;
726 t2 = wsave[k] * t2;
727 x[k] = t1 - t2;
728 x[kc] = t1 + t2;
729/* L104: */
730 }
731 modn = *n % 2;
732 if (modn != 0) {
733 x[ns2 + 1] += x[ns2 + 1];
734 }
735 rfftf_(&nm1, &x[1], &wsave[*n + 1]);
736 xim2 = x[2];
737 x[2] = c1;
738 i__1 = *n;
739 for (i__ = 4; i__ <= i__1; i__ += 2) {
740 xi = x[i__];
741 x[i__] = x[i__ - 2] - x[i__ - 1];
742 x[i__ - 1] = xim2;
743 xim2 = xi;
744/* L105: */
745 }
746 if (modn != 0) {
747 x[*n] = xim2;
748 }
749L106:
750 return 0;
751} /* cost_ */
752
753/* ------ File costi.f ------ */
754/* Subroutine */ int costi_(integer *n, real *wsave)
755{
756 /* Initialized data */
757
758 static real pi = 3.14159265358979f;
759
760 /* System generated locals */
761 integer i__1;
762
763 /* Builtin functions */
764 double sin(doublereal), cos(doublereal);
765
766 /* Local variables */
767 static integer k;
768 extern /* Subroutine */ int rffti_(integer *, real *);
769 static integer kc;
770 static real fk, dt;
771 static integer nm1, np1, ns2;
772
773 /* Parameter adjustments */
774 --wsave;
775
776 /* Function Body */
777 if (*n <= 3) {
778 return 0;
779 }
780 nm1 = *n - 1;
781 np1 = *n + 1;
782 ns2 = *n / 2;
783 dt = pi / (real) nm1;
784 fk = 0.f;
785 i__1 = ns2;
786 for (k = 2; k <= i__1; ++k) {
787 kc = np1 - k;
788 fk += 1.f;
789 wsave[k] = sin(fk * dt) * 2.f;
790 wsave[kc] = cos(fk * dt) * 2.f;
791/* L101: */
792 }
793 rffti_(&nm1, &wsave[*n + 1]);
794 return 0;
795} /* costi_ */
796
797/* ------ File ezfft1.f ------ */
798/* Subroutine */ int ezfft1_(integer *n, real *wa, integer *ifac)
799{
800 /* Initialized data */
801
802 static integer ntryh[4] = { 4,2,3,5 };
803 static real tpi = 6.28318530717959f;
804
805 /* System generated locals */
806 integer i__1, i__2, i__3;
807
808 /* Builtin functions */
809 double cos(doublereal), sin(doublereal);
810
811 /* Local variables */
812 static real argh;
813 static integer ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr;
814 static real ch1, sh1;
815 static integer ido, ipm;
816 static real dch1, ch1h, arg1, dsh1;
817 static integer nfm1;
818
819 /* Parameter adjustments */
820 --ifac;
821 --wa;
822
823 /* Function Body */
824 nl = *n;
825 nf = 0;
826 j = 0;
827L101:
828 ++j;
829 if (j - 4 <= 0) {
830 goto L102;
831 } else {
832 goto L103;
833 }
834L102:
835 ntry = ntryh[j - 1];
836 goto L104;
837L103:
838 ntry += 2;
839L104:
840 nq = nl / ntry;
841 nr = nl - ntry * nq;
842 if (nr != 0) {
843 goto L101;
844 } else {
845 goto L105;
846 }
847L105:
848 ++nf;
849 ifac[nf + 2] = ntry;
850 nl = nq;
851 if (ntry != 2) {
852 goto L107;
853 }
854 if (nf == 1) {
855 goto L107;
856 }
857 i__1 = nf;
858 for (i__ = 2; i__ <= i__1; ++i__) {
859 ib = nf - i__ + 2;
860 ifac[ib + 2] = ifac[ib + 1];
861/* L106: */
862 }
863 ifac[3] = 2;
864L107:
865 if (nl != 1) {
866 goto L104;
867 }
868 ifac[1] = *n;
869 ifac[2] = nf;
870 argh = tpi / (real) (*n);
871 is = 0;
872 nfm1 = nf - 1;
873 l1 = 1;
874 if (nfm1 == 0) {
875 return 0;
876 }
877 i__1 = nfm1;
878 for (k1 = 1; k1 <= i__1; ++k1) {
879 ip = ifac[k1 + 2];
880 l2 = l1 * ip;
881 ido = *n / l2;
882 ipm = ip - 1;
883 arg1 = (real) l1 * argh;
884 ch1 = 1.f;
885 sh1 = 0.f;
886 dch1 = cos(arg1);
887 dsh1 = sin(arg1);
888 i__2 = ipm;
889 for (j = 1; j <= i__2; ++j) {
890 ch1h = dch1 * ch1 - dsh1 * sh1;
891 sh1 = dch1 * sh1 + dsh1 * ch1;
892 ch1 = ch1h;
893 i__ = is + 2;
894 wa[i__ - 1] = ch1;
895 wa[i__] = sh1;
896 if (ido < 5) {
897 goto L109;
898 }
899 i__3 = ido;
900 for (ii = 5; ii <= i__3; ii += 2) {
901 i__ += 2;
902 wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2];
903 wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3];
904/* L108: */
905 }
906L109:
907 is += ido;
908/* L110: */
909 }
910 l1 = l2;
911/* L111: */
912 }
913 return 0;
914} /* ezfft1_ */
915
916/* ------ File ezfftb.f ------ */
917/* Subroutine */ int ezfftb_(integer *n, real *r__, real *azero, real *a,
918 real *b, real *wsave)
919{
920 /* System generated locals */
921 integer i__1;
922
923 /* Local variables */
924 static integer i__;
925 extern /* Subroutine */ int rfftb_(integer *, real *, real *);
926 static integer ns2;
927
928 /* Parameter adjustments */
929 --wsave;
930 --b;
931 --a;
932 --r__;
933
934 /* Function Body */
935 if ((i__1 = *n - 2) < 0) {
936 goto L101;
937 } else if (i__1 == 0) {
938 goto L102;
939 } else {
940 goto L103;
941 }
942L101:
943 r__[1] = *azero;
944 return 0;
945L102:
946 r__[1] = *azero + a[1];
947 r__[2] = *azero - a[1];
948 return 0;
949L103:
950 ns2 = (*n - 1) / 2;
951 i__1 = ns2;
952 for (i__ = 1; i__ <= i__1; ++i__) {
953 r__[i__ * 2] = a[i__] * .5f;
954 r__[(i__ << 1) + 1] = b[i__] * -.5f;
955/* L104: */
956 }
957 r__[1] = *azero;
958 if (*n % 2 == 0) {
959 r__[*n] = a[ns2 + 1];
960 }
961 rfftb_(n, &r__[1], &wsave[*n + 1]);
962 return 0;
963} /* ezfftb_ */
964
965/* ------ File ezfftf.f ------ */
966/* Subroutine */ int ezfftf_(integer *n, real *r__, real *azero, real *a,
967 real *b, real *wsave)
968{
969 /* System generated locals */
970 integer i__1;
971
972 /* Local variables */
973 static integer i__;
974 extern /* Subroutine */ int rfftf_(integer *, real *, real *);
975 static real cf;
976 static integer ns2;
977 static real cfm;
978 static integer ns2m;
979
980
981/* VERSION 3 JUNE 1979 */
982
983 /* Parameter adjustments */
984 --wsave;
985 --b;
986 --a;
987 --r__;
988
989 /* Function Body */
990 if ((i__1 = *n - 2) < 0) {
991 goto L101;
992 } else if (i__1 == 0) {
993 goto L102;
994 } else {
995 goto L103;
996 }
997L101:
998 *azero = r__[1];
999 return 0;
1000L102:
1001 *azero = (r__[1] + r__[2]) * .5f;
1002 a[1] = (r__[1] - r__[2]) * .5f;
1003 return 0;
1004L103:
1005 i__1 = *n;
1006 for (i__ = 1; i__ <= i__1; ++i__) {
1007 wsave[i__] = r__[i__];
1008/* L104: */
1009 }
1010 rfftf_(n, &wsave[1], &wsave[*n + 1]);
1011 cf = 2.f / (real) (*n);
1012 cfm = -cf;
1013 *azero = cf * .5f * wsave[1];
1014 ns2 = (*n + 1) / 2;
1015 ns2m = ns2 - 1;
1016 i__1 = ns2m;
1017 for (i__ = 1; i__ <= i__1; ++i__) {
1018 a[i__] = cf * wsave[i__ * 2];
1019 b[i__] = cfm * wsave[(i__ << 1) + 1];
1020/* L105: */
1021 }
1022 if (*n % 2 == 1) {
1023 return 0;
1024 }
1025 a[ns2] = cf * .5f * wsave[*n];
1026 b[ns2] = 0.f;
1027 return 0;
1028} /* ezfftf_ */
1029
1030/* ------ File ezffti.f ------ */
1031/* Subroutine */ int ezffti_(integer *n, real *wsave)
1032{
1033 extern /* Subroutine */ int ezfft1_(integer *, real *, integer *);
1034
1035 /* Parameter adjustments */
1036 --wsave;
1037
1038 /* Function Body */
1039 if (*n == 1) {
1040 return 0;
1041 }
1042 ezfft1_(n, &wsave[(*n << 1) + 1], (integer*)&wsave[*n * 3 + 1]);
1043 return 0;
1044} /* ezffti_ */
1045
1046/* ------ File passb.f ------ */
1047/* Subroutine */ int passb_(integer *nac, integer *ido, integer *ip, integer *
1048 l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2,
1049 real *wa)
1050{
1051 /* System generated locals */
1052 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
1053 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
1054 i__1, i__2, i__3;
1055
1056 /* Local variables */
1057 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
1058 idl, inc, idp;
1059 static real wai, war;
1060 static integer ipp2;
1061
1062 /* Parameter adjustments */
1063 ch_dim1 = *ido;
1064 ch_dim2 = *l1;
1065 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1066 ch -= ch_offset;
1067 c1_dim1 = *ido;
1068 c1_dim2 = *l1;
1069 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
1070 c1 -= c1_offset;
1071 cc_dim1 = *ido;
1072 cc_dim2 = *ip;
1073 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
1074 cc -= cc_offset;
1075 ch2_dim1 = *idl1;
1076 ch2_offset = ch2_dim1 + 1;
1077 ch2 -= ch2_offset;
1078 c2_dim1 = *idl1;
1079 c2_offset = c2_dim1 + 1;
1080 c2 -= c2_offset;
1081 --wa;
1082
1083 /* Function Body */
1084 idot = *ido / 2;
1085 nt = *ip * *idl1;
1086 ipp2 = *ip + 2;
1087 ipph = (*ip + 1) / 2;
1088 idp = *ip * *ido;
1089
1090 if (*ido < *l1) {
1091 goto L106;
1092 }
1093 i__1 = ipph;
1094 for (j = 2; j <= i__1; ++j) {
1095 jc = ipp2 - j;
1096 i__2 = *l1;
1097 for (k = 1; k <= i__2; ++k) {
1098 i__3 = *ido;
1099 for (i__ = 1; i__ <= i__3; ++i__) {
1100 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1101 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
1102 cc_dim1];
1103 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1104 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
1105 cc_dim1];
1106/* L101: */
1107 }
1108/* L102: */
1109 }
1110/* L103: */
1111 }
1112 i__1 = *l1;
1113 for (k = 1; k <= i__1; ++k) {
1114 i__2 = *ido;
1115 for (i__ = 1; i__ <= i__2; ++i__) {
1116 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
1117 cc_dim1];
1118/* L104: */
1119 }
1120/* L105: */
1121 }
1122 goto L112;
1123L106:
1124 i__1 = ipph;
1125 for (j = 2; j <= i__1; ++j) {
1126 jc = ipp2 - j;
1127 i__2 = *ido;
1128 for (i__ = 1; i__ <= i__2; ++i__) {
1129 i__3 = *l1;
1130 for (k = 1; k <= i__3; ++k) {
1131 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1132 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
1133 cc_dim1];
1134 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1135 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
1136 cc_dim1];
1137/* L107: */
1138 }
1139/* L108: */
1140 }
1141/* L109: */
1142 }
1143 i__1 = *ido;
1144 for (i__ = 1; i__ <= i__1; ++i__) {
1145 i__2 = *l1;
1146 for (k = 1; k <= i__2; ++k) {
1147 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
1148 cc_dim1];
1149/* L110: */
1150 }
1151/* L111: */
1152 }
1153L112:
1154 idl = 2 - *ido;
1155 inc = 0;
1156 i__1 = ipph;
1157 for (l = 2; l <= i__1; ++l) {
1158 lc = ipp2 - l;
1159 idl += *ido;
1160 i__2 = *idl1;
1161 for (ik = 1; ik <= i__2; ++ik) {
1162 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
1163 + (ch2_dim1 << 1)];
1164 c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1];
1165/* L113: */
1166 }
1167 idlj = idl;
1168 inc += *ido;
1169 i__2 = ipph;
1170 for (j = 3; j <= i__2; ++j) {
1171 jc = ipp2 - j;
1172 idlj += inc;
1173 if (idlj > idp) {
1174 idlj -= idp;
1175 }
1176 war = wa[idlj - 1];
1177 wai = wa[idlj];
1178 i__3 = *idl1;
1179 for (ik = 1; ik <= i__3; ++ik) {
1180 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
1181 c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
1182/* L114: */
1183 }
1184/* L115: */
1185 }
1186/* L116: */
1187 }
1188 i__1 = ipph;
1189 for (j = 2; j <= i__1; ++j) {
1190 i__2 = *idl1;
1191 for (ik = 1; ik <= i__2; ++ik) {
1192 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
1193/* L117: */
1194 }
1195/* L118: */
1196 }
1197 i__1 = ipph;
1198 for (j = 2; j <= i__1; ++j) {
1199 jc = ipp2 - j;
1200 i__2 = *idl1;
1201 for (ik = 2; ik <= i__2; ik += 2) {
1202 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
1203 jc * c2_dim1];
1204 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
1205 jc * c2_dim1];
1206 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
1207 c2_dim1];
1208 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
1209 c2_dim1];
1210/* L119: */
1211 }
1212/* L120: */
1213 }
1214 *nac = 1;
1215 if (*ido == 2) {
1216 return 0;
1217 }
1218 *nac = 0;
1219 i__1 = *idl1;
1220 for (ik = 1; ik <= i__1; ++ik) {
1221 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
1222/* L121: */
1223 }
1224 i__1 = *ip;
1225 for (j = 2; j <= i__1; ++j) {
1226 i__2 = *l1;
1227 for (k = 1; k <= i__2; ++k) {
1228 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
1229 ch_dim1 + 1];
1230 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
1231 ch_dim1 + 2];
1232/* L122: */
1233 }
1234/* L123: */
1235 }
1236 if (idot > *l1) {
1237 goto L127;
1238 }
1239 idij = 0;
1240 i__1 = *ip;
1241 for (j = 2; j <= i__1; ++j) {
1242 idij += 2;
1243 i__2 = *ido;
1244 for (i__ = 4; i__ <= i__2; i__ += 2) {
1245 idij += 2;
1246 i__3 = *l1;
1247 for (k = 1; k <= i__3; ++k) {
1248 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
1249 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
1250 ch[i__ + (k + j * ch_dim2) * ch_dim1];
1251 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
1252 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
1253 1 + (k + j * ch_dim2) * ch_dim1];
1254/* L124: */
1255 }
1256/* L125: */
1257 }
1258/* L126: */
1259 }
1260 return 0;
1261L127:
1262 idj = 2 - *ido;
1263 i__1 = *ip;
1264 for (j = 2; j <= i__1; ++j) {
1265 idj += *ido;
1266 i__2 = *l1;
1267 for (k = 1; k <= i__2; ++k) {
1268 idij = idj;
1269 i__3 = *ido;
1270 for (i__ = 4; i__ <= i__3; i__ += 2) {
1271 idij += 2;
1272 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
1273 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
1274 ch[i__ + (k + j * ch_dim2) * ch_dim1];
1275 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
1276 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
1277 1 + (k + j * ch_dim2) * ch_dim1];
1278/* L128: */
1279 }
1280/* L129: */
1281 }
1282/* L130: */
1283 }
1284 return 0;
1285} /* passb_ */
1286
1287/* ------ File passb2.f ------ */
1288/* Subroutine */ int passb2_(integer *ido, integer *l1, real *cc, real *ch,
1289 real *wa1)
1290{
1291 /* System generated locals */
1292 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1293
1294 /* Local variables */
1295 static integer i__, k;
1296 static real ti2, tr2;
1297
1298 /* Parameter adjustments */
1299 ch_dim1 = *ido;
1300 ch_dim2 = *l1;
1301 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1302 ch -= ch_offset;
1303 cc_dim1 = *ido;
1304 cc_offset = cc_dim1 * 3 + 1;
1305 cc -= cc_offset;
1306 --wa1;
1307
1308 /* Function Body */
1309 if (*ido > 2) {
1310 goto L102;
1311 }
1312 i__1 = *l1;
1313 for (k = 1; k <= i__1; ++k) {
1314 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
1315 cc[((k << 1) + 2) * cc_dim1 + 1];
1316 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
1317 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
1318 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
1319 cc[((k << 1) + 2) * cc_dim1 + 2];
1320 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
1321 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
1322/* L101: */
1323 }
1324 return 0;
1325L102:
1326 i__1 = *l1;
1327 for (k = 1; k <= i__1; ++k) {
1328 i__2 = *ido;
1329 for (i__ = 2; i__ <= i__2; i__ += 2) {
1330 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
1331 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
1332 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
1333 1) + 2) * cc_dim1];
1334 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
1335 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
1336 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
1337 * cc_dim1];
1338 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 +
1339 wa1[i__] * tr2;
1340 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
1341 - wa1[i__] * ti2;
1342/* L103: */
1343 }
1344/* L104: */
1345 }
1346 return 0;
1347} /* passb2_ */
1348
1349/* ------ File passb3.f ------ */
1350/* Subroutine */ int passb3_(integer *ido, integer *l1, real *cc, real *ch,
1351 real *wa1, real *wa2)
1352{
1353 /* Initialized data */
1354
1355 static real taur = -.5f;
1356 static real taui = .866025403784439f;
1357
1358 /* System generated locals */
1359 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1360
1361 /* Local variables */
1362 static integer i__, k;
1363 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
1364
1365 /* Parameter adjustments */
1366 ch_dim1 = *ido;
1367 ch_dim2 = *l1;
1368 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1369 ch -= ch_offset;
1370 cc_dim1 = *ido;
1371 cc_offset = (cc_dim1 << 2) + 1;
1372 cc -= cc_offset;
1373 --wa1;
1374 --wa2;
1375
1376 /* Function Body */
1377 if (*ido != 2) {
1378 goto L102;
1379 }
1380 i__1 = *l1;
1381 for (k = 1; k <= i__1; ++k) {
1382 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
1383 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
1384 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
1385 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
1386 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
1387 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
1388 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
1389 cc_dim1 + 1]);
1390 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
1391 cc_dim1 + 2]);
1392 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
1393 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
1394 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
1395 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
1396/* L101: */
1397 }
1398 return 0;
1399L102:
1400 i__1 = *l1;
1401 for (k = 1; k <= i__1; ++k) {
1402 i__2 = *ido;
1403 for (i__ = 2; i__ <= i__2; i__ += 2) {
1404 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
1405 3) * cc_dim1];
1406 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
1407 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
1408 cc_dim1] + tr2;
1409 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
1410 cc_dim1];
1411 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
1412 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
1413 cc_dim1] + ti2;
1414 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
1415 k * 3 + 3) * cc_dim1]);
1416 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
1417 3) * cc_dim1]);
1418 dr2 = cr2 - ci3;
1419 dr3 = cr2 + ci3;
1420 di2 = ci2 + cr3;
1421 di3 = ci2 - cr3;
1422 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
1423 wa1[i__] * dr2;
1424 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
1425 - wa1[i__] * di2;
1426 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
1427 i__] * dr3;
1428 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
1429 wa2[i__] * di3;
1430/* L103: */
1431 }
1432/* L104: */
1433 }
1434 return 0;
1435} /* passb3_ */
1436
1437/* ------ File passb4.f ------ */
1438/* Subroutine */ int passb4_(integer *ido, integer *l1, real *cc, real *ch,
1439 real *wa1, real *wa2, real *wa3)
1440{
1441 /* System generated locals */
1442 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1443
1444 /* Local variables */
1445 static integer i__, k;
1446 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
1447 tr3, tr4;
1448
1449 /* Parameter adjustments */
1450 ch_dim1 = *ido;
1451 ch_dim2 = *l1;
1452 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1453 ch -= ch_offset;
1454 cc_dim1 = *ido;
1455 cc_offset = cc_dim1 * 5 + 1;
1456 cc -= cc_offset;
1457 --wa1;
1458 --wa2;
1459 --wa3;
1460
1461 /* Function Body */
1462 if (*ido != 2) {
1463 goto L102;
1464 }
1465 i__1 = *l1;
1466 for (k = 1; k <= i__1; ++k) {
1467 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
1468 + 2];
1469 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
1470 + 2];
1471 tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1
1472 + 2];
1473 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
1474 + 2];
1475 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
1476 + 1];
1477 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
1478 + 1];
1479 ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1
1480 + 1];
1481 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
1482 + 1];
1483 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
1484 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
1485 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
1486 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
1487 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
1488 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
1489 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
1490 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
1491/* L101: */
1492 }
1493 return 0;
1494L102:
1495 i__1 = *l1;
1496 for (k = 1; k <= i__1; ++k) {
1497 i__2 = *ido;
1498 for (i__ = 2; i__ <= i__2; i__ += 2) {
1499 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
1500 * cc_dim1];
1501 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
1502 * cc_dim1];
1503 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
1504 * cc_dim1];
1505 tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
1506 * cc_dim1];
1507 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
1508 2) + 3) * cc_dim1];
1509 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
1510 2) + 3) * cc_dim1];
1511 ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
1512 2) + 4) * cc_dim1];
1513 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
1514 2) + 4) * cc_dim1];
1515 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
1516 cr3 = tr2 - tr3;
1517 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
1518 ci3 = ti2 - ti3;
1519 cr2 = tr1 + tr4;
1520 cr4 = tr1 - tr4;
1521 ci2 = ti1 + ti4;
1522 ci4 = ti1 - ti4;
1523 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
1524 - wa1[i__] * ci2;
1525 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 +
1526 wa1[i__] * cr2;
1527 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 -
1528 wa2[i__] * ci3;
1529 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
1530 i__] * cr3;
1531 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
1532 - wa3[i__] * ci4;
1533 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 +
1534 wa3[i__] * cr4;
1535/* L103: */
1536 }
1537/* L104: */
1538 }
1539 return 0;
1540} /* passb4_ */
1541
1542/* ------ File passb5.f ------ */
1543/* Subroutine */ int passb5_(integer *ido, integer *l1, real *cc, real *ch,
1544 real *wa1, real *wa2, real *wa3, real *wa4)
1545{
1546 /* Initialized data */
1547
1548 static real tr11 = .309016994374947f;
1549 static real ti11 = .951056516295154f;
1550 static real tr12 = -.809016994374947f;
1551 static real ti12 = .587785252292473f;
1552
1553 /* System generated locals */
1554 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1555
1556 /* Local variables */
1557 static integer i__, k;
1558 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
1559 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
1560
1561 /* Parameter adjustments */
1562 ch_dim1 = *ido;
1563 ch_dim2 = *l1;
1564 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1565 ch -= ch_offset;
1566 cc_dim1 = *ido;
1567 cc_offset = cc_dim1 * 6 + 1;
1568 cc -= cc_offset;
1569 --wa1;
1570 --wa2;
1571 --wa3;
1572 --wa4;
1573
1574 /* Function Body */
1575 if (*ido != 2) {
1576 goto L102;
1577 }
1578 i__1 = *l1;
1579 for (k = 1; k <= i__1; ++k) {
1580 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
1581 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
1582 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
1583 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
1584 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
1585 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
1586 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
1587 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
1588 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
1589 + tr3;
1590 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
1591 + ti3;
1592 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
1593 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
1594 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
1595 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
1596 cr5 = ti11 * tr5 + ti12 * tr4;
1597 ci5 = ti11 * ti5 + ti12 * ti4;
1598 cr4 = ti12 * tr5 - ti11 * tr4;
1599 ci4 = ti12 * ti5 - ti11 * ti4;
1600 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
1601 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
1602 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
1603 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
1604 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
1605 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
1606 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
1607 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
1608/* L101: */
1609 }
1610 return 0;
1611L102:
1612 i__1 = *l1;
1613 for (k = 1; k <= i__1; ++k) {
1614 i__2 = *ido;
1615 for (i__ = 2; i__ <= i__2; i__ += 2) {
1616 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
1617 cc_dim1];
1618 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
1619 cc_dim1];
1620 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
1621 cc_dim1];
1622 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
1623 cc_dim1];
1624 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
1625 5) * cc_dim1];
1626 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
1627 5) * cc_dim1];
1628 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
1629 4) * cc_dim1];
1630 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
1631 4) * cc_dim1];
1632 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
1633 cc_dim1] + tr2 + tr3;
1634 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
1635 cc_dim1] + ti2 + ti3;
1636 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
1637 tr3;
1638 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
1639 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
1640 tr3;
1641 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
1642 cr5 = ti11 * tr5 + ti12 * tr4;
1643 ci5 = ti11 * ti5 + ti12 * ti4;
1644 cr4 = ti12 * tr5 - ti11 * tr4;
1645 ci4 = ti12 * ti5 - ti11 * ti4;
1646 dr3 = cr3 - ci4;
1647 dr4 = cr3 + ci4;
1648 di3 = ci3 + cr4;
1649 di4 = ci3 - cr4;
1650 dr5 = cr2 + ci5;
1651 dr2 = cr2 - ci5;
1652 di5 = ci2 - cr5;
1653 di2 = ci2 + cr5;
1654 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
1655 - wa1[i__] * di2;
1656 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
1657 wa1[i__] * dr2;
1658 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
1659 wa2[i__] * di3;
1660 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
1661 i__] * dr3;
1662 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
1663 - wa3[i__] * di4;
1664 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 +
1665 wa3[i__] * dr4;
1666 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 -
1667 wa4[i__] * di5;
1668 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
1669 i__] * dr5;
1670/* L103: */
1671 }
1672/* L104: */
1673 }
1674 return 0;
1675} /* passb5_ */
1676
1677/* ------ File passf.f ------ */
1678/* Subroutine */ int passf_(integer *nac, integer *ido, integer *ip, integer *
1679 l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2,
1680 real *wa)
1681{
1682 /* System generated locals */
1683 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
1684 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
1685 i__1, i__2, i__3;
1686
1687 /* Local variables */
1688 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
1689 idl, inc, idp;
1690 static real wai, war;
1691 static integer ipp2;
1692
1693 /* Parameter adjustments */
1694 ch_dim1 = *ido;
1695 ch_dim2 = *l1;
1696 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1697 ch -= ch_offset;
1698 c1_dim1 = *ido;
1699 c1_dim2 = *l1;
1700 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
1701 c1 -= c1_offset;
1702 cc_dim1 = *ido;
1703 cc_dim2 = *ip;
1704 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
1705 cc -= cc_offset;
1706 ch2_dim1 = *idl1;
1707 ch2_offset = ch2_dim1 + 1;
1708 ch2 -= ch2_offset;
1709 c2_dim1 = *idl1;
1710 c2_offset = c2_dim1 + 1;
1711 c2 -= c2_offset;
1712 --wa;
1713
1714 /* Function Body */
1715 idot = *ido / 2;
1716 nt = *ip * *idl1;
1717 ipp2 = *ip + 2;
1718 ipph = (*ip + 1) / 2;
1719 idp = *ip * *ido;
1720
1721 if (*ido < *l1) {
1722 goto L106;
1723 }
1724 i__1 = ipph;
1725 for (j = 2; j <= i__1; ++j) {
1726 jc = ipp2 - j;
1727 i__2 = *l1;
1728 for (k = 1; k <= i__2; ++k) {
1729 i__3 = *ido;
1730 for (i__ = 1; i__ <= i__3; ++i__) {
1731 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1732 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
1733 cc_dim1];
1734 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1735 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
1736 cc_dim1];
1737/* L101: */
1738 }
1739/* L102: */
1740 }
1741/* L103: */
1742 }
1743 i__1 = *l1;
1744 for (k = 1; k <= i__1; ++k) {
1745 i__2 = *ido;
1746 for (i__ = 1; i__ <= i__2; ++i__) {
1747 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
1748 cc_dim1];
1749/* L104: */
1750 }
1751/* L105: */
1752 }
1753 goto L112;
1754L106:
1755 i__1 = ipph;
1756 for (j = 2; j <= i__1; ++j) {
1757 jc = ipp2 - j;
1758 i__2 = *ido;
1759 for (i__ = 1; i__ <= i__2; ++i__) {
1760 i__3 = *l1;
1761 for (k = 1; k <= i__3; ++k) {
1762 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1763 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
1764 cc_dim1];
1765 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
1766 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
1767 cc_dim1];
1768/* L107: */
1769 }
1770/* L108: */
1771 }
1772/* L109: */
1773 }
1774 i__1 = *ido;
1775 for (i__ = 1; i__ <= i__1; ++i__) {
1776 i__2 = *l1;
1777 for (k = 1; k <= i__2; ++k) {
1778 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
1779 cc_dim1];
1780/* L110: */
1781 }
1782/* L111: */
1783 }
1784L112:
1785 idl = 2 - *ido;
1786 inc = 0;
1787 i__1 = ipph;
1788 for (l = 2; l <= i__1; ++l) {
1789 lc = ipp2 - l;
1790 idl += *ido;
1791 i__2 = *idl1;
1792 for (ik = 1; ik <= i__2; ++ik) {
1793 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
1794 + (ch2_dim1 << 1)];
1795 c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1];
1796/* L113: */
1797 }
1798 idlj = idl;
1799 inc += *ido;
1800 i__2 = ipph;
1801 for (j = 3; j <= i__2; ++j) {
1802 jc = ipp2 - j;
1803 idlj += inc;
1804 if (idlj > idp) {
1805 idlj -= idp;
1806 }
1807 war = wa[idlj - 1];
1808 wai = wa[idlj];
1809 i__3 = *idl1;
1810 for (ik = 1; ik <= i__3; ++ik) {
1811 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
1812 c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
1813/* L114: */
1814 }
1815/* L115: */
1816 }
1817/* L116: */
1818 }
1819 i__1 = ipph;
1820 for (j = 2; j <= i__1; ++j) {
1821 i__2 = *idl1;
1822 for (ik = 1; ik <= i__2; ++ik) {
1823 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
1824/* L117: */
1825 }
1826/* L118: */
1827 }
1828 i__1 = ipph;
1829 for (j = 2; j <= i__1; ++j) {
1830 jc = ipp2 - j;
1831 i__2 = *idl1;
1832 for (ik = 2; ik <= i__2; ik += 2) {
1833 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
1834 jc * c2_dim1];
1835 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
1836 jc * c2_dim1];
1837 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
1838 c2_dim1];
1839 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
1840 c2_dim1];
1841/* L119: */
1842 }
1843/* L120: */
1844 }
1845 *nac = 1;
1846 if (*ido == 2) {
1847 return 0;
1848 }
1849 *nac = 0;
1850 i__1 = *idl1;
1851 for (ik = 1; ik <= i__1; ++ik) {
1852 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
1853/* L121: */
1854 }
1855 i__1 = *ip;
1856 for (j = 2; j <= i__1; ++j) {
1857 i__2 = *l1;
1858 for (k = 1; k <= i__2; ++k) {
1859 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
1860 ch_dim1 + 1];
1861 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
1862 ch_dim1 + 2];
1863/* L122: */
1864 }
1865/* L123: */
1866 }
1867 if (idot > *l1) {
1868 goto L127;
1869 }
1870 idij = 0;
1871 i__1 = *ip;
1872 for (j = 2; j <= i__1; ++j) {
1873 idij += 2;
1874 i__2 = *ido;
1875 for (i__ = 4; i__ <= i__2; i__ += 2) {
1876 idij += 2;
1877 i__3 = *l1;
1878 for (k = 1; k <= i__3; ++k) {
1879 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
1880 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
1881 ch[i__ + (k + j * ch_dim2) * ch_dim1];
1882 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
1883 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
1884 1 + (k + j * ch_dim2) * ch_dim1];
1885/* L124: */
1886 }
1887/* L125: */
1888 }
1889/* L126: */
1890 }
1891 return 0;
1892L127:
1893 idj = 2 - *ido;
1894 i__1 = *ip;
1895 for (j = 2; j <= i__1; ++j) {
1896 idj += *ido;
1897 i__2 = *l1;
1898 for (k = 1; k <= i__2; ++k) {
1899 idij = idj;
1900 i__3 = *ido;
1901 for (i__ = 4; i__ <= i__3; i__ += 2) {
1902 idij += 2;
1903 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
1904 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
1905 ch[i__ + (k + j * ch_dim2) * ch_dim1];
1906 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
1907 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
1908 1 + (k + j * ch_dim2) * ch_dim1];
1909/* L128: */
1910 }
1911/* L129: */
1912 }
1913/* L130: */
1914 }
1915 return 0;
1916} /* passf_ */
1917
1918/* ------ File passf2.f ------ */
1919/* Subroutine */ int passf2_(integer *ido, integer *l1, real *cc, real *ch,
1920 real *wa1)
1921{
1922 /* System generated locals */
1923 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1924
1925 /* Local variables */
1926 static integer i__, k;
1927 static real ti2, tr2;
1928
1929 /* Parameter adjustments */
1930 ch_dim1 = *ido;
1931 ch_dim2 = *l1;
1932 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
1933 ch -= ch_offset;
1934 cc_dim1 = *ido;
1935 cc_offset = cc_dim1 * 3 + 1;
1936 cc -= cc_offset;
1937 --wa1;
1938
1939 /* Function Body */
1940 if (*ido > 2) {
1941 goto L102;
1942 }
1943 i__1 = *l1;
1944 for (k = 1; k <= i__1; ++k) {
1945 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
1946 cc[((k << 1) + 2) * cc_dim1 + 1];
1947 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
1948 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
1949 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
1950 cc[((k << 1) + 2) * cc_dim1 + 2];
1951 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
1952 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
1953/* L101: */
1954 }
1955 return 0;
1956L102:
1957 i__1 = *l1;
1958 for (k = 1; k <= i__1; ++k) {
1959 i__2 = *ido;
1960 for (i__ = 2; i__ <= i__2; i__ += 2) {
1961 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
1962 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
1963 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
1964 1) + 2) * cc_dim1];
1965 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
1966 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
1967 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
1968 * cc_dim1];
1969 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 -
1970 wa1[i__] * tr2;
1971 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
1972 + wa1[i__] * ti2;
1973/* L103: */
1974 }
1975/* L104: */
1976 }
1977 return 0;
1978} /* passf2_ */
1979
1980/* ------ File passf3.f ------ */
1981/* Subroutine */ int passf3_(integer *ido, integer *l1, real *cc, real *ch,
1982 real *wa1, real *wa2)
1983{
1984 /* Initialized data */
1985
1986 static real taur = -.5f;
1987 static real taui = -.866025403784439f;
1988
1989 /* System generated locals */
1990 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1991
1992 /* Local variables */
1993 static integer i__, k;
1994 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
1995
1996 /* Parameter adjustments */
1997 ch_dim1 = *ido;
1998 ch_dim2 = *l1;
1999 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2000 ch -= ch_offset;
2001 cc_dim1 = *ido;
2002 cc_offset = (cc_dim1 << 2) + 1;
2003 cc -= cc_offset;
2004 --wa1;
2005 --wa2;
2006
2007 /* Function Body */
2008 if (*ido != 2) {
2009 goto L102;
2010 }
2011 i__1 = *l1;
2012 for (k = 1; k <= i__1; ++k) {
2013 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
2014 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
2015 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
2016 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
2017 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
2018 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
2019 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
2020 cc_dim1 + 1]);
2021 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
2022 cc_dim1 + 2]);
2023 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
2024 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
2025 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
2026 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
2027/* L101: */
2028 }
2029 return 0;
2030L102:
2031 i__1 = *l1;
2032 for (k = 1; k <= i__1; ++k) {
2033 i__2 = *ido;
2034 for (i__ = 2; i__ <= i__2; i__ += 2) {
2035 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
2036 3) * cc_dim1];
2037 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
2038 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
2039 cc_dim1] + tr2;
2040 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
2041 cc_dim1];
2042 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
2043 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
2044 cc_dim1] + ti2;
2045 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
2046 k * 3 + 3) * cc_dim1]);
2047 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
2048 3) * cc_dim1]);
2049 dr2 = cr2 - ci3;
2050 dr3 = cr2 + ci3;
2051 di2 = ci2 + cr3;
2052 di3 = ci2 - cr3;
2053 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
2054 wa1[i__] * dr2;
2055 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
2056 + wa1[i__] * di2;
2057 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
2058 i__] * dr3;
2059 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
2060 wa2[i__] * di3;
2061/* L103: */
2062 }
2063/* L104: */
2064 }
2065 return 0;
2066} /* passf3_ */
2067
2068/* ------ File passf4.f ------ */
2069/* Subroutine */ int passf4_(integer *ido, integer *l1, real *cc, real *ch,
2070 real *wa1, real *wa2, real *wa3)
2071{
2072 /* System generated locals */
2073 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2074
2075 /* Local variables */
2076 static integer i__, k;
2077 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
2078 tr3, tr4;
2079
2080 /* Parameter adjustments */
2081 ch_dim1 = *ido;
2082 ch_dim2 = *l1;
2083 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2084 ch -= ch_offset;
2085 cc_dim1 = *ido;
2086 cc_offset = cc_dim1 * 5 + 1;
2087 cc -= cc_offset;
2088 --wa1;
2089 --wa2;
2090 --wa3;
2091
2092 /* Function Body */
2093 if (*ido != 2) {
2094 goto L102;
2095 }
2096 i__1 = *l1;
2097 for (k = 1; k <= i__1; ++k) {
2098 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
2099 + 2];
2100 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
2101 + 2];
2102 tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1
2103 + 2];
2104 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
2105 + 2];
2106 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
2107 + 1];
2108 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
2109 + 1];
2110 ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
2111 + 1];
2112 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
2113 + 1];
2114 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
2115 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
2116 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
2117 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
2118 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
2119 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
2120 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
2121 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
2122/* L101: */
2123 }
2124 return 0;
2125L102:
2126 i__1 = *l1;
2127 for (k = 1; k <= i__1; ++k) {
2128 i__2 = *ido;
2129 for (i__ = 2; i__ <= i__2; i__ += 2) {
2130 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
2131 * cc_dim1];
2132 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
2133 * cc_dim1];
2134 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
2135 * cc_dim1];
2136 tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
2137 * cc_dim1];
2138 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
2139 2) + 3) * cc_dim1];
2140 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
2141 2) + 3) * cc_dim1];
2142 ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
2143 2) + 2) * cc_dim1];
2144 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
2145 2) + 4) * cc_dim1];
2146 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
2147 cr3 = tr2 - tr3;
2148 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
2149 ci3 = ti2 - ti3;
2150 cr2 = tr1 + tr4;
2151 cr4 = tr1 - tr4;
2152 ci2 = ti1 + ti4;
2153 ci4 = ti1 - ti4;
2154 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
2155 + wa1[i__] * ci2;
2156 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 -
2157 wa1[i__] * cr2;
2158 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 +
2159 wa2[i__] * ci3;
2160 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
2161 i__] * cr3;
2162 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
2163 + wa3[i__] * ci4;
2164 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 -
2165 wa3[i__] * cr4;
2166/* L103: */
2167 }
2168/* L104: */
2169 }
2170 return 0;
2171} /* passf4_ */
2172
2173/* ------ File passf5.f ------ */
2174/* Subroutine */ int passf5_(integer *ido, integer *l1, real *cc, real *ch,
2175 real *wa1, real *wa2, real *wa3, real *wa4)
2176{
2177 /* Initialized data */
2178
2179 static real tr11 = .309016994374947f;
2180 static real ti11 = -.951056516295154f;
2181 static real tr12 = -.809016994374947f;
2182 static real ti12 = -.587785252292473f;
2183
2184 /* System generated locals */
2185 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2186
2187 /* Local variables */
2188 static integer i__, k;
2189 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
2190 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
2191
2192 /* Parameter adjustments */
2193 ch_dim1 = *ido;
2194 ch_dim2 = *l1;
2195 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2196 ch -= ch_offset;
2197 cc_dim1 = *ido;
2198 cc_offset = cc_dim1 * 6 + 1;
2199 cc -= cc_offset;
2200 --wa1;
2201 --wa2;
2202 --wa3;
2203 --wa4;
2204
2205 /* Function Body */
2206 if (*ido != 2) {
2207 goto L102;
2208 }
2209 i__1 = *l1;
2210 for (k = 1; k <= i__1; ++k) {
2211 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
2212 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
2213 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
2214 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
2215 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
2216 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
2217 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
2218 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
2219 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
2220 + tr3;
2221 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
2222 + ti3;
2223 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
2224 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
2225 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
2226 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
2227 cr5 = ti11 * tr5 + ti12 * tr4;
2228 ci5 = ti11 * ti5 + ti12 * ti4;
2229 cr4 = ti12 * tr5 - ti11 * tr4;
2230 ci4 = ti12 * ti5 - ti11 * ti4;
2231 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
2232 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
2233 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
2234 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
2235 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
2236 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
2237 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
2238 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
2239/* L101: */
2240 }
2241 return 0;
2242L102:
2243 i__1 = *l1;
2244 for (k = 1; k <= i__1; ++k) {
2245 i__2 = *ido;
2246 for (i__ = 2; i__ <= i__2; i__ += 2) {
2247 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
2248 cc_dim1];
2249 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
2250 cc_dim1];
2251 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
2252 cc_dim1];
2253 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
2254 cc_dim1];
2255 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
2256 5) * cc_dim1];
2257 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
2258 5) * cc_dim1];
2259 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
2260 4) * cc_dim1];
2261 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
2262 4) * cc_dim1];
2263 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
2264 cc_dim1] + tr2 + tr3;
2265 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
2266 cc_dim1] + ti2 + ti3;
2267 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
2268 tr3;
2269 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
2270 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
2271 tr3;
2272 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
2273 cr5 = ti11 * tr5 + ti12 * tr4;
2274 ci5 = ti11 * ti5 + ti12 * ti4;
2275 cr4 = ti12 * tr5 - ti11 * tr4;
2276 ci4 = ti12 * ti5 - ti11 * ti4;
2277 dr3 = cr3 - ci4;
2278 dr4 = cr3 + ci4;
2279 di3 = ci3 + cr4;
2280 di4 = ci3 - cr4;
2281 dr5 = cr2 + ci5;
2282 dr2 = cr2 - ci5;
2283 di5 = ci2 - cr5;
2284 di2 = ci2 + cr5;
2285 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
2286 + wa1[i__] * di2;
2287 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
2288 wa1[i__] * dr2;
2289 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
2290 wa2[i__] * di3;
2291 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
2292 i__] * dr3;
2293 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
2294 + wa3[i__] * di4;
2295 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 -
2296 wa3[i__] * dr4;
2297 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 +
2298 wa4[i__] * di5;
2299 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
2300 i__] * dr5;
2301/* L103: */
2302 }
2303/* L104: */
2304 }
2305 return 0;
2306} /* passf5_ */
2307
2308/* ------ File radb2.f ------ */
2309/* Subroutine */ int radb2_(integer *ido, integer *l1, real *cc, real *ch,
2310 real *wa1)
2311{
2312 /* System generated locals */
2313 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2314
2315 /* Local variables */
2316 static integer i__, k, ic;
2317 static real ti2, tr2;
2318 static integer idp2;
2319
2320 /* Parameter adjustments */
2321 ch_dim1 = *ido;
2322 ch_dim2 = *l1;
2323 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2324 ch -= ch_offset;
2325 cc_dim1 = *ido;
2326 cc_offset = cc_dim1 * 3 + 1;
2327 cc -= cc_offset;
2328 --wa1;
2329
2330 /* Function Body */
2331 i__1 = *l1;
2332 for (k = 1; k <= i__1; ++k) {
2333 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
2334 cc[*ido + ((k << 1) + 2) * cc_dim1];
2335 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
2336 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1];
2337/* L101: */
2338 }
2339 if ((i__1 = *ido - 2) < 0) {
2340 goto L107;
2341 } else if (i__1 == 0) {
2342 goto L105;
2343 } else {
2344 goto L102;
2345 }
2346L102:
2347 idp2 = *ido + 2;
2348 i__1 = *l1;
2349 for (k = 1; k <= i__1; ++k) {
2350 i__2 = *ido;
2351 for (i__ = 3; i__ <= i__2; i__ += 2) {
2352 ic = idp2 - i__;
2353 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
2354 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
2355 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
2356 1) + 2) * cc_dim1];
2357 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
2358 cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
2359 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2)
2360 * cc_dim1];
2361 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2
2362 - wa1[i__ - 1] * ti2;
2363 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 +
2364 wa1[i__ - 1] * tr2;
2365/* L103: */
2366 }
2367/* L104: */
2368 }
2369 if (*ido % 2 == 1) {
2370 return 0;
2371 }
2372L105:
2373 i__1 = *l1;
2374 for (k = 1; k <= i__1; ++k) {
2375 ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) *
2376 cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1];
2377 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) *
2378 cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
2379/* L106: */
2380 }
2381L107:
2382 return 0;
2383} /* radb2_ */
2384
2385/* ------ File radb3.f ------ */
2386/* Subroutine */ int radb3_(integer *ido, integer *l1, real *cc, real *ch,
2387 real *wa1, real *wa2)
2388{
2389 /* Initialized data */
2390
2391 static real taur = -.5f;
2392 static real taui = .866025403784439f;
2393
2394 /* System generated locals */
2395 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2396
2397 /* Local variables */
2398 static integer i__, k, ic;
2399 static real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
2400 static integer idp2;
2401
2402 /* Parameter adjustments */
2403 ch_dim1 = *ido;
2404 ch_dim2 = *l1;
2405 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2406 ch -= ch_offset;
2407 cc_dim1 = *ido;
2408 cc_offset = (cc_dim1 << 2) + 1;
2409 cc -= cc_offset;
2410 --wa1;
2411 --wa2;
2412
2413 /* Function Body */
2414 i__1 = *l1;
2415 for (k = 1; k <= i__1; ++k) {
2416 tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) *
2417 cc_dim1];
2418 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
2419 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
2420 ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) *
2421 cc_dim1 + 1]);
2422 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
2423 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
2424/* L101: */
2425 }
2426 if (*ido == 1) {
2427 return 0;
2428 }
2429 idp2 = *ido + 2;
2430 i__1 = *l1;
2431 for (k = 1; k <= i__1; ++k) {
2432 i__2 = *ido;
2433 for (i__ = 3; i__ <= i__2; i__ += 2) {
2434 ic = idp2 - i__;
2435 tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 +
2436 2) * cc_dim1];
2437 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
2438 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
2439 cc_dim1] + tr2;
2440 ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) *
2441 cc_dim1];
2442 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
2443 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
2444 cc_dim1] + ti2;
2445 cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
2446 k * 3 + 2) * cc_dim1]);
2447 ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 +
2448 2) * cc_dim1]);
2449 dr2 = cr2 - ci3;
2450 dr3 = cr2 + ci3;
2451 di2 = ci2 + cr3;
2452 di3 = ci2 - cr3;
2453 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
2454 - wa1[i__ - 1] * di2;
2455 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
2456 wa1[i__ - 1] * dr2;
2457 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
2458 wa2[i__ - 1] * di3;
2459 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
2460 i__ - 1] * dr3;
2461/* L102: */
2462 }
2463/* L103: */
2464 }
2465 return 0;
2466} /* radb3_ */
2467
2468/* ------ File radb4.f ------ */
2469/* Subroutine */ int radb4_(integer *ido, integer *l1, real *cc, real *ch,
2470 real *wa1, real *wa2, real *wa3)
2471{
2472 /* Initialized data */
2473
2474 static real sqrt2 = 1.414213562373095f;
2475
2476 /* System generated locals */
2477 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2478
2479 /* Local variables */
2480 static integer i__, k, ic;
2481 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
2482 tr3, tr4;
2483 static integer idp2;
2484
2485 /* Parameter adjustments */
2486 ch_dim1 = *ido;
2487 ch_dim2 = *l1;
2488 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2489 ch -= ch_offset;
2490 cc_dim1 = *ido;
2491 cc_offset = cc_dim1 * 5 + 1;
2492 cc -= cc_offset;
2493 --wa1;
2494 --wa2;
2495 --wa3;
2496
2497 /* Function Body */
2498 i__1 = *l1;
2499 for (k = 1; k <= i__1; ++k) {
2500 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) *
2501 cc_dim1];
2502 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) *
2503 cc_dim1];
2504 tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) *
2505 cc_dim1];
2506 tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
2507 + 1];
2508 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
2509 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
2510 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
2511 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
2512/* L101: */
2513 }
2514 if ((i__1 = *ido - 2) < 0) {
2515 goto L107;
2516 } else if (i__1 == 0) {
2517 goto L105;
2518 } else {
2519 goto L102;
2520 }
2521L102:
2522 idp2 = *ido + 2;
2523 i__1 = *l1;
2524 for (k = 1; k <= i__1; ++k) {
2525 i__2 = *ido;
2526 for (i__ = 3; i__ <= i__2; i__ += 2) {
2527 ic = idp2 - i__;
2528 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4)
2529 * cc_dim1];
2530 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4)
2531 * cc_dim1];
2532 ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2)
2533 * cc_dim1];
2534 tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2)
2535 * cc_dim1];
2536 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
2537 2) + 4) * cc_dim1];
2538 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k <<
2539 2) + 4) * cc_dim1];
2540 ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k <<
2541 2) + 2) * cc_dim1];
2542 tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k <<
2543 2) + 2) * cc_dim1];
2544 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
2545 cr3 = tr2 - tr3;
2546 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
2547 ci3 = ti2 - ti3;
2548 cr2 = tr1 - tr4;
2549 cr4 = tr1 + tr4;
2550 ci2 = ti1 + ti4;
2551 ci4 = ti1 - ti4;
2552 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2
2553 - wa1[i__ - 1] * ci2;
2554 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 +
2555 wa1[i__ - 1] * cr2;
2556 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 -
2557 wa2[i__ - 1] * ci3;
2558 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
2559 i__ - 1] * cr3;
2560 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4
2561 - wa3[i__ - 1] * ci4;
2562 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 +
2563 wa3[i__ - 1] * cr4;
2564/* L103: */
2565 }
2566/* L104: */
2567 }
2568 if (*ido % 2 == 1) {
2569 return 0;
2570 }
2571L105:
2572 i__1 = *l1;
2573 for (k = 1; k <= i__1; ++k) {
2574 ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
2575 + 1];
2576 ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
2577 + 1];
2578 tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) *
2579 cc_dim1];
2580 tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) *
2581 cc_dim1];
2582 ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2;
2583 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1);
2584 ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2;
2585 ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1);
2586/* L106: */
2587 }
2588L107:
2589 return 0;
2590} /* radb4_ */
2591
2592/* ------ File radb5.f ------ */
2593/* Subroutine */ int radb5_(integer *ido, integer *l1, real *cc, real *ch,
2594 real *wa1, real *wa2, real *wa3, real *wa4)
2595{
2596 /* Initialized data */
2597
2598 static real tr11 = .309016994374947f;
2599 static real ti11 = .951056516295154f;
2600 static real tr12 = -.809016994374947f;
2601 static real ti12 = .587785252292473f;
2602
2603 /* System generated locals */
2604 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2605
2606 /* Local variables */
2607 static integer i__, k, ic;
2608 static real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
2609 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
2610 static integer idp2;
2611
2612 /* Parameter adjustments */
2613 ch_dim1 = *ido;
2614 ch_dim2 = *l1;
2615 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2616 ch -= ch_offset;
2617 cc_dim1 = *ido;
2618 cc_offset = cc_dim1 * 6 + 1;
2619 cc -= cc_offset;
2620 --wa1;
2621 --wa2;
2622 --wa3;
2623 --wa4;
2624
2625 /* Function Body */
2626 i__1 = *l1;
2627 for (k = 1; k <= i__1; ++k) {
2628 ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
2629 ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
2630 tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) *
2631 cc_dim1];
2632 tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) *
2633 cc_dim1];
2634 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
2635 + tr3;
2636 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
2637 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
2638 ci5 = ti11 * ti5 + ti12 * ti4;
2639 ci4 = ti12 * ti5 - ti11 * ti4;
2640 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
2641 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
2642 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
2643 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
2644/* L101: */
2645 }
2646 if (*ido == 1) {
2647 return 0;
2648 }
2649 idp2 = *ido + 2;
2650 i__1 = *l1;
2651 for (k = 1; k <= i__1; ++k) {
2652 i__2 = *ido;
2653 for (i__ = 3; i__ <= i__2; i__ += 2) {
2654 ic = idp2 - i__;
2655 ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) *
2656 cc_dim1];
2657 ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) *
2658 cc_dim1];
2659 ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) *
2660 cc_dim1];
2661 ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) *
2662 cc_dim1];
2663 tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 +
2664 2) * cc_dim1];
2665 tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 +
2666 2) * cc_dim1];
2667 tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 +
2668 4) * cc_dim1];
2669 tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 +
2670 4) * cc_dim1];
2671 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
2672 cc_dim1] + tr2 + tr3;
2673 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
2674 cc_dim1] + ti2 + ti3;
2675 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
2676 tr3;
2677 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
2678 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
2679 tr3;
2680 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
2681 cr5 = ti11 * tr5 + ti12 * tr4;
2682 ci5 = ti11 * ti5 + ti12 * ti4;
2683 cr4 = ti12 * tr5 - ti11 * tr4;
2684 ci4 = ti12 * ti5 - ti11 * ti4;
2685 dr3 = cr3 - ci4;
2686 dr4 = cr3 + ci4;
2687 di3 = ci3 + cr4;
2688 di4 = ci3 - cr4;
2689 dr5 = cr2 + ci5;
2690 dr2 = cr2 - ci5;
2691 di5 = ci2 - cr5;
2692 di2 = ci2 + cr5;
2693 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
2694 - wa1[i__ - 1] * di2;
2695 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
2696 wa1[i__ - 1] * dr2;
2697 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
2698 wa2[i__ - 1] * di3;
2699 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
2700 i__ - 1] * dr3;
2701 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4
2702 - wa3[i__ - 1] * di4;
2703 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 +
2704 wa3[i__ - 1] * dr4;
2705 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 -
2706 wa4[i__ - 1] * di5;
2707 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
2708 i__ - 1] * dr5;
2709/* L102: */
2710 }
2711/* L103: */
2712 }
2713 return 0;
2714} /* radb5_ */
2715
2716/* ------ File radbg.f ------ */
2717/* Subroutine */ int radbg_(integer *ido, integer *ip, integer *l1, integer *
2718 idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
2719{
2720 /* Initialized data */
2721
2722 static real tpi = 6.28318530717959f;
2723
2724 /* System generated locals */
2725 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
2726 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
2727 i__1, i__2, i__3;
2728
2729 /* Builtin functions */
2730 double cos(doublereal), sin(doublereal);
2731
2732 /* Local variables */
2733 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
2734 static real dc2, ai1, ai2, ar1, ar2, ds2;
2735 static integer nbd;
2736 static real dcp, arg, dsp, ar1h, ar2h;
2737 static integer idp2, ipp2;
2738
2739 /* Parameter adjustments */
2740 ch_dim1 = *ido;
2741 ch_dim2 = *l1;
2742 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
2743 ch -= ch_offset;
2744 c1_dim1 = *ido;
2745 c1_dim2 = *l1;
2746 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
2747 c1 -= c1_offset;
2748 cc_dim1 = *ido;
2749 cc_dim2 = *ip;
2750 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
2751 cc -= cc_offset;
2752 ch2_dim1 = *idl1;
2753 ch2_offset = ch2_dim1 + 1;
2754 ch2 -= ch2_offset;
2755 c2_dim1 = *idl1;
2756 c2_offset = c2_dim1 + 1;
2757 c2 -= c2_offset;
2758 --wa;
2759
2760 /* Function Body */
2761 arg = tpi / (real) (*ip);
2762 dcp = cos(arg);
2763 dsp = sin(arg);
2764 idp2 = *ido + 2;
2765 nbd = (*ido - 1) / 2;
2766 ipp2 = *ip + 2;
2767 ipph = (*ip + 1) / 2;
2768 if (*ido < *l1) {
2769 goto L103;
2770 }
2771 i__1 = *l1;
2772 for (k = 1; k <= i__1; ++k) {
2773 i__2 = *ido;
2774 for (i__ = 1; i__ <= i__2; ++i__) {
2775 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
2776 cc_dim1];
2777/* L101: */
2778 }
2779/* L102: */
2780 }
2781 goto L106;
2782L103:
2783 i__1 = *ido;
2784 for (i__ = 1; i__ <= i__1; ++i__) {
2785 i__2 = *l1;
2786 for (k = 1; k <= i__2; ++k) {
2787 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
2788 cc_dim1];
2789/* L104: */
2790 }
2791/* L105: */
2792 }
2793L106:
2794 i__1 = ipph;
2795 for (j = 2; j <= i__1; ++j) {
2796 jc = ipp2 - j;
2797 j2 = j + j;
2798 i__2 = *l1;
2799 for (k = 1; k <= i__2; ++k) {
2800 ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k *
2801 cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) *
2802 cc_dim1];
2803 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
2804 cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
2805/* L107: */
2806 }
2807/* L108: */
2808 }
2809 if (*ido == 1) {
2810 goto L116;
2811 }
2812 if (nbd < *l1) {
2813 goto L112;
2814 }
2815 i__1 = ipph;
2816 for (j = 2; j <= i__1; ++j) {
2817 jc = ipp2 - j;
2818 i__2 = *l1;
2819 for (k = 1; k <= i__2; ++k) {
2820 i__3 = *ido;
2821 for (i__ = 3; i__ <= i__3; i__ += 2) {
2822 ic = idp2 - i__;
2823 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
2824 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
2825 << 1) - 2 + k * cc_dim2) * cc_dim1];
2826 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
2827 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
2828 << 1) - 2 + k * cc_dim2) * cc_dim1];
2829 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
2830 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
2831 k * cc_dim2) * cc_dim1];
2832 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
2833 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
2834 k * cc_dim2) * cc_dim1];
2835/* L109: */
2836 }
2837/* L110: */
2838 }
2839/* L111: */
2840 }
2841 goto L116;
2842L112:
2843 i__1 = ipph;
2844 for (j = 2; j <= i__1; ++j) {
2845 jc = ipp2 - j;
2846 i__2 = *ido;
2847 for (i__ = 3; i__ <= i__2; i__ += 2) {
2848 ic = idp2 - i__;
2849 i__3 = *l1;
2850 for (k = 1; k <= i__3; ++k) {
2851 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
2852 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
2853 << 1) - 2 + k * cc_dim2) * cc_dim1];
2854 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
2855 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
2856 << 1) - 2 + k * cc_dim2) * cc_dim1];
2857 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
2858 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
2859 k * cc_dim2) * cc_dim1];
2860 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
2861 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
2862 k * cc_dim2) * cc_dim1];
2863/* L113: */
2864 }
2865/* L114: */
2866 }
2867/* L115: */
2868 }
2869L116:
2870 ar1 = 1.f;
2871 ai1 = 0.f;
2872 i__1 = ipph;
2873 for (l = 2; l <= i__1; ++l) {
2874 lc = ipp2 - l;
2875 ar1h = dcp * ar1 - dsp * ai1;
2876 ai1 = dcp * ai1 + dsp * ar1;
2877 ar1 = ar1h;
2878 i__2 = *idl1;
2879 for (ik = 1; ik <= i__2; ++ik) {
2880 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
2881 ch2_dim1 << 1)];
2882 c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1];
2883/* L117: */
2884 }
2885 dc2 = ar1;
2886 ds2 = ai1;
2887 ar2 = ar1;
2888 ai2 = ai1;
2889 i__2 = ipph;
2890 for (j = 3; j <= i__2; ++j) {
2891 jc = ipp2 - j;
2892 ar2h = dc2 * ar2 - ds2 * ai2;
2893 ai2 = dc2 * ai2 + ds2 * ar2;
2894 ar2 = ar2h;
2895 i__3 = *idl1;
2896 for (ik = 1; ik <= i__3; ++ik) {
2897 c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
2898 c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
2899/* L118: */
2900 }
2901/* L119: */
2902 }
2903/* L120: */
2904 }
2905 i__1 = ipph;
2906 for (j = 2; j <= i__1; ++j) {
2907 i__2 = *idl1;
2908 for (ik = 1; ik <= i__2; ++ik) {
2909 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
2910/* L121: */
2911 }
2912/* L122: */
2913 }
2914 i__1 = ipph;
2915 for (j = 2; j <= i__1; ++j) {
2916 jc = ipp2 - j;
2917 i__2 = *l1;
2918 for (k = 1; k <= i__2; ++k) {
2919 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
2920 c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
2921 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
2922 c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
2923/* L123: */
2924 }
2925/* L124: */
2926 }
2927 if (*ido == 1) {
2928 goto L132;
2929 }
2930 if (nbd < *l1) {
2931 goto L128;
2932 }
2933 i__1 = ipph;
2934 for (j = 2; j <= i__1; ++j) {
2935 jc = ipp2 - j;
2936 i__2 = *l1;
2937 for (k = 1; k <= i__2; ++k) {
2938 i__3 = *ido;
2939 for (i__ = 3; i__ <= i__3; i__ += 2) {
2940 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
2941 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
2942 * c1_dim1];
2943 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
2944 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
2945 c1_dim2) * c1_dim1];
2946 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
2947 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
2948 * c1_dim1];
2949 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
2950 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
2951 * c1_dim1];
2952/* L125: */
2953 }
2954/* L126: */
2955 }
2956/* L127: */
2957 }
2958 goto L132;
2959L128:
2960 i__1 = ipph;
2961 for (j = 2; j <= i__1; ++j) {
2962 jc = ipp2 - j;
2963 i__2 = *ido;
2964 for (i__ = 3; i__ <= i__2; i__ += 2) {
2965 i__3 = *l1;
2966 for (k = 1; k <= i__3; ++k) {
2967 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
2968 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
2969 * c1_dim1];
2970 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
2971 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
2972 c1_dim2) * c1_dim1];
2973 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
2974 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
2975 * c1_dim1];
2976 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
2977 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
2978 * c1_dim1];
2979/* L129: */
2980 }
2981/* L130: */
2982 }
2983/* L131: */
2984 }
2985L132:
2986 if (*ido == 1) {
2987 return 0;
2988 }
2989 i__1 = *idl1;
2990 for (ik = 1; ik <= i__1; ++ik) {
2991 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
2992/* L133: */
2993 }
2994 i__1 = *ip;
2995 for (j = 2; j <= i__1; ++j) {
2996 i__2 = *l1;
2997 for (k = 1; k <= i__2; ++k) {
2998 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
2999 ch_dim1 + 1];
3000/* L134: */
3001 }
3002/* L135: */
3003 }
3004 if (nbd > *l1) {
3005 goto L139;
3006 }
3007 is = -(*ido);
3008 i__1 = *ip;
3009 for (j = 2; j <= i__1; ++j) {
3010 is += *ido;
3011 idij = is;
3012 i__2 = *ido;
3013 for (i__ = 3; i__ <= i__2; i__ += 2) {
3014 idij += 2;
3015 i__3 = *l1;
3016 for (k = 1; k <= i__3; ++k) {
3017 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
3018 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
3019 ch[i__ + (k + j * ch_dim2) * ch_dim1];
3020 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
3021 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
3022 1 + (k + j * ch_dim2) * ch_dim1];
3023/* L136: */
3024 }
3025/* L137: */
3026 }
3027/* L138: */
3028 }
3029 goto L143;
3030L139:
3031 is = -(*ido);
3032 i__1 = *ip;
3033 for (j = 2; j <= i__1; ++j) {
3034 is += *ido;
3035 i__2 = *l1;
3036 for (k = 1; k <= i__2; ++k) {
3037 idij = is;
3038 i__3 = *ido;
3039 for (i__ = 3; i__ <= i__3; i__ += 2) {
3040 idij += 2;
3041 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
3042 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
3043 ch[i__ + (k + j * ch_dim2) * ch_dim1];
3044 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
3045 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
3046 1 + (k + j * ch_dim2) * ch_dim1];
3047/* L140: */
3048 }
3049/* L141: */
3050 }
3051/* L142: */
3052 }
3053L143:
3054 return 0;
3055} /* radbg_ */
3056
3057/* ------ File radf2.f ------ */
3058/* Subroutine */ int radf2_(integer *ido, integer *l1, real *cc, real *ch,
3059 real *wa1)
3060{
3061 /* System generated locals */
3062 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
3063
3064 /* Local variables */
3065 static integer i__, k, ic;
3066 static real ti2, tr2;
3067 static integer idp2;
3068
3069 /* Parameter adjustments */
3070 ch_dim1 = *ido;
3071 ch_offset = ch_dim1 * 3 + 1;
3072 ch -= ch_offset;
3073 cc_dim1 = *ido;
3074 cc_dim2 = *l1;
3075 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
3076 cc -= cc_offset;
3077 --wa1;
3078
3079 /* Function Body */
3080 i__1 = *l1;
3081 for (k = 1; k <= i__1; ++k) {
3082 ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
3083 cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
3084 ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
3085 - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
3086/* L101: */
3087 }
3088 if ((i__1 = *ido - 2) < 0) {
3089 goto L107;
3090 } else if (i__1 == 0) {
3091 goto L105;
3092 } else {
3093 goto L102;
3094 }
3095L102:
3096 idp2 = *ido + 2;
3097 i__1 = *l1;
3098 for (k = 1; k <= i__1; ++k) {
3099 i__2 = *ido;
3100 for (i__ = 3; i__ <= i__2; i__ += 2) {
3101 ic = idp2 - i__;
3102 tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
3103 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
3104 ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
3105 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
3106 cc_dim1];
3107 ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
3108 cc_dim1] + ti2;
3109 ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
3110 cc_dim1];
3111 ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k +
3112 cc_dim2) * cc_dim1] + tr2;
3113 ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
3114 * cc_dim1] - tr2;
3115/* L103: */
3116 }
3117/* L104: */
3118 }
3119 if (*ido % 2 == 1) {
3120 return 0;
3121 }
3122L105:
3123 i__1 = *l1;
3124 for (k = 1; k <= i__1; ++k) {
3125 ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) *
3126 cc_dim1];
3127 ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) *
3128 cc_dim1];
3129/* L106: */
3130 }
3131L107:
3132 return 0;
3133} /* radf2_ */
3134
3135/* ------ File radf3.f ------ */
3136/* Subroutine */ int radf3_(integer *ido, integer *l1, real *cc, real *ch,
3137 real *wa1, real *wa2)
3138{
3139 /* Initialized data */
3140
3141 static real taur = -.5f;
3142 static real taui = .866025403784439f;
3143
3144 /* System generated locals */
3145 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
3146
3147 /* Local variables */
3148 static integer i__, k, ic;
3149 static real ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
3150 static integer idp2;
3151
3152 /* Parameter adjustments */
3153 ch_dim1 = *ido;
3154 ch_offset = (ch_dim1 << 2) + 1;
3155 ch -= ch_offset;
3156 cc_dim1 = *ido;
3157 cc_dim2 = *l1;
3158 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
3159 cc -= cc_offset;
3160 --wa1;
3161 --wa2;
3162
3163 /* Function Body */
3164 i__1 = *l1;
3165 for (k = 1; k <= i__1; ++k) {
3166 cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
3167 cc_dim1 + 1];
3168 ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
3169 ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) *
3170 cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
3171 ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
3172 taur * cr2;
3173/* L101: */
3174 }
3175 if (*ido == 1) {
3176 return 0;
3177 }
3178 idp2 = *ido + 2;
3179 i__1 = *l1;
3180 for (k = 1; k <= i__1; ++k) {
3181 i__2 = *ido;
3182 for (i__ = 3; i__ <= i__2; i__ += 2) {
3183 ic = idp2 - i__;
3184 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
3185 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
3186 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
3187 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
3188 cc_dim1];
3189 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
3190 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
3191 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
3192 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
3193 cr2 = dr2 + dr3;
3194 ci2 = di2 + di3;
3195 ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
3196 cc_dim1] + cr2;
3197 ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
3198 cc_dim1] + ci2;
3199 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
3200 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
3201 tr3 = taui * (di2 - di3);
3202 ti3 = taui * (dr3 - dr2);
3203 ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
3204 ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
3205 ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
3206 ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
3207/* L102: */
3208 }
3209/* L103: */
3210 }
3211 return 0;
3212} /* radf3_ */
3213
3214/* ------ File radf4.f ------ */
3215/* Subroutine */ int radf4_(integer *ido, integer *l1, real *cc, real *ch,
3216 real *wa1, real *wa2, real *wa3)
3217{
3218 /* Initialized data */
3219
3220 static real hsqt2 = .7071067811865475f;
3221
3222 /* System generated locals */
3223 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
3224
3225 /* Local variables */
3226 static integer i__, k, ic;
3227 static real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
3228 tr3, tr4;
3229 static integer idp2;
3230
3231 /* Parameter adjustments */
3232 ch_dim1 = *ido;
3233 ch_offset = ch_dim1 * 5 + 1;
3234 ch -= ch_offset;
3235 cc_dim1 = *ido;
3236 cc_dim2 = *l1;
3237 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
3238 cc -= cc_offset;
3239 --wa1;
3240 --wa2;
3241 --wa3;
3242
3243 /* Function Body */
3244 i__1 = *l1;
3245 for (k = 1; k <= i__1; ++k) {
3246 tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
3247 * cc_dim1 + 1];
3248 tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
3249 cc_dim1 + 1];
3250 ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
3251 ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
3252 ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
3253 - cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
3254 ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1
3255 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
3256/* L101: */
3257 }
3258 if ((i__1 = *ido - 2) < 0) {
3259 goto L107;
3260 } else if (i__1 == 0) {
3261 goto L105;
3262 } else {
3263 goto L102;
3264 }
3265L102:
3266 idp2 = *ido + 2;
3267 i__1 = *l1;
3268 for (k = 1; k <= i__1; ++k) {
3269 i__2 = *ido;
3270 for (i__ = 3; i__ <= i__2; i__ += 2) {
3271 ic = idp2 - i__;
3272 cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
3273 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
3274 ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
3275 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
3276 cc_dim1];
3277 cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
3278 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
3279 ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
3280 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
3281 cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
3282 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
3283 ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
3284 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
3285 cc_dim1];
3286 tr1 = cr2 + cr4;
3287 tr4 = cr4 - cr2;
3288 ti1 = ci2 + ci4;
3289 ti4 = ci2 - ci4;
3290 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
3291 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
3292 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
3293 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
3294 ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
3295 ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
3296 ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
3297 ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
3298 ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
3299 ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
3300 ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
3301 ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
3302/* L103: */
3303 }
3304/* L104: */
3305 }
3306 if (*ido % 2 == 1) {
3307 return 0;
3308 }
3309L105:
3310 i__1 = *l1;
3311 for (k = 1; k <= i__1; ++k) {
3312 ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido +
3313 (k + (cc_dim2 << 2)) * cc_dim1]);
3314 tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + (
3315 k + (cc_dim2 << 2)) * cc_dim1]);
3316 ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) *
3317 cc_dim1];
3318 ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) *
3319 cc_dim1] - tr1;
3320 ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) *
3321 cc_dim1];
3322 ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) *
3323 cc_dim1];
3324/* L106: */
3325 }
3326L107:
3327 return 0;
3328} /* radf4_ */
3329
3330/* ------ File radf5.f ------ */
3331/* Subroutine */ int radf5_(integer *ido, integer *l1, real *cc, real *ch,
3332 real *wa1, real *wa2, real *wa3, real *wa4)
3333{
3334 /* Initialized data */
3335
3336 static real tr11 = .309016994374947f;
3337 static real ti11 = .951056516295154f;
3338 static real tr12 = -.809016994374947f;
3339 static real ti12 = .587785252292473f;
3340
3341 /* System generated locals */
3342 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
3343
3344 /* Local variables */
3345 static integer i__, k, ic;
3346 static real ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3,
3347 dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
3348 static integer idp2;
3349
3350 /* Parameter adjustments */
3351 ch_dim1 = *ido;
3352 ch_offset = ch_dim1 * 6 + 1;
3353 ch -= ch_offset;
3354 cc_dim1 = *ido;
3355 cc_dim2 = *l1;
3356 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
3357 cc -= cc_offset;
3358 --wa1;
3359 --wa2;
3360 --wa3;
3361 --wa4;
3362
3363 /* Function Body */
3364 i__1 = *l1;
3365 for (k = 1; k <= i__1; ++k) {
3366 cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) *
3367 cc_dim1 + 1];
3368 ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) *
3369 cc_dim1 + 1];
3370 cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
3371 cc_dim1 + 1];
3372 ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) *
3373 cc_dim1 + 1];
3374 ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2
3375 + cr3;
3376 ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
3377 tr11 * cr2 + tr12 * cr3;
3378 ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
3379 ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
3380 tr12 * cr2 + tr11 * cr3;
3381 ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
3382/* L101: */
3383 }
3384 if (*ido == 1) {
3385 return 0;
3386 }
3387 idp2 = *ido + 2;
3388 i__1 = *l1;
3389 for (k = 1; k <= i__1; ++k) {
3390 i__2 = *ido;
3391 for (i__ = 3; i__ <= i__2; i__ += 2) {
3392 ic = idp2 - i__;
3393 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
3394 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
3395 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
3396 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
3397 cc_dim1];
3398 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
3399 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
3400 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
3401 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
3402 dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
3403 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
3404 di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
3405 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
3406 cc_dim1];
3407 dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] +
3408 wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
3409 di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
3410 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
3411 cr2 = dr2 + dr5;
3412 ci5 = dr5 - dr2;
3413 cr5 = di2 - di5;
3414 ci2 = di2 + di5;
3415 cr3 = dr3 + dr4;
3416 ci4 = dr4 - dr3;
3417 cr4 = di3 - di4;
3418 ci3 = di3 + di4;
3419 ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
3420 cc_dim1] + cr2 + cr3;
3421 ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
3422 cc_dim1] + ci2 + ci3;
3423 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 *
3424 cr3;
3425 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
3426 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 *
3427 cr3;
3428 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
3429 tr5 = ti11 * cr5 + ti12 * cr4;
3430 ti5 = ti11 * ci5 + ti12 * ci4;
3431 tr4 = ti12 * cr5 - ti11 * cr4;
3432 ti4 = ti12 * ci5 - ti11 * ci4;
3433 ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
3434 ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
3435 ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
3436 ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
3437 ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
3438 ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
3439 ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
3440 ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
3441/* L102: */
3442 }
3443/* L103: */
3444 }
3445 return 0;
3446} /* radf5_ */
3447
3448/* ------ File radfg.f ------ */
3449/* Subroutine */ int radfg_(integer *ido, integer *ip, integer *l1, integer *
3450 idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
3451{
3452 /* Initialized data */
3453
3454 static real tpi = 6.28318530717959f;
3455
3456 /* System generated locals */
3457 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
3458 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
3459 i__1, i__2, i__3;
3460
3461 /* Builtin functions */
3462 double cos(doublereal), sin(doublereal);
3463
3464 /* Local variables */
3465 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
3466 static real dc2, ai1, ai2, ar1, ar2, ds2;
3467 static integer nbd;
3468 static real dcp, arg, dsp, ar1h, ar2h;
3469 static integer idp2, ipp2;
3470
3471 /* Parameter adjustments */
3472 ch_dim1 = *ido;
3473 ch_dim2 = *l1;
3474 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
3475 ch -= ch_offset;
3476 c1_dim1 = *ido;
3477 c1_dim2 = *l1;
3478 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
3479 c1 -= c1_offset;
3480 cc_dim1 = *ido;
3481 cc_dim2 = *ip;
3482 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
3483 cc -= cc_offset;
3484 ch2_dim1 = *idl1;
3485 ch2_offset = ch2_dim1 + 1;
3486 ch2 -= ch2_offset;
3487 c2_dim1 = *idl1;
3488 c2_offset = c2_dim1 + 1;
3489 c2 -= c2_offset;
3490 --wa;
3491
3492 /* Function Body */
3493 arg = tpi / (real) (*ip);
3494 dcp = cos(arg);
3495 dsp = sin(arg);
3496 ipph = (*ip + 1) / 2;
3497 ipp2 = *ip + 2;
3498 idp2 = *ido + 2;
3499 nbd = (*ido - 1) / 2;
3500 if (*ido == 1) {
3501 goto L119;
3502 }
3503 i__1 = *idl1;
3504 for (ik = 1; ik <= i__1; ++ik) {
3505 ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
3506/* L101: */
3507 }
3508 i__1 = *ip;
3509 for (j = 2; j <= i__1; ++j) {
3510 i__2 = *l1;
3511 for (k = 1; k <= i__2; ++k) {
3512 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
3513 c1_dim1 + 1];
3514/* L102: */
3515 }
3516/* L103: */
3517 }
3518 if (nbd > *l1) {
3519 goto L107;
3520 }
3521 is = -(*ido);
3522 i__1 = *ip;
3523 for (j = 2; j <= i__1; ++j) {
3524 is += *ido;
3525 idij = is;
3526 i__2 = *ido;
3527 for (i__ = 3; i__ <= i__2; i__ += 2) {
3528 idij += 2;
3529 i__3 = *l1;
3530 for (k = 1; k <= i__3; ++k) {
3531 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
3532 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
3533 c1[i__ + (k + j * c1_dim2) * c1_dim1];
3534 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
3535 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
3536 1 + (k + j * c1_dim2) * c1_dim1];
3537/* L104: */
3538 }
3539/* L105: */
3540 }
3541/* L106: */
3542 }
3543 goto L111;
3544L107:
3545 is = -(*ido);
3546 i__1 = *ip;
3547 for (j = 2; j <= i__1; ++j) {
3548 is += *ido;
3549 i__2 = *l1;
3550 for (k = 1; k <= i__2; ++k) {
3551 idij = is;
3552 i__3 = *ido;
3553 for (i__ = 3; i__ <= i__3; i__ += 2) {
3554 idij += 2;
3555 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
3556 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
3557 c1[i__ + (k + j * c1_dim2) * c1_dim1];
3558 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
3559 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
3560 1 + (k + j * c1_dim2) * c1_dim1];
3561/* L108: */
3562 }
3563/* L109: */
3564 }
3565/* L110: */
3566 }
3567L111:
3568 if (nbd < *l1) {
3569 goto L115;
3570 }
3571 i__1 = ipph;
3572 for (j = 2; j <= i__1; ++j) {
3573 jc = ipp2 - j;
3574 i__2 = *l1;
3575 for (k = 1; k <= i__2; ++k) {
3576 i__3 = *ido;
3577 for (i__ = 3; i__ <= i__3; i__ += 2) {
3578 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
3579 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
3580 ch_dim2) * ch_dim1];
3581 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
3582 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
3583 ch_dim1];
3584 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
3585 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
3586 ch_dim1];
3587 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
3588 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
3589 * ch_dim1];
3590/* L112: */
3591 }
3592/* L113: */
3593 }
3594/* L114: */
3595 }
3596 goto L121;
3597L115:
3598 i__1 = ipph;
3599 for (j = 2; j <= i__1; ++j) {
3600 jc = ipp2 - j;
3601 i__2 = *ido;
3602 for (i__ = 3; i__ <= i__2; i__ += 2) {
3603 i__3 = *l1;
3604 for (k = 1; k <= i__3; ++k) {
3605 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
3606 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
3607 ch_dim2) * ch_dim1];
3608 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
3609 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
3610 ch_dim1];
3611 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
3612 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
3613 ch_dim1];
3614 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
3615 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
3616 * ch_dim1];
3617/* L116: */
3618 }
3619/* L117: */
3620 }
3621/* L118: */
3622 }
3623 goto L121;
3624L119:
3625 i__1 = *idl1;
3626 for (ik = 1; ik <= i__1; ++ik) {
3627 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
3628/* L120: */
3629 }
3630L121:
3631 i__1 = ipph;
3632 for (j = 2; j <= i__1; ++j) {
3633 jc = ipp2 - j;
3634 i__2 = *l1;
3635 for (k = 1; k <= i__2; ++k) {
3636 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
3637 ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
3638 c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) *
3639 ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
3640/* L122: */
3641 }
3642/* L123: */
3643 }
3644
3645 ar1 = 1.f;
3646 ai1 = 0.f;
3647 i__1 = ipph;
3648 for (l = 2; l <= i__1; ++l) {
3649 lc = ipp2 - l;
3650 ar1h = dcp * ar1 - dsp * ai1;
3651 ai1 = dcp * ai1 + dsp * ar1;
3652 ar1 = ar1h;
3653 i__2 = *idl1;
3654 for (ik = 1; ik <= i__2; ++ik) {
3655 ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
3656 c2_dim1 << 1)];
3657 ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1];
3658/* L124: */
3659 }
3660 dc2 = ar1;
3661 ds2 = ai1;
3662 ar2 = ar1;
3663 ai2 = ai1;
3664 i__2 = ipph;
3665 for (j = 3; j <= i__2; ++j) {
3666 jc = ipp2 - j;
3667 ar2h = dc2 * ar2 - ds2 * ai2;
3668 ai2 = dc2 * ai2 + ds2 * ar2;
3669 ar2 = ar2h;
3670 i__3 = *idl1;
3671 for (ik = 1; ik <= i__3; ++ik) {
3672 ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
3673 ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
3674/* L125: */
3675 }
3676/* L126: */
3677 }
3678/* L127: */
3679 }
3680 i__1 = ipph;
3681 for (j = 2; j <= i__1; ++j) {
3682 i__2 = *idl1;
3683 for (ik = 1; ik <= i__2; ++ik) {
3684 ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
3685/* L128: */
3686 }
3687/* L129: */
3688 }
3689
3690 if (*ido < *l1) {
3691 goto L132;
3692 }
3693 i__1 = *l1;
3694 for (k = 1; k <= i__1; ++k) {
3695 i__2 = *ido;
3696 for (i__ = 1; i__ <= i__2; ++i__) {
3697 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
3698 ch_dim1];
3699/* L130: */
3700 }
3701/* L131: */
3702 }
3703 goto L135;
3704L132:
3705 i__1 = *ido;
3706 for (i__ = 1; i__ <= i__1; ++i__) {
3707 i__2 = *l1;
3708 for (k = 1; k <= i__2; ++k) {
3709 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
3710 ch_dim1];
3711/* L133: */
3712 }
3713/* L134: */
3714 }
3715L135:
3716 i__1 = ipph;
3717 for (j = 2; j <= i__1; ++j) {
3718 jc = ipp2 - j;
3719 j2 = j + j;
3720 i__2 = *l1;
3721 for (k = 1; k <= i__2; ++k) {
3722 cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
3723 * ch_dim1 + 1];
3724 cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
3725 ch_dim1 + 1];
3726/* L136: */
3727 }
3728/* L137: */
3729 }
3730 if (*ido == 1) {
3731 return 0;
3732 }
3733 if (nbd < *l1) {
3734 goto L141;
3735 }
3736 i__1 = ipph;
3737 for (j = 2; j <= i__1; ++j) {
3738 jc = ipp2 - j;
3739 j2 = j + j;
3740 i__2 = *l1;
3741 for (k = 1; k <= i__2; ++k) {
3742 i__3 = *ido;
3743 for (i__ = 3; i__ <= i__3; i__ += 2) {
3744 ic = idp2 - i__;
3745 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
3746 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
3747 ch_dim2) * ch_dim1];
3748 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
3749 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
3750 ch_dim2) * ch_dim1];
3751 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
3752 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
3753 ch_dim1];
3754 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
3755 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
3756 ch_dim1];
3757/* L138: */
3758 }
3759/* L139: */
3760 }
3761/* L140: */
3762 }
3763 return 0;
3764L141:
3765 i__1 = ipph;
3766 for (j = 2; j <= i__1; ++j) {
3767 jc = ipp2 - j;
3768 j2 = j + j;
3769 i__2 = *ido;
3770 for (i__ = 3; i__ <= i__2; i__ += 2) {
3771 ic = idp2 - i__;
3772 i__3 = *l1;
3773 for (k = 1; k <= i__3; ++k) {
3774 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
3775 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
3776 ch_dim2) * ch_dim1];
3777 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
3778 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
3779 ch_dim2) * ch_dim1];
3780 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
3781 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
3782 ch_dim1];
3783 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
3784 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
3785 ch_dim1];
3786/* L142: */
3787 }
3788/* L143: */
3789 }
3790/* L144: */
3791 }
3792 return 0;
3793} /* radfg_ */
3794
3795/* ------ File rfftb.f ------ */
3796/* Subroutine */ int rfftb_(integer *n, real *r__, real *wsave)
3797{
3798 extern /* Subroutine */ int rfftb1_(integer *, real *, real *, real *,
3799 integer *);
3800
3801 /* Parameter adjustments */
3802 --wsave;
3803 --r__;
3804
3805 /* Function Body */
3806 if (*n == 1) {
3807 return 0;
3808 }
3809 rfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
3810 return 0;
3811} /* rfftb_ */
3812
3813/* ------ File rfftb1.f ------ */
3814/* Subroutine */ int rfftb1_(integer *n, real *c__, real *ch, real *wa,
3815 integer *ifac)
3816{
3817 /* System generated locals */
3818 integer i__1;
3819
3820 /* Local variables */
3821 extern /* Subroutine */ int radb2_(integer *, integer *, real *, real *,
3822 real *), radb3_(integer *, integer *, real *, real *, real *,
3823 real *), radb4_(integer *, integer *, real *, real *, real *,
3824 real *, real *), radb5_(integer *, integer *, real *, real *,
3825 real *, real *, real *, real *);
3826 static integer i__;
3827 extern /* Subroutine */ int radbg_(integer *, integer *, integer *,
3828 integer *, real *, real *, real *, real *, real *, real *);
3829 static integer k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
3830
3831 /* Parameter adjustments */
3832 --ifac;
3833 --wa;
3834 --ch;
3835 --c__;
3836
3837 /* Function Body */
3838 nf = ifac[2];
3839 na = 0;
3840 l1 = 1;
3841 iw = 1;
3842 i__1 = nf;
3843 for (k1 = 1; k1 <= i__1; ++k1) {
3844 ip = ifac[k1 + 2];
3845 l2 = ip * l1;
3846 ido = *n / l2;
3847 idl1 = ido * l1;
3848 if (ip != 4) {
3849 goto L103;
3850 }
3851 ix2 = iw + ido;
3852 ix3 = ix2 + ido;
3853 if (na != 0) {
3854 goto L101;
3855 }
3856 radb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
3857 goto L102;
3858L101:
3859 radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
3860L102:
3861 na = 1 - na;
3862 goto L115;
3863L103:
3864 if (ip != 2) {
3865 goto L106;
3866 }
3867 if (na != 0) {
3868 goto L104;
3869 }
3870 radb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
3871 goto L105;
3872L104:
3873 radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
3874L105:
3875 na = 1 - na;
3876 goto L115;
3877L106:
3878 if (ip != 3) {
3879 goto L109;
3880 }
3881 ix2 = iw + ido;
3882 if (na != 0) {
3883 goto L107;
3884 }
3885 radb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
3886 goto L108;
3887L107:
3888 radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
3889L108:
3890 na = 1 - na;
3891 goto L115;
3892L109:
3893 if (ip != 5) {
3894 goto L112;
3895 }
3896 ix2 = iw + ido;
3897 ix3 = ix2 + ido;
3898 ix4 = ix3 + ido;
3899 if (na != 0) {
3900 goto L110;
3901 }
3902 radb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
3903 ix4]);
3904 goto L111;
3905L110:
3906 radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
3907 ix4]);
3908L111:
3909 na = 1 - na;
3910 goto L115;
3911L112:
3912 if (na != 0) {
3913 goto L113;
3914 }
3915 radbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
3916 1], &wa[iw]);
3917 goto L114;
3918L113:
3919 radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
3920 , &wa[iw]);
3921L114:
3922 if (ido == 1) {
3923 na = 1 - na;
3924 }
3925L115:
3926 l1 = l2;
3927 iw += (ip - 1) * ido;
3928/* L116: */
3929 }
3930 if (na == 0) {
3931 return 0;
3932 }
3933 i__1 = *n;
3934 for (i__ = 1; i__ <= i__1; ++i__) {
3935 c__[i__] = ch[i__];
3936/* L117: */
3937 }
3938 return 0;
3939} /* rfftb1_ */
3940
3941/* ------ File rfftf.f ------ */
3942/* Subroutine */ int rfftf_(integer *n, real *r__, real *wsave)
3943{
3944 extern /* Subroutine */ int rfftf1_(integer *, real *, real *, real *,
3945 integer *);
3946
3947 /* Parameter adjustments */
3948 --wsave;
3949 --r__;
3950
3951 /* Function Body */
3952 if (*n == 1) {
3953 return 0;
3954 }
3955 rfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
3956 return 0;
3957} /* rfftf_ */
3958
3959/* ------ File rfftf1.f ------ */
3960/* Subroutine */ int rfftf1_(integer *n, real *c__, real *ch, real *wa,
3961 integer *ifac)
3962{
3963 /* System generated locals */
3964 integer i__1;
3965
3966 /* Local variables */
3967 extern /* Subroutine */ int radf2_(integer *, integer *, real *, real *,
3968 real *), radf3_(integer *, integer *, real *, real *, real *,
3969 real *), radf4_(integer *, integer *, real *, real *, real *,
3970 real *, real *), radf5_(integer *, integer *, real *, real *,
3971 real *, real *, real *, real *);
3972 static integer i__;
3973 extern /* Subroutine */ int radfg_(integer *, integer *, integer *,
3974 integer *, real *, real *, real *, real *, real *, real *);
3975 static integer k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
3976
3977 /* Parameter adjustments */
3978 --ifac;
3979 --wa;
3980 --ch;
3981 --c__;
3982
3983 /* Function Body */
3984 nf = ifac[2];
3985 na = 1;
3986 l2 = *n;
3987 iw = *n;
3988 i__1 = nf;
3989 for (k1 = 1; k1 <= i__1; ++k1) {
3990 kh = nf - k1;
3991 ip = ifac[kh + 3];
3992 l1 = l2 / ip;
3993 ido = *n / l2;
3994 idl1 = ido * l1;
3995 iw -= (ip - 1) * ido;
3996 na = 1 - na;
3997 if (ip != 4) {
3998 goto L102;
3999 }
4000 ix2 = iw + ido;
4001 ix3 = ix2 + ido;
4002 if (na != 0) {
4003 goto L101;
4004 }
4005 radf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
4006 goto L110;
4007L101:
4008 radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4009 goto L110;
4010L102:
4011 if (ip != 2) {
4012 goto L104;
4013 }
4014 if (na != 0) {
4015 goto L103;
4016 }
4017 radf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
4018 goto L110;
4019L103:
4020 radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
4021 goto L110;
4022L104:
4023 if (ip != 3) {
4024 goto L106;
4025 }
4026 ix2 = iw + ido;
4027 if (na != 0) {
4028 goto L105;
4029 }
4030 radf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
4031 goto L110;
4032L105:
4033 radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4034 goto L110;
4035L106:
4036 if (ip != 5) {
4037 goto L108;
4038 }
4039 ix2 = iw + ido;
4040 ix3 = ix2 + ido;
4041 ix4 = ix3 + ido;
4042 if (na != 0) {
4043 goto L107;
4044 }
4045 radf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4046 ix4]);
4047 goto L110;
4048L107:
4049 radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4050 ix4]);
4051 goto L110;
4052L108:
4053 if (ido == 1) {
4054 na = 1 - na;
4055 }
4056 if (na != 0) {
4057 goto L109;
4058 }
4059 radfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
4060 1], &wa[iw]);
4061 na = 1;
4062 goto L110;
4063L109:
4064 radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
4065 , &wa[iw]);
4066 na = 0;
4067L110:
4068 l2 = l1;
4069/* L111: */
4070 }
4071 if (na == 1) {
4072 return 0;
4073 }
4074 i__1 = *n;
4075 for (i__ = 1; i__ <= i__1; ++i__) {
4076 c__[i__] = ch[i__];
4077/* L112: */
4078 }
4079 return 0;
4080} /* rfftf1_ */
4081
4082/* ------ File rffti.f ------ */
4083/* Subroutine */ int rffti_(integer *n, real *wsave)
4084{
4085 extern /* Subroutine */ int rffti1_(integer *, real *, integer *);
4086
4087 /* Parameter adjustments */
4088 --wsave;
4089
4090 /* Function Body */
4091 if (*n == 1) {
4092 return 0;
4093 }
4094 rffti1_(n, &wsave[*n + 1], &wsave[(*n << 1) + 1]);
4095 return 0;
4096} /* rffti_ */
4097
4098/* ------ File rffti1.f ------ */
4099/* Subroutine */ int rffti1_(integer *n, real *wa, integer *ifac)
4100{
4101 /* Initialized data */
4102
4103 static integer ntryh[4] = { 4,2,3,5 };
4104
4105 /* System generated locals */
4106 integer i__1, i__2, i__3;
4107
4108 /* Builtin functions */
4109 double cos(doublereal), sin(doublereal);
4110
4111 /* Local variables */
4112 static real argh;
4113 static integer ntry, i__, j;
4114 static real argld;
4115 static integer k1, l1, l2, ib;
4116 static real fi;
4117 static integer ld, ii, nf, ip, nl, is, nq, nr;
4118 static real arg;
4119 static integer ido, ipm;
4120 static real tpi;
4121 static integer nfm1;
4122
4123 /* Parameter adjustments */
4124 --ifac;
4125 --wa;
4126
4127 /* Function Body */
4128 nl = *n;
4129 nf = 0;
4130 j = 0;
4131L101:
4132 ++j;
4133 if (j - 4 <= 0) {
4134 goto L102;
4135 } else {
4136 goto L103;
4137 }
4138L102:
4139 ntry = ntryh[j - 1];
4140 goto L104;
4141L103:
4142 ntry += 2;
4143L104:
4144 nq = nl / ntry;
4145 nr = nl - ntry * nq;
4146 if (nr != 0) {
4147 goto L101;
4148 } else {
4149 goto L105;
4150 }
4151L105:
4152 ++nf;
4153 ifac[nf + 2] = ntry;
4154 nl = nq;
4155 if (ntry != 2) {
4156 goto L107;
4157 }
4158 if (nf == 1) {
4159 goto L107;
4160 }
4161 i__1 = nf;
4162 for (i__ = 2; i__ <= i__1; ++i__) {
4163 ib = nf - i__ + 2;
4164 ifac[ib + 2] = ifac[ib + 1];
4165/* L106: */
4166 }
4167 ifac[3] = 2;
4168L107:
4169 if (nl != 1) {
4170 goto L104;
4171 }
4172 ifac[1] = *n;
4173 ifac[2] = nf;
4174 tpi = 6.28318530717959f;
4175 argh = tpi / (real) (*n);
4176 is = 0;
4177 nfm1 = nf - 1;
4178 l1 = 1;
4179 if (nfm1 == 0) {
4180 return 0;
4181 }
4182 i__1 = nfm1;
4183 for (k1 = 1; k1 <= i__1; ++k1) {
4184 ip = ifac[k1 + 2];
4185 ld = 0;
4186 l2 = l1 * ip;
4187 ido = *n / l2;
4188 ipm = ip - 1;
4189 i__2 = ipm;
4190 for (j = 1; j <= i__2; ++j) {
4191 ld += l1;
4192 i__ = is;
4193 argld = (real) ld * argh;
4194 fi = 0.f;
4195 i__3 = ido;
4196 for (ii = 3; ii <= i__3; ii += 2) {
4197 i__ += 2;
4198 fi += 1.f;
4199 arg = fi * argld;
4200 wa[i__ - 1] = cos(arg);
4201 wa[i__] = sin(arg);
4202/* L108: */
4203 }
4204 is += ido;
4205/* L109: */
4206 }
4207 l1 = l2;
4208/* L110: */
4209 }
4210 return 0;
4211} /* rffti1_ */
4212
4213/* ------ File sinqb.f ------ */
4214/* Subroutine */ int sinqb_(integer *n, real *x, real *wsave)
4215{
4216 /* System generated locals */
4217 integer i__1;
4218
4219 /* Local variables */
4220 static integer k;
4221 extern /* Subroutine */ int cosqb_(integer *, real *, real *);
4222 static real xhold;
4223 static integer kc, ns2;
4224
4225 /* Parameter adjustments */
4226 --wsave;
4227 --x;
4228
4229 /* Function Body */
4230 if (*n > 1) {
4231 goto L101;
4232 }
4233 x[1] *= 4.f;
4234 return 0;
4235L101:
4236 ns2 = *n / 2;
4237 i__1 = *n;
4238 for (k = 2; k <= i__1; k += 2) {
4239 x[k] = -x[k];
4240/* L102: */
4241 }
4242 cosqb_(n, &x[1], &wsave[1]);
4243 i__1 = ns2;
4244 for (k = 1; k <= i__1; ++k) {
4245 kc = *n - k;
4246 xhold = x[k];
4247 x[k] = x[kc + 1];
4248 x[kc + 1] = xhold;
4249/* L103: */
4250 }
4251 return 0;
4252} /* sinqb_ */
4253
4254/* ------ File sinqf.f ------ */
4255/* Subroutine */ int sinqf_(integer *n, real *x, real *wsave)
4256{
4257 /* System generated locals */
4258 integer i__1;
4259
4260 /* Local variables */
4261 static integer k;
4262 extern /* Subroutine */ int cosqf_(integer *, real *, real *);
4263 static real xhold;
4264 static integer kc, ns2;
4265
4266 /* Parameter adjustments */
4267 --wsave;
4268 --x;
4269
4270 /* Function Body */
4271 if (*n == 1) {
4272 return 0;
4273 }
4274 ns2 = *n / 2;
4275 i__1 = ns2;
4276 for (k = 1; k <= i__1; ++k) {
4277 kc = *n - k;
4278 xhold = x[k];
4279 x[k] = x[kc + 1];
4280 x[kc + 1] = xhold;
4281/* L101: */
4282 }
4283 cosqf_(n, &x[1], &wsave[1]);
4284 i__1 = *n;
4285 for (k = 2; k <= i__1; k += 2) {
4286 x[k] = -x[k];
4287/* L102: */
4288 }
4289 return 0;
4290} /* sinqf_ */
4291
4292/* ------ File sinqi.f ------ */
4293/* Subroutine */ int sinqi_(integer *n, real *wsave)
4294{
4295 extern /* Subroutine */ int cosqi_(integer *, real *);
4296
4297 /* Parameter adjustments */
4298 --wsave;
4299
4300 /* Function Body */
4301 cosqi_(n, &wsave[1]);
4302 return 0;
4303} /* sinqi_ */
4304
4305/* ------ File sint.f ------ */
4306/* Subroutine */ int sint_(integer *n, real *x, real *wsave)
4307{
4308 extern /* Subroutine */ int sint1_(integer *, real *, real *, real *,
4309 real *, integer *);
4310 static integer np1, iw1, iw2, iw3;
4311
4312 /* Parameter adjustments */
4313 --wsave;
4314 --x;
4315
4316 /* Function Body */
4317 np1 = *n + 1;
4318 iw1 = *n / 2 + 1;
4319 iw2 = iw1 + np1;
4320 iw3 = iw2 + np1;
4321 sint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], &wsave[iw3]);
4322 return 0;
4323} /* sint_ */
4324
4325/* ------ File sint1.f ------ */
4326/* Subroutine */ int sint1_(integer *n, real *war, real *was, real *xh, real *
4327 x, integer *ifac)
4328{
4329 /* Initialized data */
4330
4331 static real sqrt3 = 1.73205080756888f;
4332
4333 /* System generated locals */
4334 integer i__1;
4335
4336 /* Local variables */
4337 static integer modn, i__, k;
4338 static real xhold, t1, t2;
4339 extern /* Subroutine */ int rfftf1_(integer *, real *, real *, real *,
4340 integer *);
4341 static integer kc, np1, ns2;
4342
4343 /* Parameter adjustments */
4344 --ifac;
4345 --x;
4346 --xh;
4347 --was;
4348 --war;
4349
4350 /* Function Body */
4351 i__1 = *n;
4352 for (i__ = 1; i__ <= i__1; ++i__) {
4353 xh[i__] = war[i__];
4354 war[i__] = x[i__];
4355/* L100: */
4356 }
4357 if ((i__1 = *n - 2) < 0) {
4358 goto L101;
4359 } else if (i__1 == 0) {
4360 goto L102;
4361 } else {
4362 goto L103;
4363 }
4364L101:
4365 xh[1] += xh[1];
4366 goto L106;
4367L102:
4368 xhold = sqrt3 * (xh[1] + xh[2]);
4369 xh[2] = sqrt3 * (xh[1] - xh[2]);
4370 xh[1] = xhold;
4371 goto L106;
4372L103:
4373 np1 = *n + 1;
4374 ns2 = *n / 2;
4375 x[1] = 0.f;
4376 i__1 = ns2;
4377 for (k = 1; k <= i__1; ++k) {
4378 kc = np1 - k;
4379 t1 = xh[k] - xh[kc];
4380 t2 = was[k] * (xh[k] + xh[kc]);
4381 x[k + 1] = t1 + t2;
4382 x[kc + 1] = t2 - t1;
4383/* L104: */
4384 }
4385 modn = *n % 2;
4386 if (modn != 0) {
4387 x[ns2 + 2] = xh[ns2 + 1] * 4.f;
4388 }
4389 rfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
4390 xh[1] = x[1] * .5f;
4391 i__1 = *n;
4392 for (i__ = 3; i__ <= i__1; i__ += 2) {
4393 xh[i__ - 1] = -x[i__];
4394 xh[i__] = xh[i__ - 2] + x[i__ - 1];
4395/* L105: */
4396 }
4397 if (modn != 0) {
4398 goto L106;
4399 }
4400 xh[*n] = -x[*n + 1];
4401L106:
4402 i__1 = *n;
4403 for (i__ = 1; i__ <= i__1; ++i__) {
4404 x[i__] = war[i__];
4405 war[i__] = xh[i__];
4406/* L107: */
4407 }
4408 return 0;
4409} /* sint1_ */
4410
4411/* ------ File sinti.f ------ */
4412/* Subroutine */ int sinti_(integer *n, real *wsave)
4413{
4414 /* Initialized data */
4415
4416 static real pi = 3.14159265358979f;
4417
4418 /* System generated locals */
4419 integer i__1;
4420
4421 /* Builtin functions */
4422 double sin(doublereal);
4423
4424 /* Local variables */
4425 static integer k;
4426 extern /* Subroutine */ int rffti_(integer *, real *);
4427 static real dt;
4428 static integer np1, ns2;
4429
4430 /* Parameter adjustments */
4431 --wsave;
4432
4433 /* Function Body */
4434 if (*n <= 1) {
4435 return 0;
4436 }
4437 ns2 = *n / 2;
4438 np1 = *n + 1;
4439 dt = pi / (real) np1;
4440 i__1 = ns2;
4441 for (k = 1; k <= i__1; ++k) {
4442 wsave[k] = sin(k * dt) * 2.f;
4443/* L101: */
4444 }
4445 rffti_(&np1, &wsave[ns2 + 1]);
4446 return 0;
4447} /* sinti_ */
4448
4449/* make a double version of the library*/
4450
4451/* Subroutine */ int cdfftb_(integer *n, double *c__, double *wsave)
4452{
4453 extern /* Subroutine */ int cdfftb1_(integer *, double *, double *, double *,
4454 integer *);
4455 static integer iw1, iw2;
4456
4457 /* Parameter adjustments */
4458 --wsave;
4459 --c__;
4460
4461 /* Function Body */
4462 if (*n == 1) {
4463 return 0;
4464 }
4465 iw1 = *n + *n + 1;
4466 iw2 = iw1 + *n + *n;
4467 cdfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
4468 return 0;
4469} /* cdfftb_ */
4470
4471/* ------ File cdfftb1.f ------ */
4472/* Subroutine */ int cdfftb1_(integer *n, double *c__, double *ch, double *wa,
4473 integer *ifac)
4474{
4475 /* System generated locals */
4476 integer i__1;
4477
4478 /* Local variables */
4479 static integer idot, i__;
4480 extern /* Subroutine */ int dpassb_(integer *, integer *, integer *,
4481 integer *, integer *, double *, double *, double *, double *, double *,
4482 double *);
4483 static integer k1, l1, l2, n2;
4484 extern /* Subroutine */ int dpassb2_(integer *, integer *, double *, double *,
4485 double *), dpassb3_(integer *, integer *, double *, double *, double *,
4486 double *), dpassb4_(integer *, integer *, double *, double *, double *,
4487 double *, double *), dpassb5_(integer *, integer *, double *, double *,
4488 double *, double *, double *, double *);
4489 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
4490
4491 /* Parameter adjustments */
4492 --ifac;
4493 --wa;
4494 --ch;
4495 --c__;
4496
4497 /* Function Body */
4498 nf = ifac[2];
4499 na = 0;
4500 l1 = 1;
4501 iw = 1;
4502 i__1 = nf;
4503 for (k1 = 1; k1 <= i__1; ++k1) {
4504 ip = ifac[k1 + 2];
4505 l2 = ip * l1;
4506 ido = *n / l2;
4507 idot = ido + ido;
4508 idl1 = idot * l1;
4509 if (ip != 4) {
4510 goto L103;
4511 }
4512 ix2 = iw + idot;
4513 ix3 = ix2 + idot;
4514 if (na != 0) {
4515 goto L101;
4516 }
4517 dpassb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
4518 goto L102;
4519L101:
4520 dpassb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4521L102:
4522 na = 1 - na;
4523 goto L115;
4524L103:
4525 if (ip != 2) {
4526 goto L106;
4527 }
4528 if (na != 0) {
4529 goto L104;
4530 }
4531 dpassb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
4532 goto L105;
4533L104:
4534 dpassb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
4535L105:
4536 na = 1 - na;
4537 goto L115;
4538L106:
4539 if (ip != 3) {
4540 goto L109;
4541 }
4542 ix2 = iw + idot;
4543 if (na != 0) {
4544 goto L107;
4545 }
4546 dpassb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
4547 goto L108;
4548L107:
4549 dpassb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4550L108:
4551 na = 1 - na;
4552 goto L115;
4553L109:
4554 if (ip != 5) {
4555 goto L112;
4556 }
4557 ix2 = iw + idot;
4558 ix3 = ix2 + idot;
4559 ix4 = ix3 + idot;
4560 if (na != 0) {
4561 goto L110;
4562 }
4563 dpassb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4564 ix4]);
4565 goto L111;
4566L110:
4567 dpassb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4568 ix4]);
4569L111:
4570 na = 1 - na;
4571 goto L115;
4572L112:
4573 if (na != 0) {
4574 goto L113;
4575 }
4576 dpassb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
4577 , &ch[1], &wa[iw]);
4578 goto L114;
4579L113:
4580 dpassb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
4581 &c__[1], &wa[iw]);
4582L114:
4583 if (nac != 0) {
4584 na = 1 - na;
4585 }
4586L115:
4587 l1 = l2;
4588 iw += (ip - 1) * idot;
4589/* L116: */
4590 }
4591 if (na == 0) {
4592 return 0;
4593 }
4594 n2 = *n + *n;
4595 i__1 = n2;
4596 for (i__ = 1; i__ <= i__1; ++i__) {
4597 c__[i__] = ch[i__];
4598/* L117: */
4599 }
4600 return 0;
4601} /* cdfftb1_ */
4602
4603/* ------ File cdfftf.f ------ */
4604/* Subroutine */ int cdfftf_(integer *n, double *c__, double *wsave)
4605{
4606 extern /* Subroutine */ int cdfftf1_(integer *, double *, double *, double *,
4607 integer *);
4608 static integer iw1, iw2;
4609
4610 /* Parameter adjustments */
4611 --wsave;
4612 --c__;
4613
4614 /* Function Body */
4615 if (*n == 1) {
4616 return 0;
4617 }
4618 iw1 = *n + *n + 1;
4619 iw2 = iw1 + *n + *n;
4620 cdfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
4621 return 0;
4622} /* cdfftf_ */
4623
4624/* ------ File cdfftf1.f ------ */
4625/* Subroutine */ int cdfftf1_(integer *n, double *c__, double *ch, double *wa,
4626 integer *ifac)
4627{
4628 /* System generated locals */
4629 integer i__1;
4630
4631 /* Local variables */
4632 static integer idot, i__;
4633 extern /* Subroutine */ int dpassf_(integer *, integer *, integer *,
4634 integer *, integer *, double *, double *, double *, double *, double *,
4635 double *);
4636 static integer k1, l1, l2, n2;
4637 extern /* Subroutine */ int dpassf2_(integer *, integer *, double *, double *,
4638 double *), dpassf3_(integer *, integer *, double *, double *, double *,
4639 double *), dpassf4_(integer *, integer *, double *, double *, double *,
4640 double *, double *), dpassf5_(integer *, integer *, double *, double *,
4641 double *, double *, double *, double *);
4642 static integer na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
4643
4644 /* Parameter adjustments */
4645 --ifac;
4646 --wa;
4647 --ch;
4648 --c__;
4649
4650 /* Function Body */
4651 nf = ifac[2];
4652 na = 0;
4653 l1 = 1;
4654 iw = 1;
4655 i__1 = nf;
4656 for (k1 = 1; k1 <= i__1; ++k1) {
4657 ip = ifac[k1 + 2];
4658 l2 = ip * l1;
4659 ido = *n / l2;
4660 idot = ido + ido;
4661 idl1 = idot * l1;
4662 if (ip != 4) {
4663 goto L103;
4664 }
4665 ix2 = iw + idot;
4666 ix3 = ix2 + idot;
4667 if (na != 0) {
4668 goto L101;
4669 }
4670 dpassf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
4671 goto L102;
4672L101:
4673 dpassf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4674L102:
4675 na = 1 - na;
4676 goto L115;
4677L103:
4678 if (ip != 2) {
4679 goto L106;
4680 }
4681 if (na != 0) {
4682 goto L104;
4683 }
4684 dpassf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
4685 goto L105;
4686L104:
4687 dpassf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
4688L105:
4689 na = 1 - na;
4690 goto L115;
4691L106:
4692 if (ip != 3) {
4693 goto L109;
4694 }
4695 ix2 = iw + idot;
4696 if (na != 0) {
4697 goto L107;
4698 }
4699 dpassf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
4700 goto L108;
4701L107:
4702 dpassf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4703L108:
4704 na = 1 - na;
4705 goto L115;
4706L109:
4707 if (ip != 5) {
4708 goto L112;
4709 }
4710 ix2 = iw + idot;
4711 ix3 = ix2 + idot;
4712 ix4 = ix3 + idot;
4713 if (na != 0) {
4714 goto L110;
4715 }
4716 dpassf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4717 ix4]);
4718 goto L111;
4719L110:
4720 dpassf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4721 ix4]);
4722L111:
4723 na = 1 - na;
4724 goto L115;
4725L112:
4726 if (na != 0) {
4727 goto L113;
4728 }
4729 dpassf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
4730 , &ch[1], &wa[iw]);
4731 goto L114;
4732L113:
4733 dpassf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
4734 &c__[1], &wa[iw]);
4735L114:
4736 if (nac != 0) {
4737 na = 1 - na;
4738 }
4739L115:
4740 l1 = l2;
4741 iw += (ip - 1) * idot;
4742/* L116: */
4743 }
4744 if (na == 0) {
4745 return 0;
4746 }
4747 n2 = *n + *n;
4748 i__1 = n2;
4749 for (i__ = 1; i__ <= i__1; ++i__) {
4750 c__[i__] = ch[i__];
4751/* L117: */
4752 }
4753 return 0;
4754} /* cdfftf1_ */
4755
4756/* ------ File cdffti.f ------ */
4757/* Subroutine */ int cdffti_(integer *n, double *wsave)
4758{
4759 extern /* Subroutine */ int cdffti1_(integer *, double *, integer *);
4760 static integer iw1, iw2;
4761
4762 /* Parameter adjustments */
4763 --wsave;
4764
4765 /* Function Body */
4766 if (*n == 1) {
4767 return 0;
4768 }
4769 iw1 = *n + *n + 1;
4770 iw2 = iw1 + *n + *n;
4771 cdffti1_(n, &wsave[iw1], &wsave[iw2]);
4772 return 0;
4773} /* cdffti_ */
4774
4775/* ------ File cdffti1.f ------ */
4776/* Subroutine */ int cdffti1_(integer *n, double *wa, integer *ifac)
4777{
4778 /* Initialized data */
4779
4780 static integer ntryh[4] = { 3,4,2,5 };
4781
4782 /* System generated locals */
4783 integer i__1, i__2, i__3;
4784
4785 /* Builtin functions */
4786 double cos(doublereal), sin(doublereal);
4787
4788 /* Local variables */
4789 static double argh;
4790 static integer idot, ntry, i__, j;
4791 static double argld;
4792 static integer i1, k1, l1, l2, ib;
4793 static double fi;
4794 static integer ld, ii, nf, ip, nl, nq, nr;
4795 static double arg;
4796 static integer ido, ipm;
4797 static double tpi;
4798
4799 /* Parameter adjustments */
4800 --ifac;
4801 --wa;
4802
4803 /* Function Body */
4804 nl = *n;
4805 nf = 0;
4806 j = 0;
4807L101:
4808 ++j;
4809 if (j - 4 <= 0) {
4810 goto L102;
4811 } else {
4812 goto L103;
4813 }
4814L102:
4815 ntry = ntryh[j - 1];
4816 goto L104;
4817L103:
4818 ntry += 2;
4819L104:
4820 nq = nl / ntry;
4821 nr = nl - ntry * nq;
4822 if (nr != 0) {
4823 goto L101;
4824 } else {
4825 goto L105;
4826 }
4827L105:
4828 ++nf;
4829 ifac[nf + 2] = ntry;
4830 nl = nq;
4831 if (ntry != 2) {
4832 goto L107;
4833 }
4834 if (nf == 1) {
4835 goto L107;
4836 }
4837 i__1 = nf;
4838 for (i__ = 2; i__ <= i__1; ++i__) {
4839 ib = nf - i__ + 2;
4840 ifac[ib + 2] = ifac[ib + 1];
4841/* L106: */
4842 }
4843 ifac[3] = 2;
4844L107:
4845 if (nl != 1) {
4846 goto L104;
4847 }
4848 ifac[1] = *n;
4849 ifac[2] = nf;
4850 tpi = 6.28318530717959f;
4851 argh = tpi / (double) (*n);
4852 i__ = 2;
4853 l1 = 1;
4854 i__1 = nf;
4855 for (k1 = 1; k1 <= i__1; ++k1) {
4856 ip = ifac[k1 + 2];
4857 ld = 0;
4858 l2 = l1 * ip;
4859 ido = *n / l2;
4860 idot = ido + ido + 2;
4861 ipm = ip - 1;
4862 i__2 = ipm;
4863 for (j = 1; j <= i__2; ++j) {
4864 i1 = i__;
4865 wa[i__ - 1] = 1.f;
4866 wa[i__] = 0.f;
4867 ld += l1;
4868 fi = 0.f;
4869 argld = (double) ld * argh;
4870 i__3 = idot;
4871 for (ii = 4; ii <= i__3; ii += 2) {
4872 i__ += 2;
4873 fi += 1.f;
4874 arg = fi * argld;
4875 wa[i__ - 1] = cos(arg);
4876 wa[i__] = sin(arg);
4877/* L108: */
4878 }
4879 if (ip <= 5) {
4880 goto L109;
4881 }
4882 wa[i1 - 1] = wa[i__ - 1];
4883 wa[i1] = wa[i__];
4884L109:
4885 ;
4886 }
4887 l1 = l2;
4888/* L110: */
4889 }
4890 return 0;
4891} /* cdffti1_ */
4892
4893/* ------ File dcosqb.f ------ */
4894/* Subroutine */ int dcosqb_(integer *n, double *x, double *wsave)
4895{
4896 /* Initialized data */
4897
4898 static double tsqrt2 = 2.82842712474619f;
4899
4900 /* System generated locals */
4901 integer i__1;
4902
4903 /* Local variables */
4904 static double x1;
4905 extern /* Subroutine */ int dcosqb1_(integer *, double *, double *, double *);
4906
4907 /* Parameter adjustments */
4908 --wsave;
4909 --x;
4910
4911 /* Function Body */
4912 if ((i__1 = *n - 2) < 0) {
4913 goto L101;
4914 } else if (i__1 == 0) {
4915 goto L102;
4916 } else {
4917 goto L103;
4918 }
4919L101:
4920 x[1] *= 4.f;
4921 return 0;
4922L102:
4923 x1 = (x[1] + x[2]) * 4.f;
4924 x[2] = tsqrt2 * (x[1] - x[2]);
4925 x[1] = x1;
4926 return 0;
4927L103:
4928 dcosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
4929 return 0;
4930} /* dcosqb_ */
4931
4932/* ------ File dcosqb1.f ------ */
4933/* Subroutine */ int dcosqb1_(integer *n, double *x, double *w, double *xh)
4934{
4935 /* System generated locals */
4936 integer i__1;
4937
4938 /* Local variables */
4939 static integer modn, i__, k;
4940 extern /* Subroutine */ int dfftb_(integer *, double *, double *);
4941 static integer kc, np2, ns2;
4942 static double xim1;
4943
4944 /* Parameter adjustments */
4945 --xh;
4946 --w;
4947 --x;
4948
4949 /* Function Body */
4950 ns2 = (*n + 1) / 2;
4951 np2 = *n + 2;
4952 i__1 = *n;
4953 for (i__ = 3; i__ <= i__1; i__ += 2) {
4954 xim1 = x[i__ - 1] + x[i__];
4955 x[i__] -= x[i__ - 1];
4956 x[i__ - 1] = xim1;
4957/* L101: */
4958 }
4959 x[1] += x[1];
4960 modn = *n % 2;
4961 if (modn == 0) {
4962 x[*n] += x[*n];
4963 }
4964 dfftb_(n, &x[1], &xh[1]);
4965 i__1 = ns2;
4966 for (k = 2; k <= i__1; ++k) {
4967 kc = np2 - k;
4968 xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k];
4969 xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc];
4970/* L102: */
4971 }
4972 if (modn == 0) {
4973 x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]);
4974 }
4975 i__1 = ns2;
4976 for (k = 2; k <= i__1; ++k) {
4977 kc = np2 - k;
4978 x[k] = xh[k] + xh[kc];
4979 x[kc] = xh[k] - xh[kc];
4980/* L103: */
4981 }
4982 x[1] += x[1];
4983 return 0;
4984} /* dcosqb1_ */
4985
4986/* ------ File dcosqf.f ------ */
4987/* Subroutine */ int dcosqf_(integer *n, double *x, double *wsave)
4988{
4989 /* Initialized data */
4990
4991 static double sqrt2 = 1.4142135623731f;
4992
4993 /* System generated locals */
4994 integer i__1;
4995
4996 /* Local variables */
4997 static double tsqx;
4998 extern /* Subroutine */ int dcosqf1_(integer *, double *, double *, double *);
4999
5000 /* Parameter adjustments */
5001 --wsave;
5002 --x;
5003
5004 /* Function Body */
5005 if ((i__1 = *n - 2) < 0) {
5006 goto L102;
5007 } else if (i__1 == 0) {
5008 goto L101;
5009 } else {
5010 goto L103;
5011 }
5012L101:
5013 tsqx = sqrt2 * x[2];
5014 x[2] = x[1] - tsqx;
5015 x[1] += tsqx;
5016L102:
5017 return 0;
5018L103:
5019 dcosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
5020 return 0;
5021} /* dcosqf_ */
5022
5023/* ------ File dcosqf1.f ------ */
5024/* Subroutine */ int dcosqf1_(integer *n, double *x, double *w, double *xh)
5025{
5026 /* System generated locals */
5027 integer i__1;
5028
5029 /* Local variables */
5030 static integer modn, i__, k;
5031 extern /* Subroutine */ int dfftf_(integer *, double *, double *);
5032 static integer kc, np2, ns2;
5033 static double xim1;
5034
5035 /* Parameter adjustments */
5036 --xh;
5037 --w;
5038 --x;
5039
5040 /* Function Body */
5041 ns2 = (*n + 1) / 2;
5042 np2 = *n + 2;
5043 i__1 = ns2;
5044 for (k = 2; k <= i__1; ++k) {
5045 kc = np2 - k;
5046 xh[k] = x[k] + x[kc];
5047 xh[kc] = x[k] - x[kc];
5048/* L101: */
5049 }
5050 modn = *n % 2;
5051 if (modn == 0) {
5052 xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1];
5053 }
5054 i__1 = ns2;
5055 for (k = 2; k <= i__1; ++k) {
5056 kc = np2 - k;
5057 x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k];
5058 x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc];
5059/* L102: */
5060 }
5061 if (modn == 0) {
5062 x[ns2 + 1] = w[ns2] * xh[ns2 + 1];
5063 }
5064 dfftf_(n, &x[1], &xh[1]);
5065 i__1 = *n;
5066 for (i__ = 3; i__ <= i__1; i__ += 2) {
5067 xim1 = x[i__ - 1] - x[i__];
5068 x[i__] = x[i__ - 1] + x[i__];
5069 x[i__ - 1] = xim1;
5070/* L103: */
5071 }
5072 return 0;
5073} /* dcosqf1_ */
5074
5075/* ------ File dcosqi.f ------ */
5076/* Subroutine */ int dcosqi_(integer *n, double *wsave)
5077{
5078 /* Initialized data */
5079
5080 static double pih = 1.57079632679491f;
5081
5082 /* System generated locals */
5083 integer i__1;
5084
5085 /* Builtin functions */
5086 double cos(doublereal);
5087
5088 /* Local variables */
5089 static integer k;
5090 extern /* Subroutine */ int dffti_(integer *, double *);
5091 static double fk, dt;
5092
5093 /* Parameter adjustments */
5094 --wsave;
5095
5096 /* Function Body */
5097 dt = pih / (double) (*n);
5098 fk = 0.f;
5099 i__1 = *n;
5100 for (k = 1; k <= i__1; ++k) {
5101 fk += 1.f;
5102 wsave[k] = cos(fk * dt);
5103/* L101: */
5104 }
5105 dffti_(n, &wsave[*n + 1]);
5106 return 0;
5107} /* dcosqi_ */
5108
5109/* ------ File dcost.f ------ */
5110/* Subroutine */ int dcost_(integer *n, double *x, double *wsave)
5111{
5112 /* System generated locals */
5113 integer i__1;
5114
5115 /* Local variables */
5116 static integer modn, i__, k;
5117 extern /* Subroutine */ int dfftf_(integer *, double *, double *);
5118 static double c1, t1, t2;
5119 static integer kc;
5120 static double xi;
5121 static integer nm1, np1;
5122 static double x1h;
5123 static integer ns2;
5124 static double tx2, x1p3, xim2;
5125
5126 /* Parameter adjustments */
5127 --wsave;
5128 --x;
5129
5130 /* Function Body */
5131 nm1 = *n - 1;
5132 np1 = *n + 1;
5133 ns2 = *n / 2;
5134 if ((i__1 = *n - 2) < 0) {
5135 goto L106;
5136 } else if (i__1 == 0) {
5137 goto L101;
5138 } else {
5139 goto L102;
5140 }
5141L101:
5142 x1h = x[1] + x[2];
5143 x[2] = x[1] - x[2];
5144 x[1] = x1h;
5145 return 0;
5146L102:
5147 if (*n > 3) {
5148 goto L103;
5149 }
5150 x1p3 = x[1] + x[3];
5151 tx2 = x[2] + x[2];
5152 x[2] = x[1] - x[3];
5153 x[1] = x1p3 + tx2;
5154 x[3] = x1p3 - tx2;
5155 return 0;
5156L103:
5157 c1 = x[1] - x[*n];
5158 x[1] += x[*n];
5159 i__1 = ns2;
5160 for (k = 2; k <= i__1; ++k) {
5161 kc = np1 - k;
5162 t1 = x[k] + x[kc];
5163 t2 = x[k] - x[kc];
5164 c1 += wsave[kc] * t2;
5165 t2 = wsave[k] * t2;
5166 x[k] = t1 - t2;
5167 x[kc] = t1 + t2;
5168/* L104: */
5169 }
5170 modn = *n % 2;
5171 if (modn != 0) {
5172 x[ns2 + 1] += x[ns2 + 1];
5173 }
5174 dfftf_(&nm1, &x[1], &wsave[*n + 1]);
5175 xim2 = x[2];
5176 x[2] = c1;
5177 i__1 = *n;
5178 for (i__ = 4; i__ <= i__1; i__ += 2) {
5179 xi = x[i__];
5180 x[i__] = x[i__ - 2] - x[i__ - 1];
5181 x[i__ - 1] = xim2;
5182 xim2 = xi;
5183/* L105: */
5184 }
5185 if (modn != 0) {
5186 x[*n] = xim2;
5187 }
5188L106:
5189 return 0;
5190} /* dcost_ */
5191
5192/* ------ File dcosti.f ------ */
5193/* Subroutine */ int dcosti_(integer *n, double *wsave)
5194{
5195 /* Initialized data */
5196
5197 static double pi = 3.14159265358979f;
5198
5199 /* System generated locals */
5200 integer i__1;
5201
5202 /* Builtin functions */
5203 double sin(doublereal), cos(doublereal);
5204
5205 /* Local variables */
5206 static integer k;
5207 extern /* Subroutine */ int dffti_(integer *, double *);
5208 static integer kc;
5209 static double fk, dt;
5210 static integer nm1, np1, ns2;
5211
5212 /* Parameter adjustments */
5213 --wsave;
5214
5215 /* Function Body */
5216 if (*n <= 3) {
5217 return 0;
5218 }
5219 nm1 = *n - 1;
5220 np1 = *n + 1;
5221 ns2 = *n / 2;
5222 dt = pi / (double) nm1;
5223 fk = 0.f;
5224 i__1 = ns2;
5225 for (k = 2; k <= i__1; ++k) {
5226 kc = np1 - k;
5227 fk += 1.f;
5228 wsave[k] = sin(fk * dt) * 2.f;
5229 wsave[kc] = cos(fk * dt) * 2.f;
5230/* L101: */
5231 }
5232 dffti_(&nm1, &wsave[*n + 1]);
5233 return 0;
5234} /* dcosti_ */
5235
5236/* ------ File dezfft1.f ------ */
5237/* Subroutine */ int dezfft1_(integer *n, double *wa, integer *ifac)
5238{
5239 /* Initialized data */
5240
5241 static integer ntryh[4] = { 4,2,3,5 };
5242 static double tpi = 6.28318530717959f;
5243
5244 /* System generated locals */
5245 integer i__1, i__2, i__3;
5246
5247 /* Builtin functions */
5248 double cos(doublereal), sin(doublereal);
5249
5250 /* Local variables */
5251 static double argh;
5252 static integer ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr;
5253 static double ch1, sh1;
5254 static integer ido, ipm;
5255 static double dch1, ch1h, arg1, dsh1;
5256 static integer nfm1;
5257
5258 /* Parameter adjustments */
5259 --ifac;
5260 --wa;
5261
5262 /* Function Body */
5263 nl = *n;
5264 nf = 0;
5265 j = 0;
5266L101:
5267 ++j;
5268 if (j - 4 <= 0) {
5269 goto L102;
5270 } else {
5271 goto L103;
5272 }
5273L102:
5274 ntry = ntryh[j - 1];
5275 goto L104;
5276L103:
5277 ntry += 2;
5278L104:
5279 nq = nl / ntry;
5280 nr = nl - ntry * nq;
5281 if (nr != 0) {
5282 goto L101;
5283 } else {
5284 goto L105;
5285 }
5286L105:
5287 ++nf;
5288 ifac[nf + 2] = ntry;
5289 nl = nq;
5290 if (ntry != 2) {
5291 goto L107;
5292 }
5293 if (nf == 1) {
5294 goto L107;
5295 }
5296 i__1 = nf;
5297 for (i__ = 2; i__ <= i__1; ++i__) {
5298 ib = nf - i__ + 2;
5299 ifac[ib + 2] = ifac[ib + 1];
5300/* L106: */
5301 }
5302 ifac[3] = 2;
5303L107:
5304 if (nl != 1) {
5305 goto L104;
5306 }
5307 ifac[1] = *n;
5308 ifac[2] = nf;
5309 argh = tpi / (double) (*n);
5310 is = 0;
5311 nfm1 = nf - 1;
5312 l1 = 1;
5313 if (nfm1 == 0) {
5314 return 0;
5315 }
5316 i__1 = nfm1;
5317 for (k1 = 1; k1 <= i__1; ++k1) {
5318 ip = ifac[k1 + 2];
5319 l2 = l1 * ip;
5320 ido = *n / l2;
5321 ipm = ip - 1;
5322 arg1 = (double) l1 * argh;
5323 ch1 = 1.f;
5324 sh1 = 0.f;
5325 dch1 = cos(arg1);
5326 dsh1 = sin(arg1);
5327 i__2 = ipm;
5328 for (j = 1; j <= i__2; ++j) {
5329 ch1h = dch1 * ch1 - dsh1 * sh1;
5330 sh1 = dch1 * sh1 + dsh1 * ch1;
5331 ch1 = ch1h;
5332 i__ = is + 2;
5333 wa[i__ - 1] = ch1;
5334 wa[i__] = sh1;
5335 if (ido < 5) {
5336 goto L109;
5337 }
5338 i__3 = ido;
5339 for (ii = 5; ii <= i__3; ii += 2) {
5340 i__ += 2;
5341 wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2];
5342 wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3];
5343/* L108: */
5344 }
5345L109:
5346 is += ido;
5347/* L110: */
5348 }
5349 l1 = l2;
5350/* L111: */
5351 }
5352 return 0;
5353} /* dezfft1_ */
5354
5355/* ------ File dezfftb.f ------ */
5356/* Subroutine */ int dezfftb_(integer *n, double *r__, double *azero, double *a,
5357 double *b, double *wsave)
5358{
5359 /* System generated locals */
5360 integer i__1;
5361
5362 /* Local variables */
5363 static integer i__;
5364 extern /* Subroutine */ int dfftb_(integer *, double *, double *);
5365 static integer ns2;
5366
5367 /* Parameter adjustments */
5368 --wsave;
5369 --b;
5370 --a;
5371 --r__;
5372
5373 /* Function Body */
5374 if ((i__1 = *n - 2) < 0) {
5375 goto L101;
5376 } else if (i__1 == 0) {
5377 goto L102;
5378 } else {
5379 goto L103;
5380 }
5381L101:
5382 r__[1] = *azero;
5383 return 0;
5384L102:
5385 r__[1] = *azero + a[1];
5386 r__[2] = *azero - a[1];
5387 return 0;
5388L103:
5389 ns2 = (*n - 1) / 2;
5390 i__1 = ns2;
5391 for (i__ = 1; i__ <= i__1; ++i__) {
5392 r__[i__ * 2] = a[i__] * .5f;
5393 r__[(i__ << 1) + 1] = b[i__] * -.5f;
5394/* L104: */
5395 }
5396 r__[1] = *azero;
5397 if (*n % 2 == 0) {
5398 r__[*n] = a[ns2 + 1];
5399 }
5400 dfftb_(n, &r__[1], &wsave[*n + 1]);
5401 return 0;
5402} /* dezfftb_ */
5403
5404/* ------ File dezfftf.f ------ */
5405/* Subroutine */ int dezfftf_(integer *n, double *r__, double *azero, double *a,
5406 double *b, double *wsave)
5407{
5408 /* System generated locals */
5409 integer i__1;
5410
5411 /* Local variables */
5412 static integer i__;
5413 extern /* Subroutine */ int dfftf_(integer *, double *, double *);
5414 static double cf;
5415 static integer ns2;
5416 static double cfm;
5417 static integer ns2m;
5418
5419
5420/* VERSION 3 JUNE 1979 */
5421
5422 /* Parameter adjustments */
5423 --wsave;
5424 --b;
5425 --a;
5426 --r__;
5427
5428 /* Function Body */
5429 if ((i__1 = *n - 2) < 0) {
5430 goto L101;
5431 } else if (i__1 == 0) {
5432 goto L102;
5433 } else {
5434 goto L103;
5435 }
5436L101:
5437 *azero = r__[1];
5438 return 0;
5439L102:
5440 *azero = (r__[1] + r__[2]) * .5f;
5441 a[1] = (r__[1] - r__[2]) * .5f;
5442 return 0;
5443L103:
5444 i__1 = *n;
5445 for (i__ = 1; i__ <= i__1; ++i__) {
5446 wsave[i__] = r__[i__];
5447/* L104: */
5448 }
5449 dfftf_(n, &wsave[1], &wsave[*n + 1]);
5450 cf = 2.f / (double) (*n);
5451 cfm = -cf;
5452 *azero = cf * .5f * wsave[1];
5453 ns2 = (*n + 1) / 2;
5454 ns2m = ns2 - 1;
5455 i__1 = ns2m;
5456 for (i__ = 1; i__ <= i__1; ++i__) {
5457 a[i__] = cf * wsave[i__ * 2];
5458 b[i__] = cfm * wsave[(i__ << 1) + 1];
5459/* L105: */
5460 }
5461 if (*n % 2 == 1) {
5462 return 0;
5463 }
5464 a[ns2] = cf * .5f * wsave[*n];
5465 b[ns2] = 0.f;
5466 return 0;
5467} /* dezfftf_ */
5468
5469/* ------ File dezffti.f ------ */
5470/* Subroutine */ int dezffti_(integer *n, double *wsave)
5471{
5472 extern /* Subroutine */ int dezfft1_(integer *, double *, integer *);
5473
5474 /* Parameter adjustments */
5475 --wsave;
5476
5477 /* Function Body */
5478 if (*n == 1) {
5479 return 0;
5480 }
5481 dezfft1_(n, &wsave[(*n << 1) + 1], (integer*)&wsave[*n * 3 + 1]);
5482 return 0;
5483} /* dezffti_ */
5484
5485/* ------ File dpassb.f ------ */
5486/* Subroutine */ int dpassb_(integer *nac, integer *ido, integer *ip, integer *
5487 l1, integer *idl1, double *cc, double *c1, double *c2, double *ch, double *ch2,
5488 double *wa)
5489{
5490 /* System generated locals */
5491 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
5492 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
5493 i__1, i__2, i__3;
5494
5495 /* Local variables */
5496 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
5497 idl, inc, idp;
5498 static double wai, war;
5499 static integer ipp2;
5500
5501 /* Parameter adjustments */
5502 ch_dim1 = *ido;
5503 ch_dim2 = *l1;
5504 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5505 ch -= ch_offset;
5506 c1_dim1 = *ido;
5507 c1_dim2 = *l1;
5508 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
5509 c1 -= c1_offset;
5510 cc_dim1 = *ido;
5511 cc_dim2 = *ip;
5512 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
5513 cc -= cc_offset;
5514 ch2_dim1 = *idl1;
5515 ch2_offset = ch2_dim1 + 1;
5516 ch2 -= ch2_offset;
5517 c2_dim1 = *idl1;
5518 c2_offset = c2_dim1 + 1;
5519 c2 -= c2_offset;
5520 --wa;
5521
5522 /* Function Body */
5523 idot = *ido / 2;
5524 nt = *ip * *idl1;
5525 ipp2 = *ip + 2;
5526 ipph = (*ip + 1) / 2;
5527 idp = *ip * *ido;
5528
5529 if (*ido < *l1) {
5530 goto L106;
5531 }
5532 i__1 = ipph;
5533 for (j = 2; j <= i__1; ++j) {
5534 jc = ipp2 - j;
5535 i__2 = *l1;
5536 for (k = 1; k <= i__2; ++k) {
5537 i__3 = *ido;
5538 for (i__ = 1; i__ <= i__3; ++i__) {
5539 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5540 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
5541 cc_dim1];
5542 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5543 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
5544 cc_dim1];
5545/* L101: */
5546 }
5547/* L102: */
5548 }
5549/* L103: */
5550 }
5551 i__1 = *l1;
5552 for (k = 1; k <= i__1; ++k) {
5553 i__2 = *ido;
5554 for (i__ = 1; i__ <= i__2; ++i__) {
5555 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
5556 cc_dim1];
5557/* L104: */
5558 }
5559/* L105: */
5560 }
5561 goto L112;
5562L106:
5563 i__1 = ipph;
5564 for (j = 2; j <= i__1; ++j) {
5565 jc = ipp2 - j;
5566 i__2 = *ido;
5567 for (i__ = 1; i__ <= i__2; ++i__) {
5568 i__3 = *l1;
5569 for (k = 1; k <= i__3; ++k) {
5570 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5571 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
5572 cc_dim1];
5573 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5574 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
5575 cc_dim1];
5576/* L107: */
5577 }
5578/* L108: */
5579 }
5580/* L109: */
5581 }
5582 i__1 = *ido;
5583 for (i__ = 1; i__ <= i__1; ++i__) {
5584 i__2 = *l1;
5585 for (k = 1; k <= i__2; ++k) {
5586 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
5587 cc_dim1];
5588/* L110: */
5589 }
5590/* L111: */
5591 }
5592L112:
5593 idl = 2 - *ido;
5594 inc = 0;
5595 i__1 = ipph;
5596 for (l = 2; l <= i__1; ++l) {
5597 lc = ipp2 - l;
5598 idl += *ido;
5599 i__2 = *idl1;
5600 for (ik = 1; ik <= i__2; ++ik) {
5601 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
5602 + (ch2_dim1 << 1)];
5603 c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1];
5604/* L113: */
5605 }
5606 idlj = idl;
5607 inc += *ido;
5608 i__2 = ipph;
5609 for (j = 3; j <= i__2; ++j) {
5610 jc = ipp2 - j;
5611 idlj += inc;
5612 if (idlj > idp) {
5613 idlj -= idp;
5614 }
5615 war = wa[idlj - 1];
5616 wai = wa[idlj];
5617 i__3 = *idl1;
5618 for (ik = 1; ik <= i__3; ++ik) {
5619 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
5620 c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
5621/* L114: */
5622 }
5623/* L115: */
5624 }
5625/* L116: */
5626 }
5627 i__1 = ipph;
5628 for (j = 2; j <= i__1; ++j) {
5629 i__2 = *idl1;
5630 for (ik = 1; ik <= i__2; ++ik) {
5631 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
5632/* L117: */
5633 }
5634/* L118: */
5635 }
5636 i__1 = ipph;
5637 for (j = 2; j <= i__1; ++j) {
5638 jc = ipp2 - j;
5639 i__2 = *idl1;
5640 for (ik = 2; ik <= i__2; ik += 2) {
5641 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
5642 jc * c2_dim1];
5643 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
5644 jc * c2_dim1];
5645 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
5646 c2_dim1];
5647 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
5648 c2_dim1];
5649/* L119: */
5650 }
5651/* L120: */
5652 }
5653 *nac = 1;
5654 if (*ido == 2) {
5655 return 0;
5656 }
5657 *nac = 0;
5658 i__1 = *idl1;
5659 for (ik = 1; ik <= i__1; ++ik) {
5660 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
5661/* L121: */
5662 }
5663 i__1 = *ip;
5664 for (j = 2; j <= i__1; ++j) {
5665 i__2 = *l1;
5666 for (k = 1; k <= i__2; ++k) {
5667 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
5668 ch_dim1 + 1];
5669 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
5670 ch_dim1 + 2];
5671/* L122: */
5672 }
5673/* L123: */
5674 }
5675 if (idot > *l1) {
5676 goto L127;
5677 }
5678 idij = 0;
5679 i__1 = *ip;
5680 for (j = 2; j <= i__1; ++j) {
5681 idij += 2;
5682 i__2 = *ido;
5683 for (i__ = 4; i__ <= i__2; i__ += 2) {
5684 idij += 2;
5685 i__3 = *l1;
5686 for (k = 1; k <= i__3; ++k) {
5687 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
5688 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
5689 ch[i__ + (k + j * ch_dim2) * ch_dim1];
5690 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
5691 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
5692 1 + (k + j * ch_dim2) * ch_dim1];
5693/* L124: */
5694 }
5695/* L125: */
5696 }
5697/* L126: */
5698 }
5699 return 0;
5700L127:
5701 idj = 2 - *ido;
5702 i__1 = *ip;
5703 for (j = 2; j <= i__1; ++j) {
5704 idj += *ido;
5705 i__2 = *l1;
5706 for (k = 1; k <= i__2; ++k) {
5707 idij = idj;
5708 i__3 = *ido;
5709 for (i__ = 4; i__ <= i__3; i__ += 2) {
5710 idij += 2;
5711 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
5712 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
5713 ch[i__ + (k + j * ch_dim2) * ch_dim1];
5714 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
5715 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
5716 1 + (k + j * ch_dim2) * ch_dim1];
5717/* L128: */
5718 }
5719/* L129: */
5720 }
5721/* L130: */
5722 }
5723 return 0;
5724} /* dpassb_ */
5725
5726/* ------ File dpassb2.f ------ */
5727/* Subroutine */ int dpassb2_(integer *ido, integer *l1, double *cc, double *ch,
5728 double *wa1)
5729{
5730 /* System generated locals */
5731 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5732
5733 /* Local variables */
5734 static integer i__, k;
5735 static double ti2, tr2;
5736
5737 /* Parameter adjustments */
5738 ch_dim1 = *ido;
5739 ch_dim2 = *l1;
5740 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5741 ch -= ch_offset;
5742 cc_dim1 = *ido;
5743 cc_offset = cc_dim1 * 3 + 1;
5744 cc -= cc_offset;
5745 --wa1;
5746
5747 /* Function Body */
5748 if (*ido > 2) {
5749 goto L102;
5750 }
5751 i__1 = *l1;
5752 for (k = 1; k <= i__1; ++k) {
5753 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
5754 cc[((k << 1) + 2) * cc_dim1 + 1];
5755 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
5756 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
5757 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
5758 cc[((k << 1) + 2) * cc_dim1 + 2];
5759 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
5760 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
5761/* L101: */
5762 }
5763 return 0;
5764L102:
5765 i__1 = *l1;
5766 for (k = 1; k <= i__1; ++k) {
5767 i__2 = *ido;
5768 for (i__ = 2; i__ <= i__2; i__ += 2) {
5769 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
5770 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
5771 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
5772 1) + 2) * cc_dim1];
5773 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
5774 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
5775 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
5776 * cc_dim1];
5777 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 +
5778 wa1[i__] * tr2;
5779 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
5780 - wa1[i__] * ti2;
5781/* L103: */
5782 }
5783/* L104: */
5784 }
5785 return 0;
5786} /* dpassb2_ */
5787
5788/* ------ File dpassb3.f ------ */
5789/* Subroutine */ int dpassb3_(integer *ido, integer *l1, double *cc, double *ch,
5790 double *wa1, double *wa2)
5791{
5792 /* Initialized data */
5793
5794 static double taur = -.5f;
5795 static double taui = .866025403784439f;
5796
5797 /* System generated locals */
5798 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5799
5800 /* Local variables */
5801 static integer i__, k;
5802 static double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
5803
5804 /* Parameter adjustments */
5805 ch_dim1 = *ido;
5806 ch_dim2 = *l1;
5807 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5808 ch -= ch_offset;
5809 cc_dim1 = *ido;
5810 cc_offset = (cc_dim1 << 2) + 1;
5811 cc -= cc_offset;
5812 --wa1;
5813 --wa2;
5814
5815 /* Function Body */
5816 if (*ido != 2) {
5817 goto L102;
5818 }
5819 i__1 = *l1;
5820 for (k = 1; k <= i__1; ++k) {
5821 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
5822 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
5823 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
5824 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
5825 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
5826 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
5827 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
5828 cc_dim1 + 1]);
5829 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
5830 cc_dim1 + 2]);
5831 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
5832 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
5833 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
5834 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
5835/* L101: */
5836 }
5837 return 0;
5838L102:
5839 i__1 = *l1;
5840 for (k = 1; k <= i__1; ++k) {
5841 i__2 = *ido;
5842 for (i__ = 2; i__ <= i__2; i__ += 2) {
5843 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
5844 3) * cc_dim1];
5845 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
5846 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
5847 cc_dim1] + tr2;
5848 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
5849 cc_dim1];
5850 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
5851 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
5852 cc_dim1] + ti2;
5853 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
5854 k * 3 + 3) * cc_dim1]);
5855 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
5856 3) * cc_dim1]);
5857 dr2 = cr2 - ci3;
5858 dr3 = cr2 + ci3;
5859 di2 = ci2 + cr3;
5860 di3 = ci2 - cr3;
5861 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
5862 wa1[i__] * dr2;
5863 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
5864 - wa1[i__] * di2;
5865 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
5866 i__] * dr3;
5867 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
5868 wa2[i__] * di3;
5869/* L103: */
5870 }
5871/* L104: */
5872 }
5873 return 0;
5874} /* dpassb3_ */
5875
5876/* ------ File dpassb4.f ------ */
5877/* Subroutine */ int dpassb4_(integer *ido, integer *l1, double *cc, double *ch,
5878 double *wa1, double *wa2, double *wa3)
5879{
5880 /* System generated locals */
5881 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5882
5883 /* Local variables */
5884 static integer i__, k;
5885 static double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
5886 tr3, tr4;
5887
5888 /* Parameter adjustments */
5889 ch_dim1 = *ido;
5890 ch_dim2 = *l1;
5891 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5892 ch -= ch_offset;
5893 cc_dim1 = *ido;
5894 cc_offset = cc_dim1 * 5 + 1;
5895 cc -= cc_offset;
5896 --wa1;
5897 --wa2;
5898 --wa3;
5899
5900 /* Function Body */
5901 if (*ido != 2) {
5902 goto L102;
5903 }
5904 i__1 = *l1;
5905 for (k = 1; k <= i__1; ++k) {
5906 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
5907 + 2];
5908 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
5909 + 2];
5910 tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1
5911 + 2];
5912 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
5913 + 2];
5914 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
5915 + 1];
5916 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
5917 + 1];
5918 ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1
5919 + 1];
5920 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
5921 + 1];
5922 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
5923 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
5924 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
5925 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
5926 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
5927 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
5928 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
5929 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
5930/* L101: */
5931 }
5932 return 0;
5933L102:
5934 i__1 = *l1;
5935 for (k = 1; k <= i__1; ++k) {
5936 i__2 = *ido;
5937 for (i__ = 2; i__ <= i__2; i__ += 2) {
5938 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
5939 * cc_dim1];
5940 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
5941 * cc_dim1];
5942 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
5943 * cc_dim1];
5944 tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
5945 * cc_dim1];
5946 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
5947 2) + 3) * cc_dim1];
5948 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
5949 2) + 3) * cc_dim1];
5950 ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
5951 2) + 4) * cc_dim1];
5952 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
5953 2) + 4) * cc_dim1];
5954 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
5955 cr3 = tr2 - tr3;
5956 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
5957 ci3 = ti2 - ti3;
5958 cr2 = tr1 + tr4;
5959 cr4 = tr1 - tr4;
5960 ci2 = ti1 + ti4;
5961 ci4 = ti1 - ti4;
5962 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
5963 - wa1[i__] * ci2;
5964 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 +
5965 wa1[i__] * cr2;
5966 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 -
5967 wa2[i__] * ci3;
5968 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
5969 i__] * cr3;
5970 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
5971 - wa3[i__] * ci4;
5972 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 +
5973 wa3[i__] * cr4;
5974/* L103: */
5975 }
5976/* L104: */
5977 }
5978 return 0;
5979} /* dpassb4_ */
5980
5981/* ------ File dpassb5.f ------ */
5982/* Subroutine */ int dpassb5_(integer *ido, integer *l1, double *cc, double *ch,
5983 double *wa1, double *wa2, double *wa3, double *wa4)
5984{
5985 /* Initialized data */
5986
5987 static double tr11 = .309016994374947f;
5988 static double ti11 = .951056516295154f;
5989 static double tr12 = -.809016994374947f;
5990 static double ti12 = .587785252292473f;
5991
5992 /* System generated locals */
5993 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5994
5995 /* Local variables */
5996 static integer i__, k;
5997 static double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
5998 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
5999
6000 /* Parameter adjustments */
6001 ch_dim1 = *ido;
6002 ch_dim2 = *l1;
6003 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6004 ch -= ch_offset;
6005 cc_dim1 = *ido;
6006 cc_offset = cc_dim1 * 6 + 1;
6007 cc -= cc_offset;
6008 --wa1;
6009 --wa2;
6010 --wa3;
6011 --wa4;
6012
6013 /* Function Body */
6014 if (*ido != 2) {
6015 goto L102;
6016 }
6017 i__1 = *l1;
6018 for (k = 1; k <= i__1; ++k) {
6019 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
6020 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
6021 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
6022 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
6023 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
6024 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
6025 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
6026 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
6027 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
6028 + tr3;
6029 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
6030 + ti3;
6031 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
6032 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
6033 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
6034 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
6035 cr5 = ti11 * tr5 + ti12 * tr4;
6036 ci5 = ti11 * ti5 + ti12 * ti4;
6037 cr4 = ti12 * tr5 - ti11 * tr4;
6038 ci4 = ti12 * ti5 - ti11 * ti4;
6039 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
6040 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
6041 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
6042 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
6043 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
6044 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
6045 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
6046 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
6047/* L101: */
6048 }
6049 return 0;
6050L102:
6051 i__1 = *l1;
6052 for (k = 1; k <= i__1; ++k) {
6053 i__2 = *ido;
6054 for (i__ = 2; i__ <= i__2; i__ += 2) {
6055 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
6056 cc_dim1];
6057 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
6058 cc_dim1];
6059 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
6060 cc_dim1];
6061 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
6062 cc_dim1];
6063 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6064 5) * cc_dim1];
6065 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6066 5) * cc_dim1];
6067 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6068 4) * cc_dim1];
6069 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6070 4) * cc_dim1];
6071 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
6072 cc_dim1] + tr2 + tr3;
6073 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
6074 cc_dim1] + ti2 + ti3;
6075 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
6076 tr3;
6077 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
6078 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
6079 tr3;
6080 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
6081 cr5 = ti11 * tr5 + ti12 * tr4;
6082 ci5 = ti11 * ti5 + ti12 * ti4;
6083 cr4 = ti12 * tr5 - ti11 * tr4;
6084 ci4 = ti12 * ti5 - ti11 * ti4;
6085 dr3 = cr3 - ci4;
6086 dr4 = cr3 + ci4;
6087 di3 = ci3 + cr4;
6088 di4 = ci3 - cr4;
6089 dr5 = cr2 + ci5;
6090 dr2 = cr2 - ci5;
6091 di5 = ci2 - cr5;
6092 di2 = ci2 + cr5;
6093 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6094 - wa1[i__] * di2;
6095 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
6096 wa1[i__] * dr2;
6097 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
6098 wa2[i__] * di3;
6099 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
6100 i__] * dr3;
6101 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
6102 - wa3[i__] * di4;
6103 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 +
6104 wa3[i__] * dr4;
6105 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 -
6106 wa4[i__] * di5;
6107 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
6108 i__] * dr5;
6109/* L103: */
6110 }
6111/* L104: */
6112 }
6113 return 0;
6114} /* dpassb5_ */
6115
6116/* ------ File dpassf.f ------ */
6117/* Subroutine */ int dpassf_(integer *nac, integer *ido, integer *ip, integer *
6118 l1, integer *idl1, double *cc, double *c1, double *c2, double *ch, double *ch2,
6119 double *wa)
6120{
6121 /* System generated locals */
6122 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
6123 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
6124 i__1, i__2, i__3;
6125
6126 /* Local variables */
6127 static integer idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
6128 idl, inc, idp;
6129 static double wai, war;
6130 static integer ipp2;
6131
6132 /* Parameter adjustments */
6133 ch_dim1 = *ido;
6134 ch_dim2 = *l1;
6135 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6136 ch -= ch_offset;
6137 c1_dim1 = *ido;
6138 c1_dim2 = *l1;
6139 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
6140 c1 -= c1_offset;
6141 cc_dim1 = *ido;
6142 cc_dim2 = *ip;
6143 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
6144 cc -= cc_offset;
6145 ch2_dim1 = *idl1;
6146 ch2_offset = ch2_dim1 + 1;
6147 ch2 -= ch2_offset;
6148 c2_dim1 = *idl1;
6149 c2_offset = c2_dim1 + 1;
6150 c2 -= c2_offset;
6151 --wa;
6152
6153 /* Function Body */
6154 idot = *ido / 2;
6155 nt = *ip * *idl1;
6156 ipp2 = *ip + 2;
6157 ipph = (*ip + 1) / 2;
6158 idp = *ip * *ido;
6159
6160 if (*ido < *l1) {
6161 goto L106;
6162 }
6163 i__1 = ipph;
6164 for (j = 2; j <= i__1; ++j) {
6165 jc = ipp2 - j;
6166 i__2 = *l1;
6167 for (k = 1; k <= i__2; ++k) {
6168 i__3 = *ido;
6169 for (i__ = 1; i__ <= i__3; ++i__) {
6170 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6171 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
6172 cc_dim1];
6173 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6174 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
6175 cc_dim1];
6176/* L101: */
6177 }
6178/* L102: */
6179 }
6180/* L103: */
6181 }
6182 i__1 = *l1;
6183 for (k = 1; k <= i__1; ++k) {
6184 i__2 = *ido;
6185 for (i__ = 1; i__ <= i__2; ++i__) {
6186 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
6187 cc_dim1];
6188/* L104: */
6189 }
6190/* L105: */
6191 }
6192 goto L112;
6193L106:
6194 i__1 = ipph;
6195 for (j = 2; j <= i__1; ++j) {
6196 jc = ipp2 - j;
6197 i__2 = *ido;
6198 for (i__ = 1; i__ <= i__2; ++i__) {
6199 i__3 = *l1;
6200 for (k = 1; k <= i__3; ++k) {
6201 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6202 cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
6203 cc_dim1];
6204 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6205 cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
6206 cc_dim1];
6207/* L107: */
6208 }
6209/* L108: */
6210 }
6211/* L109: */
6212 }
6213 i__1 = *ido;
6214 for (i__ = 1; i__ <= i__1; ++i__) {
6215 i__2 = *l1;
6216 for (k = 1; k <= i__2; ++k) {
6217 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
6218 cc_dim1];
6219/* L110: */
6220 }
6221/* L111: */
6222 }
6223L112:
6224 idl = 2 - *ido;
6225 inc = 0;
6226 i__1 = ipph;
6227 for (l = 2; l <= i__1; ++l) {
6228 lc = ipp2 - l;
6229 idl += *ido;
6230 i__2 = *idl1;
6231 for (ik = 1; ik <= i__2; ++ik) {
6232 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
6233 + (ch2_dim1 << 1)];
6234 c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1];
6235/* L113: */
6236 }
6237 idlj = idl;
6238 inc += *ido;
6239 i__2 = ipph;
6240 for (j = 3; j <= i__2; ++j) {
6241 jc = ipp2 - j;
6242 idlj += inc;
6243 if (idlj > idp) {
6244 idlj -= idp;
6245 }
6246 war = wa[idlj - 1];
6247 wai = wa[idlj];
6248 i__3 = *idl1;
6249 for (ik = 1; ik <= i__3; ++ik) {
6250 c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
6251 c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
6252/* L114: */
6253 }
6254/* L115: */
6255 }
6256/* L116: */
6257 }
6258 i__1 = ipph;
6259 for (j = 2; j <= i__1; ++j) {
6260 i__2 = *idl1;
6261 for (ik = 1; ik <= i__2; ++ik) {
6262 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
6263/* L117: */
6264 }
6265/* L118: */
6266 }
6267 i__1 = ipph;
6268 for (j = 2; j <= i__1; ++j) {
6269 jc = ipp2 - j;
6270 i__2 = *idl1;
6271 for (ik = 2; ik <= i__2; ik += 2) {
6272 ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
6273 jc * c2_dim1];
6274 ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
6275 jc * c2_dim1];
6276 ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
6277 c2_dim1];
6278 ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
6279 c2_dim1];
6280/* L119: */
6281 }
6282/* L120: */
6283 }
6284 *nac = 1;
6285 if (*ido == 2) {
6286 return 0;
6287 }
6288 *nac = 0;
6289 i__1 = *idl1;
6290 for (ik = 1; ik <= i__1; ++ik) {
6291 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
6292/* L121: */
6293 }
6294 i__1 = *ip;
6295 for (j = 2; j <= i__1; ++j) {
6296 i__2 = *l1;
6297 for (k = 1; k <= i__2; ++k) {
6298 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
6299 ch_dim1 + 1];
6300 c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
6301 ch_dim1 + 2];
6302/* L122: */
6303 }
6304/* L123: */
6305 }
6306 if (idot > *l1) {
6307 goto L127;
6308 }
6309 idij = 0;
6310 i__1 = *ip;
6311 for (j = 2; j <= i__1; ++j) {
6312 idij += 2;
6313 i__2 = *ido;
6314 for (i__ = 4; i__ <= i__2; i__ += 2) {
6315 idij += 2;
6316 i__3 = *l1;
6317 for (k = 1; k <= i__3; ++k) {
6318 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
6319 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
6320 ch[i__ + (k + j * ch_dim2) * ch_dim1];
6321 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
6322 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
6323 1 + (k + j * ch_dim2) * ch_dim1];
6324/* L124: */
6325 }
6326/* L125: */
6327 }
6328/* L126: */
6329 }
6330 return 0;
6331L127:
6332 idj = 2 - *ido;
6333 i__1 = *ip;
6334 for (j = 2; j <= i__1; ++j) {
6335 idj += *ido;
6336 i__2 = *l1;
6337 for (k = 1; k <= i__2; ++k) {
6338 idij = idj;
6339 i__3 = *ido;
6340 for (i__ = 4; i__ <= i__3; i__ += 2) {
6341 idij += 2;
6342 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
6343 i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
6344 ch[i__ + (k + j * ch_dim2) * ch_dim1];
6345 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
6346 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
6347 1 + (k + j * ch_dim2) * ch_dim1];
6348/* L128: */
6349 }
6350/* L129: */
6351 }
6352/* L130: */
6353 }
6354 return 0;
6355} /* dpassf_ */
6356
6357/* ------ File dpassf2.f ------ */
6358/* Subroutine */ int dpassf2_(integer *ido, integer *l1, double *cc, double *ch,
6359 double *wa1)
6360{
6361 /* System generated locals */
6362 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6363
6364 /* Local variables */
6365 static integer i__, k;
6366 static double ti2, tr2;
6367
6368 /* Parameter adjustments */
6369 ch_dim1 = *ido;
6370 ch_dim2 = *l1;
6371 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6372 ch -= ch_offset;
6373 cc_dim1 = *ido;
6374 cc_offset = cc_dim1 * 3 + 1;
6375 cc -= cc_offset;
6376 --wa1;
6377
6378 /* Function Body */
6379 if (*ido > 2) {
6380 goto L102;
6381 }
6382 i__1 = *l1;
6383 for (k = 1; k <= i__1; ++k) {
6384 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
6385 cc[((k << 1) + 2) * cc_dim1 + 1];
6386 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
6387 + 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
6388 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
6389 cc[((k << 1) + 2) * cc_dim1 + 2];
6390 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
6391 + 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
6392/* L101: */
6393 }
6394 return 0;
6395L102:
6396 i__1 = *l1;
6397 for (k = 1; k <= i__1; ++k) {
6398 i__2 = *ido;
6399 for (i__ = 2; i__ <= i__2; i__ += 2) {
6400 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
6401 1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
6402 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
6403 1) + 2) * cc_dim1];
6404 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
6405 cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
6406 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
6407 * cc_dim1];
6408 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 -
6409 wa1[i__] * tr2;
6410 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
6411 + wa1[i__] * ti2;
6412/* L103: */
6413 }
6414/* L104: */
6415 }
6416 return 0;
6417} /* dpassf2_ */
6418
6419/* ------ File dpassf3.f ------ */
6420/* Subroutine */ int dpassf3_(integer *ido, integer *l1, double *cc, double *ch,
6421 double *wa1, double *wa2)
6422{
6423 /* Initialized data */
6424
6425 static double taur = -.5f;
6426 static double taui = -.866025403784439f;
6427
6428 /* System generated locals */
6429 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6430
6431 /* Local variables */
6432 static integer i__, k;
6433 static double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
6434
6435 /* Parameter adjustments */
6436 ch_dim1 = *ido;
6437 ch_dim2 = *l1;
6438 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6439 ch -= ch_offset;
6440 cc_dim1 = *ido;
6441 cc_offset = (cc_dim1 << 2) + 1;
6442 cc -= cc_offset;
6443 --wa1;
6444 --wa2;
6445
6446 /* Function Body */
6447 if (*ido != 2) {
6448 goto L102;
6449 }
6450 i__1 = *l1;
6451 for (k = 1; k <= i__1; ++k) {
6452 tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
6453 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
6454 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
6455 ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
6456 ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
6457 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
6458 cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
6459 cc_dim1 + 1]);
6460 ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
6461 cc_dim1 + 2]);
6462 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
6463 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
6464 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
6465 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
6466/* L101: */
6467 }
6468 return 0;
6469L102:
6470 i__1 = *l1;
6471 for (k = 1; k <= i__1; ++k) {
6472 i__2 = *ido;
6473 for (i__ = 2; i__ <= i__2; i__ += 2) {
6474 tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
6475 3) * cc_dim1];
6476 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
6477 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
6478 cc_dim1] + tr2;
6479 ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
6480 cc_dim1];
6481 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
6482 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
6483 cc_dim1] + ti2;
6484 cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
6485 k * 3 + 3) * cc_dim1]);
6486 ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
6487 3) * cc_dim1]);
6488 dr2 = cr2 - ci3;
6489 dr3 = cr2 + ci3;
6490 di2 = ci2 + cr3;
6491 di3 = ci2 - cr3;
6492 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
6493 wa1[i__] * dr2;
6494 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6495 + wa1[i__] * di2;
6496 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
6497 i__] * dr3;
6498 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
6499 wa2[i__] * di3;
6500/* L103: */
6501 }
6502/* L104: */
6503 }
6504 return 0;
6505} /* dpassf3_ */
6506
6507/* ------ File dpassf4.f ------ */
6508/* Subroutine */ int dpassf4_(integer *ido, integer *l1, double *cc, double *ch,
6509 double *wa1, double *wa2, double *wa3)
6510{
6511 /* System generated locals */
6512 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6513
6514 /* Local variables */
6515 static integer i__, k;
6516 static double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
6517 tr3, tr4;
6518
6519 /* Parameter adjustments */
6520 ch_dim1 = *ido;
6521 ch_dim2 = *l1;
6522 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6523 ch -= ch_offset;
6524 cc_dim1 = *ido;
6525 cc_offset = cc_dim1 * 5 + 1;
6526 cc -= cc_offset;
6527 --wa1;
6528 --wa2;
6529 --wa3;
6530
6531 /* Function Body */
6532 if (*ido != 2) {
6533 goto L102;
6534 }
6535 i__1 = *l1;
6536 for (k = 1; k <= i__1; ++k) {
6537 ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
6538 + 2];
6539 ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
6540 + 2];
6541 tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1
6542 + 2];
6543 ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
6544 + 2];
6545 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
6546 + 1];
6547 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
6548 + 1];
6549 ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
6550 + 1];
6551 tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
6552 + 1];
6553 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
6554 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
6555 ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
6556 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
6557 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
6558 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
6559 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
6560 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
6561/* L101: */
6562 }
6563 return 0;
6564L102:
6565 i__1 = *l1;
6566 for (k = 1; k <= i__1; ++k) {
6567 i__2 = *ido;
6568 for (i__ = 2; i__ <= i__2; i__ += 2) {
6569 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
6570 * cc_dim1];
6571 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
6572 * cc_dim1];
6573 ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
6574 * cc_dim1];
6575 tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
6576 * cc_dim1];
6577 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
6578 2) + 3) * cc_dim1];
6579 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
6580 2) + 3) * cc_dim1];
6581 ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
6582 2) + 2) * cc_dim1];
6583 tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
6584 2) + 4) * cc_dim1];
6585 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
6586 cr3 = tr2 - tr3;
6587 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
6588 ci3 = ti2 - ti3;
6589 cr2 = tr1 + tr4;
6590 cr4 = tr1 - tr4;
6591 ci2 = ti1 + ti4;
6592 ci4 = ti1 - ti4;
6593 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
6594 + wa1[i__] * ci2;
6595 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 -
6596 wa1[i__] * cr2;
6597 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 +
6598 wa2[i__] * ci3;
6599 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
6600 i__] * cr3;
6601 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
6602 + wa3[i__] * ci4;
6603 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 -
6604 wa3[i__] * cr4;
6605/* L103: */
6606 }
6607/* L104: */
6608 }
6609 return 0;
6610} /* dpassf4_ */
6611
6612/* ------ File dpassf5.f ------ */
6613/* Subroutine */ int dpassf5_(integer *ido, integer *l1, double *cc, double *ch,
6614 double *wa1, double *wa2, double *wa3, double *wa4)
6615{
6616 /* Initialized data */
6617
6618 static double tr11 = .309016994374947f;
6619 static double ti11 = -.951056516295154f;
6620 static double tr12 = -.809016994374947f;
6621 static double ti12 = -.587785252292473f;
6622
6623 /* System generated locals */
6624 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6625
6626 /* Local variables */
6627 static integer i__, k;
6628 static double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
6629 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
6630
6631 /* Parameter adjustments */
6632 ch_dim1 = *ido;
6633 ch_dim2 = *l1;
6634 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6635 ch -= ch_offset;
6636 cc_dim1 = *ido;
6637 cc_offset = cc_dim1 * 6 + 1;
6638 cc -= cc_offset;
6639 --wa1;
6640 --wa2;
6641 --wa3;
6642 --wa4;
6643
6644 /* Function Body */
6645 if (*ido != 2) {
6646 goto L102;
6647 }
6648 i__1 = *l1;
6649 for (k = 1; k <= i__1; ++k) {
6650 ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
6651 ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
6652 ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
6653 ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
6654 tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
6655 tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
6656 tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
6657 tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
6658 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
6659 + tr3;
6660 ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
6661 + ti3;
6662 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
6663 ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
6664 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
6665 ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
6666 cr5 = ti11 * tr5 + ti12 * tr4;
6667 ci5 = ti11 * ti5 + ti12 * ti4;
6668 cr4 = ti12 * tr5 - ti11 * tr4;
6669 ci4 = ti12 * ti5 - ti11 * ti4;
6670 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
6671 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
6672 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
6673 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
6674 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
6675 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
6676 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
6677 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
6678/* L101: */
6679 }
6680 return 0;
6681L102:
6682 i__1 = *l1;
6683 for (k = 1; k <= i__1; ++k) {
6684 i__2 = *ido;
6685 for (i__ = 2; i__ <= i__2; i__ += 2) {
6686 ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
6687 cc_dim1];
6688 ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
6689 cc_dim1];
6690 ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
6691 cc_dim1];
6692 ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
6693 cc_dim1];
6694 tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6695 5) * cc_dim1];
6696 tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6697 5) * cc_dim1];
6698 tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6699 4) * cc_dim1];
6700 tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6701 4) * cc_dim1];
6702 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
6703 cc_dim1] + tr2 + tr3;
6704 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
6705 cc_dim1] + ti2 + ti3;
6706 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
6707 tr3;
6708 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
6709 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
6710 tr3;
6711 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
6712 cr5 = ti11 * tr5 + ti12 * tr4;
6713 ci5 = ti11 * ti5 + ti12 * ti4;
6714 cr4 = ti12 * tr5 - ti11 * tr4;
6715 ci4 = ti12 * ti5 - ti11 * ti4;
6716 dr3 = cr3 - ci4;
6717 dr4 = cr3 + ci4;
6718 di3 = ci3 + cr4;
6719 di4 = ci3 - cr4;
6720 dr5 = cr2 + ci5;
6721 dr2 = cr2 - ci5;
6722 di5 = ci2 - cr5;
6723 di2 = ci2 + cr5;
6724 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6725 + wa1[i__] * di2;
6726 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
6727 wa1[i__] * dr2;
6728 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
6729 wa2[i__] * di3;
6730 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
6731 i__] * dr3;
6732 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
6733 + wa3[i__] * di4;
6734 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 -
6735 wa3[i__] * dr4;
6736 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 +
6737 wa4[i__] * di5;
6738 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
6739 i__] * dr5;
6740/* L103: */
6741 }
6742/* L104: */
6743 }
6744 return 0;
6745} /* dpassf5_ */
6746
6747/* ------ File dadb2.f ------ */
6748/* Subroutine */ int dadb2_(integer *ido, integer *l1, double *cc, double *ch,
6749 double *wa1)
6750{
6751 /* System generated locals */
6752 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6753
6754 /* Local variables */
6755 static integer i__, k, ic;
6756 static double ti2, tr2;
6757 static integer idp2;
6758
6759 /* Parameter adjustments */
6760 ch_dim1 = *ido;
6761 ch_dim2 = *l1;
6762 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6763 ch -= ch_offset;
6764 cc_dim1 = *ido;
6765 cc_offset = cc_dim1 * 3 + 1;
6766 cc -= cc_offset;
6767 --wa1;
6768
6769 /* Function Body */
6770 i__1 = *l1;
6771 for (k = 1; k <= i__1; ++k) {
6772 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
6773 cc[*ido + ((k << 1) + 2) * cc_dim1];
6774 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
6775 + 1] - cc[*ido + ((k << 1) + 2) * cc_dim1];
6776/* L101: */
6777 }
6778 if ((i__1 = *ido - 2) < 0) {
6779 goto L107;
6780 } else if (i__1 == 0) {
6781 goto L105;
6782 } else {
6783 goto L102;
6784 }
6785L102:
6786 idp2 = *ido + 2;
6787 i__1 = *l1;
6788 for (k = 1; k <= i__1; ++k) {
6789 i__2 = *ido;
6790 for (i__ = 3; i__ <= i__2; i__ += 2) {
6791 ic = idp2 - i__;
6792 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
6793 1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
6794 tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
6795 1) + 2) * cc_dim1];
6796 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
6797 cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
6798 ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2)
6799 * cc_dim1];
6800 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2
6801 - wa1[i__ - 1] * ti2;
6802 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 +
6803 wa1[i__ - 1] * tr2;
6804/* L103: */
6805 }
6806/* L104: */
6807 }
6808 if (*ido % 2 == 1) {
6809 return 0;
6810 }
6811L105:
6812 i__1 = *l1;
6813 for (k = 1; k <= i__1; ++k) {
6814 ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) *
6815 cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1];
6816 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) *
6817 cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
6818/* L106: */
6819 }
6820L107:
6821 return 0;
6822} /* dadb2_ */
6823
6824/* ------ File dadb3.f ------ */
6825/* Subroutine */ int dadb3_(integer *ido, integer *l1, double *cc, double *ch,
6826 double *wa1, double *wa2)
6827{
6828 /* Initialized data */
6829
6830 static double taur = -.5f;
6831 static double taui = .866025403784439f;
6832
6833 /* System generated locals */
6834 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6835
6836 /* Local variables */
6837 static integer i__, k, ic;
6838 static double ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
6839 static integer idp2;
6840
6841 /* Parameter adjustments */
6842 ch_dim1 = *ido;
6843 ch_dim2 = *l1;
6844 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6845 ch -= ch_offset;
6846 cc_dim1 = *ido;
6847 cc_offset = (cc_dim1 << 2) + 1;
6848 cc -= cc_offset;
6849 --wa1;
6850 --wa2;
6851
6852 /* Function Body */
6853 i__1 = *l1;
6854 for (k = 1; k <= i__1; ++k) {
6855 tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) *
6856 cc_dim1];
6857 cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
6858 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
6859 ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) *
6860 cc_dim1 + 1]);
6861 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
6862 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
6863/* L101: */
6864 }
6865 if (*ido == 1) {
6866 return 0;
6867 }
6868 idp2 = *ido + 2;
6869 i__1 = *l1;
6870 for (k = 1; k <= i__1; ++k) {
6871 i__2 = *ido;
6872 for (i__ = 3; i__ <= i__2; i__ += 2) {
6873 ic = idp2 - i__;
6874 tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 +
6875 2) * cc_dim1];
6876 cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
6877 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
6878 cc_dim1] + tr2;
6879 ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) *
6880 cc_dim1];
6881 ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
6882 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
6883 cc_dim1] + ti2;
6884 cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
6885 k * 3 + 2) * cc_dim1]);
6886 ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 +
6887 2) * cc_dim1]);
6888 dr2 = cr2 - ci3;
6889 dr3 = cr2 + ci3;
6890 di2 = ci2 + cr3;
6891 di3 = ci2 - cr3;
6892 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
6893 - wa1[i__ - 1] * di2;
6894 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
6895 wa1[i__ - 1] * dr2;
6896 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
6897 wa2[i__ - 1] * di3;
6898 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
6899 i__ - 1] * dr3;
6900/* L102: */
6901 }
6902/* L103: */
6903 }
6904 return 0;
6905} /* dadb3_ */
6906
6907/* ------ File dadb4.f ------ */
6908/* Subroutine */ int dadb4_(integer *ido, integer *l1, double *cc, double *ch,
6909 double *wa1, double *wa2, double *wa3)
6910{
6911 /* Initialized data */
6912
6913 static double sqrt2 = 1.414213562373095f;
6914
6915 /* System generated locals */
6916 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6917
6918 /* Local variables */
6919 static integer i__, k, ic;
6920 static double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
6921 tr3, tr4;
6922 static integer idp2;
6923
6924 /* Parameter adjustments */
6925 ch_dim1 = *ido;
6926 ch_dim2 = *l1;
6927 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6928 ch -= ch_offset;
6929 cc_dim1 = *ido;
6930 cc_offset = cc_dim1 * 5 + 1;
6931 cc -= cc_offset;
6932 --wa1;
6933 --wa2;
6934 --wa3;
6935
6936 /* Function Body */
6937 i__1 = *l1;
6938 for (k = 1; k <= i__1; ++k) {
6939 tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) *
6940 cc_dim1];
6941 tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) *
6942 cc_dim1];
6943 tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) *
6944 cc_dim1];
6945 tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
6946 + 1];
6947 ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
6948 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
6949 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
6950 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
6951/* L101: */
6952 }
6953 if ((i__1 = *ido - 2) < 0) {
6954 goto L107;
6955 } else if (i__1 == 0) {
6956 goto L105;
6957 } else {
6958 goto L102;
6959 }
6960L102:
6961 idp2 = *ido + 2;
6962 i__1 = *l1;
6963 for (k = 1; k <= i__1; ++k) {
6964 i__2 = *ido;
6965 for (i__ = 3; i__ <= i__2; i__ += 2) {
6966 ic = idp2 - i__;
6967 ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4)
6968 * cc_dim1];
6969 ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4)
6970 * cc_dim1];
6971 ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2)
6972 * cc_dim1];
6973 tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2)
6974 * cc_dim1];
6975 tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
6976 2) + 4) * cc_dim1];
6977 tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k <<
6978 2) + 4) * cc_dim1];
6979 ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k <<
6980 2) + 2) * cc_dim1];
6981 tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k <<
6982 2) + 2) * cc_dim1];
6983 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
6984 cr3 = tr2 - tr3;
6985 ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
6986 ci3 = ti2 - ti3;
6987 cr2 = tr1 - tr4;
6988 cr4 = tr1 + tr4;
6989 ci2 = ti1 + ti4;
6990 ci4 = ti1 - ti4;
6991 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2
6992 - wa1[i__ - 1] * ci2;
6993 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 +
6994 wa1[i__ - 1] * cr2;
6995 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 -
6996 wa2[i__ - 1] * ci3;
6997 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
6998 i__ - 1] * cr3;
6999 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4
7000 - wa3[i__ - 1] * ci4;
7001 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 +
7002 wa3[i__ - 1] * cr4;
7003/* L103: */
7004 }
7005/* L104: */
7006 }
7007 if (*ido % 2 == 1) {
7008 return 0;
7009 }
7010L105:
7011 i__1 = *l1;
7012 for (k = 1; k <= i__1; ++k) {
7013 ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
7014 + 1];
7015 ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
7016 + 1];
7017 tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) *
7018 cc_dim1];
7019 tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) *
7020 cc_dim1];
7021 ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2;
7022 ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1);
7023 ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2;
7024 ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1);
7025/* L106: */
7026 }
7027L107:
7028 return 0;
7029} /* dadb4_ */
7030
7031/* ------ File dadb5.f ------ */
7032/* Subroutine */ int dadb5_(integer *ido, integer *l1, double *cc, double *ch,
7033 double *wa1, double *wa2, double *wa3, double *wa4)
7034{
7035 /* Initialized data */
7036
7037 static double tr11 = .309016994374947f;
7038 static double ti11 = .951056516295154f;
7039 static double tr12 = -.809016994374947f;
7040 static double ti12 = .587785252292473f;
7041
7042 /* System generated locals */
7043 integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
7044
7045 /* Local variables */
7046 static integer i__, k, ic;
7047 static double ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
7048 ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
7049 static integer idp2;
7050
7051 /* Parameter adjustments */
7052 ch_dim1 = *ido;
7053 ch_dim2 = *l1;
7054 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7055 ch -= ch_offset;
7056 cc_dim1 = *ido;
7057 cc_offset = cc_dim1 * 6 + 1;
7058 cc -= cc_offset;
7059 --wa1;
7060 --wa2;
7061 --wa3;
7062 --wa4;
7063
7064 /* Function Body */
7065 i__1 = *l1;
7066 for (k = 1; k <= i__1; ++k) {
7067 ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
7068 ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
7069 tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) *
7070 cc_dim1];
7071 tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) *
7072 cc_dim1];
7073 ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
7074 + tr3;
7075 cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
7076 cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
7077 ci5 = ti11 * ti5 + ti12 * ti4;
7078 ci4 = ti12 * ti5 - ti11 * ti4;
7079 ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
7080 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
7081 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
7082 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
7083/* L101: */
7084 }
7085 if (*ido == 1) {
7086 return 0;
7087 }
7088 idp2 = *ido + 2;
7089 i__1 = *l1;
7090 for (k = 1; k <= i__1; ++k) {
7091 i__2 = *ido;
7092 for (i__ = 3; i__ <= i__2; i__ += 2) {
7093 ic = idp2 - i__;
7094 ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) *
7095 cc_dim1];
7096 ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) *
7097 cc_dim1];
7098 ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) *
7099 cc_dim1];
7100 ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) *
7101 cc_dim1];
7102 tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 +
7103 2) * cc_dim1];
7104 tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 +
7105 2) * cc_dim1];
7106 tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 +
7107 4) * cc_dim1];
7108 tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 +
7109 4) * cc_dim1];
7110 ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
7111 cc_dim1] + tr2 + tr3;
7112 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
7113 cc_dim1] + ti2 + ti3;
7114 cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
7115 tr3;
7116 ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
7117 cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
7118 tr3;
7119 ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
7120 cr5 = ti11 * tr5 + ti12 * tr4;
7121 ci5 = ti11 * ti5 + ti12 * ti4;
7122 cr4 = ti12 * tr5 - ti11 * tr4;
7123 ci4 = ti12 * ti5 - ti11 * ti4;
7124 dr3 = cr3 - ci4;
7125 dr4 = cr3 + ci4;
7126 di3 = ci3 + cr4;
7127 di4 = ci3 - cr4;
7128 dr5 = cr2 + ci5;
7129 dr2 = cr2 - ci5;
7130 di5 = ci2 - cr5;
7131 di2 = ci2 + cr5;
7132 ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
7133 - wa1[i__ - 1] * di2;
7134 ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
7135 wa1[i__ - 1] * dr2;
7136 ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
7137 wa2[i__ - 1] * di3;
7138 ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
7139 i__ - 1] * dr3;
7140 ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4
7141 - wa3[i__ - 1] * di4;
7142 ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 +
7143 wa3[i__ - 1] * dr4;
7144 ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 -
7145 wa4[i__ - 1] * di5;
7146 ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
7147 i__ - 1] * dr5;
7148/* L102: */
7149 }
7150/* L103: */
7151 }
7152 return 0;
7153} /* dadb5_ */
7154
7155/* ------ File dadbg.f ------ */
7156/* Subroutine */ int dadbg_(integer *ido, integer *ip, integer *l1, integer *
7157 idl1, double *cc, double *c1, double *c2, double *ch, double *ch2, double *wa)
7158{
7159 /* Initialized data */
7160
7161 static double tpi = 6.28318530717959f;
7162
7163 /* System generated locals */
7164 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
7165 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
7166 i__1, i__2, i__3;
7167
7168 /* Builtin functions */
7169 double cos(doublereal), sin(doublereal);
7170
7171 /* Local variables */
7172 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
7173 static double dc2, ai1, ai2, ar1, ar2, ds2;
7174 static integer nbd;
7175 static double dcp, arg, dsp, ar1h, ar2h;
7176 static integer idp2, ipp2;
7177
7178 /* Parameter adjustments */
7179 ch_dim1 = *ido;
7180 ch_dim2 = *l1;
7181 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7182 ch -= ch_offset;
7183 c1_dim1 = *ido;
7184 c1_dim2 = *l1;
7185 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
7186 c1 -= c1_offset;
7187 cc_dim1 = *ido;
7188 cc_dim2 = *ip;
7189 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7190 cc -= cc_offset;
7191 ch2_dim1 = *idl1;
7192 ch2_offset = ch2_dim1 + 1;
7193 ch2 -= ch2_offset;
7194 c2_dim1 = *idl1;
7195 c2_offset = c2_dim1 + 1;
7196 c2 -= c2_offset;
7197 --wa;
7198
7199 /* Function Body */
7200 arg = tpi / (double) (*ip);
7201 dcp = cos(arg);
7202 dsp = sin(arg);
7203 idp2 = *ido + 2;
7204 nbd = (*ido - 1) / 2;
7205 ipp2 = *ip + 2;
7206 ipph = (*ip + 1) / 2;
7207 if (*ido < *l1) {
7208 goto L103;
7209 }
7210 i__1 = *l1;
7211 for (k = 1; k <= i__1; ++k) {
7212 i__2 = *ido;
7213 for (i__ = 1; i__ <= i__2; ++i__) {
7214 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
7215 cc_dim1];
7216/* L101: */
7217 }
7218/* L102: */
7219 }
7220 goto L106;
7221L103:
7222 i__1 = *ido;
7223 for (i__ = 1; i__ <= i__1; ++i__) {
7224 i__2 = *l1;
7225 for (k = 1; k <= i__2; ++k) {
7226 ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
7227 cc_dim1];
7228/* L104: */
7229 }
7230/* L105: */
7231 }
7232L106:
7233 i__1 = ipph;
7234 for (j = 2; j <= i__1; ++j) {
7235 jc = ipp2 - j;
7236 j2 = j + j;
7237 i__2 = *l1;
7238 for (k = 1; k <= i__2; ++k) {
7239 ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k *
7240 cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) *
7241 cc_dim1];
7242 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
7243 cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
7244/* L107: */
7245 }
7246/* L108: */
7247 }
7248 if (*ido == 1) {
7249 goto L116;
7250 }
7251 if (nbd < *l1) {
7252 goto L112;
7253 }
7254 i__1 = ipph;
7255 for (j = 2; j <= i__1; ++j) {
7256 jc = ipp2 - j;
7257 i__2 = *l1;
7258 for (k = 1; k <= i__2; ++k) {
7259 i__3 = *ido;
7260 for (i__ = 3; i__ <= i__3; i__ += 2) {
7261 ic = idp2 - i__;
7262 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7263 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
7264 << 1) - 2 + k * cc_dim2) * cc_dim1];
7265 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7266 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
7267 << 1) - 2 + k * cc_dim2) * cc_dim1];
7268 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7269 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
7270 k * cc_dim2) * cc_dim1];
7271 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7272 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
7273 k * cc_dim2) * cc_dim1];
7274/* L109: */
7275 }
7276/* L110: */
7277 }
7278/* L111: */
7279 }
7280 goto L116;
7281L112:
7282 i__1 = ipph;
7283 for (j = 2; j <= i__1; ++j) {
7284 jc = ipp2 - j;
7285 i__2 = *ido;
7286 for (i__ = 3; i__ <= i__2; i__ += 2) {
7287 ic = idp2 - i__;
7288 i__3 = *l1;
7289 for (k = 1; k <= i__3; ++k) {
7290 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7291 << 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
7292 << 1) - 2 + k * cc_dim2) * cc_dim1];
7293 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7294 << 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
7295 << 1) - 2 + k * cc_dim2) * cc_dim1];
7296 ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7297 1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
7298 k * cc_dim2) * cc_dim1];
7299 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7300 1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
7301 k * cc_dim2) * cc_dim1];
7302/* L113: */
7303 }
7304/* L114: */
7305 }
7306/* L115: */
7307 }
7308L116:
7309 ar1 = 1.f;
7310 ai1 = 0.f;
7311 i__1 = ipph;
7312 for (l = 2; l <= i__1; ++l) {
7313 lc = ipp2 - l;
7314 ar1h = dcp * ar1 - dsp * ai1;
7315 ai1 = dcp * ai1 + dsp * ar1;
7316 ar1 = ar1h;
7317 i__2 = *idl1;
7318 for (ik = 1; ik <= i__2; ++ik) {
7319 c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
7320 ch2_dim1 << 1)];
7321 c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1];
7322/* L117: */
7323 }
7324 dc2 = ar1;
7325 ds2 = ai1;
7326 ar2 = ar1;
7327 ai2 = ai1;
7328 i__2 = ipph;
7329 for (j = 3; j <= i__2; ++j) {
7330 jc = ipp2 - j;
7331 ar2h = dc2 * ar2 - ds2 * ai2;
7332 ai2 = dc2 * ai2 + ds2 * ar2;
7333 ar2 = ar2h;
7334 i__3 = *idl1;
7335 for (ik = 1; ik <= i__3; ++ik) {
7336 c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
7337 c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
7338/* L118: */
7339 }
7340/* L119: */
7341 }
7342/* L120: */
7343 }
7344 i__1 = ipph;
7345 for (j = 2; j <= i__1; ++j) {
7346 i__2 = *idl1;
7347 for (ik = 1; ik <= i__2; ++ik) {
7348 ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
7349/* L121: */
7350 }
7351/* L122: */
7352 }
7353 i__1 = ipph;
7354 for (j = 2; j <= i__1; ++j) {
7355 jc = ipp2 - j;
7356 i__2 = *l1;
7357 for (k = 1; k <= i__2; ++k) {
7358 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7359 c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
7360 ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7361 c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
7362/* L123: */
7363 }
7364/* L124: */
7365 }
7366 if (*ido == 1) {
7367 goto L132;
7368 }
7369 if (nbd < *l1) {
7370 goto L128;
7371 }
7372 i__1 = ipph;
7373 for (j = 2; j <= i__1; ++j) {
7374 jc = ipp2 - j;
7375 i__2 = *l1;
7376 for (k = 1; k <= i__2; ++k) {
7377 i__3 = *ido;
7378 for (i__ = 3; i__ <= i__3; i__ += 2) {
7379 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
7380 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
7381 * c1_dim1];
7382 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
7383 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
7384 c1_dim2) * c1_dim1];
7385 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7386 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
7387 * c1_dim1];
7388 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7389 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
7390 * c1_dim1];
7391/* L125: */
7392 }
7393/* L126: */
7394 }
7395/* L127: */
7396 }
7397 goto L132;
7398L128:
7399 i__1 = ipph;
7400 for (j = 2; j <= i__1; ++j) {
7401 jc = ipp2 - j;
7402 i__2 = *ido;
7403 for (i__ = 3; i__ <= i__2; i__ += 2) {
7404 i__3 = *l1;
7405 for (k = 1; k <= i__3; ++k) {
7406 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
7407 j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
7408 * c1_dim1];
7409 ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
7410 + j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
7411 c1_dim2) * c1_dim1];
7412 ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7413 c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
7414 * c1_dim1];
7415 ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7416 c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
7417 * c1_dim1];
7418/* L129: */
7419 }
7420/* L130: */
7421 }
7422/* L131: */
7423 }
7424L132:
7425 if (*ido == 1) {
7426 return 0;
7427 }
7428 i__1 = *idl1;
7429 for (ik = 1; ik <= i__1; ++ik) {
7430 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
7431/* L133: */
7432 }
7433 i__1 = *ip;
7434 for (j = 2; j <= i__1; ++j) {
7435 i__2 = *l1;
7436 for (k = 1; k <= i__2; ++k) {
7437 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
7438 ch_dim1 + 1];
7439/* L134: */
7440 }
7441/* L135: */
7442 }
7443 if (nbd > *l1) {
7444 goto L139;
7445 }
7446 is = -(*ido);
7447 i__1 = *ip;
7448 for (j = 2; j <= i__1; ++j) {
7449 is += *ido;
7450 idij = is;
7451 i__2 = *ido;
7452 for (i__ = 3; i__ <= i__2; i__ += 2) {
7453 idij += 2;
7454 i__3 = *l1;
7455 for (k = 1; k <= i__3; ++k) {
7456 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
7457 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
7458 ch[i__ + (k + j * ch_dim2) * ch_dim1];
7459 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
7460 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
7461 1 + (k + j * ch_dim2) * ch_dim1];
7462/* L136: */
7463 }
7464/* L137: */
7465 }
7466/* L138: */
7467 }
7468 goto L143;
7469L139:
7470 is = -(*ido);
7471 i__1 = *ip;
7472 for (j = 2; j <= i__1; ++j) {
7473 is += *ido;
7474 i__2 = *l1;
7475 for (k = 1; k <= i__2; ++k) {
7476 idij = is;
7477 i__3 = *ido;
7478 for (i__ = 3; i__ <= i__3; i__ += 2) {
7479 idij += 2;
7480 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
7481 i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
7482 ch[i__ + (k + j * ch_dim2) * ch_dim1];
7483 c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
7484 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
7485 1 + (k + j * ch_dim2) * ch_dim1];
7486/* L140: */
7487 }
7488/* L141: */
7489 }
7490/* L142: */
7491 }
7492L143:
7493 return 0;
7494} /* dadbg_ */
7495
7496/* ------ File dadf2.f ------ */
7497/* Subroutine */ int dadf2_(integer *ido, integer *l1, double *cc, double *ch,
7498 double *wa1)
7499{
7500 /* System generated locals */
7501 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
7502
7503 /* Local variables */
7504 static integer i__, k, ic;
7505 static double ti2, tr2;
7506 static integer idp2;
7507
7508 /* Parameter adjustments */
7509 ch_dim1 = *ido;
7510 ch_offset = ch_dim1 * 3 + 1;
7511 ch -= ch_offset;
7512 cc_dim1 = *ido;
7513 cc_dim2 = *l1;
7514 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7515 cc -= cc_offset;
7516 --wa1;
7517
7518 /* Function Body */
7519 i__1 = *l1;
7520 for (k = 1; k <= i__1; ++k) {
7521 ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7522 cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7523 ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
7524 - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7525/* L101: */
7526 }
7527 if ((i__1 = *ido - 2) < 0) {
7528 goto L107;
7529 } else if (i__1 == 0) {
7530 goto L105;
7531 } else {
7532 goto L102;
7533 }
7534L102:
7535 idp2 = *ido + 2;
7536 i__1 = *l1;
7537 for (k = 1; k <= i__1; ++k) {
7538 i__2 = *ido;
7539 for (i__ = 3; i__ <= i__2; i__ += 2) {
7540 ic = idp2 - i__;
7541 tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7542 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7543 ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7544 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7545 cc_dim1];
7546 ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7547 cc_dim1] + ti2;
7548 ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
7549 cc_dim1];
7550 ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k +
7551 cc_dim2) * cc_dim1] + tr2;
7552 ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
7553 * cc_dim1] - tr2;
7554/* L103: */
7555 }
7556/* L104: */
7557 }
7558 if (*ido % 2 == 1) {
7559 return 0;
7560 }
7561L105:
7562 i__1 = *l1;
7563 for (k = 1; k <= i__1; ++k) {
7564 ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) *
7565 cc_dim1];
7566 ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) *
7567 cc_dim1];
7568/* L106: */
7569 }
7570L107:
7571 return 0;
7572} /* dadf2_ */
7573
7574/* ------ File dadf3.f ------ */
7575/* Subroutine */ int dadf3_(integer *ido, integer *l1, double *cc, double *ch,
7576 double *wa1, double *wa2)
7577{
7578 /* Initialized data */
7579
7580 static double taur = -.5f;
7581 static double taui = .866025403784439f;
7582
7583 /* System generated locals */
7584 integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
7585
7586 /* Local variables */
7587 static integer i__, k, ic;
7588 static double ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
7589 static integer idp2;
7590
7591 /* Parameter adjustments */
7592 ch_dim1 = *ido;
7593 ch_offset = (ch_dim1 << 2) + 1;
7594 ch -= ch_offset;
7595 cc_dim1 = *ido;
7596 cc_dim2 = *l1;
7597 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7598 cc -= cc_offset;
7599 --wa1;
7600 --wa2;
7601
7602 /* Function Body */
7603 i__1 = *l1;
7604 for (k = 1; k <= i__1; ++k) {
7605 cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7606 cc_dim1 + 1];
7607 ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
7608 ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) *
7609 cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
7610 ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7611 taur * cr2;
7612/* L101: */
7613 }
7614 if (*ido == 1) {
7615 return 0;
7616 }
7617 idp2 = *ido + 2;
7618 i__1 = *l1;
7619 for (k = 1; k <= i__1; ++k) {
7620 i__2 = *ido;
7621 for (i__ = 3; i__ <= i__2; i__ += 2) {
7622 ic = idp2 - i__;
7623 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7624 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7625 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7626 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7627 cc_dim1];
7628 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7629 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7630 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7631 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7632 cr2 = dr2 + dr3;
7633 ci2 = di2 + di3;
7634 ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
7635 cc_dim1] + cr2;
7636 ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7637 cc_dim1] + ci2;
7638 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
7639 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
7640 tr3 = taui * (di2 - di3);
7641 ti3 = taui * (dr3 - dr2);
7642 ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
7643 ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
7644 ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
7645 ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
7646/* L102: */
7647 }
7648/* L103: */
7649 }
7650 return 0;
7651} /* dadf3_ */
7652
7653/* ------ File dadf4.f ------ */
7654/* Subroutine */ int dadf4_(integer *ido, integer *l1, double *cc, double *ch,
7655 double *wa1, double *wa2, double *wa3)
7656{
7657 /* Initialized data */
7658
7659 static double hsqt2 = .7071067811865475f;
7660
7661 /* System generated locals */
7662 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
7663
7664 /* Local variables */
7665 static integer i__, k, ic;
7666 static double ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
7667 tr3, tr4;
7668 static integer idp2;
7669
7670 /* Parameter adjustments */
7671 ch_dim1 = *ido;
7672 ch_offset = ch_dim1 * 5 + 1;
7673 ch -= ch_offset;
7674 cc_dim1 = *ido;
7675 cc_dim2 = *l1;
7676 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7677 cc -= cc_offset;
7678 --wa1;
7679 --wa2;
7680 --wa3;
7681
7682 /* Function Body */
7683 i__1 = *l1;
7684 for (k = 1; k <= i__1; ++k) {
7685 tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
7686 * cc_dim1 + 1];
7687 tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7688 cc_dim1 + 1];
7689 ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
7690 ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
7691 ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
7692 - cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
7693 ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1
7694 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7695/* L101: */
7696 }
7697 if ((i__1 = *ido - 2) < 0) {
7698 goto L107;
7699 } else if (i__1 == 0) {
7700 goto L105;
7701 } else {
7702 goto L102;
7703 }
7704L102:
7705 idp2 = *ido + 2;
7706 i__1 = *l1;
7707 for (k = 1; k <= i__1; ++k) {
7708 i__2 = *ido;
7709 for (i__ = 3; i__ <= i__2; i__ += 2) {
7710 ic = idp2 - i__;
7711 cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7712 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7713 ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7714 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7715 cc_dim1];
7716 cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7717 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7718 ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7719 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7720 cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
7721 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
7722 ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
7723 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
7724 cc_dim1];
7725 tr1 = cr2 + cr4;
7726 tr4 = cr4 - cr2;
7727 ti1 = ci2 + ci4;
7728 ti4 = ci2 - ci4;
7729 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
7730 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
7731 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
7732 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
7733 ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
7734 ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
7735 ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
7736 ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
7737 ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
7738 ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
7739 ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
7740 ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
7741/* L103: */
7742 }
7743/* L104: */
7744 }
7745 if (*ido % 2 == 1) {
7746 return 0;
7747 }
7748L105:
7749 i__1 = *l1;
7750 for (k = 1; k <= i__1; ++k) {
7751 ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido +
7752 (k + (cc_dim2 << 2)) * cc_dim1]);
7753 tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + (
7754 k + (cc_dim2 << 2)) * cc_dim1]);
7755 ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) *
7756 cc_dim1];
7757 ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) *
7758 cc_dim1] - tr1;
7759 ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) *
7760 cc_dim1];
7761 ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) *
7762 cc_dim1];
7763/* L106: */
7764 }
7765L107:
7766 return 0;
7767} /* dadf4_ */
7768
7769/* ------ File dadf5.f ------ */
7770/* Subroutine */ int dadf5_(integer *ido, integer *l1, double *cc, double *ch,
7771 double *wa1, double *wa2, double *wa3, double *wa4)
7772{
7773 /* Initialized data */
7774
7775 static double tr11 = .309016994374947f;
7776 static double ti11 = .951056516295154f;
7777 static double tr12 = -.809016994374947f;
7778 static double ti12 = .587785252292473f;
7779
7780 /* System generated locals */
7781 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
7782
7783 /* Local variables */
7784 static integer i__, k, ic;
7785 static double ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3,
7786 dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
7787 static integer idp2;
7788
7789 /* Parameter adjustments */
7790 ch_dim1 = *ido;
7791 ch_offset = ch_dim1 * 6 + 1;
7792 ch -= ch_offset;
7793 cc_dim1 = *ido;
7794 cc_dim2 = *l1;
7795 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7796 cc -= cc_offset;
7797 --wa1;
7798 --wa2;
7799 --wa3;
7800 --wa4;
7801
7802 /* Function Body */
7803 i__1 = *l1;
7804 for (k = 1; k <= i__1; ++k) {
7805 cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) *
7806 cc_dim1 + 1];
7807 ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) *
7808 cc_dim1 + 1];
7809 cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7810 cc_dim1 + 1];
7811 ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) *
7812 cc_dim1 + 1];
7813 ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2
7814 + cr3;
7815 ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7816 tr11 * cr2 + tr12 * cr3;
7817 ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
7818 ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7819 tr12 * cr2 + tr11 * cr3;
7820 ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
7821/* L101: */
7822 }
7823 if (*ido == 1) {
7824 return 0;
7825 }
7826 idp2 = *ido + 2;
7827 i__1 = *l1;
7828 for (k = 1; k <= i__1; ++k) {
7829 i__2 = *ido;
7830 for (i__ = 3; i__ <= i__2; i__ += 2) {
7831 ic = idp2 - i__;
7832 dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7833 + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7834 di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7835 wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7836 cc_dim1];
7837 dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7838 wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7839 di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7840 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7841 dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
7842 + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
7843 di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
7844 wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
7845 cc_dim1];
7846 dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] +
7847 wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
7848 di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
7849 i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
7850 cr2 = dr2 + dr5;
7851 ci5 = dr5 - dr2;
7852 cr5 = di2 - di5;
7853 ci2 = di2 + di5;
7854 cr3 = dr3 + dr4;
7855 ci4 = dr4 - dr3;
7856 cr4 = di3 - di4;
7857 ci3 = di3 + di4;
7858 ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
7859 cc_dim1] + cr2 + cr3;
7860 ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7861 cc_dim1] + ci2 + ci3;
7862 tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 *
7863 cr3;
7864 ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
7865 tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 *
7866 cr3;
7867 ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
7868 tr5 = ti11 * cr5 + ti12 * cr4;
7869 ti5 = ti11 * ci5 + ti12 * ci4;
7870 tr4 = ti12 * cr5 - ti11 * cr4;
7871 ti4 = ti12 * ci5 - ti11 * ci4;
7872 ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
7873 ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
7874 ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
7875 ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
7876 ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
7877 ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
7878 ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
7879 ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
7880/* L102: */
7881 }
7882/* L103: */
7883 }
7884 return 0;
7885} /* dadf5_ */
7886
7887/* ------ File dadfg.f ------ */
7888/* Subroutine */ int dadfg_(integer *ido, integer *ip, integer *l1, integer *
7889 idl1, double *cc, double *c1, double *c2, double *ch, double *ch2, double *wa)
7890{
7891 /* Initialized data */
7892
7893 static double tpi = 6.28318530717959f;
7894
7895 /* System generated locals */
7896 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
7897 c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
7898 i__1, i__2, i__3;
7899
7900 /* Builtin functions */
7901 double cos(doublereal), sin(doublereal);
7902
7903 /* Local variables */
7904 static integer idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
7905 static double dc2, ai1, ai2, ar1, ar2, ds2;
7906 static integer nbd;
7907 static double dcp, arg, dsp, ar1h, ar2h;
7908 static integer idp2, ipp2;
7909
7910 /* Parameter adjustments */
7911 ch_dim1 = *ido;
7912 ch_dim2 = *l1;
7913 ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7914 ch -= ch_offset;
7915 c1_dim1 = *ido;
7916 c1_dim2 = *l1;
7917 c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
7918 c1 -= c1_offset;
7919 cc_dim1 = *ido;
7920 cc_dim2 = *ip;
7921 cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7922 cc -= cc_offset;
7923 ch2_dim1 = *idl1;
7924 ch2_offset = ch2_dim1 + 1;
7925 ch2 -= ch2_offset;
7926 c2_dim1 = *idl1;
7927 c2_offset = c2_dim1 + 1;
7928 c2 -= c2_offset;
7929 --wa;
7930
7931 /* Function Body */
7932 arg = tpi / (double) (*ip);
7933 dcp = cos(arg);
7934 dsp = sin(arg);
7935 ipph = (*ip + 1) / 2;
7936 ipp2 = *ip + 2;
7937 idp2 = *ido + 2;
7938 nbd = (*ido - 1) / 2;
7939 if (*ido == 1) {
7940 goto L119;
7941 }
7942 i__1 = *idl1;
7943 for (ik = 1; ik <= i__1; ++ik) {
7944 ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
7945/* L101: */
7946 }
7947 i__1 = *ip;
7948 for (j = 2; j <= i__1; ++j) {
7949 i__2 = *l1;
7950 for (k = 1; k <= i__2; ++k) {
7951 ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7952 c1_dim1 + 1];
7953/* L102: */
7954 }
7955/* L103: */
7956 }
7957 if (nbd > *l1) {
7958 goto L107;
7959 }
7960 is = -(*ido);
7961 i__1 = *ip;
7962 for (j = 2; j <= i__1; ++j) {
7963 is += *ido;
7964 idij = is;
7965 i__2 = *ido;
7966 for (i__ = 3; i__ <= i__2; i__ += 2) {
7967 idij += 2;
7968 i__3 = *l1;
7969 for (k = 1; k <= i__3; ++k) {
7970 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
7971 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
7972 c1[i__ + (k + j * c1_dim2) * c1_dim1];
7973 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
7974 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
7975 1 + (k + j * c1_dim2) * c1_dim1];
7976/* L104: */
7977 }
7978/* L105: */
7979 }
7980/* L106: */
7981 }
7982 goto L111;
7983L107:
7984 is = -(*ido);
7985 i__1 = *ip;
7986 for (j = 2; j <= i__1; ++j) {
7987 is += *ido;
7988 i__2 = *l1;
7989 for (k = 1; k <= i__2; ++k) {
7990 idij = is;
7991 i__3 = *ido;
7992 for (i__ = 3; i__ <= i__3; i__ += 2) {
7993 idij += 2;
7994 ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
7995 i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
7996 c1[i__ + (k + j * c1_dim2) * c1_dim1];
7997 ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
7998 + (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
7999 1 + (k + j * c1_dim2) * c1_dim1];
8000/* L108: */
8001 }
8002/* L109: */
8003 }
8004/* L110: */
8005 }
8006L111:
8007 if (nbd < *l1) {
8008 goto L115;
8009 }
8010 i__1 = ipph;
8011 for (j = 2; j <= i__1; ++j) {
8012 jc = ipp2 - j;
8013 i__2 = *l1;
8014 for (k = 1; k <= i__2; ++k) {
8015 i__3 = *ido;
8016 for (i__ = 3; i__ <= i__3; i__ += 2) {
8017 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
8018 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8019 ch_dim2) * ch_dim1];
8020 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8021 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
8022 ch_dim1];
8023 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8024 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8025 ch_dim1];
8026 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
8027 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
8028 * ch_dim1];
8029/* L112: */
8030 }
8031/* L113: */
8032 }
8033/* L114: */
8034 }
8035 goto L121;
8036L115:
8037 i__1 = ipph;
8038 for (j = 2; j <= i__1; ++j) {
8039 jc = ipp2 - j;
8040 i__2 = *ido;
8041 for (i__ = 3; i__ <= i__2; i__ += 2) {
8042 i__3 = *l1;
8043 for (k = 1; k <= i__3; ++k) {
8044 c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
8045 j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8046 ch_dim2) * ch_dim1];
8047 c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8048 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
8049 ch_dim1];
8050 c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8051 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8052 ch_dim1];
8053 c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
8054 * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
8055 * ch_dim1];
8056/* L116: */
8057 }
8058/* L117: */
8059 }
8060/* L118: */
8061 }
8062 goto L121;
8063L119:
8064 i__1 = *idl1;
8065 for (ik = 1; ik <= i__1; ++ik) {
8066 c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
8067/* L120: */
8068 }
8069L121:
8070 i__1 = ipph;
8071 for (j = 2; j <= i__1; ++j) {
8072 jc = ipp2 - j;
8073 i__2 = *l1;
8074 for (k = 1; k <= i__2; ++k) {
8075 c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
8076 ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
8077 c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) *
8078 ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
8079/* L122: */
8080 }
8081/* L123: */
8082 }
8083
8084 ar1 = 1.f;
8085 ai1 = 0.f;
8086 i__1 = ipph;
8087 for (l = 2; l <= i__1; ++l) {
8088 lc = ipp2 - l;
8089 ar1h = dcp * ar1 - dsp * ai1;
8090 ai1 = dcp * ai1 + dsp * ar1;
8091 ar1 = ar1h;
8092 i__2 = *idl1;
8093 for (ik = 1; ik <= i__2; ++ik) {
8094 ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
8095 c2_dim1 << 1)];
8096 ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1];
8097/* L124: */
8098 }
8099 dc2 = ar1;
8100 ds2 = ai1;
8101 ar2 = ar1;
8102 ai2 = ai1;
8103 i__2 = ipph;
8104 for (j = 3; j <= i__2; ++j) {
8105 jc = ipp2 - j;
8106 ar2h = dc2 * ar2 - ds2 * ai2;
8107 ai2 = dc2 * ai2 + ds2 * ar2;
8108 ar2 = ar2h;
8109 i__3 = *idl1;
8110 for (ik = 1; ik <= i__3; ++ik) {
8111 ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
8112 ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
8113/* L125: */
8114 }
8115/* L126: */
8116 }
8117/* L127: */
8118 }
8119 i__1 = ipph;
8120 for (j = 2; j <= i__1; ++j) {
8121 i__2 = *idl1;
8122 for (ik = 1; ik <= i__2; ++ik) {
8123 ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
8124/* L128: */
8125 }
8126/* L129: */
8127 }
8128
8129 if (*ido < *l1) {
8130 goto L132;
8131 }
8132 i__1 = *l1;
8133 for (k = 1; k <= i__1; ++k) {
8134 i__2 = *ido;
8135 for (i__ = 1; i__ <= i__2; ++i__) {
8136 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
8137 ch_dim1];
8138/* L130: */
8139 }
8140/* L131: */
8141 }
8142 goto L135;
8143L132:
8144 i__1 = *ido;
8145 for (i__ = 1; i__ <= i__1; ++i__) {
8146 i__2 = *l1;
8147 for (k = 1; k <= i__2; ++k) {
8148 cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
8149 ch_dim1];
8150/* L133: */
8151 }
8152/* L134: */
8153 }
8154L135:
8155 i__1 = ipph;
8156 for (j = 2; j <= i__1; ++j) {
8157 jc = ipp2 - j;
8158 j2 = j + j;
8159 i__2 = *l1;
8160 for (k = 1; k <= i__2; ++k) {
8161 cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
8162 * ch_dim1 + 1];
8163 cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
8164 ch_dim1 + 1];
8165/* L136: */
8166 }
8167/* L137: */
8168 }
8169 if (*ido == 1) {
8170 return 0;
8171 }
8172 if (nbd < *l1) {
8173 goto L141;
8174 }
8175 i__1 = ipph;
8176 for (j = 2; j <= i__1; ++j) {
8177 jc = ipp2 - j;
8178 j2 = j + j;
8179 i__2 = *l1;
8180 for (k = 1; k <= i__2; ++k) {
8181 i__3 = *ido;
8182 for (i__ = 3; i__ <= i__3; i__ += 2) {
8183 ic = idp2 - i__;
8184 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
8185 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8186 ch_dim2) * ch_dim1];
8187 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
8188 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
8189 ch_dim2) * ch_dim1];
8190 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
8191 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8192 ch_dim1];
8193 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
8194 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
8195 ch_dim1];
8196/* L138: */
8197 }
8198/* L139: */
8199 }
8200/* L140: */
8201 }
8202 return 0;
8203L141:
8204 i__1 = ipph;
8205 for (j = 2; j <= i__1; ++j) {
8206 jc = ipp2 - j;
8207 j2 = j + j;
8208 i__2 = *ido;
8209 for (i__ = 3; i__ <= i__2; i__ += 2) {
8210 ic = idp2 - i__;
8211 i__3 = *l1;
8212 for (k = 1; k <= i__3; ++k) {
8213 cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
8214 (k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8215 ch_dim2) * ch_dim1];
8216 cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
8217 k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
8218 ch_dim2) * ch_dim1];
8219 cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
8220 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8221 ch_dim1];
8222 cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
8223 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
8224 ch_dim1];
8225/* L142: */
8226 }
8227/* L143: */
8228 }
8229/* L144: */
8230 }
8231 return 0;
8232} /* dadfg_ */
8233
8234/* ------ File dfftb.f ------ */
8235/* Subroutine */ int dfftb_(integer *n, double *r__, double *wsave)
8236{
8237 extern /* Subroutine */ int dfftb1_(integer *, double *, double *, double *,
8238 integer *);
8239
8240 /* Parameter adjustments */
8241 --wsave;
8242 --r__;
8243
8244 /* Function Body */
8245 if (*n == 1) {
8246 return 0;
8247 }
8248 dfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
8249 return 0;
8250} /* dfftb_ */
8251
8252/* ------ File dfftb1.f ------ */
8253/* Subroutine */ int dfftb1_(integer *n, double *c__, double *ch, double *wa,
8254 integer *ifac)
8255{
8256 /* System generated locals */
8257 integer i__1;
8258
8259 /* Local variables */
8260 extern /* Subroutine */ int dadb2_(integer *, integer *, double *, double *,
8261 double *), dadb3_(integer *, integer *, double *, double *, double *,
8262 double *), dadb4_(integer *, integer *, double *, double *, double *,
8263 double *, double *), dadb5_(integer *, integer *, double *, double *,
8264 double *, double *, double *, double *);
8265 static integer i__;
8266 extern /* Subroutine */ int dadbg_(integer *, integer *, integer *,
8267 integer *, double *, double *, double *, double *, double *, double *);
8268 static integer k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
8269
8270 /* Parameter adjustments */
8271 --ifac;
8272 --wa;
8273 --ch;
8274 --c__;
8275
8276 /* Function Body */
8277 nf = ifac[2];
8278 na = 0;
8279 l1 = 1;
8280 iw = 1;
8281 i__1 = nf;
8282 for (k1 = 1; k1 <= i__1; ++k1) {
8283 ip = ifac[k1 + 2];
8284 l2 = ip * l1;
8285 ido = *n / l2;
8286 idl1 = ido * l1;
8287 if (ip != 4) {
8288 goto L103;
8289 }
8290 ix2 = iw + ido;
8291 ix3 = ix2 + ido;
8292 if (na != 0) {
8293 goto L101;
8294 }
8295 dadb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
8296 goto L102;
8297L101:
8298 dadb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
8299L102:
8300 na = 1 - na;
8301 goto L115;
8302L103:
8303 if (ip != 2) {
8304 goto L106;
8305 }
8306 if (na != 0) {
8307 goto L104;
8308 }
8309 dadb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
8310 goto L105;
8311L104:
8312 dadb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
8313L105:
8314 na = 1 - na;
8315 goto L115;
8316L106:
8317 if (ip != 3) {
8318 goto L109;
8319 }
8320 ix2 = iw + ido;
8321 if (na != 0) {
8322 goto L107;
8323 }
8324 dadb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
8325 goto L108;
8326L107:
8327 dadb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
8328L108:
8329 na = 1 - na;
8330 goto L115;
8331L109:
8332 if (ip != 5) {
8333 goto L112;
8334 }
8335 ix2 = iw + ido;
8336 ix3 = ix2 + ido;
8337 ix4 = ix3 + ido;
8338 if (na != 0) {
8339 goto L110;
8340 }
8341 dadb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8342 ix4]);
8343 goto L111;
8344L110:
8345 dadb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8346 ix4]);
8347L111:
8348 na = 1 - na;
8349 goto L115;
8350L112:
8351 if (na != 0) {
8352 goto L113;
8353 }
8354 dadbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
8355 1], &wa[iw]);
8356 goto L114;
8357L113:
8358 dadbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
8359 , &wa[iw]);
8360L114:
8361 if (ido == 1) {
8362 na = 1 - na;
8363 }
8364L115:
8365 l1 = l2;
8366 iw += (ip - 1) * ido;
8367/* L116: */
8368 }
8369 if (na == 0) {
8370 return 0;
8371 }
8372 i__1 = *n;
8373 for (i__ = 1; i__ <= i__1; ++i__) {
8374 c__[i__] = ch[i__];
8375/* L117: */
8376 }
8377 return 0;
8378} /* dfftb1_ */
8379
8380/* ------ File dfftf.f ------ */
8381/* Subroutine */ int dfftf_(integer *n, double *r__, double *wsave)
8382{
8383 extern /* Subroutine */ int dfftf1_(integer *, double *, double *, double *,
8384 integer *);
8385
8386 /* Parameter adjustments */
8387 --wsave;
8388 --r__;
8389
8390 /* Function Body */
8391 if (*n == 1) {
8392 return 0;
8393 }
8394 dfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
8395 return 0;
8396} /* dfftf_ */
8397
8398/* ------ File dfftf1.f ------ */
8399/* Subroutine */ int dfftf1_(integer *n, double *c__, double *ch, double *wa,
8400 integer *ifac)
8401{
8402 /* System generated locals */
8403 integer i__1;
8404
8405 /* Local variables */
8406 extern /* Subroutine */ int dadf2_(integer *, integer *, double *, double *,
8407 double *), dadf3_(integer *, integer *, double *, double *, double *,
8408 double *), dadf4_(integer *, integer *, double *, double *, double *,
8409 double *, double *), dadf5_(integer *, integer *, double *, double *,
8410 double *, double *, double *, double *);
8411 static integer i__;
8412 extern /* Subroutine */ int dadfg_(integer *, integer *, integer *,
8413 integer *, double *, double *, double *, double *, double *, double *);
8414 static integer k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
8415
8416 /* Parameter adjustments */
8417 --ifac;
8418 --wa;
8419 --ch;
8420 --c__;
8421
8422 /* Function Body */
8423 nf = ifac[2];
8424 na = 1;
8425 l2 = *n;
8426 iw = *n;
8427 i__1 = nf;
8428 for (k1 = 1; k1 <= i__1; ++k1) {
8429 kh = nf - k1;
8430 ip = ifac[kh + 3];
8431 l1 = l2 / ip;
8432 ido = *n / l2;
8433 idl1 = ido * l1;
8434 iw -= (ip - 1) * ido;
8435 na = 1 - na;
8436 if (ip != 4) {
8437 goto L102;
8438 }
8439 ix2 = iw + ido;
8440 ix3 = ix2 + ido;
8441 if (na != 0) {
8442 goto L101;
8443 }
8444 dadf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
8445 goto L110;
8446L101:
8447 dadf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
8448 goto L110;
8449L102:
8450 if (ip != 2) {
8451 goto L104;
8452 }
8453 if (na != 0) {
8454 goto L103;
8455 }
8456 dadf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
8457 goto L110;
8458L103:
8459 dadf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
8460 goto L110;
8461L104:
8462 if (ip != 3) {
8463 goto L106;
8464 }
8465 ix2 = iw + ido;
8466 if (na != 0) {
8467 goto L105;
8468 }
8469 dadf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
8470 goto L110;
8471L105:
8472 dadf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
8473 goto L110;
8474L106:
8475 if (ip != 5) {
8476 goto L108;
8477 }
8478 ix2 = iw + ido;
8479 ix3 = ix2 + ido;
8480 ix4 = ix3 + ido;
8481 if (na != 0) {
8482 goto L107;
8483 }
8484 dadf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8485 ix4]);
8486 goto L110;
8487L107:
8488 dadf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8489 ix4]);
8490 goto L110;
8491L108:
8492 if (ido == 1) {
8493 na = 1 - na;
8494 }
8495 if (na != 0) {
8496 goto L109;
8497 }
8498 dadfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
8499 1], &wa[iw]);
8500 na = 1;
8501 goto L110;
8502L109:
8503 dadfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
8504 , &wa[iw]);
8505 na = 0;
8506L110:
8507 l2 = l1;
8508/* L111: */
8509 }
8510 if (na == 1) {
8511 return 0;
8512 }
8513 i__1 = *n;
8514 for (i__ = 1; i__ <= i__1; ++i__) {
8515 c__[i__] = ch[i__];
8516/* L112: */
8517 }
8518 return 0;
8519} /* dfftf1_ */
8520
8521/* ------ File dffti.f ------ */
8522/* Subroutine */ int dffti_(integer *n, double *wsave)
8523{
8524 extern /* Subroutine */ int dffti1_(integer *, double *, integer *);
8525
8526 /* Parameter adjustments */
8527 --wsave;
8528
8529 /* Function Body */
8530 if (*n == 1) {
8531 return 0;
8532 }
8533 dffti1_(n, &wsave[*n + 1], &wsave[(*n << 1) + 1]);
8534 return 0;
8535} /* dffti_ */
8536
8537/* ------ File dffti1.f ------ */
8538/* Subroutine */ int dffti1_(integer *n, double *wa, integer *ifac)
8539{
8540 /* Initialized data */
8541
8542 static integer ntryh[4] = { 4,2,3,5 };
8543
8544 /* System generated locals */
8545 integer i__1, i__2, i__3;
8546
8547 /* Builtin functions */
8548 double cos(doublereal), sin(doublereal);
8549
8550 /* Local variables */
8551 static double argh;
8552 static integer ntry, i__, j;
8553 static double argld;
8554 static integer k1, l1, l2, ib;
8555 static double fi;
8556 static integer ld, ii, nf, ip, nl, is, nq, nr;
8557 static double arg;
8558 static integer ido, ipm;
8559 static double tpi;
8560 static integer nfm1;
8561
8562 /* Parameter adjustments */
8563 --ifac;
8564 --wa;
8565
8566 /* Function Body */
8567 nl = *n;
8568 nf = 0;
8569 j = 0;
8570L101:
8571 ++j;
8572 if (j - 4 <= 0) {
8573 goto L102;
8574 } else {
8575 goto L103;
8576 }
8577L102:
8578 ntry = ntryh[j - 1];
8579 goto L104;
8580L103:
8581 ntry += 2;
8582L104:
8583 nq = nl / ntry;
8584 nr = nl - ntry * nq;
8585 if (nr != 0) {
8586 goto L101;
8587 } else {
8588 goto L105;
8589 }
8590L105:
8591 ++nf;
8592 ifac[nf + 2] = ntry;
8593 nl = nq;
8594 if (ntry != 2) {
8595 goto L107;
8596 }
8597 if (nf == 1) {
8598 goto L107;
8599 }
8600 i__1 = nf;
8601 for (i__ = 2; i__ <= i__1; ++i__) {
8602 ib = nf - i__ + 2;
8603 ifac[ib + 2] = ifac[ib + 1];
8604/* L106: */
8605 }
8606 ifac[3] = 2;
8607L107:
8608 if (nl != 1) {
8609 goto L104;
8610 }
8611 ifac[1] = *n;
8612 ifac[2] = nf;
8613 tpi = 6.28318530717959f;
8614 argh = tpi / (double) (*n);
8615 is = 0;
8616 nfm1 = nf - 1;
8617 l1 = 1;
8618 if (nfm1 == 0) {
8619 return 0;
8620 }
8621 i__1 = nfm1;
8622 for (k1 = 1; k1 <= i__1; ++k1) {
8623 ip = ifac[k1 + 2];
8624 ld = 0;
8625 l2 = l1 * ip;
8626 ido = *n / l2;
8627 ipm = ip - 1;
8628 i__2 = ipm;
8629 for (j = 1; j <= i__2; ++j) {
8630 ld += l1;
8631 i__ = is;
8632 argld = (double) ld * argh;
8633 fi = 0.f;
8634 i__3 = ido;
8635 for (ii = 3; ii <= i__3; ii += 2) {
8636 i__ += 2;
8637 fi += 1.f;
8638 arg = fi * argld;
8639 wa[i__ - 1] = cos(arg);
8640 wa[i__] = sin(arg);
8641/* L108: */
8642 }
8643 is += ido;
8644/* L109: */
8645 }
8646 l1 = l2;
8647/* L110: */
8648 }
8649 return 0;
8650} /* dffti1_ */
8651
8652/* ------ File dsinqb.f ------ */
8653/* Subroutine */ int dsinqb_(integer *n, double *x, double *wsave)
8654{
8655 /* System generated locals */
8656 integer i__1;
8657
8658 /* Local variables */
8659 static integer k;
8660 extern /* Subroutine */ int dcosqb_(integer *, double *, double *);
8661 static double xhold;
8662 static integer kc, ns2;
8663
8664 /* Parameter adjustments */
8665 --wsave;
8666 --x;
8667
8668 /* Function Body */
8669 if (*n > 1) {
8670 goto L101;
8671 }
8672 x[1] *= 4.f;
8673 return 0;
8674L101:
8675 ns2 = *n / 2;
8676 i__1 = *n;
8677 for (k = 2; k <= i__1; k += 2) {
8678 x[k] = -x[k];
8679/* L102: */
8680 }
8681 dcosqb_(n, &x[1], &wsave[1]);
8682 i__1 = ns2;
8683 for (k = 1; k <= i__1; ++k) {
8684 kc = *n - k;
8685 xhold = x[k];
8686 x[k] = x[kc + 1];
8687 x[kc + 1] = xhold;
8688/* L103: */
8689 }
8690 return 0;
8691} /* dsinqb_ */
8692
8693/* ------ File dsinqf.f ------ */
8694/* Subroutine */ int dsinqf_(integer *n, double *x, double *wsave)
8695{
8696 /* System generated locals */
8697 integer i__1;
8698
8699 /* Local variables */
8700 static integer k;
8701 extern /* Subroutine */ int dcosqf_(integer *, double *, double *);
8702 static double xhold;
8703 static integer kc, ns2;
8704
8705 /* Parameter adjustments */
8706 --wsave;
8707 --x;
8708
8709 /* Function Body */
8710 if (*n == 1) {
8711 return 0;
8712 }
8713 ns2 = *n / 2;
8714 i__1 = ns2;
8715 for (k = 1; k <= i__1; ++k) {
8716 kc = *n - k;
8717 xhold = x[k];
8718 x[k] = x[kc + 1];
8719 x[kc + 1] = xhold;
8720/* L101: */
8721 }
8722 dcosqf_(n, &x[1], &wsave[1]);
8723 i__1 = *n;
8724 for (k = 2; k <= i__1; k += 2) {
8725 x[k] = -x[k];
8726/* L102: */
8727 }
8728 return 0;
8729} /* dsinqf_ */
8730
8731/* ------ File dsinqi.f ------ */
8732/* Subroutine */ int dsinqi_(integer *n, double *wsave)
8733{
8734 extern /* Subroutine */ int dcosqi_(integer *, double *);
8735
8736 /* Parameter adjustments */
8737 --wsave;
8738
8739 /* Function Body */
8740 dcosqi_(n, &wsave[1]);
8741 return 0;
8742} /* dsinqi_ */
8743
8744/* ------ File dsint.f ------ */
8745/* Subroutine */ int dsint_(integer *n, double *x, double *wsave)
8746{
8747 extern /* Subroutine */ int dsint1_(integer *, double *, double *, double *,
8748 double *, integer *);
8749 static integer np1, iw1, iw2, iw3;
8750
8751 /* Parameter adjustments */
8752 --wsave;
8753 --x;
8754
8755 /* Function Body */
8756 np1 = *n + 1;
8757 iw1 = *n / 2 + 1;
8758 iw2 = iw1 + np1;
8759 iw3 = iw2 + np1;
8760 dsint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], &wsave[iw3]);
8761 return 0;
8762} /* dsint_ */
8763
8764/* ------ File dsint1.f ------ */
8765/* Subroutine */ int dsint1_(integer *n, double *war, double *was, double *xh, double *
8766 x, integer *ifac)
8767{
8768 /* Initialized data */
8769
8770 static double sqrt3 = 1.73205080756888f;
8771
8772 /* System generated locals */
8773 integer i__1;
8774
8775 /* Local variables */
8776 static integer modn, i__, k;
8777 static double xhold, t1, t2;
8778 extern /* Subroutine */ int dfftf1_(integer *, double *, double *, double *,
8779 integer *);
8780 static integer kc, np1, ns2;
8781
8782 /* Parameter adjustments */
8783 --ifac;
8784 --x;
8785 --xh;
8786 --was;
8787 --war;
8788
8789 /* Function Body */
8790 i__1 = *n;
8791 for (i__ = 1; i__ <= i__1; ++i__) {
8792 xh[i__] = war[i__];
8793 war[i__] = x[i__];
8794/* L100: */
8795 }
8796 if ((i__1 = *n - 2) < 0) {
8797 goto L101;
8798 } else if (i__1 == 0) {
8799 goto L102;
8800 } else {
8801 goto L103;
8802 }
8803L101:
8804 xh[1] += xh[1];
8805 goto L106;
8806L102:
8807 xhold = sqrt3 * (xh[1] + xh[2]);
8808 xh[2] = sqrt3 * (xh[1] - xh[2]);
8809 xh[1] = xhold;
8810 goto L106;
8811L103:
8812 np1 = *n + 1;
8813 ns2 = *n / 2;
8814 x[1] = 0.f;
8815 i__1 = ns2;
8816 for (k = 1; k <= i__1; ++k) {
8817 kc = np1 - k;
8818 t1 = xh[k] - xh[kc];
8819 t2 = was[k] * (xh[k] + xh[kc]);
8820 x[k + 1] = t1 + t2;
8821 x[kc + 1] = t2 - t1;
8822/* L104: */
8823 }
8824 modn = *n % 2;
8825 if (modn != 0) {
8826 x[ns2 + 2] = xh[ns2 + 1] * 4.f;
8827 }
8828 dfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
8829 xh[1] = x[1] * .5f;
8830 i__1 = *n;
8831 for (i__ = 3; i__ <= i__1; i__ += 2) {
8832 xh[i__ - 1] = -x[i__];
8833 xh[i__] = xh[i__ - 2] + x[i__ - 1];
8834/* L105: */
8835 }
8836 if (modn != 0) {
8837 goto L106;
8838 }
8839 xh[*n] = -x[*n + 1];
8840L106:
8841 i__1 = *n;
8842 for (i__ = 1; i__ <= i__1; ++i__) {
8843 x[i__] = war[i__];
8844 war[i__] = xh[i__];
8845/* L107: */
8846 }
8847 return 0;
8848} /* dsint1_ */
8849
8850/* ------ File dsinti.f ------ */
8851/* Subroutine */ int dsinti_(integer *n, double *wsave)
8852{
8853 /* Initialized data */
8854
8855 static double pi = 3.14159265358979f;
8856
8857 /* System generated locals */
8858 integer i__1;
8859
8860 /* Builtin functions */
8861 double sin(doublereal);
8862
8863 /* Local variables */
8864 static integer k;
8865 extern /* Subroutine */ int dffti_(integer *, double *);
8866 static double dt;
8867 static integer np1, ns2;
8868
8869 /* Parameter adjustments */
8870 --wsave;
8871
8872 /* Function Body */
8873 if (*n <= 1) {
8874 return 0;
8875 }
8876 ns2 = *n / 2;
8877 np1 = *n + 1;
8878 dt = pi / (double) np1;
8879 i__1 = ns2;
8880 for (k = 1; k <= i__1; ++k) {
8881 wsave[k] = sin(k * dt) * 2.f;
8882/* L101: */
8883 }
8884 dffti_(&np1, &wsave[ns2 + 1]);
8885 return 0;
8886} /* dsinti_ */
8887
Note: See TracBrowser for help on using the repository browser.