PLaSK library
Loading...
Searching...
No Matches
c1f4kf.c
Go to the documentation of this file.
1/* c1f4kf.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 c1f4kf_(integer *ido, integer *l1, integer *na,
46 doublereal *cc, integer *in1, doublereal *ch, integer *in2,
47 doublereal *wa)
48{
49 /* System generated locals */
50 integer cc_dim1, cc_dim2, cc_dim3, cc_offset, ch_dim1, ch_dim2, ch_offset,
51 wa_dim1, wa_offset, i__1, i__2;
52
53 /* Local variables */
54 integer i__, k;
55 doublereal sn, ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2,
56 tr3, tr4;
57
58
59/* FFTPACK 5.1 auxiliary routine */
60
61 /* Parameter adjustments */
62 wa_dim1 = *ido;
63 wa_offset = 1 + (wa_dim1 << 2);
64 wa -= wa_offset;
65 cc_dim1 = *in1;
66 cc_dim2 = *l1;
67 cc_dim3 = *ido;
68 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
69 cc -= cc_offset;
70 ch_dim1 = *in2;
71 ch_dim2 = *l1;
72 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * 5);
73 ch -= ch_offset;
74
75 /* Function Body */
76 if (*ido > 1) {
77 goto L102;
78 }
79 sn = 1. / (doublereal) (*l1 << 2);
80 if (*na == 1) {
81 goto L106;
82 }
83 i__1 = *l1;
84 for (k = 1; k <= i__1; ++k) {
85 ti1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + (
86 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
87 ti2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + (
88 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
89 tr4 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
90 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
91 ti3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
92 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
93 tr1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + (
94 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
95 tr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + (
96 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
97 ti4 = cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
98 + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1];
99 tr3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
100 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
101 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (tr2 + tr3);
102 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (tr2 - tr3)
103 ;
104 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ti2 + ti3);
105 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ti2 - ti3)
106 ;
107 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (tr1 +
108 tr4);
109 cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (tr1 -
110 tr4);
111 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ti1 +
112 ti4);
113 cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ti1 -
114 ti4);
115/* L101: */
116 }
117 return 0;
118L106:
119 i__1 = *l1;
120 for (k = 1; k <= i__1; ++k) {
121 ti1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + (
122 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
123 ti2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + (
124 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
125 tr4 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
126 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
127 ti3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
128 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
129 tr1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + (
130 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
131 tr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + (
132 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
133 ti4 = cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
134 + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1];
135 tr3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
136 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
137 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = sn * (tr2 + tr3);
138 ch[(k + ch_dim2 * 7) * ch_dim1 + 1] = sn * (tr2 - tr3);
139 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = sn * (ti2 + ti3);
140 ch[(k + ch_dim2 * 7) * ch_dim1 + 2] = sn * (ti2 - ti3);
141 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = sn * (tr1 + tr4);
142 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 1] = sn * (tr1 - tr4);
143 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = sn * (ti1 + ti4);
144 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 2] = sn * (ti1 - ti4);
145/* L107: */
146 }
147 return 0;
148L102:
149 i__1 = *l1;
150 for (k = 1; k <= i__1; ++k) {
151 ti1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + (
152 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
153 ti2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k + (
154 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
155 tr4 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k
156 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
157 ti3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
158 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 2];
159 tr1 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + (
160 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
161 tr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k + (
162 cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
163 ti4 = cc[(k + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k
164 + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1];
165 tr3 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
166 + ((cc_dim3 << 2) + 1) * cc_dim2) * cc_dim1 + 1];
167 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = tr2 + tr3;
168 ch[(k + ch_dim2 * 7) * ch_dim1 + 1] = tr2 - tr3;
169 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ti2 + ti3;
170 ch[(k + ch_dim2 * 7) * ch_dim1 + 2] = ti2 - ti3;
171 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = tr1 + tr4;
172 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 1] = tr1 - tr4;
173 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = ti1 + ti4;
174 ch[(k + (ch_dim2 << 3)) * ch_dim1 + 2] = ti1 - ti4;
175/* L103: */
176 }
177 i__1 = *ido;
178 for (i__ = 2; i__ <= i__1; ++i__) {
179 i__2 = *l1;
180 for (k = 1; k <= i__2; ++k) {
181 ti1 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] - cc[(k +
182 (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 2];
183 ti2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] + cc[(k +
184 (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 2];
185 ti3 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2] +
186 cc[(k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 2];
187 tr4 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2] -
188 cc[(k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 2];
189 tr1 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] - cc[(k +
190 (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1];
191 tr2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] + cc[(k +
192 (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1];
193 ti4 = cc[(k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 1] -
194 cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1];
195 tr3 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] +
196 cc[(k + (i__ + (cc_dim3 << 2)) * cc_dim2) * cc_dim1 + 1];
197 ch[(k + ((i__ << 2) + 1) * ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
198 cr3 = tr2 - tr3;
199 ch[(k + ((i__ << 2) + 1) * ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
200 ci3 = ti2 - ti3;
201 cr2 = tr1 + tr4;
202 cr4 = tr1 - tr4;
203 ci2 = ti1 + ti4;
204 ci4 = ti1 - ti4;
205 ch[(k + ((i__ << 2) + 2) * ch_dim2) * ch_dim1 + 1] = wa[i__ + (
206 wa_dim1 << 2)] * cr2 + wa[i__ + wa_dim1 * 7] * ci2;
207 ch[(k + ((i__ << 2) + 2) * ch_dim2) * ch_dim1 + 2] = wa[i__ + (
208 wa_dim1 << 2)] * ci2 - wa[i__ + wa_dim1 * 7] * cr2;
209 ch[(k + ((i__ << 2) + 3) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
210 wa_dim1 * 5] * cr3 + wa[i__ + (wa_dim1 << 3)] * ci3;
211 ch[(k + ((i__ << 2) + 3) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
212 wa_dim1 * 5] * ci3 - wa[i__ + (wa_dim1 << 3)] * cr3;
213 ch[(k + ((i__ << 2) + 4) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
214 wa_dim1 * 6] * cr4 + wa[i__ + wa_dim1 * 9] * ci4;
215 ch[(k + ((i__ << 2) + 4) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
216 wa_dim1 * 6] * ci4 - wa[i__ + wa_dim1 * 9] * cr4;
217/* L104: */
218 }
219/* L105: */
220 }
221 return 0;
222} /* c1f4kf_ */
223