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