      SUBROUTINE DXSET (IRAD, NRADPL, DZERO, NBITS, IERROR)
      INTEGER IRAD, NRADPL, NBITS
      DOUBLE PRECISION DZERO, DZEROX
      COMMON /DXBLK1/ NBITSF
      SAVE /DXBLK1/
      DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLG10R
      INTEGER L, L2, KMAX
      COMMON /DXBLK2/ RADIX, RADIXL, RAD2L, DLG10R, L, L2, KMAX
      SAVE /DXBLK2/
      INTEGER NLG102, MLG102, LG102
      COMMON /DXBLK3/ NLG102, MLG102, LG102(21)
      SAVE /DXBLK3/
      INTEGER IFLAG
      SAVE IFLAG
C
      DIMENSION LOG102(20), LGTEMP(20)
      SAVE LOG102
C
C   LOG102 CONTAINS THE FIRST 60 DIGITS OF LOG10(2) FOR USE IN
C CONVERSION OF EXTENDED-RANGE NUMBERS TO BASE 10 .
      DATA LOG102 /301,029,995,663,981,195,213,738,894,724,493,026,768,
     * 189,881,462,108,541,310,428/
C
C FOLLOWING CODING PREVENTS DXSET FROM BEING EXECUTED MORE THAN ONCE.
C THIS IS IMPORTANT BECAUSE SOME SUBROUTINES (SUCH AS DXNRMP AND
C DXLEGF) CALL DXSET TO MAKE SURE EXTENDED-RANGE ARITHMETIC HAS
C BEEN INITIALIZED. THE USER MAY WANT TO PRE-EMPT THIS CALL, FOR
C EXAMPLE WHEN I1MACH IS NOT AVAILABLE. SEE CODING BELOW.
      DATA IFLAG /0/
C***FIRST EXECUTABLE STATEMENT  DXSET
      IERROR=0
      IF (IFLAG .NE. 0) RETURN
      IRADX = IRAD
      NRDPLC = NRADPL
      DZEROX = DZERO
      IMINEX = 0
      IMAXEX = 0
      NBITSX = NBITS
C FOLLOWING 5 STATEMENTS SHOULD BE DELETED IF I1MACH IS
C NOT AVAILABLE OR NOT CONFIGURED TO RETURN THE CORRECT
C MACHINE-DEPENDENT VALUES.
      IF (IRADX .EQ. 0) IRADX = I1MACH (10)
      IF (NRDPLC .EQ. 0) NRDPLC = I1MACH (14)
      IF (DZEROX .EQ. 0.0D0) IMINEX = I1MACH (15)
      IF (DZEROX .EQ. 0.0D0) IMAXEX = I1MACH (16)
      IF (NBITSX .EQ. 0) NBITSX = I1MACH (8)
      IF (IRADX.EQ.2) GO TO 10
      IF (IRADX.EQ.4) GO TO 10
      IF (IRADX.EQ.8) GO TO 10
      IF (IRADX.EQ.16) GO TO 10
      CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF IRAD', 201, 1)
      IERROR=201
      RETURN
   10 CONTINUE
      LOG2R=0
      IF (IRADX.EQ.2) LOG2R = 1
      IF (IRADX.EQ.4) LOG2R = 2
      IF (IRADX.EQ.8) LOG2R = 3
      IF (IRADX.EQ.16) LOG2R = 4
      NBITSF=LOG2R*NRDPLC
      RADIX = IRADX
      DLG10R = LOG10(RADIX)
      IF (DZEROX .NE. 0.0D0) GO TO 14
      LX = MIN ((1-IMINEX)/2, (IMAXEX-1)/2)
      GO TO 16
   14 LX = 0.5D0*LOG10(DZEROX)/DLG10R
C RADIX**(2*L) SHOULD NOT OVERFLOW, BUT REDUCE L BY 1 FOR FURTHER
C PROTECTION.
      LX=LX-1
   16 L2 = 2*LX
      IF (LX.GE.4) GO TO 20
      CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF DZERO', 202, 1)
      IERROR=202
      RETURN
   20 L = LX
      RADIXL = RADIX**L
      RAD2L = RADIXL**2
C    IT IS NECESSARY TO RESTRICT NBITS (OR NBITSX) TO BE LESS THAN SOME
C UPPER LIMIT BECAUSE OF BINARY-TO-DECIMAL CONVERSION. SUCH CONVERSION
C IS DONE BY DXC210 AND REQUIRES A CONSTANT THAT IS STORED TO SOME FIXED
C PRECISION. THE STORED CONSTANT (LOG102 IN THIS ROUTINE) PROVIDES
C FOR CONVERSIONS ACCURATE TO THE LAST DECIMAL DIGIT WHEN THE INTEGER
C WORD LENGTH DOES NOT EXCEED 63. A LOWER LIMIT OF 15 BITS IS IMPOSED
C BECAUSE THE SOFTWARE IS DESIGNED TO RUN ON COMPUTERS WITH INTEGER WORD
C LENGTH OF AT LEAST 16 BITS.
      IF (15.LE.NBITSX .AND. NBITSX.LE.63) GO TO 30
      CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF NBITS', 203, 1)
      IERROR=203
      RETURN
   30 CONTINUE
      KMAX = 2**(NBITSX-1) - L2
      NB = (NBITSX-1)/2
      MLG102 = 2**NB
      IF (1.LE.NRDPLC*LOG2R .AND. NRDPLC*LOG2R.LE.120) GO TO 40
      CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF NRADPL', 204,
     +             1)
      IERROR=204
      RETURN
   40 CONTINUE
      NLG102 = NRDPLC*LOG2R/NB + 3
      NP1 = NLG102 + 1
C
C   AFTER COMPLETION OF THE FOLLOWING LOOP, IC CONTAINS
C THE INTEGER PART AND LGTEMP CONTAINS THE FRACTIONAL PART
C OF LOG10(IRADX) IN RADIX 1000.
      IC = 0
      DO 50 II=1,20
        I = 21 - II
        IT = LOG2R*LOG102(I) + IC
        IC = IT/1000
        LGTEMP(I) = MOD(IT,1000)
   50 CONTINUE
C
C   AFTER COMPLETION OF THE FOLLOWING LOOP, LG102 CONTAINS
C LOG10(IRADX) IN RADIX MLG102. THE RADIX POINT IS
C BETWEEN LG102(1) AND LG102(2).
      LG102(1) = IC
      DO 80 I=2,NP1
        LG102X = 0
        DO 70 J=1,NB
          IC = 0
          DO 60 KK=1,20
            K = 21 - KK
            IT = 2*LGTEMP(K) + IC
            IC = IT/1000
            LGTEMP(K) = MOD(IT,1000)
   60     CONTINUE
          LG102X = 2*LG102X + IC
   70   CONTINUE
        LG102(I) = LG102X
   80 CONTINUE
C
C CHECK SPECIAL CONDITIONS REQUIRED BY SUBROUTINES...
      IF (NRDPLC.LT.L) GO TO 90
      CALL XERMSG ('SLATEC', 'DXSET', 'NRADPL .GE. L', 205, 1)
      IERROR=205
      RETURN
   90 IF (6*L.LE.KMAX) GO TO 100
      CALL XERMSG ('SLATEC', 'DXSET', '6*L .GT. KMAX', 206, 1)
      IERROR=206
      RETURN
  100 CONTINUE
      IFLAG = 1
      RETURN
      END
