C     TEST --- Subroutine to test the single precision TANH function
C
C     Eugene Spafford
C     Software Tools Subsystem Math Library Test Routine
C     School of Information and Computer Science
C     Georgia Institute of Technology
C     Atlanta, Georgia 30332
C
C     Adapted from:
C     "Software Manual for the Elementary Functions"
C       by William J. Cody, Jr.  &  William Waite
C      Prentice-Hall, Englewood Cliffs, NJ  1980
C
C     Coded April 1983 by Eugene Spafford
C
C     ----------------------------------------------------------
C
      SUBROUTINE TEST
C
      REAL BETAP,EXPON,D,TANH
      DOUBLE PRECISION RNAME
$INSERT MACHAR.F.I
      DATA RNAME /'TANH66'/
C
      BETA = IBETA
      ALBETA = XALOG(BETA)
      AIT = IT
      A = 0.125
      B = XALOG(THREE)*HALF
      C = 0.1243530017715962080
      D = XALOG(TWO)+(AIT+ONE)*XALOG(BETA)*HALF
C
C----------------------------------------------------------------------
C              RANDOM ARGUMENT ACCURACY TESTS
C----------------------------------------------------------------------
C
      DO 40 J = 1,2
        K1 = 0
        K3 = 0
        X1 = ZERO
        R6 = ZERO
        R7 = ZERO
        DEL = (B-A)/XN
        XL = A
C
        DO 30 I = 1,N
          X = DEL*RANDX(I1)+XL
          W = ONE
          Z = TANH(X)
          Y = X-0.125
          ZZ = TANH(Y)
          ZZ = (ZZ+C)/(ONE+C*ZZ)
          IF (Z .NE. ZERO) W = (Z-ZZ)/Z
          IF (W .GT. ZERO) K1 = K1+1
          IF (W .GE. ZERO) GO TO 10
          K3 = K3+1
          W = -W
   10     CONTINUE
          IF (W .LE. R6) GO TO 20
          R6 = W
          X1 = X
   20     CONTINUE
          R7 = R7+W*W
          XL = XL+DEL
   30   CONTINUE
C
        K2 = N-K3-K1
        PRINT 80
        PRINT 90, N,A,B
        PRINT 100, RNAME,K1,K2,K3
        R7 = XSQRT(R7/XN)
        PRINT 110, IT,IBETA
        W = -999.0
        IF (R6 .NE. ZERO) W = XALOG(ABS(R6))/ALBETA
        PRINT 120, R6,IBETA,W,X1
        W = AMAX1(AIT+W,ZERO)
        PRINT 130, IBETA,W
        W = -999.0
        IF (R7 .NE. ZERO) W = XALOG(ABS(R7))/ALBETA
        PRINT 140, R7,IBETA,W
        W = AMAX1(AIT+W,ZERO)
        PRINT 130, IBETA,W
        A = B+A
        B = D
   40 CONTINUE
C----------------------------------------------------------------------
C                       SPECIAL TESTS
C----------------------------------------------------------------------
C
      PRINT 150
      PRINT 180
C
      DO 50 I = 1,5
        X = RANDX(I1)
        Z = TANH(X)+TANH(-X)
        PRINT 160, X,Z
   50 CONTINUE
C
      PRINT 190
      BETAP = XPOWER(BETA,FLOAT(IT))
      X = RANDX(I1)/BETAP
C
      DO 60 I = 1,5
        Z = X-TANH(X)
        PRINT 160, X,Z
        X = X/BETA
   60 CONTINUE
C
      PRINT 200
C
      X = D
      B = FOUR
      DO 70 I = 1,5
        Z = (TANH(X)-HALF)-HALF
        PRINT 160, X,Z
        X = X+B
   70 CONTINUE
C
      PRINT 210
      EXPON = MINEXP*0.75
      X = XPOWER(BETA,EXPON)
      Z = TANH(X)
      PRINT 230, X,Z
      PRINT 220, XMAX
      Z = TANH(XMAX)
      PRINT 230, XMAX,Z
      PRINT 220, XMIN
      Z = TANH(XMIN)
      PRINT 230, XMIN,Z
      X = ZERO
      PRINT 220, X
      Z = TANH(X)
      PRINT 230, X,Z
      PRINT 170
      RETURN
C
C     ----- End of the program ---
C
   80 FORMAT (///
     &'Test of TANH (X) vs (TANH(X-1/8)+TANH(1/8))/(1+TANH(X-/8)*TANH(1/
     &8))'//)
   90 FORMAT (I6,' Random arguments were tested in the interval '/6X,'('
     &,E12.4,',',E12.4,')'//)
  100 FORMAT (1X,A6,'(X) was larger',I6,' times,'/14X,' agreed',I6,
     &' times, and'/10X,'was smaller',I6,' times.'//)
  110 FORMAT (' There are ',I3,' base',I3,
     &' significant digits in a floating point number.'//)
  120 FORMAT (' The maximum relative error of',E12.4,' = ',I3,' **',F7.2
     &/4X,'occurred for X =',E17.6)
  130 FORMAT (' The estimated loss of base',I3,' significant digits is',
     &F7.2)
  140 FORMAT (' The root mean square relative error was',E15.4,' = ',I3,
     &' **',F7.2)
  150 FORMAT (//'Special Tests'//)
  160 FORMAT (2E15.7/)
  170 FORMAT (10X,'***** This concludes the tests. *****'//)
  180 FORMAT (' The identity TANH(-X) = -TANH(X) will be tested.'//8X,
     &'X',9X,'F(X) + F(-X)'/)
  190 FORMAT (' The identity TANH(X) = X, X small, will be tested.'//8X,
     &'X',9X,'X - F(X)'/)
  200 FORMAT (' The identity TANH(X) = 1, X large, will be tested.'//8X,
     &'X',9X,'X - F(X)'/)
  210 FORMAT (' Test of underflow for very small argument.')
  220 FORMAT (' TANH will be called with argument',E15.4)
  230 FORMAT (6X,' TANH(',E13.6,') =',E13.6/)
      END