REAL FUNCTION DGAMIT ( A, X )

Argument Definitions (+ indicates altered content)
REAL*8             A,          X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
evaluate tricomi-s incomplete gamma function defined by 
 
gamit = x**(-a)/gamma(a) * integral t = 0 to x of exp(-t) * 
t**(a-1.) 
and analytic continuation for a .le. 0.0.  gamma(x) is the 
complete gamma function of x.  gamit is evaluated for arbitrary 
real values of a and for non-negative values of x (even though 
gamit is defined for x .lt. 0.0). 
a slight deterioration of 2 or 3 digits accuracy will occur when 
gamit is very large or very small in absolute value, because 
logarithmic variables are used.  also, if the parameter a is very 
close to a negative integer (but not a negative integer), there is 
a loss of accuracy, which is reported if the result is less than 
half machine precision. 
 
ref. -- w. gautschi, an evaluation procedure for incomplete gamma 
functions, acm trans. math. software.
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DSIGN
GENERIC            ABS,        EXP
GENERIC*4          LOG
GENERIC            SQRT
External Functions and Subroutines Called
REAL*8             D1MACH,     D9GMIT,     D9LGIC,     D9LGIT
REAL*8             DGAMR,      DINT,       DLNGAM
SUBROUTINE         DLGAMS,     ERROFF,     SETERU
Local Variables (+ indicates altered content)
REAL*8            +AEPS,      +AINTA,      ALGAP1,    +ALNEPS
REAL*8            +ALNG,      +ALX,       +BOT,       +H
REAL*8            +SGA,        SGNGAM,    +SQEPS,     +T

REAL FUNCTION CSEVL ( X, CS, N )

Argument Definitions (+ indicates altered content)
INTEGER            N
REAL               CS(*),      X
Description
april 1977 version.  w. fullerton, c3, los alamos scientific lab. 
 
evaluate the n-term chebyshev series cs at x.  adapted from 
r. broucke, algorithm 446, c.a.c.m., 16, 254 (1973).  also see fox 
and parker, chebyshev polys in numerical analysis, oxford press, p.56. 
 
input arguments -- 
   x      value at which the series is to be evaluated. 
   cs     array of n terms of a chebyshev series.  in eval- 
          uating cs, only half the first coef is summed. 
   n      number of terms in array cs.
Source file:dgamit.f
External Functions and Subroutines Called
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +NI
REAL              +B0,        +B1,        +B2,        +TWOX

SUBROUTINE D9GAML ( XMIN, XMAX )

Argument Definitions (+ indicates altered content)
REAL*8            +XMAX,      +XMIN
Description
june 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
calculate the minimum and maximum legal bounds for x in gamma(x). 
xmin and xmax are not the only bounds, but they are the only non- 
trivial ones to calculate. 
 
output arguments -- 
xmin   dble prec minimum legal value of x in gamma(x).  any smaller 
       value of x might result in underflow. 
xmax   dble prec maximum legal value of x in gamma(x).  any larger 
        value of x might cause overflow.
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DMAX1
GENERIC            ABS,        LOG
External Functions and Subroutines Called
REAL*8             D1MACH
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I
REAL*8            +ALNBIG,    +ALNSML,    +XLN,       +XOLD

REAL FUNCTION D9GMIT ( A, X, ALGAP1, SGNGAM, ALX )

Argument Definitions (+ indicates altered content)
REAL*8             A,          ALGAP1,     ALX,        SGNGAM
REAL*8             X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
compute tricomi-s incomplete gamma function for small x.
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DBLE,       DSIGN
REAL               FLOAT
GENERIC            ABS,        EXP,        LOG
External Functions and Subroutines Called
REAL*8             D1MACH,     DLNGAM
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +K,         +M,         +MA
REAL*8            +AE,        +AEPS,      +ALG2,      +ALGS
REAL*8            +BOT,       +EPS,       +FK,        +S
REAL*8            +SGNG2,     +T,         +TE

REAL FUNCTION D9LGIC ( A, X, ALX )

