*DECK CPTQC SUBROUTINE CPTQC (LUN, KPRINT, NERR) C***BEGIN PROLOGUE CPTQC C***PURPOSE Quick check for CPTSL. 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 SUBROUTINE BEING TESTED. C THE VALUES OF A AND B AND THE PRE-COMPUTED VALUES OF CX C (THE SOLUTION VECTOR) ARE ENTERED WITH DATA STATEMENTS. C C THE COMPUTED VALUES OF X ARE COMPARED TO THE STORED C PRE-COMPUTED VALUES OF CX. FAILURE OF THE TEST OCCURS WHEN C AGREEMENT TO 3 SIGNIFICANT DIGITS IS NOT ACHIEVED AND AN C ERROR MESSAGE IS PRINTED. A SUMMARY LINE IS ALWAYS PRINTED. C C NO INPUT ARGUMENTS ARE REQUIRED. C ON RETURN, NERR (INTEGER TYPE) CONTAINS THE TOTAL COUNT C OF ALL FAILURES DETECTED BY CPTQC. C C***ROUTINES CALLED CPTSL C***REVISION HISTORY (YYMMDD) C 801024 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 CPTQC COMPLEX D(4),E(4),B(4),CX(4),DT(4),ET(4),BT(4) INTEGER N,I,INDX,NERR REAL DELX DATA D/(2.E0,0.E0),(2.E0,0.E0),(3.E0,0.E0),(4.E0,0.E0)/ DATA E/(0.E0,-1.E0),(0.E0,0.E0),(0.E0,-1.E0),(0.E0,0.E0)/ DATA B/(3.E0,2.E0),(-1.E0,3.E0),(0.E0,-4.E0),(5.E0,0.E0)/ DATA CX/(1.E0,1.E0),(0.E0,1.E0),(0.E0,-1.E0),(1.E0,0.E0)/ C***FIRST EXECUTABLE STATEMENT CPTQC N = 4 NERR = 0 DO 10 I=1,N DT(I) = D(I) ET(I) = E(I) BT(I) = B(I) 10 CONTINUE C CALL CPTSL(N,DT,ET,BT) INDX = 0 DO 20 I=1,N DELX = ABS(REAL(BT(I)-CX(I)))+ABS(AIMAG(BT(I)-CX(I))) IF (DELX .GT. .0001) INDX=INDX+1 20 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) NERR = NERR + 1 ENDIF C IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR RETURN C 200 FORMAT (/' * CPTQC - TEST FOR CPTSL FOUND ', I1, ' ERRORS.'/) 201 FORMAT (/' *** CPTSL FAILURE - ERROR IN SOLUTION') END