PLaSK library
Loading...
Searching...
No Matches
mrftb1.c
Go to the documentation of this file.
1/* mrftb1.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/* Table of constant values */
16
17static integer c__1 = 1;
18
19/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
20/* * * */
21/* * copyright (c) 2011 by UCAR * */
22/* * * */
23/* * University Corporation for Atmospheric Research * */
24/* * * */
25/* * all rights reserved * */
26/* * * */
27/* * FFTPACK version 5.1 * */
28/* * * */
29/* * A Fortran Package of Fast Fourier * */
30/* * * */
31/* * Subroutines and Example Programs * */
32/* * * */
33/* * by * */
34/* * * */
35/* * Paul Swarztrauber and Dick Valent * */
36/* * * */
37/* * of * */
38/* * * */
39/* * the National Center for Atmospheric Research * */
40/* * * */
41/* * Boulder, Colorado (80307) U.S.A. * */
42/* * * */
43/* * which is sponsored by * */
44/* * * */
45/* * the National Science Foundation * */
46/* * * */
47/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
48
49/* Subroutine */ int mrftb1_(integer *m, integer *im, integer *n, integer *in,
50 doublereal *c__, doublereal *ch, doublereal *wa, doublereal *fac)
51{
52 /* System generated locals */
53 integer ch_dim1, ch_offset, c_dim1, c_offset, i__1, i__2;
54
55 /* Local variables */
56 integer i__, j, k1, l1, l2, m2, na, nf, ip, nl, iw, ix2, ix3, ix4, ido,
57 idl1;
58 doublereal half;
59 integer modn;
60 doublereal halfm;
61 extern /* Subroutine */ int mradb2_(integer *, integer *, integer *,
62 doublereal *, integer *, integer *, doublereal *, integer *,
63 integer *, doublereal *), mradb3_(integer *, integer *, integer *,
64 doublereal *, integer *, integer *, doublereal *, integer *,
65 integer *, doublereal *, doublereal *), mradb4_(integer *,
66 integer *, integer *, doublereal *, integer *, integer *,
67 doublereal *, integer *, integer *, doublereal *, doublereal *,
68 doublereal *), mradb5_(integer *, integer *, integer *,
69 doublereal *, integer *, integer *, doublereal *, integer *,
70 integer *, doublereal *, doublereal *, doublereal *, doublereal *)
71 , mradbg_(integer *, integer *, integer *, integer *, integer *,
72 doublereal *, doublereal *, doublereal *, integer *, integer *,
73 doublereal *, doublereal *, integer *, integer *, doublereal *);
74
75
76 /* Parameter adjustments */
77 ch_dim1 = *m;
78 ch_offset = 1 + ch_dim1;
79 ch -= ch_offset;
80 --wa;
81 c_dim1 = *in;
82 c_offset = 1 + c_dim1;
83 c__ -= c_offset;
84 --fac;
85
86 /* Function Body */
87 nf = (integer) fac[2];
88 na = 0;
89 i__1 = nf;
90 for (k1 = 1; k1 <= i__1; ++k1) {
91 ip = (integer) fac[k1 + 2];
92 na = 1 - na;
93 if (ip <= 5) {
94 goto L10;
95 }
96 if (k1 == nf) {
97 goto L10;
98 }
99 na = 1 - na;
100L10:
101 ;
102 }
103 half = .5;
104 halfm = -.5;
105 modn = *n % 2;
106 nl = *n - 2;
107 if (modn != 0) {
108 nl = *n - 1;
109 }
110 if (na == 0) {
111 goto L120;
112 }
113 m2 = 1 - *im;
114 i__1 = *m;
115 for (i__ = 1; i__ <= i__1; ++i__) {
116 m2 += *im;
117 ch[i__ + ch_dim1] = c__[m2 + c_dim1];
118 ch[i__ + *n * ch_dim1] = c__[m2 + *n * c_dim1];
119/* L117: */
120 }
121 i__1 = nl;
122 for (j = 2; j <= i__1; j += 2) {
123 m2 = 1 - *im;
124 i__2 = *m;
125 for (i__ = 1; i__ <= i__2; ++i__) {
126 m2 += *im;
127 ch[i__ + j * ch_dim1] = half * c__[m2 + j * c_dim1];
128 ch[i__ + (j + 1) * ch_dim1] = halfm * c__[m2 + (j + 1) * c_dim1];
129/* L118: */
130 }
131 }
132 goto L124;
133L120:
134 i__2 = nl;
135 for (j = 2; j <= i__2; j += 2) {
136 m2 = 1 - *im;
137 i__1 = *m;
138 for (i__ = 1; i__ <= i__1; ++i__) {
139 m2 += *im;
140 c__[m2 + j * c_dim1] = half * c__[m2 + j * c_dim1];
141 c__[m2 + (j + 1) * c_dim1] = halfm * c__[m2 + (j + 1) * c_dim1];
142/* L122: */
143 }
144 }
145L124:
146 l1 = 1;
147 iw = 1;
148 i__1 = nf;
149 for (k1 = 1; k1 <= i__1; ++k1) {
150 ip = (integer) fac[k1 + 2];
151 l2 = ip * l1;
152 ido = *n / l2;
153 idl1 = ido * l1;
154 if (ip != 4) {
155 goto L103;
156 }
157 ix2 = iw + ido;
158 ix3 = ix2 + ido;
159 if (na != 0) {
160 goto L101;
161 }
162 mradb4_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
163 m, &wa[iw], &wa[ix2], &wa[ix3]);
164 goto L102;
165L101:
166 mradb4_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
167 in, &wa[iw], &wa[ix2], &wa[ix3]);
168L102:
169 na = 1 - na;
170 goto L115;
171L103:
172 if (ip != 2) {
173 goto L106;
174 }
175 if (na != 0) {
176 goto L104;
177 }
178 mradb2_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
179 m, &wa[iw]);
180 goto L105;
181L104:
182 mradb2_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
183 in, &wa[iw]);
184L105:
185 na = 1 - na;
186 goto L115;
187L106:
188 if (ip != 3) {
189 goto L109;
190 }
191 ix2 = iw + ido;
192 if (na != 0) {
193 goto L107;
194 }
195 mradb3_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
196 m, &wa[iw], &wa[ix2]);
197 goto L108;
198L107:
199 mradb3_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
200 in, &wa[iw], &wa[ix2]);
201L108:
202 na = 1 - na;
203 goto L115;
204L109:
205 if (ip != 5) {
206 goto L112;
207 }
208 ix2 = iw + ido;
209 ix3 = ix2 + ido;
210 ix4 = ix3 + ido;
211 if (na != 0) {
212 goto L110;
213 }
214 mradb5_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
215 m, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
216 goto L111;
217L110:
218 mradb5_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
219 in, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
220L111:
221 na = 1 - na;
222 goto L115;
223L112:
224 if (na != 0) {
225 goto L113;
226 }
227 mradbg_(m, &ido, &ip, &l1, &idl1, &c__[c_offset], &c__[c_offset], &
228 c__[c_offset], im, in, &ch[ch_offset], &ch[ch_offset], &c__1,
229 m, &wa[iw]);
230 goto L114;
231L113:
232 mradbg_(m, &ido, &ip, &l1, &idl1, &ch[ch_offset], &ch[ch_offset], &ch[
233 ch_offset], &c__1, m, &c__[c_offset], &c__[c_offset], im, in,
234 &wa[iw]);
235L114:
236 if (ido == 1) {
237 na = 1 - na;
238 }
239L115:
240 l1 = l2;
241 iw += (ip - 1) * ido;
242/* L116: */
243 }
244 return 0;
245} /* mrftb1_ */
246