Transition to NewIO
[u/mrichter/AliRoot.git] / MICROCERN / gamma64.F
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