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