src/numerical/slatec/fortran/dcsevl.f

   1 *DECK DCSEVL
   2       DOUBLE PRECISION FUNCTION DCSEVL (X, CS, N)
   3 C***BEGIN PROLOGUE  DCSEVL
   4 C***PURPOSE  Evaluate a Chebyshev series.
   5 C***LIBRARY   SLATEC (FNLIB)
   6 C***CATEGORY  C3A2
   7 C***TYPE      DOUBLE PRECISION (CSEVL-S, DCSEVL-D)
   8 C***KEYWORDS  CHEBYSHEV SERIES, FNLIB, SPECIAL FUNCTIONS
   9 C***AUTHOR  Fullerton, W., (LANL)
  10 C***DESCRIPTION
  11 C
  12 C  Evaluate the N-term Chebyshev series CS at X.  Adapted from
  13 C  a method presented in the paper by Broucke referenced below.
  14 C
  15 C       Input Arguments --
  16 C  X    value at which the series is to be evaluated.
  17 C  CS   array of N terms of a Chebyshev series.  In evaluating
  18 C       CS, only half the first coefficient is summed.
  19 C  N    number of terms in array CS.
  20 C
  21 C***REFERENCES  R. Broucke, Ten subroutines for the manipulation of
  22 C                 Chebyshev series, Algorithm 446, Communications of
  23 C                 the A.C.M. 16, (1973) pp. 254-256.
  24 C               L. Fox and I. B. Parker, Chebyshev Polynomials in
  25 C                 Numerical Analysis, Oxford University Press, 1968,
  26 C                 page 56.
  27 C***ROUTINES CALLED  D1MACH, XERMSG
  28 C***REVISION HISTORY  (YYMMDD)
  29 C   770401  DATE WRITTEN
  30 C   890831  Modified array declarations.  (WRB)
  31 C   890831  REVISION DATE from Version 3.2
  32 C   891214  Prologue converted to Version 4.0 format.  (BAB)
  33 C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
  34 C   900329  Prologued revised extensively and code rewritten to allow
  35 C           X to be slightly outside interval (-1,+1).  (WRB)
  36 C   920501  Reformatted the REFERENCES section.  (WRB)
  37 C***END PROLOGUE  DCSEVL
  38       DOUBLE PRECISION B0, B1, B2, CS(*), ONEPL, TWOX, X, D1MACH
  39       LOGICAL FIRST
  40       SAVE FIRST, ONEPL
  41       DATA FIRST /.TRUE./
  42 C***FIRST EXECUTABLE STATEMENT  DCSEVL
  43       IF (FIRST) ONEPL = 1.0D0 + D1MACH(4)
  44       FIRST = .FALSE.
  45       IF (N .LT. 1) CALL XERMSG ('SLATEC', 'DCSEVL',
  46      +   'NUMBER OF TERMS .LE. 0', 2, 2)
  47       IF (N .GT. 1000) CALL XERMSG ('SLATEC', 'DCSEVL',
  48      +   'NUMBER OF TERMS .GT. 1000', 3, 2)
  49       IF (ABS(X) .GT. ONEPL) CALL XERMSG ('SLATEC', 'DCSEVL',
  50      +   'X OUTSIDE THE INTERVAL (-1,+1)', 1, 1)
  51 C
  52       B1 = 0.0D0
  53       B0 = 0.0D0
  54       TWOX = 2.0D0*X
  55       DO 10 I = 1,N
  56          B2 = B1
  57          B1 = B0
  58          NI = N + 1 - I
  59          B0 = TWOX*B1 - B2 + CS(NI)
  60    10 CONTINUE
  61 C
  62       DCSEVL = 0.5D0*(B0-B2)
  63 C
  64       RETURN
  65       END