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