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