* Copyright (c) 1985 Regents of the University of California.
* %sccs.include.redist.c%
static char sccsid
[] = "@(#)tanh.c 5.5 (Berkeley) %G%";
* RETURN THE HYPERBOLIC TANGENT OF X
* DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
* CODED IN C BY K.C. NG, 1/8/85;
* REVISED BY K.C. NG on 2/8/85, 2/11/85, 3/7/85, 3/24/85.
* Required system supported functions :
* Required kernel function:
* 1. reduce x to non-negative by tanh(-x) = - tanh(x).
* 0 < x <= 1.e-10 : tanh(x) := x
* 1.e-10 < x <= 1 : tanh(x) := --------------
* 1 <= x <= 22.0 : tanh(x) := 1 - ---------------
* 22.0 < x <= INF : tanh(x) := 1.
* Note: 22 was chosen so that fl(1.0+2/(expm1(2*22)+2)) == 1.
* only tanh(0)=0 is exact for finite argument.
* tanh(x) returns the exact hyperbolic tangent of x nealy rounded.
* In a test run with 1,024,000 random arguments on a VAX, the maximum
* observed error was 2.22 ulps (units in the last place).
static double one
=1.0, two
=2.0, small
= 1.0e-10, big
= 1.0e10
;
double expm1(), t
, copysign(), sign
;
#if !defined(vax)&&!defined(tahoe)
if(x
!=x
) return(x
); /* x is NaN */
#endif /* !defined(vax)&&!defined(tahoe) */
return(copysign(one
-two
/(expm1(x
+x
)+two
),sign
));
{t
= -expm1(-(x
+x
)); return(copysign(t
/(two
-t
),sign
));}
else /* raise the INEXACT flag for non-zero x */
{big
+x
; return(copysign(x
,sign
));}
return (sign
+1.0E-37); /* raise the INEXACT flag */
return(sign
); /* x is +- INF */