312 SUBROUTINE dppsvx( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
313 $ x, ldx, rcond, ferr, berr, work, iwork, info )
321 CHARACTER EQUED, FACT, UPLO
322 INTEGER INFO, LDB, LDX, N, NRHS
323 DOUBLE PRECISION RCOND
327 DOUBLE PRECISION AFP( * ), AP( * ), B( ldb, * ), BERR( * ),
328 $ ferr( * ), s( * ), work( * ), x( ldx, * )
334 DOUBLE PRECISION ZERO, ONE
335 parameter ( zero = 0.0d+0, one = 1.0d+0 )
338 LOGICAL EQUIL, NOFACT, RCEQU
340 DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
344 DOUBLE PRECISION DLAMCH, DLANSP
345 EXTERNAL lsame, dlamch, dlansp
357 nofact = lsame( fact,
'N' )
358 equil = lsame( fact,
'E' )
359 IF( nofact .OR. equil )
THEN
363 rcequ = lsame( equed,
'Y' )
364 smlnum = dlamch(
'Safe minimum' )
365 bignum = one / smlnum
370 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
373 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
376 ELSE IF( n.LT.0 )
THEN
378 ELSE IF( nrhs.LT.0 )
THEN
380 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
381 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
388 smin = min( smin, s( j ) )
389 smax = max( smax, s( j ) )
391 IF( smin.LE.zero )
THEN
393 ELSE IF( n.GT.0 )
THEN
394 scond = max( smin, smlnum ) / min( smax, bignum )
400 IF( ldb.LT.max( 1, n ) )
THEN
402 ELSE IF( ldx.LT.max( 1, n ) )
THEN
409 CALL xerbla(
'DPPSVX', -info )
417 CALL dppequ( uplo, n, ap, s, scond, amax, infequ )
418 IF( infequ.EQ.0 )
THEN
422 CALL dlaqsp( uplo, n, ap, s, scond, amax, equed )
423 rcequ = lsame( equed,
'Y' )
432 b( i, j ) = s( i )*b( i, j )
437 IF( nofact .OR. equil )
THEN
441 CALL dcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
442 CALL dpptrf( uplo, n, afp, info )
454 anorm = dlansp(
'I', uplo, n, ap, work )
458 CALL dppcon( uplo, n, afp, anorm, rcond, work, iwork, info )
462 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
463 CALL dpptrs( uplo, n, nrhs, afp, x, ldx, info )
468 CALL dpprfs( uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr,
469 $ work, iwork, info )
477 x( i, j ) = s( i )*x( i, j )
481 ferr( j ) = ferr( j ) / scond
487 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPPRFS
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
subroutine dpptrf(UPLO, N, AP, INFO)
DPPTRF
subroutine dlaqsp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
DLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppeq...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPTRS
subroutine dppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
DPPEQU
subroutine dppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...