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