229 SUBROUTINE zlar1v( N, B1, BN, LAMBDA, D, L, LD, LLD,
230 $ pivmin, gaptol, z, wantnc, negcnt, ztz, mingma,
231 $ r, isuppz, nrminv, resid, rqcorr, work )
240 INTEGER b1, bn, n, negcnt, r
241 DOUBLE PRECISION gaptol, lambda, mingma, nrminv, pivmin, resid,
246 DOUBLE PRECISION d( * ), l( * ), ld( * ), lld( * ),
254 DOUBLE PRECISION zero, one
255 parameter( zero = 0.0d0, one = 1.0d0 )
257 parameter( cone = ( 1.0d0, 0.0d0 ) )
261 LOGICAL sawnan1, sawnan2
262 INTEGER i, indlpl, indp, inds, indumn, neg1, neg2, r1,
264 DOUBLE PRECISION dminus, dplus, eps, s, tmp
276 eps =
dlamch(
'Precision' )
297 work( inds+b1-1 ) = lld( b1-1 )
306 s = work( inds+b1-1 ) - lambda
309 work( indlpl+i ) = ld( i ) / dplus
310 IF(dplus.LT.zero) neg1 = neg1 + 1
311 work( inds+i ) = s*work( indlpl+i )*l( i )
312 s = work( inds+i ) - lambda
315 IF( sawnan1 ) goto 60
318 work( indlpl+i ) = ld( i ) / dplus
319 work( inds+i ) = s*work( indlpl+i )*l( i )
320 s = work( inds+i ) - lambda
328 s = work( inds+b1-1 ) - lambda
331 IF(abs(dplus).LT.pivmin) dplus = -pivmin
332 work( indlpl+i ) = ld( i ) / dplus
333 IF(dplus.LT.zero) neg1 = neg1 + 1
334 work( inds+i ) = s*work( indlpl+i )*l( i )
335 IF( work( indlpl+i ).EQ.zero )
336 $ work( inds+i ) = lld( i )
337 s = work( inds+i ) - lambda
341 IF(abs(dplus).LT.pivmin) dplus = -pivmin
342 work( indlpl+i ) = ld( i ) / dplus
343 work( inds+i ) = s*work( indlpl+i )*l( i )
344 IF( work( indlpl+i ).EQ.zero )
345 $ work( inds+i ) = lld( i )
346 s = work( inds+i ) - lambda
355 work( indp+bn-1 ) = d( bn ) - lambda
356 DO 80 i = bn - 1, r1, -1
357 dminus = lld( i ) + work( indp+i )
358 tmp = d( i ) / dminus
359 IF(dminus.LT.zero) neg2 = neg2 + 1
360 work( indumn+i ) = l( i )*tmp
361 work( indp+i-1 ) = work( indp+i )*tmp - lambda
363 tmp = work( indp+r1-1 )
369 DO 100 i = bn-1, r1, -1
370 dminus = lld( i ) + work( indp+i )
371 IF(abs(dminus).LT.pivmin) dminus = -pivmin
372 tmp = d( i ) / dminus
373 IF(dminus.LT.zero) neg2 = neg2 + 1
374 work( indumn+i ) = l( i )*tmp
375 work( indp+i-1 ) = work( indp+i )*tmp - lambda
377 $ work( indp+i-1 ) = d( i ) - lambda
384 mingma = work( inds+r1-1 ) + work( indp+r1-1 )
385 IF( mingma.LT.zero ) neg1 = neg1 + 1
391 IF( abs(mingma).EQ.zero )
392 $ mingma = eps*work( inds+r1-1 )
394 DO 110 i = r1, r2 - 1
395 tmp = work( inds+i ) + work( indp+i )
397 $ tmp = eps*work( inds+i )
398 IF( abs( tmp ).LE.abs( mingma ) )
THEN
413 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
414 DO 210 i = r-1, b1, -1
415 z( i ) = -( work( indlpl+i )*z( i+1 ) )
416 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
422 ztz = ztz + dble( z( i )*z( i ) )
427 DO 230 i = r - 1, b1, -1
428 IF( z( i+1 ).EQ.zero )
THEN
429 z( i ) = -( ld( i+1 ) / ld( i ) )*z( i+2 )
431 z( i ) = -( work( indlpl+i )*z( i+1 ) )
433 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
439 ztz = ztz + dble( z( i )*z( i ) )
445 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
447 z( i+1 ) = -( work( indumn+i )*z( i ) )
448 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
454 ztz = ztz + dble( z( i+1 )*z( i+1 ) )
460 IF( z( i ).EQ.zero )
THEN
461 z( i+1 ) = -( ld( i-1 ) / ld( i ) )*z( i-1 )
463 z( i+1 ) = -( work( indumn+i )*z( i ) )
465 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
471 ztz = ztz + dble( z( i+1 )*z( i+1 ) )
480 resid = abs( mingma )*nrminv