erf.f

Go to the documentation of this file.

*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