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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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)
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
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)
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
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
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
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
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
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
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
Source file: dgamit.f
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
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