PLaSK library
Loading...
Searching...
No Matches
cfft2b.c
Go to the documentation of this file.
1/* cfft2b.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/* Table of constant values */
16
17static integer c_n2 = -2;
18static integer c__6 = 6;
19static integer c__8 = 8;
20static integer c__1 = 1;
21static integer c_n5 = -5;
22
23/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
24/* * * */
25/* * copyright (c) 2011 by UCAR * */
26/* * * */
27/* * University Corporation for Atmospheric Research * */
28/* * * */
29/* * all rights reserved * */
30/* * * */
31/* * FFTPACK version 5.1 * */
32/* * * */
33/* * A Fortran Package of Fast Fourier * */
34/* * * */
35/* * Subroutines and Example Programs * */
36/* * * */
37/* * by * */
38/* * * */
39/* * Paul Swarztrauber and Dick Valent * */
40/* * * */
41/* * of * */
42/* * * */
43/* * the National Center for Atmospheric Research * */
44/* * * */
45/* * Boulder, Colorado (80307) U.S.A. * */
46/* * * */
47/* * which is sponsored by * */
48/* * * */
49/* * the National Science Foundation * */
50/* * * */
51/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
52
53/* Subroutine */ int cfft2b_(integer *ldim, integer *l, integer *m,
54 doublecomplex *c__, doublereal *wsave, integer *lensav, doublereal *
55 work, integer *lenwrk, integer *ier)
56{
57 /* System generated locals */
58 integer c_dim1, c_offset, i__1, i__2, i__3;
59
60 /* Builtin functions */
61 double log(doublereal);
62
63 /* Local variables */
64 integer iw, ier1;
65 extern /* Subroutine */ int cfftmb_(integer *, integer *, integer *,
66 integer *, doublecomplex *, integer *, doublereal *, integer *,
67 doublereal *, integer *, integer *), xerfft_(char *, integer *,
68 ftnlen);
69
70
71/* Initialize error return */
72
73 /* Parameter adjustments */
74 c_dim1 = *ldim;
75 c_offset = 1 + c_dim1;
76 c__ -= c_offset;
77 --wsave;
78 --work;
79
80 /* Function Body */
81 *ier = 0;
82
83 if (*l > *ldim) {
84 *ier = 5;
85 xerfft_("CFFT2B", &c_n2, (ftnlen)6);
86 goto L100;
87 } else if (*lensav < (*l << 1) + (integer) (log((doublereal) (*l)) / log(
88 2.)) + (*m << 1) + (integer) (log((doublereal) (*m)) / log(2.)) +
89 8) {
90 *ier = 2;
91 xerfft_("CFFT2B", &c__6, (ftnlen)6);
92 goto L100;
93 } else if (*lenwrk < (*l << 1) * *m) {
94 *ier = 3;
95 xerfft_("CFFT2B", &c__8, (ftnlen)6);
96 goto L100;
97 }
98
99/* Transform X lines of C array */
100 iw = (*l << 1) + (integer) (log((doublereal) (*l)) / log(2.)) + 3;
101 i__1 = *l - 1 + *ldim * (*m - 1) + 1;
102 i__2 = (*m << 1) + (integer) (log((doublereal) (*m)) / log(2.)) + 4;
103 i__3 = (*l << 1) * *m;
104 cfftmb_(l, &c__1, m, ldim, &c__[c_offset], &i__1, &wsave[iw], &i__2, &
105 work[1], &i__3, &ier1);
106 if (ier1 != 0) {
107 *ier = 20;
108 xerfft_("CFFT2B", &c_n5, (ftnlen)6);
109 goto L100;
110 }
111
112/* Transform Y lines of C array */
113 iw = 1;
114 i__1 = (*m - 1) * *ldim + *l;
115 i__2 = (*l << 1) + (integer) (log((doublereal) (*l)) / log(2.)) + 4;
116 i__3 = (*m << 1) * *l;
117 cfftmb_(m, ldim, l, &c__1, &c__[c_offset], &i__1, &wsave[iw], &i__2, &
118 work[1], &i__3, &ier1);
119 if (ier1 != 0) {
120 *ier = 20;
121 xerfft_("CFFT2B", &c_n5, (ftnlen)6);
122 }
123
124L100:
125 return 0;
126} /* cfft2b_ */
127