134124Sbostic /* 224590Szliu * Copyright (c) 1985 Regents of the University of California. 334124Sbostic * All rights reserved. 434124Sbostic * 534124Sbostic * Redistribution and use in source and binary forms are permitted 634931Sbostic * provided that the above copyright notice and this paragraph are 734931Sbostic * duplicated in all such forms and that any documentation, 834931Sbostic * advertising materials, and other materials related to such 934931Sbostic * distribution and use acknowledge that the software was developed 1034931Sbostic * by the University of California, Berkeley. The name of the 1134931Sbostic * University may not be used to endorse or promote products derived 1234931Sbostic * from this software without specific prior written permission. 1334931Sbostic * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR 1434931Sbostic * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 1534931Sbostic * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 1634124Sbostic * 1734124Sbostic * All recipients should regard themselves as participants in an ongoing 1834124Sbostic * research project and hence should feel obligated to report their 1934124Sbostic * experiences (good or bad) with these elementary function codes, using 2034124Sbostic * the sendbug(8) program, to the authors. 2124590Szliu */ 2224590Szliu 2324590Szliu #ifndef lint 24*35679Sbostic static char sccsid[] = "@(#)atanh.c 5.4 (Berkeley) 09/22/88"; 2534124Sbostic #endif /* not lint */ 2624590Szliu 2724590Szliu /* ATANH(X) 2824590Szliu * RETURN THE HYPERBOLIC ARC TANGENT OF X 2924590Szliu * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS) 3024590Szliu * CODED IN C BY K.C. NG, 1/8/85; 3124590Szliu * REVISED BY K.C. NG on 2/7/85, 3/7/85, 8/18/85. 3224590Szliu * 3324590Szliu * Required kernel function: 3424590Szliu * log1p(x) ...return log(1+x) 3524590Szliu * 3624590Szliu * Method : 3724590Szliu * Return 3824590Szliu * 1 2x x 3924590Szliu * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------) 4024590Szliu * 2 1 - x 1 - x 4124590Szliu * 4224590Szliu * Special cases: 4324590Szliu * atanh(x) is NaN if |x| > 1 with signal; 4424590Szliu * atanh(NaN) is that NaN with no signal; 4524590Szliu * atanh(+-1) is +-INF with signal. 4624590Szliu * 4724590Szliu * Accuracy: 4824590Szliu * atanh(x) returns the exact hyperbolic arc tangent of x nearly rounded. 4924590Szliu * In a test run with 512,000 random arguments on a VAX, the maximum 5024590Szliu * observed error was 1.87 ulps (units in the last place) at 5124590Szliu * x= -3.8962076028810414000e-03. 5224590Szliu */ 53*35679Sbostic #include "mathimpl.h" 54*35679Sbostic 5531853Szliu #if defined(vax)||defined(tahoe) 5624590Szliu #include <errno.h> 5731853Szliu #endif /* defined(vax)||defined(tahoe) */ 5824590Szliu 5924590Szliu double atanh(x) 6024590Szliu double x; 6124590Szliu { 62*35679Sbostic double z; 6324590Szliu z = copysign(0.5,x); 6424590Szliu x = copysign(x,1.0); 6531853Szliu #if defined(vax)||defined(tahoe) 6624590Szliu if (x == 1.0) { 6724590Szliu return(copysign(1.0,z)*infnan(ERANGE)); /* sign(x)*INF */ 6824590Szliu } 6931853Szliu #endif /* defined(vax)||defined(tahoe) */ 7024590Szliu x = x/(1.0-x); 7124590Szliu return( z*log1p(x+x) ); 7224590Szliu } 73