_WMRTLINK double _IF_dsinh( double x )
/************************************/
{
unsigned int err_code;
double z;
z = fabs( x );
if( z > 709.782712893384 ) { /* if argument is too large */
if( x < 0.0 ) {
err_code = FP_FUNC_SINH | M_OVERFLOW | V_NEG_HUGEVAL;
} else {
err_code = FP_FUNC_SINH | M_OVERFLOW | V_HUGEVAL;
}
z = __math1err( err_code, &x );
} else {
/* if( z <= ldexp( 1.0, -26 ) ) { */
if( z <= 1.49011611938476580e-008 ) { /* if x is small */
z = x;
} else {
z = exp( x );
z = (z - PDIV( 1.0, z )) / 2.0;
}
}
return( z );
}
_WMRTLINK double acosh( double x )
/********************************/
{
double z;
if( x < 1.0 ) {
z = __math1err( FP_FUNC_ACOSH | M_DOMAIN | V_NEG_HUGEVAL, &x );
} else {
z = log( x + sqrt( x * x - 1.0 ) );
}
return( z );
}
double __log87_err( double x, unsigned char code )
/************************************************/
{
unsigned int err_code;
if( code != FUNC_ACOSH && x == 0.0 ) {
err_code = code | M_SING | V_NEG_HUGEVAL;
} else {
err_code = code | M_DOMAIN | V_NEG_HUGEVAL;
}
return( __math1err( err_code, &x ) );
}
double DCOTAN( double arg ) {
//===========================
// Return the cotangent of arg.
double tangent;
tangent = tan( arg );
if( tangent == 0.0 ) {
return( __math1err( FUNC_COTAN | M_OVERFLOW | V_HUGEVAL, &arg ) );
}
return( 1.0 / tangent );
}
_WMRTLINK long _IF_ipow( long base, long power )
/**********************************************/
{
long result;
if( base == 0 ) {
if( power <= 0 ) {
double dummy;
dummy = 0.0;
// used to be like this:
// result = _matherr( DOMAIN, "ipow", NULL, NULL, 1.0 );
// now it is like this:
result = __math1err( FP_FUNC_IPOW | M_DOMAIN | V_ONE, &dummy );
// should be more like this:
// result = __imath2err( FP_FUNC_POW | M_DOMAIN | V_ZERO, &base, &power );
} else {
result = 0;
}
} else if( power < 0 ) {
if( base == 1 ) {
result = 1;
} else if( base == -1 ) {
if( power & 1 ) {
result = -1;
} else {
result = 1;
}
} else {
result = 0;
}
} else {
result = 1;
while( power > 0 ) {
if( power & 1 ) {
result *= base;
--power;
} else {
base *= base;
power /= 2;
}
}
}
return( result );
}
_WMRTLINK double _IF_dcosh( double x )
/*************************/
{
double z;
z = fabs( x );
if( z > 709.782712893384 ) { /* if argument is too large */
// z = _matherr( OVERFLOW, "cosh", &x, &x, HUGE_VAL );
z = __math1err( FUNC_COSH | M_OVERFLOW | V_HUGEVAL, &x );
} else {
/* if( z <= ldexp( 1.0, -26 ) ) { */
if( z <= 1.49011611938476580e-008 ) { /* if x is small */
z = 1.0;
} else {
z = exp( x );
z = (z + PDIV( 1.0 , z) ) / 2.0;
}
}
return( z );
}
_WMRTLINK double yn( int n, double x )
/**************************/
{
int j;
double by, bym, byp, tox;
if( x < 0.0 ) {
return __math1err( FP_FUNC_YN | M_DOMAIN | V_NEG_HUGEVAL, &x );
}
bym = y0( x );
if( n == 0 )
return( bym );
tox = PDIV( 2.0, x );
by = y1( x );
for( j = 1; j < n; j++ ) {
byp = j * tox * by - bym;
bym = by;
by = byp;
}
return( by );
}
_WMRTLINK double y1( double x ) /* Bessel function y1(x) */
/*******************/
{
double xx, y, z;
if( x < 0.0 ) {
// z = _matherr( DOMAIN, "y1", &x, &x, - HUGE_VAL );
z = __math1err( FUNC_Y1 | M_DOMAIN | V_NEG_HUGEVAL, &x );
} else if( x < 8.0 ) {
y = x * x;
z = PDIV( x * _EvalPoly( y, _Y1P, 10 ) , _EvalPoly( y, _Y1Q, 4 ) )
+ Two_over_pi * ( j1(x) * log(x) - PDIV(1.0,x) );
} else {
z = PDIV( 8.0 , x );
y = z * z;
xx = x - ThreePIby4;
z = sqrt( PDIV( Two_over_pi , x ) ) *
( PDIV( sin(xx) * _EvalPoly( y, _P1P, 4 ) , _EvalPoly( y, _P1Q, 5 ) )
+ z * cos(xx) *(PDIV(_EvalPoly( y, _Q1P, 4 ) , _EvalPoly( y, _Q1Q, 4 ))));
}
return( z );
}
double __math87_err( double x, unsigned char code )
/*************************************************/
{
unsigned int err_code;
err_code = code | M_OVERFLOW | V_HUGEVAL;
switch( code ) {
case FP_FUNC_ACOS:
case FP_FUNC_ASIN:
case FP_FUNC_SQRT:
err_code = code | M_DOMAIN | V_ZERO;
break;
case FP_FUNC_EXP:
if( x < 0.0 )
return( 0.0 );
break;
case FP_FUNC_SINH:
if( x < 0.0 )
err_code = code | M_OVERFLOW | V_NEG_HUGEVAL;
break;
}
return( __math1err( err_code, &x ) );
}
_WMRTLINK double _IF_dexp( double x )
/***********************************/
{
int sgnx;
int exp;
int exp2;
const double *poly;
double ipart;
double a;
double b;
double ee;
if( fabs( x ) < 4.445e-16 ) { /* if argument is too small */
x = 1.0;
} else if( fabs( x ) > 709.782712893384 ) {/* if argument is too large */
if( x < 0.0 ) {
/* FPStatus = FPS_UNDERFLOW; - - underflow */
x = 0.0; /* - - set result to 0 */
} else {
x = __math1err( FP_FUNC_EXP | M_OVERFLOW | V_HUGEVAL, &x );
}
#if defined(_M_IX86)
} else if( _RWD_real87 ) {
x = _exp87( x );
#endif
} else {
x *= log2e;
sgnx = __sgn( x );
x = modf( fabs( x ), &ipart );
exp = ipart;
if( sgnx < 0 ) {
exp = -exp;
if( x != 0.0 ) {
--exp;
x = 1.0 - x;
}
}
exp2 = 0;
if( x != 0.0 ) {
x = modf( ldexp( x, 4 ), &ipart );
if( x != 0.0 ) {
x = ldexp( x, -4 );
}
exp2 = ipart;
}
ee = x * x;
a = ee + const0;
b = (ee * const1 + const2) * x;
x = (a + b) / (a - b);
poly = ExpConsts;
while( exp2 != 0 ) {
if( exp2 & 1 ) {
x *= *poly;
}
++poly;
exp2 = exp2 >> 1;
}
x = ldexp( x, exp );
}
return( x );
}
