PLaSK library
Loading...
Searching...
No Matches
r1f3kf.c
Go to the documentation of this file.
1/* r1f3kf.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 r1f3kf_(integer *ido, integer *l1, doublereal *cc,
46 integer *in1, doublereal *ch, integer *in2, doublereal *wa1,
47 doublereal *wa2)
48{
49 /* System generated locals */
50 integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_dim3, cc_offset,
51 i__1, i__2;
52
53 /* Builtin functions */
54 double atan(doublereal), cos(doublereal), sin(doublereal);
55
56 /* Local variables */
57 integer i__, k, ic;
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_dim3 = *l1;
69 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
70 cc -= cc_offset;
71 ch_dim1 = *in2;
72 ch_dim2 = *ido;
73 ch_offset = 1 + ch_dim1 * (1 + (ch_dim2 << 2));
74 ch -= ch_offset;
75
76 /* Function Body */
77 arg = atan(1.) * 8. / 3.;
78 taur = cos(arg);
79 taui = sin(arg);
80 i__1 = *l1;
81 for (k = 1; k <= i__1; ++k) {
82 ch[((k * 3 + 1) * ch_dim2 + 1) * ch_dim1 + 1] = cc[((k + cc_dim3) *
83 cc_dim2 + 1) * cc_dim1 + 1] + (cc[((k + (cc_dim3 << 1)) *
84 cc_dim2 + 1) * cc_dim1 + 1] + cc[((k + cc_dim3 * 3) * cc_dim2
85 + 1) * cc_dim1 + 1]);
86 ch[((k * 3 + 3) * ch_dim2 + 1) * ch_dim1 + 1] = taui * (cc[((k +
87 cc_dim3 * 3) * cc_dim2 + 1) * cc_dim1 + 1] - cc[((k + (
88 cc_dim3 << 1)) * cc_dim2 + 1) * cc_dim1 + 1]);
89 ch[(*ido + (k * 3 + 2) * ch_dim2) * ch_dim1 + 1] = cc[((k + cc_dim3) *
90 cc_dim2 + 1) * cc_dim1 + 1] + taur * (cc[((k + (cc_dim3 << 1)
91 ) * cc_dim2 + 1) * cc_dim1 + 1] + cc[((k + cc_dim3 * 3) *
92 cc_dim2 + 1) * cc_dim1 + 1]);
93/* L101: */
94 }
95 if (*ido == 1) {
96 return 0;
97 }
98 idp2 = *ido + 2;
99 i__1 = *l1;
100 for (k = 1; k <= i__1; ++k) {
101 i__2 = *ido;
102 for (i__ = 3; i__ <= i__2; i__ += 2) {
103 ic = idp2 - i__;
104 ch[(i__ - 1 + (k * 3 + 1) * ch_dim2) * ch_dim1 + 1] = cc[(i__ - 1
105 + (k + cc_dim3) * cc_dim2) * cc_dim1 + 1] + (wa1[i__ - 2]
106 * cc[(i__ - 1 + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1
107 + 1] + wa1[i__ - 1] * cc[(i__ + (k + (cc_dim3 << 1)) *
108 cc_dim2) * cc_dim1 + 1] + (wa2[i__ - 2] * cc[(i__ - 1 + (
109 k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] + wa2[i__ - 1]
110 * cc[(i__ + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1]));
111 ch[(i__ + (k * 3 + 1) * ch_dim2) * ch_dim1 + 1] = cc[(i__ + (k +
112 cc_dim3) * cc_dim2) * cc_dim1 + 1] + (wa1[i__ - 2] * cc[(
113 i__ + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] -
114 wa1[i__ - 1] * cc[(i__ - 1 + (k + (cc_dim3 << 1)) *
115 cc_dim2) * cc_dim1 + 1] + (wa2[i__ - 2] * cc[(i__ + (k +
116 cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] - wa2[i__ - 1] *
117 cc[(i__ - 1 + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1])
118 );
119 ch[(i__ - 1 + (k * 3 + 3) * ch_dim2) * ch_dim1 + 1] = cc[(i__ - 1
120 + (k + cc_dim3) * cc_dim2) * cc_dim1 + 1] + taur * (wa1[
121 i__ - 2] * cc[(i__ - 1 + (k + (cc_dim3 << 1)) * cc_dim2) *
122 cc_dim1 + 1] + wa1[i__ - 1] * cc[(i__ + (k + (cc_dim3 <<
123 1)) * cc_dim2) * cc_dim1 + 1] + (wa2[i__ - 2] * cc[(i__ -
124 1 + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] + wa2[i__
125 - 1] * cc[(i__ + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 +
126 1])) + taui * (wa1[i__ - 2] * cc[(i__ + (k + (cc_dim3 <<
127 1)) * cc_dim2) * cc_dim1 + 1] - wa1[i__ - 1] * cc[(i__ -
128 1 + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] - (wa2[
129 i__ - 2] * cc[(i__ + (k + cc_dim3 * 3) * cc_dim2) *
130 cc_dim1 + 1] - wa2[i__ - 1] * cc[(i__ - 1 + (k + cc_dim3 *
131 3) * cc_dim2) * cc_dim1 + 1]));
132 ch[(ic - 1 + (k * 3 + 2) * ch_dim2) * ch_dim1 + 1] = cc[(i__ - 1
133 + (k + cc_dim3) * cc_dim2) * cc_dim1 + 1] + taur * (wa1[
134 i__ - 2] * cc[(i__ - 1 + (k + (cc_dim3 << 1)) * cc_dim2) *
135 cc_dim1 + 1] + wa1[i__ - 1] * cc[(i__ + (k + (cc_dim3 <<
136 1)) * cc_dim2) * cc_dim1 + 1] + (wa2[i__ - 2] * cc[(i__ -
137 1 + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] + wa2[i__
138 - 1] * cc[(i__ + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 +
139 1])) - taui * (wa1[i__ - 2] * cc[(i__ + (k + (cc_dim3 <<
140 1)) * cc_dim2) * cc_dim1 + 1] - wa1[i__ - 1] * cc[(i__ -
141 1 + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] - (wa2[
142 i__ - 2] * cc[(i__ + (k + cc_dim3 * 3) * cc_dim2) *
143 cc_dim1 + 1] - wa2[i__ - 1] * cc[(i__ - 1 + (k + cc_dim3 *
144 3) * cc_dim2) * cc_dim1 + 1]));
145 ch[(i__ + (k * 3 + 3) * ch_dim2) * ch_dim1 + 1] = cc[(i__ + (k +
146 cc_dim3) * cc_dim2) * cc_dim1 + 1] + taur * (wa1[i__ - 2]
147 * cc[(i__ + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1]
148 - wa1[i__ - 1] * cc[(i__ - 1 + (k + (cc_dim3 << 1)) *
149 cc_dim2) * cc_dim1 + 1] + (wa2[i__ - 2] * cc[(i__ + (k +
150 cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] - wa2[i__ - 1] *
151 cc[(i__ - 1 + (k + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1])
152 ) + taui * (wa2[i__ - 2] * cc[(i__ - 1 + (k + cc_dim3 * 3)
153 * cc_dim2) * cc_dim1 + 1] + wa2[i__ - 1] * cc[(i__ + (k
154 + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1] - (wa1[i__ - 2] *
155 cc[(i__ - 1 + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1
156 + 1] + wa1[i__ - 1] * cc[(i__ + (k + (cc_dim3 << 1)) *
157 cc_dim2) * cc_dim1 + 1]));
158 ch[(ic + (k * 3 + 2) * ch_dim2) * ch_dim1 + 1] = taui * (wa2[i__
159 - 2] * cc[(i__ - 1 + (k + cc_dim3 * 3) * cc_dim2) *
160 cc_dim1 + 1] + wa2[i__ - 1] * cc[(i__ + (k + cc_dim3 * 3)
161 * cc_dim2) * cc_dim1 + 1] - (wa1[i__ - 2] * cc[(i__ - 1 +
162 (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] + wa1[i__
163 - 1] * cc[(i__ + (k + (cc_dim3 << 1)) * cc_dim2) *
164 cc_dim1 + 1])) - (cc[(i__ + (k + cc_dim3) * cc_dim2) *
165 cc_dim1 + 1] + taur * (wa1[i__ - 2] * cc[(i__ + (k + (
166 cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] - wa1[i__ - 1] *
167 cc[(i__ - 1 + (k + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 +
168 1] + (wa2[i__ - 2] * cc[(i__ + (k + cc_dim3 * 3) *
169 cc_dim2) * cc_dim1 + 1] - wa2[i__ - 1] * cc[(i__ - 1 + (k
170 + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1])));
171/* L102: */
172 }
173/* L103: */
174 }
175 return 0;
176} /* r1f3kf_ */
177