MINICERN/mathlib/gen/c/erf64.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:01:53  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_DOUBLE)
  11       FUNCTION DERF(X)
  12 C
  13 #include "gen/imp64.inc"
  14 C
  15       CHARACTER*(*) NAME
  16       PARAMETER(NAME='DERF')
  17 #endif
  18 #if !defined(CERNLIB_DOUBLE)
  19       FUNCTION ERF(X)
  20 C
  21       CHARACTER*(*) NAME
  22       PARAMETER(NAME='ERF')
  23 #endif
  24 C
  25       LOGICAL LEF
  26       DIMENSION P1(0:3),Q1(0:3),P2(0:7),Q2(0:7),P3(0:4),Q3(0:4)
  27
  28       PARAMETER(Z1 = 1, HF = Z1/2, C1 = 0.56418 95835 47756 29D0)
  29
  30       DATA (P1(I),Q1(I),I=0,3)
  31      +/+2.42667 95523 05317 5D+2, +2.15058 87586 98612 0D+2,
  32      1 +2.19792 61618 29415 2D+1, +9.11649 05404 51490 1D+1,
  33      2 +6.99638 34886 19135 5D+0, +1.50827 97630 40778 7D+1,
  34      3 -3.56098 43701 81538 5D-2, +1/
  35
  36       DATA (P2(I),Q2(I),I=0,7)
  37      +/+3.00459 26102 01616 01D+2, +3.00459 26095 69832 93D+2,
  38      1 +4.51918 95371 18729 42D+2, +7.90950 92532 78980 27D+2,
  39      2 +3.39320 81673 43436 87D+2, +9.31354 09485 06096 21D+2,
  40      3 +1.52989 28504 69404 04D+2, +6.38980 26446 56311 67D+2,
  41      4 +4.31622 27222 05673 53D+1, +2.77585 44474 39876 43D+2,
  42      5 +7.21175 82508 83093 66D+0, +7.70001 52935 22947 30D+1,
  43      6 +5.64195 51747 89739 71D-1, +1.27827 27319 62942 35D+1,
  44      7 -1.36864 85738 27167 07D-7, +1/
  45
  46       DATA (P3(I),Q3(I),I=0,4)
  47      +/-2.99610 70770 35421 74D-3, +1.06209 23052 84679 18D-2,
  48      1 -4.94730 91062 32507 34D-2, +1.91308 92610 78298 41D-1,
  49      2 -2.26956 59353 96869 30D-1, +1.05167 51070 67932 07D+0,
  50      3 -2.78661 30860 96477 88D-1, +1.98733 20181 71352 56D+0,
  51      4 -2.23192 45973 41846 86D-2, +1/
  52
  53       LEF=.TRUE.
  54       GO TO 9
  55
  56 #if defined(CERNLIB_DOUBLE)
  57       ENTRY DERFC(X)
  58 #endif
  59 #if !defined(CERNLIB_DOUBLE)
  60       ENTRY ERFC(X)
  61 #endif
  62       LEF=.FALSE.
  63
  64     9 V=ABS(X)
  65       IF(V .LT. HF) THEN
  66        Y=V**2
  67        AP=P1(3)
  68        AQ=Q1(3)
  69        DO 1 I = 2,0,-1
  70        AP=P1(I)+Y*AP
  71     1  AQ=Q1(I)+Y*AQ
  72        H=X*AP/AQ
  73        HC=1-H
  74       ELSE
  75        IF(V .LT. 4) THEN
  76         AP=P2(7)
  77         AQ=Q2(7)
  78         DO 2 I = 6,0,-1
  79         AP=P2(I)+V*AP
  80     2   AQ=Q2(I)+V*AQ
  81         HC=EXP(-V**2)*AP/AQ
  82         H=1-HC
  83        ELSE
  84         Y=1/V**2
  85         AP=P3(4)
  86         AQ=Q3(4)
  87         DO 3 I = 3,0,-1
  88         AP=P3(I)+Y*AP
  89     3   AQ=Q3(I)+Y*AQ
  90         HC=EXP(-V**2)*(C1+Y*AP/AQ)/V
  91         H=1-HC
  92        ENDIF
  93        IF(X .LT. 0) THEN
  94         H=-H
  95         HC=2-HC
  96        ENDIF
  97       ENDIF
  98       IF(LEF) THEN
  99 #if defined(CERNLIB_DOUBLE)
 100        DERF=H
 101       ELSE
 102        DERFC=HC
 103 #endif
 104 #if !defined(CERNLIB_DOUBLE)
 105         ERF=H
 106       ELSE
 107         ERFC=HC
 108 #endif
 109       ENDIF
 110       RETURN
 111       END