PLaSK library
Loading...
Searching...
No Matches
c1f2kf.c
Go to the documentation of this file.
1/* c1f2kf.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 c1f2kf_(integer *ido, integer *l1, integer *na,
46 doublereal *cc, integer *in1, doublereal *ch, integer *in2,
47 doublereal *wa)
48{
49 /* System generated locals */
50 integer cc_dim1, cc_dim2, cc_dim3, cc_offset, ch_dim1, ch_dim2, ch_offset,
51 wa_dim1, wa_offset, i__1, i__2;
52
53 /* Local variables */
54 integer i__, k;
55 doublereal sn, ti2, tr2, chold1, chold2;
56
57
58 /* Parameter adjustments */
59 wa_dim1 = *ido;
60 wa_offset = 1 + (wa_dim1 << 1);
61 wa -= wa_offset;
62 cc_dim1 = *in1;
63 cc_dim2 = *l1;
64 cc_dim3 = *ido;
65 cc_offset = 1 + cc_dim1 * (1 + cc_dim2 * (1 + cc_dim3));
66 cc -= cc_offset;
67 ch_dim1 = *in2;
68 ch_dim2 = *l1;
69 ch_offset = 1 + ch_dim1 * (1 + ch_dim2 * 3);
70 ch -= ch_offset;
71
72 /* Function Body */
73 if (*ido > 1) {
74 goto L102;
75 }
76 sn = 1. / (doublereal) (*l1 << 1);
77 if (*na == 1) {
78 goto L106;
79 }
80 i__1 = *l1;
81 for (k = 1; k <= i__1; ++k) {
82 chold1 = sn * (cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] + cc[(
83 k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1]);
84 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 1] = sn * (cc[(k
85 + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] - cc[(k + ((cc_dim3
86 << 1) + 1) * cc_dim2) * cc_dim1 + 1]);
87 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 1] = chold1;
88 chold2 = sn * (cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] + cc[(
89 k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2]);
90 cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) * cc_dim1 + 2] = sn * (cc[(k
91 + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] - cc[(k + ((cc_dim3
92 << 1) + 1) * cc_dim2) * cc_dim1 + 2]);
93 cc[(k + (cc_dim3 + 1) * cc_dim2) * cc_dim1 + 2] = chold2;
94/* L101: */
95 }
96 return 0;
97L106:
98 i__1 = *l1;
99 for (k = 1; k <= i__1; ++k) {
100 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = sn * (cc[(k + (cc_dim3 + 1) *
101 cc_dim2) * cc_dim1 + 1] + cc[(k + ((cc_dim3 << 1) + 1) *
102 cc_dim2) * cc_dim1 + 1]);
103 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = sn * (cc[(k + (cc_dim3 + 1) *
104 cc_dim2) * cc_dim1 + 1] - cc[(k + ((cc_dim3 << 1) + 1) *
105 cc_dim2) * cc_dim1 + 1]);
106 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = sn * (cc[(k + (cc_dim3 + 1) *
107 cc_dim2) * cc_dim1 + 2] + cc[(k + ((cc_dim3 << 1) + 1) *
108 cc_dim2) * cc_dim1 + 2]);
109 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = sn * (cc[(k + (cc_dim3 + 1) *
110 cc_dim2) * cc_dim1 + 2] - cc[(k + ((cc_dim3 << 1) + 1) *
111 cc_dim2) * cc_dim1 + 2]);
112/* L107: */
113 }
114 return 0;
115L102:
116 i__1 = *l1;
117 for (k = 1; k <= i__1; ++k) {
118 ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cc[(k + (cc_dim3 + 1) * cc_dim2)
119 * cc_dim1 + 1] + cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) *
120 cc_dim1 + 1];
121 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cc[(k + (cc_dim3 + 1) *
122 cc_dim2) * cc_dim1 + 1] - cc[(k + ((cc_dim3 << 1) + 1) *
123 cc_dim2) * cc_dim1 + 1];
124 ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = cc[(k + (cc_dim3 + 1) * cc_dim2)
125 * cc_dim1 + 2] + cc[(k + ((cc_dim3 << 1) + 1) * cc_dim2) *
126 cc_dim1 + 2];
127 ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = cc[(k + (cc_dim3 + 1) *
128 cc_dim2) * cc_dim1 + 2] - cc[(k + ((cc_dim3 << 1) + 1) *
129 cc_dim2) * cc_dim1 + 2];
130/* L103: */
131 }
132 i__1 = *ido;
133 for (i__ = 2; i__ <= i__1; ++i__) {
134 i__2 = *l1;
135 for (k = 1; k <= i__2; ++k) {
136 ch[(k + ((i__ << 1) + 1) * ch_dim2) * ch_dim1 + 1] = cc[(k + (i__
137 + cc_dim3) * cc_dim2) * cc_dim1 + 1] + cc[(k + (i__ + (
138 cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1];
139 tr2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 1] - cc[(k +
140 (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 1];
141 ch[(k + ((i__ << 1) + 1) * ch_dim2) * ch_dim1 + 2] = cc[(k + (i__
142 + cc_dim3) * cc_dim2) * cc_dim1 + 2] + cc[(k + (i__ + (
143 cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2];
144 ti2 = cc[(k + (i__ + cc_dim3) * cc_dim2) * cc_dim1 + 2] - cc[(k +
145 (i__ + (cc_dim3 << 1)) * cc_dim2) * cc_dim1 + 2];
146 ch[(k + ((i__ << 1) + 2) * ch_dim2) * ch_dim1 + 2] = wa[i__ + (
147 wa_dim1 << 1)] * ti2 - wa[i__ + wa_dim1 * 3] * tr2;
148 ch[(k + ((i__ << 1) + 2) * ch_dim2) * ch_dim1 + 1] = wa[i__ + (
149 wa_dim1 << 1)] * tr2 + wa[i__ + wa_dim1 * 3] * ti2;
150/* L104: */
151 }
152/* L105: */
153 }
154 return 0;
155} /* c1f2kf_ */
156