Context Navigation

fftpackc.c@ 1474

Visit:

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

Restructuration de Sophya en petits modules - Petites corrections diverses

Reza 2/3/2000

File size: 227.2 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_(int_4 n, r_4 c__, r_4 wsave)
14	{
15	extern /* Subroutine / int cfftb1_(int_4 , r_4 , r_4 , r_4 *,
16	int_4 *);
17	static int_4 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_4 )&wsave[iw2]); / (int ) ajoute - Reza 29/11/99 /
30	return 0;
31	} /* cfftb_ */
32
33	/* ------ File cfftb1.f ------ */
34	/* Subroutine / int cfftb1_(int_4 n, r_4 c__, r_4 ch, r_4 *wa,
35	int_4 *ifac)
36	{
37	/* System generated locals */
38	int_4 i__1;
39
40	/* Local variables */
41	static int_4 idot, i__;
42	extern /* Subroutine / int passb_(int_4 , int_4 , int_4 ,
43	int_4 , int_4 , r_4 , r_4 , r_4 , r_4 , r_4 *,
44	r_4 *);
45	static int_4 k1, l1, l2, n2;
46	extern /* Subroutine / int passb2_(int_4 , int_4 , r_4 , r_4 *,
47	r_4 ), passb3_(int_4 , int_4 , r_4 , r_4 , r_4 ,
48	r_4 ), passb4_(int_4 , int_4 , r_4 , r_4 , r_4 ,
49	r_4 , r_4 ), passb5_(int_4 , int_4 , r_4 , r_4 ,
50	r_4 , r_4 , r_4 , r_4 );
51	static int_4 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;
81	L101:
82	passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
83	L102:
84	na = 1 - na;
85	goto L115;
86	L103:
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;
95	L104:
96	passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
97	L105:
98	na = 1 - na;
99	goto L115;
100	L106:
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;
110	L107:
111	passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
112	L108:
113	na = 1 - na;
114	goto L115;
115	L109:
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;
128	L110:
129	passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
130	ix4]);
131	L111:
132	na = 1 - na;
133	goto L115;
134	L112:
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;
141	L113:
142	passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
143	&c__[1], &wa[iw]);
144	L114:
145	if (nac != 0) {
146	na = 1 - na;
147	}
148	L115:
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_(int_4 n, r_4 c__, r_4 wsave)
167	{
168	extern /* Subroutine / int cfftf1_(int_4 , r_4 , r_4 , r_4 *,
169	int_4 *);
170	static int_4 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_4 )&wsave[iw2]); / (int ) ajoute - Reza 29/11/99 /
183	return 0;
184	} /* cfftf_ */
185
186	/* ------ File cfftf1.f ------ */
187	/* Subroutine / int cfftf1_(int_4 n, r_4 c__, r_4 ch, r_4 *wa,
188	int_4 *ifac)
189	{
190	/* System generated locals */
191	int_4 i__1;
192
193	/* Local variables */
194	static int_4 idot, i__;
195	extern /* Subroutine / int passf_(int_4 , int_4 , int_4 ,
196	int_4 , int_4 , r_4 , r_4 , r_4 , r_4 , r_4 *,
197	r_4 *);
198	static int_4 k1, l1, l2, n2;
199	extern /* Subroutine / int passf2_(int_4 , int_4 , r_4 , r_4 *,
200	r_4 ), passf3_(int_4 , int_4 , r_4 , r_4 , r_4 ,
201	r_4 ), passf4_(int_4 , int_4 , r_4 , r_4 , r_4 ,
202	r_4 , r_4 ), passf5_(int_4 , int_4 , r_4 , r_4 ,
203	r_4 , r_4 , r_4 , r_4 );
204	static int_4 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;
234	L101:
235	passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
236	L102:
237	na = 1 - na;
238	goto L115;
239	L103:
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;
248	L104:
249	passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
250	L105:
251	na = 1 - na;
252	goto L115;
253	L106:
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;
263	L107:
264	passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
265	L108:
266	na = 1 - na;
267	goto L115;
268	L109:
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;
281	L110:
282	passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
283	ix4]);
284	L111:
285	na = 1 - na;
286	goto L115;
287	L112:
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;
294	L113:
295	passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
296	&c__[1], &wa[iw]);
297	L114:
298	if (nac != 0) {
299	na = 1 - na;
300	}
301	L115:
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_(int_4 n, r_4 *wsave)
320	{
321	extern /* Subroutine / int cffti1_(int_4 , r_4 , int_4 );
322	static int_4 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_4 )&wsave[iw2]); / (int ) ajoute Reza 29/11/99 /
334	return 0;
335	} /* cffti_ */
336
337	/* ------ File cffti1.f ------ */
338	/* Subroutine / int cffti1_(int_4 n, r_4 wa, int_4 ifac)
339	{
340	/* Initialized data */
341
342	static int_4 ntryh[4] = { 3,4,2,5 };
343
344	/* System generated locals */
345	int_4 i__1, i__2, i__3;
346
347	/* Builtin functions */
348	/* r_8 cos(r_8truc), sin(r_8truc); commente, remplace par math.h - Reza 29/11/99 */
349
350	/* Local variables */
351	static r_4 argh;
352	static int_4 idot, ntry, i__, j;
353	static r_4 argld;
354	static int_4 i1, k1, l1, l2, ib;
355	static r_4 fi;
356	static int_4 ld, ii, nf, ip, nl, nq, nr;
357	static r_4 arg;
358	static int_4 ido, ipm;
359	static r_4 tpi;
360
361	/* Parameter adjustments */
362	--ifac;
363	--wa;
364
365	/* Function Body */
366	nl = *n;
367	nf = 0;
368	j = 0;
369	L101:
370	++j;
371	if (j - 4 <= 0) {
372	goto L102;
373	} else {
374	goto L103;
375	}
376	L102:
377	ntry = ntryh[j - 1];
378	goto L104;
379	L103:
380	ntry += 2;
381	L104:
382	nq = nl / ntry;
383	nr = nl - ntry * nq;
384	if (nr != 0) {
385	goto L101;
386	} else {
387	goto L105;
388	}
389	L105:
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;
406	L107:
407	if (nl != 1) {
408	goto L104;
409	}
410	ifac[1] = *n;
411	ifac[2] = nf;
412	tpi = 6.28318530717959f;
413	argh = tpi / (r_4) (*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 = (r_4) 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__];
446	L109:
447	;
448	}
449	l1 = l2;
450	/* L110: */
451	}
452	return 0;
453	} /* cffti1_ */
454
455	/* ------ File cosqb.f ------ */
456	/* Subroutine / int cosqb_(int_4 n, r_4 x, r_4 wsave)
457	{
458	/* Initialized data */
459
460	static r_4 tsqrt2 = 2.82842712474619f;
461
462	/* System generated locals */
463	int_4 i__1;
464
465	/* Local variables */
466	static r_4 x1;
467	extern /* Subroutine / int cosqb1_(int_4 , r_4 , r_4 , r_4 *);
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	}
481	L101:
482	x[1] *= 4.f;
483	return 0;
484	L102:
485	x1 = (x[1] + x[2]) * 4.f;
486	x[2] = tsqrt2 * (x[1] - x[2]);
487	x[1] = x1;
488	return 0;
489	L103:
490	cosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
491	return 0;
492	} /* cosqb_ */
493
494	/* ------ File cosqb1.f ------ */
495	/* Subroutine / int cosqb1_(int_4 n, r_4 x, r_4 w, r_4 *xh)
496	{
497	/* System generated locals */
498	int_4 i__1;
499
500	/* Local variables */
501	static int_4 modn, i__, k;
502	extern /* Subroutine / int rfftb_(int_4 , r_4 , r_4 );
503	static int_4 kc, np2, ns2;
504	static r_4 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_(int_4 n, r_4 x, r_4 wsave)
550	{
551	/* Initialized data */
552
553	static r_4 sqrt2 = 1.4142135623731f;
554
555	/* System generated locals */
556	int_4 i__1;
557
558	/* Local variables */
559	static r_4 tsqx;
560	extern /* Subroutine / int cosqf1_(int_4 , r_4 , r_4 , r_4 *);
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	}
574	L101:
575	tsqx = sqrt2 * x[2];
576	x[2] = x[1] - tsqx;
577	x[1] += tsqx;
578	L102:
579	return 0;
580	L103:
581	cosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
582	return 0;
583	} /* cosqf_ */
584
585	/* ------ File cosqf1.f ------ */
586	/* Subroutine / int cosqf1_(int_4 n, r_4 x, r_4 w, r_4 *xh)
587	{
588	/* System generated locals */
589	int_4 i__1;
590
591	/* Local variables */
592	static int_4 modn, i__, k;
593	extern /* Subroutine / int rfftf_(int_4 , r_4 , r_4 );
594	static int_4 kc, np2, ns2;
595	static r_4 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_(int_4 n, r_4 *wsave)
639	{
640	/* Initialized data */
641
642	static r_4 pih = 1.57079632679491f;
643
644	/* System generated locals */
645	int_4 i__1;
646
647	/* Builtin functions */
648	/* r_8 cos(r_8truc); commente - Remplace par math.h Reza 29/11/99 */
649
650	/* Local variables */
651	static int_4 k;
652	extern /* Subroutine / int rffti_(int_4 , r_4 *);
653	static r_4 fk, dt;
654
655	/* Parameter adjustments */
656	--wsave;
657
658	/* Function Body */
659	dt = pih / (r_4) (*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_(int_4 n, r_4 x, r_4 wsave)
673	{
674	/* System generated locals */
675	int_4 i__1;
676
677	/* Local variables */
678	static int_4 modn, i__, k;
679	extern /* Subroutine / int rfftf_(int_4 , r_4 , r_4 );
680	static r_4 c1, t1, t2;
681	static int_4 kc;
682	static r_4 xi;
683	static int_4 nm1, np1;
684	static r_4 x1h;
685	static int_4 ns2;
686	static r_4 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	}
703	L101:
704	x1h = x[1] + x[2];
705	x[2] = x[1] - x[2];
706	x[1] = x1h;
707	return 0;
708	L102:
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;
718	L103:
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	}
750	L106:
751	return 0;
752	} /* cost_ */
753
754	/* ------ File costi.f ------ */
755	/* Subroutine / int costi_(int_4 n, r_4 *wsave)
756	{
757	/* Initialized data */
758
759	static r_4 pi = 3.14159265358979f;
760
761	/* System generated locals */
762	int_4 i__1;
763
764	/* Builtin functions */
765	/* r_8 sin(r_8truc), cos(r_8truc); commente - Remplace par math.h Reza 29/11/99 */
766
767	/* Local variables */
768	static int_4 k;
769	extern /* Subroutine / int rffti_(int_4 , r_4 *);
770	static int_4 kc;
771	static r_4 fk, dt;
772	static int_4 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 / (r_4) 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_(int_4 n, r_4 wa, int_4 ifac)
800	{
801	/* Initialized data */
802
803	static int_4 ntryh[4] = { 4,2,3,5 };
804	static r_4 tpi = 6.28318530717959f;
805
806	/* System generated locals */
807	int_4 i__1, i__2, i__3;
808
809	/* Builtin functions */
810	/* r_8 cos(r_8truc), sin(r_8truc); commente - Remplace par math.h Reza 29/11/99 */
811
812	/* Local variables */
813	static r_4 argh;
814	static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr;
815	static r_4 ch1, sh1;
816	static int_4 ido, ipm;
817	static r_4 dch1, ch1h, arg1, dsh1;
818	static int_4 nfm1;
819
820	/* Parameter adjustments */
821	--ifac;
822	--wa;
823
824	/* Function Body */
825	nl = *n;
826	nf = 0;
827	j = 0;
828	L101:
829	++j;
830	if (j - 4 <= 0) {
831	goto L102;
832	} else {
833	goto L103;
834	}
835	L102:
836	ntry = ntryh[j - 1];
837	goto L104;
838	L103:
839	ntry += 2;
840	L104:
841	nq = nl / ntry;
842	nr = nl - ntry * nq;
843	if (nr != 0) {
844	goto L101;
845	} else {
846	goto L105;
847	}
848	L105:
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;
865	L107:
866	if (nl != 1) {
867	goto L104;
868	}
869	ifac[1] = *n;
870	ifac[2] = nf;
871	argh = tpi / (r_4) (*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 = (r_4) 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	}
907	L109:
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_(int_4 n, r_4 r__, r_4 azero, r_4 *a,
919	r_4 b, r_4 wsave)
920	{
921	/* System generated locals */
922	int_4 i__1;
923
924	/* Local variables */
925	static int_4 i__;
926	extern /* Subroutine / int rfftb_(int_4 , r_4 , r_4 );
927	static int_4 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	}
943	L101:
944	r__[1] = *azero;
945	return 0;
946	L102:
947	r__[1] = *azero + a[1];
948	r__[2] = *azero - a[1];
949	return 0;
950	L103:
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_(int_4 n, r_4 r__, r_4 azero, r_4 *a,
968	r_4 b, r_4 wsave)
969	{
970	/* System generated locals */
971	int_4 i__1;
972
973	/* Local variables */
974	static int_4 i__;
975	extern /* Subroutine / int rfftf_(int_4 , r_4 , r_4 );
976	static r_4 cf;
977	static int_4 ns2;
978	static r_4 cfm;
979	static int_4 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	}
998	L101:
999	*azero = r__[1];
1000	return 0;
1001	L102:
1002	azero = (r__[1] + r__[2]) .5f;
1003	a[1] = (r__[1] - r__[2]) * .5f;
1004	return 0;
1005	L103:
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 / (r_4) (*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_(int_4 n, r_4 *wsave)
1033	{
1034	extern /* Subroutine / int ezfft1_(int_4 , r_4 , int_4 );
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], (int_4)&wsave[n 3 + 1]);
1044	return 0;
1045	} /* ezffti_ */
1046
1047	/* ------ File passb.f ------ */
1048	/* Subroutine / int passb_(int_4 nac, int_4 ido, int_4 ip, int_4 *
1049	l1, int_4 idl1, r_4 cc, r_4 c1, r_4 c2, r_4 ch, r_4 ch2,
1050	r_4 *wa)
1051	{
1052	/* System generated locals */
1053	int_4 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 int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
1059	idl, inc, idp;
1060	static r_4 wai, war;
1061	static int_4 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;
1124	L106:
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	}
1154	L112:
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;
1262	L127:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1290	r_4 *wa1)
1291	{
1292	/* System generated locals */
1293	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1294
1295	/* Local variables */
1296	static int_4 i__, k;
1297	static r_4 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;
1326	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1352	r_4 wa1, r_4 wa2)
1353	{
1354	/* Initialized data */
1355
1356	static r_4 taur = -.5f;
1357	static r_4 taui = .866025403784439f;
1358
1359	/* System generated locals */
1360	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1361
1362	/* Local variables */
1363	static int_4 i__, k;
1364	static r_4 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;
1400	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1440	r_4 wa1, r_4 wa2, r_4 *wa3)
1441	{
1442	/* System generated locals */
1443	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1444
1445	/* Local variables */
1446	static int_4 i__, k;
1447	static r_4 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;
1495	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1545	r_4 wa1, r_4 wa2, r_4 wa3, r_4 wa4)
1546	{
1547	/* Initialized data */
1548
1549	static r_4 tr11 = .309016994374947f;
1550	static r_4 ti11 = .951056516295154f;
1551	static r_4 tr12 = -.809016994374947f;
1552	static r_4 ti12 = .587785252292473f;
1553
1554	/* System generated locals */
1555	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1556
1557	/* Local variables */
1558	static int_4 i__, k;
1559	static r_4 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;
1612	L102:
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_(int_4 nac, int_4 ido, int_4 ip, int_4 *
1680	l1, int_4 idl1, r_4 cc, r_4 c1, r_4 c2, r_4 ch, r_4 ch2,
1681	r_4 *wa)
1682	{
1683	/* System generated locals */
1684	int_4 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 int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
1690	idl, inc, idp;
1691	static r_4 wai, war;
1692	static int_4 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;
1755	L106:
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	}
1785	L112:
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;
1893	L127:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1921	r_4 *wa1)
1922	{
1923	/* System generated locals */
1924	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1925
1926	/* Local variables */
1927	static int_4 i__, k;
1928	static r_4 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;
1957	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
1983	r_4 wa1, r_4 wa2)
1984	{
1985	/* Initialized data */
1986
1987	static r_4 taur = -.5f;
1988	static r_4 taui = -.866025403784439f;
1989
1990	/* System generated locals */
1991	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
1992
1993	/* Local variables */
1994	static int_4 i__, k;
1995	static r_4 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;
2031	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2071	r_4 wa1, r_4 wa2, r_4 *wa3)
2072	{
2073	/* System generated locals */
2074	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2075
2076	/* Local variables */
2077	static int_4 i__, k;
2078	static r_4 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;
2126	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2176	r_4 wa1, r_4 wa2, r_4 wa3, r_4 wa4)
2177	{
2178	/* Initialized data */
2179
2180	static r_4 tr11 = .309016994374947f;
2181	static r_4 ti11 = -.951056516295154f;
2182	static r_4 tr12 = -.809016994374947f;
2183	static r_4 ti12 = -.587785252292473f;
2184
2185	/* System generated locals */
2186	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2187
2188	/* Local variables */
2189	static int_4 i__, k;
2190	static r_4 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;
2243	L102:
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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2311	r_4 *wa1)
2312	{
2313	/* System generated locals */
2314	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2315
2316	/* Local variables */
2317	static int_4 i__, k, ic;
2318	static r_4 ti2, tr2;
2319	static int_4 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	}
2347	L102:
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	}
2373	L105:
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	}
2382	L107:
2383	return 0;
2384	} /* radb2_ */
2385
2386	/* ------ File radb3.f ------ */
2387	/* Subroutine / int radb3_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2388	r_4 wa1, r_4 wa2)
2389	{
2390	/* Initialized data */
2391
2392	static r_4 taur = -.5f;
2393	static r_4 taui = .866025403784439f;
2394
2395	/* System generated locals */
2396	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2397
2398	/* Local variables */
2399	static int_4 i__, k, ic;
2400	static r_4 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
2401	static int_4 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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2471	r_4 wa1, r_4 wa2, r_4 *wa3)
2472	{
2473	/* Initialized data */
2474
2475	static r_4 sqrt2 = 1.414213562373095f;
2476
2477	/* System generated locals */
2478	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2479
2480	/* Local variables */
2481	static int_4 i__, k, ic;
2482	static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
2483	tr3, tr4;
2484	static int_4 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	}
2522	L102:
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	}
2572	L105:
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	}
2589	L107:
2590	return 0;
2591	} /* radb4_ */
2592
2593	/* ------ File radb5.f ------ */
2594	/* Subroutine / int radb5_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
2595	r_4 wa1, r_4 wa2, r_4 wa3, r_4 wa4)
2596	{
2597	/* Initialized data */
2598
2599	static r_4 tr11 = .309016994374947f;
2600	static r_4 ti11 = .951056516295154f;
2601	static r_4 tr12 = -.809016994374947f;
2602	static r_4 ti12 = .587785252292473f;
2603
2604	/* System generated locals */
2605	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
2606
2607	/* Local variables */
2608	static int_4 i__, k, ic;
2609	static r_4 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 int_4 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_(int_4 ido, int_4 ip, int_4 l1, int_4 *
2719	idl1, r_4 cc, r_4 c1, r_4 c2, r_4 ch, r_4 ch2, r_4 wa)
2720	{
2721	/* Initialized data */
2722
2723	static r_4 tpi = 6.28318530717959f;
2724
2725	/* System generated locals */
2726	int_4 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	/* r_8 cos(r_8truc), sin(r_8truc); commente - Remplace par math.h Reza 29/11/99 */
2732
2733	/* Local variables */
2734	static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
2735	static r_4 dc2, ai1, ai2, ar1, ar2, ds2;
2736	static int_4 nbd;
2737	static r_4 dcp, arg, dsp, ar1h, ar2h;
2738	static int_4 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 / (r_4) (*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;
2783	L103:
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	}
2794	L106:
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;
2843	L112:
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	}
2870	L116:
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;
2960	L128:
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	}
2986	L132:
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;
3031	L139:
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	}
3054	L143:
3055	return 0;
3056	} /* radbg_ */
3057
3058	/* ------ File radf2.f ------ */
3059	/* Subroutine / int radf2_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
3060	r_4 *wa1)
3061	{
3062	/* System generated locals */
3063	int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
3064
3065	/* Local variables */
3066	static int_4 i__, k, ic;
3067	static r_4 ti2, tr2;
3068	static int_4 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	}
3096	L102:
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	}
3123	L105:
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	}
3132	L107:
3133	return 0;
3134	} /* radf2_ */
3135
3136	/* ------ File radf3.f ------ */
3137	/* Subroutine / int radf3_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
3138	r_4 wa1, r_4 wa2)
3139	{
3140	/* Initialized data */
3141
3142	static r_4 taur = -.5f;
3143	static r_4 taui = .866025403784439f;
3144
3145	/* System generated locals */
3146	int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
3147
3148	/* Local variables */
3149	static int_4 i__, k, ic;
3150	static r_4 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
3151	static int_4 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_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
3217	r_4 wa1, r_4 wa2, r_4 *wa3)
3218	{
3219	/* Initialized data */
3220
3221	static r_4 hsqt2 = .7071067811865475f;
3222
3223	/* System generated locals */
3224	int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
3225
3226	/* Local variables */
3227	static int_4 i__, k, ic;
3228	static r_4 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
3229	tr3, tr4;
3230	static int_4 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	}
3266	L102:
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	}
3310	L105:
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	}
3327	L107:
3328	return 0;
3329	} /* radf4_ */
3330
3331	/* ------ File radf5.f ------ */
3332	/* Subroutine / int radf5_(int_4 ido, int_4 l1, r_4 cc, r_4 *ch,
3333	r_4 wa1, r_4 wa2, r_4 wa3, r_4 wa4)
3334	{
3335	/* Initialized data */
3336
3337	static r_4 tr11 = .309016994374947f;
3338	static r_4 ti11 = .951056516295154f;
3339	static r_4 tr12 = -.809016994374947f;
3340	static r_4 ti12 = .587785252292473f;
3341
3342	/* System generated locals */
3343	int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
3344
3345	/* Local variables */
3346	static int_4 i__, k, ic;
3347	static r_4 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 int_4 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_(int_4 ido, int_4 ip, int_4 l1, int_4 *
3451	idl1, r_4 cc, r_4 c1, r_4 c2, r_4 ch, r_4 ch2, r_4 wa)
3452	{
3453	/* Initialized data */
3454
3455	static r_4 tpi = 6.28318530717959f;
3456
3457	/* System generated locals */
3458	int_4 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	/* r_8 cos(r_8truc), sin(r_8truc); */
3464
3465	/* Local variables */
3466	static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
3467	static r_4 dc2, ai1, ai2, ar1, ar2, ds2;
3468	static int_4 nbd;
3469	static r_4 dcp, arg, dsp, ar1h, ar2h;
3470	static int_4 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 / (r_4) (*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;
3545	L107:
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	}
3568	L111:
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;
3598	L115:
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;
3625	L119:
3626	i__1 = *idl1;
3627	for (ik = 1; ik <= i__1; ++ik) {
3628	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
3629	/* L120: */
3630	}
3631	L121:
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;
3705	L132:
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	}
3716	L135:
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;
3765	L141:
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_(int_4 n, r_4 r__, r_4 wsave)
3798	{
3799	extern /* Subroutine / int rfftb1_(int_4 , r_4 , r_4 , r_4 *,
3800	int_4 *);
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_4 )&wsave[(n << 1) + 1]); / (int ) rajoute Reza 29/11/99 /
3811	return 0;
3812	} /* rfftb_ */
3813
3814	/* ------ File rfftb1.f ------ */
3815	/* Subroutine / int rfftb1_(int_4 n, r_4 c__, r_4 ch, r_4 *wa,
3816	int_4 *ifac)
3817	{
3818	/* System generated locals */
3819	int_4 i__1;
3820
3821	/* Local variables */
3822	extern /* Subroutine / int radb2_(int_4 , int_4 , r_4 , r_4 *,
3823	r_4 ), radb3_(int_4 , int_4 , r_4 , r_4 , r_4 ,
3824	r_4 ), radb4_(int_4 , int_4 , r_4 , r_4 , r_4 ,
3825	r_4 , r_4 ), radb5_(int_4 , int_4 , r_4 , r_4 ,
3826	r_4 , r_4 , r_4 , r_4 );
3827	static int_4 i__;
3828	extern /* Subroutine / int radbg_(int_4 , int_4 , int_4 ,
3829	int_4 , r_4 , r_4 , r_4 , r_4 , r_4 , r_4 *);
3830	static int_4 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;
3859	L101:
3860	radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
3861	L102:
3862	na = 1 - na;
3863	goto L115;
3864	L103:
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;
3873	L104:
3874	radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
3875	L105:
3876	na = 1 - na;
3877	goto L115;
3878	L106:
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;
3888	L107:
3889	radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
3890	L108:
3891	na = 1 - na;
3892	goto L115;
3893	L109:
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;
3906	L110:
3907	radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
3908	ix4]);
3909	L111:
3910	na = 1 - na;
3911	goto L115;
3912	L112:
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;
3919	L113:
3920	radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
3921	, &wa[iw]);
3922	L114:
3923	if (ido == 1) {
3924	na = 1 - na;
3925	}
3926	L115:
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_(int_4 n, r_4 r__, r_4 wsave)
3944	{
3945	extern /* Subroutine / int rfftf1_(int_4 , r_4 , r_4 , r_4 *,
3946	int_4 *);
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_4 )&wsave[(n << 1) + 1]); / (int ) rajoute Reza 29/11/99 /
3957	return 0;
3958	} /* rfftf_ */
3959
3960	/* ------ File rfftf1.f ------ */
3961	/* Subroutine / int rfftf1_(int_4 n, r_4 c__, r_4 ch, r_4 *wa,
3962	int_4 *ifac)
3963	{
3964	/* System generated locals */
3965	int_4 i__1;
3966
3967	/* Local variables */
3968	extern /* Subroutine / int radf2_(int_4 , int_4 , r_4 , r_4 *,
3969	r_4 ), radf3_(int_4 , int_4 , r_4 , r_4 , r_4 ,
3970	r_4 ), radf4_(int_4 , int_4 , r_4 , r_4 , r_4 ,
3971	r_4 , r_4 ), radf5_(int_4 , int_4 , r_4 , r_4 ,
3972	r_4 , r_4 , r_4 , r_4 );
3973	static int_4 i__;
3974	extern /* Subroutine / int radfg_(int_4 , int_4 , int_4 ,
3975	int_4 , r_4 , r_4 , r_4 , r_4 , r_4 , r_4 *);
3976	static int_4 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;
4008	L101:
4009	radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4010	goto L110;
4011	L102:
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;
4020	L103:
4021	radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
4022	goto L110;
4023	L104:
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;
4033	L105:
4034	radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4035	goto L110;
4036	L106:
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;
4049	L107:
4050	radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4051	ix4]);
4052	goto L110;
4053	L108:
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;
4064	L109:
4065	radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
4066	, &wa[iw]);
4067	na = 0;
4068	L110:
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_(int_4 n, r_4 *wsave)
4085	{
4086	extern /* Subroutine / int rffti1_(int_4 , r_4 , int_4 );
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_4 )&wsave[(n << 1) + 1]); / (int ) rajoute Reza 29/11/99 /
4096	return 0;
4097	} /* rffti_ */
4098
4099	/* ------ File rffti1.f ------ */
4100	/* Subroutine / int rffti1_(int_4 n, r_4 wa, int_4 ifac)
4101	{
4102	/* Initialized data */
4103
4104	static int_4 ntryh[4] = { 4,2,3,5 };
4105
4106	/* System generated locals */
4107	int_4 i__1, i__2, i__3;
4108
4109	/* Builtin functions */
4110	/* r_8 cos(r_8truc), sin(r_8truc); Remplace par math.h , Reza 29/11/99 */
4111
4112	/* Local variables */
4113	static r_4 argh;
4114	static int_4 ntry, i__, j;
4115	static r_4 argld;
4116	static int_4 k1, l1, l2, ib;
4117	static r_4 fi;
4118	static int_4 ld, ii, nf, ip, nl, is, nq, nr;
4119	static r_4 arg;
4120	static int_4 ido, ipm;
4121	static r_4 tpi;
4122	static int_4 nfm1;
4123
4124	/* Parameter adjustments */
4125	--ifac;
4126	--wa;
4127
4128	/* Function Body */
4129	nl = *n;
4130	nf = 0;
4131	j = 0;
4132	L101:
4133	++j;
4134	if (j - 4 <= 0) {
4135	goto L102;
4136	} else {
4137	goto L103;
4138	}
4139	L102:
4140	ntry = ntryh[j - 1];
4141	goto L104;
4142	L103:
4143	ntry += 2;
4144	L104:
4145	nq = nl / ntry;
4146	nr = nl - ntry * nq;
4147	if (nr != 0) {
4148	goto L101;
4149	} else {
4150	goto L105;
4151	}
4152	L105:
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;
4169	L107:
4170	if (nl != 1) {
4171	goto L104;
4172	}
4173	ifac[1] = *n;
4174	ifac[2] = nf;
4175	tpi = 6.28318530717959f;
4176	argh = tpi / (r_4) (*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 = (r_4) 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_(int_4 n, r_4 x, r_4 wsave)
4216	{
4217	/* System generated locals */
4218	int_4 i__1;
4219
4220	/* Local variables */
4221	static int_4 k;
4222	extern /* Subroutine / int cosqb_(int_4 , r_4 , r_4 );
4223	static r_4 xhold;
4224	static int_4 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;
4236	L101:
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_(int_4 n, r_4 x, r_4 wsave)
4257	{
4258	/* System generated locals */
4259	int_4 i__1;
4260
4261	/* Local variables */
4262	static int_4 k;
4263	extern /* Subroutine / int cosqf_(int_4 , r_4 , r_4 );
4264	static r_4 xhold;
4265	static int_4 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_(int_4 n, r_4 *wsave)
4295	{
4296	extern /* Subroutine / int cosqi_(int_4 , r_4 *);
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_(int_4 n, r_4 x, r_4 wsave)
4308	{
4309	extern /* Subroutine / int sint1_(int_4 , r_4 , r_4 , r_4 *,
4310	r_4 , int_4 );
4311	static int_4 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_4 )&wsave[iw3]); / (int ) rajoute Reza 29/11/99 /
4323	return 0;
4324	} /* sint_ */
4325
4326	/* ------ File sint1.f ------ */
4327	/* Subroutine / int sint1_(int_4 n, r_4 war, r_4 was, r_4 xh, r_4
4328	x, int_4 *ifac)
4329	{
4330	/* Initialized data */
4331
4332	static r_4 sqrt3 = 1.73205080756888f;
4333
4334	/* System generated locals */
4335	int_4 i__1;
4336
4337	/* Local variables */
4338	static int_4 modn, i__, k;
4339	static r_4 xhold, t1, t2;
4340	extern /* Subroutine / int rfftf1_(int_4 , r_4 , r_4 , r_4 *,
4341	int_4 *);
4342	static int_4 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	}
4365	L101:
4366	xh[1] += xh[1];
4367	goto L106;
4368	L102:
4369	xhold = sqrt3 * (xh[1] + xh[2]);
4370	xh[2] = sqrt3 * (xh[1] - xh[2]);
4371	xh[1] = xhold;
4372	goto L106;
4373	L103:
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];
4402	L106:
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_(int_4 n, r_4 *wsave)
4414	{
4415	/* Initialized data */
4416
4417	static r_4 pi = 3.14159265358979f;
4418
4419	/* System generated locals */
4420	int_4 i__1;
4421
4422	/* Builtin functions */
4423	/* r_8 sin(r_8truc); remplace par math.h , Reza 29/11/99 */
4424
4425	/* Local variables */
4426	static int_4 k;
4427	extern /* Subroutine / int rffti_(int_4 , r_4 *);
4428	static r_4 dt;
4429	static int_4 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 / (r_4) 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	/* --------------------------------------------------------------- */
4451	/* -------------- make a r_8 version of the library ----------- */
4452	/* --------------------------------------------------------------- */
4453
4454	/* Subroutine / int cdfftb_(int_4 n, r_8 c__, r_8 wsave)
4455	{
4456	extern /* Subroutine / int cdfftb1_(int_4 , r_8 , r_8 , r_8 *,
4457	int_8 *);
4458	static int_4 iw1, iw2;
4459
4460	/* Parameter adjustments */
4461	--wsave;
4462	--c__;
4463
4464	/* Function Body */
4465	if (*n == 1) {
4466	return 0;
4467	}
4468	iw1 = n + n + 1;
4469	iw2 = iw1 + n + n;
4470	cdfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 )&wsave[iw2]); / (int ) rajoute Reza 29/11/99 /
4471	return 0;
4472	} /* cdfftb_ */
4473
4474	/* ------ File cdfftb1.f ------ */
4475	/* Subroutine / int cdfftb1_(int_4 n, r_8 c__, r_8 ch, r_8 *wa,
4476	int_8 *ifac)
4477	{
4478	/* System generated locals */
4479	int_4 i__1;
4480
4481	/* Local variables */
4482	static int_4 idot, i__;
4483	extern /* Subroutine / int dpassb_(int_4 , int_4 , int_4 ,
4484	int_4 , int_4 , r_8 , r_8 , r_8 , r_8 , r_8 *,
4485	r_8 *);
4486	static int_4 k1, l1, l2, n2;
4487	extern /* Subroutine / int dpassb2_(int_4 , int_4 , r_8 , r_8 *,
4488	r_8 ), dpassb3_(int_4 , int_4 , r_8 , r_8 , r_8 ,
4489	r_8 ), dpassb4_(int_4 , int_4 , r_8 , r_8 , r_8 ,
4490	r_8 , r_8 ), dpassb5_(int_4 , int_4 , r_8 , r_8 ,
4491	r_8 , r_8 , r_8 , r_8 );
4492	static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
4493
4494	/* Parameter adjustments */
4495	--ifac;
4496	--wa;
4497	--ch;
4498	--c__;
4499
4500	/* Function Body */
4501	nf = ifac[2];
4502	na = 0;
4503	l1 = 1;
4504	iw = 1;
4505	i__1 = nf;
4506	for (k1 = 1; k1 <= i__1; ++k1) {
4507	ip = ifac[k1 + 2];
4508	l2 = ip * l1;
4509	ido = *n / l2;
4510	idot = ido + ido;
4511	idl1 = idot * l1;
4512	if (ip != 4) {
4513	goto L103;
4514	}
4515	ix2 = iw + idot;
4516	ix3 = ix2 + idot;
4517	if (na != 0) {
4518	goto L101;
4519	}
4520	dpassb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
4521	goto L102;
4522	L101:
4523	dpassb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4524	L102:
4525	na = 1 - na;
4526	goto L115;
4527	L103:
4528	if (ip != 2) {
4529	goto L106;
4530	}
4531	if (na != 0) {
4532	goto L104;
4533	}
4534	dpassb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
4535	goto L105;
4536	L104:
4537	dpassb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
4538	L105:
4539	na = 1 - na;
4540	goto L115;
4541	L106:
4542	if (ip != 3) {
4543	goto L109;
4544	}
4545	ix2 = iw + idot;
4546	if (na != 0) {
4547	goto L107;
4548	}
4549	dpassb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
4550	goto L108;
4551	L107:
4552	dpassb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4553	L108:
4554	na = 1 - na;
4555	goto L115;
4556	L109:
4557	if (ip != 5) {
4558	goto L112;
4559	}
4560	ix2 = iw + idot;
4561	ix3 = ix2 + idot;
4562	ix4 = ix3 + idot;
4563	if (na != 0) {
4564	goto L110;
4565	}
4566	dpassb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4567	ix4]);
4568	goto L111;
4569	L110:
4570	dpassb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4571	ix4]);
4572	L111:
4573	na = 1 - na;
4574	goto L115;
4575	L112:
4576	if (na != 0) {
4577	goto L113;
4578	}
4579	dpassb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
4580	, &ch[1], &wa[iw]);
4581	goto L114;
4582	L113:
4583	dpassb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
4584	&c__[1], &wa[iw]);
4585	L114:
4586	if (nac != 0) {
4587	na = 1 - na;
4588	}
4589	L115:
4590	l1 = l2;
4591	iw += (ip - 1) * idot;
4592	/* L116: */
4593	}
4594	if (na == 0) {
4595	return 0;
4596	}
4597	n2 = n + n;
4598	i__1 = n2;
4599	for (i__ = 1; i__ <= i__1; ++i__) {
4600	c__[i__] = ch[i__];
4601	/* L117: */
4602	}
4603	return 0;
4604	} /* cdfftb1_ */
4605
4606	/* ------ File cdfftf.f ------ */
4607	/* Subroutine / int cdfftf_(int_4 n, r_8 c__, r_8 wsave)
4608	{
4609	extern /* Subroutine / int cdfftf1_(int_4 , r_8 , r_8 , r_8 *,
4610	int_8 *);
4611	static int_4 iw1, iw2;
4612
4613	/* Parameter adjustments */
4614	--wsave;
4615	--c__;
4616
4617	/* Function Body */
4618	if (*n == 1) {
4619	return 0;
4620	}
4621	iw1 = n + n + 1;
4622	iw2 = iw1 + n + n;
4623	cdfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], (int_8 )&wsave[iw2]); / (int ) rajoute Reza 29/11/99 /
4624	return 0;
4625	} /* cdfftf_ */
4626
4627	/* ------ File cdfftf1.f ------ */
4628	/* Subroutine / int cdfftf1_(int_4 n, r_8 c__, r_8 ch, r_8 *wa,
4629	int_8 *ifac)
4630	{
4631	/* System generated locals */
4632	int_4 i__1;
4633
4634	/* Local variables */
4635	static int_4 idot, i__;
4636	extern /* Subroutine / int dpassf_(int_4 , int_4 , int_4 ,
4637	int_4 , int_4 , r_8 , r_8 , r_8 , r_8 , r_8 *,
4638	r_8 *);
4639	static int_4 k1, l1, l2, n2;
4640	extern /* Subroutine / int dpassf2_(int_4 , int_4 , r_8 , r_8 *,
4641	r_8 ), dpassf3_(int_4 , int_4 , r_8 , r_8 , r_8 ,
4642	r_8 ), dpassf4_(int_4 , int_4 , r_8 , r_8 , r_8 ,
4643	r_8 , r_8 ), dpassf5_(int_4 , int_4 , r_8 , r_8 ,
4644	r_8 , r_8 , r_8 , r_8 );
4645	static int_4 na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
4646
4647	/* Parameter adjustments */
4648	--ifac;
4649	--wa;
4650	--ch;
4651	--c__;
4652
4653	/* Function Body */
4654	nf = ifac[2];
4655	na = 0;
4656	l1 = 1;
4657	iw = 1;
4658	i__1 = nf;
4659	for (k1 = 1; k1 <= i__1; ++k1) {
4660	ip = ifac[k1 + 2];
4661	l2 = ip * l1;
4662	ido = *n / l2;
4663	idot = ido + ido;
4664	idl1 = idot * l1;
4665	if (ip != 4) {
4666	goto L103;
4667	}
4668	ix2 = iw + idot;
4669	ix3 = ix2 + idot;
4670	if (na != 0) {
4671	goto L101;
4672	}
4673	dpassf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
4674	goto L102;
4675	L101:
4676	dpassf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
4677	L102:
4678	na = 1 - na;
4679	goto L115;
4680	L103:
4681	if (ip != 2) {
4682	goto L106;
4683	}
4684	if (na != 0) {
4685	goto L104;
4686	}
4687	dpassf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
4688	goto L105;
4689	L104:
4690	dpassf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
4691	L105:
4692	na = 1 - na;
4693	goto L115;
4694	L106:
4695	if (ip != 3) {
4696	goto L109;
4697	}
4698	ix2 = iw + idot;
4699	if (na != 0) {
4700	goto L107;
4701	}
4702	dpassf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
4703	goto L108;
4704	L107:
4705	dpassf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
4706	L108:
4707	na = 1 - na;
4708	goto L115;
4709	L109:
4710	if (ip != 5) {
4711	goto L112;
4712	}
4713	ix2 = iw + idot;
4714	ix3 = ix2 + idot;
4715	ix4 = ix3 + idot;
4716	if (na != 0) {
4717	goto L110;
4718	}
4719	dpassf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4720	ix4]);
4721	goto L111;
4722	L110:
4723	dpassf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
4724	ix4]);
4725	L111:
4726	na = 1 - na;
4727	goto L115;
4728	L112:
4729	if (na != 0) {
4730	goto L113;
4731	}
4732	dpassf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
4733	, &ch[1], &wa[iw]);
4734	goto L114;
4735	L113:
4736	dpassf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1],
4737	&c__[1], &wa[iw]);
4738	L114:
4739	if (nac != 0) {
4740	na = 1 - na;
4741	}
4742	L115:
4743	l1 = l2;
4744	iw += (ip - 1) * idot;
4745	/* L116: */
4746	}
4747	if (na == 0) {
4748	return 0;
4749	}
4750	n2 = n + n;
4751	i__1 = n2;
4752	for (i__ = 1; i__ <= i__1; ++i__) {
4753	c__[i__] = ch[i__];
4754	/* L117: */
4755	}
4756	return 0;
4757	} /* cdfftf1_ */
4758
4759	/* ------ File cdffti.f ------ */
4760	/* Subroutine / int cdffti_(int_4 n, r_8 *wsave)
4761	{
4762	extern /* Subroutine / int cdffti1_(int_4 , r_8 , int_8 );
4763	static int_4 iw1, iw2;
4764
4765	/* Parameter adjustments */
4766	--wsave;
4767
4768	/* Function Body */
4769	if (*n == 1) {
4770	return 0;
4771	}
4772	iw1 = n + n + 1;
4773	iw2 = iw1 + n + n;
4774	cdffti1_(n, &wsave[iw1], (int_8 )&wsave[iw2]); / (int ) rajoute Reza 29/11/99 /
4775	return 0;
4776	} /* cdffti_ */
4777
4778	/* ------ File cdffti1.f ------ */
4779	/* Subroutine / int cdffti1_(int_4 n, r_8 wa, int_8 ifac)
4780	{
4781	/* Initialized data */
4782
4783	static int_4 ntryh[4] = { 3,4,2,5 };
4784
4785	/* System generated locals */
4786	int_4 i__1, i__2, i__3;
4787
4788	/* Builtin functions */
4789	/* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */
4790
4791	/* Local variables */
4792	static r_8 argh;
4793	static int_4 idot, ntry, i__, j;
4794	static r_8 argld;
4795	static int_4 i1, k1, l1, l2, ib;
4796	static r_8 fi;
4797	static int_4 ld, ii, nf, ip, nl, nq, nr;
4798	static r_8 arg;
4799	static int_4 ido, ipm;
4800	static r_8 tpi;
4801
4802	/* Parameter adjustments */
4803	--ifac;
4804	--wa;
4805
4806	/* Function Body */
4807	nl = *n;
4808	nf = 0;
4809	j = 0;
4810	L101:
4811	++j;
4812	if (j - 4 <= 0) {
4813	goto L102;
4814	} else {
4815	goto L103;
4816	}
4817	L102:
4818	ntry = ntryh[j - 1];
4819	goto L104;
4820	L103:
4821	ntry += 2;
4822	L104:
4823	nq = nl / ntry;
4824	nr = nl - ntry * nq;
4825	if (nr != 0) {
4826	goto L101;
4827	} else {
4828	goto L105;
4829	}
4830	L105:
4831	++nf;
4832	ifac[nf + 2] = ntry;
4833	nl = nq;
4834	if (ntry != 2) {
4835	goto L107;
4836	}
4837	if (nf == 1) {
4838	goto L107;
4839	}
4840	i__1 = nf;
4841	for (i__ = 2; i__ <= i__1; ++i__) {
4842	ib = nf - i__ + 2;
4843	ifac[ib + 2] = ifac[ib + 1];
4844	/* L106: */
4845	}
4846	ifac[3] = 2;
4847	L107:
4848	if (nl != 1) {
4849	goto L104;
4850	}
4851	ifac[1] = *n;
4852	ifac[2] = nf;
4853	tpi = 6.28318530717959f;
4854	argh = tpi / (r_8) (*n);
4855	i__ = 2;
4856	l1 = 1;
4857	i__1 = nf;
4858	for (k1 = 1; k1 <= i__1; ++k1) {
4859	ip = ifac[k1 + 2];
4860	ld = 0;
4861	l2 = l1 * ip;
4862	ido = *n / l2;
4863	idot = ido + ido + 2;
4864	ipm = ip - 1;
4865	i__2 = ipm;
4866	for (j = 1; j <= i__2; ++j) {
4867	i1 = i__;
4868	wa[i__ - 1] = 1.f;
4869	wa[i__] = 0.f;
4870	ld += l1;
4871	fi = 0.f;
4872	argld = (r_8) ld * argh;
4873	i__3 = idot;
4874	for (ii = 4; ii <= i__3; ii += 2) {
4875	i__ += 2;
4876	fi += 1.f;
4877	arg = fi * argld;
4878	wa[i__ - 1] = cos(arg);
4879	wa[i__] = sin(arg);
4880	/* L108: */
4881	}
4882	if (ip <= 5) {
4883	goto L109;
4884	}
4885	wa[i1 - 1] = wa[i__ - 1];
4886	wa[i1] = wa[i__];
4887	L109:
4888	;
4889	}
4890	l1 = l2;
4891	/* L110: */
4892	}
4893	return 0;
4894	} /* cdffti1_ */
4895
4896	/* ------ File dcosqb.f ------ */
4897	/* Subroutine / int dcosqb_(int_4 n, r_8 x, r_8 wsave)
4898	{
4899	/* Initialized data */
4900
4901	static r_8 tsqrt2 = 2.82842712474619f;
4902
4903	/* System generated locals */
4904	int_4 i__1;
4905
4906	/* Local variables */
4907	static r_8 x1;
4908	extern /* Subroutine / int dcosqb1_(int_4 , r_8 , r_8 , r_8 *);
4909
4910	/* Parameter adjustments */
4911	--wsave;
4912	--x;
4913
4914	/* Function Body */
4915	if ((i__1 = *n - 2) < 0) {
4916	goto L101;
4917	} else if (i__1 == 0) {
4918	goto L102;
4919	} else {
4920	goto L103;
4921	}
4922	L101:
4923	x[1] *= 4.f;
4924	return 0;
4925	L102:
4926	x1 = (x[1] + x[2]) * 4.f;
4927	x[2] = tsqrt2 * (x[1] - x[2]);
4928	x[1] = x1;
4929	return 0;
4930	L103:
4931	dcosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
4932	return 0;
4933	} /* dcosqb_ */
4934
4935	/* ------ File dcosqb1.f ------ */
4936	/* Subroutine / int dcosqb1_(int_4 n, r_8 x, r_8 w, r_8 *xh)
4937	{
4938	/* System generated locals */
4939	int_4 i__1;
4940
4941	/* Local variables */
4942	static int_4 modn, i__, k;
4943	extern /* Subroutine / int dfftb_(int_4 , r_8 , r_8 );
4944	static int_4 kc, np2, ns2;
4945	static r_8 xim1;
4946
4947	/* Parameter adjustments */
4948	--xh;
4949	--w;
4950	--x;
4951
4952	/* Function Body */
4953	ns2 = (*n + 1) / 2;
4954	np2 = *n + 2;
4955	i__1 = *n;
4956	for (i__ = 3; i__ <= i__1; i__ += 2) {
4957	xim1 = x[i__ - 1] + x[i__];
4958	x[i__] -= x[i__ - 1];
4959	x[i__ - 1] = xim1;
4960	/* L101: */
4961	}
4962	x[1] += x[1];
4963	modn = *n % 2;
4964	if (modn == 0) {
4965	x[n] += x[n];
4966	}
4967	dfftb_(n, &x[1], &xh[1]);
4968	i__1 = ns2;
4969	for (k = 2; k <= i__1; ++k) {
4970	kc = np2 - k;
4971	xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k];
4972	xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc];
4973	/* L102: */
4974	}
4975	if (modn == 0) {
4976	x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]);
4977	}
4978	i__1 = ns2;
4979	for (k = 2; k <= i__1; ++k) {
4980	kc = np2 - k;
4981	x[k] = xh[k] + xh[kc];
4982	x[kc] = xh[k] - xh[kc];
4983	/* L103: */
4984	}
4985	x[1] += x[1];
4986	return 0;
4987	} /* dcosqb1_ */
4988
4989	/* ------ File dcosqf.f ------ */
4990	/* Subroutine / int dcosqf_(int_4 n, r_8 x, r_8 wsave)
4991	{
4992	/* Initialized data */
4993
4994	static r_8 sqrt2 = 1.4142135623731f;
4995
4996	/* System generated locals */
4997	int_4 i__1;
4998
4999	/* Local variables */
5000	static r_8 tsqx;
5001	extern /* Subroutine / int dcosqf1_(int_4 , r_8 , r_8 , r_8 *);
5002
5003	/* Parameter adjustments */
5004	--wsave;
5005	--x;
5006
5007	/* Function Body */
5008	if ((i__1 = *n - 2) < 0) {
5009	goto L102;
5010	} else if (i__1 == 0) {
5011	goto L101;
5012	} else {
5013	goto L103;
5014	}
5015	L101:
5016	tsqx = sqrt2 * x[2];
5017	x[2] = x[1] - tsqx;
5018	x[1] += tsqx;
5019	L102:
5020	return 0;
5021	L103:
5022	dcosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
5023	return 0;
5024	} /* dcosqf_ */
5025
5026	/* ------ File dcosqf1.f ------ */
5027	/* Subroutine / int dcosqf1_(int_4 n, r_8 x, r_8 w, r_8 *xh)
5028	{
5029	/* System generated locals */
5030	int_4 i__1;
5031
5032	/* Local variables */
5033	static int_4 modn, i__, k;
5034	extern /* Subroutine / int dfftf_(int_4 , r_8 , r_8 );
5035	static int_4 kc, np2, ns2;
5036	static r_8 xim1;
5037
5038	/* Parameter adjustments */
5039	--xh;
5040	--w;
5041	--x;
5042
5043	/* Function Body */
5044	ns2 = (*n + 1) / 2;
5045	np2 = *n + 2;
5046	i__1 = ns2;
5047	for (k = 2; k <= i__1; ++k) {
5048	kc = np2 - k;
5049	xh[k] = x[k] + x[kc];
5050	xh[kc] = x[k] - x[kc];
5051	/* L101: */
5052	}
5053	modn = *n % 2;
5054	if (modn == 0) {
5055	xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1];
5056	}
5057	i__1 = ns2;
5058	for (k = 2; k <= i__1; ++k) {
5059	kc = np2 - k;
5060	x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k];
5061	x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc];
5062	/* L102: */
5063	}
5064	if (modn == 0) {
5065	x[ns2 + 1] = w[ns2] * xh[ns2 + 1];
5066	}
5067	dfftf_(n, &x[1], &xh[1]);
5068	i__1 = *n;
5069	for (i__ = 3; i__ <= i__1; i__ += 2) {
5070	xim1 = x[i__ - 1] - x[i__];
5071	x[i__] = x[i__ - 1] + x[i__];
5072	x[i__ - 1] = xim1;
5073	/* L103: */
5074	}
5075	return 0;
5076	} /* dcosqf1_ */
5077
5078	/* ------ File dcosqi.f ------ */
5079	/* Subroutine / int dcosqi_(int_4 n, r_8 *wsave)
5080	{
5081	/* Initialized data */
5082
5083	static r_8 pih = 1.57079632679491f;
5084
5085	/* System generated locals */
5086	int_4 i__1;
5087
5088	/* Builtin functions */
5089	/* r_8 cos(r_8truc); remplace par math.h Reza 29/11/99 */
5090
5091	/* Local variables */
5092	static int_4 k;
5093	extern /* Subroutine / int dffti_(int_4 , r_8 *);
5094	static r_8 fk, dt;
5095
5096	/* Parameter adjustments */
5097	--wsave;
5098
5099	/* Function Body */
5100	dt = pih / (r_8) (*n);
5101	fk = 0.f;
5102	i__1 = *n;
5103	for (k = 1; k <= i__1; ++k) {
5104	fk += 1.f;
5105	wsave[k] = cos(fk * dt);
5106	/* L101: */
5107	}
5108	dffti_(n, &wsave[*n + 1]);
5109	return 0;
5110	} /* dcosqi_ */
5111
5112	/* ------ File dcost.f ------ */
5113	/* Subroutine / int dcost_(int_4 n, r_8 x, r_8 wsave)
5114	{
5115	/* System generated locals */
5116	int_4 i__1;
5117
5118	/* Local variables */
5119	static int_4 modn, i__, k;
5120	extern /* Subroutine / int dfftf_(int_4 , r_8 , r_8 );
5121	static r_8 c1, t1, t2;
5122	static int_4 kc;
5123	static r_8 xi;
5124	static int_4 nm1, np1;
5125	static r_8 x1h;
5126	static int_4 ns2;
5127	static r_8 tx2, x1p3, xim2;
5128
5129	/* Parameter adjustments */
5130	--wsave;
5131	--x;
5132
5133	/* Function Body */
5134	nm1 = *n - 1;
5135	np1 = *n + 1;
5136	ns2 = *n / 2;
5137	if ((i__1 = *n - 2) < 0) {
5138	goto L106;
5139	} else if (i__1 == 0) {
5140	goto L101;
5141	} else {
5142	goto L102;
5143	}
5144	L101:
5145	x1h = x[1] + x[2];
5146	x[2] = x[1] - x[2];
5147	x[1] = x1h;
5148	return 0;
5149	L102:
5150	if (*n > 3) {
5151	goto L103;
5152	}
5153	x1p3 = x[1] + x[3];
5154	tx2 = x[2] + x[2];
5155	x[2] = x[1] - x[3];
5156	x[1] = x1p3 + tx2;
5157	x[3] = x1p3 - tx2;
5158	return 0;
5159	L103:
5160	c1 = x[1] - x[*n];
5161	x[1] += x[*n];
5162	i__1 = ns2;
5163	for (k = 2; k <= i__1; ++k) {
5164	kc = np1 - k;
5165	t1 = x[k] + x[kc];
5166	t2 = x[k] - x[kc];
5167	c1 += wsave[kc] * t2;
5168	t2 = wsave[k] * t2;
5169	x[k] = t1 - t2;
5170	x[kc] = t1 + t2;
5171	/* L104: */
5172	}
5173	modn = *n % 2;
5174	if (modn != 0) {
5175	x[ns2 + 1] += x[ns2 + 1];
5176	}
5177	dfftf_(&nm1, &x[1], &wsave[*n + 1]);
5178	xim2 = x[2];
5179	x[2] = c1;
5180	i__1 = *n;
5181	for (i__ = 4; i__ <= i__1; i__ += 2) {
5182	xi = x[i__];
5183	x[i__] = x[i__ - 2] - x[i__ - 1];
5184	x[i__ - 1] = xim2;
5185	xim2 = xi;
5186	/* L105: */
5187	}
5188	if (modn != 0) {
5189	x[*n] = xim2;
5190	}
5191	L106:
5192	return 0;
5193	} /* dcost_ */
5194
5195	/* ------ File dcosti.f ------ */
5196	/* Subroutine / int dcosti_(int_4 n, r_8 *wsave)
5197	{
5198	/* Initialized data */
5199
5200	static r_8 pi = 3.14159265358979f;
5201
5202	/* System generated locals */
5203	int_4 i__1;
5204
5205	/* Builtin functions */
5206	/* r_8 sin(r_8truc), cos(r_8truc); remplace par math.h Reza 29/11/99 */
5207
5208	/* Local variables */
5209	static int_4 k;
5210	extern /* Subroutine / int dffti_(int_4 , r_8 *);
5211	static int_4 kc;
5212	static r_8 fk, dt;
5213	static int_4 nm1, np1, ns2;
5214
5215	/* Parameter adjustments */
5216	--wsave;
5217
5218	/* Function Body */
5219	if (*n <= 3) {
5220	return 0;
5221	}
5222	nm1 = *n - 1;
5223	np1 = *n + 1;
5224	ns2 = *n / 2;
5225	dt = pi / (r_8) nm1;
5226	fk = 0.f;
5227	i__1 = ns2;
5228	for (k = 2; k <= i__1; ++k) {
5229	kc = np1 - k;
5230	fk += 1.f;
5231	wsave[k] = sin(fk * dt) * 2.f;
5232	wsave[kc] = cos(fk * dt) * 2.f;
5233	/* L101: */
5234	}
5235	dffti_(&nm1, &wsave[*n + 1]);
5236	return 0;
5237	} /* dcosti_ */
5238
5239	/* ------ File dezfft1.f ------ */
5240	/* Subroutine / int dezfft1_(int_4 n, r_8 wa, int_8 ifac)
5241	{
5242	/* Initialized data */
5243
5244	static int_4 ntryh[4] = { 4,2,3,5 };
5245	static r_8 tpi = 6.28318530717959f;
5246
5247	/* System generated locals */
5248	int_4 i__1, i__2, i__3;
5249
5250	/* Builtin functions */
5251	/* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */
5252
5253	/* Local variables */
5254	static r_8 argh;
5255	static int_4 ntry, i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr;
5256	static r_8 ch1, sh1;
5257	static int_4 ido, ipm;
5258	static r_8 dch1, ch1h, arg1, dsh1;
5259	static int_4 nfm1;
5260
5261	/* Parameter adjustments */
5262	--ifac;
5263	--wa;
5264
5265	/* Function Body */
5266	nl = *n;
5267	nf = 0;
5268	j = 0;
5269	L101:
5270	++j;
5271	if (j - 4 <= 0) {
5272	goto L102;
5273	} else {
5274	goto L103;
5275	}
5276	L102:
5277	ntry = ntryh[j - 1];
5278	goto L104;
5279	L103:
5280	ntry += 2;
5281	L104:
5282	nq = nl / ntry;
5283	nr = nl - ntry * nq;
5284	if (nr != 0) {
5285	goto L101;
5286	} else {
5287	goto L105;
5288	}
5289	L105:
5290	++nf;
5291	ifac[nf + 2] = ntry;
5292	nl = nq;
5293	if (ntry != 2) {
5294	goto L107;
5295	}
5296	if (nf == 1) {
5297	goto L107;
5298	}
5299	i__1 = nf;
5300	for (i__ = 2; i__ <= i__1; ++i__) {
5301	ib = nf - i__ + 2;
5302	ifac[ib + 2] = ifac[ib + 1];
5303	/* L106: */
5304	}
5305	ifac[3] = 2;
5306	L107:
5307	if (nl != 1) {
5308	goto L104;
5309	}
5310	ifac[1] = *n;
5311	ifac[2] = nf;
5312	argh = tpi / (r_8) (*n);
5313	is = 0;
5314	nfm1 = nf - 1;
5315	l1 = 1;
5316	if (nfm1 == 0) {
5317	return 0;
5318	}
5319	i__1 = nfm1;
5320	for (k1 = 1; k1 <= i__1; ++k1) {
5321	ip = ifac[k1 + 2];
5322	l2 = l1 * ip;
5323	ido = *n / l2;
5324	ipm = ip - 1;
5325	arg1 = (r_8) l1 * argh;
5326	ch1 = 1.f;
5327	sh1 = 0.f;
5328	dch1 = cos(arg1);
5329	dsh1 = sin(arg1);
5330	i__2 = ipm;
5331	for (j = 1; j <= i__2; ++j) {
5332	ch1h = dch1 * ch1 - dsh1 * sh1;
5333	sh1 = dch1 * sh1 + dsh1 * ch1;
5334	ch1 = ch1h;
5335	i__ = is + 2;
5336	wa[i__ - 1] = ch1;
5337	wa[i__] = sh1;
5338	if (ido < 5) {
5339	goto L109;
5340	}
5341	i__3 = ido;
5342	for (ii = 5; ii <= i__3; ii += 2) {
5343	i__ += 2;
5344	wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2];
5345	wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3];
5346	/* L108: */
5347	}
5348	L109:
5349	is += ido;
5350	/* L110: */
5351	}
5352	l1 = l2;
5353	/* L111: */
5354	}
5355	return 0;
5356	} /* dezfft1_ */
5357
5358	/* ------ File dezfftb.f ------ */
5359	/* Subroutine / int dezfftb_(int_4 n, r_8 r__, r_8 azero, r_8 *a,
5360	r_8 b, r_8 wsave)
5361	{
5362	/* System generated locals */
5363	int_4 i__1;
5364
5365	/* Local variables */
5366	static int_4 i__;
5367	extern /* Subroutine / int dfftb_(int_4 , r_8 , r_8 );
5368	static int_4 ns2;
5369
5370	/* Parameter adjustments */
5371	--wsave;
5372	--b;
5373	--a;
5374	--r__;
5375
5376	/* Function Body */
5377	if ((i__1 = *n - 2) < 0) {
5378	goto L101;
5379	} else if (i__1 == 0) {
5380	goto L102;
5381	} else {
5382	goto L103;
5383	}
5384	L101:
5385	r__[1] = *azero;
5386	return 0;
5387	L102:
5388	r__[1] = *azero + a[1];
5389	r__[2] = *azero - a[1];
5390	return 0;
5391	L103:
5392	ns2 = (*n - 1) / 2;
5393	i__1 = ns2;
5394	for (i__ = 1; i__ <= i__1; ++i__) {
5395	r__[i__ * 2] = a[i__] * .5f;
5396	r__[(i__ << 1) + 1] = b[i__] * -.5f;
5397	/* L104: */
5398	}
5399	r__[1] = *azero;
5400	if (*n % 2 == 0) {
5401	r__[*n] = a[ns2 + 1];
5402	}
5403	dfftb_(n, &r__[1], &wsave[*n + 1]);
5404	return 0;
5405	} /* dezfftb_ */
5406
5407	/* ------ File dezfftf.f ------ */
5408	/* Subroutine / int dezfftf_(int_4 n, r_8 r__, r_8 azero, r_8 *a,
5409	r_8 b, r_8 wsave)
5410	{
5411	/* System generated locals */
5412	int_4 i__1;
5413
5414	/* Local variables */
5415	static int_4 i__;
5416	extern /* Subroutine / int dfftf_(int_4 , r_8 , r_8 );
5417	static r_8 cf;
5418	static int_4 ns2;
5419	static r_8 cfm;
5420	static int_4 ns2m;
5421
5422
5423	/* VERSION 3 JUNE 1979 */
5424
5425	/* Parameter adjustments */
5426	--wsave;
5427	--b;
5428	--a;
5429	--r__;
5430
5431	/* Function Body */
5432	if ((i__1 = *n - 2) < 0) {
5433	goto L101;
5434	} else if (i__1 == 0) {
5435	goto L102;
5436	} else {
5437	goto L103;
5438	}
5439	L101:
5440	*azero = r__[1];
5441	return 0;
5442	L102:
5443	azero = (r__[1] + r__[2]) .5f;
5444	a[1] = (r__[1] - r__[2]) * .5f;
5445	return 0;
5446	L103:
5447	i__1 = *n;
5448	for (i__ = 1; i__ <= i__1; ++i__) {
5449	wsave[i__] = r__[i__];
5450	/* L104: */
5451	}
5452	dfftf_(n, &wsave[1], &wsave[*n + 1]);
5453	cf = 2.f / (r_8) (*n);
5454	cfm = -cf;
5455	azero = cf .5f * wsave[1];
5456	ns2 = (*n + 1) / 2;
5457	ns2m = ns2 - 1;
5458	i__1 = ns2m;
5459	for (i__ = 1; i__ <= i__1; ++i__) {
5460	a[i__] = cf * wsave[i__ * 2];
5461	b[i__] = cfm * wsave[(i__ << 1) + 1];
5462	/* L105: */
5463	}
5464	if (*n % 2 == 1) {
5465	return 0;
5466	}
5467	a[ns2] = cf * .5f * wsave[*n];
5468	b[ns2] = 0.f;
5469	return 0;
5470	} /* dezfftf_ */
5471
5472	/* ------ File dezffti.f ------ */
5473	/* Subroutine / int dezffti_(int_4 n, r_8 *wsave)
5474	{
5475	extern /* Subroutine / int dezfft1_(int_4 , r_8 , int_8 );
5476
5477	/* Parameter adjustments */
5478	--wsave;
5479
5480	/* Function Body */
5481	if (*n == 1) {
5482	return 0;
5483	}
5484	dezfft1_(n, &wsave[(n << 1) + 1], (int_8 )&wsave[n 3 + 1]);
5485	return 0;
5486	} /* dezffti_ */
5487
5488	/* ------ File dpassb.f ------ */
5489	/* Subroutine / int dpassb_(int_4 nac, int_4 ido, int_4 ip, int_4 *
5490	l1, int_4 idl1, r_8 cc, r_8 c1, r_8 c2, r_8 ch, r_8 ch2,
5491	r_8 *wa)
5492	{
5493	/* System generated locals */
5494	int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
5495	c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
5496	i__1, i__2, i__3;
5497
5498	/* Local variables */
5499	static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
5500	idl, inc, idp;
5501	static r_8 wai, war;
5502	static int_4 ipp2;
5503
5504	/* Parameter adjustments */
5505	ch_dim1 = *ido;
5506	ch_dim2 = *l1;
5507	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5508	ch -= ch_offset;
5509	c1_dim1 = *ido;
5510	c1_dim2 = *l1;
5511	c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
5512	c1 -= c1_offset;
5513	cc_dim1 = *ido;
5514	cc_dim2 = *ip;
5515	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
5516	cc -= cc_offset;
5517	ch2_dim1 = *idl1;
5518	ch2_offset = ch2_dim1 + 1;
5519	ch2 -= ch2_offset;
5520	c2_dim1 = *idl1;
5521	c2_offset = c2_dim1 + 1;
5522	c2 -= c2_offset;
5523	--wa;
5524
5525	/* Function Body */
5526	idot = *ido / 2;
5527	nt = ip *idl1;
5528	ipp2 = *ip + 2;
5529	ipph = (*ip + 1) / 2;
5530	idp = ip *ido;
5531
5532	if (ido < l1) {
5533	goto L106;
5534	}
5535	i__1 = ipph;
5536	for (j = 2; j <= i__1; ++j) {
5537	jc = ipp2 - j;
5538	i__2 = *l1;
5539	for (k = 1; k <= i__2; ++k) {
5540	i__3 = *ido;
5541	for (i__ = 1; i__ <= i__3; ++i__) {
5542	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5543	cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
5544	cc_dim1];
5545	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5546	cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
5547	cc_dim1];
5548	/* L101: */
5549	}
5550	/* L102: */
5551	}
5552	/* L103: */
5553	}
5554	i__1 = *l1;
5555	for (k = 1; k <= i__1; ++k) {
5556	i__2 = *ido;
5557	for (i__ = 1; i__ <= i__2; ++i__) {
5558	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
5559	cc_dim1];
5560	/* L104: */
5561	}
5562	/* L105: */
5563	}
5564	goto L112;
5565	L106:
5566	i__1 = ipph;
5567	for (j = 2; j <= i__1; ++j) {
5568	jc = ipp2 - j;
5569	i__2 = *ido;
5570	for (i__ = 1; i__ <= i__2; ++i__) {
5571	i__3 = *l1;
5572	for (k = 1; k <= i__3; ++k) {
5573	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5574	cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
5575	cc_dim1];
5576	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
5577	cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
5578	cc_dim1];
5579	/* L107: */
5580	}
5581	/* L108: */
5582	}
5583	/* L109: */
5584	}
5585	i__1 = *ido;
5586	for (i__ = 1; i__ <= i__1; ++i__) {
5587	i__2 = *l1;
5588	for (k = 1; k <= i__2; ++k) {
5589	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
5590	cc_dim1];
5591	/* L110: */
5592	}
5593	/* L111: */
5594	}
5595	L112:
5596	idl = 2 - *ido;
5597	inc = 0;
5598	i__1 = ipph;
5599	for (l = 2; l <= i__1; ++l) {
5600	lc = ipp2 - l;
5601	idl += *ido;
5602	i__2 = *idl1;
5603	for (ik = 1; ik <= i__2; ++ik) {
5604	c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
5605	+ (ch2_dim1 << 1)];
5606	c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + ip ch2_dim1];
5607	/* L113: */
5608	}
5609	idlj = idl;
5610	inc += *ido;
5611	i__2 = ipph;
5612	for (j = 3; j <= i__2; ++j) {
5613	jc = ipp2 - j;
5614	idlj += inc;
5615	if (idlj > idp) {
5616	idlj -= idp;
5617	}
5618	war = wa[idlj - 1];
5619	wai = wa[idlj];
5620	i__3 = *idl1;
5621	for (ik = 1; ik <= i__3; ++ik) {
5622	c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
5623	c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
5624	/* L114: */
5625	}
5626	/* L115: */
5627	}
5628	/* L116: */
5629	}
5630	i__1 = ipph;
5631	for (j = 2; j <= i__1; ++j) {
5632	i__2 = *idl1;
5633	for (ik = 1; ik <= i__2; ++ik) {
5634	ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
5635	/* L117: */
5636	}
5637	/* L118: */
5638	}
5639	i__1 = ipph;
5640	for (j = 2; j <= i__1; ++j) {
5641	jc = ipp2 - j;
5642	i__2 = *idl1;
5643	for (ik = 2; ik <= i__2; ik += 2) {
5644	ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
5645	jc * c2_dim1];
5646	ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
5647	jc * c2_dim1];
5648	ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
5649	c2_dim1];
5650	ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
5651	c2_dim1];
5652	/* L119: */
5653	}
5654	/* L120: */
5655	}
5656	*nac = 1;
5657	if (*ido == 2) {
5658	return 0;
5659	}
5660	*nac = 0;
5661	i__1 = *idl1;
5662	for (ik = 1; ik <= i__1; ++ik) {
5663	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
5664	/* L121: */
5665	}
5666	i__1 = *ip;
5667	for (j = 2; j <= i__1; ++j) {
5668	i__2 = *l1;
5669	for (k = 1; k <= i__2; ++k) {
5670	c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
5671	ch_dim1 + 1];
5672	c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
5673	ch_dim1 + 2];
5674	/* L122: */
5675	}
5676	/* L123: */
5677	}
5678	if (idot > *l1) {
5679	goto L127;
5680	}
5681	idij = 0;
5682	i__1 = *ip;
5683	for (j = 2; j <= i__1; ++j) {
5684	idij += 2;
5685	i__2 = *ido;
5686	for (i__ = 4; i__ <= i__2; i__ += 2) {
5687	idij += 2;
5688	i__3 = *l1;
5689	for (k = 1; k <= i__3; ++k) {
5690	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
5691	i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
5692	ch[i__ + (k + j * ch_dim2) * ch_dim1];
5693	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
5694	+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
5695	1 + (k + j * ch_dim2) * ch_dim1];
5696	/* L124: */
5697	}
5698	/* L125: */
5699	}
5700	/* L126: */
5701	}
5702	return 0;
5703	L127:
5704	idj = 2 - *ido;
5705	i__1 = *ip;
5706	for (j = 2; j <= i__1; ++j) {
5707	idj += *ido;
5708	i__2 = *l1;
5709	for (k = 1; k <= i__2; ++k) {
5710	idij = idj;
5711	i__3 = *ido;
5712	for (i__ = 4; i__ <= i__3; i__ += 2) {
5713	idij += 2;
5714	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
5715	i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
5716	ch[i__ + (k + j * ch_dim2) * ch_dim1];
5717	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
5718	+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
5719	1 + (k + j * ch_dim2) * ch_dim1];
5720	/* L128: */
5721	}
5722	/* L129: */
5723	}
5724	/* L130: */
5725	}
5726	return 0;
5727	} /* dpassb_ */
5728
5729	/* ------ File dpassb2.f ------ */
5730	/* Subroutine / int dpassb2_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
5731	r_8 *wa1)
5732	{
5733	/* System generated locals */
5734	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5735
5736	/* Local variables */
5737	static int_4 i__, k;
5738	static r_8 ti2, tr2;
5739
5740	/* Parameter adjustments */
5741	ch_dim1 = *ido;
5742	ch_dim2 = *l1;
5743	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5744	ch -= ch_offset;
5745	cc_dim1 = *ido;
5746	cc_offset = cc_dim1 * 3 + 1;
5747	cc -= cc_offset;
5748	--wa1;
5749
5750	/* Function Body */
5751	if (*ido > 2) {
5752	goto L102;
5753	}
5754	i__1 = *l1;
5755	for (k = 1; k <= i__1; ++k) {
5756	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
5757	cc[((k << 1) + 2) * cc_dim1 + 1];
5758	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
5759	+ 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
5760	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
5761	cc[((k << 1) + 2) * cc_dim1 + 2];
5762	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
5763	+ 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
5764	/* L101: */
5765	}
5766	return 0;
5767	L102:
5768	i__1 = *l1;
5769	for (k = 1; k <= i__1; ++k) {
5770	i__2 = *ido;
5771	for (i__ = 2; i__ <= i__2; i__ += 2) {
5772	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
5773	1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
5774	tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
5775	1) + 2) * cc_dim1];
5776	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
5777	cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
5778	ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
5779	* cc_dim1];
5780	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 +
5781	wa1[i__] * tr2;
5782	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
5783	- wa1[i__] * ti2;
5784	/* L103: */
5785	}
5786	/* L104: */
5787	}
5788	return 0;
5789	} /* dpassb2_ */
5790
5791	/* ------ File dpassb3.f ------ */
5792	/* Subroutine / int dpassb3_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
5793	r_8 wa1, r_8 wa2)
5794	{
5795	/* Initialized data */
5796
5797	static r_8 taur = -.5f;
5798	static r_8 taui = .866025403784439f;
5799
5800	/* System generated locals */
5801	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5802
5803	/* Local variables */
5804	static int_4 i__, k;
5805	static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
5806
5807	/* Parameter adjustments */
5808	ch_dim1 = *ido;
5809	ch_dim2 = *l1;
5810	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5811	ch -= ch_offset;
5812	cc_dim1 = *ido;
5813	cc_offset = (cc_dim1 << 2) + 1;
5814	cc -= cc_offset;
5815	--wa1;
5816	--wa2;
5817
5818	/* Function Body */
5819	if (*ido != 2) {
5820	goto L102;
5821	}
5822	i__1 = *l1;
5823	for (k = 1; k <= i__1; ++k) {
5824	tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
5825	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
5826	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
5827	ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
5828	ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
5829	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
5830	cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
5831	cc_dim1 + 1]);
5832	ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
5833	cc_dim1 + 2]);
5834	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
5835	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
5836	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
5837	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
5838	/* L101: */
5839	}
5840	return 0;
5841	L102:
5842	i__1 = *l1;
5843	for (k = 1; k <= i__1; ++k) {
5844	i__2 = *ido;
5845	for (i__ = 2; i__ <= i__2; i__ += 2) {
5846	tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
5847	3) * cc_dim1];
5848	cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
5849	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
5850	cc_dim1] + tr2;
5851	ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
5852	cc_dim1];
5853	ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
5854	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
5855	cc_dim1] + ti2;
5856	cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
5857	k * 3 + 3) * cc_dim1]);
5858	ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
5859	3) * cc_dim1]);
5860	dr2 = cr2 - ci3;
5861	dr3 = cr2 + ci3;
5862	di2 = ci2 + cr3;
5863	di3 = ci2 - cr3;
5864	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
5865	wa1[i__] * dr2;
5866	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
5867	- wa1[i__] * di2;
5868	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
5869	i__] * dr3;
5870	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
5871	wa2[i__] * di3;
5872	/* L103: */
5873	}
5874	/* L104: */
5875	}
5876	return 0;
5877	} /* dpassb3_ */
5878
5879	/* ------ File dpassb4.f ------ */
5880	/* Subroutine / int dpassb4_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
5881	r_8 wa1, r_8 wa2, r_8 *wa3)
5882	{
5883	/* System generated locals */
5884	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5885
5886	/* Local variables */
5887	static int_4 i__, k;
5888	static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
5889	tr3, tr4;
5890
5891	/* Parameter adjustments */
5892	ch_dim1 = *ido;
5893	ch_dim2 = *l1;
5894	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
5895	ch -= ch_offset;
5896	cc_dim1 = *ido;
5897	cc_offset = cc_dim1 * 5 + 1;
5898	cc -= cc_offset;
5899	--wa1;
5900	--wa2;
5901	--wa3;
5902
5903	/* Function Body */
5904	if (*ido != 2) {
5905	goto L102;
5906	}
5907	i__1 = *l1;
5908	for (k = 1; k <= i__1; ++k) {
5909	ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
5910	+ 2];
5911	ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
5912	+ 2];
5913	tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1
5914	+ 2];
5915	ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
5916	+ 2];
5917	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
5918	+ 1];
5919	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
5920	+ 1];
5921	ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1
5922	+ 1];
5923	tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
5924	+ 1];
5925	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
5926	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
5927	ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
5928	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
5929	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
5930	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
5931	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
5932	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
5933	/* L101: */
5934	}
5935	return 0;
5936	L102:
5937	i__1 = *l1;
5938	for (k = 1; k <= i__1; ++k) {
5939	i__2 = *ido;
5940	for (i__ = 2; i__ <= i__2; i__ += 2) {
5941	ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
5942	* cc_dim1];
5943	ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
5944	* cc_dim1];
5945	ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
5946	* cc_dim1];
5947	tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
5948	* cc_dim1];
5949	tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
5950	2) + 3) * cc_dim1];
5951	tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
5952	2) + 3) * cc_dim1];
5953	ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
5954	2) + 4) * cc_dim1];
5955	tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
5956	2) + 4) * cc_dim1];
5957	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
5958	cr3 = tr2 - tr3;
5959	ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
5960	ci3 = ti2 - ti3;
5961	cr2 = tr1 + tr4;
5962	cr4 = tr1 - tr4;
5963	ci2 = ti1 + ti4;
5964	ci4 = ti1 - ti4;
5965	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
5966	- wa1[i__] * ci2;
5967	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 +
5968	wa1[i__] * cr2;
5969	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 -
5970	wa2[i__] * ci3;
5971	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
5972	i__] * cr3;
5973	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
5974	- wa3[i__] * ci4;
5975	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 +
5976	wa3[i__] * cr4;
5977	/* L103: */
5978	}
5979	/* L104: */
5980	}
5981	return 0;
5982	} /* dpassb4_ */
5983
5984	/* ------ File dpassb5.f ------ */
5985	/* Subroutine / int dpassb5_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
5986	r_8 wa1, r_8 wa2, r_8 wa3, r_8 wa4)
5987	{
5988	/* Initialized data */
5989
5990	static r_8 tr11 = .309016994374947f;
5991	static r_8 ti11 = .951056516295154f;
5992	static r_8 tr12 = -.809016994374947f;
5993	static r_8 ti12 = .587785252292473f;
5994
5995	/* System generated locals */
5996	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
5997
5998	/* Local variables */
5999	static int_4 i__, k;
6000	static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
6001	ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
6002
6003	/* Parameter adjustments */
6004	ch_dim1 = *ido;
6005	ch_dim2 = *l1;
6006	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6007	ch -= ch_offset;
6008	cc_dim1 = *ido;
6009	cc_offset = cc_dim1 * 6 + 1;
6010	cc -= cc_offset;
6011	--wa1;
6012	--wa2;
6013	--wa3;
6014	--wa4;
6015
6016	/* Function Body */
6017	if (*ido != 2) {
6018	goto L102;
6019	}
6020	i__1 = *l1;
6021	for (k = 1; k <= i__1; ++k) {
6022	ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
6023	ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
6024	ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
6025	ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
6026	tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
6027	tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
6028	tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
6029	tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
6030	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
6031	+ tr3;
6032	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
6033	+ ti3;
6034	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
6035	ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
6036	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
6037	ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
6038	cr5 = ti11 * tr5 + ti12 * tr4;
6039	ci5 = ti11 * ti5 + ti12 * ti4;
6040	cr4 = ti12 * tr5 - ti11 * tr4;
6041	ci4 = ti12 * ti5 - ti11 * ti4;
6042	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
6043	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
6044	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
6045	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
6046	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
6047	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
6048	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
6049	ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
6050	/* L101: */
6051	}
6052	return 0;
6053	L102:
6054	i__1 = *l1;
6055	for (k = 1; k <= i__1; ++k) {
6056	i__2 = *ido;
6057	for (i__ = 2; i__ <= i__2; i__ += 2) {
6058	ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
6059	cc_dim1];
6060	ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
6061	cc_dim1];
6062	ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
6063	cc_dim1];
6064	ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
6065	cc_dim1];
6066	tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6067	5) * cc_dim1];
6068	tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6069	5) * cc_dim1];
6070	tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6071	4) * cc_dim1];
6072	tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6073	4) * cc_dim1];
6074	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
6075	cc_dim1] + tr2 + tr3;
6076	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
6077	cc_dim1] + ti2 + ti3;
6078	cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
6079	tr3;
6080	ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
6081	cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
6082	tr3;
6083	ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
6084	cr5 = ti11 * tr5 + ti12 * tr4;
6085	ci5 = ti11 * ti5 + ti12 * ti4;
6086	cr4 = ti12 * tr5 - ti11 * tr4;
6087	ci4 = ti12 * ti5 - ti11 * ti4;
6088	dr3 = cr3 - ci4;
6089	dr4 = cr3 + ci4;
6090	di3 = ci3 + cr4;
6091	di4 = ci3 - cr4;
6092	dr5 = cr2 + ci5;
6093	dr2 = cr2 - ci5;
6094	di5 = ci2 - cr5;
6095	di2 = ci2 + cr5;
6096	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6097	- wa1[i__] * di2;
6098	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 +
6099	wa1[i__] * dr2;
6100	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 -
6101	wa2[i__] * di3;
6102	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
6103	i__] * dr3;
6104	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
6105	- wa3[i__] * di4;
6106	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 +
6107	wa3[i__] * dr4;
6108	ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 -
6109	wa4[i__] * di5;
6110	ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
6111	i__] * dr5;
6112	/* L103: */
6113	}
6114	/* L104: */
6115	}
6116	return 0;
6117	} /* dpassb5_ */
6118
6119	/* ------ File dpassf.f ------ */
6120	/* Subroutine / int dpassf_(int_4 nac, int_4 ido, int_4 ip, int_4 *
6121	l1, int_4 idl1, r_8 cc, r_8 c1, r_8 c2, r_8 ch, r_8 ch2,
6122	r_8 *wa)
6123	{
6124	/* System generated locals */
6125	int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
6126	c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
6127	i__1, i__2, i__3;
6128
6129	/* Local variables */
6130	static int_4 idij, idlj, idot, ipph, i__, j, k, l, jc, lc, ik, nt, idj,
6131	idl, inc, idp;
6132	static r_8 wai, war;
6133	static int_4 ipp2;
6134
6135	/* Parameter adjustments */
6136	ch_dim1 = *ido;
6137	ch_dim2 = *l1;
6138	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6139	ch -= ch_offset;
6140	c1_dim1 = *ido;
6141	c1_dim2 = *l1;
6142	c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
6143	c1 -= c1_offset;
6144	cc_dim1 = *ido;
6145	cc_dim2 = *ip;
6146	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
6147	cc -= cc_offset;
6148	ch2_dim1 = *idl1;
6149	ch2_offset = ch2_dim1 + 1;
6150	ch2 -= ch2_offset;
6151	c2_dim1 = *idl1;
6152	c2_offset = c2_dim1 + 1;
6153	c2 -= c2_offset;
6154	--wa;
6155
6156	/* Function Body */
6157	idot = *ido / 2;
6158	nt = ip *idl1;
6159	ipp2 = *ip + 2;
6160	ipph = (*ip + 1) / 2;
6161	idp = ip *ido;
6162
6163	if (ido < l1) {
6164	goto L106;
6165	}
6166	i__1 = ipph;
6167	for (j = 2; j <= i__1; ++j) {
6168	jc = ipp2 - j;
6169	i__2 = *l1;
6170	for (k = 1; k <= i__2; ++k) {
6171	i__3 = *ido;
6172	for (i__ = 1; i__ <= i__3; ++i__) {
6173	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6174	cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
6175	cc_dim1];
6176	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6177	cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
6178	cc_dim1];
6179	/* L101: */
6180	}
6181	/* L102: */
6182	}
6183	/* L103: */
6184	}
6185	i__1 = *l1;
6186	for (k = 1; k <= i__1; ++k) {
6187	i__2 = *ido;
6188	for (i__ = 1; i__ <= i__2; ++i__) {
6189	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
6190	cc_dim1];
6191	/* L104: */
6192	}
6193	/* L105: */
6194	}
6195	goto L112;
6196	L106:
6197	i__1 = ipph;
6198	for (j = 2; j <= i__1; ++j) {
6199	jc = ipp2 - j;
6200	i__2 = *ido;
6201	for (i__ = 1; i__ <= i__2; ++i__) {
6202	i__3 = *l1;
6203	for (k = 1; k <= i__3; ++k) {
6204	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6205	cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) *
6206	cc_dim1];
6207	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k *
6208	cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) *
6209	cc_dim1];
6210	/* L107: */
6211	}
6212	/* L108: */
6213	}
6214	/* L109: */
6215	}
6216	i__1 = *ido;
6217	for (i__ = 1; i__ <= i__1; ++i__) {
6218	i__2 = *l1;
6219	for (k = 1; k <= i__2; ++k) {
6220	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
6221	cc_dim1];
6222	/* L110: */
6223	}
6224	/* L111: */
6225	}
6226	L112:
6227	idl = 2 - *ido;
6228	inc = 0;
6229	i__1 = ipph;
6230	for (l = 2; l <= i__1; ++l) {
6231	lc = ipp2 - l;
6232	idl += *ido;
6233	i__2 = *idl1;
6234	for (ik = 1; ik <= i__2; ++ik) {
6235	c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik
6236	+ (ch2_dim1 << 1)];
6237	c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + ip ch2_dim1];
6238	/* L113: */
6239	}
6240	idlj = idl;
6241	inc += *ido;
6242	i__2 = ipph;
6243	for (j = 3; j <= i__2; ++j) {
6244	jc = ipp2 - j;
6245	idlj += inc;
6246	if (idlj > idp) {
6247	idlj -= idp;
6248	}
6249	war = wa[idlj - 1];
6250	wai = wa[idlj];
6251	i__3 = *idl1;
6252	for (ik = 1; ik <= i__3; ++ik) {
6253	c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
6254	c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
6255	/* L114: */
6256	}
6257	/* L115: */
6258	}
6259	/* L116: */
6260	}
6261	i__1 = ipph;
6262	for (j = 2; j <= i__1; ++j) {
6263	i__2 = *idl1;
6264	for (ik = 1; ik <= i__2; ++ik) {
6265	ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
6266	/* L117: */
6267	}
6268	/* L118: */
6269	}
6270	i__1 = ipph;
6271	for (j = 2; j <= i__1; ++j) {
6272	jc = ipp2 - j;
6273	i__2 = *idl1;
6274	for (ik = 2; ik <= i__2; ik += 2) {
6275	ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik +
6276	jc * c2_dim1];
6277	ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik +
6278	jc * c2_dim1];
6279	ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc *
6280	c2_dim1];
6281	ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc *
6282	c2_dim1];
6283	/* L119: */
6284	}
6285	/* L120: */
6286	}
6287	*nac = 1;
6288	if (*ido == 2) {
6289	return 0;
6290	}
6291	*nac = 0;
6292	i__1 = *idl1;
6293	for (ik = 1; ik <= i__1; ++ik) {
6294	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
6295	/* L121: */
6296	}
6297	i__1 = *ip;
6298	for (j = 2; j <= i__1; ++j) {
6299	i__2 = *l1;
6300	for (k = 1; k <= i__2; ++k) {
6301	c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
6302	ch_dim1 + 1];
6303	c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) *
6304	ch_dim1 + 2];
6305	/* L122: */
6306	}
6307	/* L123: */
6308	}
6309	if (idot > *l1) {
6310	goto L127;
6311	}
6312	idij = 0;
6313	i__1 = *ip;
6314	for (j = 2; j <= i__1; ++j) {
6315	idij += 2;
6316	i__2 = *ido;
6317	for (i__ = 4; i__ <= i__2; i__ += 2) {
6318	idij += 2;
6319	i__3 = *l1;
6320	for (k = 1; k <= i__3; ++k) {
6321	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
6322	i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
6323	ch[i__ + (k + j * ch_dim2) * ch_dim1];
6324	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
6325	+ (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
6326	1 + (k + j * ch_dim2) * ch_dim1];
6327	/* L124: */
6328	}
6329	/* L125: */
6330	}
6331	/* L126: */
6332	}
6333	return 0;
6334	L127:
6335	idj = 2 - *ido;
6336	i__1 = *ip;
6337	for (j = 2; j <= i__1; ++j) {
6338	idj += *ido;
6339	i__2 = *l1;
6340	for (k = 1; k <= i__2; ++k) {
6341	idij = idj;
6342	i__3 = *ido;
6343	for (i__ = 4; i__ <= i__3; i__ += 2) {
6344	idij += 2;
6345	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
6346	i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] *
6347	ch[i__ + (k + j * ch_dim2) * ch_dim1];
6348	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
6349	+ (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ -
6350	1 + (k + j * ch_dim2) * ch_dim1];
6351	/* L128: */
6352	}
6353	/* L129: */
6354	}
6355	/* L130: */
6356	}
6357	return 0;
6358	} /* dpassf_ */
6359
6360	/* ------ File dpassf2.f ------ */
6361	/* Subroutine / int dpassf2_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6362	r_8 *wa1)
6363	{
6364	/* System generated locals */
6365	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6366
6367	/* Local variables */
6368	static int_4 i__, k;
6369	static r_8 ti2, tr2;
6370
6371	/* Parameter adjustments */
6372	ch_dim1 = *ido;
6373	ch_dim2 = *l1;
6374	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6375	ch -= ch_offset;
6376	cc_dim1 = *ido;
6377	cc_offset = cc_dim1 * 3 + 1;
6378	cc -= cc_offset;
6379	--wa1;
6380
6381	/* Function Body */
6382	if (*ido > 2) {
6383	goto L102;
6384	}
6385	i__1 = *l1;
6386	for (k = 1; k <= i__1; ++k) {
6387	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
6388	cc[((k << 1) + 2) * cc_dim1 + 1];
6389	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
6390	+ 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
6391	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] +
6392	cc[((k << 1) + 2) * cc_dim1 + 2];
6393	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1
6394	+ 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
6395	/* L101: */
6396	}
6397	return 0;
6398	L102:
6399	i__1 = *l1;
6400	for (k = 1; k <= i__1; ++k) {
6401	i__2 = *ido;
6402	for (i__ = 2; i__ <= i__2; i__ += 2) {
6403	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
6404	1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
6405	tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
6406	1) + 2) * cc_dim1];
6407	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
6408	cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
6409	ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
6410	* cc_dim1];
6411	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 -
6412	wa1[i__] * tr2;
6413	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2
6414	+ wa1[i__] * ti2;
6415	/* L103: */
6416	}
6417	/* L104: */
6418	}
6419	return 0;
6420	} /* dpassf2_ */
6421
6422	/* ------ File dpassf3.f ------ */
6423	/* Subroutine / int dpassf3_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6424	r_8 wa1, r_8 wa2)
6425	{
6426	/* Initialized data */
6427
6428	static r_8 taur = -.5f;
6429	static r_8 taui = -.866025403784439f;
6430
6431	/* System generated locals */
6432	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6433
6434	/* Local variables */
6435	static int_4 i__, k;
6436	static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
6437
6438	/* Parameter adjustments */
6439	ch_dim1 = *ido;
6440	ch_dim2 = *l1;
6441	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6442	ch -= ch_offset;
6443	cc_dim1 = *ido;
6444	cc_offset = (cc_dim1 << 2) + 1;
6445	cc -= cc_offset;
6446	--wa1;
6447	--wa2;
6448
6449	/* Function Body */
6450	if (*ido != 2) {
6451	goto L102;
6452	}
6453	i__1 = *l1;
6454	for (k = 1; k <= i__1; ++k) {
6455	tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
6456	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
6457	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
6458	ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
6459	ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
6460	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
6461	cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) *
6462	cc_dim1 + 1]);
6463	ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) *
6464	cc_dim1 + 2]);
6465	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
6466	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
6467	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
6468	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
6469	/* L101: */
6470	}
6471	return 0;
6472	L102:
6473	i__1 = *l1;
6474	for (k = 1; k <= i__1; ++k) {
6475	i__2 = *ido;
6476	for (i__ = 2; i__ <= i__2; i__ += 2) {
6477	tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 +
6478	3) * cc_dim1];
6479	cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
6480	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
6481	cc_dim1] + tr2;
6482	ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) *
6483	cc_dim1];
6484	ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
6485	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
6486	cc_dim1] + ti2;
6487	cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
6488	k * 3 + 3) * cc_dim1]);
6489	ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 +
6490	3) * cc_dim1]);
6491	dr2 = cr2 - ci3;
6492	dr3 = cr2 + ci3;
6493	di2 = ci2 + cr3;
6494	di3 = ci2 - cr3;
6495	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
6496	wa1[i__] * dr2;
6497	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6498	+ wa1[i__] * di2;
6499	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
6500	i__] * dr3;
6501	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
6502	wa2[i__] * di3;
6503	/* L103: */
6504	}
6505	/* L104: */
6506	}
6507	return 0;
6508	} /* dpassf3_ */
6509
6510	/* ------ File dpassf4.f ------ */
6511	/* Subroutine / int dpassf4_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6512	r_8 wa1, r_8 wa2, r_8 *wa3)
6513	{
6514	/* System generated locals */
6515	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6516
6517	/* Local variables */
6518	static int_4 i__, k;
6519	static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
6520	tr3, tr4;
6521
6522	/* Parameter adjustments */
6523	ch_dim1 = *ido;
6524	ch_dim2 = *l1;
6525	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6526	ch -= ch_offset;
6527	cc_dim1 = *ido;
6528	cc_offset = cc_dim1 * 5 + 1;
6529	cc -= cc_offset;
6530	--wa1;
6531	--wa2;
6532	--wa3;
6533
6534	/* Function Body */
6535	if (*ido != 2) {
6536	goto L102;
6537	}
6538	i__1 = *l1;
6539	for (k = 1; k <= i__1; ++k) {
6540	ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1
6541	+ 2];
6542	ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1
6543	+ 2];
6544	tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1
6545	+ 2];
6546	ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1
6547	+ 2];
6548	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1
6549	+ 1];
6550	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
6551	+ 1];
6552	ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
6553	+ 1];
6554	tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
6555	+ 1];
6556	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
6557	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
6558	ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
6559	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
6560	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
6561	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
6562	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
6563	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
6564	/* L101: */
6565	}
6566	return 0;
6567	L102:
6568	i__1 = *l1;
6569	for (k = 1; k <= i__1; ++k) {
6570	i__2 = *ido;
6571	for (i__ = 2; i__ <= i__2; i__ += 2) {
6572	ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
6573	* cc_dim1];
6574	ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
6575	* cc_dim1];
6576	ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
6577	* cc_dim1];
6578	tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
6579	* cc_dim1];
6580	tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
6581	2) + 3) * cc_dim1];
6582	tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
6583	2) + 3) * cc_dim1];
6584	ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
6585	2) + 2) * cc_dim1];
6586	tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
6587	2) + 4) * cc_dim1];
6588	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
6589	cr3 = tr2 - tr3;
6590	ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
6591	ci3 = ti2 - ti3;
6592	cr2 = tr1 + tr4;
6593	cr4 = tr1 - tr4;
6594	ci2 = ti1 + ti4;
6595	ci4 = ti1 - ti4;
6596	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2
6597	+ wa1[i__] * ci2;
6598	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 -
6599	wa1[i__] * cr2;
6600	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 +
6601	wa2[i__] * ci3;
6602	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
6603	i__] * cr3;
6604	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4
6605	+ wa3[i__] * ci4;
6606	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 -
6607	wa3[i__] * cr4;
6608	/* L103: */
6609	}
6610	/* L104: */
6611	}
6612	return 0;
6613	} /* dpassf4_ */
6614
6615	/* ------ File dpassf5.f ------ */
6616	/* Subroutine / int dpassf5_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6617	r_8 wa1, r_8 wa2, r_8 wa3, r_8 wa4)
6618	{
6619	/* Initialized data */
6620
6621	static r_8 tr11 = .309016994374947f;
6622	static r_8 ti11 = -.951056516295154f;
6623	static r_8 tr12 = -.809016994374947f;
6624	static r_8 ti12 = -.587785252292473f;
6625
6626	/* System generated locals */
6627	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6628
6629	/* Local variables */
6630	static int_4 i__, k;
6631	static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
6632	ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
6633
6634	/* Parameter adjustments */
6635	ch_dim1 = *ido;
6636	ch_dim2 = *l1;
6637	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6638	ch -= ch_offset;
6639	cc_dim1 = *ido;
6640	cc_offset = cc_dim1 * 6 + 1;
6641	cc -= cc_offset;
6642	--wa1;
6643	--wa2;
6644	--wa3;
6645	--wa4;
6646
6647	/* Function Body */
6648	if (*ido != 2) {
6649	goto L102;
6650	}
6651	i__1 = *l1;
6652	for (k = 1; k <= i__1; ++k) {
6653	ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
6654	ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
6655	ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
6656	ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
6657	tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
6658	tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
6659	tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
6660	tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
6661	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
6662	+ tr3;
6663	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2
6664	+ ti3;
6665	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
6666	ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
6667	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
6668	ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
6669	cr5 = ti11 * tr5 + ti12 * tr4;
6670	ci5 = ti11 * ti5 + ti12 * ti4;
6671	cr4 = ti12 * tr5 - ti11 * tr4;
6672	ci4 = ti12 * ti5 - ti11 * ti4;
6673	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
6674	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
6675	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
6676	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
6677	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
6678	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
6679	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
6680	ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
6681	/* L101: */
6682	}
6683	return 0;
6684	L102:
6685	i__1 = *l1;
6686	for (k = 1; k <= i__1; ++k) {
6687	i__2 = *ido;
6688	for (i__ = 2; i__ <= i__2; i__ += 2) {
6689	ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) *
6690	cc_dim1];
6691	ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) *
6692	cc_dim1];
6693	ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) *
6694	cc_dim1];
6695	ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) *
6696	cc_dim1];
6697	tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6698	5) * cc_dim1];
6699	tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6700	5) * cc_dim1];
6701	tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 +
6702	4) * cc_dim1];
6703	tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 +
6704	4) * cc_dim1];
6705	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
6706	cc_dim1] + tr2 + tr3;
6707	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
6708	cc_dim1] + ti2 + ti3;
6709	cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
6710	tr3;
6711	ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
6712	cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
6713	tr3;
6714	ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
6715	cr5 = ti11 * tr5 + ti12 * tr4;
6716	ci5 = ti11 * ti5 + ti12 * ti4;
6717	cr4 = ti12 * tr5 - ti11 * tr4;
6718	ci4 = ti12 * ti5 - ti11 * ti4;
6719	dr3 = cr3 - ci4;
6720	dr4 = cr3 + ci4;
6721	di3 = ci3 + cr4;
6722	di4 = ci3 - cr4;
6723	dr5 = cr2 + ci5;
6724	dr2 = cr2 - ci5;
6725	di5 = ci2 - cr5;
6726	di2 = ci2 + cr5;
6727	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2
6728	+ wa1[i__] * di2;
6729	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 -
6730	wa1[i__] * dr2;
6731	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 +
6732	wa2[i__] * di3;
6733	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
6734	i__] * dr3;
6735	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4
6736	+ wa3[i__] * di4;
6737	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 -
6738	wa3[i__] * dr4;
6739	ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 +
6740	wa4[i__] * di5;
6741	ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
6742	i__] * dr5;
6743	/* L103: */
6744	}
6745	/* L104: */
6746	}
6747	return 0;
6748	} /* dpassf5_ */
6749
6750	/* ------ File dadb2.f ------ */
6751	/* Subroutine / int dadb2_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6752	r_8 *wa1)
6753	{
6754	/* System generated locals */
6755	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6756
6757	/* Local variables */
6758	static int_4 i__, k, ic;
6759	static r_8 ti2, tr2;
6760	static int_4 idp2;
6761
6762	/* Parameter adjustments */
6763	ch_dim1 = *ido;
6764	ch_dim2 = *l1;
6765	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6766	ch -= ch_offset;
6767	cc_dim1 = *ido;
6768	cc_offset = cc_dim1 * 3 + 1;
6769	cc -= cc_offset;
6770	--wa1;
6771
6772	/* Function Body */
6773	i__1 = *l1;
6774	for (k = 1; k <= i__1; ++k) {
6775	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] +
6776	cc[ido + ((k << 1) + 2) cc_dim1];
6777	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1
6778	+ 1] - cc[ido + ((k << 1) + 2) cc_dim1];
6779	/* L101: */
6780	}
6781	if ((i__1 = *ido - 2) < 0) {
6782	goto L107;
6783	} else if (i__1 == 0) {
6784	goto L105;
6785	} else {
6786	goto L102;
6787	}
6788	L102:
6789	idp2 = *ido + 2;
6790	i__1 = *l1;
6791	for (k = 1; k <= i__1; ++k) {
6792	i__2 = *ido;
6793	for (i__ = 3; i__ <= i__2; i__ += 2) {
6794	ic = idp2 - i__;
6795	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) +
6796	1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
6797	tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
6798	1) + 2) * cc_dim1];
6799	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) *
6800	cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
6801	ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2)
6802	* cc_dim1];
6803	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2
6804	- wa1[i__ - 1] * ti2;
6805	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 +
6806	wa1[i__ - 1] * tr2;
6807	/* L103: */
6808	}
6809	/* L104: */
6810	}
6811	if (*ido % 2 == 1) {
6812	return 0;
6813	}
6814	L105:
6815	i__1 = *l1;
6816	for (k = 1; k <= i__1; ++k) {
6817	ch[ido + (k + ch_dim2) ch_dim1] = cc[ido + ((k << 1) + 1)
6818	cc_dim1] + cc[ido + ((k << 1) + 1) cc_dim1];
6819	ch[ido + (k + (ch_dim2 << 1)) ch_dim1] = -(cc[((k << 1) + 2) *
6820	cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
6821	/* L106: */
6822	}
6823	L107:
6824	return 0;
6825	} /* dadb2_ */
6826
6827	/* ------ File dadb3.f ------ */
6828	/* Subroutine / int dadb3_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6829	r_8 wa1, r_8 wa2)
6830	{
6831	/* Initialized data */
6832
6833	static r_8 taur = -.5f;
6834	static r_8 taui = .866025403784439f;
6835
6836	/* System generated locals */
6837	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6838
6839	/* Local variables */
6840	static int_4 i__, k, ic;
6841	static r_8 ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
6842	static int_4 idp2;
6843
6844	/* Parameter adjustments */
6845	ch_dim1 = *ido;
6846	ch_dim2 = *l1;
6847	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6848	ch -= ch_offset;
6849	cc_dim1 = *ido;
6850	cc_offset = (cc_dim1 << 2) + 1;
6851	cc -= cc_offset;
6852	--wa1;
6853	--wa2;
6854
6855	/* Function Body */
6856	i__1 = *l1;
6857	for (k = 1; k <= i__1; ++k) {
6858	tr2 = cc[ido + (k 3 + 2) * cc_dim1] + cc[ido + (k 3 + 2) *
6859	cc_dim1];
6860	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
6861	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
6862	ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) *
6863	cc_dim1 + 1]);
6864	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
6865	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
6866	/* L101: */
6867	}
6868	if (*ido == 1) {
6869	return 0;
6870	}
6871	idp2 = *ido + 2;
6872	i__1 = *l1;
6873	for (k = 1; k <= i__1; ++k) {
6874	i__2 = *ido;
6875	for (i__ = 3; i__ <= i__2; i__ += 2) {
6876	ic = idp2 - i__;
6877	tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 +
6878	2) * cc_dim1];
6879	cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
6880	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
6881	cc_dim1] + tr2;
6882	ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) *
6883	cc_dim1];
6884	ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
6885	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) *
6886	cc_dim1] + ti2;
6887	cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
6888	k * 3 + 2) * cc_dim1]);
6889	ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 +
6890	2) * cc_dim1]);
6891	dr2 = cr2 - ci3;
6892	dr3 = cr2 + ci3;
6893	di2 = ci2 + cr3;
6894	di3 = ci2 - cr3;
6895	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
6896	- wa1[i__ - 1] * di2;
6897	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
6898	wa1[i__ - 1] * dr2;
6899	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
6900	wa2[i__ - 1] * di3;
6901	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
6902	i__ - 1] * dr3;
6903	/* L102: */
6904	}
6905	/* L103: */
6906	}
6907	return 0;
6908	} /* dadb3_ */
6909
6910	/* ------ File dadb4.f ------ */
6911	/* Subroutine / int dadb4_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
6912	r_8 wa1, r_8 wa2, r_8 *wa3)
6913	{
6914	/* Initialized data */
6915
6916	static r_8 sqrt2 = 1.414213562373095f;
6917
6918	/* System generated locals */
6919	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
6920
6921	/* Local variables */
6922	static int_4 i__, k, ic;
6923	static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
6924	tr3, tr4;
6925	static int_4 idp2;
6926
6927	/* Parameter adjustments */
6928	ch_dim1 = *ido;
6929	ch_dim2 = *l1;
6930	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
6931	ch -= ch_offset;
6932	cc_dim1 = *ido;
6933	cc_offset = cc_dim1 * 5 + 1;
6934	cc -= cc_offset;
6935	--wa1;
6936	--wa2;
6937	--wa3;
6938
6939	/* Function Body */
6940	i__1 = *l1;
6941	for (k = 1; k <= i__1; ++k) {
6942	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[ido + ((k << 2) + 4)
6943	cc_dim1];
6944	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[ido + ((k << 2) + 4)
6945	cc_dim1];
6946	tr3 = cc[ido + ((k << 2) + 2) cc_dim1] + cc[ido + ((k << 2) + 2)
6947	cc_dim1];
6948	tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1
6949	+ 1];
6950	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
6951	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
6952	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
6953	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
6954	/* L101: */
6955	}
6956	if ((i__1 = *ido - 2) < 0) {
6957	goto L107;
6958	} else if (i__1 == 0) {
6959	goto L105;
6960	} else {
6961	goto L102;
6962	}
6963	L102:
6964	idp2 = *ido + 2;
6965	i__1 = *l1;
6966	for (k = 1; k <= i__1; ++k) {
6967	i__2 = *ido;
6968	for (i__ = 3; i__ <= i__2; i__ += 2) {
6969	ic = idp2 - i__;
6970	ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4)
6971	* cc_dim1];
6972	ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4)
6973	* cc_dim1];
6974	ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2)
6975	* cc_dim1];
6976	tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2)
6977	* cc_dim1];
6978	tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k <<
6979	2) + 4) * cc_dim1];
6980	tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k <<
6981	2) + 4) * cc_dim1];
6982	ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k <<
6983	2) + 2) * cc_dim1];
6984	tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k <<
6985	2) + 2) * cc_dim1];
6986	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
6987	cr3 = tr2 - tr3;
6988	ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
6989	ci3 = ti2 - ti3;
6990	cr2 = tr1 - tr4;
6991	cr4 = tr1 + tr4;
6992	ci2 = ti1 + ti4;
6993	ci4 = ti1 - ti4;
6994	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2
6995	- wa1[i__ - 1] * ci2;
6996	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 +
6997	wa1[i__ - 1] * cr2;
6998	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 -
6999	wa2[i__ - 1] * ci3;
7000	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
7001	i__ - 1] * cr3;
7002	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4
7003	- wa3[i__ - 1] * ci4;
7004	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 +
7005	wa3[i__ - 1] * cr4;
7006	/* L103: */
7007	}
7008	/* L104: */
7009	}
7010	if (*ido % 2 == 1) {
7011	return 0;
7012	}
7013	L105:
7014	i__1 = *l1;
7015	for (k = 1; k <= i__1; ++k) {
7016	ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1
7017	+ 1];
7018	ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1
7019	+ 1];
7020	tr1 = cc[ido + ((k << 2) + 1) cc_dim1] - cc[ido + ((k << 2) + 3)
7021	cc_dim1];
7022	tr2 = cc[ido + ((k << 2) + 1) cc_dim1] + cc[ido + ((k << 2) + 3)
7023	cc_dim1];
7024	ch[ido + (k + ch_dim2) ch_dim1] = tr2 + tr2;
7025	ch[ido + (k + (ch_dim2 << 1)) ch_dim1] = sqrt2 * (tr1 - ti1);
7026	ch[ido + (k + ch_dim2 3) * ch_dim1] = ti2 + ti2;
7027	ch[ido + (k + (ch_dim2 << 2)) ch_dim1] = -sqrt2 * (tr1 + ti1);
7028	/* L106: */
7029	}
7030	L107:
7031	return 0;
7032	} /* dadb4_ */
7033
7034	/* ------ File dadb5.f ------ */
7035	/* Subroutine / int dadb5_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
7036	r_8 wa1, r_8 wa2, r_8 wa3, r_8 wa4)
7037	{
7038	/* Initialized data */
7039
7040	static r_8 tr11 = .309016994374947f;
7041	static r_8 ti11 = .951056516295154f;
7042	static r_8 tr12 = -.809016994374947f;
7043	static r_8 ti12 = .587785252292473f;
7044
7045	/* System generated locals */
7046	int_4 cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;
7047
7048	/* Local variables */
7049	static int_4 i__, k, ic;
7050	static r_8 ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
7051	ti2, ti3, ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
7052	static int_4 idp2;
7053
7054	/* Parameter adjustments */
7055	ch_dim1 = *ido;
7056	ch_dim2 = *l1;
7057	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7058	ch -= ch_offset;
7059	cc_dim1 = *ido;
7060	cc_offset = cc_dim1 * 6 + 1;
7061	cc -= cc_offset;
7062	--wa1;
7063	--wa2;
7064	--wa3;
7065	--wa4;
7066
7067	/* Function Body */
7068	i__1 = *l1;
7069	for (k = 1; k <= i__1; ++k) {
7070	ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
7071	ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
7072	tr2 = cc[ido + (k 5 + 2) * cc_dim1] + cc[ido + (k 5 + 2) *
7073	cc_dim1];
7074	tr3 = cc[ido + (k 5 + 4) * cc_dim1] + cc[ido + (k 5 + 4) *
7075	cc_dim1];
7076	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2
7077	+ tr3;
7078	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
7079	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
7080	ci5 = ti11 * ti5 + ti12 * ti4;
7081	ci4 = ti12 * ti5 - ti11 * ti4;
7082	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
7083	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
7084	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
7085	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
7086	/* L101: */
7087	}
7088	if (*ido == 1) {
7089	return 0;
7090	}
7091	idp2 = *ido + 2;
7092	i__1 = *l1;
7093	for (k = 1; k <= i__1; ++k) {
7094	i__2 = *ido;
7095	for (i__ = 3; i__ <= i__2; i__ += 2) {
7096	ic = idp2 - i__;
7097	ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) *
7098	cc_dim1];
7099	ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) *
7100	cc_dim1];
7101	ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) *
7102	cc_dim1];
7103	ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) *
7104	cc_dim1];
7105	tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 +
7106	2) * cc_dim1];
7107	tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 +
7108	2) * cc_dim1];
7109	tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 +
7110	4) * cc_dim1];
7111	tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 +
7112	4) * cc_dim1];
7113	ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
7114	cc_dim1] + tr2 + tr3;
7115	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) *
7116	cc_dim1] + ti2 + ti3;
7117	cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 *
7118	tr3;
7119	ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
7120	cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 *
7121	tr3;
7122	ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
7123	cr5 = ti11 * tr5 + ti12 * tr4;
7124	ci5 = ti11 * ti5 + ti12 * ti4;
7125	cr4 = ti12 * tr5 - ti11 * tr4;
7126	ci4 = ti12 * ti5 - ti11 * ti4;
7127	dr3 = cr3 - ci4;
7128	dr4 = cr3 + ci4;
7129	di3 = ci3 + cr4;
7130	di4 = ci3 - cr4;
7131	dr5 = cr2 + ci5;
7132	dr2 = cr2 - ci5;
7133	di5 = ci2 - cr5;
7134	di2 = ci2 + cr5;
7135	ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2
7136	- wa1[i__ - 1] * di2;
7137	ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 +
7138	wa1[i__ - 1] * dr2;
7139	ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 -
7140	wa2[i__ - 1] * di3;
7141	ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
7142	i__ - 1] * dr3;
7143	ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4
7144	- wa3[i__ - 1] * di4;
7145	ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 +
7146	wa3[i__ - 1] * dr4;
7147	ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 -
7148	wa4[i__ - 1] * di5;
7149	ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
7150	i__ - 1] * dr5;
7151	/* L102: */
7152	}
7153	/* L103: */
7154	}
7155	return 0;
7156	} /* dadb5_ */
7157
7158	/* ------ File dadbg.f ------ */
7159	/* Subroutine / int dadbg_(int_4 ido, int_4 ip, int_4 l1, int_4 *
7160	idl1, r_8 cc, r_8 c1, r_8 c2, r_8 ch, r_8 ch2, r_8 wa)
7161	{
7162	/* Initialized data */
7163
7164	static r_8 tpi = 6.28318530717959f;
7165
7166	/* System generated locals */
7167	int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
7168	c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
7169	i__1, i__2, i__3;
7170
7171	/* Builtin functions */
7172	/* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */
7173
7174	/* Local variables */
7175	static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
7176	static r_8 dc2, ai1, ai2, ar1, ar2, ds2;
7177	static int_4 nbd;
7178	static r_8 dcp, arg, dsp, ar1h, ar2h;
7179	static int_4 idp2, ipp2;
7180
7181	/* Parameter adjustments */
7182	ch_dim1 = *ido;
7183	ch_dim2 = *l1;
7184	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7185	ch -= ch_offset;
7186	c1_dim1 = *ido;
7187	c1_dim2 = *l1;
7188	c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
7189	c1 -= c1_offset;
7190	cc_dim1 = *ido;
7191	cc_dim2 = *ip;
7192	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7193	cc -= cc_offset;
7194	ch2_dim1 = *idl1;
7195	ch2_offset = ch2_dim1 + 1;
7196	ch2 -= ch2_offset;
7197	c2_dim1 = *idl1;
7198	c2_offset = c2_dim1 + 1;
7199	c2 -= c2_offset;
7200	--wa;
7201
7202	/* Function Body */
7203	arg = tpi / (r_8) (*ip);
7204	dcp = cos(arg);
7205	dsp = sin(arg);
7206	idp2 = *ido + 2;
7207	nbd = (*ido - 1) / 2;
7208	ipp2 = *ip + 2;
7209	ipph = (*ip + 1) / 2;
7210	if (ido < l1) {
7211	goto L103;
7212	}
7213	i__1 = *l1;
7214	for (k = 1; k <= i__1; ++k) {
7215	i__2 = *ido;
7216	for (i__ = 1; i__ <= i__2; ++i__) {
7217	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
7218	cc_dim1];
7219	/* L101: */
7220	}
7221	/* L102: */
7222	}
7223	goto L106;
7224	L103:
7225	i__1 = *ido;
7226	for (i__ = 1; i__ <= i__1; ++i__) {
7227	i__2 = *l1;
7228	for (k = 1; k <= i__2; ++k) {
7229	ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) *
7230	cc_dim1];
7231	/* L104: */
7232	}
7233	/* L105: */
7234	}
7235	L106:
7236	i__1 = ipph;
7237	for (j = 2; j <= i__1; ++j) {
7238	jc = ipp2 - j;
7239	j2 = j + j;
7240	i__2 = *l1;
7241	for (k = 1; k <= i__2; ++k) {
7242	ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[ido + (j2 - 2 + k
7243	cc_dim2) * cc_dim1] + cc[ido + (j2 - 2 + k cc_dim2) *
7244	cc_dim1];
7245	ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
7246	cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
7247	/* L107: */
7248	}
7249	/* L108: */
7250	}
7251	if (*ido == 1) {
7252	goto L116;
7253	}
7254	if (nbd < *l1) {
7255	goto L112;
7256	}
7257	i__1 = ipph;
7258	for (j = 2; j <= i__1; ++j) {
7259	jc = ipp2 - j;
7260	i__2 = *l1;
7261	for (k = 1; k <= i__2; ++k) {
7262	i__3 = *ido;
7263	for (i__ = 3; i__ <= i__3; i__ += 2) {
7264	ic = idp2 - i__;
7265	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7266	<< 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
7267	<< 1) - 2 + k * cc_dim2) * cc_dim1];
7268	ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7269	<< 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
7270	<< 1) - 2 + k * cc_dim2) * cc_dim1];
7271	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7272	1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
7273	k * cc_dim2) * cc_dim1];
7274	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7275	1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
7276	k * cc_dim2) * cc_dim1];
7277	/* L109: */
7278	}
7279	/* L110: */
7280	}
7281	/* L111: */
7282	}
7283	goto L116;
7284	L112:
7285	i__1 = ipph;
7286	for (j = 2; j <= i__1; ++j) {
7287	jc = ipp2 - j;
7288	i__2 = *ido;
7289	for (i__ = 3; i__ <= i__2; i__ += 2) {
7290	ic = idp2 - i__;
7291	i__3 = *l1;
7292	for (k = 1; k <= i__3; ++k) {
7293	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7294	<< 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j
7295	<< 1) - 2 + k * cc_dim2) * cc_dim1];
7296	ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j
7297	<< 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j
7298	<< 1) - 2 + k * cc_dim2) * cc_dim1];
7299	ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7300	1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 +
7301	k * cc_dim2) * cc_dim1];
7302	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) -
7303	1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 +
7304	k * cc_dim2) * cc_dim1];
7305	/* L113: */
7306	}
7307	/* L114: */
7308	}
7309	/* L115: */
7310	}
7311	L116:
7312	ar1 = 1.f;
7313	ai1 = 0.f;
7314	i__1 = ipph;
7315	for (l = 2; l <= i__1; ++l) {
7316	lc = ipp2 - l;
7317	ar1h = dcp * ar1 - dsp * ai1;
7318	ai1 = dcp * ai1 + dsp * ar1;
7319	ar1 = ar1h;
7320	i__2 = *idl1;
7321	for (ik = 1; ik <= i__2; ++ik) {
7322	c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
7323	ch2_dim1 << 1)];
7324	c2[ik + lc * c2_dim1] = ai1 * ch2[ik + ip ch2_dim1];
7325	/* L117: */
7326	}
7327	dc2 = ar1;
7328	ds2 = ai1;
7329	ar2 = ar1;
7330	ai2 = ai1;
7331	i__2 = ipph;
7332	for (j = 3; j <= i__2; ++j) {
7333	jc = ipp2 - j;
7334	ar2h = dc2 * ar2 - ds2 * ai2;
7335	ai2 = dc2 * ai2 + ds2 * ar2;
7336	ar2 = ar2h;
7337	i__3 = *idl1;
7338	for (ik = 1; ik <= i__3; ++ik) {
7339	c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
7340	c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
7341	/* L118: */
7342	}
7343	/* L119: */
7344	}
7345	/* L120: */
7346	}
7347	i__1 = ipph;
7348	for (j = 2; j <= i__1; ++j) {
7349	i__2 = *idl1;
7350	for (ik = 1; ik <= i__2; ++ik) {
7351	ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
7352	/* L121: */
7353	}
7354	/* L122: */
7355	}
7356	i__1 = ipph;
7357	for (j = 2; j <= i__1; ++j) {
7358	jc = ipp2 - j;
7359	i__2 = *l1;
7360	for (k = 1; k <= i__2; ++k) {
7361	ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7362	c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
7363	ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7364	c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
7365	/* L123: */
7366	}
7367	/* L124: */
7368	}
7369	if (*ido == 1) {
7370	goto L132;
7371	}
7372	if (nbd < *l1) {
7373	goto L128;
7374	}
7375	i__1 = ipph;
7376	for (j = 2; j <= i__1; ++j) {
7377	jc = ipp2 - j;
7378	i__2 = *l1;
7379	for (k = 1; k <= i__2; ++k) {
7380	i__3 = *ido;
7381	for (i__ = 3; i__ <= i__3; i__ += 2) {
7382	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
7383	j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
7384	* c1_dim1];
7385	ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
7386	+ j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
7387	c1_dim2) * c1_dim1];
7388	ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7389	c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
7390	* c1_dim1];
7391	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7392	c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
7393	* c1_dim1];
7394	/* L125: */
7395	}
7396	/* L126: */
7397	}
7398	/* L127: */
7399	}
7400	goto L132;
7401	L128:
7402	i__1 = ipph;
7403	for (j = 2; j <= i__1; ++j) {
7404	jc = ipp2 - j;
7405	i__2 = *ido;
7406	for (i__ = 3; i__ <= i__2; i__ += 2) {
7407	i__3 = *l1;
7408	for (k = 1; k <= i__3; ++k) {
7409	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k +
7410	j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2)
7411	* c1_dim1];
7412	ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k
7413	+ j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc *
7414	c1_dim2) * c1_dim1];
7415	ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7416	c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2)
7417	* c1_dim1];
7418	ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j *
7419	c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2)
7420	* c1_dim1];
7421	/* L129: */
7422	}
7423	/* L130: */
7424	}
7425	/* L131: */
7426	}
7427	L132:
7428	if (*ido == 1) {
7429	return 0;
7430	}
7431	i__1 = *idl1;
7432	for (ik = 1; ik <= i__1; ++ik) {
7433	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
7434	/* L133: */
7435	}
7436	i__1 = *ip;
7437	for (j = 2; j <= i__1; ++j) {
7438	i__2 = *l1;
7439	for (k = 1; k <= i__2; ++k) {
7440	c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
7441	ch_dim1 + 1];
7442	/* L134: */
7443	}
7444	/* L135: */
7445	}
7446	if (nbd > *l1) {
7447	goto L139;
7448	}
7449	is = -(*ido);
7450	i__1 = *ip;
7451	for (j = 2; j <= i__1; ++j) {
7452	is += *ido;
7453	idij = is;
7454	i__2 = *ido;
7455	for (i__ = 3; i__ <= i__2; i__ += 2) {
7456	idij += 2;
7457	i__3 = *l1;
7458	for (k = 1; k <= i__3; ++k) {
7459	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
7460	i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
7461	ch[i__ + (k + j * ch_dim2) * ch_dim1];
7462	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
7463	+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
7464	1 + (k + j * ch_dim2) * ch_dim1];
7465	/* L136: */
7466	}
7467	/* L137: */
7468	}
7469	/* L138: */
7470	}
7471	goto L143;
7472	L139:
7473	is = -(*ido);
7474	i__1 = *ip;
7475	for (j = 2; j <= i__1; ++j) {
7476	is += *ido;
7477	i__2 = *l1;
7478	for (k = 1; k <= i__2; ++k) {
7479	idij = is;
7480	i__3 = *ido;
7481	for (i__ = 3; i__ <= i__3; i__ += 2) {
7482	idij += 2;
7483	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
7484	i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] *
7485	ch[i__ + (k + j * ch_dim2) * ch_dim1];
7486	c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__
7487	+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ -
7488	1 + (k + j * ch_dim2) * ch_dim1];
7489	/* L140: */
7490	}
7491	/* L141: */
7492	}
7493	/* L142: */
7494	}
7495	L143:
7496	return 0;
7497	} /* dadbg_ */
7498
7499	/* ------ File dadf2.f ------ */
7500	/* Subroutine / int dadf2_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
7501	r_8 *wa1)
7502	{
7503	/* System generated locals */
7504	int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
7505
7506	/* Local variables */
7507	static int_4 i__, k, ic;
7508	static r_8 ti2, tr2;
7509	static int_4 idp2;
7510
7511	/* Parameter adjustments */
7512	ch_dim1 = *ido;
7513	ch_offset = ch_dim1 * 3 + 1;
7514	ch -= ch_offset;
7515	cc_dim1 = *ido;
7516	cc_dim2 = *l1;
7517	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7518	cc -= cc_offset;
7519	--wa1;
7520
7521	/* Function Body */
7522	i__1 = *l1;
7523	for (k = 1; k <= i__1; ++k) {
7524	ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7525	cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7526	ch[ido + ((k << 1) + 2) ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
7527	- cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7528	/* L101: */
7529	}
7530	if ((i__1 = *ido - 2) < 0) {
7531	goto L107;
7532	} else if (i__1 == 0) {
7533	goto L105;
7534	} else {
7535	goto L102;
7536	}
7537	L102:
7538	idp2 = *ido + 2;
7539	i__1 = *l1;
7540	for (k = 1; k <= i__1; ++k) {
7541	i__2 = *ido;
7542	for (i__ = 3; i__ <= i__2; i__ += 2) {
7543	ic = idp2 - i__;
7544	tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7545	+ wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7546	ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7547	wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7548	cc_dim1];
7549	ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7550	cc_dim1] + ti2;
7551	ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
7552	cc_dim1];
7553	ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k +
7554	cc_dim2) * cc_dim1] + tr2;
7555	ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
7556	* cc_dim1] - tr2;
7557	/* L103: */
7558	}
7559	/* L104: */
7560	}
7561	if (*ido % 2 == 1) {
7562	return 0;
7563	}
7564	L105:
7565	i__1 = *l1;
7566	for (k = 1; k <= i__1; ++k) {
7567	ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[ido + (k + (cc_dim2 << 1))
7568	cc_dim1];
7569	ch[ido + ((k << 1) + 1) ch_dim1] = cc[ido + (k + cc_dim2)
7570	cc_dim1];
7571	/* L106: */
7572	}
7573	L107:
7574	return 0;
7575	} /* dadf2_ */
7576
7577	/* ------ File dadf3.f ------ */
7578	/* Subroutine / int dadf3_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
7579	r_8 wa1, r_8 wa2)
7580	{
7581	/* Initialized data */
7582
7583	static r_8 taur = -.5f;
7584	static r_8 taui = .866025403784439f;
7585
7586	/* System generated locals */
7587	int_4 ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;
7588
7589	/* Local variables */
7590	static int_4 i__, k, ic;
7591	static r_8 ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
7592	static int_4 idp2;
7593
7594	/* Parameter adjustments */
7595	ch_dim1 = *ido;
7596	ch_offset = (ch_dim1 << 2) + 1;
7597	ch -= ch_offset;
7598	cc_dim1 = *ido;
7599	cc_dim2 = *l1;
7600	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7601	cc -= cc_offset;
7602	--wa1;
7603	--wa2;
7604
7605	/* Function Body */
7606	i__1 = *l1;
7607	for (k = 1; k <= i__1; ++k) {
7608	cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7609	cc_dim1 + 1];
7610	ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
7611	ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) *
7612	cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
7613	ch[ido + (k 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7614	taur * cr2;
7615	/* L101: */
7616	}
7617	if (*ido == 1) {
7618	return 0;
7619	}
7620	idp2 = *ido + 2;
7621	i__1 = *l1;
7622	for (k = 1; k <= i__1; ++k) {
7623	i__2 = *ido;
7624	for (i__ = 3; i__ <= i__2; i__ += 2) {
7625	ic = idp2 - i__;
7626	dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7627	+ wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7628	di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7629	wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7630	cc_dim1];
7631	dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7632	wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7633	di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7634	i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7635	cr2 = dr2 + dr3;
7636	ci2 = di2 + di3;
7637	ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
7638	cc_dim1] + cr2;
7639	ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7640	cc_dim1] + ci2;
7641	tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
7642	ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
7643	tr3 = taui * (di2 - di3);
7644	ti3 = taui * (dr3 - dr2);
7645	ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
7646	ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
7647	ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
7648	ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
7649	/* L102: */
7650	}
7651	/* L103: */
7652	}
7653	return 0;
7654	} /* dadf3_ */
7655
7656	/* ------ File dadf4.f ------ */
7657	/* Subroutine / int dadf4_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
7658	r_8 wa1, r_8 wa2, r_8 *wa3)
7659	{
7660	/* Initialized data */
7661
7662	static r_8 hsqt2 = .7071067811865475f;
7663
7664	/* System generated locals */
7665	int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
7666
7667	/* Local variables */
7668	static int_4 i__, k, ic;
7669	static r_8 ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
7670	tr3, tr4;
7671	static int_4 idp2;
7672
7673	/* Parameter adjustments */
7674	ch_dim1 = *ido;
7675	ch_offset = ch_dim1 * 5 + 1;
7676	ch -= ch_offset;
7677	cc_dim1 = *ido;
7678	cc_dim2 = *l1;
7679	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7680	cc -= cc_offset;
7681	--wa1;
7682	--wa2;
7683	--wa3;
7684
7685	/* Function Body */
7686	i__1 = *l1;
7687	for (k = 1; k <= i__1; ++k) {
7688	tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
7689	* cc_dim1 + 1];
7690	tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7691	cc_dim1 + 1];
7692	ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
7693	ch[ido + ((k << 2) + 4) ch_dim1] = tr2 - tr1;
7694	ch[ido + ((k << 2) + 2) ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1]
7695	- cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
7696	ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1
7697	+ 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
7698	/* L101: */
7699	}
7700	if ((i__1 = *ido - 2) < 0) {
7701	goto L107;
7702	} else if (i__1 == 0) {
7703	goto L105;
7704	} else {
7705	goto L102;
7706	}
7707	L102:
7708	idp2 = *ido + 2;
7709	i__1 = *l1;
7710	for (k = 1; k <= i__1; ++k) {
7711	i__2 = *ido;
7712	for (i__ = 3; i__ <= i__2; i__ += 2) {
7713	ic = idp2 - i__;
7714	cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7715	+ wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7716	ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7717	wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7718	cc_dim1];
7719	cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7720	wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7721	ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7722	i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7723	cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
7724	+ wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
7725	ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
7726	wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
7727	cc_dim1];
7728	tr1 = cr2 + cr4;
7729	tr4 = cr4 - cr2;
7730	ti1 = ci2 + ci4;
7731	ti4 = ci2 - ci4;
7732	ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
7733	ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
7734	tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
7735	tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
7736	ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
7737	ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
7738	ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
7739	ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
7740	ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
7741	ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
7742	ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
7743	ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
7744	/* L103: */
7745	}
7746	/* L104: */
7747	}
7748	if (*ido % 2 == 1) {
7749	return 0;
7750	}
7751	L105:
7752	i__1 = *l1;
7753	for (k = 1; k <= i__1; ++k) {
7754	ti1 = -hsqt2 * (cc[ido + (k + (cc_dim2 << 1)) cc_dim1] + cc[*ido +
7755	(k + (cc_dim2 << 2)) * cc_dim1]);
7756	tr1 = hsqt2 * (cc[ido + (k + (cc_dim2 << 1)) cc_dim1] - cc[*ido + (
7757	k + (cc_dim2 << 2)) * cc_dim1]);
7758	ch[ido + ((k << 2) + 1) ch_dim1] = tr1 + cc[ido + (k + cc_dim2)
7759	cc_dim1];
7760	ch[ido + ((k << 2) + 3) ch_dim1] = cc[ido + (k + cc_dim2)
7761	cc_dim1] - tr1;
7762	ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[ido + (k + cc_dim2 3) *
7763	cc_dim1];
7764	ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[ido + (k + cc_dim2 3) *
7765	cc_dim1];
7766	/* L106: */
7767	}
7768	L107:
7769	return 0;
7770	} /* dadf4_ */
7771
7772	/* ------ File dadf5.f ------ */
7773	/* Subroutine / int dadf5_(int_4 ido, int_4 l1, r_8 cc, r_8 *ch,
7774	r_8 wa1, r_8 wa2, r_8 wa3, r_8 wa4)
7775	{
7776	/* Initialized data */
7777
7778	static r_8 tr11 = .309016994374947f;
7779	static r_8 ti11 = .951056516295154f;
7780	static r_8 tr12 = -.809016994374947f;
7781	static r_8 ti12 = .587785252292473f;
7782
7783	/* System generated locals */
7784	int_4 cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;
7785
7786	/* Local variables */
7787	static int_4 i__, k, ic;
7788	static r_8 ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3,
7789	dr4, dr5, cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
7790	static int_4 idp2;
7791
7792	/* Parameter adjustments */
7793	ch_dim1 = *ido;
7794	ch_offset = ch_dim1 * 6 + 1;
7795	ch -= ch_offset;
7796	cc_dim1 = *ido;
7797	cc_dim2 = *l1;
7798	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7799	cc -= cc_offset;
7800	--wa1;
7801	--wa2;
7802	--wa3;
7803	--wa4;
7804
7805	/* Function Body */
7806	i__1 = *l1;
7807	for (k = 1; k <= i__1; ++k) {
7808	cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) *
7809	cc_dim1 + 1];
7810	ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) *
7811	cc_dim1 + 1];
7812	cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) *
7813	cc_dim1 + 1];
7814	ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) *
7815	cc_dim1 + 1];
7816	ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2
7817	+ cr3;
7818	ch[ido + (k 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7819	tr11 * cr2 + tr12 * cr3;
7820	ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
7821	ch[ido + (k 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] +
7822	tr12 * cr2 + tr11 * cr3;
7823	ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
7824	/* L101: */
7825	}
7826	if (*ido == 1) {
7827	return 0;
7828	}
7829	idp2 = *ido + 2;
7830	i__1 = *l1;
7831	for (k = 1; k <= i__1; ++k) {
7832	i__2 = *ido;
7833	for (i__ = 3; i__ <= i__2; i__ += 2) {
7834	ic = idp2 - i__;
7835	dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1]
7836	+ wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
7837	di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] -
7838	wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) *
7839	cc_dim1];
7840	dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] +
7841	wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
7842	di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
7843	i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
7844	dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1]
7845	+ wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
7846	di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] -
7847	wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) *
7848	cc_dim1];
7849	dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] +
7850	wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
7851	di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
7852	i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
7853	cr2 = dr2 + dr5;
7854	ci5 = dr5 - dr2;
7855	cr5 = di2 - di5;
7856	ci2 = di2 + di5;
7857	cr3 = dr3 + dr4;
7858	ci4 = dr4 - dr3;
7859	cr4 = di3 - di4;
7860	ci3 = di3 + di4;
7861	ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
7862	cc_dim1] + cr2 + cr3;
7863	ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) *
7864	cc_dim1] + ci2 + ci3;
7865	tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 *
7866	cr3;
7867	ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
7868	tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 *
7869	cr3;
7870	ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
7871	tr5 = ti11 * cr5 + ti12 * cr4;
7872	ti5 = ti11 * ci5 + ti12 * ci4;
7873	tr4 = ti12 * cr5 - ti11 * cr4;
7874	ti4 = ti12 * ci5 - ti11 * ci4;
7875	ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
7876	ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
7877	ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
7878	ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
7879	ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
7880	ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
7881	ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
7882	ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
7883	/* L102: */
7884	}
7885	/* L103: */
7886	}
7887	return 0;
7888	} /* dadf5_ */
7889
7890	/* ------ File dadfg.f ------ */
7891	/* Subroutine / int dadfg_(int_4 ido, int_4 ip, int_4 l1, int_4 *
7892	idl1, r_8 cc, r_8 c1, r_8 c2, r_8 ch, r_8 ch2, r_8 wa)
7893	{
7894	/* Initialized data */
7895
7896	static r_8 tpi = 6.28318530717959f;
7897
7898	/* System generated locals */
7899	int_4 ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
7900	c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset,
7901	i__1, i__2, i__3;
7902
7903	/* Builtin functions */
7904	/* r_8 cos(r_8truc), sin(r_8truc); */
7905
7906	/* Local variables */
7907	static int_4 idij, ipph, i__, j, k, l, j2, ic, jc, lc, ik, is;
7908	static r_8 dc2, ai1, ai2, ar1, ar2, ds2;
7909	static int_4 nbd;
7910	static r_8 dcp, arg, dsp, ar1h, ar2h;
7911	static int_4 idp2, ipp2;
7912
7913	/* Parameter adjustments */
7914	ch_dim1 = *ido;
7915	ch_dim2 = *l1;
7916	ch_offset = ch_dim1 * (ch_dim2 + 1) + 1;
7917	ch -= ch_offset;
7918	c1_dim1 = *ido;
7919	c1_dim2 = *l1;
7920	c1_offset = c1_dim1 * (c1_dim2 + 1) + 1;
7921	c1 -= c1_offset;
7922	cc_dim1 = *ido;
7923	cc_dim2 = *ip;
7924	cc_offset = cc_dim1 * (cc_dim2 + 1) + 1;
7925	cc -= cc_offset;
7926	ch2_dim1 = *idl1;
7927	ch2_offset = ch2_dim1 + 1;
7928	ch2 -= ch2_offset;
7929	c2_dim1 = *idl1;
7930	c2_offset = c2_dim1 + 1;
7931	c2 -= c2_offset;
7932	--wa;
7933
7934	/* Function Body */
7935	arg = tpi / (r_8) (*ip);
7936	dcp = cos(arg);
7937	dsp = sin(arg);
7938	ipph = (*ip + 1) / 2;
7939	ipp2 = *ip + 2;
7940	idp2 = *ido + 2;
7941	nbd = (*ido - 1) / 2;
7942	if (*ido == 1) {
7943	goto L119;
7944	}
7945	i__1 = *idl1;
7946	for (ik = 1; ik <= i__1; ++ik) {
7947	ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
7948	/* L101: */
7949	}
7950	i__1 = *ip;
7951	for (j = 2; j <= i__1; ++j) {
7952	i__2 = *l1;
7953	for (k = 1; k <= i__2; ++k) {
7954	ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) *
7955	c1_dim1 + 1];
7956	/* L102: */
7957	}
7958	/* L103: */
7959	}
7960	if (nbd > *l1) {
7961	goto L107;
7962	}
7963	is = -(*ido);
7964	i__1 = *ip;
7965	for (j = 2; j <= i__1; ++j) {
7966	is += *ido;
7967	idij = is;
7968	i__2 = *ido;
7969	for (i__ = 3; i__ <= i__2; i__ += 2) {
7970	idij += 2;
7971	i__3 = *l1;
7972	for (k = 1; k <= i__3; ++k) {
7973	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
7974	i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
7975	c1[i__ + (k + j * c1_dim2) * c1_dim1];
7976	ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
7977	+ (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
7978	1 + (k + j * c1_dim2) * c1_dim1];
7979	/* L104: */
7980	}
7981	/* L105: */
7982	}
7983	/* L106: */
7984	}
7985	goto L111;
7986	L107:
7987	is = -(*ido);
7988	i__1 = *ip;
7989	for (j = 2; j <= i__1; ++j) {
7990	is += *ido;
7991	i__2 = *l1;
7992	for (k = 1; k <= i__2; ++k) {
7993	idij = is;
7994	i__3 = *ido;
7995	for (i__ = 3; i__ <= i__3; i__ += 2) {
7996	idij += 2;
7997	ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
7998	i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] *
7999	c1[i__ + (k + j * c1_dim2) * c1_dim1];
8000	ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__
8001	+ (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ -
8002	1 + (k + j * c1_dim2) * c1_dim1];
8003	/* L108: */
8004	}
8005	/* L109: */
8006	}
8007	/* L110: */
8008	}
8009	L111:
8010	if (nbd < *l1) {
8011	goto L115;
8012	}
8013	i__1 = ipph;
8014	for (j = 2; j <= i__1; ++j) {
8015	jc = ipp2 - j;
8016	i__2 = *l1;
8017	for (k = 1; k <= i__2; ++k) {
8018	i__3 = *ido;
8019	for (i__ = 3; i__ <= i__3; i__ += 2) {
8020	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
8021	j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8022	ch_dim2) * ch_dim1];
8023	c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8024	ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
8025	ch_dim1];
8026	c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8027	ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8028	ch_dim1];
8029	c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
8030	* ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
8031	* ch_dim1];
8032	/* L112: */
8033	}
8034	/* L113: */
8035	}
8036	/* L114: */
8037	}
8038	goto L121;
8039	L115:
8040	i__1 = ipph;
8041	for (j = 2; j <= i__1; ++j) {
8042	jc = ipp2 - j;
8043	i__2 = *ido;
8044	for (i__ = 3; i__ <= i__2; i__ += 2) {
8045	i__3 = *l1;
8046	for (k = 1; k <= i__3; ++k) {
8047	c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k +
8048	j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8049	ch_dim2) * ch_dim1];
8050	c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8051	ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) *
8052	ch_dim1];
8053	c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
8054	ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8055	ch_dim1];
8056	c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc
8057	* ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
8058	* ch_dim1];
8059	/* L116: */
8060	}
8061	/* L117: */
8062	}
8063	/* L118: */
8064	}
8065	goto L121;
8066	L119:
8067	i__1 = *idl1;
8068	for (ik = 1; ik <= i__1; ++ik) {
8069	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
8070	/* L120: */
8071	}
8072	L121:
8073	i__1 = ipph;
8074	for (j = 2; j <= i__1; ++j) {
8075	jc = ipp2 - j;
8076	i__2 = *l1;
8077	for (k = 1; k <= i__2; ++k) {
8078	c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) *
8079	ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
8080	c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) *
8081	ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
8082	/* L122: */
8083	}
8084	/* L123: */
8085	}
8086
8087	ar1 = 1.f;
8088	ai1 = 0.f;
8089	i__1 = ipph;
8090	for (l = 2; l <= i__1; ++l) {
8091	lc = ipp2 - l;
8092	ar1h = dcp * ar1 - dsp * ai1;
8093	ai1 = dcp * ai1 + dsp * ar1;
8094	ar1 = ar1h;
8095	i__2 = *idl1;
8096	for (ik = 1; ik <= i__2; ++ik) {
8097	ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
8098	c2_dim1 << 1)];
8099	ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + ip c2_dim1];
8100	/* L124: */
8101	}
8102	dc2 = ar1;
8103	ds2 = ai1;
8104	ar2 = ar1;
8105	ai2 = ai1;
8106	i__2 = ipph;
8107	for (j = 3; j <= i__2; ++j) {
8108	jc = ipp2 - j;
8109	ar2h = dc2 * ar2 - ds2 * ai2;
8110	ai2 = dc2 * ai2 + ds2 * ar2;
8111	ar2 = ar2h;
8112	i__3 = *idl1;
8113	for (ik = 1; ik <= i__3; ++ik) {
8114	ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
8115	ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
8116	/* L125: */
8117	}
8118	/* L126: */
8119	}
8120	/* L127: */
8121	}
8122	i__1 = ipph;
8123	for (j = 2; j <= i__1; ++j) {
8124	i__2 = *idl1;
8125	for (ik = 1; ik <= i__2; ++ik) {
8126	ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
8127	/* L128: */
8128	}
8129	/* L129: */
8130	}
8131
8132	if (ido < l1) {
8133	goto L132;
8134	}
8135	i__1 = *l1;
8136	for (k = 1; k <= i__1; ++k) {
8137	i__2 = *ido;
8138	for (i__ = 1; i__ <= i__2; ++i__) {
8139	cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
8140	ch_dim1];
8141	/* L130: */
8142	}
8143	/* L131: */
8144	}
8145	goto L135;
8146	L132:
8147	i__1 = *ido;
8148	for (i__ = 1; i__ <= i__1; ++i__) {
8149	i__2 = *l1;
8150	for (k = 1; k <= i__2; ++k) {
8151	cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) *
8152	ch_dim1];
8153	/* L133: */
8154	}
8155	/* L134: */
8156	}
8157	L135:
8158	i__1 = ipph;
8159	for (j = 2; j <= i__1; ++j) {
8160	jc = ipp2 - j;
8161	j2 = j + j;
8162	i__2 = *l1;
8163	for (k = 1; k <= i__2; ++k) {
8164	cc[ido + (j2 - 2 + k cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
8165	* ch_dim1 + 1];
8166	cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
8167	ch_dim1 + 1];
8168	/* L136: */
8169	}
8170	/* L137: */
8171	}
8172	if (*ido == 1) {
8173	return 0;
8174	}
8175	if (nbd < *l1) {
8176	goto L141;
8177	}
8178	i__1 = ipph;
8179	for (j = 2; j <= i__1; ++j) {
8180	jc = ipp2 - j;
8181	j2 = j + j;
8182	i__2 = *l1;
8183	for (k = 1; k <= i__2; ++k) {
8184	i__3 = *ido;
8185	for (i__ = 3; i__ <= i__3; i__ += 2) {
8186	ic = idp2 - i__;
8187	cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
8188	(k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8189	ch_dim2) * ch_dim1];
8190	cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
8191	k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
8192	ch_dim2) * ch_dim1];
8193	cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
8194	ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8195	ch_dim1];
8196	cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
8197	ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
8198	ch_dim1];
8199	/* L138: */
8200	}
8201	/* L139: */
8202	}
8203	/* L140: */
8204	}
8205	return 0;
8206	L141:
8207	i__1 = ipph;
8208	for (j = 2; j <= i__1; ++j) {
8209	jc = ipp2 - j;
8210	j2 = j + j;
8211	i__2 = *ido;
8212	for (i__ = 3; i__ <= i__2; i__ += 2) {
8213	ic = idp2 - i__;
8214	i__3 = *l1;
8215	for (k = 1; k <= i__3; ++k) {
8216	cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 +
8217	(k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc *
8218	ch_dim2) * ch_dim1];
8219	cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
8220	k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc *
8221	ch_dim2) * ch_dim1];
8222	cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
8223	ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) *
8224	ch_dim1];
8225	cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
8226	ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) *
8227	ch_dim1];
8228	/* L142: */
8229	}
8230	/* L143: */
8231	}
8232	/* L144: */
8233	}
8234	return 0;
8235	} /* dadfg_ */
8236
8237	/* ------ File dfftb.f ------ */
8238	/* Subroutine / int dfftb_(int_4 n, r_8 r__, r_8 wsave)
8239	{
8240	extern /* Subroutine / int dfftb1_(int_4 , r_8 , r_8 , r_8 *,
8241	int_8 *);
8242
8243	/* Parameter adjustments */
8244	--wsave;
8245	--r__;
8246
8247	/* Function Body */
8248	if (*n == 1) {
8249	return 0;
8250	}
8251	dfftb1_(n, &r__[1], &wsave[1], &wsave[n + 1], (int_8 )&wsave[(n << 1) + 1]); / (int ) rajoute Reza 29/11/99 /
8252	return 0;
8253	} /* dfftb_ */
8254
8255	/* ------ File dfftb1.f ------ */
8256	/* Subroutine / int dfftb1_(int_4 n, r_8 c__, r_8 ch, r_8 *wa,
8257	int_8 *ifac)
8258	{
8259	/* System generated locals */
8260	int_4 i__1;
8261
8262	/* Local variables */
8263	extern /* Subroutine / int dadb2_(int_4 , int_4 , r_8 , r_8 *,
8264	r_8 ), dadb3_(int_4 , int_4 , r_8 , r_8 , r_8 ,
8265	r_8 ), dadb4_(int_4 , int_4 , r_8 , r_8 , r_8 ,
8266	r_8 , r_8 ), dadb5_(int_4 , int_4 , r_8 , r_8 ,
8267	r_8 , r_8 , r_8 , r_8 );
8268	static int_4 i__;
8269	extern /* Subroutine / int dadbg_(int_4 , int_4 , int_4 ,
8270	int_4 , r_8 , r_8 , r_8 , r_8 , r_8 , r_8 *);
8271	static int_4 k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
8272
8273	/* Parameter adjustments */
8274	--ifac;
8275	--wa;
8276	--ch;
8277	--c__;
8278
8279	/* Function Body */
8280	nf = ifac[2];
8281	na = 0;
8282	l1 = 1;
8283	iw = 1;
8284	i__1 = nf;
8285	for (k1 = 1; k1 <= i__1; ++k1) {
8286	ip = ifac[k1 + 2];
8287	l2 = ip * l1;
8288	ido = *n / l2;
8289	idl1 = ido * l1;
8290	if (ip != 4) {
8291	goto L103;
8292	}
8293	ix2 = iw + ido;
8294	ix3 = ix2 + ido;
8295	if (na != 0) {
8296	goto L101;
8297	}
8298	dadb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
8299	goto L102;
8300	L101:
8301	dadb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
8302	L102:
8303	na = 1 - na;
8304	goto L115;
8305	L103:
8306	if (ip != 2) {
8307	goto L106;
8308	}
8309	if (na != 0) {
8310	goto L104;
8311	}
8312	dadb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
8313	goto L105;
8314	L104:
8315	dadb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
8316	L105:
8317	na = 1 - na;
8318	goto L115;
8319	L106:
8320	if (ip != 3) {
8321	goto L109;
8322	}
8323	ix2 = iw + ido;
8324	if (na != 0) {
8325	goto L107;
8326	}
8327	dadb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
8328	goto L108;
8329	L107:
8330	dadb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
8331	L108:
8332	na = 1 - na;
8333	goto L115;
8334	L109:
8335	if (ip != 5) {
8336	goto L112;
8337	}
8338	ix2 = iw + ido;
8339	ix3 = ix2 + ido;
8340	ix4 = ix3 + ido;
8341	if (na != 0) {
8342	goto L110;
8343	}
8344	dadb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8345	ix4]);
8346	goto L111;
8347	L110:
8348	dadb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8349	ix4]);
8350	L111:
8351	na = 1 - na;
8352	goto L115;
8353	L112:
8354	if (na != 0) {
8355	goto L113;
8356	}
8357	dadbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
8358	1], &wa[iw]);
8359	goto L114;
8360	L113:
8361	dadbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
8362	, &wa[iw]);
8363	L114:
8364	if (ido == 1) {
8365	na = 1 - na;
8366	}
8367	L115:
8368	l1 = l2;
8369	iw += (ip - 1) * ido;
8370	/* L116: */
8371	}
8372	if (na == 0) {
8373	return 0;
8374	}
8375	i__1 = *n;
8376	for (i__ = 1; i__ <= i__1; ++i__) {
8377	c__[i__] = ch[i__];
8378	/* L117: */
8379	}
8380	return 0;
8381	} /* dfftb1_ */
8382
8383	/* ------ File dfftf.f ------ */
8384	/* Subroutine / int dfftf_(int_4 n, r_8 r__, r_8 wsave)
8385	{
8386	extern /* Subroutine / int dfftf1_(int_4 , r_8 , r_8 , r_8 *,
8387	int_8 *);
8388
8389	/* Parameter adjustments */
8390	--wsave;
8391	--r__;
8392
8393	/* Function Body */
8394	if (*n == 1) {
8395	return 0;
8396	}
8397	dfftf1_(n, &r__[1], &wsave[1], &wsave[n + 1], (int_8 )&wsave[(n << 1) + 1]);/ (int ) rajoute Reza 29/11/99 /
8398	return 0;
8399	} /* dfftf_ */
8400
8401	/* ------ File dfftf1.f ------ */
8402	/* Subroutine / int dfftf1_(int_4 n, r_8 c__, r_8 ch, r_8 *wa,
8403	int_8 *ifac)
8404	{
8405	/* System generated locals */
8406	int_4 i__1;
8407
8408	/* Local variables */
8409	extern /* Subroutine / int dadf2_(int_4 , int_4 , r_8 , r_8 *,
8410	r_8 ), dadf3_(int_4 , int_4 , r_8 , r_8 , r_8 ,
8411	r_8 ), dadf4_(int_4 , int_4 , r_8 , r_8 , r_8 ,
8412	r_8 , r_8 ), dadf5_(int_4 , int_4 , r_8 , r_8 ,
8413	r_8 , r_8 , r_8 , r_8 );
8414	static int_4 i__;
8415	extern /* Subroutine / int dadfg_(int_4 , int_4 , int_4 ,
8416	int_4 , r_8 , r_8 , r_8 , r_8 , r_8 , r_8 *);
8417	static int_4 k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
8418
8419	/* Parameter adjustments */
8420	--ifac;
8421	--wa;
8422	--ch;
8423	--c__;
8424
8425	/* Function Body */
8426	nf = ifac[2];
8427	na = 1;
8428	l2 = *n;
8429	iw = *n;
8430	i__1 = nf;
8431	for (k1 = 1; k1 <= i__1; ++k1) {
8432	kh = nf - k1;
8433	ip = ifac[kh + 3];
8434	l1 = l2 / ip;
8435	ido = *n / l2;
8436	idl1 = ido * l1;
8437	iw -= (ip - 1) * ido;
8438	na = 1 - na;
8439	if (ip != 4) {
8440	goto L102;
8441	}
8442	ix2 = iw + ido;
8443	ix3 = ix2 + ido;
8444	if (na != 0) {
8445	goto L101;
8446	}
8447	dadf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
8448	goto L110;
8449	L101:
8450	dadf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
8451	goto L110;
8452	L102:
8453	if (ip != 2) {
8454	goto L104;
8455	}
8456	if (na != 0) {
8457	goto L103;
8458	}
8459	dadf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
8460	goto L110;
8461	L103:
8462	dadf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
8463	goto L110;
8464	L104:
8465	if (ip != 3) {
8466	goto L106;
8467	}
8468	ix2 = iw + ido;
8469	if (na != 0) {
8470	goto L105;
8471	}
8472	dadf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
8473	goto L110;
8474	L105:
8475	dadf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
8476	goto L110;
8477	L106:
8478	if (ip != 5) {
8479	goto L108;
8480	}
8481	ix2 = iw + ido;
8482	ix3 = ix2 + ido;
8483	ix4 = ix3 + ido;
8484	if (na != 0) {
8485	goto L107;
8486	}
8487	dadf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8488	ix4]);
8489	goto L110;
8490	L107:
8491	dadf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
8492	ix4]);
8493	goto L110;
8494	L108:
8495	if (ido == 1) {
8496	na = 1 - na;
8497	}
8498	if (na != 0) {
8499	goto L109;
8500	}
8501	dadfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
8502	1], &wa[iw]);
8503	na = 1;
8504	goto L110;
8505	L109:
8506	dadfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
8507	, &wa[iw]);
8508	na = 0;
8509	L110:
8510	l2 = l1;
8511	/* L111: */
8512	}
8513	if (na == 1) {
8514	return 0;
8515	}
8516	i__1 = *n;
8517	for (i__ = 1; i__ <= i__1; ++i__) {
8518	c__[i__] = ch[i__];
8519	/* L112: */
8520	}
8521	return 0;
8522	} /* dfftf1_ */
8523
8524	/* ------ File dffti.f ------ */
8525	/* Subroutine / int dffti_(int_4 n, r_8 *wsave)
8526	{
8527	extern /* Subroutine / int dffti1_(int_4 , r_8 , int_8 );
8528
8529	/* Parameter adjustments */
8530	--wsave;
8531
8532	/* Function Body */
8533	if (*n == 1) {
8534	return 0;
8535	}
8536	dffti1_(n, &wsave[n + 1], (int_8 )&wsave[(n << 1) + 1]); / (int ) rajoute Reza 29/11/99 /
8537	return 0;
8538	} /* dffti_ */
8539
8540	/* ------ File dffti1.f ------ */
8541	/* Subroutine / int dffti1_(int_4 n, r_8 wa, int_8 ifac)
8542	{
8543	/* Initialized data */
8544
8545	static int_4 ntryh[4] = { 4,2,3,5 };
8546
8547	/* System generated locals */
8548	int_4 i__1, i__2, i__3;
8549
8550	/* Builtin functions */
8551	/* r_8 cos(r_8truc), sin(r_8truc); remplace par math.h Reza 29/11/99 */
8552
8553	/* Local variables */
8554	static r_8 argh;
8555	static int_4 ntry, i__, j;
8556	static r_8 argld;
8557	static int_4 k1, l1, l2, ib;
8558	static r_8 fi;
8559	static int_4 ld, ii, nf, ip, nl, is, nq, nr;
8560	static r_8 arg;
8561	static int_4 ido, ipm;
8562	static r_8 tpi;
8563	static int_4 nfm1;
8564
8565	/* Parameter adjustments */
8566	--ifac;
8567	--wa;
8568
8569	/* Function Body */
8570	nl = *n;
8571	nf = 0;
8572	j = 0;
8573	L101:
8574	++j;
8575	if (j - 4 <= 0) {
8576	goto L102;
8577	} else {
8578	goto L103;
8579	}
8580	L102:
8581	ntry = ntryh[j - 1];
8582	goto L104;
8583	L103:
8584	ntry += 2;
8585	L104:
8586	nq = nl / ntry;
8587	nr = nl - ntry * nq;
8588	if (nr != 0) {
8589	goto L101;
8590	} else {
8591	goto L105;
8592	}
8593	L105:
8594	++nf;
8595	ifac[nf + 2] = ntry;
8596	nl = nq;
8597	if (ntry != 2) {
8598	goto L107;
8599	}
8600	if (nf == 1) {
8601	goto L107;
8602	}
8603	i__1 = nf;
8604	for (i__ = 2; i__ <= i__1; ++i__) {
8605	ib = nf - i__ + 2;
8606	ifac[ib + 2] = ifac[ib + 1];
8607	/* L106: */
8608	}
8609	ifac[3] = 2;
8610	L107:
8611	if (nl != 1) {
8612	goto L104;
8613	}
8614	ifac[1] = *n;
8615	ifac[2] = nf;
8616	tpi = 6.28318530717959f;
8617	argh = tpi / (r_8) (*n);
8618	is = 0;
8619	nfm1 = nf - 1;
8620	l1 = 1;
8621	if (nfm1 == 0) {
8622	return 0;
8623	}
8624	i__1 = nfm1;
8625	for (k1 = 1; k1 <= i__1; ++k1) {
8626	ip = ifac[k1 + 2];
8627	ld = 0;
8628	l2 = l1 * ip;
8629	ido = *n / l2;
8630	ipm = ip - 1;
8631	i__2 = ipm;
8632	for (j = 1; j <= i__2; ++j) {
8633	ld += l1;
8634	i__ = is;
8635	argld = (r_8) ld * argh;
8636	fi = 0.f;
8637	i__3 = ido;
8638	for (ii = 3; ii <= i__3; ii += 2) {
8639	i__ += 2;
8640	fi += 1.f;
8641	arg = fi * argld;
8642	wa[i__ - 1] = cos(arg);
8643	wa[i__] = sin(arg);
8644	/* L108: */
8645	}
8646	is += ido;
8647	/* L109: */
8648	}
8649	l1 = l2;
8650	/* L110: */
8651	}
8652	return 0;
8653	} /* dffti1_ */
8654
8655	/* ------ File dsinqb.f ------ */
8656	/* Subroutine / int dsinqb_(int_4 n, r_8 x, r_8 wsave)
8657	{
8658	/* System generated locals */
8659	int_4 i__1;
8660
8661	/* Local variables */
8662	static int_4 k;
8663	extern /* Subroutine / int dcosqb_(int_4 , r_8 , r_8 );
8664	static r_8 xhold;
8665	static int_4 kc, ns2;
8666
8667	/* Parameter adjustments */
8668	--wsave;
8669	--x;
8670
8671	/* Function Body */
8672	if (*n > 1) {
8673	goto L101;
8674	}
8675	x[1] *= 4.f;
8676	return 0;
8677	L101:
8678	ns2 = *n / 2;
8679	i__1 = *n;
8680	for (k = 2; k <= i__1; k += 2) {
8681	x[k] = -x[k];
8682	/* L102: */
8683	}
8684	dcosqb_(n, &x[1], &wsave[1]);
8685	i__1 = ns2;
8686	for (k = 1; k <= i__1; ++k) {
8687	kc = *n - k;
8688	xhold = x[k];
8689	x[k] = x[kc + 1];
8690	x[kc + 1] = xhold;
8691	/* L103: */
8692	}
8693	return 0;
8694	} /* dsinqb_ */
8695
8696	/* ------ File dsinqf.f ------ */
8697	/* Subroutine / int dsinqf_(int_4 n, r_8 x, r_8 wsave)
8698	{
8699	/* System generated locals */
8700	int_4 i__1;
8701
8702	/* Local variables */
8703	static int_4 k;
8704	extern /* Subroutine / int dcosqf_(int_4 , r_8 , r_8 );
8705	static r_8 xhold;
8706	static int_4 kc, ns2;
8707
8708	/* Parameter adjustments */
8709	--wsave;
8710	--x;
8711
8712	/* Function Body */
8713	if (*n == 1) {
8714	return 0;
8715	}
8716	ns2 = *n / 2;
8717	i__1 = ns2;
8718	for (k = 1; k <= i__1; ++k) {
8719	kc = *n - k;
8720	xhold = x[k];
8721	x[k] = x[kc + 1];
8722	x[kc + 1] = xhold;
8723	/* L101: */
8724	}
8725	dcosqf_(n, &x[1], &wsave[1]);
8726	i__1 = *n;
8727	for (k = 2; k <= i__1; k += 2) {
8728	x[k] = -x[k];
8729	/* L102: */
8730	}
8731	return 0;
8732	} /* dsinqf_ */
8733
8734	/* ------ File dsinqi.f ------ */
8735	/* Subroutine / int dsinqi_(int_4 n, r_8 *wsave)
8736	{
8737	extern /* Subroutine / int dcosqi_(int_4 , r_8 *);
8738
8739	/* Parameter adjustments */
8740	--wsave;
8741
8742	/* Function Body */
8743	dcosqi_(n, &wsave[1]);
8744	return 0;
8745	} /* dsinqi_ */
8746
8747	/* ------ File dsint.f ------ */
8748	/* Subroutine / int dsint_(int_4 n, r_8 x, r_8 wsave)
8749	{
8750	extern /* Subroutine / int dsint1_(int_4 , r_8 , r_8 , r_8 *,
8751	r_8 , int_8 );
8752	static int_4 np1, iw1, iw2, iw3;
8753
8754	/* Parameter adjustments */
8755	--wsave;
8756	--x;
8757
8758	/* Function Body */
8759	np1 = *n + 1;
8760	iw1 = *n / 2 + 1;
8761	iw2 = iw1 + np1;
8762	iw3 = iw2 + np1;
8763	dsint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], (int_8 ) &wsave[iw3]); / (int ) rajoute Reza 29/11/99 /
8764	return 0;
8765	} /* dsint_ */
8766
8767	/* ------ File dsint1.f ------ */
8768	/* Subroutine / int dsint1_(int_4 n, r_8 war, r_8 was, r_8 xh, r_8
8769	x, int_8 *ifac)
8770	{
8771	/* Initialized data */
8772
8773	static r_8 sqrt3 = 1.73205080756888f;
8774
8775	/* System generated locals */
8776	int_4 i__1;
8777
8778	/* Local variables */
8779	static int_4 modn, i__, k;
8780	static r_8 xhold, t1, t2;
8781	extern /* Subroutine / int dfftf1_(int_4 , r_8 , r_8 , r_8 *,
8782	int_8 *);
8783	static int_4 kc, np1, ns2;
8784
8785	/* Parameter adjustments */
8786	--ifac;
8787	--x;
8788	--xh;
8789	--was;
8790	--war;
8791
8792	/* Function Body */
8793	i__1 = *n;
8794	for (i__ = 1; i__ <= i__1; ++i__) {
8795	xh[i__] = war[i__];
8796	war[i__] = x[i__];
8797	/* L100: */
8798	}
8799	if ((i__1 = *n - 2) < 0) {
8800	goto L101;
8801	} else if (i__1 == 0) {
8802	goto L102;
8803	} else {
8804	goto L103;
8805	}
8806	L101:
8807	xh[1] += xh[1];
8808	goto L106;
8809	L102:
8810	xhold = sqrt3 * (xh[1] + xh[2]);
8811	xh[2] = sqrt3 * (xh[1] - xh[2]);
8812	xh[1] = xhold;
8813	goto L106;
8814	L103:
8815	np1 = *n + 1;
8816	ns2 = *n / 2;
8817	x[1] = 0.f;
8818	i__1 = ns2;
8819	for (k = 1; k <= i__1; ++k) {
8820	kc = np1 - k;
8821	t1 = xh[k] - xh[kc];
8822	t2 = was[k] * (xh[k] + xh[kc]);
8823	x[k + 1] = t1 + t2;
8824	x[kc + 1] = t2 - t1;
8825	/* L104: */
8826	}
8827	modn = *n % 2;
8828	if (modn != 0) {
8829	x[ns2 + 2] = xh[ns2 + 1] * 4.f;
8830	}
8831	dfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
8832	xh[1] = x[1] * .5f;
8833	i__1 = *n;
8834	for (i__ = 3; i__ <= i__1; i__ += 2) {
8835	xh[i__ - 1] = -x[i__];
8836	xh[i__] = xh[i__ - 2] + x[i__ - 1];
8837	/* L105: */
8838	}
8839	if (modn != 0) {
8840	goto L106;
8841	}
8842	xh[n] = -x[n + 1];
8843	L106:
8844	i__1 = *n;
8845	for (i__ = 1; i__ <= i__1; ++i__) {
8846	x[i__] = war[i__];
8847	war[i__] = xh[i__];
8848	/* L107: */
8849	}
8850	return 0;
8851	} /* dsint1_ */
8852
8853	/* ------ File dsinti.f ------ */
8854	/* Subroutine / int dsinti_(int_4 n, r_8 *wsave)
8855	{
8856	/* Initialized data */
8857
8858	static r_8 pi = 3.14159265358979f;
8859
8860	/* System generated locals */
8861	int_4 i__1;
8862
8863	/* Builtin functions */
8864	/* r_8 sin(r_8truc); remplace par math.h Reza 29/11/99 */
8865
8866	/* Local variables */
8867	static int_4 k;
8868	extern /* Subroutine / int dffti_(int_4 , r_8 *);
8869	static r_8 dt;
8870	static int_4 np1, ns2;
8871
8872	/* Parameter adjustments */
8873	--wsave;
8874
8875	/* Function Body */
8876	if (*n <= 1) {
8877	return 0;
8878	}
8879	ns2 = *n / 2;
8880	np1 = *n + 1;
8881	dt = pi / (r_8) np1;
8882	i__1 = ns2;
8883	for (k = 1; k <= i__1; ++k) {
8884	wsave[k] = sin(k * dt) * 2.f;
8885	/* L101: */
8886	}
8887	dffti_(&np1, &wsave[ns2 + 1]);
8888	return 0;
8889	} /* dsinti_ */
8890

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: