File: SMPRT.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C	SAMPLE PROGRAM FOR REAL AND COMPLEX ROOTS OF A REAL POLY-
C	NOMIAL - SMPRT
	DIMENSION A(37),W(37),ROOTR(37),ROOTI(37)
10	FORMAT(1X,I4,3X,I2)
30	FORMAT(////62H REAL AND COMPLEX ROOTS OF A POLYNOMIAL USING SUBROU
	1TINE POLRT///17H FOR POLYNOMIAL  ,I4,2X,10HOF ORDER  ,I2//27H THE 
	2INPUT COEFFICIENTS ARE//)
40	FORMAT(7F10.0)
50	FORMAT(6E16.7)
65	FORMAT(////34H ORDER OF POLYNOMIAL LESS THAN ONE)
77	FORMAT(////36H ORDER OF POLYNOMIAL GREATER THAN 36)
79	FORMAT(////31H HIGH ORDER COEFFICIENT IS ZERO)
85	FORMAT(////50H UNABLE TO DETERMINE ROOT. THOSE ALREADY FOUND ARE)
95	FORMAT(////5X,9HREAL ROOT,6X,12HCOMPLEX ROOT//)
97	FORMAT(2E16.7)
C  **MX IS OUTPUT CHANNEL, MY IS INPUT CHANNEL
	MX=2
	MY=1
5	READ(MY,10) ID,IORD
	IF(ID+IORD) 100,100,20
20	WRITE(MX,30) ID,IORD
	J=IORD+1
	READ(MY,40) (A(I),I=1,J)
	WRITE(MX,50) (A(I),I=1,J)
	CALL POLRT(A,W,IORD,ROOTR,ROOTI,IER)
	IF(IER-1) 90,60,70
60	WRITE(MX,65)
	GO TO 5
70	IF(IER-3) 75,80,78
75	WRITE(MX,77)
	GO TO 5
78	WRITE(MX,79)
	GO TO 5
80	WRITE(MX,85)
90	WRITE(MX,95)
	DO 96 I=1,IORD
96	WRITE(MX,97)ROOTR(I),ROOTI(I)
	GO TO 5
100	STOP
	END

---