1 SUBROUTINE dlarrb2( N, D, LLD, IFIRST, ILAST, RTOL1,
2 $ RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
3 $ PIVMIN, LGPVMN, LGSPDM, TWIST, INFO )
12 INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
13 DOUBLE PRECISION LGPVMN, LGSPDM, PIVMIN,
18 DOUBLE PRECISION D( * ), LLD( * ), W( * ),
19 $ werr( * ), wgap( * ), work( * )
118 DOUBLE PRECISION ZERO, TWO, HALF
119 PARAMETER ( ZERO = 0.0d0, two = 2.0d0,
124 INTEGER I, I1, II, INDLLD, IP, ITER, J, K, NEGCNT,
125 $ NEXT, NINT, OLNINT, PREV, R
126 DOUBLE PRECISION BACK, CVRGD, GAP, LEFT, LGAP, MID, MNWDTH,
127 $ RGAP, RIGHT, SAVGAP, TMP, WIDTH
132 DOUBLE PRECISION DLAMCH
134 EXTERNAL disnan, dlamch,
150 maxitr = int( ( lgspdm - lgpvmn ) / log( two ) ) + 2
151 mnwdth = two * pivmin
158 work(indlld+i-1) = d(j)
159 work(indlld+i) = lld(j)
161 work(indlld+2*n-1) = d(n)
163 IF((r.LT.1).OR.(r.GT.n)) r = n
178 rgap = wgap( i1-offset )
182 left = w( ii ) - werr( ii )
183 right = w( ii ) + werr( ii )
186 gap =
min( lgap, rgap )
188 IF((abs(left).LE.16*pivmin).OR.(abs(right).LE.16*pivmin))
202 negcnt = dlaneg2a( n, work(indlld+1), left, pivmin, r )
203 IF( negcnt.GT.i-1 )
THEN
214 negcnt = dlaneg2a( n, work(indlld+1),right, pivmin, r )
216 IF( negcnt.LT.i )
THEN
223 width = half*abs( left - right )
224 tmp =
max( abs( left ), abs( right ) )
225 cvrgd =
max(rtol1*gap,rtol2*tmp)
226 IF( width.LE.cvrgd .OR. width.LE.mnwdth )
THEN
233 IF((i.EQ.i1).AND.(i.LT.ilast)) i1 = i + 1
234 IF((prev.GE.i1).AND.(i.LE.ilast)) iwork( 2*prev-1 ) = i + 1
256 DO 100 ip = 1, olnint
261 IF(ii.GT.1) lgap = wgap( ii-1 )
262 gap =
min( lgap, rgap )
266 mid = half*( left + right )
269 tmp =
max( abs( left ), abs( right ) )
270 cvrgd =
max(rtol1*gap,rtol2*tmp)
271 IF( ( width.LE.cvrgd ) .OR. ( width.LE.mnwdth ).OR.
272 $ ( iter.EQ.maxitr ) )
THEN
281 IF(prev.GE.i1) iwork( 2*prev-1 ) = next
290 negcnt = dlaneg2a( n, work(indlld+1), mid, pivmin, r )
291 IF( negcnt.LE.i-1 )
THEN
302 IF( ( nint.GT.0 ).AND.(iter.LE.maxitr) )
GO TO 80
308 savgap = wgap( ilast-offset )
310 left = work( 2*ifirst-1 )
311 DO 110 i = ifirst, ilast
317 IF( iwork( k-1 ).EQ.0 )
THEN
318 w( ii ) = half*( left+right )
319 werr( ii ) = right - w( ii )
323 wgap( ii ) =
max( zero, left - right )
326 wgap( ilast-offset ) = savgap
336 FUNCTION dlaneg2( N, D, LLD, SIGMA, PIVMIN, R )
344 DOUBLE PRECISION pivmin, sigma
347 DOUBLE PRECISION d( * ), lld( * )
349 DOUBLE PRECISION zero
350 PARAMETER ( zero = 0.0d0 )
353 PARAMETER ( blklen = 2048 )
356 INTEGER bj, j, neg1, neg2, negcnt, to
357 DOUBLE PRECISION dminus, dplus, gamma, p, s, t, tmp, xsav
370 DO 210 bj = 1, r-1, blklen
374 IF ( to.LE.r-1 )
THEN
378 IF( dplus.LT.zero ) neg1=neg1 + 1
379 s = t*lld( j ) / dplus
385 IF( dplus.LT.zero ) neg1=neg1 + 1
386 s = t*lld( j ) / dplus
395 IF ( to.LE.r-1 )
THEN
399 IF(abs(dplus).LT.pivmin)
401 tmp = lld( j ) / dplus
405 IF( tmp.EQ.zero ) s = lld( j )
411 IF(abs(dplus).LT.pivmin)
413 tmp = lld( j ) / dplus
414 IF( dplus.LT.zero ) neg1=neg1+1
416 IF( tmp.EQ.zero ) s = lld( j )
420 negcnt = negcnt + neg1
426 DO 230 bj = n-1, r, -blklen
432 dminus = lld( j ) + p
433 IF( dminus.LT.zero ) neg2=neg2+1
435 p = tmp * d( j ) - sigma
439 dminus = lld( j ) + p
440 IF( dminus.LT.zero ) neg2=neg2+1
442 p = tmp * d( j ) - sigma
453 dminus = lld( j ) + p
454 IF(abs(dminus).LT.pivmin)
456 tmp = d( j ) / dminus
465 dminus = lld( j ) + p
466 IF(abs(dminus).LT.pivmin)
468 tmp = d( j ) / dminus
477 negcnt = negcnt + neg2
483 IF( gamma.LT.zero ) negcnt = negcnt+1
490 FUNCTION dlaneg2a( N, DLLD, SIGMA, PIVMIN, R )
498 DOUBLE PRECISION pivmin, sigma
501 DOUBLE PRECISION dlld( * )
503 DOUBLE PRECISION zero
504 PARAMETER ( zero = 0.0d0 )
507 PARAMETER ( blklen = 512 )
514 INTEGER bj, i, j, nb, neg1, neg2, negcnt, nx
515 DOUBLE PRECISION dminus, dplus, gamma, p, s, t, tmp, xsav
528 nb = int((r-1)/blklen)
531 DO 210 bj = 1, nx, blklen
534 DO 21 j = bj, bj+blklen-1
537 dplus = dlld( i-1 ) + t
538 IF( dplus.LT.zero ) neg1=neg1 + 1
539 s = t*dlld( i ) / dplus
546 DO 23 j = bj, bj+blklen-1
549 dplus = dlld( i-1 ) + t
550 IF(abs(dplus).LT.pivmin)
552 tmp = dlld( i ) / dplus
556 IF( tmp.EQ.zero ) s = dlld( i )
559 negcnt = negcnt + neg1
567 dplus = dlld( i-1 ) + t
568 IF( dplus.LT.zero ) neg1=neg1 + 1
569 s = t*dlld( i ) / dplus
579 dplus = dlld( i-1 ) + t
580 IF(abs(dplus).LT.pivmin)
582 tmp = dlld( i ) / dplus
583 IF( dplus.LT.zero ) neg1=neg1+1
585 IF( tmp.EQ.zero ) s = dlld( i )
588 negcnt = negcnt + neg1
592 nb = int((n-r)/blklen)
594 p = dlld( 2*n-1 ) - sigma
595 DO 230 bj = n-1, nx, -blklen
598 DO 25 j = bj, bj-blklen+1, -1
600 dminus = dlld( i ) + p
601 IF( dminus.LT.zero ) neg2=neg2+1
603 p = tmp * dlld( i-1 ) - sigma
610 DO 27 j = bj, bj-blklen+1, -1
612 dminus = dlld( i ) + p
613 IF(abs(dminus).LT.pivmin)
615 tmp = dlld( i-1 ) / dminus
620 $ p = dlld( i-1 ) - sigma
623 negcnt = negcnt + neg2
628 DO 26 j = nx-1, r, -1
630 dminus = dlld( i ) + p
631 IF( dminus.LT.zero ) neg2=neg2+1
633 p = tmp * dlld( i-1 ) - sigma
640 DO 28 j = nx-1, r, -1
642 dminus = dlld( i ) + p
643 IF(abs(dminus).LT.pivmin)
645 tmp = dlld( i-1 ) / dminus
650 $ p = dlld( i-1 ) - sigma
653 negcnt = negcnt + neg2
658 IF( gamma.LT.zero ) negcnt = negcnt+1