$JOB SMPRT[30,30]
$FORTRAN SMPRT
C SMPR 10
C ..................................................................SMPR 20
C SMPR 30
C SAMPLE PROGRAM FOR REAL AND COMPLEX ROOTS OF A REAL POLY- SMPR 40
C NOMIAL - SMPRT SMPR 50
C SMPR 60
C PURPOSE SMPR 70
C COMPUTES THE REAL AND COMPLEX ROOTS OF A REAL POLYNOMIAL SMPR 80
C WHOSE COEFFICIENTS ARE INPUT. SMPR 90
C SMPR 100
C REMARKS SMPR 110
C THE ORDER OF THE POLYNOMIAL MUST BE GREATER THAN ONE AND SMPR 120
C LESS THAN THIRTY SEVEN SMPR 130
C SMPR 140
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED SMPR 150
C POLRT SMPR 160
C SMPR 170
C METHOD SMPR 180
C READS A CONTROL CARD CONTAINING THE IDENTIFICATION CODE AND SMPR 190
C THE ORDER OF THE POLYNOMIAL WHOSE COEFFICIENTS ARE SMPR 200
C CONTAINED ON THE FOLLOWING DATA CARDS. THE COEFFICIENTS SMPR 210
C ARE THEN READ AND THE ROOTS ARE COMPUTED. SMPR 220
C MORE THAN ONE CONTROL CARD AND CORRESPONDING DATA CAN BE SMPR 230
C PROCESSED. EXECUTION IS TERMINATED BY A BLANK CONTROL CARD. SMPR 240
C SMPR 250
C ..................................................................SMPR 260
C SMPR 270
DIMENSION A(37),W(37),ROOTR(37),ROOTI(37) SMPR 280
C SMPR 290
C ...............................................................SMPR 300
C SMPR 310
C IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE SMPR 320
C C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION SMPR 330
C STATEMENT WHICH FOLLOWS. SMPR 340
C SMPR 350
C DOUBLE PRECISION A,W,ROOTR,ROOTI SMPR 360
C SMPR 370
C THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS SMPR 380
C APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS SMPR 390
C ROUTINE. SMPR 400
C SMPR 410
C ...............................................................SMPR 420
C SMPR 430
5 READ(5,10)ID,IORD SMPR 440
10 FORMAT(1X,I4,3X,I2) SMPR 450
IF(ID+IORD)100,100,20 SMPR 460
20 WRITE(6,30)ID,IORD SMPR 470
30 FORMAT(1H1,61HREAL AND COMPLEX ROOTS OF A POLYNOMIAL USING SUBROUTSMPR 480
1INE POLRT/// 17H FOR POLYNOMIAL ,I4,2X,10HOF ORDER ,I2//1H , SMPR 490
226HTHE INPUT COEFFICIENTS ARE,//) SMPR 500
J=IORD+1 SMPR 510
READ(5,40)(A(I),I=1,J) SMPR 520
40 FORMAT(7F10.0) SMPR 530
WRITE(6,50)(A(I),I=1,J) SMPR 540
50 FORMAT(6E16.7) SMPR 550
CALL POLRT(A,W,IORD,ROOTR,ROOTI,IER) SMPR 560
IF(IER-1)90,60,70 SMPR 570
60 WRITE(6,65) SMPR 580
65 FORMAT(//1H ,33HORDER OF POLYNOMIAL LESS THAN ONE) SMPR 590
GO TO 5 SMPR 600
70 IF(IER-3)75,80,78 SMPR 610
75 WRITE(6,77) SMPR 620
77 FORMAT(//1H ,35HORDER OF POLYNOMIAL GREATER THAN 36) SMPR 630
GO TO 5 SMPR 640
78 WRITE(6,79) SMPR 650
79 FORMAT(//1H ,31H HIGH ORDER COEFFICIENT IS ZERO) SMPR 660
GO TO 5 SMPR 670
80 WRITE(6,85) SMPR 680
85 FORMAT(//1H ,49HUNABLE TO DETERMINE ROOT. THOSE ALREADY FOUND ARE)SMPR 690
90 WRITE(6,95) SMPR 700
95 FORMAT(//1H ,5X,9HREAL ROOT,6X,12HCOMPLEX ROOT//) SMPR 710
DO 96 I=1,IORD SMPR 720
96 WRITE(6,97)ROOTR(I),ROOTI(I) SMPR 730
97 FORMAT(1H ,2E16.7) SMPR 740
GO TO 5 SMPR 750
100 RETURN SMPR 760
END SMPR 770
$DECK SMP.CDR
360 9 20
-1.0 1.0 30
1.0 40
50
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR SMP
.EXECUTE/REL SMPRT,WES:SSP/LIB
%FIN::
.DELETE SMP.CDR