Mercurial > octave-nkf

diff libcruft/slatec-fn/inits.f @ 7789:82be108cc558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First attempt at single precision tyeps * * * corrections to qrupdate single precision routines * * * prefer demotion to single over promotion to double * * * Add single precision support to log2 function * * * Trivial PROJECT file update * * * Cache optimized hermitian/transpose methods * * * Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author David Bateman <dbateman@free.fr>
date Sun, 27 Apr 2008 22:34:17 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/slatec-fn/inits.f	Sun Apr 27 22:34:17 2008 +0200
@@ -0,0 +1,53 @@
+*DECK INITS
+      FUNCTION INITS (OS, NOS, ETA)
+C***BEGIN PROLOGUE  INITS
+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      SINGLE 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 INITS 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     single 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   770401  DATE WRITTEN
+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  INITS
+      REAL OS(*)
+C***FIRST EXECUTABLE STATEMENT  INITS
+      IF (NOS .LT. 1) CALL XERMSG ('SLATEC', 'INITS',
+     +   'Number of coefficients is less than 1', 2, 1)
+C
+      ERR = 0.
+      DO 10 II = 1,NOS
+        I = NOS + 1 - II
+        ERR = ERR + ABS(OS(I))
+        IF (ERR.GT.ETA) GO TO 20
+   10 CONTINUE
+C
+   20 IF (I .EQ. NOS) CALL XERMSG ('SLATEC', 'INITS',
+     +   'Chebyshev series too short for specified accuracy', 1, 1)
+      INITS = I
+C
+      RETURN
+      END