PLaSK library
Loading...
Searching...
No Matches
cmf2kb.c
Go to the documentation of this file.
1/* cmf2kb.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 cmf2kb_(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, m1d;
55 doublereal ti2;
56 integer m2s;
57 doublereal tr2, chold1, chold2;
58
59
60 /* Parameter adjustments */
61 wa_dim1 = *ido;
62 wa_offset = 1 + (wa_dim1 << 1);
63 wa -= wa_offset;
64 cc_dim2 = *in1;
65 cc_dim3 = *l1;
66 cc_dim4 = *ido;
67 cc_offset = 1 + 2 * (1 + cc_dim2 * (1 + cc_dim3 * (1 + cc_dim4)));
68 cc -= cc_offset;
69 ch_dim2 = *in2;
70 ch_dim3 = *l1;
71 ch_offset = 1 + 2 * (1 + ch_dim2 * (1 + ch_dim3 * 3));
72 ch -= ch_offset;
73
74 /* Function Body */
75 m1d = (*lot - 1) * *im1 + 1;
76 m2s = 1 - *im2;
77 if (*ido > 1 || *na == 1) {
78 goto L102;
79 }
80 i__1 = *l1;
81 for (k = 1; k <= i__1; ++k) {
82 i__2 = m1d;
83 i__3 = *im1;
84 for (m1 = 1; i__3 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__3) {
85 chold1 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) +
86 1] + cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
87 cc_dim2 << 1) + 1];
88 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 1]
89 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1)
90 + 1] - cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
91 cc_dim2 << 1) + 1];
92 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] =
93 chold1;
94 chold2 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) +
95 2] + cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
96 cc_dim2 << 1) + 2];
97 cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 2]
98 = cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1)
99 + 2] - cc[(m1 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) *
100 cc_dim2 << 1) + 2];
101 cc[(m1 + (k + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] =
102 chold2;
103/* L101: */
104 }
105 }
106 return 0;
107L102:
108 i__3 = *l1;
109 for (k = 1; k <= i__3; ++k) {
110 m2 = m2s;
111 i__2 = m1d;
112 i__1 = *im1;
113 for (m1 = 1; i__1 < 0 ? m1 >= i__2 : m1 <= i__2; m1 += i__1) {
114 m2 += *im2;
115 ch[(m2 + (k + ch_dim3 * 3) * ch_dim2 << 1) + 1] = cc[(m1 + (k + (
116 cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] + cc[(m1 + (
117 k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 1];
118 ch[(m2 + (k + (ch_dim3 << 2)) * ch_dim2 << 1) + 1] = cc[(m1 + (k
119 + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 1] - cc[(m1
120 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) +
121 1];
122 ch[(m2 + (k + ch_dim3 * 3) * ch_dim2 << 1) + 2] = cc[(m1 + (k + (
123 cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] + cc[(m1 + (
124 k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) + 2];
125 ch[(m2 + (k + (ch_dim3 << 2)) * ch_dim2 << 1) + 2] = cc[(m1 + (k
126 + (cc_dim4 + 1) * cc_dim3) * cc_dim2 << 1) + 2] - cc[(m1
127 + (k + ((cc_dim4 << 1) + 1) * cc_dim3) * cc_dim2 << 1) +
128 2];
129/* L103: */
130 }
131 }
132 if (*ido == 1) {
133 return 0;
134 }
135 i__1 = *ido;
136 for (i__ = 2; i__ <= i__1; ++i__) {
137 i__2 = *l1;
138 for (k = 1; k <= i__2; ++k) {
139 m2 = m2s;
140 i__3 = m1d;
141 i__4 = *im1;
142 for (m1 = 1; i__4 < 0 ? m1 >= i__3 : m1 <= i__3; m1 += i__4) {
143 m2 += *im2;
144 ch[(m2 + (k + ((i__ << 1) + 1) * ch_dim3) * ch_dim2 << 1) + 1]
145 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2
146 << 1) + 1] + cc[(m1 + (k + (i__ + (cc_dim4 << 1)) *
147 cc_dim3) * cc_dim2 << 1) + 1];
148 tr2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
149 + 1] - cc[(m1 + (k + (i__ + (cc_dim4 << 1)) *
150 cc_dim3) * cc_dim2 << 1) + 1];
151 ch[(m2 + (k + ((i__ << 1) + 1) * ch_dim3) * ch_dim2 << 1) + 2]
152 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2
153 << 1) + 2] + cc[(m1 + (k + (i__ + (cc_dim4 << 1)) *
154 cc_dim3) * cc_dim2 << 1) + 2];
155 ti2 = cc[(m1 + (k + (i__ + cc_dim4) * cc_dim3) * cc_dim2 << 1)
156 + 2] - cc[(m1 + (k + (i__ + (cc_dim4 << 1)) *
157 cc_dim3) * cc_dim2 << 1) + 2];
158 ch[(m2 + (k + ((i__ << 1) + 2) * ch_dim3) * ch_dim2 << 1) + 2]
159 = wa[i__ + (wa_dim1 << 1)] * ti2 + wa[i__ + wa_dim1 *
160 3] * tr2;
161 ch[(m2 + (k + ((i__ << 1) + 2) * ch_dim3) * ch_dim2 << 1) + 1]
162 = wa[i__ + (wa_dim1 << 1)] * tr2 - wa[i__ + wa_dim1 *
163 3] * ti2;
164/* L104: */
165 }
166 }
167/* L105: */
168 }
169 return 0;
170} /* cmf2kb_ */
171