Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/pqfb.ssp
There are 2 other files named pqfb.ssp in the archive. Click here to see a list.
C PQFB 10
C ..................................................................PQFB 20
C PQFB 30
C SUBROUTINE PQFB PQFB 40
C PQFB 50
C PURPOSE PQFB 60
C TO FIND AN APPROXIMATION Q(X)=Q1+Q2*X+X*X TO A QUADRATIC PQFB 70
C FACTOR OF A GIVEN POLYNOMIAL P(X) WITH REAL COEFFICIENTS. PQFB 80
C PQFB 90
C USAGE PQFB 100
C CALL PQFB(C,IC,Q,LIM,IER) PQFB 110
C PQFB 120
C DESCRIPTION OF PARAMETERS PQFB 130
C C - INPUT VECTOR CONTAINING THE COEFFICIENTS OF P(X) - PQFB 140
C C(1) IS THE CONSTANT TERM (DIMENSION IC) PQFB 150
C IC - DIMENSION OF C PQFB 160
C Q - VECTOR OF DIMENSION 4 - ON INPUT Q(1) AND Q(2) MUST PQFB 170
C CONTAIN INITIAL GUESSES FOR Q1 AND Q2 - ON RETURN Q(1)PQFB 180
C AND Q(2) CONTAIN THE REFINED COEFFICIENTS Q1 AND Q2 OFPQFB 190
C Q(X), WHILE Q(3) AND Q(4) CONTAIN THE COEFFICIENTS A PQFB 200
C AND B OF A+B*X, WHICH IS THE REMAINDER OF THE QUOTIENTPQFB 210
C OF P(X) BY Q(X) PQFB 220
C LIM - INPUT VALUE SPECIFYING THE MAXIMUM NUMBER OF PQFB 230
C ITERATIONS TO BE PERFORMED PQFB 240
C IER - RESULTING ERROR PARAMETER (SEE REMARKS) PQFB 250
C IER= 0 - NO ERROR PQFB 260
C IER= 1 - NO CONVERGENCE WITHIN LIM ITERATIONS PQFB 270
C IER=-1 - THE POLYNOMIAL P(X) IS CONSTANT OR UNDEFINED PQFB 280
C - OR OVERFLOW OCCURRED IN NORMALIZING P(X) PQFB 290
C IER=-2 - THE POLYNOMIAL P(X) IS OF DEGREE 1 PQFB 300
C IER=-3 - NO FURTHER REFINEMENT OF THE APPROXIMATION TOPQFB 310
C A QUADRATIC FACTOR IS FEASIBLE, DUE TO EITHERPQFB 320
C DIVISION BY 0, OVERFLOW OR AN INITIAL GUESS PQFB 330
C THAT IS NOT SUFFICIENTLY CLOSE TO A FACTOR OFPQFB 340
C P(X) PQFB 350
C PQFB 360
C REMARKS PQFB 370
C (1) IF IER=-1 THERE IS NO COMPUTATION OTHER THAN THE PQFB 380
C POSSIBLE NORMALIZATION OF C. PQFB 390
C (2) IF IER=-2 THERE IS NO COMPUTATION OTHER THAN THE PQFB 400
C NORMALIZATION OF C. PQFB 410
C (3) IF IER =-3 IT IS SUGGESTED THAT A NEW INITIAL GUESS BEPQFB 420
C MADE FOR A QUADRATIC FACTOR. Q, HOWEVER, WILL CONTAIN PQFB 430
C THE VALUES ASSOCIATED WITH THE ITERATION THAT YIELDED PQFB 440
C THE SMALLEST NORM OF THE MODIFIED LINEAR REMAINDER. PQFB 450
C (4) IF IER=1, THEN, ALTHOUGH THE NUMBER OF ITERATIONS LIM PQFB 460
C WAS TOO SMALL TO INDICATE CONVERGENCE, NO OTHER PROB- PQFB 470
C LEMS HAVE BEEN DETECTED, AND Q WILL CONTAIN THE VALUES PQFB 480
C ASSOCIATED WITH THE ITERATION THAT YIELDED THE SMALLESTPQFB 490
C NORM OF THE MODIFIED LINEAR REMAINDER. PQFB 500
C (5) FOR COMPLETE DETAIL SEE THE DOCUMENTATION FOR PQFB 510
C SUBROUTINES PQFB AND DPQFB. PQFB 520
C PQFB 530
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED PQFB 540
C NONE PQFB 550
C PQFB 560
C METHOD PQFB 570
C COMPUTATION IS BASED ON BAIRSTOW'S ITERATIVE METHOD. (SEE PQFB 580
C WILKINSON, J.H., THE EVALUATION OF THE ZEROS OF ILL-CON- PQFB 590
C DITIONED POLYNOMIALS (PART ONE AND TWO), NUMERISCHE MATHE- PQFB 600
C MATIK, VOL.1 (1959), PP. 150-180, OR HILDEBRAND, F.B., PQFB 610
C INTRODUCTION TO NUMERICAL ANALYSIS, MC GRAW-HILL, NEW YORK/ PQFB 620
C TORONTO/LONDON, 1956, PP. 472-476.) PQFB 630
C PQFB 640
C ..................................................................PQFB 650
C PQFB 660
SUBROUTINE PQFB(C,IC,Q,LIM,IER) PQFB 670
C PQFB 680
C PQFB 690
DIMENSION C(1),Q(1) PQFB 700
C PQFB 710
C TEST ON LEADING ZERO COEFFICIENTS PQFB 720
IER=0 PQFB 730
J=IC+1 PQFB 740
1 J=J-1 PQFB 750
IF(J-1)40,40,2 PQFB 760
2 IF(C(J))3,1,3 PQFB 770
C PQFB 780
C NORMALIZATION OF REMAINING COEFFICIENTS PQFB 790
3 A=C(J) PQFB 800
IF(A-1.)4,6,4 PQFB 810
4 DO 5 I=1,J PQFB 820
C(I)=C(I)/A PQFB 830
CALL OVERFL(N) PQFB 840
IF(N-2)40,5,5 PQFB 850
5 CONTINUE PQFB 860
C PQFB 870
C TEST ON NECESSITY OF BAIRSTOW ITERATION PQFB 880
6 IF(J-3)41,38,7 PQFB 890
C PQFB 900
C PREPARE BAIRSTOW ITERATION PQFB 910
7 EPS=1.E-6 PQFB 920
EPS1=1.E-3 PQFB 930
L=0 PQFB 940
LL=0 PQFB 950
Q1=Q(1) PQFB 960
Q2=Q(2) PQFB 970
QQ1=0. PQFB 980
QQ2=0. PQFB 990
AA=C(1) PQFB1000
BB=C(2) PQFB1010
CB=ABS(AA) PQFB1020
CA=ABS(BB) PQFB1030
IF(CB-CA)8,9,10 PQFB1040
8 CC=CB+CB PQFB1050
CB=CB/CA PQFB1060
CA=1. PQFB1070
GO TO 11 PQFB1080
9 CC=CA+CA PQFB1090
CA=1. PQFB1100
CB=1. PQFB1110
GO TO 11 PQFB1120
10 CC=CA+CA PQFB1130
CA=CA/CB PQFB1140
CB=1. PQFB1150
11 CD=CC*.1 PQFB1160
C PQFB1170
C START BAIRSTOW ITERATION PQFB1180
C PREPARE NESTED MULTIPLICATION PQFB1190
12 A=0. PQFB1200
B=A PQFB1210
A1=A PQFB1220
B1=A PQFB1230
I=J PQFB1240
QQQ1=Q1 PQFB1250
QQQ2=Q2 PQFB1260
DQ1=HH PQFB1270
DQ2=H PQFB1280
C PQFB1290
C START NESTED MULTIPLICATION PQFB1300
13 H=-Q1*B-Q2*A+C(I) PQFB1310
CALL OVERFL(N) PQFB1320
IF(N-2)42,14,14 PQFB1330
14 B=A PQFB1340
A=H PQFB1350
I=I-1 PQFB1360
IF(I-1)18,15,16 PQFB1370
15 H=0. PQFB1380
16 H=-Q1*B1-Q2*A1+H PQFB1390
CALL OVERFL(N) PQFB1400
IF(N-2)42,17,17 PQFB1410
17 C1=B1 PQFB1420
B1=A1 PQFB1430
A1=H PQFB1440
GO TO 13 PQFB1450
C END OF NESTED MULTIPLICATION PQFB1460
C PQFB1470
C TEST ON SATISFACTORY ACCURACY PQFB1480
18 H=CA*ABS(A)+CB*ABS(B) PQFB1490
IF(LL)19,19,39 PQFB1500
19 L=L+1 PQFB1510
IF(ABS(A)-EPS*ABS(C(1)))20,20,21 PQFB1520
20 IF(ABS(B)-EPS*ABS(C(2)))39,39,21 PQFB1530
C PQFB1540
C TEST ON LINEAR REMAINDER OF MINIMUM NORM PQFB1550
21 IF(H-CC)22,22,23 PQFB1560
22 AA=A PQFB1570
BB=B PQFB1580
CC=H PQFB1590
QQ1=Q1 PQFB1600
QQ2=Q2 PQFB1610
C PQFB1620
C TEST ON LAST ITERATION STEP PQFB1630
23 IF(L-LIM)28,28,24 PQFB1640
C PQFB1650
C TEST ON RESTART OF BAIRSTOW ITERATION WITH ZERO INITIAL GUESS PQFB1660
24 IF(H-CD)43,43,25 PQFB1670
25 IF(Q(1))27,26,27 PQFB1680
26 IF(Q(2))27,42,27 PQFB1690
27 Q(1)=0. PQFB1700
Q(2)=0. PQFB1710
GO TO 7 PQFB1720
C PQFB1730
C PERFORM ITERATION STEP PQFB1740
28 HH=AMAX1(ABS(A1),ABS(B1),ABS(C1)) PQFB1750
IF(HH)42,42,29 PQFB1760
29 A1=A1/HH PQFB1770
B1=B1/HH PQFB1780
C1=C1/HH PQFB1790
H=A1*C1-B1*B1 PQFB1800
IF(H)30,42,30 PQFB1810
30 A=A/HH PQFB1820
B=B/HH PQFB1830
HH=(B*A1-A*B1)/H PQFB1840
H=(A*C1-B*B1)/H PQFB1850
Q1=Q1+HH PQFB1860
Q2=Q2+H PQFB1870
C END OF ITERATION STEP PQFB1880
C PQFB1890
C TEST ON SATISFACTORY RELATIVE ERROR OF ITERATED VALUES PQFB1900
IF(ABS(HH)-EPS*ABS(Q1))31,31,33 PQFB1910
31 IF(ABS(H)-EPS*ABS(Q2))32,32,33 PQFB1920
32 LL=1 PQFB1930
GO TO 12 PQFB1940
C PQFB1950
C TEST ON DECREASING RELATIVE ERRORS PQFB1960
33 IF(L-1)12,12,34 PQFB1970
34 IF(ABS(HH)-EPS1*ABS(Q1))35,35,12 PQFB1980
35 IF(ABS(H)-EPS1*ABS(Q2))36,36,12 PQFB1990
36 IF(ABS(QQQ1*HH)-ABS(Q1*DQ1))37,44,44 PQFB2000
37 IF(ABS(QQQ2*H)-ABS(Q2*DQ2))12,44,44 PQFB2010
C END OF BAIRSTOW ITERATION PQFB2020
C PQFB2030
C EXIT IN CASE OF QUADRATIC POLYNOMIAL PQFB2040
38 Q(1)=C(1) PQFB2050
Q(2)=C(2) PQFB2060
Q(3)=0. PQFB2070
Q(4)=0. PQFB2080
RETURN PQFB2090
C PQFB2100
C EXIT IN CASE OF SUFFICIENT ACCURACY PQFB2110
39 Q(1)=Q1 PQFB2120
Q(2)=Q2 PQFB2130
Q(3)=A PQFB2140
Q(4)=B PQFB2150
RETURN PQFB2160
C PQFB2170
C ERROR EXIT IN CASE OF ZERO OR CONSTANT POLYNOMIAL PQFB2180
40 IER=-1 PQFB2190
RETURN PQFB2200
C PQFB2210
C ERROR EXIT IN CASE OF LINEAR POLYNOMIAL PQFB2220
41 IER=-2 PQFB2230
RETURN PQFB2240
C PQFB2250
C ERROR EXIT IN CASE OF NONREFINED QUADRATIC FACTOR PQFB2260
42 IER=-3 PQFB2270
GO TO 44 PQFB2280
C PQFB2290
C ERROR EXIT IN CASE OF UNSATISFACTORY ACCURACY PQFB2300
43 IER=1 PQFB2310
44 Q(1)=QQ1 PQFB2320
Q(2)=QQ2 PQFB2330
Q(3)=AA PQFB2340
Q(4)=BB PQFB2350
RETURN PQFB2360
END PQFB2370