Argument Definitions (+ indicates altered content)
REAL*8             A,          ALX,        X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
compute the log complementary incomplete gamma function for large 
x and for a .le. x.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS,        LOG
External Functions and Subroutines Called
REAL*8             D1MACH
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +K
REAL*8            +EPS,       +FK,        +P,         +R
REAL*8            +S,         +T,         +XMA,       +XPA

REAL FUNCTION D9LGIT ( A, X, ALGAP1 )

Argument Definitions (+ indicates altered content)
REAL*8             A,          ALGAP1,     X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
compute the log of tricomi-s incomplete gamma function with 
perron-s continued fraction for large x and for a .ge. x.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS,        LOG,        SQRT
External Functions and Subroutines Called
REAL*8             D1MACH
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +K
REAL*8            +A1X,       +AX,        +EPS,       +FK
REAL*8            +HSTAR,     +P,         +R,         +S
REAL*8            +SQEPS,     +T

REAL FUNCTION D9LGMC ( X )

Argument Definitions (+ indicates altered content)
REAL*8             X
Description
august 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
compute the log gamma correction factor for x .ge. 10. so that 
log (dgamma(x)) = log(dsqrt(2*pi)) + (x-.5)*log(x) - x + 
d9lgmc(x)
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DMIN1
REAL               SNGL
GENERIC            EXP,        LOG,        SQRT
External Functions and Subroutines Called
INTEGER            INITDS
REAL*8             D1MACH,     DCSEVL
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +NALGM
REAL*8            +ALGMCS(15),            +XBIG,      +XMAX

REAL FUNCTION D9PAK ( Y, N )

Argument Definitions (+ indicates altered content)
INTEGER            N
REAL*8             Y
Description
december 1979 edition. w. fullerton, c3, los alamos scientific lab. 
 
pack a base 2 exponent into floating point number x.  this routine is 
almost the inverse of d9upak.  it is not exactly the inverse, because 
abs(x) need not be between 0.5 and 1.0.  if both d9pak and 2.d0**n 
were known to be in range we could compute 
d9pak = x * 2.0d0**n
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DBLE
REAL               FLOAT
External Functions and Subroutines Called
INTEGER            I1MACH
REAL*8             D1MACH
SUBROUTINE         D9UPAK,     SETERU
Local Variables (+ indicates altered content)
INTEGER           +NMAX,      +NMIN,      +NSUM,       NY
REAL*8            +ALN210,    +ALN2B

SUBROUTINE D9UPAK ( X, Y, N )

Argument Definitions (+ indicates altered content)
INTEGER           +N
REAL*8             X,         +Y
Description
august 1980 portable edition.  w. fullerton, los alamos scientific lab 
 
unpack floating point number x so that x = y * 2.0**n, where 
0.5 .le. abs(y) .lt. 1.0 .
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DSIGN
GENERIC            ABS
Local Variables (+ indicates altered content)
REAL*8            +ABSX

REAL FUNCTION DCSEVL ( X, A, N )

Argument Definitions (+ indicates altered content)
INTEGER            N
REAL*8             A(N),       X
Description
evaluate the n-term chebyshev series a at x.  adapted from 
r. broucke, algorithm 446, c.a.c.m., 16, 254 (1973). 
 
input arguments -- 
  x      dble prec value at which the series is to be evaluated. 
  a      dble prec array of n terms of a chebyshev series.  in eval- 
         uating a, only half the first coef is summed. 
  n      number of terms in array a.
Source file:dgamit.f
External Functions and Subroutines Called
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +NI
REAL*8            +B0,        +B1,        +B2,        +TWOX

REAL FUNCTION DGAMMA ( X )

Argument Definitions (+ indicates altered content)
REAL*8             X
Description
jan 1984 edition.  w. fullerton, c3, los alamos scientific lab. 
jan 1994 wpp@ips.id.ethz.ch, ehg@research.att.com   declare xsml
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DBLE,       DMAX1
REAL               FLOAT,      SNGL
GENERIC            ABS,        EXP,        LOG,        SIN
GENERIC            SQRT
External Functions and Subroutines Called
INTEGER            INITDS
REAL*8             D1MACH,     D9LGMC,     DCSEVL,     DINT
SUBROUTINE         D9GAML,     SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +N,         +NGAM
REAL*8            +DXREL,     +GAMCS(42), +PI,        +SINPIY
REAL*8            +SQ2PIL,    +XMAX,      +XMIN,      +XSML
REAL*8            +Y

