00001 *DECK INITDS 00002 FUNCTION INITDS (OS, NOS, ETA) 00003 C***BEGIN PROLOGUE INITDS 00004 C***PURPOSE Determine the number of terms needed in an orthogonal 00005 C polynomial series so that it meets a specified accuracy. 00006 C***LIBRARY SLATEC (FNLIB) 00007 C***CATEGORY C3A2 00008 C***TYPE DOUBLE PRECISION (INITS-S, INITDS-D) 00009 C***KEYWORDS CHEBYSHEV, FNLIB, INITIALIZE, ORTHOGONAL POLYNOMIAL, 00010 C ORTHOGONAL SERIES, SPECIAL FUNCTIONS 00011 C***AUTHOR Fullerton, W., (LANL) 00012 C***DESCRIPTION 00013 C 00014 C Initialize the orthogonal series, represented by the array OS, so 00015 C that INITDS is the number of terms needed to insure the error is no 00016 C larger than ETA. Ordinarily, ETA will be chosen to be one-tenth 00017 C machine precision. 00018 C 00019 C Input Arguments -- 00020 C OS double precision array of NOS coefficients in an orthogonal 00021 C series. 00022 C NOS number of coefficients in OS. 00023 C ETA single precision scalar containing requested accuracy of 00024 C series. 00025 C 00026 C***REFERENCES (NONE) 00027 C***ROUTINES CALLED XERMSG 00028 C***REVISION HISTORY (YYMMDD) 00029 C 770601 DATE WRITTEN 00030 C 890531 Changed all specific intrinsics to generic. (WRB) 00031 C 890831 Modified array declarations. (WRB) 00032 C 891115 Modified error message. (WRB) 00033 C 891115 REVISION DATE from Version 3.2 00034 C 891214 Prologue converted to Version 4.0 format. (BAB) 00035 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) 00036 C***END PROLOGUE INITDS 00037 DOUBLE PRECISION OS(*) 00038 C***FIRST EXECUTABLE STATEMENT INITDS 00039 IF (NOS .LT. 1) CALL XERMSG ('SLATEC', 'INITDS', 00040 + 'Number of coefficients is less than 1', 2, 1) 00041 C 00042 ERR = 0. 00043 DO 10 II = 1,NOS 00044 I = NOS + 1 - II 00045 ERR = ERR + ABS(REAL(OS(I))) 00046 IF (ERR.GT.ETA) GO TO 20 00047 10 CONTINUE 00048 C 00049 20 IF (I .EQ. NOS) CALL XERMSG ('SLATEC', 'INITDS', 00050 + 'Chebyshev series too short for specified accuracy', 1, 1) 00051 INITDS = I 00052 C 00053 RETURN 00054 END
1.7.1
