inits.f 1.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253
  1. *DECK INITS
  2. FUNCTION INITS (OS, NOS, ETA)
  3. C***BEGIN PROLOGUE INITS
  4. C***PURPOSE Determine the number of terms needed in an orthogonal
  5. C polynomial series so that it meets a specified accuracy.
  6. C***LIBRARY SLATEC (FNLIB)
  7. C***CATEGORY C3A2
  8. C***TYPE SINGLE PRECISION (INITS-S, INITDS-D)
  9. C***KEYWORDS CHEBYSHEV, FNLIB, INITIALIZE, ORTHOGONAL POLYNOMIAL,
  10. C ORTHOGONAL SERIES, SPECIAL FUNCTIONS
  11. C***AUTHOR Fullerton, W., (LANL)
  12. C***DESCRIPTION
  13. C
  14. C Initialize the orthogonal series, represented by the array OS, so
  15. C that INITS is the number of terms needed to insure the error is no
  16. C larger than ETA. Ordinarily, ETA will be chosen to be one-tenth
  17. C machine precision.
  18. C
  19. C Input Arguments --
  20. C OS single precision array of NOS coefficients in an orthogonal
  21. C series.
  22. C NOS number of coefficients in OS.
  23. C ETA single precision scalar containing requested accuracy of
  24. C series.
  25. C
  26. C***REFERENCES (NONE)
  27. C***ROUTINES CALLED XERMSG
  28. C***REVISION HISTORY (YYMMDD)
  29. C 770401 DATE WRITTEN
  30. C 890831 Modified array declarations. (WRB)
  31. C 891115 Modified error message. (WRB)
  32. C 891115 REVISION DATE from Version 3.2
  33. C 891214 Prologue converted to Version 4.0 format. (BAB)
  34. C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
  35. C***END PROLOGUE INITS
  36. REAL OS(*)
  37. C***FIRST EXECUTABLE STATEMENT INITS
  38. IF (NOS .LT. 1) CALL XERMSG ('SLATEC', 'INITS',
  39. + 'Number of coefficients is less than 1', 2, 1)
  40. C
  41. ERR = 0.
  42. DO 10 II = 1,NOS
  43. I = NOS + 1 - II
  44. ERR = ERR + ABS(OS(I))
  45. IF (ERR.GT.ETA) GO TO 20
  46. 10 CONTINUE
  47. C
  48. 20 IF (I .EQ. NOS) CALL XERMSG ('SLATEC', 'INITS',
  49. + 'Chebyshev series too short for specified accuracy', 1, 1)
  50. INITS = I
  51. C
  52. RETURN
  53. END