This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / g / probkl.F
1
2 *
3 * $Id$
4 *
5 * $Log$
6 * Revision 1.2  1997/04/08 14:39:00  mclareni
7 * A fourth term is needed for part of the range of X, Fred James
8 *
9 * Revision 1.1.1.1  1996/04/01 15:02:42  mclareni
10 * Mathlib gen
11 *
12 *
13 #include "gen/pilot.h"
14 C     This corresponds to PROBKL,IF=DOUBLE and PROBKL64,IF=-DOUBLE
15       FUNCTION PROBKL(X)
16
17       DIMENSION FJ(4),R(4)
18
19       PARAMETER (PI = 3.14159 265D0)
20       PARAMETER (W  = 2.50662 827D0)
21       PARAMETER (C1 = -PI**2/8, C2 = 9*C1, C3 = 25*C1)
22
23       DATA FJ /-2,-8,-18,-32/
24
25       U=ABS(X)
26       IF(U .LT. 0.2) THEN
27        P=1.
28       ELSEIF(U .LT. 0.755) THEN
29        V=1/U**2
30        P=1-W*(EXP(C1*V)+EXP(C2*V)+EXP(C3*V))/U
31       ELSEIF(U .LT. 6.8116) THEN
32        R(2)=0.
33        R(3)=0.
34        R(4)=0.
35        V=U**2
36        DO 1 J = 1,MAX(1,NINT(3/U))
37     1  R(J)=EXP(FJ(J)*V)
38        P=2*(R(1)-R(2)+R(3)-R(4))
39 CCC         PRINT '(35x,4e10.2)', (R(JJ),JJ=1,4)
40       ELSE
41        P=0
42       ENDIF
43       PROBKL=P
44       RETURN
45       END
46
47
48
49
50
51