core/vnl/vnl_erf.cxx
Go to the documentation of this file.
00001 // This is core/vnl/vnl_erf.cxx
00002 #include "vnl_erf.h"
00003 //:
00004 // \file
00005 // \brief Complete and incomplete gamma function approximations
00006 // \author Tim Cootes
00007 //   Translated from NETLIB/SPECFUN/erf by Ian Scott
00008 //   Original SPECFUN fortran based on
00009 //   the main computation evaluates near-minimax approximations
00010 //   from "Rational Chebyshev approximations for the error function"
00011 //   by W. J. Cody, Math. Comp., 1969, PP. 631-638.
00012 
00013 double vnl_erfc(double x)
00014 {
00015   // Initialized data
00016 
00017   const double thresh = .46875;
00018   const double xbig = 26.543;
00019   const double xhuge = 6.71e7;
00020   const double xmax = 2.53e307;
00021 #if 0 // unused:
00022   const double xneg = -26.628;
00023   const double xsmall = 1.11e-16;
00024   const double xinf = 1.79e308;
00025 #endif // 0
00026 
00027   const double c[9] = { .564188496988670089,8.88314979438837594,
00028     66.1191906371416295,298.635138197400131,881.95222124176909,
00029     1712.04761263407058,2051.07837782607147,1230.33935479799725,
00030     2.15311535474403846e-8 };
00031   const double d[8] = { 15.7449261107098347,117.693950891312499,
00032     537.181101862009858,1621.38957456669019,3290.79923573345963,
00033     4362.61909014324716,3439.36767414372164,1230.33935480374942 };
00034   const double p[6] = { .305326634961232344,.360344899949804439,
00035     .125781726111229246,.0160837851487422766,6.58749161529837803e-4,
00036     .0163153871373020978 };
00037   const double q[5] = { 2.56852019228982242,1.87295284992346047,
00038     .527905102951428412,.0605183413124413191,.00233520497626869185 };
00039   const double sqrpi = .56418958354775628695;
00040 
00041 
00042   // Local variables
00043   double xden, xnum, result;
00044   int i;
00045   double y, del, ysq;
00046 
00047   // ------------------------------------------------------------------
00048 
00049   // This packet evaluates  erf(x),  erfc(x),  and  exp(x*x)*erfc(x)
00050   //   for a real argument  x.  It contains three FUNCTION type
00051   //   subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
00052   //   and one SUBROUTINE type subprogram, CALERF.  The calling
00053   //   statements for the primary entries are:
00054   //
00055   //                   Y=ERF(X)     (or   Y=DERF(X)),
00056   //
00057   //                   Y=ERFC(X)    (or   Y=DERFC(X)),
00058   //   and
00059   //                   Y=ERFCX(X)   (or   Y=DERFCX(X)).
00060   //
00061   //   The routine  CALERF  is intended for internal packet use only,
00062   //   all computations within the packet being concentrated in this
00063   //   routine.  The function subprograms invoke  CALERF  with the
00064   //   statement
00065   //
00066   //          CALL CALERF(ARG,RESULT,JINT)
00067   //
00068   //   where the parameter usage is as follows
00069   //
00070   //      Function                     Parameters for CALERF
00071   //       call              ARG                  Result          JINT
00072   //
00073   //     ERF(ARG)      ANY REAL ARGUMENT         ERF(ARG)          0
00074   //     ERFC(ARG)     ABS(ARG) .LT. XBIG        ERFC(ARG)         1
00075   //     ERFCX(ARG)    XNEG .LT. ARG .LT. XMAX   ERFCX(ARG)        2
00076   //
00077   //   The main computation evaluates near-minimax approximations
00078   //   from "Rational Chebyshev approximations for the error function"
00079   //   by W. J. Cody, Math. Comp., 1969, PP. 631-638.  This
00080   //   transportable program uses rational functions that theoretically
00081   //   approximate  erf(x)  and  erfc(x)  to at least 18 significant
00082   //   decimal digits.  The accuracy achieved depends on the arithmetic
00083   //   system, the compiler, the intrinsic functions, and proper
00084   //   selection of the machine-dependent constants.
00085   //
00086   // *******************************************************************
00087   // *******************************************************************
00088   //
00089   // Explanation of machine-dependent constants
00090   //
00091   //   XMIN   = the smallest positive floating-point number.
00092   //   XINF   = the largest positive finite floating-point number.
00093   //   XNEG   = the largest negative argument acceptable to ERFCX;
00094   //            the negative of the solution to the equation
00095   //            2*exp(x*x) = XINF.
00096   //   XSMALL = argument below which erf(x) may be represented by
00097   //            2*x/sqrt(pi)  and above which  x*x  will not underflow.
00098   //            A conservative value is the largest machine number X
00099   //            such that   1.0 + X = 1.0   to machine precision.
00100   //   XBIG   = largest argument acceptable to ERFC;  solution to
00101   //            the equation:  W(x) * (1-0.5/x**2) = XMIN,  where
00102   //            W(x) = exp(-x*x)/[x*sqrt(pi)].
00103   //   XHUGE  = argument above which  1.0 - 1/(2*x*x) = 1.0  to
00104   //            machine precision.  A conservative value is
00105   //            1/[2*sqrt(XSMALL)]
00106   //   XMAX   = largest acceptable argument to ERFCX; the minimum
00107   //            of XINF and 1/[sqrt(pi)*XMIN].
00108   //
00109   //   Approximate values for some important machines are:
00110   //
00111   //                               XMIN       XINF        XNEG     XSMALL   XBIG   XHUGE    XMAX
00112   //
00113   //  CDC 7600           (S.P.)  3.13E-294   1.26E+322   -27.220  7.11E-1  25.922  8.39E+6  1.80X+293 5
00114   //  CRAY-1             (S.P.)  4.58E-2467  5.45E+2465  -75.345  7.11E-1  75.326  8.39E+6  5.45E+24655
00115   // IEEE(IBM/XT,SUN,..) (S.P.)  1.18E-38    3.40E+38     -9.382  5.96E-8   9.194  2.90E+3  4.79E+37
00116   // IEEE(IBM/XT,SUN,..) (D.P.)  2.23D-308   1.79D+308   -26.628  1.11D-1  26.543  6.71D+7  2.53D+307 6
00117   //  IBM 195            (D.P.)  5.40D-79    7.23E+75    -13.190  1.39D-1  13.306  1.90D+8  7.23E+75  7
00118   //  UNIVAC 1108        (D.P.)  2.78D-309   8.98D+307   -26.615  1.73D-1  26.582  5.37D+8  8.98D+307 8
00119   //  VAX D-Format       (D.P.)  2.94D-39    1.70D+38     -9.345  1.39D-1   9.269  1.90D+8  1.70D+38  7
00120   //  VAX G-Format       (D.P.)  5.56D-309   8.98D+307   -26.615  1.11D-1  26.569  6.71D+7  8.98D+307 6
00121 
00122   // *******************************************************************
00123   // *******************************************************************
00124 
00125   // Error returns
00126   //
00127   //  The program returns  ERFC = 0      for  ARG .GE. XBIG;
00128   //
00129   //                       ERFCX = XINF  for  ARG .LT. XNEG;
00130   //      and
00131   //                       ERFCX = 0     for  ARG .GE. XMAX.
00132 
00133 
00134   // Intrinsic functions required are:
00135   //
00136   //     ABS, AINT, EXP
00137 
00138 
00139   //  Author: W. J. Cody
00140   //          Mathematics and Computer Science Division
00141   //          Argonne National Laboratory
00142   //          Argonne, IL 60439
00143   //
00144   //  Latest modification: March 19, 1990
00145 
00146   y = vcl_abs(x);
00147   // ------------------------------------------------------------------
00148   //  Evaluate  erfc  for  |X| <= 0.46875
00149   // ------------------------------------------------------------------
00150   if (y <= thresh)
00151     return 1 - vnl_erf(x);
00152 
00153   // ------------------------------------------------------------------
00154   //  Evaluate  erfc  for 0.46875 <= |X| <= 4.0
00155   // ------------------------------------------------------------------
00156   else if (y <= 4.0)
00157   {
00158     xnum = c[8] * y;
00159     xden = y;
00160     for (i = 0; i < 7; ++i)
00161     {
00162       xnum = (xnum + c[i]) * y;
00163       xden = (xden + d[i]) * y;
00164     }
00165     result = (xnum + c[7]) / (xden + d[7]);
00166     ysq = vcl_floor(y * 16.0) / 16.0;
00167     del = (y - ysq) * (y + ysq);
00168     result = vcl_exp(-ysq * ysq) * vcl_exp(-del) * result;
00169 
00170     // ------------------------------------------------------------------
00171     //  Evaluate  erfc  for |X| > 4.0
00172     // ------------------------------------------------------------------
00173   }
00174   else
00175   {
00176     if (y >= xhuge)
00177     {
00178       if (y < xmax)
00179         result = sqrpi / y;
00180       else
00181         result = 0;
00182     }
00183     else if (y >= xbig)
00184       result = 0;
00185     else
00186     {
00187       ysq = 1.0 / (y * y);
00188       xnum = p[5] * ysq;
00189       xden = ysq;
00190       for (unsigned i = 0; i < 4; ++i)
00191       {
00192         xnum = (xnum + p[i]) * ysq;
00193         xden = (xden + q[i]) * ysq;
00194       }
00195       result = ysq * (xnum + p[4]) / (xden + q[4]);
00196       result = (sqrpi - result) / y;
00197       ysq = vcl_floor(y * 16.0) / 16.0;
00198       del = (y - ysq) * (y + ysq);
00199       result = vcl_exp(-ysq * ysq) * vcl_exp(-del) * result;
00200     }
00201   }
00202   // ------------------------------------------------------------------
00203   //  Fix up for negative argument, erf, etc.
00204   // ------------------------------------------------------------------
00205   if (x < 0.0)
00206     result = 2.0 - result;
00207   return result;
00208 }