initds.cpp 2.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586
  1. /* initds.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__2 = 2;
  7. static integer const c__1 = 1;
  8. integer initds_(double const *os, integer const *nos, float const *eta)
  9. {
  10. /* System generated locals */
  11. integer ret_val, i__1;
  12. float r__1;
  13. /* Local variables. Some initialized to avoid -Wmaybe-uninitialized */
  14. integer i__ = 0, ii;
  15. float err;
  16. /* ***BEGIN PROLOGUE INITDS */
  17. /* ***PURPOSE Determine the number of terms needed in an orthogonal */
  18. /* polynomial series so that it meets a specified accuracy. */
  19. /* ***LIBRARY SLATEC (FNLIB) */
  20. /* ***CATEGORY C3A2 */
  21. /* ***TYPE DOUBLE PRECISION (INITS-S, INITDS-D) */
  22. /* ***KEYWORDS CHEBYSHEV, FNLIB, INITIALIZE, ORTHOGONAL POLYNOMIAL, */
  23. /* ORTHOGONAL SERIES, SPECIAL FUNCTIONS */
  24. /* ***AUTHOR Fullerton, W., (LANL) */
  25. /* ***DESCRIPTION */
  26. /* Initialize the orthogonal series, represented by the array OS, so */
  27. /* that INITDS is the number of terms needed to insure the error is no */
  28. /* larger than ETA. Ordinarily, ETA will be chosen to be one-tenth */
  29. /* machine precision. */
  30. /* Input Arguments -- */
  31. /* OS double precision array of NOS coefficients in an orthogonal */
  32. /* series. */
  33. /* NOS number of coefficients in OS. */
  34. /* ETA single precision scalar containing requested accuracy of */
  35. /* series. */
  36. /* ***REFERENCES (NONE) */
  37. /* ***ROUTINES CALLED XERMSG */
  38. /* ***REVISION HISTORY (YYMMDD) */
  39. /* 770601 DATE WRITTEN */
  40. /* 890531 Changed all specific intrinsics to generic. (WRB) */
  41. /* 890831 Modified array declarations. (WRB) */
  42. /* 891115 Modified error message. (WRB) */
  43. /* 891115 REVISION DATE from Version 3.2 */
  44. /* 891214 Prologue converted to Version 4.0 format. (BAB) */
  45. /* 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) */
  46. /* ***END PROLOGUE INITDS */
  47. /* ***FIRST EXECUTABLE STATEMENT INITDS */
  48. /* Parameter adjustments */
  49. --os;
  50. /* Function Body */
  51. if (*nos < 1) {
  52. xermsg_("SLATEC", "INITDS", "Number of coefficients is less than 1", &
  53. c__2, &c__1, (ftnlen)6, (ftnlen)6, (ftnlen)37);
  54. }
  55. err = (float)0.;
  56. i__1 = *nos;
  57. for (ii = 1; ii <= i__1; ++ii) {
  58. i__ = *nos + 1 - ii;
  59. err += (r__1 = (float) os[i__], (double)(abs(r__1)));
  60. if (err > *eta) {
  61. goto L20;
  62. }
  63. /* L10: */
  64. }
  65. L20:
  66. if (i__ == *nos) {
  67. xermsg_("SLATEC", "INITDS", "Chebyshev series too short for specified accuracy",
  68. &c__1, &c__1, (ftnlen)6, (ftnlen)6, (ftnlen)49);
  69. }
  70. ret_val = i__;
  71. return ret_val;
  72. } /* initds_ */