*DECK CTRQC
      SUBROUTINE CTRQC (LUN, KPRINT, NERR)
C***BEGIN PROLOGUE  CTRQC
C***PURPOSE  Quick check for CTRFA, CTRCO, CTRSL and CTRDI.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Voorhees, E. A., (LANL)
C***DESCRIPTION
C
C    LET  A*X=B  BE A COMPLEX LINEAR SYSTEM WHERE THE MATRIX  A  IS
C    OF THE PROPER TYPE FOR THE LINPACK SUBROUTINES BEING TESTED.
C    THE VALUES OF  A  AND  B  AND THE PRE-COMPUTED VALUES OF  C
C    (THE SOLUTION VECTOR),  AINV  (INVERSE OF MATRIX  A ),  DC
C    (DETERMINANT OF  A ), AND  RCND  ( RCOND ) ARE ENTERED
C    WITH DATA STATEMENTS.
C
C    THE COMPUTED TEST RESULTS FOR  X, RCOND, THE DETERMINANT, AND
C    THE INVERSE ARE COMPARED TO THE STORED PRE-COMPUTED VALUES.
C    FAILURE OF THE TEST OCCURS WHEN AGREEMENT TO 3 SIGNIFICANT
C    DIGITS IS NOT ACHIEVED AND AN ERROR MESSAGE INDICATING WHICH
C    LINPACK SUBROUTINE FAILED AND WHICH QUANTITY WAS INVOLVED IS
C    PRINTED.  A SUMMARY LINE IS ALWAYS PRINTED.
C
C    NO INPUT ARGUMENTS ARE REQUIRED.
C    ON RETURN,  NERR  (INTEGER TYPE) CONTAINS THE TOTAL COUNT OF
C    ALL FAILURES DETECTED BY CTRQC.
C
C***ROUTINES CALLED  CTRCO, CTRDI, CTRSL
C***REVISION HISTORY  (YYMMDD)
C   801023  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 and cleaned up
C           FORMATs.  (RWC)
C***END PROLOGUE  CTRQC
      COMPLEX A(4,4),AT(5,4),B(4,2),BT(4),C(4),AINV(4,4,2),DET(2),
     1 DC(2),Z(4),XA,XB
      REAL R,RCOND,RCND(2),DELX
      CHARACTER KPROG*19, KFAIL*39
      INTEGER LDA,N,INFO,I,J,INDX,NERR
      INTEGER JOB,K,KK
      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 B/(2.E0,2.E0),(-1.E0,3.E0),(0.E0,-3.E0),(5.E0,0.E0),
     1 (3.E0,2.E0),(0.E0,2.E0),(0.E0,-4.E0),(4.E0,0.E0)/
      DATA C/(1.E0,1.E0),(0.E0,1.E0),(0.E0,-1.E0),(1.E0,0.E0)/
      DATA AINV/(.50000E0,0.E0),(0.E0,-.25000E0),(0.E0,0.E0),
     1 (0.E0,0.E0),
     2 (0.E0,-1.00000E0),(.50000E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),
     3 (0.E0,0.E0),(0.E0,0.E0),(.33333E0,0.E0),(0.E0,-.083333E0),
     4 (0.E0,0.E0),(0.E0,0.E0),(0.E0,-1.00000E0),(.25000E0,0.E0),
     5 (.50000E0,0.E0),(0.E0,1.00000E0),(0.E0,0.E0),(0.E0,0.E0),
     6 (0.E0,.25000E0),(.50000E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),
     7 (0.E0,0.E0),(0.E0,0.E0),(.33333E0,0.E0),(0.E0,1.00000E0),
     8 (0.E0,0.E0),(0.E0,0.E0),(0.E0,.083333E0),(.25000E0,0.E0)/
      DATA DC/(4.8E0,0.E0),(1.0E0,0.E0)/
      DATA KPROG/'TRFA TRCO TRSL TRDI'/
      DATA KFAIL/'INFO RCOND SOLUTION DETERMINANT INVERSE'/
      DATA RCND/.45695E0,.37047E0/