REAL FUNCTION DGAMR ( X )

Argument Definitions (+ indicates altered content)
REAL*8             X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
this routine, not dgamma(x), should be the fundamental one.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS,        EXP
External Functions and Subroutines Called
REAL*8             DGAMMA,     DINT
SUBROUTINE         DLGAMS,     ENTSRC,     ERROFF
Local Variables (+ indicates altered content)
INTEGER            IR,         IROLD
REAL*8             ALNGX,      SGNGX

REAL FUNCTION DINT ( X )

Argument Definitions (+ indicates altered content)
REAL*8             X
Description
december 1983 edition. w. fullerton, c3, los alamos scientific lab. 
 
dint is the real*8 equivalent of aint.  this portable 
version is quite efficient when the argument is reasonably small (a 
common case), and so no faster machine-dependent version is needed.
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DBLE
INTEGER            INT
REAL               AMIN1,      FLOAT,      SNGL
GENERIC            ABS,        LOG
External Functions and Subroutines Called
INTEGER            I1MACH
REAL*8             D1MACH
REAL               R1MACH
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +IBASE,     +IPART,     +NPART
REAL*8            +PART,      +SCALE,     +XBIG,      +XMAX
REAL*8            +XSCL

SUBROUTINE DLGAMS ( X, DLGAM, SGNGAM )

Argument Definitions (+ indicates altered content)
REAL*8            +DLGAM,     +SGNGAM,     X
Description
july 1977 edition.  w. fullerton, c3, los alamos scientific lab. 
 
evaluate log abs (gamma(x)) and return the sign of gamma(x) in sgngam. 
sgngam is either +1.0 or -1.0.
Source file:dgamit.f
Intrinsic Functions Called
DOUBLE PRECISION   DMOD
External Functions and Subroutines Called
REAL*8             DINT,       DLNGAM
Local Variables (+ indicates altered content)
INTEGER           +INT

REAL FUNCTION DLNGAM ( X )

Argument Definitions (+ indicates altered content)
REAL*8             X
Description
august 1980 edition.   w. fullerton, c3, los alamos scientific lab.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS,        LOG,        SIN,        SQRT
External Functions and Subroutines Called
REAL*8             D1MACH,     D9LGMC,     DGAMMA,     DINT
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
REAL*8            +DXREL,     +PI,        +SINPIY,    +SQ2PIL
REAL*8            +SQPI2L,    +XMAX,      +Y

SUBROUTINE E9RINT ( MESSG, NW, NERR, SAVE )

Argument Definitions (+ indicates altered content)
CHARACTER          MESSG(NW)
INTEGER            NERR,       NW
LOGICAL            SAVE
Description
this routine stores the current error message or prints the old one, 
if any, depending on whether or not save = .true. .
Source file:dgamit.f
I/O Operations:
Unit ID  Unit No       Access  Form   Operation
 IWUNIT                   SEQ  FMTD           W  
      *                   SEQ  FMTD           W  

Operation codes A=rewind,B=backspace,C=close,E=endfile
                I=inquire,O=open,R=read,W=write
External Functions and Subroutines Called
INTEGER            I1MACH,     I8SAVE
SUBROUTINE         S88FMT
Local Variables (+ indicates altered content)
CHARACTER         +CCPLUS,    +FMT(14),   +MESSGP(36)
INTEGER           +I,         +IWUNIT,    +NERRP,     +NWP

SUBROUTINE ENTSRC ( IROLD, IRNEW )

Argument Definitions (+ indicates altered content)
INTEGER            IRNEW,     +IROLD
Description
this routine returns irold = lrecov and sets lrecov = irnew. 
 
if there is an active error state, the message is printed and 
execution stops. 
 
