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