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
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 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 ...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function dlansp(NORM, UPLO, N, AP, WORK)
DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
subroutine dlaqsp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
DLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppeq...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPTRS
logical function lsame(CA, CB)
LSAME
subroutine dpptrf(UPLO, N, AP, INFO)
DPPTRF
subroutine dppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
DPPEQU
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
subroutine dpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPPRFS