2 REAL FUNCTION betai (X, PIN, QIN)
38 SAVE eps, alneps, sml, alnsml, first
49 IF (x .LT. 0. .OR. x .GT. 1.0) CALL
xermsg(
'SLATEC',
'BETAI',
50 +
'X IS NOT IN THE RANGE (0,1)', 1, 2)
51 IF (pin .LE. 0. .OR. qin .LE. 0.) CALL
xermsg(
'SLATEC',
'BETAI',
52 +
'P AND/OR Q IS LE ZERO', 2, 2)
57 IF (q.LE.p .AND. x.LT.0.8) go to 20
58 IF (x.LT.0.2) go to 20
63 20
IF ((p+q)*y/(p+1.).LT.eps) go to 80
69 IF (ps.EQ.0.) ps = 1.0
72 IF (xb.LT.alnsml) go to 40
76 IF (ps.EQ.1.0) go to 40
78 n =
max(alneps/
log(y), 4.0e0)
80 term = term*(i-ps)*y/i
86 40
IF (q.LE.1.0) go to 70
89 ib =
max(xb/alnsml, 0.0e0)
90 term =
exp(xb - ib*alnsml)
96 IF (q.EQ.
REAL(n)) n = n - 1
98 IF (p1.LE.1.0 .AND. term/eps.LE.finsum) go to 60
99 term = (q-i+1)*c*term/(p+q-i)
101 IF (term.GT.1.0) ib = ib - 1
102 IF (term.GT.1.0) term = term*sml
104 IF (ib.EQ.0) finsum = finsum + term
108 70
IF (y.NE.x .OR. p.NE.pin)
betai = 1.0 -
betai
114 IF (xb.GT.alnsml .AND. y.NE.0.)
betai =
exp(xb)
octave_value log(void) const
charNDArray max(char d, const charNDArray &m)
subroutine xermsg(LIBRAR, SUBROU, MESSG, NERR, LEVEL)
real function betai(X, PIN, QIN)
charNDArray min(char d, const charNDArray &m)