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