mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
54 lines
1.9 KiB
Fortran
54 lines
1.9 KiB
Fortran
*DECK INITDS
|
|
FUNCTION INITDS (OS, NOS, ETA)
|
|
C***BEGIN PROLOGUE INITDS
|
|
C***PURPOSE Determine the number of terms needed in an orthogonal
|
|
C polynomial series so that it meets a specified accuracy.
|
|
C***LIBRARY SLATEC (FNLIB)
|
|
C***CATEGORY C3A2
|
|
C***TYPE DOUBLE PRECISION (INITS-S, INITDS-D)
|
|
C***KEYWORDS CHEBYSHEV, FNLIB, INITIALIZE, ORTHOGONAL POLYNOMIAL,
|
|
C ORTHOGONAL SERIES, SPECIAL FUNCTIONS
|
|
C***AUTHOR Fullerton, W., (LANL)
|
|
C***DESCRIPTION
|
|
C
|
|
C Initialize the orthogonal series, represented by the array OS, so
|
|
C that INITDS is the number of terms needed to insure the error is no
|
|
C larger than ETA. Ordinarily, ETA will be chosen to be one-tenth
|
|
C machine precision.
|
|
C
|
|
C Input Arguments --
|
|
C OS double precision array of NOS coefficients in an orthogonal
|
|
C series.
|
|
C NOS number of coefficients in OS.
|
|
C ETA single precision scalar containing requested accuracy of
|
|
C series.
|
|
C
|
|
C***REFERENCES (NONE)
|
|
C***ROUTINES CALLED XERMSG
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 770601 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
C 890831 Modified array declarations. (WRB)
|
|
C 891115 Modified error message. (WRB)
|
|
C 891115 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***END PROLOGUE INITDS
|
|
DOUBLE PRECISION OS(*)
|
|
C***FIRST EXECUTABLE STATEMENT INITDS
|
|
IF (NOS .LT. 1) CALL XERMSG ('SLATEC', 'INITDS',
|
|
+ 'Number of coefficients is less than 1', 2, 1)
|
|
C
|
|
ERR = 0.
|
|
DO 10 II = 1,NOS
|
|
I = NOS + 1 - II
|
|
ERR = ERR + ABS(REAL(OS(I)))
|
|
IF (ERR.GT.ETA) GO TO 20
|
|
10 CONTINUE
|
|
C
|
|
20 IF (I .EQ. NOS) CALL XERMSG ('SLATEC', 'INITDS',
|
|
+ 'Chebyshev series too short for specified accuracy', 1, 1)
|
|
INITDS = I
|
|
C
|
|
RETURN
|
|
END
|