      DOUBLE PRECISION FUNCTION D1MACH(I)

C  DOUBLE-PRECISION MACHINE CONSTANTS (SEE R1MACH FOR DOCUMENTATION)

C  FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST
C  TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE.

      INTEGER SMALL(4), LARGE(4), RIGHT(4), DIVER(4), LOG10(4), SC
      DOUBLE PRECISION DMACH(5), EPS, EPSNEW, S

      EQUIVALENCE (DMACH(1),SMALL(1)), (DMACH(2),LARGE(1)),
     $            (DMACH(3),RIGHT(1)), (DMACH(4),DIVER(1)),
     $            (DMACH(5),LOG10(1))

      LOGICAL  PASS1
      SAVE     PASS1
      DATA     PASS1/.TRUE./

C IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T 3B SERIES AND
C MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T PC 7300),
C IN WHICH THE MOST SIGNIFICANT BYTE IS STORED FIRST.
cj HP, SUN and SIG are big-endian

      DATA (SMALL(N),N=1,2)/1048576,0/, (LARGE(N),N=1,2)/2146435071,-1/,
     $  (RIGHT(N),N=1,2)/1017118720,0/, (DIVER(N),N=1,2)/1018167296,0/,
     $  (LOG10(N),N=1,2)/1070810131,1352628735/, SC/987/

C IEEE ARITHMETIC MACHINES AND 8087-BASED MICROS, SUCH AS THE IBM PC
C AND AT&T 6300, IN WHICH THE LEAST SIGNIFICANT BYTE IS STORED FIRST.
cj ie. little-endian

cj      DATA (SMALL(N),N=1,2)/0,1048576/, (LARGE(N),N=1,2)/-1,2146435071/,
cj     $  (RIGHT(N),N=1,2)/0,1017118720/, (DIVER(N),N=1,2)/0,1018167296/,
cj     $  (LOG10(N),N=1,2)/1352628735,1070810131/, SC/987/

C AMDAHL MACHINES.

C      DATA (SMALL(N),N=1,2)/1048576,0/, (LARGE(N),N=1,2)/2147483647,-1/,
C     $ (RIGHT(N),N=1,2)/856686592,0/, (DIVER(N),N=1,2)/ 873463808,0/,
C     $ (LOG10(N),N=1,2)/1091781651,1352628735/, SC/987/

C BURROUGHS 1700 SYSTEM.

C      DATA (SMALL(N),N=1,2)/ZC00800000,Z000000000/,
C     $ (LARGE(N),N=1,2)/ZDFFFFFFFF,ZFFFFFFFFF/,
C     $ (RIGHT(N),N=1,2)/ZCC5800000,Z000000000/,
C     $ (DIVER(N),N=1,2)/ZCC6800000,Z000000000/,
C     $ (LOG10(N),N=1,2)/ZD00E730E7,ZC77800DC0/, SC/987/

C BURROUGHS 5700 SYSTEM.

C      DATA (SMALL(N),N=1,2)/O1771000000000000,O0000000000000000/,
C     $  (LARGE(N),N=1,2)/O0777777777777777,O0007777777777777/,
C     $  (RIGHT(N),N=1,2)/O1461000000000000,O0000000000000000/,
C     $  (DIVER(N),N=1,2)/O1451000000000000,O0000000000000000/,
C     $  (LOG10(N),N=1,2)/O1157163034761674,O0006677466732724/, SC/987/

C BURROUGHS 6700/7700 SYSTEMS.

C      DATA (SMALL(N),N=1,2)/O1771000000000000,O7770000000000000/,
C     $  (LARGE(N),N=1,2)/O0777777777777777,O7777777777777777/,
C     $  (RIGHT(N),N=1,2)/O1461000000000000,O0000000000000000/,
C     $  (DIVER(N),N=1,2)/O1451000000000000,O0000000000000000/,
C     $  (LOG10(N),N=1,2)/O1157163034761674,O0006677466732724/, SC/987/

C FTN4 ON THE CDC 6000/7000 SERIES.

C      DATA
C     $  (SMALL(N),N=1,2)/00564000000000000000B,00000000000000000000B/,
C     $  (LARGE(N),N=1,2)/37757777777777777777B,37157777777777777774B/,
C     $  (RIGHT(N),N=1,2)/15624000000000000000B,00000000000000000000B/,
C     $  (DIVER(N),N=1,2)/15634000000000000000B,00000000000000000000B/,
C     $  (LOG10(N),N=1,2)/17164642023241175717B,16367571421742254654B/,
C     $  SC/987/

C FTN5 ON THE CDC 6000/7000 SERIES.

C      DATA
C     $(SMALL(N),N=1,2)/O"00564000000000000000",O"00000000000000000000"/,
C     $(LARGE(N),N=1,2)/O"37757777777777777777",O"37157777777777777774"/,
C     $(RIGHT(N),N=1,2)/O"15624000000000000000",O"00000000000000000000"/,
C     $(DIVER(N),N=1,2)/O"15634000000000000000",O"00000000000000000000"/,
C     $(LOG10(N),N=1,2)/O"17164642023241175717",O"16367571421742254654"/,
C     $ SC/987/