irnew = 0 leaves lrecov unchanged, while 
irnew = 1 gives recovery and 
irnew = 2 turns recovery off. 
 
error states - 
 
1 - illegal value of irnew. 
2 - called while in an error state.
Source file:dgamit.f
External Functions and Subroutines Called
INTEGER            I8SAVE
SUBROUTINE         SETERR

SUBROUTINE EPRINT ( )

Description
this subroutine prints the last error message, if any.
Source file:dgamit.f
External Functions and Subroutines Called
SUBROUTINE         E9RINT
Parameter Variables Used
INTEGER            MESSGLENGTH        (MESSGLENGTH = 100)
Local Variables (+ indicates altered content)
CHARACTER          MESSG(MESSGLENGTH)

SUBROUTINE ERROFF ( )

Description
turns off the error state off by setting lerror=0.
Source file:dgamit.f
External Functions and Subroutines Called
INTEGER            I8SAVE
Local Variables (+ indicates altered content)
INTEGER           +I

INTEGER FUNCTION I8SAVE ( ISW, IVALUE, SET )

Argument Definitions (+ indicates altered content)
INTEGER            ISW,        IVALUE
LOGICAL            SET
Description
if (isw = 1) i8save returns the current error number and 
sets it to ivalue if set = .true. . 
 
if (isw = 2) i8save returns the current recovery switch and 
sets it to ivalue if set = .true. .
Source file:dgamit.f
Local Variables (+ indicates altered content)
INTEGER           +IPARAM(2)

INTEGER FUNCTION INITDS ( DOS, NOS, ETA )

Argument Definitions (+ indicates altered content)
INTEGER            NOS
REAL*8             DOS(NOS)
REAL               ETA
Description
june 1977 edition.   w. fullerton, c3, los alamos scientific lab. 
 
initialize the real*8 orthogonal series dos so that 
initds is the number of terms needed to insure the error is no 
larger than eta.  ordinarily eta will be chosen to be one-tenth 
machine precision. 
 
input arguments -- 
dos    dble prec array of nos coefficients in an orthogonal series. 
nos    number of coefficients in dos. 
eta    requested accuracy of series.
Source file:dgamit.f
Intrinsic Functions Called
REAL               SNGL
GENERIC            ABS
External Functions and Subroutines Called
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +II
REAL              +ERR

INTEGER FUNCTION INITS ( OS, NOS, ETA )

Argument Definitions (+ indicates altered content)
INTEGER            NOS
REAL               ETA,        OS(NOS)
Description
april 1977 version.  w. fullerton, c3, los alamos scientific lab. 
 
initialize the orthogonal series so that inits is the number of terms 
needed to insure the error is no larger than eta.  ordinarily, eta 
will be chosen to be one-tenth machine precision. 
 
input arguments -- 
os     array of nos coefficients in an orthogonal series. 
nos    number of coefficients in os. 
eta    requested accuracy of series.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS
External Functions and Subroutines Called
SUBROUTINE         SETERU
Local Variables (+ indicates altered content)
INTEGER           +I,         +II
REAL              +ERR

SUBROUTINE R9UPAK ( X, Y, N )

Argument Definitions (+ indicates altered content)
INTEGER           +N
REAL               X,         +Y
Description
august 1980 portable edition.  w. fullerton, los alamos scientific lab 
 
unpack floating point number x so that x = y * 2.0**n, where 
0.5 .le. abs(y) .lt. 1.0 .
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            ABS,        SIGN
Local Variables (+ indicates altered content)
REAL              +ABSX

SUBROUTINE S88FMT ( N, W, IFMT )

Argument Definitions (+ indicates altered content)
CHARACTER         +IFMT(N)
INTEGER            N,          W
Description
s88fmt  replaces ifmt(1), ... , ifmt(n) with 
the characters corresponding to the n least significant 
digits of w.
Source file:dgamit.f
Intrinsic Functions Called
GENERIC            MOD
Local Variables (+ indicates altered content)
CHARACTER         +DIGITS(10)
INTEGER           +IDIGIT
INTEGER           +NT,        +WT

