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