PLaSK library
Loading...
Searching...
No Matches
costmi.c
Go to the documentation of this file.
1/* costmi.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__3 = 3;
18static integer c_n5 = -5;
19
20/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
21/* * * */
22/* * copyright (c) 2011 by UCAR * */
23/* * * */
24/* * University Corporation for Atmospheric Research * */
25/* * * */
26/* * all rights reserved * */
27/* * * */
28/* * FFTPACK version 5.1 * */
29/* * * */
30/* * A Fortran Package of Fast Fourier * */
31/* * * */
32/* * Subroutines and Example Programs * */
33/* * * */
34/* * by * */
35/* * * */
36/* * Paul Swarztrauber and Dick Valent * */
37/* * * */
38/* * of * */
39/* * * */
40/* * the National Center for Atmospheric Research * */
41/* * * */
42/* * Boulder, Colorado (80307) U.S.A. * */
43/* * * */
44/* * which is sponsored by * */
45/* * * */
46/* * the National Science Foundation * */
47/* * * */
48/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
49
50/* Subroutine */ int costmi_(integer *n, doublereal *wsave, integer *lensav,
51 integer *ier)
52{
53 /* System generated locals */
54 integer i__1;
55
56 /* Builtin functions */
57 double log(doublereal), atan(doublereal), sin(doublereal), cos(doublereal)
58 ;
59
60 /* Local variables */
61 integer k, kc;
62 doublereal fk, dt, pi;
63 integer nm1, np1, ns2, ier1, lnsv;
64 extern /* Subroutine */ int rfftmi_(integer *, doublereal *, integer *,
65 integer *), xerfft_(char *, integer *, ftnlen);
66
67
68 /* Parameter adjustments */
69 --wsave;
70
71 /* Function Body */
72 *ier = 0;
73
74 if (*lensav < (*n << 1) + (integer) (log((doublereal) (*n)) / log(2.)) +
75 4) {
76 *ier = 2;
77 xerfft_("COSTMI", &c__3, (ftnlen)6);
78 goto L300;
79 }
80
81 if (*n <= 3) {
82 return 0;
83 }
84 nm1 = *n - 1;
85 np1 = *n + 1;
86 ns2 = *n / 2;
87 pi = atan(1.) * 4.;
88 dt = pi / (doublereal) nm1;
89 fk = 0.;
90 i__1 = ns2;
91 for (k = 2; k <= i__1; ++k) {
92 kc = np1 - k;
93 fk += 1.;
94 wsave[k] = sin(fk * dt) * 2.;
95 wsave[kc] = cos(fk * dt) * 2.;
96/* L101: */
97 }
98 lnsv = nm1 + (integer) (log((doublereal) nm1) / log(2.)) + 4;
99 rfftmi_(&nm1, &wsave[*n + 1], &lnsv, &ier1);
100 if (ier1 != 0) {
101 *ier = 20;
102 xerfft_("COSTMI", &c_n5, (ftnlen)6);
103 }
104L300:
105 return 0;
106} /* costmi_ */
107