home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / slatec-fn / derf.f < prev    next >
Text File  |  1996-09-28  |  4KB  |  84 lines
  1. *DECK DERF
  2.       DOUBLE PRECISION FUNCTION DERF (X)
  3. C***BEGIN PROLOGUE  DERF
  4. C***PURPOSE  Compute the error function.
  5. C***LIBRARY   SLATEC (FNLIB)
  6. C***CATEGORY  C8A, L5A1E
  7. C***TYPE      DOUBLE PRECISION (ERF-S, DERF-D)
  8. C***KEYWORDS  ERF, ERROR FUNCTION, FNLIB, SPECIAL FUNCTIONS
  9. C***AUTHOR  Fullerton, W., (LANL)
  10. C***DESCRIPTION
  11. C
  12. C DERF(X) calculates the double precision error function for double
  13. C precision argument X.
  14. C
  15. C Series for ERF        on the interval  0.          to  1.00000E+00
  16. C                                        with weighted error   1.28E-32
  17. C                                         log weighted error  31.89
  18. C                               significant figures required  31.05
  19. C                                    decimal places required  32.55
  20. C
  21. C***REFERENCES  (NONE)
  22. C***ROUTINES CALLED  D1MACH, DCSEVL, DERFC, INITDS
  23. C***REVISION HISTORY  (YYMMDD)
  24. C   770701  DATE WRITTEN
  25. C   890531  Changed all specific intrinsics to generic.  (WRB)
  26. C   890531  REVISION DATE from Version 3.2
  27. C   891214  Prologue converted to Version 4.0 format.  (BAB)
  28. C   900727  Added EXTERNAL statement.  (WRB)
  29. C   920618  Removed space from variable name.  (RWC, WRB)
  30. C***END PROLOGUE  DERF
  31.       DOUBLE PRECISION X, ERFCS(21), SQEPS, SQRTPI, XBIG, Y, D1MACH,
  32.      1  DCSEVL, DERFC
  33.       LOGICAL FIRST
  34.       EXTERNAL DERFC
  35.       SAVE ERFCS, SQRTPI, NTERF, XBIG, SQEPS, FIRST
  36.       DATA ERFCS(  1) / -.4904612123 4691808039 9845440333 76 D-1     /
  37.       DATA ERFCS(  2) / -.1422612051 0371364237 8247418996 31 D+0     /
  38.       DATA ERFCS(  3) / +.1003558218 7599795575 7546767129 33 D-1     /
  39.       DATA ERFCS(  4) / -.5768764699 7674847650 8270255091 67 D-3     /
  40.       DATA ERFCS(  5) / +.2741993125 2196061034 4221607914 71 D-4     /
  41.       DATA ERFCS(  6) / -.1104317550 7344507604 1353812959 05 D-5     /
  42.       DATA ERFCS(  7) / +.3848875542 0345036949 9613114981 74 D-7     /
  43.       DATA ERFCS(  8) / -.1180858253 3875466969 6317518015 81 D-8     /
  44.       DATA ERFCS(  9) / +.3233421582 6050909646 4029309533 54 D-10    /
  45.       DATA ERFCS( 10) / -.7991015947 0045487581 6073747085 95 D-12    /
  46.       DATA ERFCS( 11) / +.1799072511 3961455611 9672454866 34 D-13    /
  47.       DATA ERFCS( 12) / -.3718635487 8186926382 3168282094 93 D-15    /
  48.       DATA ERFCS( 13) / +.7103599003 7142529711 6899083946 66 D-17    /
  49.       DATA ERFCS( 14) / -.1261245511 9155225832 4954248533 33 D-18    /
  50.       DATA ERFCS( 15) / +.2091640694 1769294369 1705002666 66 D-20    /
  51.       DATA ERFCS( 16) / -.3253973102 9314072982 3641600000 00 D-22    /
  52.       DATA ERFCS( 17) / +.4766867209 7976748332 3733333333 33 D-24    /
  53.       DATA ERFCS( 18) / -.6598012078 2851343155 1999999999 99 D-26    /
  54.       DATA ERFCS( 19) / +.8655011469 9637626197 3333333333 33 D-28    /
  55.       DATA ERFCS( 20) / -.1078892517 7498064213 3333333333 33 D-29    /
  56.       DATA ERFCS( 21) / +.1281188399 3017002666 6666666666 66 D-31    /
  57.       DATA SQRTPI / 1.772453850 9055160272 9816748334 115D0 /
  58.       DATA FIRST /.TRUE./
  59. C***FIRST EXECUTABLE STATEMENT  DERF
  60.       IF (FIRST) THEN
  61.          NTERF = INITDS (ERFCS, 21, 0.1*REAL(D1MACH(3)))
  62.          XBIG = SQRT(-LOG(SQRTPI*D1MACH(3)))
  63.          SQEPS = SQRT(2.0D0*D1MACH(3))
  64.       ENDIF
  65.       FIRST = .FALSE.
  66. C
  67.       Y = ABS(X)
  68.       IF (Y.GT.1.D0) GO TO 20
  69. C
  70. C ERF(X) = 1.0 - ERFC(X)  FOR  -1.0 .LE. X .LE. 1.0
  71. C
  72.       IF (Y.LE.SQEPS) DERF = 2.0D0*X*X/SQRTPI
  73.       IF (Y.GT.SQEPS) DERF = X*(1.0D0 + DCSEVL (2.D0*X*X-1.D0,
  74.      1  ERFCS, NTERF))
  75.       RETURN
  76. C
  77. C ERF(X) = 1.0 - ERFC(X) FOR ABS(X) .GT. 1.0
  78. C
  79.  20   IF (Y.LE.XBIG) DERF = SIGN (1.0D0-DERFC(Y), X)
  80.       IF (Y.GT.XBIG) DERF = SIGN (1.0D0, X)
  81. C
  82.       RETURN
  83.       END
  84.