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