*DECK CQRQC
      SUBROUTINE CQRQC (LUN, KPRINT, NERR)
C***BEGIN PROLOGUE  CQRQC
C***PURPOSE  Quick check for CQRDC and CQRSL.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Voorhees, E. A., (LANL)
C***DESCRIPTION
C
C    THE RETURNED FLOATING POINT VALUES FROM CQRDC AND CQRSL FOR
C    FACTORED X, QRAUX, QY, QTY, B, RSD, AND XB ARE COMPARED TO
C    THEIR CORRESPONDING STORED PRE-COMPUTED VALUES (ENTERED
C    WITH DATA STATEMENTS).  FAILURE OF THE TEST OCCURS WHEN
C    AGREEMENT TO 3 SIGNIFICANT DIGITS IS NOT ACHIEVED AND AN
C    ERROR MESSAGE IS THEN PRINTED.
C
C    THE RETURNED INTEGER VALUES OF JPVT AND INFO ARE ALSO CHECKED.
C    LACK OF AGREEMENT RESULTS IN AN ERROR MESSAGE.  A SUMMARY
C    LINE IS ALWAYS PRINTED.
C
C    NO INPUT ARGUMENTS ARE REQUIRED.  ON RETURN, NERR (INTEGER
C    TYPE) CONTAINS THE TOTAL COUNT OF ALL FAILURES DETECTED.
C
C***ROUTINES CALLED  CQRDC, CQRSL
C***REVISION HISTORY  (YYMMDD)
C   801029  DATE WRITTEN
C   890618  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   901010  Restructured using IF-THEN-ELSE-ENDIF, moved an ARITHMETIC
C           STATEMENT FUNCTION ahead of the FIRST EXECUTABLE STATEMENT
C           record and cleaned up FORMATs.  (RWC)
C***END PROLOGUE  CQRQC
      COMPLEX A(4,4),QRAUX(4),WORK(4),Y(4),QY(4),QTY(4),B(4),RSD(4),XB(4
     1)
      COMPLEX AT(5,4),AC(4,4),QRAUXC(4),QYC(4),QTYC(4),BC(4),RSDC(4),XBC
     1(4),X1,X2
      CHARACTER KPROG*9,KFAIL*75
      INTEGER LDX,N,P,JPVT(4),JOB,K,INFO
      INTEGER JPVTT(4),JPVTC(4),I,J,INDX(5),NERR,L
      REAL DELX
      DATA A/(2.E0,0.E0),(0.E0,1.E0),(0.E0,0.E0),(0.E0,0.E0),
     1 (0.E0,-1.E0),(2.E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),
     2 (0.E0,0.E0),(0.E0,0.E0),(3.E0,0.E0),(0.E0,1.E0),
     3 (0.E0,0.E0),(0.E0,0.E0),(0.E0,-1.E0),(4.E0,0.E0)/
      DATA JPVT/0,-1,1,0/
      DATA Y/(3.E0,2.E0),(-1.E0,3.E0),(0.E0,-4.E0),(5.E0,0.E0)/
      DATA AC/(-3.16228E0,0.E0),(0.E0,0.E0),(.94868E0,0.E0),
     1 (0.E0,.31623E0),(0.E0,2.21359E0),(-3.47851E0,0.E0),
     2 (0.E0,.31623E0),(.94868E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),
     3 (2.23607E0,0.E0),(0.E0,.70711E0),(0.E0,0.E0),(0.E0,0.E0),
     4 (0.E0,-1.78885E0),(-1.34164E0,0.E0)/
      DATA QRAUXC/(1.E0,0.E0),(1.E0,0.E0),(1.70711E0,0.E0),(0.E0,0.E0)/
      DATA JPVTC/3,4,1,2/
      DATA QYC/(0.E0,-5.81378E0),(-2.68328E0,0.E0),
     1 (-1.89737E0,-1.58114E0),(1.58114E0,-3.79473E0)/
      DATA QTYC/(0.E0,5.37587E0),(-3.47851E0,0.E0),
     1 (4.02492E0,2.23607E0),(0.E0,-1.34164E0)/
      DATA BC/(0.E0,-1.E0),(1.E0,0.E0),(1.E0,1.E0),(0.E0,1.E0)/
      DATA RSDC/(0.E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),(0.E0,0.E0)/
      DATA XBC/(3.E0,2.E0),(-1.E0,3.E0),(0.E0,-4.E0),(5.E0,0.E0)/
      DATA KPROG/'QRDC QRSL'/
      DATA KFAIL/'FACTOR QRAUX  JPVT  QY        QTY       SOLUTION  RSD
     1       XB        INFO'/
