PLaSK library
Loading...
Searching...
No Matches
c1fgkb.c
Go to the documentation of this file.
1/* c1fgkb.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 c1fgkb_(integer *ido, integer *ip, integer *l1, integer *
46 lid, integer *na, doublereal *cc, doublereal *cc1, integer *in1,
47 doublereal *ch, doublereal *ch1, integer *in2, doublereal *wa)
48{
49 /* System generated locals */
50 integer ch_dim1, ch_dim2, ch_dim3, ch_offset, cc_dim1, cc_dim2, cc_dim3,
51 cc_offset, cc1_dim1, cc1_dim2, cc1_offset, ch1_dim1, ch1_dim2,
52 ch1_offset, wa_dim1, wa_dim2, wa_offset, i__1, i__2, i__3;
53
54 /* Local variables */
55 integer i__, j, k, l, jc, lc, ki;
56 doublereal wai, war;
57 integer ipp2, idlj, ipph;
58 doublereal chold1, chold2;
59
60
61/* FFTPACK 5.1 auxiliary routine */
62
63 /* Parameter adjustments */
64 wa_dim1 = *ido;
65 wa_dim2 = *ip - 1;
66 wa_offset = 1 + wa_dim1 * (1 + wa_dim2);
67 wa -= wa_offset;
68 cc1_dim1 = *in1;
69 cc1_dim2 = *lid;
70 cc1_offset = 1 + cc1_dim1 * (1 + cc1_dim2);
71 cc1 -= cc1_offset;
72 cc_dim1 = *in1;
73 cc_dim2 = *l1;
74 cc_dim3 = *ip;
75 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
76 cc -= cc_offset;
77 ch1_dim1 = *in2;
78 ch1_dim2 = *lid;
79 ch1_offset = 1 + ch1_dim1 * (1 + ch1_dim2);
80 ch1 -= ch1_offset;
81 ch_dim1 = *in2;
82 ch_dim2 = *l1;
83 ch_dim3 = *ido;
84 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * (1 + ch_dim3));
85 ch -= ch_offset;
86
87 /* Function Body */
88 ipp2 = *ip + 2;
89 ipph = (*ip + 1) / 2;
90 i__1 = *lid;
91 for (ki = 1; ki <= i__1; ++ki) {
92 ch1[(ki + ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + cc1_dim2) * cc1_dim1
93 + 1];
94 ch1[(ki + ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + cc1_dim2) * cc1_dim1
95 + 2];
96/* L110: */
97 }
98 i__1 = ipph;
99 for (j = 2; j <= i__1; ++j) {
100 jc = ipp2 - j;
101 i__2 = *lid;
102 for (ki = 1; ki <= i__2; ++ki) {
103 ch1[(ki + j * ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + j * cc1_dim2)
104 * cc1_dim1 + 1] + cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 1]
105 ;
106 ch1[(ki + jc * ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + j * cc1_dim2)
107 * cc1_dim1 + 1] - cc1[(ki + jc * cc1_dim2) * cc1_dim1 +
108 1];
109 ch1[(ki + j * ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + j * cc1_dim2)
110 * cc1_dim1 + 2] + cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 2]
111 ;
112 ch1[(ki + jc * ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + j * cc1_dim2)
113 * cc1_dim1 + 2] - cc1[(ki + jc * cc1_dim2) * cc1_dim1 +
114 2];
115/* L112: */
116 }
117/* L111: */
118 }
119 i__1 = ipph;
120 for (j = 2; j <= i__1; ++j) {
121 i__2 = *lid;
122 for (ki = 1; ki <= i__2; ++ki) {
123 cc1[(ki + cc1_dim2) * cc1_dim1 + 1] += ch1[(ki + j * ch1_dim2) *
124 ch1_dim1 + 1];
125 cc1[(ki + cc1_dim2) * cc1_dim1 + 2] += ch1[(ki + j * ch1_dim2) *
126 ch1_dim1 + 2];
127/* L117: */
128 }
129/* L118: */
130 }
131 i__1 = ipph;
132 for (l = 2; l <= i__1; ++l) {
133 lc = ipp2 - l;
134 i__2 = *lid;
135 for (ki = 1; ki <= i__2; ++ki) {
136 cc1[(ki + l * cc1_dim2) * cc1_dim1 + 1] = ch1[(ki + ch1_dim2) *
137 ch1_dim1 + 1] + wa[(l - 1 + wa_dim2) * wa_dim1 + 1] * ch1[
138 (ki + (ch1_dim2 << 1)) * ch1_dim1 + 1];
139 cc1[(ki + lc * cc1_dim2) * cc1_dim1 + 1] = wa[(l - 1 + (wa_dim2 <<
140 1)) * wa_dim1 + 1] * ch1[(ki + *ip * ch1_dim2) *
141 ch1_dim1 + 1];
142 cc1[(ki + l * cc1_dim2) * cc1_dim1 + 2] = ch1[(ki + ch1_dim2) *
143 ch1_dim1 + 2] + wa[(l - 1 + wa_dim2) * wa_dim1 + 1] * ch1[
144 (ki + (ch1_dim2 << 1)) * ch1_dim1 + 2];
145 cc1[(ki + lc * cc1_dim2) * cc1_dim1 + 2] = wa[(l - 1 + (wa_dim2 <<
146 1)) * wa_dim1 + 1] * ch1[(ki + *ip * ch1_dim2) *
147 ch1_dim1 + 2];
148/* L113: */
149 }
150 i__2 = ipph;
151 for (j = 3; j <= i__2; ++j) {
152 jc = ipp2 - j;
153 idlj = (l - 1) * (j - 1) % *ip;
154 war = wa[(idlj + wa_dim2) * wa_dim1 + 1];
155 wai = wa[(idlj + (wa_dim2 << 1)) * wa_dim1 + 1];
156 i__3 = *lid;
157 for (ki = 1; ki <= i__3; ++ki) {
158 cc1[(ki + l * cc1_dim2) * cc1_dim1 + 1] += war * ch1[(ki + j *
159 ch1_dim2) * ch1_dim1 + 1];
160 cc1[(ki + lc * cc1_dim2) * cc1_dim1 + 1] += wai * ch1[(ki +
161 jc * ch1_dim2) * ch1_dim1 + 1];
162 cc1[(ki + l * cc1_dim2) * cc1_dim1 + 2] += war * ch1[(ki + j *
163 ch1_dim2) * ch1_dim1 + 2];
164 cc1[(ki + lc * cc1_dim2) * cc1_dim1 + 2] += wai * ch1[(ki +
165 jc * ch1_dim2) * ch1_dim1 + 2];
166/* L114: */
167 }
168/* L115: */
169 }
170/* L116: */
171 }
172 if (*ido > 1 || *na == 1) {
173 goto L136;
174 }
175 i__1 = ipph;
176 for (j = 2; j <= i__1; ++j) {
177 jc = ipp2 - j;
178 i__2 = *lid;
179 for (ki = 1; ki <= i__2; ++ki) {
180 chold1 = cc1[(ki + j * cc1_dim2) * cc1_dim1 + 1] - cc1[(ki + jc *
181 cc1_dim2) * cc1_dim1 + 2];
182 chold2 = cc1[(ki + j * cc1_dim2) * cc1_dim1 + 1] + cc1[(ki + jc *
183 cc1_dim2) * cc1_dim1 + 2];
184 cc1[(ki + j * cc1_dim2) * cc1_dim1 + 1] = chold1;
185 cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 2] = cc1[(ki + j * cc1_dim2)
186 * cc1_dim1 + 2] - cc1[(ki + jc * cc1_dim2) * cc1_dim1 +
187 1];
188 cc1[(ki + j * cc1_dim2) * cc1_dim1 + 2] += cc1[(ki + jc *
189 cc1_dim2) * cc1_dim1 + 1];
190 cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 1] = chold2;
191/* L119: */
192 }
193/* L120: */
194 }
195 return 0;
196L136:
197 i__1 = *lid;
198 for (ki = 1; ki <= i__1; ++ki) {
199 ch1[(ki + ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + cc1_dim2) * cc1_dim1
200 + 1];
201 ch1[(ki + ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + cc1_dim2) * cc1_dim1
202 + 2];
203/* L137: */
204 }
205 i__1 = ipph;
206 for (j = 2; j <= i__1; ++j) {
207 jc = ipp2 - j;
208 i__2 = *lid;
209 for (ki = 1; ki <= i__2; ++ki) {
210 ch1[(ki + j * ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + j * cc1_dim2)
211 * cc1_dim1 + 1] - cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 2]
212 ;
213 ch1[(ki + jc * ch1_dim2) * ch1_dim1 + 1] = cc1[(ki + j * cc1_dim2)
214 * cc1_dim1 + 1] + cc1[(ki + jc * cc1_dim2) * cc1_dim1 +
215 2];
216 ch1[(ki + jc * ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + j * cc1_dim2)
217 * cc1_dim1 + 2] - cc1[(ki + jc * cc1_dim2) * cc1_dim1 +
218 1];
219 ch1[(ki + j * ch1_dim2) * ch1_dim1 + 2] = cc1[(ki + j * cc1_dim2)
220 * cc1_dim1 + 2] + cc1[(ki + jc * cc1_dim2) * cc1_dim1 + 1]
221 ;
222/* L134: */
223 }
224/* L135: */
225 }
226 if (*ido == 1) {
227 return 0;
228 }
229 i__1 = *ido;
230 for (i__ = 1; i__ <= i__1; ++i__) {
231 i__2 = *l1;
232 for (k = 1; k <= i__2; ++k) {
233 cc[(k + (i__ * cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] = ch[(k + (
234 i__ + ch_dim3) * ch_dim2) * ch_dim1 + 1];
235 cc[(k + (i__ * cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] = ch[(k + (
236 i__ + ch_dim3) * ch_dim2) * ch_dim1 + 2];
237/* L130: */
238 }
239/* L131: */
240 }
241 i__1 = *ip;
242 for (j = 2; j <= i__1; ++j) {
243 i__2 = *l1;
244 for (k = 1; k <= i__2; ++k) {
245 cc[(k + (j + cc_dim3) * cc_dim2) * cc_dim1 + 1] = ch[(k + (j *
246 ch_dim3 + 1) * ch_dim2) * ch_dim1 + 1];
247 cc[(k + (j + cc_dim3) * cc_dim2) * cc_dim1 + 2] = ch[(k + (j *
248 ch_dim3 + 1) * ch_dim2) * ch_dim1 + 2];
249/* L122: */
250 }
251/* L123: */
252 }
253 i__1 = *ip;
254 for (j = 2; j <= i__1; ++j) {
255 i__2 = *ido;
256 for (i__ = 2; i__ <= i__2; ++i__) {
257 i__3 = *l1;
258 for (k = 1; k <= i__3; ++k) {
259 cc[(k + (j + i__ * cc_dim3) * cc_dim2) * cc_dim1 + 1] = wa[
260 i__ + (j - 1 + wa_dim2) * wa_dim1] * ch[(k + (i__ + j
261 * ch_dim3) * ch_dim2) * ch_dim1 + 1] - wa[i__ + (j -
262 1 + (wa_dim2 << 1)) * wa_dim1] * ch[(k + (i__ + j *
263 ch_dim3) * ch_dim2) * ch_dim1 + 2];
264 cc[(k + (j + i__ * cc_dim3) * cc_dim2) * cc_dim1 + 2] = wa[
265 i__ + (j - 1 + wa_dim2) * wa_dim1] * ch[(k + (i__ + j
266 * ch_dim3) * ch_dim2) * ch_dim1 + 2] + wa[i__ + (j -
267 1 + (wa_dim2 << 1)) * wa_dim1] * ch[(k + (i__ + j *
268 ch_dim3) * ch_dim2) * ch_dim1 + 1];
269/* L124: */
270 }
271/* L125: */
272 }
273/* L126: */
274 }
275 return 0;
276} /* c1fgkb_ */
277