Mercurial > octave-nkf

diff libcruft/slatec-fn/erf.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/erf.f	Sun Apr 27 22:34:17 2008 +0200
@@ -0,0 +1,73 @@
+*DECK ERF
+      FUNCTION ERF (X)
+C***BEGIN PROLOGUE  ERF
+C***PURPOSE  Compute the error function.
+C***LIBRARY   SLATEC (FNLIB)
+C***CATEGORY  C8A, L5A1E
+C***TYPE      SINGLE PRECISION (ERF-S, DERF-D)
+C***KEYWORDS  ERF, ERROR FUNCTION, FNLIB, SPECIAL FUNCTIONS
+C***AUTHOR  Fullerton, W., (LANL)
+C***DESCRIPTION
+C
+C ERF(X) calculates the single precision error function for
+C single precision argument X.
+C
+C Series for ERF        on the interval  0.          to  1.00000D+00
+C                                        with weighted error   7.10E-18
+C                                         log weighted error  17.15
+C                               significant figures required  16.31
+C                                    decimal places required  17.71
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  CSEVL, ERFC, INITS, R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   770401  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890531  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900727  Added EXTERNAL statement.  (WRB)
+C   920618  Removed space from variable name.  (RWC, WRB)
+C***END PROLOGUE  ERF
+      DIMENSION ERFCS(13)
+      LOGICAL FIRST
+      EXTERNAL ERFC
+      SAVE ERFCS, SQRTPI, NTERF, XBIG, SQEPS, FIRST
+      DATA ERFCS( 1) /   -.0490461212 34691808E0 /
+      DATA ERFCS( 2) /   -.1422612051 0371364E0 /
+      DATA ERFCS( 3) /    .0100355821 87599796E0 /
+      DATA ERFCS( 4) /   -.0005768764 69976748E0 /
+      DATA ERFCS( 5) /    .0000274199 31252196E0 /
+      DATA ERFCS( 6) /   -.0000011043 17550734E0 /
+      DATA ERFCS( 7) /    .0000000384 88755420E0 /
+      DATA ERFCS( 8) /   -.0000000011 80858253E0 /
+      DATA ERFCS( 9) /    .0000000000 32334215E0 /
+      DATA ERFCS(10) /   -.0000000000 00799101E0 /
+      DATA ERFCS(11) /    .0000000000 00017990E0 /
+      DATA ERFCS(12) /   -.0000000000 00000371E0 /
+      DATA ERFCS(13) /    .0000000000 00000007E0 /
+      DATA SQRTPI /1.772453850 9055160E0/
+      DATA FIRST /.TRUE./
+C***FIRST EXECUTABLE STATEMENT  ERF
+      IF (FIRST) THEN
+         NTERF = INITS (ERFCS, 13, 0.1*R1MACH(3))
+         XBIG = SQRT(-LOG(SQRTPI*R1MACH(3)))
+         SQEPS = SQRT(2.0*R1MACH(3))
+      ENDIF
+      FIRST = .FALSE.
+C
+      Y = ABS(X)
+      IF (Y.GT.1.) GO TO 20
+C
+C ERF(X) = 1. - ERFC(X) FOR -1. .LE. X .LE. 1.
+C
+      IF (Y.LE.SQEPS) ERF = 2.0*X/SQRTPI
+      IF (Y.GT.SQEPS) ERF = X*(1.0 + CSEVL(2.*X**2-1., ERFCS, NTERF))
+      RETURN
+C
+C ERF(X) = 1. - ERFC(X) FOR  ABS(X) .GT. 1.
+C
+ 20   IF (Y.LE.XBIG) ERF = SIGN (1.0-ERFC(Y), X)
+      IF (Y.GT.XBIG) ERF = SIGN (1.0, X)
+C
+      RETURN
+      END