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