long double __tgammal_r(long double x, int* sgngaml)
{
long double p, q, z;
int i;
*sgngaml = 1;
#ifdef NANS
if (isnanl(x))
return (NANL);
#endif
#ifdef INFINITIES
#ifdef NANS
if (x == INFINITYL)
return (x);
if (x == -INFINITYL)
return (NANL);
#else
if (!isfinite(x))
return (x);
#endif
#endif
q = fabsl(x);
if (q > 13.0L)
{
if (q > MAXGAML)
goto goverf;
if (x < 0.0L)
{
p = floorl(q);
if (p == q)
{
gsing:
_SET_ERRNO(EDOM);
mtherr("tgammal", SING);
#ifdef INFINITIES
return (INFINITYL);
#else
return (*sgngaml * MAXNUML);
#endif
}
i = p;
if ((i & 1) == 0)
*sgngaml = -1;
z = q - p;
if (z > 0.5L)
{
p += 1.0L;
z = q - p;
}
z = q * sinl(PIL * z);
z = fabsl(z) * stirf(q);
if (z <= PIL/MAXNUML)
{
goverf:
_SET_ERRNO(ERANGE);
mtherr("tgammal", OVERFLOW);
#ifdef INFINITIES
return(*sgngaml * INFINITYL);
#else
return(*sgngaml * MAXNUML);
#endif
}
z = PIL/z;
}
else
{
z = stirf(x);
}
return (*sgngaml * z);
}
z = 1.0L;
while (x >= 3.0L)
{
x -= 1.0L;
z *= x;
}
while (x < -0.03125L)
{
z /= x;
x += 1.0L;
}
if (x <= 0.03125L)
goto Small;
while (x < 2.0L)
{
z /= x;
x += 1.0L;
}
if (x == 2.0L)
return (z);
x -= 2.0L;
p = polevll( x, P, 7 );
q = polevll( x, Q, 8 );
return (z * p / q);
Small:
if (x == 0.0L)
{
goto gsing;
}
else
{
if (x < 0.0L)
{
x = -x;
q = z / (x * polevll(x, SN, 8));
}
else
q = z / (x * polevll(x, S, 8));
}
return q;
}
double gamm (double x)
{
double p, q, z;
int i;
sgngam = 1;
q = fabs(x);
if( q > 33.0 )
{ if( x < 0.0 )
{ p = floor(q);
if( p == q )
goto goverf;
i = (int)p;
if( (i & 1) == 0 )
sgngam = -1;
z = q - p;
if( z > 0.5 )
{
p += 1.0;
z = q - p;
}
z = q * sin( PI * z );
if( z == 0.0 )
{
goverf:
output("Overflow in gamma\n");
error=1; return 0;
}
z = fabs(z);
z = PI/(z * stirf(q) );
}
else
{
z = stirf(x);
}
return( sgngam * z );
}
z = 1.0;
while( x >= 3.0 )
{
x -= 1.0;
z *= x;
}
while( x < 0.0 )
{
if( x > -1.E-9 )
goto small;
z /= x;
x += 1.0;
}
while( x < 2.0 )
{
if( x < 1.e-9 )
goto small;
z /= x;
x += 1.0;
}
if( (x == 2.0) || (x == 3.0) )
return(z);
x -= 2.0;
p = polevl( x, P, 6 );
q = polevl( x, Q, 7 );
return( z * p / q );
small:
if( x == 0.0 )
{
output("Wrong argument for gamma.\n");
error=1; return 0;
}
else
return( z/((1.0 + 0.5772156649015329 * x) * x) );
}
float __tgammaf_r( float x, int* sgngamf)
{
float p, q, z, nz;
int i, direction, negative;
#ifdef NANS
if( isnan(x) )
return(x);
#endif
#ifdef INFINITIES
#ifdef NANS
if( x == INFINITYF )
return(x);
if( x == -INFINITYF )
return(NANF);
#else
if( !isfinite(x) )
return(x);
#endif
#endif
*sgngamf = 1;
negative = 0;
nz = 0.0;
if( x < 0.0 )
{
negative = 1;
q = -x;
p = floorf(q);
if( p == q )
{
gsing:
_SET_ERRNO(EDOM);
mtherr( "tgammaf", SING );
#ifdef INFINITIES
return (INFINITYF);
#else
return (MAXNUMF);
#endif
}
i = p;
if( (i & 1) == 0 )
*sgngamf = -1;
nz = q - p;
if( nz > 0.5 )
{
p += 1.0;
nz = q - p;
}
nz = q * sinf( PIF * nz );
if( nz == 0.0 )
{
_SET_ERRNO(ERANGE);
mtherr( "tgamma", OVERFLOW );
#ifdef INFINITIES
return( *sgngamf * INFINITYF);
#else
return( *sgngamf * MAXNUMF);
#endif
}
if( nz < 0 )
nz = -nz;
x = q;
}
if( x >= 10.0 )
{
z = stirf(x);
}
if( x < 2.0 )
direction = 1;
else
direction = 0;
z = 1.0;
while( x >= 3.0 )
{
x -= 1.0;
z *= x;
}
/*
while( x < 0.0 )
{
if( x > -1.E-4 )
goto Small;
z *=x;
x += 1.0;
}
*/
while( x < 2.0 )
{
if( x < 1.e-4 )
goto Small;
z *=x;
x += 1.0;
}
if( direction )
z = 1.0/z;
if( x == 2.0 )
return(z);
x -= 2.0;
p = z * polevlf( x, P, 7 );
gdone:
if( negative )
{
p = *sgngamf * PIF/(nz * p );
}
return(p);
Small:
if( x == 0.0 )
{
goto gsing;
}
else
{
p = z / ((1.0 + 0.5772156649015329 * x) * x);
goto gdone;
}
}
double Gamma(double x)
{
double p, q, z;
int i;
sgngam = 1;
if (!npy_isfinite(x)) {
return x;
}
q = fabs(x);
if (q > 33.0) {
if (x < 0.0) {
p = floor(q);
if (p == q) {
gamnan:
mtherr("Gamma", OVERFLOW);
return (NPY_INFINITY);
}
i = p;
if ((i & 1) == 0)
sgngam = -1;
z = q - p;
if (z > 0.5) {
p += 1.0;
z = q - p;
}
z = q * sin(NPY_PI * z);
if (z == 0.0) {
return (sgngam * NPY_INFINITY);
}
z = fabs(z);
z = NPY_PI / (z * stirf(q));
}
else {
z = stirf(x);
}
return (sgngam * z);
}
z = 1.0;
while (x >= 3.0) {
x -= 1.0;
z *= x;
}
while (x < 0.0) {
if (x > -1.E-9)
goto small;
z /= x;
x += 1.0;
}
while (x < 2.0) {
if (x < 1.e-9)
goto small;
z /= x;
x += 1.0;
}
if (x == 2.0)
return (z);
x -= 2.0;
p = polevl(x, P, 6);
q = polevl(x, Q, 7);
return (z * p / q);
small:
if (x == 0.0) {
goto gamnan;
}
else
return (z / ((1.0 + 0.5772156649015329 * x) * x));
}
double Gamma(double x)
{
double p, q, z;
int i;
sgngam = 1;
#ifdef NANS
if( isnan(x) )
return(x);
#endif
#ifdef INFINITIES
#ifdef NANS
if( x == INFINITY )
return(x);
if( x == -INFINITY )
return(x);
#else
if( !isfinite(x) )
return(x);
#endif
#endif
q = fabs(x);
if( q > 33.0 )
{
if( x < 0.0 )
{
p = floor(q);
if( p == q )
{
#ifdef NANS
gamnan:
mtherr( "Gamma", OVERFLOW );
return (MAXNUM);
#else
goto goverf;
#endif
}
i = p;
if( (i & 1) == 0 )
sgngam = -1;
z = q - p;
if( z > 0.5 )
{
p += 1.0;
z = q - p;
}
z = q * sin( PI * z );
if( z == 0.0 )
{
#ifdef INFINITIES
return( sgngam * INFINITY);
#else
goverf:
mtherr( "Gamma", OVERFLOW );
return( sgngam * MAXNUM);
#endif
}
z = fabs(z);
z = PI/(z * stirf(q) );
}
else
{
z = stirf(x);
}
return( sgngam * z );
}
z = 1.0;
while( x >= 3.0 )
{
x -= 1.0;
z *= x;
}
while( x < 0.0 )
{
if( x > -1.E-9 )
goto small;
z /= x;
x += 1.0;
}
while( x < 2.0 )
{
if( x < 1.e-9 )
goto small;
z /= x;
x += 1.0;
}
if( x == 2.0 )
return(z);
x -= 2.0;
p = polevl( x, P, 6 );
q = polevl( x, Q, 7 );
return( z * p / q );
small:
if( x == 0.0 )
{
#ifdef INFINITIES
#ifdef NANS
goto gamnan;
#else
return( INFINITY );
#endif
#else
mtherr( "Gamma", SING );
return( MAXNUM );
#endif
}
else
return( z/((1.0 + 0.5772156649015329 * x) * x) );
}
double __tgamma_r(double x, int *sgngam)
{
double p, q, z;
int i;
*sgngam = 1;
#ifdef NANS
if (isnan(x))
return (x);
#endif
#ifdef INFINITIES
#ifdef NANS
if (x == INFINITY)
return (x);
if (x == -INFINITY)
return (NAN);
#else
if (!isfinite(x))
return (x);
#endif
#endif
q = fabs(x);
if (q > 33.0)
{
if (x < 0.0)
{
p = floor(q);
if (p == q)
{
gsing:
_SET_ERRNO(EDOM);
mtherr("tgamma", SING);
#ifdef INFINITIES
return (INFINITY);
#else
return (MAXNUM);
#endif
}
i = p;
if ((i & 1) == 0)
*sgngam = -1;
z = q - p;
if (z > 0.5)
{
p += 1.0;
z = q - p;
}
z = q * sin(PI * z);
if (z == 0.0)
{
_SET_ERRNO(ERANGE);
mtherr("tgamma", OVERFLOW);
#ifdef INFINITIES
return (*sgngam * INFINITY);
#else
return (*sgngam * MAXNUM);
#endif
}
z = fabs(z);
z = PI/(z * stirf(q));
}
else
{
z = stirf(x);
}
return (*sgngam * z);
}
z = 1.0;
while (x >= 3.0)
{
x -= 1.0;
z *= x;
}
while (x < 0.0)
{
if (x > -1.E-9)
goto Small;
z /= x;
x += 1.0;
}
while (x < 2.0)
{
if (x < 1.e-9)
goto Small;
z /= x;
x += 1.0;
}
if (x == 2.0)
return (z);
x -= 2.0;
p = polevl( x, P, 6 );
q = polevl( x, Q, 7 );
return (z * p / q);
Small:
if (x == 0.0)
{
goto gsing;
}
else
return (z/((1.0 + 0.5772156649015329 * x) * x));
}
long double
tgammal(long double x)
{
long double p, q, z;
int i;
signgam = 1;
if( isnan(x) )
return(NAN);
if(x == INFINITY)
return(INFINITY);
if(x == -INFINITY)
return(x - x);
q = fabsl(x);
if( q > 13.0L )
{
if( q > MAXGAML )
goto goverf;
if( x < 0.0L )
{
p = floorl(q);
if( p == q )
return (x - x) / (x - x);
i = p;
if( (i & 1) == 0 )
signgam = -1;
z = q - p;
if( z > 0.5L )
{
p += 1.0L;
z = q - p;
}
z = q * sinl( PIL * z );
z = fabsl(z) * stirf(q);
if( z <= PIL/LDBL_MAX )
{
goverf:
return( signgam * INFINITY);
}
z = PIL/z;
}
else
{
z = stirf(x);
}
return( signgam * z );
}
z = 1.0L;
while( x >= 3.0L )
{
x -= 1.0L;
z *= x;
}
while( x < -0.03125L )
{
z /= x;
x += 1.0L;
}
if( x <= 0.03125L )
goto small;
while( x < 2.0L )
{
z /= x;
x += 1.0L;
}
if( x == 2.0L )
return(z);
x -= 2.0L;
p = __polevll( x, P, 7 );
q = __polevll( x, Q, 8 );
z = z * p / q;
if( z < 0 )
signgam = -1;
return z;
small:
if( x == 0.0L )
return (x - x) / (x - x);
else
{
if( x < 0.0L )
{
x = -x;
q = z / (x * __polevll( x, SN, 8 ));
signgam = -1;
}
else
q = z / (x * __polevll( x, S, 8 ));
}
return q;
}
long double tgammal(long double x)
{
long double p, q, z;
if (!isfinite(x))
return x + INFINITY;
q = fabsl(x);
if (q > 13.0) {
if (x < 0.0) {
p = floorl(q);
z = q - p;
if (z == 0)
return 0 / z;
if (q > MAXGAML) {
z = 0;
} else {
if (z > 0.5) {
p += 1.0;
z = q - p;
}
z = q * sinl(PIL * z);
z = fabsl(z) * stirf(q);
z = PIL/z;
}
if (0.5 * p == floorl(q * 0.5))
z = -z;
} else if (x > MAXGAML) {
z = x * 0x1p16383L;
} else {
z = stirf(x);
}
return z;
}
z = 1.0;
while (x >= 3.0) {
x -= 1.0;
z *= x;
}
while (x < -0.03125L) {
z /= x;
x += 1.0;
}
if (x <= 0.03125L)
goto small;
while (x < 2.0) {
z /= x;
x += 1.0;
}
if (x == 2.0)
return z;
x -= 2.0;
p = __polevll(x, P, 7);
q = __polevll(x, Q, 8);
z = z * p / q;
return z;
small:
/* z==1 if x was originally +-0 */
if (x == 0 && z != 1)
return x / x;
if (x < 0.0) {
x = -x;
q = z / (x * __polevll(x, SN, 8));
} else
q = z / (x * __polevll(x, S, 8));
return q;
}
