*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