C-8K FOCAL @1969

01.10 T !! " ROOTS OF POLYNOMIAL
01.30 A ! "ORDER OF POLYNOMIAL  ",N
01.40 T !! "TYPE POLYNOMIAL COEFFS",!
01.45 F I=1,N+1;A AM(I)
01.50 D 1.1
01.55 T !! "POLYNOMIAL COEFFS",!
01.60 F I=1,N+1;T %,AM(I),!
01.70 S ST=0
01.80 F I=1,N+1;S ST=ST+FABS(AM(I))

02.05 S XS=-ST/2;S T=0
02.10 S 2=XS;S X1=0
02.15 D 3
02.20 I (Y1*Y2)4.1,3.25,2.25
02.25 S X2=X2+X;S X1=X1+XS
02.30 I (FABS(X2)-ST)2.15,2.15,2(4
02.40 I (X2)2.5,2.5,2.55
02.50 S XS=-XS;G 2.1
02.55 S T=T+1;I (T-3)2.57,2.6,2.6
02.57 S XS=-XS/10;G 2.1
02.60 T !! "FUNCTION VALUE HAS NJT CROSSED REAL AXIS DURING
02.65 T ! "SEARCH - ROOTS MAY BE COMPLEX",!;G 16.01

03.10 S X=X1;D 7
03.15 S Y1=Z;S X=X2;D 7
03.20 S Y2=Z;R
03.25 T !! "ONE REAL ROOT IS  "
03.30 IF (Y2)3.5,3.4,3.5
03.40 T X2;S XR=2;G 6.1
03.50 T X1;S XR=X1;G 6.1

04.10 S X=X2;D 7
04.12 S Y=Z
04.13 S X=X1
04.15 D 7
04.20 IF (FABS(X2-X)-.1)5.1,5.1,4.25
04.25 IF (Y*Z)4.3,4.6,4.4
04.30 S X1=X;G 4.5
04.40 S X2=X
04.50 S X=(X1+X2)/2;G 4.15
04.60 D 3.25;T X,!;S XR=X;G 6.1

05.10  XC=X
05.15 F I=1,N;S P(I)=AM(I)*(N-I+1)
05.20 S X=XC;D 7
05.25 S YA=Z
05.30 S YB=AP(1);F I=1,N-1;S YB=YB*X+AP(I+1)
05.40 S XN=XC-YA/YB
05.50 I (FABS(XN-XC)-.00001)5.7,5.7,5.6
05.60 S XC=XN;G 5.2
05.70 D 3.25;T XN,!;S XR=XN

06.10 S M=1;S B(1)=1;S B(2)=-XR
06.20  I=1,N+1;S G(I)=AM(I)
06.30 D 12
06.40 F I=1,N;S AM(I)=Q(I)
06.55 S N=N-1;I (N-2)6.6,6.6,1.7
06.60 S RQ=AM(2)*AM(2)-4*AM(1)*AM(3)
06.65 IF (RQ)6.8,6.7,6.7
06.70 S Q1=(-AM(2)+FSQT(RQ))/(2*AM(1))
06.71 S Q2=(-AM(2)-FSQT(RQ))/(2*AM(1))
06.75 T !! "ROOTS OF QUADRATIC ARE  "
06.77 T Q1,"    ",Q2,!;Q
06.80 S QR=-AM(2)/(2*AM(1))
06.81 S QI=FSQT(AM(3)-AM(2)*AM(2)/4*AM(1))
06.82 D 6.75
06.85 T   "REA PART   ",QR,"   IMAG PART    ",QI,!;Q

07.10 S Z=A
(1)
07.20 F I=1,N;S Z=Z*X+AM(I+1)
07.30 R

12.30 S LL=N-M+1
12.40 F I=1,LL;D 13
12.50 F I=1,M;S R(I)=G(N-M+I+1)
12.60 S L=M-1
10.70 IF (R(1)) 12.9,12.75,12.9
12.75 	F (L) 12.9,12.9,12.77
12.77 F I=1,L;S R()=R(I+1)
12.80 S L=L-1;G 12.7
12.90 R

13.10 S Q(I)=G(I)/B(1)
13.20 F J=1,M;D 14
13.30 R

14.10 S W=Q(I)*B(+1)
14.20 S G(I+J)=G(I+J)-W
14.30 IF (FABS(G(I+J))-.0001*FABS(W)) 14.4,14.4,14.5
14.40 S G(I+J)=0
14.50 R

16.01 T !! "BEGIN SOLUTION FOR COMPLEX ROOTS
16.05 S IR=1
16.10 S B(1)=1;S B(2)=0;S B(3)=0;S M=2;S JI=0
16.20 F I=1,N+1;S G(I)=AM(I)
16.30 D 12
16.35 F I=1,N-1;S QM(I)=Q(I)
16.37 F I=1,2;S RM(I)=R(I)
16.40 IF (RM(1)) 16.45,16.95,16.45
16.45 S QM(N)=RM(1);S QM(N+1)=RM(2)
16.50 F I=1,N+1;S G(I)=QM(I)
16.55 D 12
16.57 F I=1,N-1;S C(I)=Q(I)
16.58 F I=1,2;S T(I)=R(I)
16.60 S D=C(N-1)*(C(N-1)-B(2)*C(N-2))
16.65 S D=D-C(N2)*(T(1)-RM(1)-(2)*C(N-1))
16.70 IF (D) 16.75,16.72,16.75
16.72 S B(2)=B(2)+.1;S B(3)=B(3)+.1;G 16.85
16.75 S D2=(RM(1)*(C(N-1)+B(2)*C(N-2))-RM(2)*C(N-2))/D
16.77 S D3=(C(N-1)*RM(2)-RM(1)*(T(1)-RM(1)+B(2)*C(N-1)))/D
16.80 S B(2)=B(2)+D2;S B(3)=B(3)+D3
16.81 S X=ABS(D2)+FABS(D3);S Y=FABS(B(2))+FABS(B(3))
16.82 IF (X/Y-.0001) 16.95,16.95,16.85
16.85 S JI=JI+1
16.87 IF (100-J)16.9,16.2,16.2
16.90 T !!! "NO CONVERGENCE AFTER 100 ITERATIONS",Q
16.95 S P=B(2);S U=B(3)

17.05 S T1=(P^2-4*U);I (T1)17.1,17.6,17.6
17.10 S RP=-P/2;S IM=FSQT(U-P^2/4)
17.20 T !!! "COMPLEX ROOTS SET  ",%3.0,IR,%
17.25 T !! "REAL PART       ",RP
17.26 T ! "IMAGINARY PART       ",IM,!
17.28 IF (N-2) 17.9,17.9,17.3
17.30 F I=1,N+1; S G(I)=AM(I)
17.40 D 12
17.45 S IR=IR+1
17.50 S N=N-2; IF (N-2)17.8,17.8,17.55
17.55 F I=1,N+1;S AM(I)=Q(I)
17.57 G 16.1
17.60 S T1=FSQT(T1);S T2=(-P+T1)/2;S T3=(-P-T1)/2
17.65 D 3.25;T T2,!;D 3.25;T T3,!
17.70 F I=1,N+1;S G(I)=AM(I)
17.72 D 12
17.74 F I=1,N-1; S AM(I)=Q(I)
17.76 S N=N-2;G 1.7
17.80 S P=Q(2);S U=Q(3);G 17.1
17.90 Q
*