*DECK CQRTST
      SUBROUTINE CQRTST (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  CQRTST
C***PURPOSE  Quick check for CPQR79.
C***LIBRARY   SLATEC
C***TYPE      COMPLEX (RQRTST-S, CQRTST-C)
C***AUTHOR  (UNKNOWN)
C***ROUTINES CALLED  CPQR79, NUMXER, PASS, R1MACH, XERCLR, XGETF, XSETF
C***REVISION HISTORY  (YYMMDD)
C   ??????  DATE WRITTEN
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   901205  Changed usage of R1MACH(3) to R1MACH(4).  (RWC)
C   911010  Code reworked and simplified.  (RWC and WRB)
C***END PROLOGUE  CQRTST
      INTEGER ITEST(2), ITMP(7)
      REAL WORK(144)
      COMPLEX COEFF1(9), COEFF2(2), COEFF3(2), ROOT(8), CHK1(8), CHK2
      LOGICAL FATAL
C
      DATA COEFF1 / (1.0,0.0), (-7.0,-2.0), (8.0,6.0), (28.0, 8.0),
     *              (-49.0,-24.0), (7.0,2.0), (-8.0,-6.0),
     *              (-28.0,-8.0), (48.0,24.0)/
      DATA COEFF2 / (1.0,1.0), (1.0,3.0) /
      DATA COEFF3 / (0.0,0.0), (1.0,3.0) /
      DATA CHK1 / (4.0,2.0), (3.0,0.0), (-2.0,0.0), (2.0,0.0),
     *            (0.0,-1.0), (-1.0,0.0), (0.0,1.0), (1.0,0.0) /
      DATA CHK2 / (-2.0,-1.0) /
C***FIRST EXECUTABLE STATEMENT  CQRTST
      IF (KPRINT .GE. 2) WRITE (LUN, 90000)
      TOL = SQRT(R1MACH(4))
      IPASS = 1
C
C     First test.
C
      CALL CPQR79 (8, COEFF1, ROOT, IERR, WORK)
C
C     Check to see if test passed.
C
      DO 10 I=1,7
         ITMP(I) = 0
   10 CONTINUE
C
C     Check for roots in any order.
C
      DO 30 I=1,7
         DO 20 J=1,7
            IF (ABS(ROOT(I)-CHK1(J)) .LE. TOL) THEN
               ITMP(J) = 1
               GOTO 30
            ENDIF
   20    CONTINUE
   30 CONTINUE
C
C     Check that we found all 7 roots.
C
      ITEST(1) = 1
      DO 40 I=1,7
         ITEST(1) = ITEST(1)*ITMP(I)
   40 CONTINUE
C
C     Print test results.
C
      IF (KPRINT.GE.3 .OR. (KPRINT.GE.2.AND.ITEST(1).EQ.0)) THEN
         WRITE (LUN, 90010)
         WRITE (LUN, 90020) (J,COEFF1(J), J=1,9)
         WRITE (LUN, 90030)
         WRITE (LUN, 90040) (J,ROOT(J), J=1,7)
      ENDIF
      IF (KPRINT .GE. 2) THEN
         CALL PASS (LUN, 1, ITEST(1))
      ENDIF
C
C     Set up next problem.
C
      CALL CPQR79 (1, COEFF2, ROOT, IERR, WORK)
C
C     Check to see if test passed.
C
      ITEST(2) = 1
      IF (ABS(ROOT(1)-CHK2) .GT. TOL) ITEST(2) = 0
C
C     Print test results for second test.
C
      IF (KPRINT.GE.3 .OR. (KPRINT.GE.2.AND.ITEST(1).EQ.0)) THEN
         WRITE (LUN, 90050)
         WRITE (LUN, 90010)
         WRITE (LUN, 90020) (J,COEFF2(J), J=1,2)
         WRITE (LUN, 90030)
         WRITE (LUN, 90040) (J,ROOT(J), J=1,1)
      ENDIF
      IF (KPRINT .GE. 2) THEN
         CALL PASS (LUN, 2, ITEST(2))
      ENDIF
C
C     Trigger 2 error conditions
C
      CALL XGETF (KONTRL)
      IF (KPRINT .LE. 2) THEN
         CALL XSETF (0)
      ELSE
         CALL XSETF (1)
      ENDIF
      FATAL = .FALSE.
      CALL XERCLR
      IF (KPRINT .GE. 3) WRITE (LUN, 90060)
C
C     CALL CPQR79 with 0 degree polynomial.
C
      CALL CPQR79 (0, COEFF2, ROOT, IERR, WORK)
      IF (NUMXER(NERR) .NE. 3) THEN
         FATAL = .TRUE.
      ENDIF
      CALL XERCLR
C
C     CALL CPQR79 with zero leading coefficient.
C
      CALL CPQR79 (2, COEFF3, ROOT, IERR, WORK)
      IF (NUMXER(NERR) .NE. 2) THEN
         FATAL = .TRUE.
      ENDIF
      CALL XERCLR
C
      CALL XSETF (KONTRL)
      IF (FATAL) THEN
         IPASS = 0
         IF (KPRINT .GE. 2) THEN
            WRITE (LUN, 90070)
         ENDIF
      ELSE
         IF (KPRINT .GE. 3) THEN
            WRITE (LUN, 90080)
         ENDIF
      ENDIF
C
C     See if all tests passed.
C
      IPASS = IPASS*ITEST(1)*ITEST(2)
C
      IF (IPASS.EQ.1 .AND. KPRINT.GT.1) WRITE (LUN,90100)
      IF (IPASS.EQ.0 .AND. KPRINT.NE.0) WRITE (LUN,90110)
      RETURN
C
90000 FORMAT ('1', /,' CPQR79 QUICK CHECK')
90010 FORMAT (/, ' CHECK REAL AND IMAGINARY PARTS OF ROOT' /
     *          ' COEFFICIENTS')
90020 FORMAT (/ (I6, 3X, 1P, 2E22.14))
90030 FORMAT (// 25X, 'TABLE of ROOTS' //
     *        '   ROOT         REAL  PART', 12X, 'IMAG  PART' /
     *        '  NUMBER', 8X, 2(' of  ZERO ', 12X))
90040 FORMAT (I6, 3X, 1P, 2E22.14)
90050 FORMAT (/, ' TEST SUBSEQUENT RELATED CALL')
90060 FORMAT (// ' TRIGGER 2 ERROR CONDITIONS' //)
90070 FORMAT (/ ' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED')
90080 FORMAT (/ ' ALL INCORRECT ARGUMENT TESTS PASSED')
90100 FORMAT (/' **************CPQR79 PASSED ALL TESTS**************')
90110 FORMAT (/' **************CPQR79 FAILED SOME TESTS*************')
      END