PLaSK library
Loading...
Searching...
No Matches
c1f5kf.c
Go to the documentation of this file.
1/* c1f5kf.f -- translated by f2c (version 20100827).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11*/
12
13#include "f2c.h"
14
15/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
16/* * * */
17/* * copyright (c) 2011 by UCAR * */
18/* * * */
19/* * University Corporation for Atmospheric Research * */
20/* * * */
21/* * all rights reserved * */
22/* * * */
23/* * FFTPACK version 5.1 * */
24/* * * */
25/* * A Fortran Package of Fast Fourier * */
26/* * * */
27/* * Subroutines and Example Programs * */
28/* * * */
29/* * by * */
30/* * * */
31/* * Paul Swarztrauber and Dick Valent * */
32/* * * */
33/* * of * */
34/* * * */
35/* * the National Center for Atmospheric Research * */
36/* * * */
37/* * Boulder, Colorado (80307) U.S.A. * */
38/* * * */
39/* * which is sponsored by * */
40/* * * */
41/* * the National Science Foundation * */
42/* * * */
43/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
44
45/* Subroutine */ int c1f5kf_(integer *ido, integer *l1, integer *na,
46 doublereal *cc, integer *in1, doublereal *ch, integer *in2,
47 doublereal *wa)
48{
49 /* Initialized data */
50
51 static doublereal tr11 = .3090169943749474;
52 static doublereal ti11 = -.9510565162951536;
53 static doublereal tr12 = -.8090169943749474;
54 static doublereal ti12 = -.5877852522924731;
55
56 /* System generated locals */
57 integer cc_dim1, cc_dim2, cc_dim3, cc_offset, ch_dim1, ch_dim2, ch_offset,
58 wa_dim1, wa_offset, i__1, i__2;
59
60 /* Local variables */
61 integer i__, k;
62 doublereal sn, ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4,
63 dr3, dr4, ti2, ti3, ti4, ti5, dr5, dr2, tr2, tr3, tr4, tr5,
64 chold1, chold2;
65
66 /* Parameter adjustments */
67 wa_dim1 = *ido;
68 wa_offset = 1 + wa_dim1 * 5;
69 wa -= wa_offset;
70 cc_dim1 = *in1;
71 cc_dim2 = *l1;
72 cc_dim3 = *ido;
73 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
74 cc -= cc_offset;
75 ch_dim1 = *in2;
76 ch_dim2 = *l1;
77 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * 6);
78 ch -= ch_offset;
79
80 /* Function Body */
81
82/* FFTPACK 5.1 auxiliary routine */
83
84 if (*ido > 1) {
85 goto L102;
86 }
87 sn = 1. / (doublereal) (*l1 * 5);
88 if (*na == 1) {
89 goto L106;
90 }
91 i__1 = *l1;
92 for (k = 1; k <= i__1; ++k) {
93 ti5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
94 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
95 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
96 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
97 ti4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + ((
98 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
99 ti3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + ((
100 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
101 tr5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
102 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
103 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
104 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
105 tr4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + ((
106 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
107 tr3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + ((
108 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
109 chold1 = sn * (cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr2
110 + tr3);
111 chold2 = sn * (cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + ti2
112 + ti3);
113 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr11 * tr2 +
114 tr12 * tr3;
115 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr11 * ti2 +
116 tr12 * ti3;
117 cr3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr12 * tr2 +
118 tr11 * tr3;
119 ci3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr12 * ti2 +
120 tr11 * ti3;
121 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] = chold1;
122 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] = chold2;
123 cr5 = ti11 * tr5 + ti12 * tr4;
124 ci5 = ti11 * ti5 + ti12 * ti4;
125 cr4 = ti12 * tr5 - ti11 * tr4;
126 ci4 = ti12 * ti5 - ti11 * ti4;
127 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr2 -
128 ci5);
129 cc[(k + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr2 + ci5)
130 ;
131 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci2 +
132 cr5);
133 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci3 + cr4)
134 ;
135 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr3 - ci4)
136 ;
137 cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr3 +
138 ci4);
139 cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci3 -
140 cr4);
141 cc[(k + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci2 - cr5)
142 ;
143/* L101: */
144 }
145 return 0;
146L106:
147 i__1 = *l1;
148 for (k = 1; k <= i__1; ++k) {
149 ti5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
150 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
151 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
152 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
153 ti4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + ((
154 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
155 ti3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + ((
156 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
157 tr5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
158 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
159 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
160 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
161 tr4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + ((
162 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
163 tr3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + ((
164 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
165 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = sn * (cc[(k + (cc_dim3 + 1) *
166 cc_dim2) * cc_dim1 + 1] + tr2 + tr3);
167 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = sn * (cc[(k + (cc_dim3 + 1) *
168 cc_dim2) * cc_dim1 + 2] + ti2 + ti3);
169 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr11 * tr2 +
170 tr12 * tr3;
171 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr11 * ti2 +
172 tr12 * ti3;
173 cr3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr12 * tr2 +
174 tr11 * tr3;
175 ci3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr12 * ti2 +
176 tr11 * ti3;
177 cr5 = ti11 * tr5 + ti12 * tr4;
178 ci5 = ti11 * ti5 + ti12 * ti4;
179 cr4 = ti12 * tr5 - ti11 * tr4;
180 ci4 = ti12 * ti5 - ti11 * ti4;
181 ch[(k + ch_dim2 * 7) * ch_dim1 + 1] = sn * (cr2 - ci5);
182 ch[(k + ch_dim2 * 10) * ch_dim1 + 1] = sn * (cr2 + ci5);
183 ch[(k + ch_dim2 * 7) * ch_dim1 + 2] = sn * (ci2 + cr5);
184 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 2] = sn * (ci3 + cr4);
185 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 1] = sn * (cr3 - ci4);
186 ch[(k + ch_dim2 * 9) * ch_dim1 + 1] = sn * (cr3 + ci4);
187 ch[(k + ch_dim2 * 9) * ch_dim1 + 2] = sn * (ci3 - cr4);
188 ch[(k + ch_dim2 * 10) * ch_dim1 + 2] = sn * (ci2 - cr5);
189/* L107: */
190 }
191 return 0;
192L102:
193 i__1 = *l1;
194 for (k = 1; k <= i__1; ++k) {
195 ti5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
196 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
197 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
198 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 2];
199 ti4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + ((
200 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
201 ti3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + ((
202 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
203 tr5 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
204 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
205 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
206 + (cc_dim3 * 5 + 1) * cc_dim2) * cc_dim1 + 1];
207 tr4 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + ((
208 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
209 tr3 = cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + ((
210 cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
211 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = cc[(k + (cc_dim3 + 1) * cc_dim2)
212 * cc_dim1 + 1] + tr2 + tr3;
213 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = cc[(k + (cc_dim3 + 1) * cc_dim2)
214 * cc_dim1 + 2] + ti2 + ti3;
215 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr11 * tr2 +
216 tr12 * tr3;
217 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr11 * ti2 +
218 tr12 * ti3;
219 cr3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr12 * tr2 +
220 tr11 * tr3;
221 ci3 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + tr12 * ti2 +
222 tr11 * ti3;
223 cr5 = ti11 * tr5 + ti12 * tr4;
224 ci5 = ti11 * ti5 + ti12 * ti4;
225 cr4 = ti12 * tr5 - ti11 * tr4;
226 ci4 = ti12 * ti5 - ti11 * ti4;
227 ch[(k + ch_dim2 * 7) * ch_dim1 + 1] = cr2 - ci5;
228 ch[(k + ch_dim2 * 10) * ch_dim1 + 1] = cr2 + ci5;
229 ch[(k + ch_dim2 * 7) * ch_dim1 + 2] = ci2 + cr5;
230 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 2] = ci3 + cr4;
231 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 1] = cr3 - ci4;
232 ch[(k + ch_dim2 * 9) * ch_dim1 + 1] = cr3 + ci4;
233 ch[(k + ch_dim2 * 9) * ch_dim1 + 2] = ci3 - cr4;
234 ch[(k + ch_dim2 * 10) * ch_dim1 + 2] = ci2 - cr5;
235/* L103: */
236 }
237 i__1 = *ido;
238 for (i__ = 2; i__ <= i__1; ++i__) {
239 i__2 = *l1;
240 for (k = 1; k <= i__2; ++k) {
241 ti5 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2] -
242 cc[(k + (i__ + cc_dim3 * 5) * cc_dim2) * cc_dim1 + 2];
243 ti2 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2] +
244 cc[(k + (i__ + cc_dim3 * 5) * cc_dim2) * cc_dim1 + 2];
245 ti4 = cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 2] - cc[(
246 k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 2];
247 ti3 = cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 2] + cc[(
248 k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 2];
249 tr5 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] -
250 cc[(k + (i__ + cc_dim3 * 5) * cc_dim2) * cc_dim1 + 1];
251 tr2 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] +
252 cc[(k + (i__ + cc_dim3 * 5) * cc_dim2) * cc_dim1 + 1];
253 tr4 = cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] - cc[(
254 k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 1];
255 tr3 = cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] + cc[(
256 k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 1];
257 ch[(k + (i__ * 5 + 1) * ch_dim2) * ch_dim1 + 1] = cc[(k + (i__ +
258 cc_dim3) * cc_dim2) * cc_dim1 + 1] + tr2 + tr3;
259 ch[(k + (i__ * 5 + 1) * ch_dim2) * ch_dim1 + 2] = cc[(k + (i__ +
260 cc_dim3) * cc_dim2) * cc_dim1 + 2] + ti2 + ti3;
261 cr2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] + tr11 *
262 tr2 + tr12 * tr3;
263 ci2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] + tr11 *
264 ti2 + tr12 * ti3;
265 cr3 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] + tr12 *
266 tr2 + tr11 * tr3;
267 ci3 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] + tr12 *
268 ti2 + tr11 * ti3;
269 cr5 = ti11 * tr5 + ti12 * tr4;
270 ci5 = ti11 * ti5 + ti12 * ti4;
271 cr4 = ti12 * tr5 - ti11 * tr4;
272 ci4 = ti12 * ti5 - ti11 * ti4;
273 dr3 = cr3 - ci4;
274 dr4 = cr3 + ci4;
275 di3 = ci3 + cr4;
276 di4 = ci3 - cr4;
277 dr5 = cr2 + ci5;
278 dr2 = cr2 - ci5;
279 di5 = ci2 - cr5;
280 di2 = ci2 + cr5;
281 ch[(k + (i__ * 5 + 2) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
282 wa_dim1 * 5] * dr2 + wa[i__ + wa_dim1 * 9] * di2;
283 ch[(k + (i__ * 5 + 2) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
284 wa_dim1 * 5] * di2 - wa[i__ + wa_dim1 * 9] * dr2;
285 ch[(k + (i__ * 5 + 3) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
286 wa_dim1 * 6] * dr3 + wa[i__ + wa_dim1 * 10] * di3;
287 ch[(k + (i__ * 5 + 3) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
288 wa_dim1 * 6] * di3 - wa[i__ + wa_dim1 * 10] * dr3;
289 ch[(k + (i__ * 5 + 4) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
290 wa_dim1 * 7] * dr4 + wa[i__ + wa_dim1 * 11] * di4;
291 ch[(k + (i__ * 5 + 4) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
292 wa_dim1 * 7] * di4 - wa[i__ + wa_dim1 * 11] * dr4;
293 ch[(k + (i__ * 5 + 5) * ch_dim2) * ch_dim1 + 1] = wa[i__ + (
294 wa_dim1 << 3)] * dr5 + wa[i__ + wa_dim1 * 12] * di5;
295 ch[(k + (i__ * 5 + 5) * ch_dim2) * ch_dim1 + 2] = wa[i__ + (
296 wa_dim1 << 3)] * di5 - wa[i__ + wa_dim1 * 12] * dr5;
297/* L104: */
298 }
299/* L105: */
300 }
301 return 0;
302} /* c1f5kf_ */
303