Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0026/smprt.smp
There are 2 other files named smprt.smp in the archive. Click here to see a list.
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