C   IMSL ROUTINE NAME   - MGAMAD=DGAMMA
C
C-----------------------------------------------------------------------
C
C   COMPUTER            - VAX/DOUBLE
C
C   LATEST REVISION     - NOVEMBER 1, 1984
C
C   PURPOSE             - EVALUATE THE GAMMA FUNCTION OF A DOUBLE
C                           PRECISION ARGUMENT
C
C   USAGE               - RESULT = DGAMMA(X)
C
C   ARGUMENTS    X      - INPUT DOUBLE PRECISION ARGUMENT.
C                           DGAMMA IS SET TO MACHINE INFINITY, WITH THE
C                           PROPER SIGN, WHENEVER
C                             X IS ZERO,
C                             X IS A NEGATIVE INTEGER,
C                             ABS(X) .LE. XMIN, OR
C                             ABS(X) .GE. XMAX.
C                             XMIN IS OF THE ORDER OF 10**(-39) AND
C                             XMAX IS AT LEAST 34.8. THE EXACT VALUES
C                             OF XMIN AND XMAX MAY ALLOW LARGER RANGES
C                             FOR X ON SOME COMPUTERS.
C                             SEE THE PROGRAMMING NOTES IN THE MANUAL
C                             FOR THE EXACT VALUES.
C                DGAMMA - OUTPUT DOUBLE PRECISION VALUE OF THE GAMMA
C                           FUNCTION. DGAMMA MUST BE TYPED DOUBLE
C                           PRECISION IN THE CALLING PROGRAM.
C
C   PRECISION/HARDWARE  - DOUBLE/H32,H36
C                       - NOT AVAILABLE/H48,H60
C                         NOTE - DGAMMA MAY NOT BE SUPPLIED BY IMSL IF
C                           IT RESIDES IN THE MATHEMATICAL SUBPROGRAM
C                           LIBRARY SUPPLIED BY THE MANUFACTURER.
C
C   REQD. IMSL ROUTINES - UERTST,UGETIO
C
C   NOTATION            - INFORMATION ON SPECIAL NOTATION AND
C                           CONVENTIONS IS AVAILABLE IN THE MANUAL
C                           INTRODUCTION OR THROUGH IMSL ROUTINE UHELP
C
C   REMARKS      AN ERROR MESSAGE PRINTED BY UERTST FROM DGAMMA SHOULD
C                BE INTERPRETED AS FOLLOWS
C                IER    - ERROR INDICATOR
C                         TERMINAL ERROR
C                           IER = 129 INDICATES THAT THE ABSOLUTE VALUE
C                             OF THE INPUT ARGUMENT X IS SPECIFIED
C                             GREATER THAN OR EQUAL TO XMAX. DGAMMA
C                             IS SET TO MACHINE INFINITY.
C                           IER = 130 INDICATES THAT THE INPUT ARGUMENT
C                             X IS SPECIFIED AS ZERO OR A NEGATIVE
C                             INTEGER OR THAT THE ABSOLUTE VALUE OF THE
C                             INPUT ARGUMENT IS LESS THAN OR EQUAL TO
C                             XMIN. DGAMMA IS SET TO MACHINE INFINITY
C                             WITH THE PROPER SIGN FOR THE DGAMMA
C                             FUNCTION. IF X IS ZERO OR AN EVEN
C                             NEGATIVE INTEGER, GAMMA HAS A NEGATIVE
C                             SIGN. OTHERWISE IT HAS A POSITIVE SIGN.
C
C   COPYRIGHT           - 1982 BY IMSL, INC. ALL RIGHTS RESERVED.
C
C   WARRANTY            - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN
C                           APPLIED TO THIS CODE. NO OTHER WARRANTY,
C                           EXPRESSED OR IMPLIED, IS APPLICABLE.
C
C-----------------------------------------------------------------------
C
      FUNCTION DGAMMA (X)
C                                  SPECIFICATIONS FOR ARGUMENTS
      DOUBLE PRECISION   X,DGAMMA
C                                  SPECIFICATIONS FOR LOCAL VARIABLES
      DOUBLE PRECISION   P(9),Q(8),P4(7)
      DOUBLE PRECISION   A,B,DEN,PI,T,TOP,BIG1,
     1                   XINF,XMIN,Y,SIGN,R
      INTEGER            I,IER,J
      LOGICAL            MFLAG
