PLaSK library
Loading...
Searching...
No Matches
cmf5kb.c
Go to the documentation of this file.
1/* cmf5kb.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 cmf5kb_(integer *lot, integer *ido, integer *l1, integer
46 *na, doublereal *cc, integer *im1, integer *in1, doublereal *ch,
47 integer *im2, integer *in2, 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_dim2, cc_dim3, cc_dim4, cc_offset, ch_dim2, ch_dim3, ch_offset,
58 wa_dim1, wa_offset, i__1, i__2, i__3, i__4;
59
60 /* Local variables */
61 integer i__, k, m1, m2;
62 doublereal ci2, ci3, ci4, ci5;
63 integer m1d;
64 doublereal di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3, ti4;
65 integer m2s;
66 doublereal ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5, chold1, chold2;
67
68 /* Parameter adjustments */
69 wa_dim1 = *ido;
70 wa_offset = 1 + wa_dim1 * 5;
71 wa -= wa_offset;
72 cc_dim2 = *in1;
73 cc_dim3 = *l1;
74 cc_dim4 = *ido;
75 cc_offset = 1 + 2 * (1 + cc_dim2 * (1 + cc_dim3 * (1 + cc_dim4)));
76 cc -= cc_offset;
77 ch_dim2 = *in2;
78 ch_dim3 = *l1;
79 ch_offset = 1 + 2 * (1 + ch_dim2 * (1 + ch_dim3 * 6));
80 ch -= ch_offset;
81
82 /* Function Body */
83
84/* FFTPACK 5.0 auxiliary routine */
85
86 m1d = (*lot - 1) * *im1 + 1;
87 m2s = 1 - *im2;
88 if (*ido > 1 || *na == 1) {
89 goto L102;
90 }
91 i__1 = *l1;
92 for (k = 1; k <= i__1; ++k) {
93 i__2 = m1d;
94 i__3 = *im1;
95 for (m1 = 1; i__3 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__3) {
96 ti5 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
97 1) + 2] - cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
98 cc_dim2 << 1) + 2];
99 ti2 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
100 1) + 2] + cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
101 cc_dim2 << 1) + 2];
102 ti4 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
103 + 2] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
104 cc_dim2 << 1) + 2];
105 ti3 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
106 + 2] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
107 cc_dim2 << 1) + 2];
108 tr5 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
109 1) + 1] - cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
110 cc_dim2 << 1) + 1];
111 tr2 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
112 1) + 1] + cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
113 cc_dim2 << 1) + 1];
114 tr4 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
115 + 1] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
116 cc_dim2 << 1) + 1];
117 tr3 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
118 + 1] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
119 cc_dim2 << 1) + 1];
120 chold1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) +
121 1] + tr2 + tr3;
122 chold2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) +
123 2] + ti2 + ti3;
124 cr2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
125 + tr11 * tr2 + tr12 * tr3;
126 ci2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
127 + tr11 * ti2 + tr12 * ti3;
128 cr3 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
129 + tr12 * tr2 + tr11 * tr3;
130 ci3 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
131 + tr12 * ti2 + tr11 * ti3;
132 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] =
133 chold1;
134 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] =
135 chold2;
136 cr5 = ti11 * tr5 + ti12 * tr4;
137 ci5 = ti11 * ti5 + ti12 * ti4;
138 cr4 = ti12 * tr5 - ti11 * tr4;
139 ci4 = ti12 * ti5 - ti11 * ti4;
140 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 1]
141 = cr2 - ci5;
142 cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) * cc_dim2 << 1) + 1] =
143 cr2 + ci5;
144 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 2]
145 = ci2 + cr5;
146 cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1) + 2] =
147 ci3 + cr4;
148 cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1) + 1] =
149 cr3 - ci4;
150 cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 << 1) + 1]
151 = cr3 + ci4;
152 cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 << 1) + 2]
153 = ci3 - cr4;
154 cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) * cc_dim2 << 1) + 2] =
155 ci2 - cr5;
156/* L101: */
157 }
158 }
159 return 0;
160L102:
161 i__3 = *l1;
162 for (k = 1; k <= i__3; ++k) {
163 m2 = m2s;
164 i__2 = m1d;
165 i__1 = *im1;
166 for (m1 = 1; i__1 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__1) {
167 m2 += *im2;
168 ti5 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
169 1) + 2] - cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
170 cc_dim2 << 1) + 2];
171 ti2 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
172 1) + 2] + cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
173 cc_dim2 << 1) + 2];
174 ti4 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
175 + 2] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
176 cc_dim2 << 1) + 2];
177 ti3 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
178 + 2] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
179 cc_dim2 << 1) + 2];
180 tr5 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
181 1) + 1] - cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
182 cc_dim2 << 1) + 1];
183 tr2 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
184 1) + 1] + cc[(m1 + (k + (cc_dim4 * 5 + 1) * cc_dim3) *
185 cc_dim2 << 1) + 1];
186 tr4 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
187 + 1] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
188 cc_dim2 << 1) + 1];
189 tr3 = cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1)
190 + 1] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
191 cc_dim2 << 1) + 1];
192 ch[(m2 + (k + ch_dim3 * 6) * ch_dim2 << 1) + 1] = cc[(m1 + (k + (
193 cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] + tr2 + tr3;
194 ch[(m2 + (k + ch_dim3 * 6) * ch_dim2 << 1) + 2] = cc[(m1 + (k + (
195 cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] + ti2 + ti3;
196 cr2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
197 + tr11 * tr2 + tr12 * tr3;
198 ci2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
199 + tr11 * ti2 + tr12 * ti3;
200 cr3 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
201 + tr12 * tr2 + tr11 * tr3;
202 ci3 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
203 + tr12 * ti2 + tr11 * ti3;
204 cr5 = ti11 * tr5 + ti12 * tr4;
205 ci5 = ti11 * ti5 + ti12 * ti4;
206 cr4 = ti12 * tr5 - ti11 * tr4;
207 ci4 = ti12 * ti5 - ti11 * ti4;
208 ch[(m2 + (k + ch_dim3 * 7) * ch_dim2 << 1) + 1] = cr2 - ci5;
209 ch[(m2 + (k + ch_dim3 * 10) * ch_dim2 << 1) + 1] = cr2 + ci5;
210 ch[(m2 + (k + ch_dim3 * 7) * ch_dim2 << 1) + 2] = ci2 + cr5;
211 ch[(m2 + (k + (ch_dim3 << 3)) * ch_dim2 << 1) + 2] = ci3 + cr4;
212 ch[(m2 + (k + (ch_dim3 << 3)) * ch_dim2 << 1) + 1] = cr3 - ci4;
213 ch[(m2 + (k + ch_dim3 * 9) * ch_dim2 << 1) + 1] = cr3 + ci4;
214 ch[(m2 + (k + ch_dim3 * 9) * ch_dim2 << 1) + 2] = ci3 - cr4;
215 ch[(m2 + (k + ch_dim3 * 10) * ch_dim2 << 1) + 2] = ci2 - cr5;
216/* L103: */
217 }
218 }
219 if (*ido == 1) {
220 return 0;
221 }
222 i__1 = *ido;
223 for (i__ = 2; i__ <= i__1; ++i__) {
224 i__2 = *l1;
225 for (k = 1; k <= i__2; ++k) {
226 m2 = m2s;
227 i__3 = m1d;
228 i__4 = *im1;
229 for (m1 = 1; i__4 < 0 ? m1 >= i__3 : m1 <= i__3; m1 += i__4) {
230 m2 += *im2;
231 ti5 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
232 cc_dim2 << 1) + 2] - cc[(m1 + (k + (i__ + cc_dim4 * 5)
233 * cc_dim3) * cc_dim2 << 1) + 2];
234 ti2 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
235 cc_dim2 << 1) + 2] + cc[(m1 + (k + (i__ + cc_dim4 * 5)
236 * cc_dim3) * cc_dim2 << 1) + 2];
237 ti4 = cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) * cc_dim2
238 << 1) + 2] - cc[(m1 + (k + (i__ + (cc_dim4 << 2)) *
239 cc_dim3) * cc_dim2 << 1) + 2];
240 ti3 = cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) * cc_dim2
241 << 1) + 2] + cc[(m1 + (k + (i__ + (cc_dim4 << 2)) *
242 cc_dim3) * cc_dim2 << 1) + 2];
243 tr5 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
244 cc_dim2 << 1) + 1] - cc[(m1 + (k + (i__ + cc_dim4 * 5)
245 * cc_dim3) * cc_dim2 << 1) + 1];
246 tr2 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
247 cc_dim2 << 1) + 1] + cc[(m1 + (k + (i__ + cc_dim4 * 5)
248 * cc_dim3) * cc_dim2 << 1) + 1];
249 tr4 = cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) * cc_dim2
250 << 1) + 1] - cc[(m1 + (k + (i__ + (cc_dim4 << 2)) *
251 cc_dim3) * cc_dim2 << 1) + 1];
252 tr3 = cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) * cc_dim2
253 << 1) + 1] + cc[(m1 + (k + (i__ + (cc_dim4 << 2)) *
254 cc_dim3) * cc_dim2 << 1) + 1];
255 ch[(m2 + (k + (i__ * 5 + 1) * ch_dim3) * ch_dim2 << 1) + 1] =
256 cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 <<
257 1) + 1] + tr2 + tr3;
258 ch[(m2 + (k + (i__ * 5 + 1) * ch_dim3) * ch_dim2 << 1) + 2] =
259 cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 <<
260 1) + 2] + ti2 + ti3;
261 cr2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
262 + 1] + tr11 * tr2 + tr12 * tr3;
263 ci2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
264 + 2] + tr11 * ti2 + tr12 * ti3;
265 cr3 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
266 + 1] + tr12 * tr2 + tr11 * tr3;
267 ci3 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
268 + 2] + tr12 * 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[(m2 + (k + (i__ * 5 + 2) * ch_dim3) * ch_dim2 << 1) + 1] =
282 wa[i__ + wa_dim1 * 5] * dr2 - wa[i__ + wa_dim1 * 9] *
283 di2;
284 ch[(m2 + (k + (i__ * 5 + 2) * ch_dim3) * ch_dim2 << 1) + 2] =
285 wa[i__ + wa_dim1 * 5] * di2 + wa[i__ + wa_dim1 * 9] *
286 dr2;
287 ch[(m2 + (k + (i__ * 5 + 3) * ch_dim3) * ch_dim2 << 1) + 1] =
288 wa[i__ + wa_dim1 * 6] * dr3 - wa[i__ + wa_dim1 * 10] *
289 di3;
290 ch[(m2 + (k + (i__ * 5 + 3) * ch_dim3) * ch_dim2 << 1) + 2] =
291 wa[i__ + wa_dim1 * 6] * di3 + wa[i__ + wa_dim1 * 10] *
292 dr3;
293 ch[(m2 + (k + (i__ * 5 + 4) * ch_dim3) * ch_dim2 << 1) + 1] =
294 wa[i__ + wa_dim1 * 7] * dr4 - wa[i__ + wa_dim1 * 11] *
295 di4;
296 ch[(m2 + (k + (i__ * 5 + 4) * ch_dim3) * ch_dim2 << 1) + 2] =
297 wa[i__ + wa_dim1 * 7] * di4 + wa[i__ + wa_dim1 * 11] *
298 dr4;
299 ch[(m2 + (k + (i__ * 5 + 5) * ch_dim3) * ch_dim2 << 1) + 1] =
300 wa[i__ + (wa_dim1 << 3)] * dr5 - wa[i__ + wa_dim1 *
301 12] * di5;
302 ch[(m2 + (k + (i__ * 5 + 5) * ch_dim3) * ch_dim2 << 1) + 2] =
303 wa[i__ + (wa_dim1 << 3)] * di5 + wa[i__ + wa_dim1 *
304 12] * dr5;
305/* L104: */
306 }
307 }
308/* L105: */
309 }
310 return 0;
311} /* cmf5kb_ */
312