This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / rexpin64.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.4  1997/09/04 12:10:28  mclareni
6 * Remove non NT mod introduced with NT mods, the test and Sigma fail
7 *
8 * Revision 1.3  1997/09/02 16:09:37  mclareni
9 * WINNT corrections
10 *
11 * Revision 1.2  1997/04/07 10:01:01  mclareni
12 * Mods for winnt
13 *
14 * Revision 1.1.1.1.2.1  1997/01/21 11:26:01  mclareni
15 * All mods for Winnt 96a on winnt branch
16 *
17 * Revision 1.1.1.1  1996/04/01 15:02:06  mclareni
18 * Mathlib gen
19 *
20 *
21 #include "gen/pilot.h"
22 #if !defined(CERNLIB_DOUBLE)
23       FUNCTION REXPIN(X)
24 #endif
25 #if defined(CERNLIB_DOUBLE)
26       FUNCTION DEXPIN(X)
27 #include "gen/imp64.inc"
28 #endif
29       LOGICAL LEX
30       CHARACTER NAME*(*),NAMEE*(*)
31 #if !defined(CERNLIB_DOUBLE)
32       PARAMETER (NAME = 'REXPIN', NAMEE = 'REXPIE')
33 #endif
34 #if defined(CERNLIB_DOUBLE)
35       PARAMETER (NAME = 'REXPIN/DEXPIN', NAMEE = 'REXPIE/DEXPIE')
36 #endif
37       DIMENSION P1(5),Q1(5),P2(7),Q2(7),P3(7),Q3(7),P4(8),Q4(8)
38       DIMENSION A1(8),B1(8),A2(8),B2(8),A3(8),B3(8)
39
40       PARAMETER (Z1 = 1, R3 = -2*Z1/3, X0 = 0.37250 74107 81366 63D0)
41       DATA P1
42      1/+4.29312 52343 20972 6D+0, +3.98941 53870 32106 6D+1,
43      2 +2.92525 18866 92054 9D+2, +4.25696 82638 59170 3D+2,
44      3 -4.34981 43832 95212 0D+2/
45       DATA Q1
46      1/+1.00000 00000 00000 0D+0, +1.88992 88395 00296 9D+1,
47      2 +1.50950 38744 25130 9D+2, +5.68052 52718 98695 5D+2,
48      3 +7.53585 64359 84293 2D+2/
49       DATA P2
50      1/+4.30967 83946 93887 8D-1, +6.90522 52278 44435 7D+0,
51      2 +2.30192 55939 13334 6D+1, +2.43784 08879 13167 3D+1,
52      3 +9.04161 55694 63286 6D+0, +9.99979 57705 15949 7D-1,
53      4 +4.65627 10797 50956 60D-7/
54       DATA Q2
55      1/+1.03400 13040 48739 8D-1, +3.31909 21359 33016 0D+0,
56      2 +2.04494 78501 37941 7D+1, +4.12807 84189 14243 4D+1,
57      3 +3.24264 21069 51380 5D+1, +1.00411 64382 90544 8D+1,
58      4 +1.00000 00000 00000 0D+0/
59       DATA P3
60      1/-5.66575 20653 38687 4D+0, -5.45374 15888 31328 7D+2,
61      2 -1.29885 68874 64841 0D+3, -8.95927 95777 29368 1D+2,
62      3 -2.41055 82709 70148 5D+2, -2.66271 06043 18114 5D+1,
63      4 -9.99999 99999 84469 1D-1/
64       DATA Q3
65      1/+6.31657 48328 08002 3D+2, +2.40401 71322 59089 5D+3,
66      2 +2.77761 94950 91629 6D+3, +1.33278 53774 82572 3D+3,
67      3 +2.92310 03938 85332 5D+2, +2.86271 06042 21919 0D+1,
68      4 +1.00000 00000 00000 0D+0/
69       DATA P4
70      1/-8.66937 33995 10695 6D+0, -5.49142 26552 10851 5D+2,
71      2 -4.21001 61535 70699 3D+3, -2.49301 39345 86475 9D+5,
72      3 -1.19623 66934 92468 7D+5, -2.21744 62775 88453 8D+7,
73      4 +3.89280 42131 12014 1D+6, -3.91546 07380 90955 5D+8/
74       DATA Q4
75      1/+3.41718 75000 00000 0D+1, -1.60708 92658 72208 5D+3,
76      2 +3.57300 29805 85081 1D+4, -4.83547 43616 21635 1D+5,
77      3 +4.28559 62461 17490 4D+6, -2.49033 37574 05403 3D+7,
78      4 +8.91925 76757 56121 1D+7, -1.65254 29972 52109 1D+8/
79       DATA A1
80      1/-2.18086 38152 07237 1D+0, -2.19010 23385 48806 9D+1,
81      2 +9.30816 38566 21651 5D+0, +2.50762 81129 35598 3D+1,
82      3 -3.31842 53199 72211 2D+1, +6.01217 99083 00804 8D+1,
83      4 -4.32531 13287 81345 8D+1, +1.00443 10922 80779 1D+0/
84       DATA B1
85      1/+0.00000 00000 00000 0D+0, +3.93707 70185 27150 0D+0,
86      2 +3.00892 64837 29152 0D+2, -6.25041 16167 18755 4D+0,
87      3 +1.00367 43951 67257 7D+3, +1.43256 73812 19376 0D+1,
88      4 +2.73624 11988 93280 6D+3, +5.27468 85196 29078 5D-1/
89       DATA A2
90      1/-3.48334 65360 28526 1D+0, -1.86545 45488 33988 4D+1,
91      2 -8.28561 99414 06413 2D+0, -3.23467 33030 54034 6D+1,
92      3 +1.79601 68876 92516 4D+1, +1.75656 31546 96144 2D+0,
93      4 -1.95022 32128 96598 2D+0, +9.99994 29607 47082 9D-1/
94       DATA B2
95      1/+0.00000 00000 00000 0D+0, +6.95000 65588 74339 8D+1,
96      2 +5.72837 19383 73237 2D+1, +2.57776 38423 84398 7D+1,
97      3 +7.60761 14800 77345 8D+2, +2.89516 72792 51350 5D+1,
98      4 -3.43942 26689 98699 7D+0, +1.00083 86740 26391 2D+0/
99       DATA A3
100      1/-5.31686 62349 44816 2D+1, +8.91263 82257 37077 5D+0,
101      2 -1.39381 36036 44050 7D+0, -3.08336 26905 17627 0D+1,
102      3 -7.49289 16779 28844 3D+0, -5.00140 34551 59243 5D+0,
103      4 -3.00000 01678 20851 8D+0, +1.00000 00000 00583 9D+0/
104       DATA B3
105      1/+0.00000 00000 00000 0D+0, +1.04745 36265 24683 0D+3,
106      2 -6.74704 58046 58324 3D+0, +2.95999 39948 68313 3D+2,
107      3 -4.31325 83614 66279 6D+0, -7.90404 99229 89255 1D+0,
108      4 -2.99996 43294 44464 6D+0, +1.99999 99992 41308 9D+0/
109
110 #if !defined(CERNLIB_DOUBLE)
111        ENTRY EXPINT
112 #endif
113        LEX=.FALSE.
114        GO TO 9
115
116 #if !defined(CERNLIB_DOUBLE)
117        ENTRY REXPIE
118 #endif
119 #if defined(CERNLIB_DOUBLE)
120 #  ifdef CERNLIB_MSSTDCALL
121        ENTRY DEXPIE(x)
122 #  else
123        ENTRY DEXPIE
124 #  endif
125 #endif
126        LEX=.TRUE.
127
128     9 IF(X .LE. -24) THEN
129        AP=A3(1)-X
130        DO 1 I = 2,7
131     1  AP=A3(I)-X+B3(I)/AP
132        H=(1-(A3(8)+B3(8)/AP)/X)/X
133        IF(.NOT.LEX) H=EXP(-X)*H
134       ELSE IF(X .LE. -12) THEN
135        AP=A2(1)-X
136        DO 2 I = 2,7
137     2  AP=A2(I)-X+B2(I)/AP
138        H=(A2(8)+B2(8)/AP)/X
139        IF(.NOT.LEX) H=EXP(-X)*H
140       ELSE IF(X .LE. -6) THEN
141        AP=A1(1)-X
142        DO 3 I = 2,7
143     3  AP=A1(I)-X+B1(I)/AP
144        H=(A1(8)+B1(8)/AP)/X
145        IF(.NOT.LEX) H=EXP(-X)*H
146       ELSE IF(X .LT. 0) THEN
147        V=R3*X-2
148        BP=0
149        DP=P4(1)
150        DO 4 I = 2,8
151        AP=BP
152        BP=DP
153     4  DP=P4(I)-AP+V*BP
154        BQ=0
155        DQ=Q4(1)
156        DO 14 I = 2,8
157        AQ=BQ
158        BQ=DQ
159    14  DQ=Q4(I)-AQ+V*BQ
160        H=-LOG(-X/X0)+(X+X0)*(DP-AP)/(DQ-AQ)
161        IF(LEX) H=EXP(X)*H
162       ELSE IF(X .EQ. 0) THEN
163        H=0
164        IF(.NOT.LEX) CALL MTLPRT(NAME ,'C337.1','ARGUMENT X = 0')
165        IF(     LEX) CALL MTLPRT(NAMEE,'C337.1','ARGUMENT X = 0')
166       ELSE IF(X .LT. 1) THEN
167        AP=P1(1)
168        AQ=Q1(1)
169        DO 5 I = 2,5
170        AP=P1(I)+X*AP
171     5  AQ=Q1(I)+X*AQ
172        H=-LOG(X)+AP/AQ
173        IF(LEX) H=EXP(X)*H
174       ELSE IF(X .LE. 4) THEN
175        Y=1/X
176        AP=P2(1)
177        AQ=Q2(1)
178        DO 6 I = 2,7
179        AP=P2(I)+Y*AP
180     6  AQ=Q2(I)+Y*AQ
181        H=AP/AQ
182        IF(.NOT.LEX) H=EXP(-X)*H
183       ELSE
184        Y=1/X
185        AP=P3(1)
186        AQ=Q3(1)
187        DO 7 I = 2,7
188        AP=P3(I)+Y*AP
189     7  AQ=Q3(I)+Y*AQ
190        H=Y*(1+Y*AP/AQ)
191        IF(.NOT.LEX) H=EXP(-X)*H
192       END IF
193 #if !defined(CERNLIB_DOUBLE)
194       REXPIN=H
195 #endif
196 #if defined(CERNLIB_DOUBLE)
197       DEXPIN=H
198 #endif
199       RETURN
200       END