datanh.f

Go to the documentation of this file.

*DECK DATANH
      DOUBLE PRECISION FUNCTION DATANH (X)
C***BEGIN PROLOGUE  DATANH
C***PURPOSE  Compute the arc hyperbolic tangent.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C4C
C***TYPE      DOUBLE 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 DATANH(X) calculates the double precision arc hyperbolic
C tangent for double precision argument X.
C
C Series for ATNH       on the interval  0.          to  2.50000E-01
C                                        with weighted error   6.86E-32
C                                         log weighted error  31.16
C                               significant figures required  30.00
C                                    decimal places required  31.88
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH, DCSEVL, INITDS, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   770601  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***END PROLOGUE  DATANH
      DOUBLE PRECISION X, ATNHCS(27), DXREL, SQEPS, Y, DCSEVL, D1MACH
      LOGICAL FIRST
      SAVE ATNHCS, NTERMS, DXREL, SQEPS, FIRST
      DATA ATNHCS(  1) / +.9439510239 3195492308 4289221863 3 D-1      /
      DATA ATNHCS(  2) / +.4919843705 5786159472 0003457666 8 D-1      /
      DATA ATNHCS(  3) / +.2102593522 4554327634 7932733175 2 D-2      /
      DATA ATNHCS(  4) / +.1073554449 7761165846 4073104527 6 D-3      /
      DATA ATNHCS(  5) / +.5978267249 2930314786 4278751787 2 D-5      /
      DATA ATNHCS(  6) / +.3505062030 8891348459 6683488620 0 D-6      /
      DATA ATNHCS(  7) / +.2126374343 7653403508 9621931443 1 D-7      /
      DATA ATNHCS(  8) / +.1321694535 7155271921 2980172305 5 D-8      /
      DATA ATNHCS(  9) / +.8365875501 1780703646 2360405295 9 D-10     /
      DATA ATNHCS( 10) / +.5370503749 3110021638 8143458777 2 D-11     /
      DATA ATNHCS( 11) / +.3486659470 1571079229 7124578429 0 D-12     /
      DATA ATNHCS( 12) / +.2284549509 6034330155 2402411972 2 D-13     /
      DATA ATNHCS( 13) / +.1508407105 9447930448 7422906755 8 D-14     /
      DATA ATNHCS( 14) / +.1002418816 8041091261 3699572283 7 D-15     /
      DATA ATNHCS( 15) / +.6698674738 1650695397 1552688298 6 D-17     /
      DATA ATNHCS( 16) / +.4497954546 4949310830 8332762453 3 D-18     /
      DATA ATNHCS( 17) / +.3032954474 2794535416 8236714666 6 D-19     /
      DATA ATNHCS( 18) / +.2052702064 1909368264 6386141866 6 D-20     /
      DATA ATNHCS( 19) / +.1393848977 0538377131 9301461333 3 D-21     /
      DATA ATNHCS( 20) / +.9492580637 2245769719 5895466666 6 D-23     /
      DATA ATNHCS( 21) / +.6481915448 2423076049 8244266666 6 D-24     /
      DATA ATNHCS( 22) / +.4436730205 7236152726 3232000000 0 D-25     /
      DATA ATNHCS( 23) / +.3043465618 5431616389 1200000000 0 D-26     /
      DATA ATNHCS( 24) / +.2091881298 7923934740 4799999999 9 D-27     /
      DATA ATNHCS( 25) / +.1440445411 2340505613 6533333333 3 D-28     /
      DATA ATNHCS( 26) / +.9935374683 1416404650 6666666666 6 D-30     /
      DATA ATNHCS( 27) / +.6863462444 3582600533 3333333333 3 D-31     /
      DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT  DATANH
      IF (FIRST) THEN
         NTERMS = INITDS (ATNHCS, 27, 0.1*REAL(D1MACH(3)) )
         DXREL = SQRT(D1MACH(4))
         SQEPS = SQRT(3.0D0*D1MACH(3))
      ENDIF
      FIRST = .FALSE.
C
      Y = ABS(X)
      IF (Y .GE. 1.D0) CALL XERMSG ('SLATEC', 'DATANH', 'ABS(X) GE 1',
     +   2, 2)
C
      IF (1.D0-Y .LT. DXREL) CALL XERMSG ('SLATEC', 'DATANH',
     +   'ANSWER LT HALF PRECISION BECAUSE ABS(X) TOO NEAR 1', 1, 1)
C
      DATANH = X
      IF (Y.GT.SQEPS .AND. Y.LE.0.5D0) DATANH = X*(1.0D0 +
     1  DCSEVL (8.D0*X*X-1.D0, ATNHCS, NTERMS) )
      IF (Y.GT.0.5D0) DATANH = 0.5D0*LOG ((1.0D0+X)/(1.0D0-X))
C
      RETURN
      END