225 SUBROUTINE slar1v( N, B1, BN, LAMBDA, D, L, LD, LLD,
226 $ PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA,
227 $ R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )
235 INTEGER B1, BN, N, NEGCNT, R
236 REAL GAPTOL, LAMBDA, MINGMA, NRMINV, PIVMIN, RESID,
241 REAL D( * ), L( * ), LD( * ), LLD( * ),
250 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
254 LOGICAL SAWNAN1, SAWNAN2
255 INTEGER I, INDLPL, INDP, INDS, INDUMN, NEG1, NEG2, R1,
257 REAL DMINUS, DPLUS, EPS, S, TMP
262 EXTERNAL sisnan, slamch
269 eps = slamch(
'Precision' )
290 work( inds+b1-1 ) = lld( b1-1 )
299 s = work( inds+b1-1 ) - lambda
302 work( indlpl+i ) = ld( i ) / dplus
303 IF(dplus.LT.zero) neg1 = neg1 + 1
304 work( inds+i ) = s*work( indlpl+i )*l( i )
305 s = work( inds+i ) - lambda
307 sawnan1 = sisnan( s )
308 IF( sawnan1 )
GOTO 60
311 work( indlpl+i ) = ld( i ) / dplus
312 work( inds+i ) = s*work( indlpl+i )*l( i )
313 s = work( inds+i ) - lambda
315 sawnan1 = sisnan( s )
321 s = work( inds+b1-1 ) - lambda
324 IF(abs(dplus).LT.pivmin) dplus = -pivmin
325 work( indlpl+i ) = ld( i ) / dplus
326 IF(dplus.LT.zero) neg1 = neg1 + 1
327 work( inds+i ) = s*work( indlpl+i )*l( i )
328 IF( work( indlpl+i ).EQ.zero )
329 $ work( inds+i ) = lld( i )
330 s = work( inds+i ) - lambda
334 IF(abs(dplus).LT.pivmin) dplus = -pivmin
335 work( indlpl+i ) = ld( i ) / dplus
336 work( inds+i ) = s*work( indlpl+i )*l( i )
337 IF( work( indlpl+i ).EQ.zero )
338 $ work( inds+i ) = lld( i )
339 s = work( inds+i ) - lambda
348 work( indp+bn-1 ) = d( bn ) - lambda
349 DO 80 i = bn - 1, r1, -1
350 dminus = lld( i ) + work( indp+i )
351 tmp = d( i ) / dminus
352 IF(dminus.LT.zero) neg2 = neg2 + 1
353 work( indumn+i ) = l( i )*tmp
354 work( indp+i-1 ) = work( indp+i )*tmp - lambda
356 tmp = work( indp+r1-1 )
357 sawnan2 = sisnan( tmp )
362 DO 100 i = bn-1, r1, -1
363 dminus = lld( i ) + work( indp+i )
364 IF(abs(dminus).LT.pivmin) dminus = -pivmin
365 tmp = d( i ) / dminus
366 IF(dminus.LT.zero) neg2 = neg2 + 1
367 work( indumn+i ) = l( i )*tmp
368 work( indp+i-1 ) = work( indp+i )*tmp - lambda
370 $ work( indp+i-1 ) = d( i ) - lambda
377 mingma = work( inds+r1-1 ) + work( indp+r1-1 )
378 IF( mingma.LT.zero ) neg1 = neg1 + 1
384 IF( abs(mingma).EQ.zero )
385 $ mingma = eps*work( inds+r1-1 )
387 DO 110 i = r1, r2 - 1
388 tmp = work( inds+i ) + work( indp+i )
390 $ tmp = eps*work( inds+i )
391 IF( abs( tmp ).LE.abs( mingma ) )
THEN
406 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
407 DO 210 i = r-1, b1, -1
408 z( i ) = -( work( indlpl+i )*z( i+1 ) )
409 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
415 ztz = ztz + z( i )*z( i )
420 DO 230 i = r - 1, b1, -1
421 IF( z( i+1 ).EQ.zero )
THEN
422 z( i ) = -( ld( i+1 ) / ld( i ) )*z( i+2 )
424 z( i ) = -( work( indlpl+i )*z( i+1 ) )
426 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
432 ztz = ztz + z( i )*z( i )
438 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
440 z( i+1 ) = -( work( indumn+i )*z( i ) )
441 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
447 ztz = ztz + z( i+1 )*z( i+1 )
453 IF( z( i ).EQ.zero )
THEN
454 z( i+1 ) = -( ld( i-1 ) / ld( i ) )*z( i-1 )
456 z( i+1 ) = -( work( indumn+i )*z( i ) )
458 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
464 ztz = ztz + z( i+1 )*z( i+1 )
473 resid = abs( mingma )*nrminv
subroutine slar1v(n, b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, negcnt, ztz, mingma, r, isuppz, nrminv, resid, rqcorr, work)
SLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the...