1*34124Sbostic /* 224590Szliu * Copyright (c) 1985 Regents of the University of California. 3*34124Sbostic * All rights reserved. 4*34124Sbostic * 5*34124Sbostic * Redistribution and use in source and binary forms are permitted 6*34124Sbostic * provided that this notice is preserved and that due credit is given 7*34124Sbostic * to the University of California at Berkeley. The name of the University 8*34124Sbostic * may not be used to endorse or promote products derived from this 9*34124Sbostic * software without specific prior written permission. This software 10*34124Sbostic * is provided ``as is'' without express or implied warranty. 11*34124Sbostic * 12*34124Sbostic * All recipients should regard themselves as participants in an ongoing 13*34124Sbostic * research project and hence should feel obligated to report their 14*34124Sbostic * experiences (good or bad) with these elementary function codes, using 15*34124Sbostic * the sendbug(8) program, to the authors. 1624590Szliu */ 1724590Szliu 1824590Szliu #ifndef lint 19*34124Sbostic static char sccsid[] = "@(#)atanh.c 5.2 (Berkeley) 04/29/88"; 20*34124Sbostic #endif /* not lint */ 2124590Szliu 2224590Szliu /* ATANH(X) 2324590Szliu * RETURN THE HYPERBOLIC ARC TANGENT OF X 2424590Szliu * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS) 2524590Szliu * CODED IN C BY K.C. NG, 1/8/85; 2624590Szliu * REVISED BY K.C. NG on 2/7/85, 3/7/85, 8/18/85. 2724590Szliu * 2824590Szliu * Required kernel function: 2924590Szliu * log1p(x) ...return log(1+x) 3024590Szliu * 3124590Szliu * Method : 3224590Szliu * Return 3324590Szliu * 1 2x x 3424590Szliu * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) 3524590Szliu * 2 1 - x 1 - x 3624590Szliu * 3724590Szliu * Special cases: 3824590Szliu * atanh(x) is NaN if |x| > 1 with signal; 3924590Szliu * atanh(NaN) is that NaN with no signal; 4024590Szliu * atanh(+-1) is +-INF with signal. 4124590Szliu * 4224590Szliu * Accuracy: 4324590Szliu * atanh(x) returns the exact hyperbolic arc tangent of x nearly rounded. 4424590Szliu * In a test run with 512,000 random arguments on a VAX, the maximum 4524590Szliu * observed error was 1.87 ulps (units in the last place) at 4624590Szliu * x= -3.8962076028810414000e-03. 4724590Szliu */ 4831853Szliu #if defined(vax)||defined(tahoe) 4924590Szliu #include <errno.h> 5031853Szliu #endif /* defined(vax)||defined(tahoe) */ 5124590Szliu 5224590Szliu double atanh(x) 5324590Szliu double x; 5424590Szliu { 5524590Szliu double copysign(),log1p(),z; 5624590Szliu z = copysign(0.5,x); 5724590Szliu x = copysign(x,1.0); 5831853Szliu #if defined(vax)||defined(tahoe) 5924590Szliu if (x == 1.0) { 6024590Szliu extern double infnan(); 6124590Szliu return(copysign(1.0,z)*infnan(ERANGE)); /* sign(x)*INF */ 6224590Szliu } 6331853Szliu #endif /* defined(vax)||defined(tahoe) */ 6424590Szliu x = x/(1.0-x); 6524590Szliu return( z*log1p(x+x) ); 6624590Szliu } 67