PLaSK library
Loading...
Searching...
No Matches
mrftf1.c
Go to the documentation of this file.
1/* mrftf1.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 mrftf1_(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, kh, nf, ip, nl, iw;
57 doublereal sn;
58 integer ix2, ix3, ix4, ido;
59 doublereal tsn;
60 integer idl1, modn;
61 doublereal tsnm;
62 extern /* Subroutine */ int mradf2_(integer *, integer *, integer *,
63 doublereal *, integer *, integer *, doublereal *, integer *,
64 integer *, doublereal *), mradf3_(integer *, integer *, integer *,
65 doublereal *, integer *, integer *, doublereal *, integer *,
66 integer *, doublereal *, doublereal *), mradf4_(integer *,
67 integer *, integer *, doublereal *, integer *, integer *,
68 doublereal *, integer *, integer *, doublereal *, doublereal *,
69 doublereal *), mradf5_(integer *, integer *, integer *,
70 doublereal *, integer *, integer *, doublereal *, integer *,
71 integer *, doublereal *, doublereal *, doublereal *, doublereal *)
72 , mradfg_(integer *, integer *, integer *, integer *, integer *,
73 doublereal *, doublereal *, doublereal *, integer *, integer *,
74 doublereal *, doublereal *, integer *, integer *, doublereal *);
75
76
77 /* Parameter adjustments */
78 ch_dim1 = *m;
79 ch_offset = 1 + ch_dim1;
80 ch -= ch_offset;
81 --wa;
82 c_dim1 = *in;
83 c_offset = 1 + c_dim1;
84 c__ -= c_offset;
85 --fac;
86
87 /* Function Body */
88 nf = (integer) fac[2];
89 na = 1;
90 l2 = *n;
91 iw = *n;
92 i__1 = nf;
93 for (k1 = 1; k1 <= i__1; ++k1) {
94 kh = nf - k1;
95 ip = (integer) fac[kh + 3];
96 l1 = l2 / ip;
97 ido = *n / l2;
98 idl1 = ido * l1;
99 iw -= (ip - 1) * ido;
100 na = 1 - na;
101 if (ip != 4) {
102 goto L102;
103 }
104 ix2 = iw + ido;
105 ix3 = ix2 + ido;
106 if (na != 0) {
107 goto L101;
108 }
109 mradf4_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
110 m, &wa[iw], &wa[ix2], &wa[ix3]);
111 goto L110;
112L101:
113 mradf4_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
114 in, &wa[iw], &wa[ix2], &wa[ix3]);
115 goto L110;
116L102:
117 if (ip != 2) {
118 goto L104;
119 }
120 if (na != 0) {
121 goto L103;
122 }
123 mradf2_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
124 m, &wa[iw]);
125 goto L110;
126L103:
127 mradf2_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
128 in, &wa[iw]);
129 goto L110;
130L104:
131 if (ip != 3) {
132 goto L106;
133 }
134 ix2 = iw + ido;
135 if (na != 0) {
136 goto L105;
137 }
138 mradf3_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
139 m, &wa[iw], &wa[ix2]);
140 goto L110;
141L105:
142 mradf3_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
143 in, &wa[iw], &wa[ix2]);
144 goto L110;
145L106:
146 if (ip != 5) {
147 goto L108;
148 }
149 ix2 = iw + ido;
150 ix3 = ix2 + ido;
151 ix4 = ix3 + ido;
152 if (na != 0) {
153 goto L107;
154 }
155 mradf5_(m, &ido, &l1, &c__[c_offset], im, in, &ch[ch_offset], &c__1,
156 m, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
157 goto L110;
158L107:
159 mradf5_(m, &ido, &l1, &ch[ch_offset], &c__1, m, &c__[c_offset], im,
160 in, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
161 goto L110;
162L108:
163 if (ido == 1) {
164 na = 1 - na;
165 }
166 if (na != 0) {
167 goto L109;
168 }
169 mradfg_(m, &ido, &ip, &l1, &idl1, &c__[c_offset], &c__[c_offset], &
170 c__[c_offset], im, in, &ch[ch_offset], &ch[ch_offset], &c__1,
171 m, &wa[iw]);
172 na = 1;
173 goto L110;
174L109:
175 mradfg_(m, &ido, &ip, &l1, &idl1, &ch[ch_offset], &ch[ch_offset], &ch[
176 ch_offset], &c__1, m, &c__[c_offset], &c__[c_offset], im, in,
177 &wa[iw]);
178 na = 0;
179L110:
180 l2 = l1;
181/* L111: */
182 }
183 sn = 1. / *n;
184 tsn = 2. / *n;
185 tsnm = -tsn;
186 modn = *n % 2;
187 nl = *n - 2;
188 if (modn != 0) {
189 nl = *n - 1;
190 }
191 if (na != 0) {
192 goto L120;
193 }
194 m2 = 1 - *im;
195 i__1 = *m;
196 for (i__ = 1; i__ <= i__1; ++i__) {
197 m2 += *im;
198 c__[m2 + c_dim1] = sn * ch[i__ + ch_dim1];
199/* L117: */
200 }
201 i__1 = nl;
202 for (j = 2; j <= i__1; j += 2) {
203 m2 = 1 - *im;
204 i__2 = *m;
205 for (i__ = 1; i__ <= i__2; ++i__) {
206 m2 += *im;
207 c__[m2 + j * c_dim1] = tsn * ch[i__ + j * ch_dim1];
208 c__[m2 + (j + 1) * c_dim1] = tsnm * ch[i__ + (j + 1) * ch_dim1];
209/* L118: */
210 }
211 }
212 if (modn != 0) {
213 return 0;
214 }
215 m2 = 1 - *im;
216 i__2 = *m;
217 for (i__ = 1; i__ <= i__2; ++i__) {
218 m2 += *im;
219 c__[m2 + *n * c_dim1] = sn * ch[i__ + *n * ch_dim1];
220/* L119: */
221 }
222 return 0;
223L120:
224 m2 = 1 - *im;
225 i__2 = *m;
226 for (i__ = 1; i__ <= i__2; ++i__) {
227 m2 += *im;
228 c__[m2 + c_dim1] = sn * c__[m2 + c_dim1];
229/* L121: */
230 }
231 i__2 = nl;
232 for (j = 2; j <= i__2; j += 2) {
233 m2 = 1 - *im;
234 i__1 = *m;
235 for (i__ = 1; i__ <= i__1; ++i__) {
236 m2 += *im;
237 c__[m2 + j * c_dim1] = tsn * c__[m2 + j * c_dim1];
238 c__[m2 + (j + 1) * c_dim1] = tsnm * c__[m2 + (j + 1) * c_dim1];
239/* L122: */
240 }
241 }
242 if (modn != 0) {
243 return 0;
244 }
245 m2 = 1 - *im;
246 i__1 = *m;
247 for (i__ = 1; i__ <= i__1; ++i__) {
248 m2 += *im;
249 c__[m2 + *n * c_dim1] = sn * c__[m2 + *n * c_dim1];
250/* L123: */
251 }
252 return 0;
253} /* mrftf1_ */
254