C
      DELX(XA,XB)=ABS(REAL(XA-XB))+ABS(AIMAG(XA-XB))
C***FIRST EXECUTABLE STATEMENT  CTRQC
      LDA = 5
      N = 4
      NERR = 0
C
C     K=1 FOR LOWER, K=2 FOR UPPER
C
      DO 160 K=1,2
C
C        FORM AT FOR CTRCO AND BT FOR CTRSL, TEST CTRCO
C
         DO 20 J=1,N
            BT(J) = B(J,K)
            DO 10 I=1,N
               AT(I,J) = A(I,J)
   10       CONTINUE
   20    CONTINUE
C
         JOB = K - 1
         CALL CTRCO(AT,LDA,N,RCOND,Z,JOB)
         R = ABS(RCND(K)-RCOND)
         IF (R .GE. .0001) THEN
            WRITE (LUN,201) KPROG(6:9),KFAIL(6:10)
            NERR = NERR + 1
         ENDIF
C
C        TEST CTRSL FOR JOB= 0 OR 1
C
         CALL CTRSL(AT,LDA,N,BT,JOB,INFO)
         IF (INFO .NE. 0) THEN
            WRITE (LUN,201) KPROG(11:14),KFAIL(1:4)
            NERR = NERR + 1
         ENDIF
C
         INDX = 0
         DO 50 I=1,N
            IF (DELX(C(I),BT(I)) .GT. .0001) INDX=INDX+1
   50    CONTINUE
C
         IF (INDX .NE. 0) THEN
            WRITE (LUN,201) KPROG(11:14),KFAIL(12:19)
            NERR = NERR + 1
         ENDIF
C
C        FORM BT FOR CTRSL
C
         KK = 3 - K
         DO 70 J=1,N
            BT(J) = B(J,KK)
   70    CONTINUE
C
C        TEST CTRSL FOR JOB EQUAL TO 10 OR 11
C
         JOB = 9 + K
         CALL CTRSL(AT,LDA,N,BT,JOB,INFO)
         IF (INFO .NE. 0) THEN
            WRITE (LUN,201) KPROG(11:14),KFAIL(1:4)
            NERR = NERR + 1
         ENDIF
C
         INDX = 0
         DO 90 I=1,N
            IF (DELX(C(I),BT(I)) .GT. .0001) INDX=INDX+1
   90    CONTINUE
C
         IF (INDX .NE. 0) THEN
            WRITE (LUN,201) KPROG(11:14),KFAIL(12:19)
            NERR = NERR + 1
         ENDIF
C
C        TEST CTRDI FOR JOB= 110 OR 111
C
         JOB = 109 + K
         CALL CTRDI(AT,LDA,N,DET,JOB,INFO)
         IF (INFO .NE. 0) THEN
            WRITE (LUN,201) KPROG(16:19),KFAIL(1:4)
            NERR = NERR + 1
         ENDIF
C
         INDX = 0
         DO 110 I=1,2
            IF (DELX(DC(I),DET(I)) .GT. .0001) INDX=INDX+1
  110    CONTINUE
C
         IF (INDX .NE. 0) THEN
            WRITE (LUN,201) KPROG(16:19),KFAIL(21:31)
            NERR = NERR + 1
         ENDIF
C
         INDX = 0
         DO 140 I=1,N
            DO 130 J=1,N
               IF (DELX(AINV(I,J,K),AT(I,J)) .GT. .0001) INDX=INDX+1
  130       CONTINUE
  140    CONTINUE
C
         IF (INDX .NE. 0) THEN
            WRITE (LUN,201) KPROG(16:19),KFAIL(33:39)
            NERR = NERR + 1
         ENDIF
  160 CONTINUE
C
      IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR
      RETURN
C
  200 FORMAT(/' * CTRQC - TEST FOR CTRCO, CTRSL AND CTRDI FOUND '
     1   , I2, ' ERRORS.'/)
  201 FORMAT (/' *** C', A, ' FAILURE - ERROR IN ', A)
      END

.