SUBROUTINE SETERR ( MESSG, NMESSG, NERR, IOPT )

Argument Definitions (+ indicates altered content)
CHARACTER          MESSG(MESSGLENGTH)
INTEGER            IOPT,       NERR,       NMESSG
Description
this version modified by w. fullerton to dump if iopt = 1 and 
not recovering. 
seterr sets lerror = nerr, optionally prints the message and dumps 
according to the following rules... 
 
if iopt = 1 and recovering      - just remember the error. 
if iopt = 1 and not recovering  - print, dump and stop. 
if iopt = 2                     - print, dump and stop. 
 
input 
 
messg  - the error message. 
nmessg - the length of the message, in characters. 
nerr   - the error number. must have nerr non-zero. 
iopt   - the option. must have iopt=1 or 2. 
 
error states - 
 
1 - message length not positive. 
2 - cannot have nerr=0. 
3 - an unrecovered error followed by another error. 
4 - bad value for iopt. 
 
only the first 72 characters of the message are printed. 
 
the error handler calls a subroutine named fdump to produce a 
symbolic dump. to complete the package, a dummy version of fdump 
is supplied, but it should be replaced by a locally written version 
which at least gives a trace-back.
Source file:dgamit.f
I/O Operations:
Unit ID  Unit No       Access  Form   Operation
 IWUNIT                   SEQ  FMTD           W  

Operation codes A=rewind,B=backspace,C=close,E=endfile
                I=inquire,O=open,R=read,W=write
Intrinsic Functions Called
INTEGER            MIN0
External Functions and Subroutines Called
INTEGER            I1MACH,     I8SAVE
SUBROUTINE         E9RINT,     EPRINT,     FDUMP
Parameter Variables Used
INTEGER            MESSGLENGTH        (MESSGLENGTH = 100)
Local Variables (+ indicates altered content)
INTEGER           +ITEMP,     +IWUNIT,    +NW

SUBROUTINE SETERU ( MESSG, NMESSG, NERR, IOPT )

Argument Definitions (+ indicates altered content)
CHARACTER          MESSG(MESSGLENGTH)
INTEGER            IOPT,       NERR,       NMESSG
Source file:dgamit.f
External Functions and Subroutines Called
SUBROUTINE         SETERR
Parameter Variables Used
INTEGER            MESSGLENGTH        (MESSGLENGTH = 100)
Referenced Common Block Variables (+ indicates altered content)
CSETER             INTEGER           +IUNFLO

INTEGER FUNCTION I1MACH ( I )

Argument Definitions (+ indicates altered content)
INTEGER            I
Source file:dgamit.f
I/O Operations:
Unit ID  Unit No       Access  Form   Operation
      *                   SEQ  FMTD           W  

Operation codes A=rewind,B=backspace,C=close,E=endfile
                I=inquire,O=open,R=read,W=write
Local Variables (+ indicates altered content)
INTEGER           +IMACH(16), +OUTPUT,    +SANITY,    +SMALL(2)
REAL*8            +RMACH
Referenced Equivalenced Variables (+ indicates altered content)

EQUIV              INTEGER           +IMACH()    Local Var
                   INTEGER           +OUTPUT     Local Var
EQUIV              REAL*8            +RMACH      Local Var
                   INTEGER           +SMALL()    Local Var
Referenced Common Block Variables (+ indicates altered content)
D8MACH             INTEGER           +CRAY1

SUBROUTINE FDUMP ( )

Source file:dgamit.f

REAL FUNCTION D1MACH ( I )

Argument Definitions (+ indicates altered content)
INTEGER            I
Description
DOUBLE-PRECISION MACHINE CONSTANTS 
 
D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. 
 
D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. 
 
D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. 
 
D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. 
 
D1MACH( 5) = LOG10(B) 
 
TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, 
THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY 
REMOVING THE C FROM COLUMN 1. 
ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. 
(BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) 
 
FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), ONE OF THE FIRST 
TWO SETS OF CONSTANTS BELOW SHOULD BE APPROPRIATE.  IF YOU DO NOT 
KNOW WHICH SET TO USE, TRY BOTH AND SEE WHICH GIVES PLAUSIBLE 
VALUES. 
 
