OpenLibm/slatec/csevl.f
Viral B. Shah c977aa998f Add Makefile.extras to build libopenlibm-extras.
Replace amos with slatec
2012-12-31 16:37:05 -05:00

65 lines
2.3 KiB
Fortran

*DECK CSEVL
FUNCTION CSEVL (X, CS, N)
C***BEGIN PROLOGUE CSEVL
C***PURPOSE Evaluate a Chebyshev series.
C***LIBRARY SLATEC (FNLIB)
C***CATEGORY C3A2
C***TYPE SINGLE PRECISION (CSEVL-S, DCSEVL-D)
C***KEYWORDS CHEBYSHEV SERIES, FNLIB, SPECIAL FUNCTIONS
C***AUTHOR Fullerton, W., (LANL)
C***DESCRIPTION
C
C Evaluate the N-term Chebyshev series CS at X. Adapted from
C a method presented in the paper by Broucke referenced below.
C
C Input Arguments --
C X value at which the series is to be evaluated.
C CS array of N terms of a Chebyshev series. In evaluating
C CS, only half the first coefficient is summed.
C N number of terms in array CS.
C
C***REFERENCES R. Broucke, Ten subroutines for the manipulation of
C Chebyshev series, Algorithm 446, Communications of
C the A.C.M. 16, (1973) pp. 254-256.
C L. Fox and I. B. Parker, Chebyshev Polynomials in
C Numerical Analysis, Oxford University Press, 1968,
C page 56.
C***ROUTINES CALLED R1MACH, XERMSG
C***REVISION HISTORY (YYMMDD)
C 770401 DATE WRITTEN
C 890831 Modified array declarations. (WRB)
C 890831 REVISION DATE from Version 3.2
C 891214 Prologue converted to Version 4.0 format. (BAB)
C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
C 900329 Prologued revised extensively and code rewritten to allow
C X to be slightly outside interval (-1,+1). (WRB)
C 920501 Reformatted the REFERENCES section. (WRB)
C***END PROLOGUE CSEVL
REAL B0, B1, B2, CS(*), ONEPL, TWOX, X
LOGICAL FIRST
SAVE FIRST, ONEPL
DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT CSEVL
IF (FIRST) ONEPL = 1.0E0 + R1MACH(4)
FIRST = .FALSE.
IF (N .LT. 1) CALL XERMSG ('SLATEC', 'CSEVL',
+ 'NUMBER OF TERMS .LE. 0', 2, 2)
IF (N .GT. 1000) CALL XERMSG ('SLATEC', 'CSEVL',
+ 'NUMBER OF TERMS .GT. 1000', 3, 2)
IF (ABS(X) .GT. ONEPL) CALL XERMSG ('SLATEC', 'CSEVL',
+ 'X OUTSIDE THE INTERVAL (-1,+1)', 1, 1)
C
B1 = 0.0E0
B0 = 0.0E0
TWOX = 2.0*X
DO 10 I = 1,N
B2 = B1
B1 = B0
NI = N + 1 - I
B0 = TWOX*B1 - B2 + CS(NI)
10 CONTINUE
C
CSEVL = 0.5E0*(B0-B2)
C
RETURN
END