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