home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / slatec-fn / initds.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  55 lines
  1. *DECK INITDS
  2.       FUNCTION INITDS (OS, NOS, ETA)
  3. C***BEGIN PROLOGUE  INITDS
  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      DOUBLE 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 INITDS 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     double 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   770601  DATE WRITTEN
  30. C   890531  Changed all specific intrinsics to generic.  (WRB)
  31. C   890831  Modified array declarations.  (WRB)
  32. C   891115  Modified error message.  (WRB)
  33. C   891115  REVISION DATE from Version 3.2
  34. C   891214  Prologue converted to Version 4.0 format.  (BAB)
  35. C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
  36. C***END PROLOGUE  INITDS
  37.       DOUBLE PRECISION OS(*)
  38. C***FIRST EXECUTABLE STATEMENT  INITDS
  39.       IF (NOS .LT. 1) CALL XERMSG ('SLATEC', 'INITDS',
  40.      +   'Number of coefficients is less than 1', 2, 1)
  41. C
  42.       ERR = 0.
  43.       DO 10 II = 1,NOS
  44.         I = NOS + 1 - II
  45.         ERR = ERR + ABS(REAL(OS(I)))
  46.         IF (ERR.GT.ETA) GO TO 20
  47.    10 CONTINUE
  48. C
  49.    20 IF (I .EQ. NOS) CALL XERMSG ('SLATEC', 'INITDS',
  50.      +   'Chebyshev series too short for specified accuracy', 1, 1)
  51.       INITDS = I
  52. C
  53.       RETURN
  54.       END
  55.