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