*DECK CGECK SUBROUTINE CGECK (LUN, KPRINT, NERR) C***BEGIN PROLOGUE CGECK C***PURPOSE Quick check for CGEFA, CGECO, CGESL and CGEDI. 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 SUBROUTINES BEING TESTED. C THE VALUES OF A AND B AND THE PRE-COMPUTED VALUES OF C C (THE SOLUTION VECTOR), AINV (INVERSE OF MATRIX A ), DC C (DETERMINANT OF A ), AND RCND ( RCOND ) ARE ENTERED C WITH DATA STATEMENTS. C C THE COMPUTED TEST RESULTS FOR X, RCOND, THE DETERMINANT, AND C THE INVERSE ARE COMPARED TO THE STORED PRE-COMPUTED VALUES. C FAILURE OF THE TEST OCCURS WHEN AGREEMENT TO 3 SIGNIFICANT C DIGITS IS NOT ACHIEVED AND AN ERROR MESSAGE INDICATING WHICH C LINPACK SUBROUTINE FAILED AND WHICH QUANTITY WAS INVOLVED IS C PRINTED. A SUMMARY LINE IS ALWAYS PRINTED. C C NO INPUT ARGUMENTS ARE REQUIRED. C ON RETURN, NERR (INTEGER TYPE) CONTAINS THE TOTAL COUNT OF C ALL FAILURES DETECTED BY CGECK. C C***ROUTINES CALLED CGECO, CGEDI, CGEFA, CGESL C***REVISION HISTORY (YYMMDD) C 801014 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 CGECK COMPLEX A(4,4),AT(5,4),B(4),BT(4),C(4),AINV(4,4),DET(2),DC(2), 1 Z(4),XA,XB REAL R,RCOND,RCND,DELX CHARACTER KPROG*19,KFAIL*39 INTEGER LDA,N,IPVT(4),INFO,I,J,INDX,NERR 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 B/(3.E0,2.E0),(-1.E0,3.E0),(0.E0,-4.E0),(5.E0,0.E0)/ DATA C/(1.E0,1.E0),(0.E0,1.E0),(0.E0,-1.E0),(1.E0,0.E0)/ DATA AINV/(.66667E0,0.E0),(0.E0,-.33333E0),(0.E0,0.E0), 1 (0.E0,0.E0), 2 (0.E0,.33333E0),(.66667E0,0.E0),(0.E0,0.E0),(0.E0,0.E0), 3 (0.E0,0.E0),(0.E0,0.E0),(.36364E0,0.E0),(0.E0,-.09091E0), 4 (0.E0,0.E0),(0.E0,0.E0),(0.E0,.09091E0),(.27273E0,0.E0)/ DATA DC/(3.3E0,0.E0),(1.0E0,0.E0)/ DATA KPROG/'GEFA GECO GESL GEDI'/ DATA KFAIL/'INFO RCOND SOLUTION DETERMINANT INVERSE'/ DATA RCND/.24099E0/ C DELX(XA,XB)=ABS(REAL(XA-XB))+ABS(AIMAG(XA-XB)) C***FIRST EXECUTABLE STATEMENT CGECK LDA = 5 N = 4 NERR = 0 C C FORM AT FOR CGEFA AND BT FOR CGESL, TEST CGEFA C DO 20 J=1,N BT(J) = B(J) DO 10 I=1,N AT(I,J) = A(I,J) 10 CONTINUE 20 CONTINUE C CALL CGEFA(AT,LDA,N,IPVT,INFO) IF (INFO .NE. 0) THEN WRITE (LUN,201) KPROG(1:4),KFAIL(1:4) NERR = NERR + 1 ENDIF C C TEST CGESL FOR JOB=0 C CALL CGESL(AT,LDA,N,IPVT,BT,0) INDX = 0 DO 40 I=1,N IF(DELX(C(I),BT(I)) .GT. .0001) INDX=INDX+1 40 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KPROG(11:14),KFAIL(12:19) NERR = NERR + 1 ENDIF C C FORM AT FOR CGECO AND BT FOR CGESL, TEST CGECO C DO 70 J=1,N BT(J) = B(J) DO 60 I=1,N AT(I,J) = A(I,J) 60 CONTINUE 70 CONTINUE C CALL CGECO(AT,LDA,N,IPVT,RCOND,Z) R = ABS(RCND-RCOND) IF (R .GE. .0001) THEN WRITE (LUN,201) KPROG(6:9),KFAIL(6:10) NERR = NERR + 1 ENDIF C C TEST CGESL FOR JOB NOT EQUAL TO 0 C CALL CGESL(AT,LDA,N,IPVT,BT,1) INDX = 0 DO 90 I=1,N IF (DELX(C(I),BT(I)) .GT. .0001) INDX=INDX+1 90 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KPROG(11:14),KFAIL(12:19) NERR = NERR + 1 ENDIF C C TEST CGEDI FOR JOB=11 C CALL CGEDI(AT,LDA,N,IPVT,DET,Z,11) INDX = 0 DO 110 I=1,2 IF (DELX(DC(I),DET(I)) .GT. .0001) INDX=INDX+1 110 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KPROG(16:19),KFAIL(21:31) NERR = NERR + 1 ENDIF C INDX = 0 DO 140 I=1,N DO 130 J=1,N IF (DELX(AINV(I,J),AT(I,J)) .GT. .0001) INDX=INDX+1 130 CONTINUE 140 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KPROG(16:19),KFAIL(33:39) NERR = NERR + 1 ENDIF C IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR RETURN C 200 FORMAT(/' * CGECK - TEST FOR CGEFA, CGECO, CGESL AND CGEDI FOUND ' 1 , I1, ' ERRORS.'/) 201 FORMAT (/' *** C', A, ' FAILURE - ERROR IN ', A) END .