source: Sophya/trunk/SophyaLib/NTools/fftpackc.c@ 663

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

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