*DECK CGTQC SUBROUTINE CGTQC (LUN, KPRINT, NERR) C***BEGIN PROLOGUE CGTQC C***PURPOSE Quick check for CGTSL. 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 CGTQC. C C***ROUTINES CALLED CGTSL 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, moved an ARITHMETIC C STATEMENT FUNCTION ahead of the FIRST EXECUTABLE STATEMENT C record and cleaned up FORMATs. (RWC) C***END PROLOGUE CGTQC COMPLEX C(4),D(4),E(4),B(4),CX(4),CT(4),DT(4),ET(4),BT(4) CHARACTER KFAIL*13 INTEGER N,INFO,I,INDX,NERR REAL DELX DATA C/(0.E0,0.E0),(0.E0,1.E0),(0.E0,0.E0),(0.E0,1.E0)/ 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)/ DATA KFAIL/'INFO SOLUTION'/ C***FIRST EXECUTABLE STATEMENT CGTQC N = 4 NERR = 0 DO 10 I=1,N CT(I) = C(I) DT(I) = D(I) ET(I) = E(I) BT(I) = B(I) 10 CONTINUE C CALL CGTSL(N,CT,DT,ET,BT,INFO) IF (INFO .NE. 0) THEN WRITE (LUN,201) KFAIL(1:4) NERR = NERR + 1 ENDIF C INDX = 0 DO 30 I=1,N DELX = ABS(REAL(BT(I)-CX(I)))+ABS(AIMAG(BT(I)-CX(I))) IF (DELX .GT. .0001) INDX=INDX+1 30 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KFAIL(6:13) NERR = NERR + 1 ENDIF C IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR RETURN C 200 FORMAT (/' * CGTQC - TEST FOR CGTSL FOUND ', I1, ' ERRORS.'/) 201 FORMAT (/' *** CGTSL FAILURE - ERROR IN ', A) END