      SUBROUTINE TABLAT
C----------------------------------------------------------------------
C  Subroutine to tabulate the results of tests for complex
C  functions.
C
C  Generic Fortran subprograms required:
C
C         ABS, AIMAG (or DIMAG), REAL (or DBLE)
C
C  Latest revision - October 11, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
C----------------------------------------------------------------------
C  Declare named common
C----------------------------------------------------------------------
      COMMON /ELEFUN/ CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,
     1       CZ,CZZ,AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN,
     2       IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N,
     3       IFLAG,RFLAG,PFLAG
      LOGICAL IFLAG,RFLAG,PFLAG
      INTEGER IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N
CS    REAL
      DOUBLE PRECISION
     1       AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN
CS    COMPLEX
      COMPLEX*16
     1       CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,CZ,CZZ
C----------------------------------------------------------------------
C  Declare local variables
C----------------------------------------------------------------------
CS    REAL
      DOUBLE PRECISION
     1   CONVR,CONVI,ONE,W,Z,ZERO,ZZ
CS    COMPLEX
      COMPLEX*16
     1   CW,CZERO,ZDUM
C----------------------------------------------------------------------
C  Mathematical constants
C----------------------------------------------------------------------
CS    DATA ONE,ZERO/1.0E0,0.0E0/
CS    DATA CZERO/(0.0E0,0.0E0)/
      DATA ONE,ZERO/1.0D0,0.0D0/
      DATA CZERO/(0.0D0,0.0D0)/
C----------------------------------------------------------------------
C  Statement functions for conversion between complex and float
C----------------------------------------------------------------------
CS    CONVR(ZDUM) = REAL(ZDUM)
CS    CONVI(ZDUM) = AIMAG(ZDUM)
      CONVR(ZDUM) = DBLE(ZDUM)
      CONVI(ZDUM) = DIMAG(ZDUM)
C-----------------------------------------------------------------
C Handle vector error
C-----------------------------------------------------------------
      IF (CZ .NE. CZERO) THEN
            CW = (CZ-CZZ)/CZ
         ELSE
            CW = ONE
      END IF
      W = ABS(CW)
      IF (W .LT. ZERO) THEN
            K1 = K1 + 1
         ELSE IF (W .GT. ZERO) THEN
            K3 = K3 + 1
      END IF
      IF (W .GT. R6) THEN
         R6 = W
         CX1 = CX
         IF (PFLAG) CY1 = CV
         CF1 = CZ
      END IF
      R7 = R7 + W*W
C-----------------------------------------------------------------
C Handle error in real component
C-----------------------------------------------------------------
      IF (RFLAG) THEN
         Z = CONVR(CZ)
         ZZ = CONVR(CZZ)
         IF (Z .NE. ZERO) THEN
               W = (Z-ZZ)/Z
            ELSE
               W = ONE
         END IF
         IF (W .LT. ZERO) THEN
               KX1 = KX1 + 1
            ELSE IF (W .GT. ZERO) THEN
               KX3 = KX3 + 1
         END IF
         W = ABS(W)
         IF (W .GT. RX6) THEN
            RX6 = W
            CX2 = CX
            IF (PFLAG) CY2 = CV
            CF2 = CZ
         END IF
         RX7 = RX7 + W*W
      END IF
C-----------------------------------------------------------------
C Handle error in imaginary component
C-----------------------------------------------------------------
      IF (IFLAG) THEN
         Z = CONVI(CZ)
         ZZ = CONVI(CZZ)
         IF (Z .NE. ZERO) THEN
               W = (Z-ZZ)/Z
            ELSE
               W = ONE
         END IF
         IF (W .LT. ZERO) THEN
               KY1 = KY1 + 1
            ELSE IF (W .GT. ZERO) THEN
               KY3 = KY3 + 1
         END IF
         W = ABS(W)
         IF (W .GT. RY6) THEN
            RY6 = W
            CX3 = CX
            IF (PFLAG) CY3 = CV
            CF3 = CZ
         END IF
         RY7 = RY7 + W*W
      END IF
      RETURN
C---------- Last line of TABLAT ----------
      END
*
      SUBROUTINE REPORT(IOUT)
