dcsevl.cpp 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. /* dcsevl.f -- translated by f2c (version 20100827).
  2. This file no longer depends on f2c.
  3. */
  4. #include "slatec-internal.hpp"
  5. /* Table of constant values */
  6. static integer const c__4 = 4;
  7. static integer const c__2 = 2;
  8. static integer const c__3 = 3;
  9. static integer const c__1 = 1;
  10. /* Initialized data */
  11. static double const onepl = 1. + d1mach_(4);
  12. double dcsevl_(double *x, double const *cs, integer const *n)
  13. {
  14. /* System generated locals */
  15. integer i__1;
  16. double ret_val;
  17. /* Local variables. Some initialized to avoid -Wmaybe-uninitialized */
  18. integer i__;
  19. double b0, b1, b2 = 0.;
  20. integer ni;
  21. double twox;
  22. /* ***BEGIN PROLOGUE DCSEVL */
  23. /* ***PURPOSE Evaluate a Chebyshev series. */
  24. /* ***LIBRARY SLATEC (FNLIB) */
  25. /* ***CATEGORY C3A2 */
  26. /* ***TYPE DOUBLE PRECISION (CSEVL-S, DCSEVL-D) */
  27. /* ***KEYWORDS CHEBYSHEV SERIES, FNLIB, SPECIAL FUNCTIONS */
  28. /* ***AUTHOR Fullerton, W., (LANL) */
  29. /* ***DESCRIPTION */
  30. /* Evaluate the N-term Chebyshev series CS at X. Adapted from */
  31. /* a method presented in the paper by Broucke referenced below. */
  32. /* Input Arguments -- */
  33. /* X value at which the series is to be evaluated. */
  34. /* CS array of N terms of a Chebyshev series. In evaluating */
  35. /* CS, only half the first coefficient is summed. */
  36. /* N number of terms in array CS. */
  37. /* ***REFERENCES R. Broucke, Ten subroutines for the manipulation of */
  38. /* Chebyshev series, Algorithm 446, Communications of */
  39. /* the A.C.M. 16, (1973) pp. 254-256. */
  40. /* L. Fox and I. B. Parker, Chebyshev Polynomials in */
  41. /* Numerical Analysis, Oxford University Press, 1968, */
  42. /* page 56. */
  43. /* ***ROUTINES CALLED D1MACH, XERMSG */
  44. /* ***REVISION HISTORY (YYMMDD) */
  45. /* 770401 DATE WRITTEN */
  46. /* 890831 Modified array declarations. (WRB) */
  47. /* 890831 REVISION DATE from Version 3.2 */
  48. /* 891214 Prologue converted to Version 4.0 format. (BAB) */
  49. /* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
  50. /* 900329 Prologued revised extensively and code rewritten to allow */
  51. /* X to be slightly outside interval (-1,+1). (WRB) */
  52. /* 920501 Reformatted the REFERENCES section. (WRB) */
  53. /* ***END PROLOGUE DCSEVL */
  54. /* Parameter adjustments */
  55. --cs;
  56. /* Function Body */
  57. /* ***FIRST EXECUTABLE STATEMENT DCSEVL */
  58. if (*n < 1) {
  59. xermsg_("SLATEC", "DCSEVL", "NUMBER OF TERMS .LE. 0", &c__2, &c__2,
  60. (ftnlen)6, (ftnlen)6, (ftnlen)22);
  61. }
  62. if (*n > 1000) {
  63. xermsg_("SLATEC", "DCSEVL", "NUMBER OF TERMS .GT. 1000", &c__3, &c__2,
  64. (ftnlen)6, (ftnlen)6, (ftnlen)25);
  65. }
  66. if (abs(*x) > onepl) {
  67. xermsg_("SLATEC", "DCSEVL", "X OUTSIDE THE INTERVAL (-1,+1)", &c__1, &c__1,
  68. (ftnlen)6, (ftnlen)6, (ftnlen)30);
  69. }
  70. b1 = 0.;
  71. b0 = 0.;
  72. twox = *x * 2.;
  73. i__1 = *n;
  74. for (i__ = 1; i__ <= i__1; ++i__) {
  75. b2 = b1;
  76. b1 = b0;
  77. ni = *n + 1 - i__;
  78. b0 = twox * b1 - b2 + cs[ni];
  79. /* L10: */
  80. }
  81. ret_val = (b0 - b2) * .5;
  82. return ret_val;
  83. } /* dcsevl_ */