xref: /csrg-svn/lib/libm/common_source/acosh.c (revision 34124)
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 this notice is preserved and that due credit is given
7  * to the University of California at Berkeley. The name of the University
8  * may not be used to endorse or promote products derived from this
9  * software without specific prior written permission. This software
10  * is provided ``as is'' without express or implied warranty.
11  *
12  * All recipients should regard themselves as participants in an ongoing
13  * research project and hence should feel obligated to report their
14  * experiences (good or bad) with these elementary function codes, using
15  * the sendbug(8) program, to the authors.
16  */
17 
18 #ifndef lint
19 static char sccsid[] = "@(#)acosh.c	5.2 (Berkeley) 04/29/88";
20 #endif /* not lint */
21 
22 /* ACOSH(X)
23  * RETURN THE INVERSE HYPERBOLIC COSINE OF X
24  * DOUBLE PRECISION (VAX D FORMAT 56 BITS, IEEE DOUBLE 53 BITS)
25  * CODED IN C BY K.C. NG, 2/16/85;
26  * REVISED BY K.C. NG on 3/6/85, 3/24/85, 4/16/85, 8/17/85.
27  *
28  * Required system supported functions :
29  *	sqrt(x)
30  *
31  * Required kernel function:
32  *	log1p(x) 		...return log(1+x)
33  *
34  * Method :
35  *	Based on
36  *		acosh(x) = log [ x + sqrt(x*x-1) ]
37  *	we have
38  *		acosh(x) := log1p(x)+ln2,	if (x > 1.0E20); else
39  *		acosh(x) := log1p( sqrt(x-1) * (sqrt(x-1) + sqrt(x+1)) ) .
40  *	These formulae avoid the over/underflow complication.
41  *
42  * Special cases:
43  *	acosh(x) is NaN with signal if x<1.
44  *	acosh(NaN) is NaN without signal.
45  *
46  * Accuracy:
47  *	acosh(x) returns the exact inverse hyperbolic cosine of x nearly
48  *	rounded. In a test run with 512,000 random arguments on a VAX, the
49  *	maximum observed error was 3.30 ulps (units of the last place) at
50  *	x=1.0070493753568216 .
51  *
52  * Constants:
53  * The hexadecimal values are the intended ones for the following constants.
54  * The decimal values may be used, provided that the compiler will convert
55  * from decimal to binary accurately enough to produce the hexadecimal values
56  * shown.
57  */
58 
59 #if defined(vax)||defined(tahoe)	/* VAX D format */
60 #ifdef vax
61 #define _0x(A,B)	0x/**/A/**/B
62 #else	/* vax */
63 #define _0x(A,B)	0x/**/B/**/A
64 #endif	/* vax */
65 /* static double */
66 /* ln2hi  =  6.9314718055829871446E-1    , Hex  2^  0   *  .B17217F7D00000 */
67 /* ln2lo  =  1.6465949582897081279E-12   ; Hex  2^-39   *  .E7BCD5E4F1D9CC */
68 static long     ln2hix[] = { _0x(7217,4031), _0x(0000,f7d0)};
69 static long     ln2lox[] = { _0x(bcd5,2ce7), _0x(d9cc,e4f1)};
70 #define    ln2hi    (*(double*)ln2hix)
71 #define    ln2lo    (*(double*)ln2lox)
72 #else	/* defined(vax)||defined(tahoe) */
73 static double
74 ln2hi  =  6.9314718036912381649E-1    , /*Hex  2^ -1   *  1.62E42FEE00000 */
75 ln2lo  =  1.9082149292705877000E-10   ; /*Hex  2^-33   *  1.A39EF35793C76 */
76 #endif	/* defined(vax)||defined(tahoe) */
77 
78 double acosh(x)
79 double x;
80 {
81 	double log1p(),sqrt(),t,big=1.E20; /* big+1==big */
82 
83 #if !defined(vax)&&!defined(tahoe)
84 	if(x!=x) return(x);	/* x is NaN */
85 #endif	/* !defined(vax)&&!defined(tahoe) */
86 
87     /* return log1p(x) + log(2) if x is large */
88 	if(x>big) {t=log1p(x)+ln2lo; return(t+ln2hi);}
89 
90 	t=sqrt(x-1.0);
91 	return(log1p(t*(t+sqrt(x+1.0))));
92 }
93