C----------------------------------------------------------------------
C  Subroutine to print the results of tests for complex functions.
C
C  Generic Fortran subprograms required:
C
C         ABS, LOG, MAX, SQRT
C
C  Latest revision - October 11, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
C----------------------------------------------------------------------
C  Declare named common
C----------------------------------------------------------------------
      COMMON /ELEFUN/ CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,
     1       CZ,CZZ,AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN,
     2       IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N,
     3       IFLAG,RFLAG,PFLAG
      LOGICAL IFLAG,RFLAG,PFLAG
      INTEGER IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N
CS    REAL
      DOUBLE PRECISION
     1       AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN
CS    COMPLEX
      COMPLEX*16
     1       CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,CZ,CZZ
C----------------------------------------------------------------------
C  Declare local variables
C----------------------------------------------------------------------
      INTEGER IOUT
CS    REAL
      DOUBLE PRECISION
     1   ALL9,W,ZERO
C----------------------------------------------------------------------
C  Mathematical constants
C----------------------------------------------------------------------
CS    DATA ALL9,ZERO/-999.0E0,0.0E0/
      DATA ALL9,ZERO/-999.0D0,0.0D0/
C----------------------------------------------------------------------
         WRITE (IOUT,1000) N,AX,BX,AY,BY
C-----------------------------------------------------------------
C Report vector error
C-----------------------------------------------------------------
         WRITE (IOUT,1001)
         K2 = N - K3 - K1
         R7 = SQRT(R7/XN)
         WRITE (IOUT,1011) K1,K2,K3
         WRITE (IOUT,1020) IT,IBETA
         IF (R6 .NE. ZERO) THEN
               W = LOG(ABS(R6))/ALBETA
            ELSE
               W = ALL9
         END IF
         IF (.NOT. PFLAG) THEN
               WRITE (IOUT,1021) R6,IBETA,W,CX1,CF1
            ELSE
               WRITE (IOUT,1022) R6,IBETA,W,CX1,CY1,CF1
         END IF
         W = MAX(AIT+W,ZERO)
         WRITE (IOUT,1023) IBETA,W
         IF (R7 .NE. ZERO) THEN
               W = LOG(ABS(R7))/ALBETA
            ELSE
               W = ALL9
         END IF
         WRITE (IOUT,1024) R7,IBETA,W
         W = MAX(AIT+W,ZERO)
         WRITE (IOUT,1023) IBETA,W
C-----------------------------------------------------------------
C Report error in real component
C-----------------------------------------------------------------
         IF (RFLAG) THEN
            WRITE (IOUT,1002)
            KX2 = N - KX3 - KX1
            RX7 = SQRT(RX7/XN)
            WRITE (IOUT,1011) KX1,KX2,KX3
            WRITE (IOUT,1020) IT,IBETA
            IF (RX6 .NE. ZERO) THEN
                  W = LOG(ABS(RX6))/ALBETA
               ELSE
                  W = ALL9
            END IF
            IF (.NOT. PFLAG) THEN
                  WRITE (IOUT,1021) RX6,IBETA,W,CX2,CF2
               ELSE
                  WRITE (IOUT,1022) RX6,IBETA,W,CX2,CY2,CF2
            END IF
            W = MAX(AIT+W,ZERO)
            WRITE (IOUT,1023) IBETA,W
            IF (RX7 .NE. ZERO) THEN
                  W = LOG(ABS(RX7))/ALBETA
               ELSE
                  W = ALL9
            END IF
            WRITE (IOUT,1024) RX7,IBETA,W
            W = MAX(AIT+W,ZERO)
            WRITE (IOUT,1023) IBETA,W
         END IF
C-----------------------------------------------------------------
C Report error in imaginary component
C-----------------------------------------------------------------
         IF (IFLAG) THEN
            WRITE (IOUT,1003)
            KY2 = N - KY3 - KY1
            RY7 = SQRT(RY7/XN)
            WRITE (IOUT,1011) KY1,KY2,KY3
            WRITE (IOUT,1020) IT,IBETA
            IF (RY6 .NE. ZERO) THEN
                  W = LOG(ABS(RY6))/ALBETA
               ELSE
                  W = ALL9
            END IF
            IF (.NOT. PFLAG) THEN
                  WRITE (IOUT,1021) RY6,IBETA,W,CX3,CF3
               ELSE
                  WRITE (IOUT,1022) RY6,IBETA,W,CX3,CY3,CF3
            END IF
            W = MAX(AIT+W,ZERO)
            WRITE (IOUT,1023) IBETA,W
            IF (RY7 .NE. ZERO) THEN
                  W = LOG(ABS(RY7))/ALBETA
               ELSE
                  W = ALL9
            END IF
            WRITE (IOUT,1024) RY7,IBETA,W
            W = MAX(AIT+W,ZERO)
            WRITE (IOUT,1023) IBETA,W
         END IF
      RETURN
