*DECK CCHQC
      SUBROUTINE CCHQC (LUN, KPRINT, NERR)
C***BEGIN PROLOGUE  CCHQC
C***PURPOSE  Quick check for CCHDC.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Voorhees, E. A., (LANL)
C***DESCRIPTION
C
C    QUICK CHECK FOR LINPACK SUBROUTINE CCHDC.
C
C    THE CHOLESKY FACTORIZATION OF MATRIX  A  IS COMPARED TO
C    THE STORED PRE-COMPUTED FACTORIZATION OF  A  (ENTERED
C    WITH A DATA STATEMENT).  FAILURE OF THE TEST OCCURS WHEN
C    AGREEMENT TO 3 SIGNIFICANT DIGITS IS NOT ACHIEVED AND AN
C    ERROR MESSAGE IS PRINTED.
C
C    THE INTEGER VALUES OF JPVT AND INFO ARE SIMILARLY TESTED.
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  CCHDC
C***REVISION HISTORY  (YYMMDD)
C   801027  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  CCHQC
      COMPLEX A(4,4),WORK(4),AT(5,4),AF(4,4)
      INTEGER LDA,P,JPVT(4),JOB,INFO,JPVTT(4),I,J,INFOC,JPVTC(4)
      CHARACTER*20 KFAIL
      INTEGER INDX
      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 AF/(1.73205E0,0.E0),(0.E0,1.E0),(0.E0,0.E0),(0.E0,0.E0),
     1 (0.E0,-.57735E0),(1.91485E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),
     2 (0.E0,0.E0),(0.E0,0.E0),(1.41421E0,0.E0),(0.E0,1.E0),
     3 (0.E0,0.E0),(0.E0,0.E0),(0.E0,-.70711E0),(1.22475E0,0.E0)/
      DATA INFOC/4/
      DATA JPVTC/3,4,1,2/
      DATA KFAIL/'FACTORING JPVT INFO '/
C***FIRST EXECUTABLE STATEMENT  CCHQC
      JOB = 1
      LDA = 5
      P = 4
      NERR = 0
C
C     FORM AT AND JPVTT.
C
      DO 20 J=1,P
         JPVTT(J) = JPVT(J)
         DO 10 I=1,P
            AT(I,J) = A(I,J)
   10    CONTINUE
   20 CONTINUE
C
C     TEST CCHDC.
C
      CALL CCHDC(AT,LDA,P,WORK,JPVTT,JOB,INFO)
      INDX = 0
      DO 40 J=1,P
         DO 30 I=1,P
            DELX =ABS(REAL(AT(I,J)-AF(I,J)))+ABS(AIMAG(AT(I,J)-AF(I,J)))
            IF (DELX .GT. .0001) INDX=INDX+1
   30    CONTINUE
   40 CONTINUE
C
      IF (INDX .NE. 0) THEN
         WRITE (LUN,201) KFAIL(1:9)
         NERR = NERR + 1
      ENDIF
C
      INDX = 0
      DO 60 I=1,P
         IF (JPVTT(I) .NE. JPVTC(I)) INDX=INDX+1
   60 CONTINUE
C
      IF (INDX .NE. 0) THEN
         WRITE (LUN,201) KFAIL(11:14)
         NERR = NERR + 1
      ENDIF
C
      IF (INFO .NE. INFOC) THEN
         WRITE (LUN,201) KFAIL(16:19)
         NERR = NERR + 1
      ENDIF
C
      IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR
      RETURN
C
  200 FORMAT (/' * CCHQC - TEST FOR CCHDC FOUND ', I1, ' ERRORS.'/
     1   6X, '(NO TEST FOR CCHUD, CCHDD OR CCHEX)'/)
  201 FORMAT (/' *** CCHDC FAILURE - ERROR IN ', A)
      END
