*DECK CPRPQX SUBROUTINE CPRPQX (LUN, KPRINT, IPASS) C***BEGIN PROLOGUE CPRPQX C***PURPOSE Quick check for CPZERO and RPZERO. C***LIBRARY SLATEC C***KEYWORDS QUICK CHECK C***AUTHOR Kahaner, D. K., (NBS) C***DESCRIPTION C C THIS QUICK CHECK ROUTINE IS WRITTEN FOR CPZERO AND RPZERO. C THE ZEROS OF POLYNOMIAL WITH COEFFICIENTS A(.) ARE STORED C IN ZK(.). RELERR IS THE RELATIVE ACCURACY REQUIRED FOR C THEM TO PASS. C C***ROUTINES CALLED CPZERO, R1MACH, RPZERO C***REVISION HISTORY (YYMMDD) C 810223 DATE WRITTEN C 890618 REVISION DATE from Version 3.2 C 891214 Prologue converted to Version 4.0 format. (BAB) C***END PROLOGUE CPRPQX INTEGER KPRINT,IPASS,LUN INTEGER IDEG,IDEGP1,INFO,I,J,ID REAL A(6),ERR,ERRI,RELERR COMPLEX AC(6),Z(5),ZK(5),W(21) DATA IDEG / 5 / DATA A / 1., -3.7, 7.4, -10.8, 10.8, -6.8 / DATA ZK / (1.7,0.), (1.,1.), (1.,-1.), + (0.,1.414213562 3730950488), + (0.,-1.414213562 3730950488) / C***FIRST EXECUTABLE STATEMENT CPRPQX IPASS = 1 IDEGP1 = IDEG+1 RELERR = SQRT(R1MACH(4)) DO 10 J=1,IDEGP1 AC(J) = CMPLX(A(J),0.) 10 CONTINUE INFO = 0 CALL CPZERO(IDEG,AC,Z,W(4),INFO,W) IF(INFO .EQ. 0) GO TO 15 IPASS=0 IF(INFO .EQ. 1 .AND. KPRINT .GE. 1) WRITE(LUN,630) IF(INFO .EQ. 2 .AND. KPRINT .GE. 1) WRITE(LUN,640) 15 DO 30 J=1,IDEG ERR = ABS(Z(J) - ZK(1)) ID = 1 DO 20 I=2,IDEG ERRI = ABS(Z(J) - ZK(I)) IF (ERRI .LT. ERR) ID = I ERR = MIN(ERRI,ERR) 20 CONTINUE IF (ABS(Z(J) - ZK(ID))/ABS(ZK(ID)) .GE. RELERR) IPASS = 0 30 CONTINUE INFO = 0 CALL RPZERO(IDEG,A,Z,W(4),INFO,W) IF(INFO .EQ. 0) GO TO 35 IPASS=0 IF(INFO .EQ. 1 .AND. KPRINT .GE. 1) WRITE(LUN,650) IF(INFO .EQ. 2 .AND. KPRINT .GE. 1) WRITE(LUN,660) 35 DO 50 J=1,IDEG ERR = ABS(Z(J) - ZK(1)) ID = 1 DO 40 I=2,IDEG ERRI = ABS(Z(J) - ZK(I)) IF (ERRI .LT. ERR) ID = I ERR = MIN(ERRI,ERR) 40 CONTINUE IF (ABS(Z(J) - ZK(ID))/ABS(ZK(ID)) .GE. RELERR) IPASS = 0 50 CONTINUE IF (KPRINT.GE.2 .AND. IPASS.NE.0) WRITE (LUN,670) IF (KPRINT.GE.1 .AND. IPASS.EQ.0) WRITE (LUN,680) RETURN C 630 FORMAT(' CPZERO TEST FAILS: LEADING COEFFICIENT OR DEGREE OF', 1 ' POLYNOMIAL IS ZERO') 640 FORMAT(' CPZERO TEST FAILS: NON-CONVERGENCE IN 125 ITERATIONS') 650 FORMAT(' RPZERO TEST FAILS: LEADING COEFFICIENT OR DEGREE OF', 1 ' POLYNOMIAL IS ZERO') 660 FORMAT(' RPZERO TEST FAILS: NON-CONVERGENCE IN 125 ITERATIONS') 670 FORMAT(25H CPRPQX PASSES ALL TESTS.) 680 FORMAT(25H CPRPQX FAILS SOME TESTS.) END