Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50145/dpqfb.ssp
There are 2 other files named dpqfb.ssp in the archive. Click here to see a list.
C DPQF 10
C ..................................................................DPQF 20
C DPQF 30
C SUBROUTINE DPQFB DPQF 40
C DPQF 50
C PURPOSE DPQF 60
C TO FIND AN APPROXIMATION Q(X)=Q1+Q2*X+X*X TO A QUADRATIC DPQF 70
C FACTOR OF A GIVEN POLYNOMIAL P(X) WITH REAL COEFFICIENTS. DPQF 80
C DPQF 90
C USAGE DPQF 100
C CALL DPQFB(C,IC,Q,LIM,IER) DPQF 110
C DPQF 120
C DESCRIPTION OF PARAMETERS DPQF 130
C C - DOUBLE PRECISION INPUT VECTOR CONTAINING THE DPQF 140
C COEFFICIENTS OF P(X) - C(1) IS THE CONSTANT TERM DPQF 150
C (DIMENSION IC) DPQF 160
C IC - DIMENSION OF C DPQF 170
C Q - DOUBLE PRECISION VECTOR OF DIMENSION 4 - ON INPUT Q(1)DPQF 180
C AND Q(2) CONTAIN INITIAL GUESSES FOR Q1 AND Q2 - ON DPQF 190
C RETURN Q(1) AND Q(2) CONTAIN THE REFINED COEFFICIENTS DPQF 200
C Q1 AND Q2 OF Q(X), WHILE Q(3) AND Q(4) CONTAIN THE DPQF 210
C COEFFICIENTS A AND B OF A+B*X, WHICH IS THE REMAINDER DPQF 220
C OF THE QUOTIENT OF P(X) BY Q(X) DPQF 230
C LIM - INPUT VALUE SPECIFYING THE MAXIMUM NUMBER OF DPQF 240
C ITERATIONS TO BE PERFORMED DPQF 250
C IER - RESULTING ERROR PARAMETER (SEE REMARKS) DPQF 260
C IER= 0 - NO ERROR DPQF 270
C IER= 1 - NO CONVERGENCE WITHIN LIM ITERATIONS DPQF 280
C IER=-1 - THE POLYNOMIAL P(X) IS CONSTANT OR UNDEFINED DPQF 290
C - OR OVERFLOW OCCURRED IN NORMALIZING P(X) DPQF 300
C IER=-2 - THE POLYNOMIAL P(X) IS OF DEGREE 1 DPQF 310
C IER=-3 - NO FURTHER REFINEMENT OF THE APPROXIMATION TODPQF 320
C A QUADRATIC FACTOR IS FEASIBLE, DUE TO EITHERDPQF 330
C DIVISION BY 0, OVERFLOW OR AN INITIAL GUESS DPQF 340
C THAT IS NOT SUFFICIENTLY CLOSE TO A FACTOR OFDPQF 350
C P(X) DPQF 360
C DPQF 370
C REMARKS DPQF 380
C (1) IF IER=-1 THERE IS NO COMPUTATION OTHER THAN THE DPQF 390
C POSSIBLE NORMALIZATION OF C. DPQF 400
C (2) IF IER=-2 THERE IS NO COMPUTATION OTHER THAN THE DPQF 410
C NORMALIZATION OF C. DPQF 420
C (3) IF IER =-3 IT IS SUGGESTED THAT A NEW INITIAL GUESS BEDPQF 430
C MADE FOR A QUADRATIC FACTOR. Q, HOWEVER, WILL CONTAIN DPQF 440
C THE VALUES ASSOCIATED WITH THE ITERATION THAT YIELDED DPQF 450
C THE SMALLEST NORM OF THE MODIFIED LINEAR REMAINDER. DPQF 460
C (4) IF IER=1, THEN, ALTHOUGH THE NUMBER OF ITERATIONS LIM DPQF 470
C WAS TOO SMALL TO INDICATE CONVERGENCE, NO OTHER PROB- DPQF 480
C LEMS HAVE BEEN DETECTED, AND Q WILL CONTAIN THE VALUES DPQF 490
C ASSOCIATED WITH THE ITERATION THAT YIELDED THE SMALLESTDPQF 500
C NORM OF THE MODIFIED LINEAR REMAINDER. DPQF 510
C (5) FOR COMPLETE DETAIL SEE THE DOCUMENTATION FOR DPQF 520
C SUBROUTINES PQFB AND DPQFB. DPQF 530
C DPQF 540
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED DPQF 550
C NONE DPQF 560
C DPQF 570
C METHOD DPQF 580
C COMPUTATION IS BASED ON BAIRSTOW'S ITERATIVE METHOD. (SEE DPQF 590
C WILKINSON, J.H., THE EVALUATION OF THE ZEROS OF ILL-CON- DPQF 600
C DITIONED POLYNOMIALS (PART ONE AND TWO), NUMERISCHE MATHE- DPQF 610
C MATIK, VOL.1 (1959), PP. 150-180, OR HILDEBRAND, F.B., DPQF 620
C INTRODUCTION TO NUMERICAL ANALYSIS, MC GRAW-HILL, NEW YORK/ DPQF 630
C TORONTO/LONDON, 1956, PP. 472-476.) DPQF 640
C DPQF 650
C ..................................................................DPQF 660
C DPQF 670
SUBROUTINE DPQFB(C,IC,Q,LIM,IER) DPQF 680
C DPQF 690
C DPQF 700
DIMENSION C(1),Q(1) DPQF 710
DOUBLE PRECISION A,B,AA,BB,CA,CB,CC,CD,A1,B1,C1,H,HH,Q1,Q2,QQ1, DPQF 720
1 QQ2,QQQ1,QQQ2,DQ1,DQ2,EPS,EPS1,C,Q DPQF 730
C DPQF 740
C TEST ON LEADING ZERO COEFFICIENTS DPQF 750
IER=0 DPQF 760
J=IC+1 DPQF 770
1 J=J-1 DPQF 780
IF(J-1)40,40,2 DPQF 790
2 IF(C(J))3,1,3 DPQF 800
C DPQF 810
C NORMALIZATION OF REMAINING COEFFICIENTS DPQF 820
3 A=C(J) DPQF 830
IF(A-1.D0)4,6,4 DPQF 840
4 DO 5 I=1,J DPQF 850
C(I)=C(I)/A DPQF 860
CALL OVERFL(N) DPQF 870
IF(N-2)40,5,5 DPQF 880
5 CONTINUE DPQF 890
C DPQF 900
C TEST ON NECESSITY OF BAIRSTOW ITERATION DPQF 910
6 IF(J-3)41,38,7 DPQF 920
C DPQF 930
C PREPARE BAIRSTOW ITERATION DPQF 940
7 EPS=1.D-14 DPQF 950
EPS1=1.D-6 DPQF 960
L=0 DPQF 970
LL=0 DPQF 980
Q1=Q(1) DPQF 990
Q2=Q(2) DPQF1000
QQ1=0.D0 DPQF1010
QQ2=0.D0 DPQF1020
AA=C(1) DPQF1030
BB=C(2) DPQF1040
CB=DABS(AA) DPQF1050
CA=DABS(BB) DPQF1060
IF(CB-CA)8,9,10 DPQF1070
8 CC=CB+CB DPQF1080
CB=CB/CA DPQF1090
CA=1.D0 DPQF1100
GO TO 11 DPQF1110
9 CC=CA+CA DPQF1120
CA=1.D0 DPQF1130
CB=1.D0 DPQF1140
GO TO 11 DPQF1150
10 CC=CA+CA DPQF1160
CA=CA/CB DPQF1170
CB=1.D0 DPQF1180
11 CD=CC*.1D0 DPQF1190
C DPQF1200
C START BAIRSTOW ITERATION DPQF1210
C PREPARE NESTED MULTIPLICATION DPQF1220
12 A=0.D0 DPQF1230
B=A DPQF1240
A1=A DPQF1250
B1=A DPQF1260
I=J DPQF1270
QQQ1=Q1 DPQF1280
QQQ2=Q2 DPQF1290
DQ1=HH DPQF1300
DQ2=H DPQF1310
C DPQF1320
C START NESTED MULTIPLICATION DPQF1330
13 H=-Q1*B-Q2*A+C(I) DPQF1340
CALL OVERFL(N) DPQF1350
IF(N-2)42,14,14 DPQF1360
14 B=A DPQF1370
A=H DPQF1380
I=I-1 DPQF1390
IF(I-1)18,15,16 DPQF1400
15 H=0.D0 DPQF1410
16 H=-Q1*B1-Q2*A1+H DPQF1420
CALL OVERFL(N) DPQF1430
IF(N-2)42,17,17 DPQF1440
17 C1=B1 DPQF1450
B1=A1 DPQF1460
A1=H DPQF1470
GO TO 13 DPQF1480
C END OF NESTED MULTIPLICATION DPQF1490
C DPQF1500
C TEST ON SATISFACTORY ACCURACY DPQF1510
18 H=CA*DABS(A)+CB*DABS(B) DPQF1520
IF(LL)19,19,39 DPQF1530
19 L=L+1 DPQF1540
IF(DABS(A)-EPS*DABS(C(1)))20,20,21 DPQF1550
20 IF(DABS(B)-EPS*DABS(C(2)))39,39,21 DPQF1560
C DPQF1570
C TEST ON LINEAR REMAINDER OF MINIMUM NORM DPQF1580
21 IF(H-CC)22,22,23 DPQF1590
22 AA=A DPQF1600
BB=B DPQF1610
CC=H DPQF1620
QQ1=Q1 DPQF1630
QQ2=Q2 DPQF1640
C DPQF1650
C TEST ON LAST ITERATION STEP DPQF1660
23 IF(L-LIM)28,28,24 DPQF1670
C DPQF1680
C TEST ON RESTART OF BAIRSTOW ITERATION WITH ZERO INITIAL GUESS DPQF1690
24 IF(H-CD)43,43,25 DPQF1700
25 IF(Q(1))27,26,27 DPQF1710
26 IF(Q(2))27,42,27 DPQF1720
27 Q(1)=0.D0 DPQF1730
Q(2)=0.D0 DPQF1740
GO TO 7 DPQF1750
C DPQF1760
C PERFORM ITERATION STEP DPQF1770
28 HH=DMAX1(DABS(A1),DABS(B1),DABS(C1)) DPQF1780
IF(HH)42,42,29 DPQF1790
29 A1=A1/HH DPQF1800
B1=B1/HH DPQF1810
C1=C1/HH DPQF1820
H=A1*C1-B1*B1 DPQF1830
IF(H)30,42,30 DPQF1840
30 A=A/HH DPQF1850
B=B/HH DPQF1860
HH=(B*A1-A*B1)/H DPQF1870
H=(A*C1-B*B1)/H DPQF1880
Q1=Q1+HH DPQF1890
Q2=Q2+H DPQF1900
C END OF ITERATION STEP DPQF1910
C DPQF1920
C TEST ON SATISFACTORY RELATIVE ERROR OF ITERATED VALUES DPQF1930
IF(DABS(HH)-EPS*DABS(Q1))31,31,33 DPQF1940
31 IF(DABS(H)-EPS*DABS(Q2))32,32,33 DPQF1950
32 LL=1 DPQF1960
GO TO 12 DPQF1970
C DPQF1980
C TEST ON DECREASING RELATIVE ERRORS DPQF1990
33 IF(L-1)12,12,34 DPQF2000
34 IF(DABS(HH)-EPS1*DABS(Q1))35,35,12 DPQF2010
35 IF(DABS(H)-EPS1*DABS(Q2))36,36,12 DPQF2020
36 IF(DABS(QQQ1*HH)-DABS(Q1*DQ1))37,44,44 DPQF2030
37 IF(DABS(QQQ2*H)-DABS(Q2*DQ2))12,44,44 DPQF2040
C END OF BAIRSTOW ITERATION DPQF2050
C DPQF2060
C EXIT IN CASE OF QUADRATIC POLYNOMIAL DPQF2070
38 Q(1)=C(1) DPQF2080
Q(2)=C(2) DPQF2090
Q(3)=0.D0 DPQF2100
Q(4)=0.D0 DPQF2110
RETURN DPQF2120
C DPQF2130
C EXIT IN CASE OF SUFFICIENT ACCURACY DPQF2140
39 Q(1)=Q1 DPQF2150
Q(2)=Q2 DPQF2160
Q(3)=A DPQF2170
Q(4)=B DPQF2180
RETURN DPQF2190
C DPQF2200
C ERROR EXIT IN CASE OF ZERO OR CONSTANT POLYNOMIAL DPQF2210
40 IER=-1 DPQF2220
RETURN DPQF2230
C DPQF2240
C ERROR EXIT IN CASE OF LINEAR POLYNOMIAL DPQF2250
41 IER=-2 DPQF2260
RETURN DPQF2270
C DPQF2280
C ERROR EXIT IN CASE OF NONREFINED QUADRATIC FACTOR DPQF2290
42 IER=-3 DPQF2300
GO TO 44 DPQF2310
C DPQF2320
C ERROR EXIT IN CASE OF UNSATISFACTORY ACCURACY DPQF2330
43 IER=1 DPQF2340
44 Q(1)=QQ1 DPQF2350
Q(2)=QQ2 DPQF2360
Q(3)=AA DPQF2370
Q(4)=BB DPQF2380
RETURN DPQF2390
END DPQF2400