5 * Revision 1.1.1.1 1996/04/01 15:02:33 mclareni
10 SUBROUTINE BISECT(N,EPS1,D,E,E2,LB,UB,MM,M,W,IND,IERR,RV4,RV5)
11 INTEGER I,J,K,L,M,N,P,Q,R,S,II,MM,M1,M2,TAG,IERR,ISTURM
12 REAL D(N),E(N),E2(N),W(MM),RV4(N),RV5(N)
13 REAL U,V,LB,T1,T2,UB,XU,X0,X1,EPS1,MACHEP
15 #if defined(CERNLIB_CDC)
18 #if !defined(CERNLIB_CDC)
26 IF (I .EQ. 1) GO TO 20
27 IF (ABS(E(I)) .GT. MACHEP * (ABS(D(I)) + ABS(D(I-1))))
41 IF (M .GT. MM) GO TO 980
44 100 IF (R .EQ. M) GO TO 1001
54 IF (Q .EQ. N) GO TO 110
57 110 XU = MIN(D(Q)-(X1+U),XU)
58 X0 = MAX(D(Q)+(X1+U),X0)
59 IF (V .EQ. 0.0) GO TO 140
61 140 X1 = MAX(ABS(XU),ABS(X0)) * MACHEP
62 IF (EPS1 .LE. 0.0) EPS1 = -X1
63 IF (P .NE. Q) GO TO 180
64 IF (T1 .GT. D(P) .OR. D(P) .GE. T2) GO TO 940
80 IF (M1 .GT. M2) GO TO 940
91 IF (XU .GE. RV4(I)) GO TO 260
95 280 IF (X0 .GT. RV5(K)) X0 = RV5(K)
96 300 X1 = (XU + X0) * 0.5
97 IF ((X0 - XU) .LE. (2.0 * MACHEP *
98 X (ABS(XU) + ABS(X0)) + ABS(EPS1))) GO TO 420
102 IF (U .NE. 0.0) GO TO 325
103 V = ABS(E(I)) / MACHEP
106 330 U = D(I) - X1 - V
107 IF (U .LT. 0.0) S = S + 1
109 GO TO (60,80,200,220,360), ISTURM
110 360 IF (S .GE. K) GO TO 400
112 IF (S .GE. M1) GO TO 380
116 IF (RV5(S) .GT. X1) RV5(S) = X1
122 IF (K .GE. M1) GO TO 250
128 IF (J .GT. S) GO TO 910
129 IF (K .GT. M2) GO TO 940
130 IF (RV5(K) .GE. W(L)) GO TO 915
142 940 IF (Q .LT. N) GO TO 100