      SUBROUTINE DRPOLY(DEGREE,COEFF,ZEROR,ZEROI)
C
C FINDS THE ZEROS OF A POLYNOMIAL WITH REAL COEFFICIENTS.
C
C  INPUTS -
C
C     COEFF         -  DOUBLE PRECISION VECTOR OF THE COEFF-
C                      ICIENTS IN ORDER OF DECREASING POWERS.
C
C     DEGREE        -  INTEGER DEGREE OF POLYNOMIAL.
C
C  OUTPUTS -
C
C     ZEROR, ZEROI  -  DOUBLE PRECISION VECTORS OF REAL
C                      AND IMAGINARY PARTS OF THE ZEROS.
C
C THE SUBROUTINE USES SINGLE PRECISION CALCULATIONS
C FOR SCALING, BOUNDS AND ERROR CALCULATIONS. ALL
C CALCULATIONS FOR THE ITERATIONS ARE DONE IN DOUBLE
C PRECISION.
C
C
C  ERROR STATES -
C
C    1    - DEGREE IS LESS THAN 1
C    2    - LEADING COEFFICIENT IS ZERO
C    3    - THE DYNAMIC STORAGE STACK IS NOT BIG ENOUGH
C    NNN  - ONLY NNN (.LT. DEGREE) ZEROS HAVE BEEN
C          FOUND (RECOVERABLE)
C
C
C PORT NOTE -
C
C THE ORIGINAL PROGRAM HAS BEEN ADAPTED TO PORT BY -
C
C   (1) PUTTING IN AUTOMATIC ERROR HANDLING.
C   (2) SUBSTITUTING DYNAMIC STACK ALLOCATION FOR THE DIMENSIONED
C       ARRAYS IN NAMED COMMON.
C   (3) CHANGING THE NAMES OF THE INTERNAL ROUTINES TO AVOID USER
C       NAME CONFLICT.
C
C  THE FOLLOWING NAME EQUIVALENCES (ORIGINAL - NEW) APPLY -
C
C            RPOLY    -   D1RPLY
C            CALCSC   -   D2RPLY
C            FXSHFR   -   D3RPLY
C            NEWEST   -   D4RPLY
C            NEXTK    -   D5RPLY
C            QUAD     -   D6RPLY
C            QUADIT   -   D7RPLY
C            QUADSD   -   D8RPLY
C            REALIT   -   D9RPLY
C
C
C DYNAMIC STORAGE SPACE USED -
C
C    THE DRPOLY PROGRAMS USE 6*(DEGREE+1)
C    DOUBLE-PRECISION LOCATIONS PLUS 1*(DEGREE+1) REAL
C    LOCATIONS IN THE DYNAMIC STORAGE STACK.
C
C COMMON AREA
      COMMON/CSTAK/ISTAK
C
      INTEGER DEGREE
      REAL RSTAK(10000)
      DOUBLE PRECISION DSTAK(5000)
      INTEGER ISTAK(10000)
      DOUBLE PRECISION COEFF(1),ZEROR(1),ZEROI(1)
      LOGICAL FAIL
C
      INTEGER IK, IP, IPT, IQK, IQP, ISVK, ITEMP, KP10, NLEFT, NN, NNN
      INTEGER ISTKGT, ISTKQU
      EXTERNAL ISTKGT, ISTKQU
C
      EQUIVALENCE (ISTAK(1),DSTAK(1))
      EQUIVALENCE (ISTAK(1),RSTAK(1))
C
C THE DEGREE IS LESS THAN 1
C
C/6S
C     IF (DEGREE .LT. 1) CALL SETERR(
C    1   34HDRPOLY - THE DEGREE IS LESS THAN 1,34,1,2)
C/7S
      IF (DEGREE .LT. 1) CALL SETERR(
     1   'DRPOLY - THE DEGREE IS LESS THAN 1',34,1,2)
C/
C
C ALGORITHM FAILS IF THE LEADING COEFFICIENT IS ZERO.
C
C/6S
C     IF (COEFF(1) .EQ. 0.0D0) CALL SETERR(
C    1   36HDRPOLY - LEADING COEFFICIENT IS ZERO,36,2,2)
C/7S
      IF (COEFF(1) .EQ. 0.0D0) CALL SETERR(
     1   'DRPOLY - LEADING COEFFICIENT IS ZERO',36,2,2)
C/
C
C SET UP THE STORAGE IN THE DYNAMIC STORAGE STACK -
C IF THERE IS ROOM
C
      NN = DEGREE + 1
C
      NLEFT = ISTKQU(4) - 6*NN
C/6S
C     IF (NLEFT .LE. 0) CALL SETERR(
C    1   47HDRPOLY - THE DYNAMIC STORAGE LEFT IS NOT ENOUGH,47,3,2)
C/7S
      IF (NLEFT .LE. 0) CALL SETERR(
     1   'DRPOLY - THE DYNAMIC STORAGE LEFT IS NOT ENOUGH',47,3,2)
C/
C
      NNN = 6*NN
      IP    = ISTKGT(NNN,4)
      IQP   = IP   + NN
      IK    = IQP  + NN
      IQK   = IK   + NN
      ISVK  = IQK  + NN
      ITEMP = ISVK + NN
C
      NLEFT = ISTKQU(3) - 1*NN
C/6S
C     IF (NLEFT .LE. 0) CALL SETERR(
C    1   47HDRPOLY - THE DYNAMIC STORAGE LEFT IS NOT ENOUGH,47,3,2)
C/7S
      IF (NLEFT .LE. 0) CALL SETERR(
     1   'DRPOLY - THE DYNAMIC STORAGE LEFT IS NOT ENOUGH',47,3,2)
C/
C
      IPT   = ISTKGT(NN,4)
C
C
C  CALL THE JENKINS-TRAUB ROUTINE (OLD RPOLY IS NOW D1RPLY) WITH
C  THE STACK LOCATIONS INCLUDED IN THE CALL.
C
      CALL D1RPLY(COEFF,DEGREE,ZEROR,ZEROI,FAIL,
     1  DSTAK(IP),DSTAK(IQP),DSTAK(IK),DSTAK(IQK),DSTAK(ISVK),
     2  DSTAK(ITEMP),DSTAK(IPT))
C
C  SEE IF THE THING FAILED
C
      IF (.NOT. FAIL) GO TO 10
C
C  OTHERWISE FIGURE HOW MANY ROOTS WERE FOUND
C
      KP10 = DEGREE+10
C
C/6S
C     CALL SETERR(
C    1   37HDRPOLY - ONLY K ZEROS HAVE BEEN FOUND,37,KP10,1)
C/7S
      CALL SETERR(
     1   'DRPOLY - ONLY K ZEROS HAVE BEEN FOUND',37,KP10,1)
C/
C
  10  CALL ISTKRL(2)
      RETURN
      END
