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