]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
fe4da5cc | 4 | #include "gen/pilot.h" |
5 | #if !defined(CERNLIB_IBM) | |
6 | #if defined(CERNLIB_DOUBLE) | |
7 | FUNCTION DGAMMA(X) | |
8 | C | |
9 | #include "gen/imp64.inc" | |
10 | C | |
11 | CHARACTER*(*) NAME | |
12 | PARAMETER(NAME='GAMMA/DGAMMA') | |
13 | #endif | |
14 | #if !defined(CERNLIB_DOUBLE) | |
15 | FUNCTION GAMMA(X) | |
16 | C | |
17 | CHARACTER*(*) NAME | |
18 | PARAMETER(NAME='GAMMA') | |
19 | #endif | |
20 | C | |
21 | CHARACTER*80 ERRTXT | |
22 | ||
23 | DIMENSION C(0:15) | |
24 | ||
25 | DATA C( 0) /3.65738 77250 83382 44D0/ | |
26 | DATA C( 1) /1.95754 34566 61268 27D0/ | |
27 | DATA C( 2) /0.33829 71138 26160 39D0/ | |
28 | DATA C( 3) /0.04208 95127 65575 49D0/ | |
29 | DATA C( 4) /0.00428 76504 82129 09D0/ | |
30 | DATA C( 5) /0.00036 52121 69294 62D0/ | |
31 | DATA C( 6) /0.00002 74006 42226 42D0/ | |
32 | DATA C( 7) /0.00000 18124 02333 65D0/ | |
33 | DATA C( 8) /0.00000 01096 57758 66D0/ | |
34 | DATA C( 9) /0.00000 00059 87184 05D0/ | |
35 | DATA C(10) /0.00000 00003 07690 81D0/ | |
36 | DATA C(11) /0.00000 00000 14317 93D0/ | |
37 | DATA C(12) /0.00000 00000 00651 09D0/ | |
38 | DATA C(13) /0.00000 00000 00025 96D0/ | |
39 | DATA C(14) /0.00000 00000 00001 11D0/ | |
40 | DATA C(15) /0.00000 00000 00000 04D0/ | |
41 | ||
42 | U=X | |
43 | IF(U .LE. 0) THEN | |
44 | WRITE(ERRTXT,101) U | |
45 | CALL MTLPRT(NAME,'C302.1',ERRTXT) | |
46 | H=0 | |
47 | GO TO 9 | |
48 | ENDIF | |
49 | 8 F=1 | |
50 | IF(U .LT. 3) THEN | |
51 | DO 1 I = 1,INT(4-U) | |
52 | F=F/U | |
53 | 1 U=U+1 | |
54 | ELSE | |
55 | DO 2 I = 1,INT(U-3) | |
56 | U=U-1 | |
57 | 2 F=F*U | |
58 | END IF | |
59 | H=U+U-7 | |
60 | ALFA=H+H | |
61 | B1=0 | |
62 | B2=0 | |
63 | DO 3 I = 15,0,-1 | |
64 | B0=C(I)+ALFA*B1-B2 | |
65 | B2=B1 | |
66 | 3 B1=B0 | |
67 | #if defined(CERNLIB_DOUBLE) | |
68 | 9 DGAMMA=F*(B0-H*B2) | |
69 | #endif | |
70 | #if !defined(CERNLIB_DOUBLE) | |
71 | 9 GAMMA =F*(B0-H*B2) | |
72 | #endif | |
73 | RETURN | |
74 | 101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1) | |
75 | END | |
76 | #endif |