PLaSK library
Loading...
Searching...
No Matches
cmf4kb.c
Go to the documentation of this file.
1/* cmf4kb.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 cmf4kb_(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 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 || *na == 1) {
82 goto L102;
83 }
84 i__1 = *l1;
85 for (k = 1; k <= i__1; ++k) {
86 i__2 = m1d;
87 i__3 = *im1;
88 for (m1 = 1; i__3 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__3) {
89 ti1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
90 - cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
91 1) + 2];
92 ti2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
93 + cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
94 1) + 2];
95 tr4 = cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 <<
96 1) + 2] - cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
97 cc_dim2 << 1) + 2];
98 ti3 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
99 1) + 2] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
100 cc_dim2 << 1) + 2];
101 tr1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
102 - cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
103 1) + 1];
104 tr2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
105 + cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
106 1) + 1];
107 ti4 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
108 1) + 1] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
109 cc_dim2 << 1) + 1];
110 tr3 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
111 1) + 1] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
112 cc_dim2 << 1) + 1];
113 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] = tr2
114 + tr3;
115 cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1) + 1] =
116 tr2 - tr3;
117 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] = ti2
118 + ti3;
119 cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 << 1) + 2] =
120 ti2 - ti3;
121 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 1]
122 = tr1 + tr4;
123 cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 << 1) + 1]
124 = tr1 - tr4;
125 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 2]
126 = ti1 + ti4;
127 cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 << 1) + 2]
128 = ti1 - ti4;
129/* L101: */
130 }
131 }
132 return 0;
133L102:
134 i__3 = *l1;
135 for (k = 1; k <= i__3; ++k) {
136 m2 = m2s;
137 i__2 = m1d;
138 i__1 = *im1;
139 for (m1 = 1; i__1 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__1) {
140 m2 += *im2;
141 ti1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
142 - cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
143 1) + 2];
144 ti2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2]
145 + cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
146 1) + 2];
147 tr4 = cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) * cc_dim2 <<
148 1) + 2] - cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
149 cc_dim2 << 1) + 2];
150 ti3 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
151 1) + 2] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
152 cc_dim2 << 1) + 2];
153 tr1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
154 - cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
155 1) + 1];
156 tr2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1]
157 + cc[(m1 + (k + (cc_dim4 * 3 + 1) * cc_dim3) * cc_dim2 <<
158 1) + 1];
159 ti4 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
160 1) + 1] - cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
161 cc_dim2 << 1) + 1];
162 tr3 = cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 <<
163 1) + 1] + cc[(m1 + (k + ((cc_dim4 << 2) + 1) * cc_dim3) *
164 cc_dim2 << 1) + 1];
165 ch[(m2 + (k + ch_dim3 * 5) * ch_dim2 << 1) + 1] = tr2 + tr3;
166 ch[(m2 + (k + ch_dim3 * 7) * ch_dim2 << 1) + 1] = tr2 - tr3;
167 ch[(m2 + (k + ch_dim3 * 5) * ch_dim2 << 1) + 2] = ti2 + ti3;
168 ch[(m2 + (k + ch_dim3 * 7) * ch_dim2 << 1) + 2] = ti2 - ti3;
169 ch[(m2 + (k + ch_dim3 * 6) * ch_dim2 << 1) + 1] = tr1 + tr4;
170 ch[(m2 + (k + (ch_dim3 << 3)) * ch_dim2 << 1) + 1] = tr1 - tr4;
171 ch[(m2 + (k + ch_dim3 * 6) * ch_dim2 << 1) + 2] = ti1 + ti4;
172 ch[(m2 + (k + (ch_dim3 << 3)) * ch_dim2 << 1) + 2] = ti1 - ti4;
173/* L103: */
174 }
175 }
176 if (*ido == 1) {
177 return 0;
178 }
179 i__1 = *ido;
180 for (i__ = 2; i__ <= i__1; ++i__) {
181 i__2 = *l1;
182 for (k = 1; k <= i__2; ++k) {
183 m2 = m2s;
184 i__3 = m1d;
185 i__4 = *im1;
186 for (m1 = 1; i__4 < 0 ? m1 >= i__3 : m1 <= i__3; m1 += i__4) {
187 m2 += *im2;
188 ti1 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
189 + 2] - cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) *
190 cc_dim2 << 1) + 2];
191 ti2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
192 + 2] + cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) *
193 cc_dim2 << 1) + 2];
194 ti3 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
195 cc_dim2 << 1) + 2] + cc[(m1 + (k + (i__ + (cc_dim4 <<
196 2)) * cc_dim3) * cc_dim2 << 1) + 2];
197 tr4 = cc[(m1 + (k + (i__ + (cc_dim4 << 2)) * cc_dim3) *
198 cc_dim2 << 1) + 2] - cc[(m1 + (k + (i__ + (cc_dim4 <<
199 1)) * cc_dim3) * cc_dim2 << 1) + 2];
200 tr1 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
201 + 1] - cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) *
202 cc_dim2 << 1) + 1];
203 tr2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
204 + 1] + cc[(m1 + (k + (i__ + cc_dim4 * 3) * cc_dim3) *
205 cc_dim2 << 1) + 1];
206 ti4 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
207 cc_dim2 << 1) + 1] - cc[(m1 + (k + (i__ + (cc_dim4 <<
208 2)) * cc_dim3) * cc_dim2 << 1) + 1];
209 tr3 = cc[(m1 + (k + (i__ + (cc_dim4 << 1)) * cc_dim3) *
210 cc_dim2 << 1) + 1] + cc[(m1 + (k + (i__ + (cc_dim4 <<
211 2)) * cc_dim3) * cc_dim2 << 1) + 1];
212 ch[(m2 + (k + ((i__ << 2) + 1) * ch_dim3) * ch_dim2 << 1) + 1]
213 = tr2 + tr3;
214 cr3 = tr2 - tr3;
215 ch[(m2 + (k + ((i__ << 2) + 1) * ch_dim3) * ch_dim2 << 1) + 2]
216 = ti2 + ti3;
217 ci3 = ti2 - ti3;
218 cr2 = tr1 + tr4;
219 cr4 = tr1 - tr4;
220 ci2 = ti1 + ti4;
221 ci4 = ti1 - ti4;
222 ch[(m2 + (k + ((i__ << 2) + 2) * ch_dim3) * ch_dim2 << 1) + 1]
223 = wa[i__ + (wa_dim1 << 2)] * cr2 - wa[i__ + wa_dim1 *
224 7] * ci2;
225 ch[(m2 + (k + ((i__ << 2) + 2) * ch_dim3) * ch_dim2 << 1) + 2]
226 = wa[i__ + (wa_dim1 << 2)] * ci2 + wa[i__ + wa_dim1 *
227 7] * cr2;
228 ch[(m2 + (k + ((i__ << 2) + 3) * ch_dim3) * ch_dim2 << 1) + 1]
229 = wa[i__ + wa_dim1 * 5] * cr3 - wa[i__ + (wa_dim1 <<
230 3)] * ci3;
231 ch[(m2 + (k + ((i__ << 2) + 3) * ch_dim3) * ch_dim2 << 1) + 2]
232 = wa[i__ + wa_dim1 * 5] * ci3 + wa[i__ + (wa_dim1 <<
233 3)] * cr3;
234 ch[(m2 + (k + ((i__ << 2) + 4) * ch_dim3) * ch_dim2 << 1) + 1]
235 = wa[i__ + wa_dim1 * 6] * cr4 - wa[i__ + wa_dim1 * 9]
236 * ci4;
237 ch[(m2 + (k + ((i__ << 2) + 4) * ch_dim3) * ch_dim2 << 1) + 2]
238 = wa[i__ + wa_dim1 * 6] * ci4 + wa[i__ + wa_dim1 * 9]
239 * cr4;
240/* L104: */
241 }
242 }
243/* L105: */
244 }
245 return 0;
246} /* cmf4kb_ */
247