Mercurial > hg > octave-nkf

annotate libcruft/slatec-fn/dgamr.f @ 14853:72b8b39e12be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
doc: Periodic grammarcheck of documentation. * contrib.txi, diagperm.txi, emacs.txi, install.txi, package.txi, plot.txi, poly.txi, vectorize.txi, strread.m, textscan.m, graphics_toolkit.m, bicg.m, bicgstab.m, cgs.m, rand.cc, data.cc: Periodic grammarcheck of documentation.
author Rik <octave@nomad.inbox5.com>
date Mon, 09 Jul 2012 10:34:43 -0700
parents fe6f9bd9d0e6
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3111
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
1 *DECK DGAMR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
2 DOUBLE PRECISION FUNCTION DGAMR (X)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE DGAMR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
4 C***PURPOSE Compute the reciprocal of the Gamma function.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
5 C***LIBRARY SLATEC (FNLIB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
6 C***CATEGORY C7A
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
7 C***TYPE DOUBLE PRECISION (GAMR-S, DGAMR-D, CGAMR-C)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
8 C***KEYWORDS FNLIB, RECIPROCAL GAMMA FUNCTION, SPECIAL FUNCTIONS
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
9 C***AUTHOR Fullerton, W., (LANL)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
10 C***DESCRIPTION
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
11 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
12 C DGAMR(X) calculates the double precision reciprocal of the
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
13 C complete Gamma function for double precision argument X.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
14 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
15 C***REFERENCES (NONE)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
16 C***ROUTINES CALLED DGAMMA, DLGAMS, XERCLR, XGETF, XSETF
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
17 C***REVISION HISTORY (YYMMDD)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
18 C 770701 DATE WRITTEN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
19 C 890531 Changed all specific intrinsics to generic. (WRB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
20 C 890531 REVISION DATE from Version 3.2
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
21 C 891214 Prologue converted to Version 4.0 format. (BAB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
22 C 900727 Added EXTERNAL statement. (WRB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
23 C***END PROLOGUE DGAMR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
24 DOUBLE PRECISION X, ALNGX, SGNGX, DGAMMA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
25 EXTERNAL DGAMMA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
26 C***FIRST EXECUTABLE STATEMENT DGAMR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
27 DGAMR = 0.0D0
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
28 IF (X.LE.0.0D0 .AND. AINT(X).EQ.X) RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
29 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
30 CALL XGETF (IROLD)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
31 CALL XSETF (1)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
32 IF (ABS(X).GT.10.0D0) GO TO 10
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
33 DGAMR = 1.0D0/DGAMMA(X)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
34 CALL XERCLR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
35 CALL XSETF (IROLD)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
36 RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
37 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
38 10 CALL DLGAMS (X, ALNGX, SGNGX)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
39 CALL XERCLR
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
40 CALL XSETF (IROLD)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
41 DGAMR = SGNGX * EXP(-ALNGX)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
42 RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
43 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
44 END