Web pdp-10.trailing-edge.com

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
```