#include "fpreproc/library_names.h"
#include "fpreproc/f77_dcomplx.h"
#include "fpreproc/fp_const.h"
*DECK DATANH
      REAL*8 FUNCTION DATANH (X)
C***BEGIN PROLOGUE  DATANH
C***PURPOSE  Compute the arc hyperbolic tangent.
C***LIBRARY   SLATEC (FNLIB)
C***CATEGORY  C4C
C***TYPE      REAL*8 (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
C============
C idecl:  explicitize implicit INTEGER declarations:
      IMPLICIT NONE
      INTEGER nterms,initds
C============
      REAL*8 X, ATNHCS(27), DXREL, SQEPS, Y, DCSEVL, D1MACH
      LOGICAL FIRST
      SAVE ATNHCS, NTERMS, DXREL, SQEPS, FIRST
      DATA ATNHCS(  1) / +CONST(.9439510239319549230842892218633,-1)/
      DATA ATNHCS(  2) / +CONST(.4919843705578615947200034576668,-1)/
      DATA ATNHCS(  3) / +CONST(.2102593522455432763479327331752,-2)/
      DATA ATNHCS(  4) / +CONST(.1073554449776116584640731045276,-3)/
      DATA ATNHCS(  5) / +CONST(.5978267249293031478642787517872,-5)/
      DATA ATNHCS(  6) / +CONST(.3505062030889134845966834886200,-6)/
      DATA ATNHCS(  7) / +CONST(.2126374343765340350896219314431,-7)/
      DATA ATNHCS(  8) / +CONST(.1321694535715527192129801723055,-8)/
      DATA ATNHCS(  9) / +CONST(.8365875501178070364623604052959,-10)/
      DATA ATNHCS( 10) / +CONST(.5370503749311002163881434587772,-11)/
      DATA ATNHCS( 11) / +CONST(.3486659470157107922971245784290,-12)/
      DATA ATNHCS( 12) / +CONST(.2284549509603433015524024119722,-13)/
      DATA ATNHCS( 13) / +CONST(.1508407105944793044874229067558,-14)/
      DATA ATNHCS( 14) / +CONST(.1002418816804109126136995722837,-15)/
      DATA ATNHCS( 15) / +CONST(.6698674738165069539715526882986,-17)/
      DATA ATNHCS( 16) / +CONST(.4497954546494931083083327624533,-18)/
      DATA ATNHCS( 17) / +CONST(.3032954474279453541682367146666,-19)/
      DATA ATNHCS( 18) / +CONST(.2052702064190936826463861418666,-20)/
      DATA ATNHCS( 19) / +CONST(.1393848977053837713193014613333,-21)/
      DATA ATNHCS( 20) / +CONST(.9492580637224576971958954666666,-23)/
      DATA ATNHCS( 21) / +CONST(.6481915448242307604982442666666,-24)/
      DATA ATNHCS( 22) / +CONST(.4436730205723615272632320000000,-25)/
      DATA ATNHCS( 23) / +CONST(.3043465618543161638912000000000,-26)/
      DATA ATNHCS( 24) / +CONST(.2091881298792393474047999999999,-27)/
      DATA ATNHCS( 25) / +CONST(.1440445411234050561365333333333,-28)/
      DATA ATNHCS( 26) / +CONST(.9935374683141640465066666666666,-30)/
      DATA ATNHCS( 27) / +CONST(.6863462444358260053333333333333,-31)/
      DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT  DATANH
      IF (FIRST) THEN
         NTERMS = INITDS (ATNHCS, 27, CONST(0.1,0)*AREAL(D1MACH(3)) )
         DXREL = SQRT(D1MACH(4))
         SQEPS = SQRT(CONST(3.0,0)*D1MACH(3))
      ENDIF
      FIRST = .FALSE.
C
      Y = ABS(X)
      IF (Y .GE. CONST(1.,0)) CALL XERMSG
     +   ('SLATEC', 'DATANH', 'ABS(X) GE 1', 2, 2)
C
      IF (CONST(1.,0)-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.CONST(0.5,0)) DATANH = X*(CONST(1.0,0)+
     1  DCSEVL (CONST(8.,0)*X*X-CONST(1.,0), ATNHCS, NTERMS) )
      IF (Y.GT.CONST(0.5,0)) DATANH =
     1   CONST(0.5,0)*LOG ((CONST(1.0,0)+X)/(CONST(1.0,0)-X))
C
      RETURN
      END
! 22Jun2000 fgtok -s r8_precision.sub "r8con.csh conversion"
! 22Jun2000 fgtok
! 22Jun2000 fgtok
! 22Jun2000 fgtok
