This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / g / probold.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:42  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10 #if defined(CERNLIB_OBSOLETE)
11 C     This corresponds to PROB,IF=DOUBLE and PROB64,IF=-DOUBLE
12       FUNCTION PROB(CHI2,N)
13
14       CHARACTER NAME*(*)
15       CHARACTER*80 ERRTXT
16       PARAMETER (NAME = 'PROB')
17       PARAMETER (R1 = 1, HF = R1/2, TH = R1/3, F1 = 2*R1/9)
18       PARAMETER (C1 = 1.12837 91670 95513D0)
19 C      PARAMETER (UP = 340)
20       PARAMETER (UP = 170)
21
22       X=HF*CHI2
23       IF(N .LE. 0) THEN
24        H=0
25        WRITE(ERRTXT,101) N
26        CALL MTLPRT(NAME,'G100.1',ERRTXT)
27       ELSEIF(CHI2 .LT. 0) THEN
28        H=0
29        WRITE(ERRTXT,102) CHI2
30        CALL MTLPRT(NAME,'G100.2',ERRTXT)
31       ELSEIF(CHI2 .GT. UP) THEN
32        H=0
33       ELSEIF(N .GT. 100) THEN
34        S=R1/N
35        T=F1*S
36        H=HF*ERFC(((CHI2*S)**TH-(1-T))/SQRT(2*T))
37       ELSEIF(N .EQ. 1) THEN
38        H=ERFC(SQRT(X))
39       ELSE
40        S=1
41        T=1
42        M=N/2
43        IF(2*M .EQ. N) THEN
44         DO 1 I = 1,M-1
45         T=X*T/I
46     1   S=S+T
47         H=S*EXP(-X)
48        ELSE
49         DO 2 I=1,M-1
50         T=T*CHI2/(2*I+1)
51     2   S=S+T
52         W=SQRT(X)
53         H=C1*W*S*EXP(-X)+ERFC(W)
54        ENDIF
55       ENDIF
56       PROB=H
57       RETURN
58   101 FORMAT('N = ',I6,' < 1')
59   102 FORMAT('X = ',1P,E20.10,' < 0')
60       END
61 #endif