PLaSK library
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Modules Pages
rfft1b.c
Go to the documentation of this file.
1/* rfft1b.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__6 = 6;
18static integer c__8 = 8;
19static integer c__10 = 10;
20
21/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
22/* * * */
23/* * copyright (c) 2011 by UCAR * */
24/* * * */
25/* * University Corporation for Atmospheric Research * */
26/* * * */
27/* * all rights reserved * */
28/* * * */
29/* * FFTPACK version 5.1 * */
30/* * * */
31/* * A Fortran Package of Fast Fourier * */
32/* * * */
33/* * Subroutines and Example Programs * */
34/* * * */
35/* * by * */
36/* * * */
37/* * Paul Swarztrauber and Dick Valent * */
38/* * * */
39/* * of * */
40/* * * */
41/* * the National Center for Atmospheric Research * */
42/* * * */
43/* * Boulder, Colorado (80307) U.S.A. * */
44/* * * */
45/* * which is sponsored by * */
46/* * * */
47/* * the National Science Foundation * */
48/* * * */
49/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
50
51/* Subroutine */ int rfft1b_(integer *n, integer *inc, doublereal *r__,
52 integer *lenr, doublereal *wsave, integer *lensav, doublereal *work,
53 integer *lenwrk, integer *ier)
54{
55 /* Builtin functions */
56 double log(doublereal);
57
58 /* Local variables */
59 extern /* Subroutine */ int rfftb1_(integer *, integer *, doublereal *,
60 doublereal *, doublereal *, doublereal *), xerfft_(char *,
61 integer *, ftnlen);
62
63
64 /* Parameter adjustments */
65 --r__;
66 --wsave;
67 --work;
68
69 /* Function Body */
70 *ier = 0;
71
72 if (*lenr < *inc * (*n - 1) + 1) {
73 *ier = 1;
74 xerfft_("RFFT1B ", &c__6, (ftnlen)7);
75 } else if (*lensav < *n + (integer) (log((doublereal) (*n)) / log(2.)) +
76 4) {
77 *ier = 2;
78 xerfft_("RFFT1B ", &c__8, (ftnlen)7);
79 } else if (*lenwrk < *n) {
80 *ier = 3;
81 xerfft_("RFFT1B ", &c__10, (ftnlen)7);
82 }
83
84 if (*n == 1) {
85 return 0;
86 }
87
88 rfftb1_(n, inc, &r__[1], &work[1], &wsave[1], &wsave[*n + 1]);
89 return 0;
90} /* rfft1b_ */
91