PLaSK library
Loading...
Searching...
No Matches
mradb4.c
Go to the documentation of this file.
1/* mradb4.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 mradb4_(integer *m, integer *ido, integer *l1,
46 doublereal *cc, integer *im1, integer *in1, doublereal *ch, integer *
47 im2, integer *in2, doublereal *wa1, 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, i__3, i__4;
52
53 /* Builtin functions */
54 double sqrt(doublereal);
55
56 /* Local variables */
57 integer i__, k, m1, m2, ic, m1d, m2s, 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 m1d = (*m - 1) * *im1 + 1;
77 m2s = 1 - *im2;
78 sqrt2 = sqrt(2.);
79 i__1 = *l1;
80 for (k = 1; k <= i__1; ++k) {
81 m2 = m2s;
82 i__2 = m1d;
83 i__3 = *im1;
84 for (m1 = 1; i__3 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__3) {
85 m2 += *im2;
86 ch[m2 + ((k + ch_dim3 * 3) * ch_dim2 + 1) * ch_dim1] = cc[m1 + (((
87 k << 2) + 1) * cc_dim2 + 1) * cc_dim1] + cc[m1 + (*ido + (
88 (k << 2) + 4) * cc_dim2) * cc_dim1] - (cc[m1 + (*ido + ((
89 k << 2) + 2) * cc_dim2) * cc_dim1] + cc[m1 + (*ido + ((k
90 << 2) + 2) * cc_dim2) * cc_dim1]);
91 ch[m2 + ((k + ch_dim3) * ch_dim2 + 1) * ch_dim1] = cc[m1 + (((k <<
92 2) + 1) * cc_dim2 + 1) * cc_dim1] + cc[m1 + (*ido + ((k
93 << 2) + 4) * cc_dim2) * cc_dim1] + (cc[m1 + (*ido + ((k <<
94 2) + 2) * cc_dim2) * cc_dim1] + cc[m1 + (*ido + ((k << 2)
95 + 2) * cc_dim2) * cc_dim1]);
96 ch[m2 + ((k + (ch_dim3 << 2)) * ch_dim2 + 1) * ch_dim1] = cc[m1 +
97 (((k << 2) + 1) * cc_dim2 + 1) * cc_dim1] - cc[m1 + (*ido
98 + ((k << 2) + 4) * cc_dim2) * cc_dim1] + (cc[m1 + (((k <<
99 2) + 3) * cc_dim2 + 1) * cc_dim1] + cc[m1 + (((k << 2) +
100 3) * cc_dim2 + 1) * cc_dim1]);
101 ch[m2 + ((k + (ch_dim3 << 1)) * ch_dim2 + 1) * ch_dim1] = cc[m1 +
102 (((k << 2) + 1) * cc_dim2 + 1) * cc_dim1] - cc[m1 + (*ido
103 + ((k << 2) + 4) * cc_dim2) * cc_dim1] - (cc[m1 + (((k <<
104 2) + 3) * cc_dim2 + 1) * cc_dim1] + cc[m1 + (((k << 2) +
105 3) * cc_dim2 + 1) * cc_dim1]);
106/* L1001: */
107 }
108/* L101: */
109 }
110 if ((i__1 = *ido - 2) < 0) {
111 goto L107;
112 } else if (i__1 == 0) {
113 goto L105;
114 } else {
115 goto L102;
116 }
117L102:
118 idp2 = *ido + 2;
119 i__1 = *l1;
120 for (k = 1; k <= i__1; ++k) {
121 i__3 = *ido;
122 for (i__ = 3; i__ <= i__3; i__ += 2) {
123 ic = idp2 - i__;
124 m2 = m2s;
125 i__2 = m1d;
126 i__4 = *im1;
127 for (m1 = 1; i__4 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__4) {
128 m2 += *im2;
129 ch[m2 + (i__ - 1 + (k + ch_dim3) * ch_dim2) * ch_dim1] = cc[
130 m1 + (i__ - 1 + ((k << 2) + 1) * cc_dim2) * cc_dim1]
131 + cc[m1 + (ic - 1 + ((k << 2) + 4) * cc_dim2) *
132 cc_dim1] + (cc[m1 + (i__ - 1 + ((k << 2) + 3) *
133 cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + ((k << 2) + 2)
134 * cc_dim2) * cc_dim1]);
135 ch[m2 + (i__ + (k + ch_dim3) * ch_dim2) * ch_dim1] = cc[m1 + (
136 i__ + ((k << 2) + 1) * cc_dim2) * cc_dim1] - cc[m1 + (
137 ic + ((k << 2) + 4) * cc_dim2) * cc_dim1] + (cc[m1 + (
138 i__ + ((k << 2) + 3) * cc_dim2) * cc_dim1] - cc[m1 + (
139 ic + ((k << 2) + 2) * cc_dim2) * cc_dim1]);
140 ch[m2 + (i__ - 1 + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1]
141 = wa1[i__ - 2] * (cc[m1 + (i__ - 1 + ((k << 2) + 1) *
142 cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + ((k << 2) + 4)
143 * cc_dim2) * cc_dim1] - (cc[m1 + (i__ + ((k << 2) +
144 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic + ((k << 2) +
145 2) * cc_dim2) * cc_dim1])) - wa1[i__ - 1] * (cc[m1 + (
146 i__ + ((k << 2) + 1) * cc_dim2) * cc_dim1] + cc[m1 + (
147 ic + ((k << 2) + 4) * cc_dim2) * cc_dim1] + (cc[m1 + (
148 i__ - 1 + ((k << 2) + 3) * cc_dim2) * cc_dim1] - cc[
149 m1 + (ic - 1 + ((k << 2) + 2) * cc_dim2) * cc_dim1]));
150 ch[m2 + (i__ + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1] =
151 wa1[i__ - 2] * (cc[m1 + (i__ + ((k << 2) + 1) *
152 cc_dim2) * cc_dim1] + cc[m1 + (ic + ((k << 2) + 4) *
153 cc_dim2) * cc_dim1] + (cc[m1 + (i__ - 1 + ((k << 2) +
154 3) * cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + ((k << 2)
155 + 2) * cc_dim2) * cc_dim1])) + wa1[i__ - 1] * (cc[m1
156 + (i__ - 1 + ((k << 2) + 1) * cc_dim2) * cc_dim1] -
157 cc[m1 + (ic - 1 + ((k << 2) + 4) * cc_dim2) * cc_dim1]
158 - (cc[m1 + (i__ + ((k << 2) + 3) * cc_dim2) *
159 cc_dim1] + cc[m1 + (ic + ((k << 2) + 2) * cc_dim2) *
160 cc_dim1]));
161 ch[m2 + (i__ - 1 + (k + ch_dim3 * 3) * ch_dim2) * ch_dim1] =
162 wa2[i__ - 2] * (cc[m1 + (i__ - 1 + ((k << 2) + 1) *
163 cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + ((k << 2) + 4)
164 * cc_dim2) * cc_dim1] - (cc[m1 + (i__ - 1 + ((k << 2)
165 + 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + ((k <<
166 2) + 2) * cc_dim2) * cc_dim1])) - wa2[i__ - 1] * (cc[
167 m1 + (i__ + ((k << 2) + 1) * cc_dim2) * cc_dim1] - cc[
168 m1 + (ic + ((k << 2) + 4) * cc_dim2) * cc_dim1] - (cc[
169 m1 + (i__ + ((k << 2) + 3) * cc_dim2) * cc_dim1] - cc[
170 m1 + (ic + ((k << 2) + 2) * cc_dim2) * cc_dim1]));
171 ch[m2 + (i__ + (k + ch_dim3 * 3) * ch_dim2) * ch_dim1] = wa2[
172 i__ - 2] * (cc[m1 + (i__ + ((k << 2) + 1) * cc_dim2) *
173 cc_dim1] - cc[m1 + (ic + ((k << 2) + 4) * cc_dim2) *
174 cc_dim1] - (cc[m1 + (i__ + ((k << 2) + 3) * cc_dim2) *
175 cc_dim1] - cc[m1 + (ic + ((k << 2) + 2) * cc_dim2) *
176 cc_dim1])) + wa2[i__ - 1] * (cc[m1 + (i__ - 1 + ((k <<
177 2) + 1) * cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + ((
178 k << 2) + 4) * cc_dim2) * cc_dim1] - (cc[m1 + (i__ -
179 1 + ((k << 2) + 3) * cc_dim2) * cc_dim1] + cc[m1 + (
180 ic - 1 + ((k << 2) + 2) * cc_dim2) * cc_dim1]));
181 ch[m2 + (i__ - 1 + (k + (ch_dim3 << 2)) * ch_dim2) * ch_dim1]
182 = wa3[i__ - 2] * (cc[m1 + (i__ - 1 + ((k << 2) + 1) *
183 cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + ((k << 2) + 4)
184 * cc_dim2) * cc_dim1] + (cc[m1 + (i__ + ((k << 2) +
185 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic + ((k << 2) +
186 2) * cc_dim2) * cc_dim1])) - wa3[i__ - 1] * (cc[m1 + (
187 i__ + ((k << 2) + 1) * cc_dim2) * cc_dim1] + cc[m1 + (
188 ic + ((k << 2) + 4) * cc_dim2) * cc_dim1] - (cc[m1 + (
189 i__ - 1 + ((k << 2) + 3) * cc_dim2) * cc_dim1] - cc[
190 m1 + (ic - 1 + ((k << 2) + 2) * cc_dim2) * cc_dim1]));
191 ch[m2 + (i__ + (k + (ch_dim3 << 2)) * ch_dim2) * ch_dim1] =
192 wa3[i__ - 2] * (cc[m1 + (i__ + ((k << 2) + 1) *
193 cc_dim2) * cc_dim1] + cc[m1 + (ic + ((k << 2) + 4) *
194 cc_dim2) * cc_dim1] - (cc[m1 + (i__ - 1 + ((k << 2) +
195 3) * cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + ((k << 2)
196 + 2) * cc_dim2) * cc_dim1])) + wa3[i__ - 1] * (cc[m1
197 + (i__ - 1 + ((k << 2) + 1) * cc_dim2) * cc_dim1] -
198 cc[m1 + (ic - 1 + ((k << 2) + 4) * cc_dim2) * cc_dim1]
199 + (cc[m1 + (i__ + ((k << 2) + 3) * cc_dim2) *
200 cc_dim1] + cc[m1 + (ic + ((k << 2) + 2) * cc_dim2) *
201 cc_dim1]));
202/* L1002: */
203 }
204/* L103: */
205 }
206/* L104: */
207 }
208 if (*ido % 2 == 1) {
209 return 0;
210 }
211L105:
212 i__1 = *l1;
213 for (k = 1; k <= i__1; ++k) {
214 m2 = m2s;
215 i__3 = m1d;
216 i__4 = *im1;
217 for (m1 = 1; i__4 < 0 ? m1 >= i__3 : m1 <= i__3; m1 += i__4) {
218 m2 += *im2;
219 ch[m2 + (*ido + (k + ch_dim3) * ch_dim2) * ch_dim1] = cc[m1 + (*
220 ido + ((k << 2) + 1) * cc_dim2) * cc_dim1] + cc[m1 + (*
221 ido + ((k << 2) + 3) * cc_dim2) * cc_dim1] + (cc[m1 + (*
222 ido + ((k << 2) + 1) * cc_dim2) * cc_dim1] + cc[m1 + (*
223 ido + ((k << 2) + 3) * cc_dim2) * cc_dim1]);
224 ch[m2 + (*ido + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1] =
225 sqrt2 * (cc[m1 + (*ido + ((k << 2) + 1) * cc_dim2) *
226 cc_dim1] - cc[m1 + (*ido + ((k << 2) + 3) * cc_dim2) *
227 cc_dim1] - (cc[m1 + (((k << 2) + 2) * cc_dim2 + 1) *
228 cc_dim1] + cc[m1 + (((k << 2) + 4) * cc_dim2 + 1) *
229 cc_dim1]));
230 ch[m2 + (*ido + (k + ch_dim3 * 3) * ch_dim2) * ch_dim1] = cc[m1 +
231 (((k << 2) + 4) * cc_dim2 + 1) * cc_dim1] - cc[m1 + (((k
232 << 2) + 2) * cc_dim2 + 1) * cc_dim1] + (cc[m1 + (((k << 2)
233 + 4) * cc_dim2 + 1) * cc_dim1] - cc[m1 + (((k << 2) + 2)
234 * cc_dim2 + 1) * cc_dim1]);
235 ch[m2 + (*ido + (k + (ch_dim3 << 2)) * ch_dim2) * ch_dim1] =
236 -sqrt2 * (cc[m1 + (*ido + ((k << 2) + 1) * cc_dim2) *
237 cc_dim1] - cc[m1 + (*ido + ((k << 2) + 3) * cc_dim2) *
238 cc_dim1] + (cc[m1 + (((k << 2) + 2) * cc_dim2 + 1) *
239 cc_dim1] + cc[m1 + (((k << 2) + 4) * cc_dim2 + 1) *
240 cc_dim1]));
241/* L1003: */
242 }
243/* L106: */
244 }
245L107:
246 return 0;
247} /* mradb4_ */
248