C                                  COEFFICIENTS FOR MINIMAX
C                                  APPROXIMATION TO GAMMA(X),
C                                  2.0 .LE. X .LE. 3.0
      DATA               P(1)/-5.966047488753637D01/,
     *                   P(2)/5.864023793062003D01/,
     *                   P(3)/-1.364106217165365D03/,
     *                   P(4)/-8.117569271425580D02/,
     *                   P(5)/-1.569414683149179D04/,
     *                   P(6)/-1.525979925758372D04/,
     *                   P(7)/-7.264059615964330D04/,
     *                   P(8)/-8.972275718101010D-01/,
     *                   P(9)/3.349618189847578D00/
      DATA               Q(1)/4.103991474182904D02/,
     *                   Q(2)/-2.262590291514875D03/,
     *                   Q(3)/2.494325576714903D03/,
     *                   Q(4)/2.362106244383048D04/,
     *                   Q(5)/-5.741873227396418D04/,
     *                   Q(6)/-7.257239715408240D04/,
     *                   Q(7)/-9.491399521686949D00/,
     *                   Q(8)/-3.255006939455704D01/
C                                  COEFFICIENTS FOR MINIMAX
C                                  APPROXIMATION TO LN(GAMMA(X)),
C                                  12.0 .LE. X
      DATA               P4(1)/8.40596949829D-04/,
     1                   P4(2)/-5.9523334141881D-04/,
     2                   P4(3)/7.9365078409227D-04/,
     *                   P4(4)/-2.777777777769526D-03/,
     *                   P4(5)/8.333333333333333D-02/,
     *                   P4(6)/9.189385332046727D-01/,
     6                   P4(7)/-1.7816839846D-03/
      DATA               PI/3.141592653589793D0/
      DATA               XINF/1.7D+38/
C                                  DGAMMA(XMIN) .APPROX. XINF
C                                  DGAMMA(BIG1) .APPROX. XINF
      DATA               XMIN/5.8775D-39/
      DATA               BIG1/34.844D0/
C                                  FIRST EXECUTABLE STATEMENT
      IER = 0
      MFLAG = .FALSE.
      T = X
      IF (DABS(T).GT.XMIN) GO TO 5
      IER = 130
      DGAMMA = XINF
      IF (T.LE.0.0D0) DGAMMA = -XINF
      GO TO 9000
    5 IF (DABS(T).LT.BIG1) GO TO 10
      IER = 129
      DGAMMA = XINF
      GO TO 9000
   10 IF (T.GT.0.0D0) GO TO 20
C                                  ARGUMENT IS NEGATIVE
      MFLAG = .TRUE.
      T = -T
      R = DINT(T)
      SIGN = 1.0D0
      IF (MOD(R,2.0D0).EQ.0.0D0) SIGN = -1.0D0
      R = T-R
      IF (R.NE.0.0D0) GO TO 15
      IER = 130
      DGAMMA = XINF
      IF (SIGN.EQ.-1.0D0) DGAMMA = -XINF
      GO TO 9000
C                                  ARGUMENT IS NOT A NEGATIVE INTEGER
   15 R = PI/DSIN(R*PI)*SIGN
      T = T+1.0D0
C                                  EVALUATE APPROXIMATION FOR DGAMMA(T)
C                                    T .GT. XMIN
   20 IF (T.GT.12.0D0) GO TO 55
      I = T
      A = 1.0D0
      IF (I.GT.2) GO TO 35
      I = I+1
      GO TO (25,30,45),I
C                                  0.0 .LT. T .LT. 1.0
   25 A = A/(T*(T+1.0D0))
      T = T+2.0D0
      GO TO 45
C                                  1.0 .LE. T .LT. 2.0
   30 A = A/T
      T = T+1.0D0
      GO TO 45
C                                  3.0 .LE. T .LE. 12.0
   35 DO 40 J=3,I
         T = T-1.0D0
         A = A*T
   40 CONTINUE
C                                  2.0 .LE. T .LE. 3.0
   45 TOP = P(8)*T+P(9)
      DEN = T+Q(8)
      DO 50 J=1,7
         TOP = TOP*T+P(J)
         DEN = DEN*T+Q(J)
   50 CONTINUE
      Y = (TOP/DEN)*A
      IF (MFLAG) Y = R/Y
      DGAMMA = Y
      GO TO 9005
C                                  T .GT. 12.0
   55 TOP = DLOG(T)
      TOP = T*(TOP-1.0D0)-.5D0*TOP
      T = 1.0D0/T
      B = T*T
      A = P4(7)
      DO 60 J = 1,5
   60 A = A*B+P4(J)
      Y = A*T+P4(6)+TOP
      Y = DEXP(Y)
      IF (MFLAG) Y = R/Y
      DGAMMA = Y
      GO TO 9005
 9000 CONTINUE
      CALL UERTST(-IER,'MGAMAD')
      CALL UERTST( IER,'DGAMMA')
 9005 RETURN
      END
