| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172 |
- *DECK ATANH
- FUNCTION ATANH (X)
- C***BEGIN PROLOGUE ATANH
- C***PURPOSE Compute the arc hyperbolic tangent.
- C***LIBRARY SLATEC (FNLIB)
- C***CATEGORY C4C
- C***TYPE SINGLE PRECISION (ATANH-S, DATANH-D, CATANH-C)
- C***KEYWORDS ARC HYPERBOLIC TANGENT, ATANH, ELEMENTARY FUNCTIONS,
- C FNLIB, INVERSE HYPERBOLIC TANGENT
- C***AUTHOR Fullerton, W., (LANL)
- C***DESCRIPTION
- C
- C ATANH(X) computes the arc hyperbolic tangent of X.
- C
- C Series for ATNH on the interval 0. to 2.50000D-01
- C with weighted error 6.70E-18
- C log weighted error 17.17
- C significant figures required 16.01
- C decimal places required 17.76
- C
- C***REFERENCES (NONE)
- C***ROUTINES CALLED CSEVL, INITS, R1MACH, XERMSG
- C***REVISION HISTORY (YYMMDD)
- C 770401 DATE WRITTEN
- C 890531 Changed all specific intrinsics to generic. (WRB)
- C 890531 REVISION DATE from Version 3.2
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
- C 900326 Removed duplicate information from DESCRIPTION section.
- C (WRB)
- C***END PROLOGUE ATANH
- DIMENSION ATNHCS(15)
- LOGICAL FIRST
- SAVE ATNHCS, NTERMS, DXREL, SQEPS, FIRST
- DATA ATNHCS( 1) / .0943951023 93195492E0 /
- DATA ATNHCS( 2) / .0491984370 55786159E0 /
- DATA ATNHCS( 3) / .0021025935 22455432E0 /
- DATA ATNHCS( 4) / .0001073554 44977611E0 /
- DATA ATNHCS( 5) / .0000059782 67249293E0 /
- DATA ATNHCS( 6) / .0000003505 06203088E0 /
- DATA ATNHCS( 7) / .0000000212 63743437E0 /
- DATA ATNHCS( 8) / .0000000013 21694535E0 /
- DATA ATNHCS( 9) / .0000000000 83658755E0 /
- DATA ATNHCS(10) / .0000000000 05370503E0 /
- DATA ATNHCS(11) / .0000000000 00348665E0 /
- DATA ATNHCS(12) / .0000000000 00022845E0 /
- DATA ATNHCS(13) / .0000000000 00001508E0 /
- DATA ATNHCS(14) / .0000000000 00000100E0 /
- DATA ATNHCS(15) / .0000000000 00000006E0 /
- DATA FIRST /.TRUE./
- C***FIRST EXECUTABLE STATEMENT ATANH
- IF (FIRST) THEN
- NTERMS = INITS (ATNHCS, 15, 0.1*R1MACH(3))
- DXREL = SQRT (R1MACH(4))
- SQEPS = SQRT (3.0*R1MACH(3))
- ENDIF
- FIRST = .FALSE.
- C
- Y = ABS(X)
- IF (Y .GE. 1.0) CALL XERMSG ('SLATEC', 'ATANH', 'ABS(X) GE 1', 2,
- + 2)
- C
- IF (1.0-Y .LT. DXREL) CALL XERMSG ('SLATEC', 'ATANH',
- + 'ANSWER LT HALF PRECISION BECAUSE ABS(X) TOO NEAR 1', 1, 1)
- C
- ATANH = X
- IF (Y.GT.SQEPS .AND. Y.LE.0.5) ATANH = X*(1.0 + CSEVL (8.*X*X-1.,
- 1 ATNHCS, NTERMS))
- IF (Y.GT.0.5) ATANH = 0.5*LOG((1.0+X)/(1.0-X))
- C
- RETURN
- END
|
