PLaSK library
Loading...
Searching...
No Matches
rfftf1.c
Go to the documentation of this file.
1/* rfftf1.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 rfftf1_(integer *n, integer *in, doublereal *c__,
50 doublereal *ch, doublereal *wa, doublereal *fac)
51{
52 /* System generated locals */
53 integer c_dim1, c_offset, i__1;
54
55 /* Local variables */
56 integer j, k1, l1, l2, 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 r1f2kf_(integer *, integer *, doublereal *,
63 integer *, doublereal *, integer *, doublereal *), r1f3kf_(
64 integer *, integer *, doublereal *, integer *, doublereal *,
65 integer *, doublereal *, doublereal *), r1f4kf_(integer *,
66 integer *, doublereal *, integer *, doublereal *, integer *,
67 doublereal *, doublereal *, doublereal *), r1f5kf_(integer *,
68 integer *, doublereal *, integer *, doublereal *, integer *,
69 doublereal *, doublereal *, doublereal *, doublereal *), r1fgkf_(
70 integer *, integer *, integer *, integer *, doublereal *,
71 doublereal *, doublereal *, integer *, doublereal *, doublereal *,
72 integer *, doublereal *);
73
74
75 /* Parameter adjustments */
76 --wa;
77 c_dim1 = *in;
78 c_offset = 1 + c_dim1;
79 c__ -= c_offset;
80 --ch;
81 --fac;
82
83 /* Function Body */
84 nf = (integer) fac[2];
85 na = 1;
86 l2 = *n;
87 iw = *n;
88 i__1 = nf;
89 for (k1 = 1; k1 <= i__1; ++k1) {
90 kh = nf - k1;
91 ip = (integer) fac[kh + 3];
92 l1 = l2 / ip;
93 ido = *n / l2;
94 idl1 = ido * l1;
95 iw -= (ip - 1) * ido;
96 na = 1 - na;
97 if (ip != 4) {
98 goto L102;
99 }
100 ix2 = iw + ido;
101 ix3 = ix2 + ido;
102 if (na != 0) {
103 goto L101;
104 }
105 r1f4kf_(&ido, &l1, &c__[c_offset], in, &ch[1], &c__1, &wa[iw], &wa[
106 ix2], &wa[ix3]);
107 goto L110;
108L101:
109 r1f4kf_(&ido, &l1, &ch[1], &c__1, &c__[c_offset], in, &wa[iw], &wa[
110 ix2], &wa[ix3]);
111 goto L110;
112L102:
113 if (ip != 2) {
114 goto L104;
115 }
116 if (na != 0) {
117 goto L103;
118 }
119 r1f2kf_(&ido, &l1, &c__[c_offset], in, &ch[1], &c__1, &wa[iw]);
120 goto L110;
121L103:
122 r1f2kf_(&ido, &l1, &ch[1], &c__1, &c__[c_offset], in, &wa[iw]);
123 goto L110;
124L104:
125 if (ip != 3) {
126 goto L106;
127 }
128 ix2 = iw + ido;
129 if (na != 0) {
130 goto L105;
131 }
132 r1f3kf_(&ido, &l1, &c__[c_offset], in, &ch[1], &c__1, &wa[iw], &wa[
133 ix2]);
134 goto L110;
135L105:
136 r1f3kf_(&ido, &l1, &ch[1], &c__1, &c__[c_offset], in, &wa[iw], &wa[
137 ix2]);
138 goto L110;
139L106:
140 if (ip != 5) {
141 goto L108;
142 }
143 ix2 = iw + ido;
144 ix3 = ix2 + ido;
145 ix4 = ix3 + ido;
146 if (na != 0) {
147 goto L107;
148 }
149 r1f5kf_(&ido, &l1, &c__[c_offset], in, &ch[1], &c__1, &wa[iw], &wa[
150 ix2], &wa[ix3], &wa[ix4]);
151 goto L110;
152L107:
153 r1f5kf_(&ido, &l1, &ch[1], &c__1, &c__[c_offset], in, &wa[iw], &wa[
154 ix2], &wa[ix3], &wa[ix4]);
155 goto L110;
156L108:
157 if (ido == 1) {
158 na = 1 - na;
159 }
160 if (na != 0) {
161 goto L109;
162 }
163 r1fgkf_(&ido, &ip, &l1, &idl1, &c__[c_offset], &c__[c_offset], &c__[
164 c_offset], in, &ch[1], &ch[1], &c__1, &wa[iw]);
165 na = 1;
166 goto L110;
167L109:
168 r1fgkf_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__1, &c__[
169 c_offset], &c__[c_offset], in, &wa[iw]);
170 na = 0;
171L110:
172 l2 = l1;
173/* L111: */
174 }
175 sn = 1. / *n;
176 tsn = 2. / *n;
177 tsnm = -tsn;
178 modn = *n % 2;
179 nl = *n - 2;
180 if (modn != 0) {
181 nl = *n - 1;
182 }
183 if (na != 0) {
184 goto L120;
185 }
186 c__[c_dim1 + 1] = sn * ch[1];
187 i__1 = nl;
188 for (j = 2; j <= i__1; j += 2) {
189 c__[j * c_dim1 + 1] = tsn * ch[j];
190 c__[(j + 1) * c_dim1 + 1] = tsnm * ch[j + 1];
191/* L118: */
192 }
193 if (modn != 0) {
194 return 0;
195 }
196 c__[*n * c_dim1 + 1] = sn * ch[*n];
197 return 0;
198L120:
199 c__[c_dim1 + 1] = sn * c__[c_dim1 + 1];
200 i__1 = nl;
201 for (j = 2; j <= i__1; j += 2) {
202 c__[j * c_dim1 + 1] = tsn * c__[j * c_dim1 + 1];
203 c__[(j + 1) * c_dim1 + 1] = tsnm * c__[(j + 1) * c_dim1 + 1];
204/* L122: */
205 }
206 if (modn != 0) {
207 return 0;
208 }
209 c__[*n * c_dim1 + 1] = sn * c__[*n * c_dim1 + 1];
210 return 0;
211} /* rfftf1_ */
212