*DECK CHIQC SUBROUTINE CHIQC (LUN, KPRINT, NERR) C***BEGIN PROLOGUE CHIQC C***PURPOSE Quick check for CHIFA, CHICO, CHISL and CHIDI. 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 CHIQC. C C***ROUTINES CALLED CHICO, CHIDI, CHIFA, CHISL C***REVISION HISTORY (YYMMDD) C 801022 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 CHIQC COMPLEX A(4,4),AT(5,4),B(4),BT(4),C(4),AINV(4,4), 1 Z(4),XA,XB REAL R,RCOND,RCND,DELX,DET(2),DC(2) CHARACTER KPROG*19,KFAIL*47 INTEGER LDA,N,IPVT(4),INFO,I,J,INDX,NERR INTEGER INERT(3),IRT(3) 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,1.E0),(0.E0,0.E0),(0.E0,0.E0), 1 (0.E0,.33333E0),(.66667E0,0.E0),(0.E0,0.E0),(0.E0,0.E0), 2 (0.E0,0.E0),(0.E0,0.E0),(.36364E0,0.E0),(0.E0,1.E0), 3 (0.E0,0.E0),(0.E0,0.E0),(0.E0,.09091E0),(.27273E0,0.E0)/ DATA DC/3.3E0,1.0E0/ DATA KPROG/'HIFA HICO HISL HIDI'/ DATA KFAIL/'INFO RCOND SOLUTION DETERMINANT INVERSE INERTIA'/ DATA RCND/.24099E0/ DATA IRT/4,0,0/ C DELX(XA,XB)=ABS(REAL(XA-XB))+ABS(AIMAG(XA-XB)) C***FIRST EXECUTABLE STATEMENT CHIQC LDA = 5 N = 4 NERR = 0 C C FORM AT FOR CHIFA AND BT FOR CHISL, TEST CHIFA 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 CHIFA(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 CHISL C CALL CHISL(AT,LDA,N,IPVT,BT) 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 CHICO, TEST CHICO C DO 70 J=1,N DO 60 I=1,N AT(I,J) = A(I,J) 60 CONTINUE 70 CONTINUE C CALL CHICO(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 CHIDI FOR JOB=111 C CALL CHIDI(AT,LDA,N,IPVT,DET,INERT,Z,111) INDX = 0 DO 110 I=1,2 IF (ABS(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 INDX = 0 DO 160 I=1,3 IF((INERT(I)-IRT(I)) .NE. 0) INDX=INDX+1 160 CONTINUE C IF (INDX .NE. 0) THEN WRITE (LUN,201) KPROG(16:19),KFAIL(41:47) NERR = NERR + 1 ENDIF C IF (KPRINT.GE.2 .OR. NERR.NE.0) WRITE (LUN,200) NERR RETURN C 200 FORMAT(/' * CHIQC - TEST FOR CHIFA, CHICO, CHISL AND CHIDI FOUND ' 1 , I1, ' ERRORS.'/) 201 FORMAT (/' *** C', A, ' FAILURE - ERROR IN ', A) END