static void init(char meth) { int i,j,ind; for( i=0;i<nx;i++ ) { *(x0+i)=i*hx; *(t0+i)=0.0; *(v+i)=(*(f+i)); *(s+i)=1/(*(f+i)); *(q+i)=1.0; ind=i; for( j=1;j<nz;j++ ) { ind+=nx; *(x0+ind)=0.0; *(t0+ind)=INFTY; *(v+ind)=0.0; } for( j=1;j<nt;j++ ){ ind=i+j*nx; *(q+ind)=1.0; } } if ('c'==meth) chebyshev_init(); fastmarch_init(nx,nz,nt, hx,hz,ht, x0,t0,v,s); }
static gnm_float lgammacor(gnm_float x) { static const gnm_float algmcs[15] = { GNM_const(+.1666389480451863247205729650822e+0), GNM_const(-.1384948176067563840732986059135e-4), GNM_const(+.9810825646924729426157171547487e-8), GNM_const(-.1809129475572494194263306266719e-10), GNM_const(+.6221098041892605227126015543416e-13), GNM_const(-.3399615005417721944303330599666e-15), GNM_const(+.2683181998482698748957538846666e-17), GNM_const(-.2868042435334643284144622399999e-19), GNM_const(+.3962837061046434803679306666666e-21), GNM_const(-.6831888753985766870111999999999e-23), GNM_const(+.1429227355942498147573333333333e-24), GNM_const(-.3547598158101070547199999999999e-26), GNM_const(+.1025680058010470912000000000000e-27), GNM_const(-.3401102254316748799999999999999e-29), GNM_const(+.1276642195630062933333333333333e-30) }; gnm_float tmp; #ifdef NOMORE_FOR_THREADS static int nalgm = 0; static gnm_float xbig = 0, xmax = 0; /* Initialize machine dependent constants, the first time gamma() is called. FIXME for threads ! */ if (nalgm == 0) { /* For IEEE gnm_float precision : nalgm = 5 */ nalgm = chebyshev_init(algmcs, 15, GNM_EPSILON/2);/*was d1mach(3)*/ xbig = 1 / gnm_sqrt(GNM_EPSILON/2); /* ~ 94906265.6 for IEEE gnm_float */ xmax = gnm_exp(fmin2(gnm_log(GNM_MAX / 12), -gnm_log(12 * GNM_MIN))); /* = GNM_MAX / 48 ~= 3.745e306 for IEEE gnm_float */ } #else /* For IEEE gnm_float precision GNM_EPSILON = 2^-52 = GNM_const(2.220446049250313e-16) : * xbig = 2 ^ 26.5 * xmax = GNM_MAX / 48 = 2^1020 / 3 */ # define nalgm 5 # define xbig GNM_const(94906265.62425156) # define xmax GNM_const(3.745194030963158e306) #endif if (x < 10) ML_ERR_return_NAN else if (x >= xmax) { ML_ERROR(ME_UNDERFLOW); return ML_UNDERFLOW; } else if (x < xbig) { tmp = 10 / x; return chebyshev_eval(tmp * tmp * 2 - 1, algmcs, nalgm) / x; } else return 1 / (x * 12); }
int main (void) { int i; float x, y, x1=1.0f, x2=2.0f, d[N]; for (i=0; i < N; i++) { x = cosf(i*SF_PI/(N-1)); x = 0.5*x+1.5; d[i] = x*x*x-x*x+1.0; } chebyshev_init(N,d,x1,x2); x = 1.1; y = x*x*x-x*x+1.0; printf("Compare %g and %g\n",y,chebyshev(x)); }
double gammafn(double x) { const static double gamcs[42] = { +.8571195590989331421920062399942e-2, +.4415381324841006757191315771652e-2, +.5685043681599363378632664588789e-1, -.4219835396418560501012500186624e-2, +.1326808181212460220584006796352e-2, -.1893024529798880432523947023886e-3, +.3606925327441245256578082217225e-4, -.6056761904460864218485548290365e-5, +.1055829546302283344731823509093e-5, -.1811967365542384048291855891166e-6, +.3117724964715322277790254593169e-7, -.5354219639019687140874081024347e-8, +.9193275519859588946887786825940e-9, -.1577941280288339761767423273953e-9, +.2707980622934954543266540433089e-10, -.4646818653825730144081661058933e-11, +.7973350192007419656460767175359e-12, -.1368078209830916025799499172309e-12, +.2347319486563800657233471771688e-13, -.4027432614949066932766570534699e-14, +.6910051747372100912138336975257e-15, -.1185584500221992907052387126192e-15, +.2034148542496373955201026051932e-16, -.3490054341717405849274012949108e-17, +.5987993856485305567135051066026e-18, -.1027378057872228074490069778431e-18, +.1762702816060529824942759660748e-19, -.3024320653735306260958772112042e-20, +.5188914660218397839717833550506e-21, -.8902770842456576692449251601066e-22, +.1527474068493342602274596891306e-22, -.2620731256187362900257328332799e-23, +.4496464047830538670331046570666e-24, -.7714712731336877911703901525333e-25, +.1323635453126044036486572714666e-25, -.2270999412942928816702313813333e-26, +.3896418998003991449320816639999e-27, -.6685198115125953327792127999999e-28, +.1146998663140024384347613866666e-28, -.1967938586345134677295103999999e-29, +.3376448816585338090334890666666e-30, -.5793070335782135784625493333333e-31 }; int i, n; double y; double sinpiy, value; #ifdef NOMORE_FOR_THREADS static int ngam = 0; static double xmin = 0, xmax = 0., xsml = 0., dxrel = 0.; /* Initialize machine dependent constants, the first time gamma() is called. FIXME for threads ! */ if (ngam == 0) { ngam = chebyshev_init(gamcs, 42, DBL_EPSILON/20);/*was .1*d1mach(3)*/ gammalims(&xmin, &xmax);/*-> ./gammalims.c */ xsml = exp(fmax2(log(DBL_MIN), -log(DBL_MAX)) + 0.01); /* = exp(.01)*DBL_MIN = 2.247e-308 for IEEE */ dxrel = sqrt(DBL_EPSILON);/*was sqrt(d1mach(4)) */ } #else /* For IEEE double precision DBL_EPSILON = 2^-52 = 2.220446049250313e-16 : * (xmin, xmax) are non-trivial, see ./gammalims.c * xsml = exp(.01)*DBL_MIN * dxrel = sqrt(DBL_EPSILON) = 2 ^ -26 */ # define ngam 22 # define xmin -170.5674972726612 # define xmax 171.61447887182298 # define xsml 2.2474362225598545e-308 # define dxrel 1.490116119384765696e-8 #endif if(ISNAN(x)) return x; /* If the argument is exactly zero or a negative integer * then return NaN. */ if (x == 0 || (x < 0 && x == (long)x)) { ML_ERROR(ME_DOMAIN, "gammafn"); return ML_NAN; } y = fabs(x); if (y <= 10) { /* Compute gamma(x) for -10 <= x <= 10 * Reduce the interval and find gamma(1 + y) for 0 <= y < 1 * first of all. */ n = (int) x; if(x < 0) --n; y = x - n;/* n = floor(x) ==> y in [ 0, 1 ) */ --n; value = chebyshev_eval(y * 2 - 1, gamcs, ngam) + .9375; if (n == 0) return value;/* x = 1.dddd = 1+y */ if (n < 0) { /* compute gamma(x) for -10 <= x < 1 */ /* exact 0 or "-n" checked already above */ /* The answer is less than half precision */ /* because x too near a negative integer. */ if (x < -0.5 && fabs(x - (int)(x - 0.5) / x) < dxrel) { ML_ERROR(ME_PRECISION, "gammafn"); } /* The argument is so close to 0 that the result would overflow. */ if (y < xsml) { ML_ERROR(ME_RANGE, "gammafn"); if(x > 0) return ML_POSINF; else return ML_NEGINF; } n = -n; for (i = 0; i < n; i++) { value /= (x + i); } return value; } else { /* gamma(x) for 2 <= x <= 10 */ for (i = 1; i <= n; i++) { value *= (y + i); } return value; } } else { /* gamma(x) for y = |x| > 10. */ if (x > xmax) { /* Overflow */ ML_ERROR(ME_RANGE, "gammafn"); return ML_POSINF; } if (x < xmin) { /* Underflow */ ML_ERROR(ME_UNDERFLOW, "gammafn"); return 0.; } if(y <= 50 && y == (int)y) { /* compute (n - 1)! */ value = 1.; for (i = 2; i < y; i++) value *= i; } else { /* normal case */ value = exp((y - 0.5) * log(y) - y + M_LN_SQRT_2PI + ((2*y == (int)2*y)? stirlerr(y) : lgammacor(y))); } if (x > 0) return value; if (fabs((x - (int)(x - 0.5))/x) < dxrel){ /* The answer is less than half precision because */ /* the argument is too near a negative integer. */ ML_ERROR(ME_PRECISION, "gammafn"); } sinpiy = sin(M_PI * y); if (sinpiy == 0) { /* Negative integer arg - overflow */ ML_ERROR(ME_RANGE, "gammafn"); return ML_POSINF; } return -M_PI / (y * sinpiy * value); } }
double log1p(double x) { /* series for log1p on the interval -.375 to .375 * with weighted error 6.35e-32 * log weighted error 31.20 * significant figures required 30.93 * decimal places required 32.01 */ const static double alnrcs[43] = { +.10378693562743769800686267719098e+1, -.13364301504908918098766041553133e+0, +.19408249135520563357926199374750e-1, -.30107551127535777690376537776592e-2, +.48694614797154850090456366509137e-3, -.81054881893175356066809943008622e-4, +.13778847799559524782938251496059e-4, -.23802210894358970251369992914935e-5, +.41640416213865183476391859901989e-6, -.73595828378075994984266837031998e-7, +.13117611876241674949152294345011e-7, -.23546709317742425136696092330175e-8, +.42522773276034997775638052962567e-9, -.77190894134840796826108107493300e-10, +.14075746481359069909215356472191e-10, -.25769072058024680627537078627584e-11, +.47342406666294421849154395005938e-12, -.87249012674742641745301263292675e-13, +.16124614902740551465739833119115e-13, -.29875652015665773006710792416815e-14, +.55480701209082887983041321697279e-15, -.10324619158271569595141333961932e-15, +.19250239203049851177878503244868e-16, -.35955073465265150011189707844266e-17, +.67264542537876857892194574226773e-18, -.12602624168735219252082425637546e-18, +.23644884408606210044916158955519e-19, -.44419377050807936898878389179733e-20, +.83546594464034259016241293994666e-21, -.15731559416479562574899253521066e-21, +.29653128740247422686154369706666e-22, -.55949583481815947292156013226666e-23, +.10566354268835681048187284138666e-23, -.19972483680670204548314999466666e-24, +.37782977818839361421049855999999e-25, -.71531586889081740345038165333333e-26, +.13552488463674213646502024533333e-26, -.25694673048487567430079829333333e-27, +.48747756066216949076459519999999e-28, -.92542112530849715321132373333333e-29, +.17578597841760239233269760000000e-29, -.33410026677731010351377066666666e-30, +.63533936180236187354180266666666e-31, }; #ifdef NOMORE_FOR_THREADS static int nlnrel = 0; static double xmin = 0.0; if (xmin == 0.0) xmin = -1 + sqrt(DBL_EPSILON);/*was sqrt(d1mach(4)); */ if (nlnrel == 0) /* initialize chebychev coefficients */ nlnrel = chebyshev_init(alnrcs, 43, DBL_EPSILON/20);/*was .1*d1mach(3)*/ #else # define nlnrel 22 const static double xmin = -0.999999985; /* 22: for IEEE double precision where DBL_EPSILON = 2.22044604925031e-16 */ #endif if (x == 0.) return 0.;/* speed */ if (x == -1) return(ML_NEGINF); if (x < -1) ML_ERR_return_NAN; if (fabs(x) <= .375) { /* Improve on speed (only); again give result accurate to IEEE double precision: */ if(fabs(x) < .5 * DBL_EPSILON) return x; if( (0 < x && x < 1e-8) || (-1e-9 < x && x < 0)) return x * (1 - .5 * x); /* else */ return x * (1 - x * chebyshev_eval(x / .375, alnrcs, nlnrel)); } /* else */ if (x < xmin) { /* answer less than half precision because x too near -1 */ ML_ERROR(ME_PRECISION, "log1p"); } return log(1 + x); }