|
|
1.1 root 1: /*
2: * Copyright (c) 1985 Regents of the University of California.
3: * All rights reserved.
4: *
5: * Redistribution and use in source and binary forms are permitted
6: * provided that the above copyright notice and this paragraph are
7: * duplicated in all such forms and that any documentation,
8: * advertising materials, and other materials related to such
9: * distribution and use acknowledge that the software was developed
10: * by the University of California, Berkeley. The name of the
11: * University may not be used to endorse or promote products derived
12: * from this software without specific prior written permission.
13: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
14: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
15: * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
16: *
17: * All recipients should regard themselves as participants in an ongoing
18: * research project and hence should feel obligated to report their
19: * experiences (good or bad) with these elementary function codes, using
20: * the sendbug(8) program, to the authors.
21: */
22:
23: #ifndef lint
24: static char sccsid[] = "@(#)tanh.c 5.3 (Berkeley) 6/30/88";
25: #endif /* not lint */
26:
27: /* TANH(X)
28: * RETURN THE HYPERBOLIC TANGENT OF X
29: * DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
30: * CODED IN C BY K.C. NG, 1/8/85;
31: * REVISED BY K.C. NG on 2/8/85, 2/11/85, 3/7/85, 3/24/85.
32: *
33: * Required system supported functions :
34: * copysign(x,y)
35: * finite(x)
36: *
37: * Required kernel function:
38: * expm1(x) ...exp(x)-1
39: *
40: * Method :
41: * 1. reduce x to non-negative by tanh(-x) = - tanh(x).
42: * 2.
43: * 0 < x <= 1.e-10 : tanh(x) := x
44: * -expm1(-2x)
45: * 1.e-10 < x <= 1 : tanh(x) := --------------
46: * expm1(-2x) + 2
47: * 2
48: * 1 <= x <= 22.0 : tanh(x) := 1 - ---------------
49: * expm1(2x) + 2
50: * 22.0 < x <= INF : tanh(x) := 1.
51: *
52: * Note: 22 was chosen so that fl(1.0+2/(expm1(2*22)+2)) == 1.
53: *
54: * Special cases:
55: * tanh(NaN) is NaN;
56: * only tanh(0)=0 is exact for finite argument.
57: *
58: * Accuracy:
59: * tanh(x) returns the exact hyperbolic tangent of x nealy rounded.
60: * In a test run with 1,024,000 random arguments on a VAX, the maximum
61: * observed error was 2.22 ulps (units in the last place).
62: */
63:
64: double tanh(x)
65: double x;
66: {
67: static double one=1.0, two=2.0, small = 1.0e-10, big = 1.0e10;
68: double expm1(), t, copysign(), sign;
69: int finite();
70:
71: #if !defined(vax)&&!defined(tahoe)
72: if(x!=x) return(x); /* x is NaN */
73: #endif /* !defined(vax)&&!defined(tahoe) */
74:
75: sign=copysign(one,x);
76: x=copysign(x,one);
77: if(x < 22.0)
78: if( x > one )
79: return(copysign(one-two/(expm1(x+x)+two),sign));
80: else if ( x > small )
81: {t= -expm1(-(x+x)); return(copysign(t/(two-t),sign));}
82: else /* raise the INEXACT flag for non-zero x */
83: {big+x; return(copysign(x,sign));}
84: else if(finite(x))
85: return (sign+1.0E-37); /* raise the INEXACT flag */
86: else
87: return(sign); /* x is +- INF */
88: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.