This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / clogam64.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:01:55  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10 #if !defined(CERNLIB_DOUBLE)
11       FUNCTION CLGAMA(Z)
12 #include "gen/defc64.inc"
13      +     CLGAMA
14      +    ,CLOGAM
15 #endif
16 #if defined(CERNLIB_DOUBLE)
17       FUNCTION WLGAMA(Z)
18 #include "gen/imp64.inc"
19 #include "gen/defc64.inc"
20      +     WLGAMA
21      +    ,WLOGAM
22 #endif
23 #include "gen/defc64.inc"
24 C    +     Z,W,U,V,H,P,R,GCONJG,GCMPLX
25      +     Z,  U,V,H,P,R
26       CHARACTER NAME*(*)
27       CHARACTER*80 ERRTXT
28 #if !defined(CERNLIB_DOUBLE)
29       PARAMETER (NAME = 'CLGAMA')
30 #endif
31 #if defined(CERNLIB_DOUBLE)
32       PARAMETER (NAME = 'CLGAMA/WLGAMA')
33 #endif
34       DIMENSION C(10)
35
36       PARAMETER (Z1 = 1, HF = Z1/2)
37
38 #include "gen/gcmpfun.inc"
39
40       DATA PI /3.14159 26535 89793 24D+0/
41       DATA C1 /9.18938 53320 46727 42D-1/
42       DATA C2 /1.14472 98858 49400 17D+0/
43
44       DATA C( 1) / 8.33333 33333 33333 33D-2/
45       DATA C( 2) /-2.77777 77777 77777 78D-3/
46       DATA C( 3) / 7.93650 79365 07936 51D-4/
47       DATA C( 4) /-5.95238 09523 80952 38D-4/
48       DATA C( 5) / 8.41750 84175 08417 51D-4/
49       DATA C( 6) /-1.91752 69175 26917 53D-3/
50       DATA C( 7) / 6.41025 64102 56410 26D-3/
51       DATA C( 8) /-2.95506 53594 77124 18D-2/
52       DATA C( 9) / 1.79644 37236 88305 73D-1/
53       DATA C(10) /-1.39243 22169 05901 12D+0/
54 C     GREAL(U)=DREAL(U)
55 C     GIMAG(U)=DIMAG(U)
56 C     GCONJG(U)=DCONJG(U)
57 C     GCMPLX(X,Y)=DCMPLX(X,Y)
58
59 #if !defined(CERNLIB_DOUBLE)
60       ENTRY CLOGAM(Z)
61 #endif
62 #if defined(CERNLIB_DOUBLE)
63       ENTRY WLOGAM(Z)
64 #endif
65
66       X=Z
67       Y=GIMAG(Z)
68       IF(Y .EQ. 0 .AND. -ABS(X) .EQ. INT(X)) THEN
69        H=0
70        WRITE(ERRTXT,101) X
71        CALL MTLPRT(NAME,'C306.1',ERRTXT)
72       ELSE
73        YA=ABS(Y)
74        U=GCMPLX(X,YA)
75        IF(X .LT. 0) U=1-U
76        H=0
77        UR=U
78        IF(UR .LT. 7) THEN
79         UI=GIMAG(U)
80         A=ATAN2(UI,UR)
81         H=U
82         DO 1 I = 1,6-INT(UR)
83         UR=UR+1
84         U=GCMPLX(UR,UI)
85         H=H*U
86     1   A=A+ATAN2(UI,UR)
87         H=GCMPLX(HF*LOG(GREAL(H)**2+GIMAG(H)**2),A)
88         U=U+1
89        ENDIF
90        R=1/U**2
91        P=R*C(10)
92        DO 2 I = 9,2,-1
93     2  P=R*(C(I)+P)
94        H=C1+(U-HF)*LOG(U)-U+(C(1)+P)/U-H
95        IF(X .LT. 0) THEN
96         UR=INT(X)-1
97         UI=PI*(X-UR)
98         X=PI*YA
99         T=EXP(-X-X)
100         A=SIN(UI)
101         T=X+HF*LOG(T*A**2+(HF*(1-T))**2)
102         A=ATAN2(COS(UI)*TANH(X),A)-UR*PI
103         H=C2-GCMPLX(T,A)-H
104        ENDIF
105        IF(Y .LT. 0) H=GCONJG(H)
106       ENDIF
107 #if defined(CERNLIB_DOUBLE)
108       WLGAMA=H
109 #endif
110 #if !defined(CERNLIB_DOUBLE)
111       CLGAMA=H
112 #endif
113       RETURN
114   101 FORMAT('ARGUMENT EQUALS NON-POSITIVE INTEGER = ',1P,E15.1)
115       END