GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
atanh.f
Go to the documentation of this file.
1 *DECK ATANH
2  FUNCTION atanh (X)
3 C***BEGIN PROLOGUE ATANH
4 C***PURPOSE Compute the arc hyperbolic tangent.
5 C***LIBRARY SLATEC (FNLIB)
6 C***CATEGORY C4C
7 C***TYPE SINGLE PRECISION (ATANH-S, DATANH-D, CATANH-C)
8 C***KEYWORDS ARC HYPERBOLIC TANGENT, ATANH, ELEMENTARY FUNCTIONS,
9 C FNLIB, INVERSE HYPERBOLIC TANGENT
10 C***AUTHOR Fullerton, W., (LANL)
11 C***DESCRIPTION
12 C
13 C ATANH(X) computes the arc hyperbolic tangent of X.
14 C
15 C Series for ATNH on the interval 0. to 2.50000D-01
16 C with weighted error 6.70E-18
17 C log weighted error 17.17
18 C significant figures required 16.01
19 C decimal places required 17.76
20 C
21 C***REFERENCES (NONE)
22 C***ROUTINES CALLED CSEVL, INITS, R1MACH, XERMSG
23 C***REVISION HISTORY (YYMMDD)
24 C 770401 DATE WRITTEN
25 C 890531 Changed all specific intrinsics to generic. (WRB)
26 C 890531 REVISION DATE from Version 3.2
27 C 891214 Prologue converted to Version 4.0 format. (BAB)
28 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
29 C 900326 Removed duplicate information from DESCRIPTION section.
30 C (WRB)
31 C***END PROLOGUE ATANH
32  dimension atnhcs(15)
33  LOGICAL first
34  SAVE atnhcs, nterms, dxrel, sqeps, first
35  DATA atnhcs( 1) / .0943951023 93195492e0 /
36  DATA atnhcs( 2) / .0491984370 55786159e0 /
37  DATA atnhcs( 3) / .0021025935 22455432e0 /
38  DATA atnhcs( 4) / .0001073554 44977611e0 /
39  DATA atnhcs( 5) / .0000059782 67249293e0 /
40  DATA atnhcs( 6) / .0000003505 06203088e0 /
41  DATA atnhcs( 7) / .0000000212 63743437e0 /
42  DATA atnhcs( 8) / .0000000013 21694535e0 /
43  DATA atnhcs( 9) / .0000000000 83658755e0 /
44  DATA atnhcs(10) / .0000000000 05370503e0 /
45  DATA atnhcs(11) / .0000000000 00348665e0 /
46  DATA atnhcs(12) / .0000000000 00022845e0 /
47  DATA atnhcs(13) / .0000000000 00001508e0 /
48  DATA atnhcs(14) / .0000000000 00000100e0 /
49  DATA atnhcs(15) / .0000000000 00000006e0 /
50  DATA first /.true./
51 C***FIRST EXECUTABLE STATEMENT ATANH
52  IF (first) THEN
53  nterms = inits(atnhcs, 15, 0.1*r1mach(3))
54  dxrel = sqrt(r1mach(4))
55  sqeps = sqrt(3.0*r1mach(3))
56  ENDIF
57  first = .false.
58 C
59  y = abs(x)
60  IF (y .GE. 1.0) THEN
61  IF (y .GT. 1.0) THEN
62  atanh = (x - x) / (x - x)
63  ELSE
64  atanh = x / 0.0
65  ENDIF
66  RETURN
67  ENDIF
68 C
69  IF (1.0-y .LT. dxrel) CALL xermsg('SLATEC', 'ATANH',
70  + 'ANSWER LT HALF PRECISION BECAUSE ABS(X) TOO NEAR 1', 1, 1)
71 C
72  atanh = x
73  IF (y.GT.sqeps .AND. y.LE.0.5) atanh = x*(1.0 + csevl(8.*x*x-1.,
74  1 atnhcs, nterms))
75  IF (y.GT.0.5) atanh = 0.5*log((1.0+x)/(1.0-x))
76 C
77  RETURN
78  END