C-----------------------------------------------------------------
 1000 FORMAT(I7,' Random arguments were tested from the box'/
     1 6X,'(',E15.4,',',E15.4,')'/6X,'(',E15.4,',',E15.4,1H)//)
 1001 FORMAT(' First, report the vector error'//)
 1002 FORMAT(' Then, report the error in the real component.'//)
 1003 FORMAT(' Then, report the error in the imaginary component.'//)
 1011 FORMAT(' Test function was larger',I6,' times,'/
     1     18X,' agreed',I6,' times, and'/
     2   14X,'was smaller',I6,' times.'//)
 1020 FORMAT(' There are',I4,' base',I4,
     1    ' significant digits in a floating-point number.'//)
 1021 FORMAT(' The maximum relative error of',E15.4,' = ',I4,' **',
     1  F7.2/4X,'occurred for Z =',(E17.6,E17.6)/
     2       4X,'with a value of ',(E17.6,E17.6))
 1022 FORMAT(' The maximum relative error of',E15.4,' = ',I4,' **',
     1  F7.2/4X,'occurred for Z =',(E17.6,E17.6)/
     2       13X,'and W =',(E17.6,E17.6)/
     3       4X,'with a value of ',(E17.6,E17.6))
 1023 FORMAT(' The estimated loss of base',I4,
     1  ' significant digits is',F7.2//)
 1024 FORMAT(' The root mean square relative error was',E15.4,
     1    ' = ',I4,' **',F7.2)
C---------- Last line of REPORT ----------
      END
*
      SUBROUTINE RESET
C----------------------------------------------------------------------
C  Subroutine to reset the paramaters for tests for complex
C  functions.
C
C  Latest revision - October 15, 1990
C
C  Author - W. J. Cody
C           Argonne National Laboratory
C
C----------------------------------------------------------------------
C  Declare named common
C----------------------------------------------------------------------
      COMMON /ELEFUN/ CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,
     1       CZ,CZZ,AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN,
     2       IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N,
     3       IFLAG,RFLAG,PFLAG
      LOGICAL IFLAG,RFLAG,PFLAG
      INTEGER IBETA,IT,KX1,KX2,KX3,KY1,KY2,KY3,K1,K2,K3,N
CS    REAL
      DOUBLE PRECISION
     1       AIT,ALBETA,AX,AY,BX,BY,RX6,RX7,RY6,RY7,R6,R7,XN
CS    COMPLEX
      COMPLEX*16
     1       CF1,CF2,CF3,CV,CX,CX1,CX2,CX3,CY1,CY2,CY3,CZ,CZZ
C----------------------------------------------------------------------
C  Declare local variables
C----------------------------------------------------------------------
CS    REAL
      DOUBLE PRECISION
     1   ZERO
CS    COMPLEX
      COMPLEX*16
     1   CZERO
C-----------------------------------------------------------------
CS    DATA CZERO/(0.0E0,0.0E0)/
CS    DATA ZERO/0.0E0/
      DATA CZERO/(0.0D0,0.0D0)/
      DATA ZERO/0.0D0/
C-----------------------------------------------------------------
      K1 = 0
      K3 = 0
      KX1 = 0
      KX3 = 0
      KY1 = 0
      KY3 = 0
      CX1 = CZERO
      CX2 = CZERO
      CX3 = CZERO
      CY1 = CZERO
      CY2 = CZERO
      CY3 = CZERO
      CF1 = CZERO
      CF2 = CZERO
      CF3 = CZERO
      R6 = ZERO
      R7 = ZERO
      RX6 = ZERO
      RX7 = ZERO
      RY6 = ZERO
      RY7 = ZERO
      RETURN
C---------- Last line of RESET ----------
      END