WHERE POSSIBLE, DECIMAL, OCTAL OR HEXADECIMAL CONSTANTS ARE USED 
TO SPECIFY THE CONSTANTS EXACTLY.  SOMETIMES THIS REQUIRES USING 
EQUIVALENT INTEGER ARRAYS.  IF YOUR COMPILER USES HALF-WORD 
INTEGERS BY DEFAULT (SOMETIMES CALLED INTEGER*2), YOU MAY NEED TO 
CHANGE INTEGER TO INTEGER*4 OR OTHERWISE INSTRUCT YOUR COMPILER 
TO USE FULL-WORD INTEGERS IN THE NEXT 5 DECLARATIONS. 
 
COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) 
GIVE C SOURCE FOR D1MACH.
Source file:dgamit.f
I/O Operations:
Unit ID  Unit No       Access  Form   Operation
      *                   SEQ  FMTD           W  

Operation codes A=rewind,B=backspace,C=close,E=endfile
                I=inquire,O=open,R=read,W=write
Local Variables (+ indicates altered content)
INTEGER           +DIVER(2),  +LARGE(2),  +LOG10(2),  +RIGHT(2)
INTEGER           +SC,        +SMALL(2)
REAL*8            +DMACH(5)
Referenced Equivalenced Variables (+ indicates altered content)

EQUIV              INTEGER           +DIVER()    Local Var
                   INTEGER           +RIGHT()    Local Var
                   INTEGER           +LARGE()    Local Var
                   INTEGER           +SMALL()    Local Var
                   REAL*8            +DMACH()    Local Var
                   INTEGER           +LOG10()    Local Var

REAL FUNCTION R1MACH ( I )

Argument Definitions (+ indicates altered content)
INTEGER            I
Description
SINGLE-PRECISION MACHINE CONSTANTS 
 
R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. 
 
R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. 
 
R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. 
 
R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. 
 
R1MACH(5) = LOG10(B) 
 
TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, 
THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY 
REMOVING THE C FROM COLUMN 1. 
 
FOR IEEE-ARITHMETIC MACHINES (BINARY STANDARD), THE FIRST 
SET OF CONSTANTS BELOW SHOULD BE APPROPRIATE. 
 
WHERE POSSIBLE, DECIMAL, OCTAL OR HEXADECIMAL CONSTANTS ARE USED 
TO SPECIFY THE CONSTANTS EXACTLY.  SOMETIMES THIS REQUIRES USING 
EQUIVALENT INTEGER ARRAYS.  IF YOUR COMPILER USES HALF-WORD 
INTEGERS BY DEFAULT (SOMETIMES CALLED INTEGER*2), YOU MAY NEED TO 
CHANGE INTEGER TO INTEGER*4 OR OTHERWISE INSTRUCT YOUR COMPILER 
TO USE FULL-WORD INTEGERS IN THE NEXT 5 DECLARATIONS. 
 
COMMENTS JUST BEFORE THE END STATEMENT (LINES STARTING WITH *) 
GIVE C SOURCE FOR R1MACH.
Source file:dgamit.f
I/O Operations:
Unit ID  Unit No       Access  Form   Operation
      *                   SEQ  FMTD           W  

Operation codes A=rewind,B=backspace,C=close,E=endfile
                I=inquire,O=open,R=read,W=write
Local Variables (+ indicates altered content)
INTEGER           +DIVER(2),  +LARGE(2),  +LOG10(2),  +RIGHT(2)
INTEGER           +SC,        +SMALL(2)
REAL*8            +RMACH(5)
Referenced Equivalenced Variables (+ indicates altered content)

EQUIV              INTEGER           +DIVER()    Local Var
                   INTEGER           +RIGHT()    Local Var
                   INTEGER           +LARGE()    Local Var
                   INTEGER           +SMALL()    Local Var
                   REAL*8            +RMACH()    Local Var
                   INTEGER           +LOG10()    Local Var