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