*DECK CSVQC SUBROUTINE CSVQC (LUN, KPRINT, NERR) C***BEGIN PROLOGUE CSVQC C***PURPOSE Quick check for CSVDC. C***LIBRARY SLATEC C***KEYWORDS QUICK CHECK C***AUTHOR Voorhees, E. A., (LANL) C***DESCRIPTION C C THE RETURNED FLOATING POINT VALUES FROM CSVDC FOR C S, E, U, AND V ARE COMPARED TO THEIR C CORRESPONDING STORED PRE-COMPUTED VALUES (ENTERED C WITH DATA STATEMENTS). FAILURE OF THE TEST OCCURS WHEN C AGREEMENT TO 3 SIGNIFICANT DIGITS IS NOT ACHIEVED AND C AN ERROR MESSAGE IS THEN PRINTED. C C THE RETURNED INTEGER VALUE OF INFO IS ALSO CHECKED. 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 CSVDC C***REVISION HISTORY (YYMMDD) C 801031 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 CSVQC COMPLEX A(4,4),WORK(4),S(4),E(4),U(4,4),V(4,4) COMPLEX AT(5,4),SC(4),EC(4),UVC(4,4),X1,X2 INTEGER LDX,N,P,LDU,LDV,JOB,INFO CHARACTER KFAIL*12 INTEGER I,J,INDX(4) 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 KFAIL/'S E U V INFO'/ DATA SC/(4.61803E0,0.E0),(3.0E0,0.E0),(2.38197E0,0.E0),(1.E0,0.E0) 1/ DATA EC/(0.E0,0.E0),(0.E0,0.E0),(0.E0,0.E0),(0.E0,0.E0)/ DATA UVC/(0.E0,0.E0),(0.E0,0.E0),(-.52573E0,0.E0),(0.E0,-.85065E0) 1, 2 (.70711E0,0.E0),(0.E0,.70711E0),(0.E0,0.E0),(0.E0,0.E0), 3 (0.E0,0.E0),(0.E0,0.E0),(-.85065E0,0.E0),(0.E0,.52573E0), 4 (-.70711E0,0.E0),(0.E0,.70711E0),(0.E0,0.E0),(0.E0,0.E0)/ C DELX(X1,X2) = ABS(REAL(X1-X2))+ABS(AIMAG(X1-X2)) C***FIRST EXECUTABLE STATEMENT CSVQC N = 4 P = 4 LDX = 5 LDU = 4 LDV = 4 NERR = 0 JOB = 11 C C FORM AT C DO 20 J=1,N DO 10 I=1,N AT(I,J) = A(I,J) 10 CONTINUE 20 CONTINUE C C TEST CSVDC (S, E, U, V, INFO) C DO 30 I=1,4 INDX(I) = 0 30 CONTINUE C CALL CSVDC(AT,LDX,N,P,S,E,U,LDU,V,LDV,WORK,JOB,INFO) DO 50 J=1,N IF (DELX(S(J),SC(J)) .GT. .0001) INDX(1) = INDX(1)+1 IF (DELX(E(J),EC(J)) .GT. .0001) INDX(2) = INDX(2)+1 DO 40 I=1,N IF (DELX(U(I,J),UVC(I,J)) .GT. .0001) INDX(3) = INDX(3)+1 IF (DELX(V(I,J),UVC(I,J)) .GT. .0001) INDX(4) = INDX(4)+1 40 CONTINUE 50 CONTINUE C DO 70 I=1,4 KONE=2*I-1 IF (INDX(I) .NE. 0) THEN WRITE (LUN,201) KFAIL(KONE:KONE) NERR = NERR + 1 ENDIF 70 CONTINUE C IF (INFO .NE. 0) THEN WRITE (LUN,201) KFAIL(9:12) NERR = NERR + 1 ENDIF C IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR RETURN C 200 FORMAT (/' * CSVQC - TEST FOR CSVDC FOUND ', I1, ' ERRORS.'/) 201 FORMAT (/' *** CSVQC FAILURE - ERROR IN ', A) END