*DECK CPRPQX
      SUBROUTINE CPRPQX (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  CPRPQX
C***PURPOSE  Quick check for CPZERO and RPZERO.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Kahaner, D. K., (NBS)
C***DESCRIPTION
C
C     THIS QUICK CHECK ROUTINE IS WRITTEN FOR CPZERO AND RPZERO.
C     THE ZEROS OF POLYNOMIAL WITH COEFFICIENTS A(.) ARE STORED
C     IN ZK(.).  RELERR IS THE RELATIVE ACCURACY REQUIRED FOR
C     THEM TO PASS.
C
C***ROUTINES CALLED  CPZERO, R1MACH, RPZERO
C***REVISION HISTORY  (YYMMDD)
C   810223  DATE WRITTEN
C   890618  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C***END PROLOGUE  CPRPQX
      INTEGER KPRINT,IPASS,LUN
      INTEGER IDEG,IDEGP1,INFO,I,J,ID
      REAL A(6),ERR,ERRI,RELERR
      COMPLEX AC(6),Z(5),ZK(5),W(21)
      DATA IDEG / 5 /
      DATA A / 1., -3.7, 7.4, -10.8, 10.8, -6.8 /
      DATA ZK / (1.7,0.), (1.,1.), (1.,-1.),
     +          (0.,1.414213562 3730950488),
     +         (0.,-1.414213562 3730950488) /
C***FIRST EXECUTABLE STATEMENT  CPRPQX
      IPASS = 1
      IDEGP1 = IDEG+1
      RELERR = SQRT(R1MACH(4))
      DO 10 J=1,IDEGP1
         AC(J) = CMPLX(A(J),0.)
   10    CONTINUE
      INFO = 0
      CALL CPZERO(IDEG,AC,Z,W(4),INFO,W)
      IF(INFO .EQ. 0) GO TO 15
      IPASS=0
      IF(INFO .EQ. 1 .AND. KPRINT .GE. 1) WRITE(LUN,630)
      IF(INFO .EQ. 2 .AND. KPRINT .GE. 1) WRITE(LUN,640)
15    DO 30 J=1,IDEG
         ERR = ABS(Z(J) - ZK(1))
         ID = 1
         DO 20 I=2,IDEG
            ERRI = ABS(Z(J) - ZK(I))
            IF (ERRI .LT. ERR) ID = I
            ERR = MIN(ERRI,ERR)
   20       CONTINUE
         IF (ABS(Z(J) - ZK(ID))/ABS(ZK(ID)) .GE. RELERR) IPASS = 0
   30    CONTINUE
      INFO = 0
      CALL RPZERO(IDEG,A,Z,W(4),INFO,W)
      IF(INFO .EQ. 0) GO TO 35
      IPASS=0
      IF(INFO .EQ. 1 .AND. KPRINT .GE. 1) WRITE(LUN,650)
      IF(INFO .EQ. 2 .AND. KPRINT .GE. 1) WRITE(LUN,660)
35    DO 50 J=1,IDEG
         ERR = ABS(Z(J) - ZK(1))
         ID = 1
         DO 40 I=2,IDEG
            ERRI = ABS(Z(J) - ZK(I))
            IF (ERRI .LT. ERR) ID = I
            ERR = MIN(ERRI,ERR)
   40    CONTINUE
         IF (ABS(Z(J) - ZK(ID))/ABS(ZK(ID)) .GE. RELERR) IPASS = 0
   50 CONTINUE
      IF (KPRINT.GE.2 .AND. IPASS.NE.0) WRITE (LUN,670)
      IF (KPRINT.GE.1 .AND. IPASS.EQ.0) WRITE (LUN,680)
      RETURN
C
  630 FORMAT(' CPZERO TEST FAILS: LEADING COEFFICIENT OR DEGREE OF',
     1 ' POLYNOMIAL IS ZERO')
  640 FORMAT(' CPZERO TEST FAILS: NON-CONVERGENCE IN 125 ITERATIONS')
  650 FORMAT(' RPZERO TEST FAILS: LEADING COEFFICIENT OR DEGREE OF',
     1 ' POLYNOMIAL IS ZERO')
  660 FORMAT(' RPZERO TEST FAILS: NON-CONVERGENCE IN 125 ITERATIONS')
  670 FORMAT(25H CPRPQX PASSES ALL TESTS.)
  680 FORMAT(25H CPRPQX FAILS SOME TESTS.)
      END
