229 SUBROUTINE slar1v( 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 REAL gaptol, lambda, mingma, nrminv, pivmin, resid,
246 REAL d( * ), l( * ), ld( * ), lld( * ),
255 parameter( zero = 0.0e0, one = 1.0e0 )
259 LOGICAL sawnan1, sawnan2
260 INTEGER i, indlpl, indp, inds, indumn, neg1, neg2, r1,
262 REAL dminus, dplus, eps, s, tmp
274 eps =
slamch(
'Precision' )
295 work( inds+b1-1 ) = lld( b1-1 )
304 s = work( inds+b1-1 ) - lambda
307 work( indlpl+i ) = ld( i ) / dplus
308 IF(dplus.LT.zero) neg1 = neg1 + 1
309 work( inds+i ) = s*work( indlpl+i )*l( i )
310 s = work( inds+i ) - lambda
313 IF( sawnan1 ) goto 60
316 work( indlpl+i ) = ld( i ) / dplus
317 work( inds+i ) = s*work( indlpl+i )*l( i )
318 s = work( inds+i ) - lambda
326 s = work( inds+b1-1 ) - lambda
329 IF(abs(dplus).LT.pivmin) dplus = -pivmin
330 work( indlpl+i ) = ld( i ) / dplus
331 IF(dplus.LT.zero) neg1 = neg1 + 1
332 work( inds+i ) = s*work( indlpl+i )*l( i )
333 IF( work( indlpl+i ).EQ.zero )
334 $ work( inds+i ) = lld( i )
335 s = work( inds+i ) - lambda
339 IF(abs(dplus).LT.pivmin) dplus = -pivmin
340 work( indlpl+i ) = ld( i ) / dplus
341 work( inds+i ) = s*work( indlpl+i )*l( i )
342 IF( work( indlpl+i ).EQ.zero )
343 $ work( inds+i ) = lld( i )
344 s = work( inds+i ) - lambda
353 work( indp+bn-1 ) = d( bn ) - lambda
354 DO 80 i = bn - 1, r1, -1
355 dminus = lld( i ) + work( indp+i )
356 tmp = d( i ) / dminus
357 IF(dminus.LT.zero) neg2 = neg2 + 1
358 work( indumn+i ) = l( i )*tmp
359 work( indp+i-1 ) = work( indp+i )*tmp - lambda
361 tmp = work( indp+r1-1 )
367 DO 100 i = bn-1, r1, -1
368 dminus = lld( i ) + work( indp+i )
369 IF(abs(dminus).LT.pivmin) dminus = -pivmin
370 tmp = d( i ) / dminus
371 IF(dminus.LT.zero) neg2 = neg2 + 1
372 work( indumn+i ) = l( i )*tmp
373 work( indp+i-1 ) = work( indp+i )*tmp - lambda
375 $ work( indp+i-1 ) = d( i ) - lambda
382 mingma = work( inds+r1-1 ) + work( indp+r1-1 )
383 IF( mingma.LT.zero ) neg1 = neg1 + 1
389 IF( abs(mingma).EQ.zero )
390 $ mingma = eps*work( inds+r1-1 )
392 DO 110 i = r1, r2 - 1
393 tmp = work( inds+i ) + work( indp+i )
395 $ tmp = eps*work( inds+i )
396 IF( abs( tmp ).LE.abs( mingma ) )
THEN
411 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
412 DO 210 i = r-1, b1, -1
413 z( i ) = -( work( indlpl+i )*z( i+1 ) )
414 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
420 ztz = ztz + z( i )*z( i )
425 DO 230 i = r - 1, b1, -1
426 IF( z( i+1 ).EQ.zero )
THEN
427 z( i ) = -( ld( i+1 ) / ld( i ) )*z( i+2 )
429 z( i ) = -( work( indlpl+i )*z( i+1 ) )
431 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
437 ztz = ztz + z( i )*z( i )
443 IF( .NOT.sawnan1 .AND. .NOT.sawnan2 )
THEN
445 z( i+1 ) = -( work( indumn+i )*z( i ) )
446 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
452 ztz = ztz + z( i+1 )*z( i+1 )
458 IF( z( i ).EQ.zero )
THEN
459 z( i+1 ) = -( ld( i-1 ) / ld( i ) )*z( i-1 )
461 z( i+1 ) = -( work( indumn+i )*z( i ) )
463 IF( (abs(z(i))+abs(z(i+1)))* abs(ld(i)).LT.gaptol )
469 ztz = ztz + z( i+1 )*z( i+1 )
478 resid = abs( mingma )*nrminv
real function slamch(CMACH)
SLAMCH
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...
logical function sisnan(SIN)
SISNAN tests input for NaN.