1 /*							atanh.c
2  *
3  *	Inverse hyperbolic tangent
4  *
5  *
6  *
7  * SYNOPSIS:
8  *
9  * double x, y, atanh();
10  *
11  * y = atanh( x );
12  *
13  *
14  *
15  * DESCRIPTION:
16  *
17  * Returns inverse hyperbolic tangent of argument in the range
18  * MINLOG to MAXLOG.
19  *
20  * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
21  * employed.  Otherwise,
22  *        atanh(x) = 0.5 * log( (1+x)/(1-x) ).
23  *
24  *
25  *
26  * ACCURACY:
27  *
28  *                      Relative error:
29  * arithmetic   domain     # trials      peak         rms
30  *    DEC       -1,1        50000       2.4e-17     6.4e-18
31  *    IEEE      -1,1        30000       1.9e-16     5.2e-17
32  *
33  */
34 
35 /*						atanh.c	*/
36 
37 
38 /*
39 Cephes Math Library Release 2.3:  March, 1995
40 Copyright (C) 1987, 1995 by Stephen L. Moshier
41 */
42 
43 #include "mconf.h"
44 #include "cephes.h"
45 
46 #ifndef HAVE_ATANH
47 
48 #ifdef UNK
49 static double P[] = {
50 -8.54074331929669305196E-1,
51  1.20426861384072379242E1,
52 -4.61252884198732692637E1,
53  6.54566728676544377376E1,
54 -3.09092539379866942570E1
55 };
56 static double Q[] = {
57 /* 1.00000000000000000000E0,*/
58 -1.95638849376911654834E1,
59  1.08938092147140262656E2,
60 -2.49839401325893582852E2,
61  2.52006675691344555838E2,
62 -9.27277618139601130017E1
63 };
64 #endif
65 #ifdef DEC
66 static unsigned short P[] = {
67 0140132,0122235,0105775,0130300,
68 0041100,0127327,0124407,0034722,
69 0141470,0100113,0115607,0130535,
70 0041602,0164721,0003257,0013673,
71 0141367,0043046,0166673,0045750
72 };
73 static unsigned short Q[] = {
74 /*0040200,0000000,0000000,0000000,*/
75 0141234,0101326,0015460,0134564,
76 0041731,0160115,0116451,0032045,
77 0142171,0153343,0000532,0167226,
78 0042174,0000665,0077604,0000310,
79 0141671,0072235,0031114,0074377
80 };
81 #endif
82 
83 #ifdef IBMPC
84 static unsigned short P[] = {
85 0xb618,0xb17f,0x5493,0xbfeb,
86 0xe73a,0xf520,0x15da,0x4028,
87 0xf62c,0x7370,0x1009,0xc047,
88 0xe2f7,0x20d5,0x5d3a,0x4050,
89 0x697d,0xddb7,0xe8c4,0xc03e
90 };
91 static unsigned short Q[] = {
92 /*0x0000,0x0000,0x0000,0x3ff0,*/
93 0x172f,0xc366,0x905a,0xc033,
94 0x2685,0xb3a5,0x3c09,0x405b,
95 0x5dd3,0x602b,0x3adc,0xc06f,
96 0x8019,0xaff0,0x8036,0x406f,
97 0x8f20,0xa649,0x2e93,0xc057
98 };
99 #endif
100 
101 #ifdef MIEEE
102 static unsigned short P[] = {
103 0xbfeb,0x5493,0xb17f,0xb618,
104 0x4028,0x15da,0xf520,0xe73a,
105 0xc047,0x1009,0x7370,0xf62c,
106 0x4050,0x5d3a,0x20d5,0xe2f7,
107 0xc03e,0xe8c4,0xddb7,0x697d
108 };
109 static unsigned short Q[] = {
110 0xc033,0x905a,0xc366,0x172f,
111 0x405b,0x3c09,0xb3a5,0x2685,
112 0xc06f,0x3adc,0x602b,0x5dd3,
113 0x406f,0x8036,0xaff0,0x8019,
114 0xc057,0x2e93,0xa649,0x8f20
115 };
116 #endif
117 
118 extern double INFINITY, NAN;
119 
atanh(x)120 double atanh(x)
121 double x;
122 {
123 double s, z;
124 
125 #ifdef MINUSZERO
126 if( x == 0.0 )
127 	return(x);
128 #endif
129 z = fabs(x);
130 if( z >= 1.0 )
131 	{
132 	if( x == 1.0 )
133 		return( INFINITY );
134 	if( x == -1.0 )
135 		return( -INFINITY );
136 	mtherr( "atanh", DOMAIN );
137 	return( NAN );
138 	}
139 
140 if( z < 1.0e-7 )
141 	return(x);
142 
143 if( z < 0.5 )
144 	{
145 	z = x * x;
146 	s = x   +  x * z * (polevl(z, P, 4) / p1evl(z, Q, 5));
147 	return(s);
148 	}
149 
150 return( 0.5 * log((1.0+x)/(1.0-x)) );
151 }
152 
153 #endif /* HAVE_ATANH */
154 
155