Mercurial > hg > octave-nkf

annotate libcruft/slatec-fn/dlbeta.f @ 11897:ee24b6c413f6 release-3-0-x

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
contourf.m: Correct order of patch object handles.
author Ben Abbott <bpabbott@mac.com>
date Sat, 13 Dec 2008 17:30:38 +0100
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 DLBETA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
2 DOUBLE PRECISION FUNCTION DLBETA (A, B)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE DLBETA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
4 C***PURPOSE Compute the natural logarithm of the complete Beta
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
5 C function.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
6 C***LIBRARY SLATEC (FNLIB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
7 C***CATEGORY C7B
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
8 C***TYPE DOUBLE PRECISION (ALBETA-S, DLBETA-D, CLBETA-C)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
9 C***KEYWORDS FNLIB, LOGARITHM OF THE COMPLETE BETA FUNCTION,
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
10 C SPECIAL FUNCTIONS
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
11 C***AUTHOR Fullerton, W., (LANL)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
12 C***DESCRIPTION
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
13 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
14 C DLBETA(A,B) calculates the double precision natural logarithm of
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
15 C the complete beta function for double precision arguments
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
16 C A and B.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
17 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
18 C***REFERENCES (NONE)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
19 C***ROUTINES CALLED D9LGMC, DGAMMA, DLNGAM, DLNREL, XERMSG
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
20 C***REVISION HISTORY (YYMMDD)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
21 C 770701 DATE WRITTEN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
22 C 890531 Changed all specific intrinsics to generic. (WRB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
23 C 890531 REVISION DATE from Version 3.2
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
24 C 891214 Prologue converted to Version 4.0 format. (BAB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
25 C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
26 C 900727 Added EXTERNAL statement. (WRB)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
27 C***END PROLOGUE DLBETA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
28 DOUBLE PRECISION A, B, P, Q, CORR, SQ2PIL, D9LGMC, DGAMMA, DLNGAM,
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
29 1 DLNREL
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
30 EXTERNAL DGAMMA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
31 SAVE SQ2PIL
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
32 DATA SQ2PIL / 0.9189385332 0467274178 0329736405 62 D0 /
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
33 C***FIRST EXECUTABLE STATEMENT DLBETA
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
34 P = MIN (A, B)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
35 Q = MAX (A, B)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
36 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
37 IF (P .LE. 0.D0) CALL XERMSG ('SLATEC', 'DLBETA',
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
38 + 'BOTH ARGUMENTS MUST BE GT ZERO', 1, 2)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
39 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
40 IF (P.GE.10.D0) GO TO 30
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
41 IF (Q.GE.10.D0) GO TO 20
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
42 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
43 C P AND Q ARE SMALL.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
44 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
45 DLBETA = LOG (DGAMMA(P) * (DGAMMA(Q)/DGAMMA(P+Q)) )
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
46 RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
47 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
48 C P IS SMALL, BUT Q IS BIG.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
49 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
50 20 CORR = D9LGMC(Q) - D9LGMC(P+Q)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
51 DLBETA = DLNGAM(P) + CORR + P - P*LOG(P+Q)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
52 1 + (Q-0.5D0)*DLNREL(-P/(P+Q))
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
53 RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
54 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
55 C P AND Q ARE BIG.
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
56 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
57 30 CORR = D9LGMC(P) + D9LGMC(Q) - D9LGMC(P+Q)
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
58 DLBETA = -0.5D0*LOG(Q) + SQ2PIL + CORR + (P-0.5D0)*LOG(P/(P+Q))
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
59 1 + Q*DLNREL(-P/(P+Q))
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
60 RETURN
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
61 C
fe6f9bd9d0e6 [project @ 1997-11-26 07:52:06 by jwe]
jwe
parents:
diff changeset
62 END