PLaSK library
Loading...
Searching...
No Matches
mradb3.c
Go to the documentation of this file.
1/* mradb3.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 mradb3_(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 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 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_offset = 1 + cc_dim1 * (1 + (cc_dim2 << 2));
69 cc -= cc_offset;
70 ch_dim1 = *in2;
71 ch_dim2 = *ido;
72 ch_dim3 = *l1;
73 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * (1 + ch_dim3));
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 + ch_dim3) * ch_dim2 + 1) * ch_dim1] = cc[m1 + ((k *
90 3 + 1) * cc_dim2 + 1) * cc_dim1] + cc[m1 + (*ido + (k * 3
91 + 2) * cc_dim2) * cc_dim1] * 2.;
92 ch[m2 + ((k + (ch_dim3 << 1)) * ch_dim2 + 1) * ch_dim1] = cc[m1 +
93 ((k * 3 + 1) * cc_dim2 + 1) * cc_dim1] + taur * 2. * cc[
94 m1 + (*ido + (k * 3 + 2) * cc_dim2) * cc_dim1] - taui *
95 2. * cc[m1 + ((k * 3 + 3) * cc_dim2 + 1) * cc_dim1];
96 ch[m2 + ((k + ch_dim3 * 3) * ch_dim2 + 1) * ch_dim1] = cc[m1 + ((
97 k * 3 + 1) * cc_dim2 + 1) * cc_dim1] + taur * 2. * cc[m1
98 + (*ido + (k * 3 + 2) * cc_dim2) * cc_dim1] + taui * 2. *
99 cc[m1 + ((k * 3 + 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 + ch_dim3) * ch_dim2) * ch_dim1] = cc[
119 m1 + (i__ - 1 + (k * 3 + 1) * cc_dim2) * cc_dim1] + (
120 cc[m1 + (i__ - 1 + (k * 3 + 3) * cc_dim2) * cc_dim1]
121 + cc[m1 + (ic - 1 + (k * 3 + 2) * cc_dim2) * cc_dim1])
122 ;
123 ch[m2 + (i__ + (k + ch_dim3) * ch_dim2) * ch_dim1] = cc[m1 + (
124 i__ + (k * 3 + 1) * cc_dim2) * cc_dim1] + (cc[m1 + (
125 i__ + (k * 3 + 3) * cc_dim2) * cc_dim1] - cc[m1 + (ic
126 + (k * 3 + 2) * cc_dim2) * cc_dim1]);
127 ch[m2 + (i__ - 1 + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1]
128 = wa1[i__ - 2] * (cc[m1 + (i__ - 1 + (k * 3 + 1) *
129 cc_dim2) * cc_dim1] + taur * (cc[m1 + (i__ - 1 + (k *
130 3 + 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + (k *
131 3 + 2) * cc_dim2) * cc_dim1]) - taui * (cc[m1 + (i__
132 + (k * 3 + 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic + (
133 k * 3 + 2) * cc_dim2) * cc_dim1])) - wa1[i__ - 1] * (
134 cc[m1 + (i__ + (k * 3 + 1) * cc_dim2) * cc_dim1] +
135 taur * (cc[m1 + (i__ + (k * 3 + 3) * cc_dim2) *
136 cc_dim1] - cc[m1 + (ic + (k * 3 + 2) * cc_dim2) *
137 cc_dim1]) + taui * (cc[m1 + (i__ - 1 + (k * 3 + 3) *
138 cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + (k * 3 + 2) *
139 cc_dim2) * cc_dim1]));
140 ch[m2 + (i__ + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1] =
141 wa1[i__ - 2] * (cc[m1 + (i__ + (k * 3 + 1) * cc_dim2)
142 * cc_dim1] + taur * (cc[m1 + (i__ + (k * 3 + 3) *
143 cc_dim2) * cc_dim1] - cc[m1 + (ic + (k * 3 + 2) *
144 cc_dim2) * cc_dim1]) + taui * (cc[m1 + (i__ - 1 + (k *
145 3 + 3) * cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + (k *
146 3 + 2) * cc_dim2) * cc_dim1])) + wa1[i__ - 1] * (cc[
147 m1 + (i__ - 1 + (k * 3 + 1) * cc_dim2) * cc_dim1] +
148 taur * (cc[m1 + (i__ - 1 + (k * 3 + 3) * cc_dim2) *
149 cc_dim1] + cc[m1 + (ic - 1 + (k * 3 + 2) * cc_dim2) *
150 cc_dim1]) - taui * (cc[m1 + (i__ + (k * 3 + 3) *
151 cc_dim2) * cc_dim1] + cc[m1 + (ic + (k * 3 + 2) *
152 cc_dim2) * cc_dim1]));
153 ch[m2 + (i__ - 1 + (k + ch_dim3 * 3) * ch_dim2) * ch_dim1] =
154 wa2[i__ - 2] * (cc[m1 + (i__ - 1 + (k * 3 + 1) *
155 cc_dim2) * cc_dim1] + taur * (cc[m1 + (i__ - 1 + (k *
156 3 + 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic - 1 + (k *
157 3 + 2) * cc_dim2) * cc_dim1]) + taui * (cc[m1 + (i__
158 + (k * 3 + 3) * cc_dim2) * cc_dim1] + cc[m1 + (ic + (
159 k * 3 + 2) * cc_dim2) * cc_dim1])) - wa2[i__ - 1] * (
160 cc[m1 + (i__ + (k * 3 + 1) * cc_dim2) * cc_dim1] +
161 taur * (cc[m1 + (i__ + (k * 3 + 3) * cc_dim2) *
162 cc_dim1] - cc[m1 + (ic + (k * 3 + 2) * cc_dim2) *
163 cc_dim1]) - taui * (cc[m1 + (i__ - 1 + (k * 3 + 3) *
164 cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + (k * 3 + 2) *
165 cc_dim2) * cc_dim1]));
166 ch[m2 + (i__ + (k + ch_dim3 * 3) * ch_dim2) * ch_dim1] = wa2[
167 i__ - 2] * (cc[m1 + (i__ + (k * 3 + 1) * cc_dim2) *
168 cc_dim1] + taur * (cc[m1 + (i__ + (k * 3 + 3) *
169 cc_dim2) * cc_dim1] - cc[m1 + (ic + (k * 3 + 2) *
170 cc_dim2) * cc_dim1]) - taui * (cc[m1 + (i__ - 1 + (k *
171 3 + 3) * cc_dim2) * cc_dim1] - cc[m1 + (ic - 1 + (k *
172 3 + 2) * cc_dim2) * cc_dim1])) + wa2[i__ - 1] * (cc[
173 m1 + (i__ - 1 + (k * 3 + 1) * cc_dim2) * cc_dim1] +
174 taur * (cc[m1 + (i__ - 1 + (k * 3 + 3) * cc_dim2) *
175 cc_dim1] + cc[m1 + (ic - 1 + (k * 3 + 2) * cc_dim2) *
176 cc_dim1]) + taui * (cc[m1 + (i__ + (k * 3 + 3) *
177 cc_dim2) * cc_dim1] + cc[m1 + (ic + (k * 3 + 2) *
178 cc_dim2) * cc_dim1]));
179/* L1002: */
180 }
181/* L102: */
182 }
183/* L103: */
184 }
185 return 0;
186} /* mradb3_ */
187