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