C
      DELX(X1,X2) = ABS(REAL(X1-X2))+ABS(AIMAG(X1-X2))
C***FIRST EXECUTABLE STATEMENT  CQRQC
      LDX = 5
      N = 4
      P = 4
      K = 4
      NERR = 0
C
C     FORM AT AND JPVTT
C
      DO 20 J=1,N
         JPVTT(J) = JPVT(J)
         DO 10 I=1,N
            AT(I,J) = A(I,J)
   10    CONTINUE
   20 CONTINUE
C
C     TEST CQRDC (FACTOR, QRAUX, JPVT)
C
      JOB = 1
      CALL CQRDC(AT,LDX,N,P,QRAUX,JPVTT,WORK,JOB)
      INDX(1) = 0
      DO 40 J=1,N
         DO 30 I=1,N
            IF (DELX(AT(I,J),AC(I,J)) .GT. .0001) INDX(1) = INDX(1)+1
   30    CONTINUE
   40 CONTINUE
C
      IF (INDX(1) .NE. 0) THEN
         WRITE (LUN, 501) KPROG(1:4),KFAIL(1:6)
         NERR = NERR + 1
      ENDIF
C
      DO 60 I=1,2
         INDX(I) = 0
   60 CONTINUE
C
      DO 70 I=1,N
         IF (DELX(QRAUX(I),QRAUXC(I)) .GT. .0001) INDX(1) = INDX(1)+1
         IF (JPVTT(I) .NE. JPVTC(I)) INDX(2) = INDX(2)+1
   70 CONTINUE
C
      DO 90 I=1,2
         L = 7*I+1
         IF (INDX(I) .NE. 0) THEN
            WRITE (LUN,501) KPROG(1:4),KFAIL(L:L+4)
            NERR = NERR + 1
         ENDIF
   90 CONTINUE
C
C     TEST CQRSL (QY, QTY, SOLUTION, RSD, XB, INFO)
C
      JOB = 11111
      DO 100 I=1,5
         INDX(I) = 0
  100 CONTINUE
C
      CALL CQRSL(AT,LDX,N,K,QRAUX,Y,QY,QTY,B,RSD,XB,JOB,INFO)
      DO 110 I=1,N
         IF (DELX(QY(I),QYC(I))   .GT. .0001) INDX(1) = INDX(1)+1
         IF (DELX(QTY(I),QTYC(I)) .GT. .0001) INDX(2) = INDX(2)+1
         IF (DELX(B(I),BC(I))     .GT. .0001) INDX(3) = INDX(3)+1
         IF (DELX(RSD(I),RSDC(I)) .GT. .0001) INDX(4) = INDX(4)+1
         IF (DELX(XB(I),XBC(I))   .GT. .0001) INDX(5) = INDX(5)+1
  110 CONTINUE
C
      DO 130 I=1,5
         L = 10*I+11
         IF (INDX(I) .NE. 0) THEN
            WRITE (LUN,501) KPROG(6:9),KFAIL(L:L+8)
            NERR = NERR + 1
         ENDIF
  130 CONTINUE
C
      IF (INFO .NE. 0) THEN
         WRITE (LUN,501) KPROG(6:9),KFAIL(71:74)
         NERR = NERR + 1
      ENDIF
C
      IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,500) NERR
      RETURN
C
  500 FORMAT(/' * CQRQC - TEST FOR CQRDC AND CQRSL FOUND ', I1,
     *   ' ERRORS.'/)
  501 FORMAT (/' *** C', A, ' FAILURE - ERROR IN ', A)
      END
