PLaSK library
Loading...
Searching...
No Matches
r1f2kb.c
Go to the documentation of this file.
1/* r1f2kb.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 r1f2kb_(integer *ido, integer *l1, doublereal *cc,
46 integer *in1, doublereal *ch, integer *in2, doublereal *wa1)
47{
48 /* System generated locals */
49 integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_dim2, ch_dim3, ch_offset,
50 i__1, i__2;
51
52 /* Local variables */
53 integer i__, k, ic, idp2;
54
55
56 /* Parameter adjustments */
57 --wa1;
58 cc_dim1 = *in1;
59 cc_dim2 = *ido;
60 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * 3);
61 cc -= cc_offset;
62 ch_dim1 = *in2;
63 ch_dim2 = *ido;
64 ch_dim3 = *l1;
65 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * (1 + ch_dim3));
66 ch -= ch_offset;
67
68 /* Function Body */
69 i__1 = *l1;
70 for (k = 1; k <= i__1; ++k) {
71 ch[((k + ch_dim3) * ch_dim2 + 1) * ch_dim1 + 1] = cc[(((k << 1) + 1) *
72 cc_dim2 + 1) * cc_dim1 + 1] + cc[(*ido + ((k << 1) + 2) *
73 cc_dim2) * cc_dim1 + 1];
74 ch[((k + (ch_dim3 << 1)) * ch_dim2 + 1) * ch_dim1 + 1] = cc[(((k << 1)
75 + 1) * cc_dim2 + 1) * cc_dim1 + 1] - cc[(*ido + ((k << 1) +
76 2) * cc_dim2) * cc_dim1 + 1];
77/* L101: */
78 }
79 if ((i__1 = *ido - 2) < 0) {
80 goto L107;
81 } else if (i__1 == 0) {
82 goto L105;
83 } else {
84 goto L102;
85 }
86L102:
87 idp2 = *ido + 2;
88 i__1 = *l1;
89 for (k = 1; k <= i__1; ++k) {
90 i__2 = *ido;
91 for (i__ = 3; i__ <= i__2; i__ += 2) {
92 ic = idp2 - i__;
93 ch[(i__ - 1 + (k + ch_dim3) * ch_dim2) * ch_dim1 + 1] = cc[(i__ -
94 1 + ((k << 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(ic - 1
95 + ((k << 1) + 2) * cc_dim2) * cc_dim1 + 1];
96 ch[(i__ + (k + ch_dim3) * ch_dim2) * ch_dim1 + 1] = cc[(i__ + ((k
97 << 1) + 1) * cc_dim2) * cc_dim1 + 1] - cc[(ic + ((k << 1)
98 + 2) * cc_dim2) * cc_dim1 + 1];
99 ch[(i__ - 1 + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1 + 1] =
100 wa1[i__ - 2] * (cc[(i__ - 1 + ((k << 1) + 1) * cc_dim2) *
101 cc_dim1 + 1] - cc[(ic - 1 + ((k << 1) + 2) * cc_dim2) *
102 cc_dim1 + 1]) - wa1[i__ - 1] * (cc[(i__ + ((k << 1) + 1) *
103 cc_dim2) * cc_dim1 + 1] + cc[(ic + ((k << 1) + 2) *
104 cc_dim2) * cc_dim1 + 1]);
105 ch[(i__ + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1 + 1] = wa1[
106 i__ - 2] * (cc[(i__ + ((k << 1) + 1) * cc_dim2) * cc_dim1
107 + 1] + cc[(ic + ((k << 1) + 2) * cc_dim2) * cc_dim1 + 1])
108 + wa1[i__ - 1] * (cc[(i__ - 1 + ((k << 1) + 1) * cc_dim2)
109 * cc_dim1 + 1] - cc[(ic - 1 + ((k << 1) + 2) * cc_dim2) *
110 cc_dim1 + 1]);
111/* L103: */
112 }
113/* L104: */
114 }
115 if (*ido % 2 == 1) {
116 return 0;
117 }
118L105:
119 i__1 = *l1;
120 for (k = 1; k <= i__1; ++k) {
121 ch[(*ido + (k + ch_dim3) * ch_dim2) * ch_dim1 + 1] = cc[(*ido + ((k <<
122 1) + 1) * cc_dim2) * cc_dim1 + 1] + cc[(*ido + ((k << 1) + 1)
123 * cc_dim2) * cc_dim1 + 1];
124 ch[(*ido + (k + (ch_dim3 << 1)) * ch_dim2) * ch_dim1 + 1] = -(cc[(((k
125 << 1) + 2) * cc_dim2 + 1) * cc_dim1 + 1] + cc[(((k << 1) + 2)
126 * cc_dim2 + 1) * cc_dim1 + 1]);
127/* L106: */
128 }
129L107:
130 return 0;
131} /* r1f2kb_ */
132