xref: /csrg-svn/lib/libm/common_source/acosh.c (revision 31853)
124586Szliu /*
224586Szliu  * Copyright (c) 1985 Regents of the University of California.
324586Szliu  *
424586Szliu  * Use and reproduction of this software are granted  in  accordance  with
524586Szliu  * the terms and conditions specified in  the  Berkeley  Software  License
624586Szliu  * Agreement (in particular, this entails acknowledgement of the programs'
724586Szliu  * source, and inclusion of this notice) with the additional understanding
824586Szliu  * that  all  recipients  should regard themselves as participants  in  an
924586Szliu  * ongoing  research  project and hence should  feel  obligated  to report
1024586Szliu  * their  experiences (good or bad) with these elementary function  codes,
1124586Szliu  * using "sendbug 4bsd-bugs@BERKELEY", to the authors.
1224586Szliu  */
1324586Szliu 
1424586Szliu #ifndef lint
1524706Selefunt static char sccsid[] =
16*31853Szliu "@(#)acosh.c	1.2 (Berkeley) 8/21/85; 1.5 (ucb.elefunt) 07/13/87";
17*31853Szliu #endif	/* not lint */
1824586Szliu /* ACOSH(X)
1924586Szliu  * RETURN THE INVERSE HYPERBOLIC COSINE OF X
2024586Szliu  * DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
2124586Szliu  * CODED IN C BY K.C. NG, 2/16/85;
2224586Szliu  * REVISED BY K.C. NG on 3/6/85, 3/24/85, 4/16/85, 8/17/85.
2324586Szliu  *
2424586Szliu  * Required system supported functions :
2524586Szliu  *	sqrt(x)
2624586Szliu  *
2724586Szliu  * Required kernel function:
2824586Szliu  *	log1p(x) 		...return log(1+x)
2924586Szliu  *
3024586Szliu  * Method :
3124586Szliu  *	Based on
3224586Szliu  *		acosh(x) = log [ x + sqrt(x*x-1) ]
3324586Szliu  *	we have
3424586Szliu  *		acosh(x) := log1p(x)+ln2,	if (x > 1.0E20); else
3524586Szliu  *		acosh(x) := log1p( sqrt(x-1) * (sqrt(x-1) + sqrt(x+1)) ) .
3624586Szliu  *	These formulae avoid the over/underflow complication.
3724586Szliu  *
3824586Szliu  * Special cases:
3924586Szliu  *	acosh(x) is NaN with signal if x<1.
4024586Szliu  *	acosh(NaN) is NaN without signal.
4124586Szliu  *
4224586Szliu  * Accuracy:
4324586Szliu  *	acosh(x) returns the exact inverse hyperbolic cosine of x nearly
4424586Szliu  *	rounded. In a test run with 512,000 random arguments on a VAX, the
4524586Szliu  *	maximum observed error was 3.30 ulps (units of the last place) at
4624586Szliu  *	x=1.0070493753568216 .
4724586Szliu  *
4824586Szliu  * Constants:
4924586Szliu  * The hexadecimal values are the intended ones for the following constants.
5024586Szliu  * The decimal values may be used, provided that the compiler will convert
5124586Szliu  * from decimal to binary accurately enough to produce the hexadecimal values
5224586Szliu  * shown.
5324586Szliu  */
5424586Szliu 
55*31853Szliu #if defined(vax)||defined(tahoe)	/* VAX D format */
56*31853Szliu #ifdef vax
5731812Szliu #define _0x(A,B)	0x/**/A/**/B
58*31853Szliu #else	/* vax */
5931812Szliu #define _0x(A,B)	0x/**/B/**/A
60*31853Szliu #endif	/* vax */
6124586Szliu /* static double */
6224586Szliu /* ln2hi  =  6.9314718055829871446E-1    , Hex  2^  0   *  .B17217F7D00000 */
6324586Szliu /* ln2lo  =  1.6465949582897081279E-12   ; Hex  2^-39   *  .E7BCD5E4F1D9CC */
6431812Szliu static long     ln2hix[] = { _0x(7217,4031), _0x(0000,f7d0)};
6531812Szliu static long     ln2lox[] = { _0x(bcd5,2ce7), _0x(d9cc,e4f1)};
6624586Szliu #define    ln2hi    (*(double*)ln2hix)
6724586Szliu #define    ln2lo    (*(double*)ln2lox)
68*31853Szliu #else	/* defined(vax)||defined(tahoe) */
6924586Szliu static double
7024586Szliu ln2hi  =  6.9314718036912381649E-1    , /*Hex  2^ -1   *  1.62E42FEE00000 */
7124586Szliu ln2lo  =  1.9082149292705877000E-10   ; /*Hex  2^-33   *  1.A39EF35793C76 */
72*31853Szliu #endif	/* defined(vax)||defined(tahoe) */
7324586Szliu 
7424586Szliu double acosh(x)
7524586Szliu double x;
7624586Szliu {
7724586Szliu 	double log1p(),sqrt(),t,big=1.E20; /* big+1==big */
7824586Szliu 
79*31853Szliu #if !defined(vax)&&!defined(tahoe)
8024586Szliu 	if(x!=x) return(x);	/* x is NaN */
81*31853Szliu #endif	/* !defined(vax)&&!defined(tahoe) */
8224586Szliu 
8324586Szliu     /* return log1p(x) + log(2) if x is large */
8424586Szliu 	if(x>big) {t=log1p(x)+ln2lo; return(t+ln2hi);}
8524586Szliu 
8624586Szliu 	t=sqrt(x-1.0);
8724586Szliu 	return(log1p(t*(t+sqrt(x+1.0))));
8824586Szliu }
89