SUBROUTINE MACHAR(IBETA,IT,IRND,NGRD,MACHEP,NEGEP,IEXP,MINEXP,
     1                    MAXEXP,EPS,EPSNEG,XMIN,XMAX)
C
      DOUBLE PRECISION A,B,BETA,BETAIN,BETAM1,EPS,EPSNEG,ONE,XMAX,
     1                  XMIN,Y,Z,ZERO
C
      ONE = DBLE(FLOAT(1))
      ZERO = 0.0D0
      A = ONE
   10 A = A + A
         IF (((A+ONE)-A)-ONE .EQ. ZERO) GO TO 10
      B = ONE
   20 B = B + B
         IF ((A+B)-A .EQ. ZERO) GO TO 20
      IBETA = IDINT((A+B)-A)
      BETA = DBLE(FLOAT(IBETA))
      IT = 0
      B = ONE
  100 IT = IT + 1
         B = B * BETA
         IF (((B+ONE)-B)-ONE .EQ. ZERO) GO TO 100
      IRND = 0
      BETAM1 = BETA - ONE
      IF ((A+BETAM1)-A .NE. ZERO) IRND = 1
      NEGEP = IT + 3
      BETAIN = ONE / BETA
      A = ONE
      DO 200 I = 1, NEGEP
         A = A * BETAIN
  200 CONTINUE
      B = A
  210 IF ((ONE-A)-ONE .NE. ZERO) GO TO 220
         A = A * BETA
         NEGEP = NEGEP - 1
      GO TO 210
  220 NEGEP = -NEGEP
      EPSNEG = A
      IF ((IBETA .EQ. 2) .OR. (IRND .EQ. 0)) GO TO 300
      A = (A*(ONE+A)) / (ONE+ONE)
      IF ((ONE-A)-ONE .NE. ZERO) EPSNEG = A
  300 MACHEP = -IT-3
      A = B
  310 IF ((ONE+A)-ONE .NE. ZERO) GO TO 320
         A = A * BETA
         MACHEP = MACHEP + 1
      GO TO 310
  320 EPS = A
      IF ((IBETA .EQ. 2) .OR. (IRND .EQ. 0)) GO TO 350
      A = (A*(ONE+A)) / (ONE+ONE)
      IF ((ONE+A)-ONE .NE. ZERO) EPS = A
  350 NGRD = 0
      IF ((IRND .EQ. 0) .AND. ((ONE+EPS)*ONE-ONE) .NE. ZERO) NGRD = 1
      I = 0
      K = 1
      Z = BETAIN
  400 Y = Z
         Z = Y * Y
         A = Z * ONE
         IF ((A+A .EQ. ZERO) .OR. (ABS(Z) .GE. Y)) GO TO 410
         I = I + 1
         K = K + K
      GO TO 400
  410 IF (IBETA .EQ. 10) GO TO 420
      IEXP = I + 1
      MX = K + K
      GO TO 450
  420 IEXB = 2
      IZ = BETA
  430 IF (K .LT. Z) GO TO 440
         IZ = IZ * IBETA
         IEXP = IEXP + 1
      GO TO 430
  440 MX = IZ + IZ - 1
  450 XMIN = Y
         Y = Y * BETAIN
         A = Y * ONE
         IF (((A+A) .EQ. ZERO) .OR. (ABS(Y) .GE. XMIN)) GO TO 460
         K = K + 1
      GO TO 450
  460 MINEXP = -K
      IF ((MX .GT. K+K-3) .OR. (IBETA .EQ. 10)) GO TO 500
      MX = MX + MX
      IEXP = IEXP + 1
  500 MAXEXP = MX + MINEXP
      I = MAXEXP + MINEXP
      IF ((IBETA .EQ. 2) .AND. (I .EQ. 0)) MAXEXP = MAXEXP - 1
      IF (I .GT. 20) MAXEXP = MAXEXP - 1
      IF (A .NE. Y) MAXEXP = MAXEXP - 2
      XMAX = ONE - EPSNEG
      IF (XMAX*ONE .NE. XMAX) XMAX = ONE - BETA * EPSNEG
      XMAX = XMAX / (BETA * BETA * BETA * XMIN)
      I = MAXEXP + MINEXP + 3
      IF (I .LE. 0) GO TO 520
      DO 510 J = 1, I
         IF (IBETA .EQ. 2) XMAX = XMAX + XMAX
         IF (IBETA .NE. 2) XMAX = XMAX * BETA
  510 CONTINUE
  520 RETURN
C ---------- LAST CAR OF MACHAR ----------
      END

.