C CONVEX C-1

C      DATA (SMALL(N),N=1,2)/'00100000'X,'00000000'X/,
C     $  (LARGE(N),N=1,2)/'7FFFFFFF'X,'FFFFFFFF'X/,
C     $  (RIGHT(N),N=1,2)/'3CC00000'X,'00000000'X/,
C     $  (DIVER(N),N=1,2)/'3CD00000'X,'00000000'X/,
C     $  (LOG10(N),N=1,2)/'3FF34413'X,'509F79FF'X/, SC/987/

C CRAY 1, XMP, 2, AND 3.

C      DATA
C     $ (SMALL(N),N=1,2)/201354000000000000000B,000000000000000000000B/,
C     $ (LARGE(N),N=1,2)/577767777777777777777B,000007777777777777776B/,
C     $ (RIGHT(N),N=1,2)/376434000000000000000B,000000000000000000000B/,
C     $ (DIVER(N),N=1,2)/376444000000000000000B,000000000000000000000B/,
C     $ (LOG10(N),N=1,2)/377774642023241175717B,000007571421742254654B/,
C     $ SC/987/

C DATA GENERAL ECLIPSE S/200
C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE -
C STATIC DMACH(5)

C      DATA SMALL/20K,3*0/, LARGE/77777K,3*177777K/,
C     $  RIGHT/31420K,3*0/, DIVER/32020K,3*0/,
C     $  LOG10/40423K,42023K,50237K,74776K/, SC/987/

C HARRIS SLASH 6 AND SLASH 7

C      DATA (SMALL(N),N=1,2)/'20000000,'00000201/,
C     $  (LARGE(N),N=1,2)/'37777777,'37777577/,
C     $  (RIGHT(N),N=1,2)/'20000000,'00000333/,
C     $  (DIVER(N),N=1,2)/'20000000,'00000334/,
C     $  (LOG10(N),N=1,2)/'23210115,'10237777/, SC/987/

C HONEYWELL DPS 8/70 SERIES.

C      DATA (SMALL(N),N=1,2)/O402400000000,O000000000000/,
C     $  (LARGE(N),N=1,2)/O376777777777,O777777777777/,
C     $  (RIGHT(N),N=1,2)/O604400000000,O000000000000/,
C     $  (DIVER(N),N=1,2)/O606400000000,O000000000000/,
C     $  (LOG10(N),N=1,2)/O776464202324,O117571775714/, SC/987/

C IBM 360/370 SERIES, XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86.

C      DATA (SMALL(N),N=1,2)/Z00100000,Z00000000/,
C     $  (LARGE(N),N=1,2)/Z7FFFFFFF,ZFFFFFFFF/,
C     $  (RIGHT(N),N=1,2)/Z33100000,Z00000000/,
C     $  (DIVER(N),N=1,2)/Z34100000,Z00000000/,
C     $  (LOG10(N),N=1,2)/Z41134413,Z509F79FF/, SC/987/

C INTERDATA 8/32 WITH THE UNIX SYSTEM FORTRAN 77 COMPILER.
C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE
C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S.

C      DATA (SMALL(N),N=1,2)/Z'00100000',Z'00000000'/,
C     $  (LARGE(N),N=1,2)/Z'7EFFFFFF',Z'FFFFFFFF'/,
C     $  (RIGHT(N),N=1,2)/Z'33100000',Z'00000000'/,
C     $  (DIVER(N),N=1,2)/Z'34100000',Z'00000000'/,
C     $  (LOG10(N),N=1,2)/Z'41134413',Z'509F79FF'/, SC/987/

C PDP-10 (KA PROCESSOR).

C      DATA (SMALL(N),N=1,2)/"033400000000,"000000000000/,
C     $  (LARGE(N),N=1,2)/"377777777777,"344777777777/,
C     $  (RIGHT(N),N=1,2)/"113400000000,"000000000000/,
C     $  (DIVER(N),N=1,2)/"114400000000,"000000000000/,
C     $  (LOG10(N),N=1,2)/"177464202324,"144117571776/, SC/987/

C PDP-10 (KI PROCESSOR).

C      DATA (SMALL(N),N=1,2)/"000400000000,"000000000000/,
C     $  (LARGE(N),N=1,2)/"377777777777,"377777777777/,
C     $  (RIGHT(N),N=1,2)/"103400000000,"000000000000/,
C     $  (DIVER(N),N=1,2)/"104400000000,"000000000000/,
C     $  (LOG10(N),N=1,2)/"177464202324,"047674776746/, SC/987/

C PDP-11 FORTRANS SUPPORTING 32-BIT INTEGERS
C (EXPRESSED IN INTEGER AND OCTAL).

C      DATA (SMALL(N),N=1,2)/8388608,0/, (LARGE(N),N=1,2)/2147483647,-1/,
C     $  (RIGHT(N),N=1,2)/612368384,0/, (DIVER(N),N=1,2)/620756992,0/,
C     $  (LOG10(N),N=1,2)/1067065498,-2063872008/, SC/987/

