Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0025/rooter.bas
There are 2 other files named rooter.bas in the archive. Click here to see a list.
10	DATA 1,3,6
11	DATA 2,1,-6,5
12	DATA 3,3,-7,0,4
305	 DIM A(25),B(25),X(25)
310	LET G8=0
315	PRINT
320	LET G8=G8+1
325	PRINT
330	 READ N
335	IF N=0 THEN 999
340	PRINT
345	PRINT "POLYNOMIAL NUMBER";G8;"IS OF ORDER";N
350	PRINT
355	PRINT "   COEFFICIENTS (IN DESCENDING ORDER) ARE:"
360	PRINT
365	PRINT "      ";
370	 FOR I=0 TO N
375	READ A(I)
380	  PRINT A(I);
385	 LET B(I)=A(I)
390	NEXT I
395	PRINT
400	 PRINT
405	PRINT "   THE ROOTS ARE:"
410	 PRINT
415	 IF N<=2 THEN 665
420	 IF A(N) = 0 THEN 705
425	 IF (N/2-INT(N/2))=0 THEN 440
430	 GOSUB 745
435	 GOTO 415
440	 IF ABS(A(N-2))< 1.E-25 THEN 460
445	 LET P=A(N-1)/A(N-2)
450	LET Q=A(N)/A(N-2)
455	 GOTO 470
460	 LET P=A(N-1)
465	 LET Q=A(N)
470	FOR I = 0 TO N
475	LET X(I)=A(I)
480	NEXT I
485	GOSUB 720
490	 FOR I = 0 TO N-2
495	 LET B(I)=X(I)
500	 NEXT I
505	LET R=X(N-1)
510	LET S=A(N)-P*X(N-1)-Q*X(N-2)
515	GOSUB 720
520	 LET X(N-1)=-P*X(N-2)-Q*X(N-3)
525	 LET D=X(N-2)^2-X(N-1)*X(N-3)
530	 IF ABS(D ) > 1.E-25 THEN 545
535	PRINT "       UNOBTAINABLE WITH THIS PROGRAM.  SORRY ABOUT THAT."
540	 GOTO 315
545	 LET P1=P+(R*X(N-2)-S*X(N-3))/D
550	 LET Q1=Q+(S*X(N-2)-R*X(N-1))/D
555	 IF ABS(P ) > 1.E-25 THEN 575
560	 IF ABS(P1) > 1.E-25 THEN 575
565	 IF ABS( Q) > 1.E-25 THEN 580
570	 GOTO 585
575	 IF ABS(P1/P-1)>.000001 THEN 585
580	 IF ABS(Q1/Q-1)<.000001 THEN 600
585	 LET P=P1
590	LET Q=Q1
595	 GOTO 470
600	 FOR I=1 TO N-2
605	LET A(I)=B(I) 
610	 NEXT I
615	 LET  N=N-2
620	 LET D=P*P-4*Q
625	 IF D<0 THEN 650
630	 LET D=SQR(D)
635	PRINT "      ";(-P+D)/2;" AND  ";(-P-D)/2
640	IF N-2>0 THEN 420
645	 GOTO 665
650	 LET D=SQR(-D)
655	PRINT "      ";-P/2;"+ J *";D/2;" AND  ";-P/2;"- J *";D/2
660	 IF N-2>0 THEN 420
665	 IF N=1 THEN 695
670	IF N=0 THEN 315
675	 LET P=B(1)/B(0)
680	 LET Q=B(2)/B(0)
685	 LET N=0
690	 GOTO 620
695	PRINT "      ";-B(1)/B(0)
700	GOTO 315
705	PRINT "       0.00000"
710	 LET N=N-1
715	GOTO 415
720	LET X(1)=X(1)-P*X(0)
725	 FOR I=2 TO N-1
730	 LET X(I)=X(I)-P*X(I-1)-Q*X(I-2)
735	 NEXT I
740	 RETURN
745	 IF B(1) = 0 THEN 760
750	 LET X=-B(1)/B(0)
755	 GOTO 765
760	 LET X=-B(N)/B(0)
765	 LET F=0
770	 LET F1=0
775	 FOR I=0 TO N
780	 LET J=N-I
785	 IF B(J)=0 THEN 805
790	 LET F=B(J)*X^I+F
795	 IF I = 0 THEN 805
800	 LET F1=I*B(J)*X^(I-1)+F1
805	 NEXT I
810	 LET X1=X-F/F1
815	 IF ABS(X/X1-1) < .000001 THEN 830
820	 LET X=X1
825	 GOTO 765
830	PRINT "      ";X1
835	 LET N=N-1
840	 FOR I=1 TO N
845	 LET A(I)=B(I)+X1*A(I-1)
850	 LET B(I)=A(I)
855	 NEXT I
860	 RETURN
865	STOP
870	PRINT
875	PRINT "THIS PROGRAM FINDS THE ROOTS OF POLYNOMIALS"
880	PRINT "USING BAIRSTOW'S METHOD.  TO USE, ENTER DATA"
885	PRINT "IN DATA STATEMENTS AS FOLLOWS:"
890	PRINT
895	PRINT "   10 DATA  N, A(N), A(N-1),......, A(1), A(0)"
900	PRINT
905	PRINT "WHERE N IS THE ORDER OF THE POLYNOMIAL AND"
910	PRINT "A(I) IS THE COEFFICIENT OF THE I-TH DEGREE"
915	PRINT "TERM.  MORE THAN ONE DATA LINE MAY BE USED"
920	PRINT "TO SUPPLY COEFFICIENTS FOR ONE POLYNOMIAL,"
925	PRINT "AND ADDITIONAL POLYNOMIALS MAY BE SOLVED ON"
930	PRINT "A SINGLE RUN BY SUPPLYING DATA FOR THEM ON"
935	PRINT "SUBSEQUENT DATA LINES (NOT BEYOND LINE 299)."
940	PRINT
945	PRINT "CAUTION:  THERE ARE A FEW TYPES OF POLYNOMIALS"
950	PRINT "WHICH THIS PROGRAM IS UNABLE TO SOLVE.  PROGRAM"
955	PRINT "WILL SO INDICATE AND GO ON TO NEXT CASE.  ALSO,"
960	PRINT "FOR HIGH ORDER POLYNOMIALS, PROGRAM MAY REQUIRE"
965	PRINT "MANY ITERATIONS, SO RUNNING TIME CAN BE HIGH."
975	PRINT"ENTER DATA BEGINNING ON LINE 10 THEN TYPE 'RUN'"
998	DATA 0
999	END