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 }