This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / algama128.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:01:54  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10 #if defined(CERNLIB_QUAD)
11 #if !defined(CERNLIB_DOUBLE)
12       FUNCTION DLGAMA(X)
13 #endif
14 #if defined(CERNLIB_DOUBLE)
15       FUNCTION QLGAMA(X)
16 #endif
17 #include "gen/imp128.inc"
18       CHARACTER NAME*(*)
19       CHARACTER*80 ERRTXT
20 #if defined(CERNLIB_DOUBLE)
21       PARAMETER (NAME = 'QLGAMA')
22       DIMENSION C(0:27)
23
24       PARAMETER (AL2 =  0.69314 71805 59945 30941 72321 21458 18Q0)
25
26       DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97Q0/
27       DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36Q0/
28       DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71Q0/
29       DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98Q0/
30       DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41Q0/
31       DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24Q0/
32       DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28Q0/
33       DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97Q0/
34       DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37Q0/
35       DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22Q0/
36       DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01Q0/
37       DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37Q0/
38       DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53Q0/
39       DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81Q0/
40       DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76Q0/
41       DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10Q0/
42       DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16Q0/
43       DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51Q0/
44       DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13Q0/
45       DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61Q0/
46       DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05Q0/
47       DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69Q0/
48       DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33Q0/
49       DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57Q0/
50       DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40Q0/
51       DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02Q0/
52       DATA C(26) / 0.00000 00000 00000 00000 00000 00000 14Q0/
53       DATA C(27) /-0.00000 00000 00000 00000 00000 00000 01Q0/
54
55       PARAMETER (FM = 1Q20)
56
57 #endif
58 #if !defined(CERNLIB_DOUBLE)
59       PARAMETER (NAME = 'DLGAMA')
60       DIMENSION C(0:25)
61
62       PARAMETER (AL2 =  0.69314 71805 59945 30941 72321 21458 18D0)
63
64       DATA C( 0) / 0.52854 30369 82234 59886 70146 10587 97D0/
65       DATA C( 1) / 0.54987 64461 21414 11418 47224 01104 36D0/
66       DATA C( 2) / 0.02073 98006 16136 65135 91673 63567 71D0/
67       DATA C( 3) /-0.00056 91677 04215 43842 38953 35739 98D0/
68       DATA C( 4) / 0.00002 32458 72104 00168 83522 53120 41D0/
69       DATA C( 5) /-0.00000 11306 07585 70393 43721 97663 24D0/
70       DATA C( 6) / 0.00000 00606 56530 98948 08283 26590 28D0/
71       DATA C( 7) /-0.00000 00034 62843 57769 83164 91206 97D0/
72       DATA C( 8) / 0.00000 00002 06249 98805 67913 53392 37D0/
73       DATA C( 9) /-0.00000 00000 12663 51115 66776 12652 22D0/
74       DATA C(10) / 0.00000 00000 00795 31006 91836 38345 01D0/
75       DATA C(11) /-0.00000 00000 00050 82076 64160 41154 37D0/
76       DATA C(12) / 0.00000 00000 00003 29187 26043 65876 53D0/
77       DATA C(13) /-0.00000 00000 00000 21555 55420 93157 81D0/
78       DATA C(14) / 0.00000 00000 00000 01423 99484 99073 76D0/
79       DATA C(15) /-0.00000 00000 00000 00094 75908 48729 10D0/
80       DATA C(16) / 0.00000 00000 00000 00006 34422 73080 16D0/
81       DATA C(17) /-0.00000 00000 00000 00000 42694 88760 51D0/
82       DATA C(18) / 0.00000 00000 00000 00000 02885 95426 13D0/
83       DATA C(19) /-0.00000 00000 00000 00000 00195 82123 61D0/
84       DATA C(20) / 0.00000 00000 00000 00000 00013 33140 05D0/
85       DATA C(21) /-0.00000 00000 00000 00000 00000 91025 69D0/
86       DATA C(22) / 0.00000 00000 00000 00000 00000 06231 33D0/
87       DATA C(23) /-0.00000 00000 00000 00000 00000 00427 57D0/
88       DATA C(24) / 0.00000 00000 00000 00000 00000 00029 40D0/
89       DATA C(25) /-0.00000 00000 00000 00000 00000 00002 02D0/
90
91       PARAMETER (FM = 1D20)
92 #endif
93
94       U=X
95       IF(X .LE. 0) THEN
96        H=0
97        WRITE(ERRTXT,101) X
98        CALL MTLPRT(NAME,'C304.1',ERRTXT)
99        GO TO 9
100       ENDIF
101       F=1
102       IF(U .LT. 3) THEN
103        DO 1 I = 1,INT(4-U)
104        F=F/U
105     1  U=U+1
106        FL=LOG(F)+AL2
107       ELSE
108        FL=AL2
109        DO 2 I = 1,INT(U-3)
110        U=U-1
111        F=F*U
112        IF(F .GT. FM) THEN
113         FL=FL+LOG(F)
114         F=1
115        ENDIF
116     2  CONTINUE
117        FL=FL+LOG(F)
118       END IF
119       H=U+U-7
120       ALFA=H+H
121       B1=0
122       B2=0
123       DO 3 I = 27,0,-1
124       B0=C(I)+ALFA*B1-B2
125       B2=B1
126     3 B1=B0
127       H=FL+B0-H*B2
128 #if defined(CERNLIB_DOUBLE)
129     9 QLGAMA=H
130 #endif
131 #if !defined(CERNLIB_DOUBLE)
132     9 DLGAMA=H
133 #endif
134       RETURN
135   101 FORMAT('ARGUMENT IS NEGATIVE = ',1P,E15.1)
136       END
137 #endif