C      DATA (SMALL(N),N=1,2)/O00040000000,O00000000000/,
C     $  (LARGE(N),N=1,2)/O17777777777,O37777777777/,
C     $  (RIGHT(N),N=1,2)/O04440000000,O00000000000/,
C     $  (DIVER(N),N=1,2)/O04500000000,O00000000000/,
C     $  (LOG10(N),N=1,2)/O07746420232,O20476747770/, SC/987/

C PDP-11 FORTRANS SUPPORTING 16-BIT INTEGERS
C (EXPRESSED IN INTEGER AND OCTAL).

C      DATA SMALL/128,3*0/, LARGE/32767,3*-1/, RIGHT/9344,3*0/,
C     $  DIVER/9472,3*0/, LOG10/16282,8346,-31493,-12296/, SC/987/

C      DATA SMALL/O000200,3*O000000/, LARGE/O077777,3*O177777/,
C     $  RIGHT/O022200,3*O000000/, DIVER/O022400,3*O000000/,
C     $  LOG10/O037632,O020232,O102373,O147770/, SC/987/

C PRIME 50 SERIES SYSTEMS WITH 32-BIT INTEGERS AND 64V MODE
C INSTRUCTIONS, SUPPLIED BY IGOR BRAY.

C      DATA (SMALL(N),N=1,2)/:10000000000,:00000100001/,
C     $  (LARGE(N),N=1,2)/:17777777777,:37777677775/,
C     $  (RIGHT(N),N=1,2)/:10000000000,:00000000122/,
C     $  (DIVER(N),N=1,2)/:10000000000,:00000000123/,
C     $  (LOG10(N),N=1,2)/:11504046501,:07674600177/, SC/987/

C SEQUENT BALANCE 8000

C      DATA (SMALL(N),N=1,2)/$00000000, $00100000/,
C     $  (LARGE(N),N=1,2)/$FFFFFFFF, $7FEFFFFF/,
C     $  (RIGHT(N),N=1,2)/$00000000, $3CA00000/,
C     $  (DIVER(N),N=1,2)/$00000000, $3CB00000/,
C     $  (LOG10(N),N=1,2)/$509F79FF, $3FD34413/, SC/987/

C UNIVAC 1100 SERIES.

C      DATA (SMALL(N),N=1,2)/O000040000000,O000000000000/,
C     $  (LARGE(N),N=1,2)/O377777777777,O777777777777/,
C     $  (RIGHT(N),N=1,2)/O170540000000,O000000000000/,
C     $  (DIVER(N),N=1,2)/O170640000000,O000000000000/,
C     $  (LOG10(N),N=1,2)/O177746420232,O411757177572/, SC/987/

C VAX UNIX F77 COMPILER

C      DATA (SMALL(N),N=1,2)/128,0/, (LARGE(N),N=1,2)/-32769,-1/,
C     $  (RIGHT(N),N=1,2)/9344,0/, (DIVER(N),N=1,2)/9472,0/,
C     $  (LOG10(N),N=1,2)/546979738,-805796613/, SC/987/

C VAX-11 WITH FORTRAN IV-PLUS COMPILER

C      DATA (SMALL(N),N=1,2)/Z00000080,Z00000000/,
C     $  (LARGE(N),N=1,2)/ZFFFF7FFF,ZFFFFFFFF/,
C     $  (RIGHT(N),N=1,2)/Z00002480,Z00000000/,
C     $  (DIVER(N),N=1,2)/Z00002500,Z00000000/,
C     $  (LOG10(N),N=1,2)/Z209A3F9A,ZCFF884FB/, SC/987/

C VAX/VMS VERSION 2.2

C      DATA (SMALL(N),N=1,2)/'80'X,'0'X/,
C     $  (LARGE(N),N=1,2)/'FFFF7FFF'X,'FFFFFFFF'X/,
C     $  (RIGHT(N),N=1,2)/'2480'X,'0'X/, (DIVER(N),N=1,2)/'2500'X,'0'X/,
C     $  (LOG10(N),N=1,2)/'209A3F9A'X,'CFF884FB'X/, SC/987/

      IF( PASS1 )  THEN

         PASS1 = .FALSE.
         IF (SC.NE.987)
     $       CALL ERRMSG( 'D1MACH--NO DATA STATEMENTS ACTIVE',.TRUE.)

C                        ** CALCULATE MACHINE PRECISION
         EPSNEW = 0.01D0
   10    EPS = EPSNEW
            EPSNEW = EPSNEW / 1.1D0
C                               ** IMPORTANT TO STORE 'S' SINCE MAY BE
C                               ** KEPT IN HIGHER PRECISION IN REGISTERS
            S = 1.D0 + EPSNEW
            IF( S.GT.1.D0 ) GO TO 10
         IF( EPS/DMACH(4).LT.0.5D0 .OR. EPS/DMACH(4).GT.2.D0 )
     $       CALL ERRMSG( 'D1MACH--TABULATED PRECISION WRONG',.TRUE.)

      END IF

      IF (I.LT.1.OR.I.GT.5)
     $    CALL ERRMSG( 'D1MACH--ARGUMENT OUT OF BOUNDS',.TRUE.)
      D1MACH = DMACH(I)
      RETURN
      END
