PLaSK library
Loading...
Searching...
No Matches
c1f3kf.c
Go to the documentation of this file.
1/* c1f3kf.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 c1f3kf_(integer *ido, integer *l1, integer *na,
46 doublereal *cc, integer *in1, doublereal *ch, integer *in2,
47 doublereal *wa)
48{
49 /* Initialized data */
50
51 static doublereal taur = -.5;
52 static doublereal taui = -.866025403784439;
53
54 /* System generated locals */
55 integer cc_dim1, cc_dim2, cc_dim3, cc_offset, ch_dim1, ch_dim2, ch_offset,
56 wa_dim1, wa_offset, i__1, i__2;
57
58 /* Local variables */
59 integer i__, k;
60 doublereal sn, ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
61
62 /* Parameter adjustments */
63 wa_dim1 = *ido;
64 wa_offset = 1 + wa_dim1 * 3;
65 wa -= wa_offset;
66 cc_dim1 = *in1;
67 cc_dim2 = *l1;
68 cc_dim3 = *ido;
69 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
70 cc -= cc_offset;
71 ch_dim1 = *in2;
72 ch_dim2 = *l1;
73 ch_offset = 1 + ch_dim1 * (1 + (ch_dim2 << 2));
74 ch -= ch_offset;
75
76 /* Function Body */
77
78 if (*ido > 1) {
79 goto L102;
80 }
81 sn = 1. / (doublereal) (*l1 * 3);
82 if (*na == 1) {
83 goto L106;
84 }
85 i__1 = *l1;
86 for (k = 1; k <= i__1; ++k) {
87 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
88 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
89 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + taur * tr2;
90 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cc[(k + (
91 cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + tr2);
92 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
93 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
94 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + taur * ti2;
95 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (cc[(k + (
96 cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + ti2);
97 cr3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1]
98 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1]);
99 ci3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2]
100 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2]);
101 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr2 -
102 ci3);
103 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cr2 + ci3)
104 ;
105 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci2 +
106 cr3);
107 cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2] = sn * (ci2 - cr3)
108 ;
109/* L101: */
110 }
111 return 0;
112L106:
113 i__1 = *l1;
114 for (k = 1; k <= i__1; ++k) {
115 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
116 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
117 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + taur * tr2;
118 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = sn * (cc[(k + (cc_dim3 + 1) *
119 cc_dim2) * cc_dim1 + 1] + tr2);
120 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
121 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
122 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + taur * ti2;
123 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = sn * (cc[(k + (cc_dim3 + 1) *
124 cc_dim2) * cc_dim1 + 2] + ti2);
125 cr3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1]
126 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1]);
127 ci3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2]
128 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2]);
129 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = sn * (cr2 - ci3);
130 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = sn * (cr2 + ci3);
131 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = sn * (ci2 + cr3);
132 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = sn * (ci2 - cr3);
133/* L107: */
134 }
135 return 0;
136L102:
137 i__1 = *l1;
138 for (k = 1; k <= i__1; ++k) {
139 tr2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(k
140 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1];
141 cr2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + taur * tr2;
142 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cc[(k + (cc_dim3 + 1) *
143 cc_dim2) * cc_dim1 + 1] + tr2;
144 ti2 = cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] + cc[(k
145 + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2];
146 ci2 = cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + taur * ti2;
147 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = cc[(k + (cc_dim3 + 1) *
148 cc_dim2) * cc_dim1 + 2] + ti2;
149 cr3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1]
150 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 1]);
151 ci3 = taui * (cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2]
152 - cc[(k + (cc_dim3 * 3 + 1) * cc_dim2) * cc_dim1 + 2]);
153 ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 - ci3;
154 ch[(k + ch_dim2 * 6) * ch_dim1 + 1] = cr2 + ci3;
155 ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 + cr3;
156 ch[(k + ch_dim2 * 6) * ch_dim1 + 2] = ci2 - cr3;
157/* L103: */
158 }
159 i__1 = *ido;
160 for (i__ = 2; i__ <= i__1; ++i__) {
161 i__2 = *l1;
162 for (k = 1; k <= i__2; ++k) {
163 tr2 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1] +
164 cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 1];
165 cr2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] + taur *
166 tr2;
167 ch[(k + (i__ * 3 + 1) * ch_dim2) * ch_dim1 + 1] = cc[(k + (i__ +
168 cc_dim3) * cc_dim2) * cc_dim1 + 1] + tr2;
169 ti2 = cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2] +
170 cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 + 2];
171 ci2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] + taur *
172 ti2;
173 ch[(k + (i__ * 3 + 1) * ch_dim2) * ch_dim1 + 2] = cc[(k + (i__ +
174 cc_dim3) * cc_dim2) * cc_dim1 + 2] + ti2;
175 cr3 = taui * (cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1
176 + 1] - cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 +
177 1]);
178 ci3 = taui * (cc[(k + (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1
179 + 2] - cc[(k + (i__ + cc_dim3 * 3) * cc_dim2) * cc_dim1 +
180 2]);
181 dr2 = cr2 - ci3;
182 dr3 = cr2 + ci3;
183 di2 = ci2 + cr3;
184 di3 = ci2 - cr3;
185 ch[(k + (i__ * 3 + 2) * ch_dim2) * ch_dim1 + 2] = wa[i__ +
186 wa_dim1 * 3] * di2 - wa[i__ + wa_dim1 * 5] * dr2;
187 ch[(k + (i__ * 3 + 2) * ch_dim2) * ch_dim1 + 1] = wa[i__ +
188 wa_dim1 * 3] * dr2 + wa[i__ + wa_dim1 * 5] * di2;
189 ch[(k + (i__ * 3 + 3) * ch_dim2) * ch_dim1 + 2] = wa[i__ + (
190 wa_dim1 << 2)] * di3 - wa[i__ + wa_dim1 * 6] * dr3;
191 ch[(k + (i__ * 3 + 3) * ch_dim2) * ch_dim1 + 1] = wa[i__ + (
192 wa_dim1 << 2)] * dr3 + wa[i__ + wa_dim1 * 6] * di3;
193/* L104: */
194 }
195/* L105: */
196 }
197 return 0;
198} /* c1f3kf_ */
199