503 SUBROUTINE dsysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
504 $ equed, s,
b, ldb,
x, ldx, rcond, rpvgrw, berr,
505 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
506 $ nparams, params, work, iwork, info )
514 CHARACTER equed, fact, uplo
515 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
517 DOUBLE PRECISION rcond, rpvgrw
520 INTEGER ipiv( * ), iwork( * )
521 DOUBLE PRECISION a( lda, * ), af( ldaf, * ),
b( ldb, * ),
522 $
x( ldx, * ), work( * )
523 DOUBLE PRECISION s( * ), params( * ), berr( * ),
524 $ err_bnds_norm( nrhs, * ),
525 $ err_bnds_comp( nrhs, * )
531 DOUBLE PRECISION zero, one
532 parameter( zero = 0.0d+0, one = 1.0d+0 )
533 INTEGER final_nrm_err_i, final_cmp_err_i, berr_i
534 INTEGER rcond_i, nrm_rcond_i, nrm_err_i, cmp_rcond_i
535 INTEGER cmp_err_i, piv_growth_i
536 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
538 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
539 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
543 LOGICAL equil, nofact, rcequ
545 DOUBLE PRECISION amax, bignum, smin, smax, scond, smlnum
562 nofact =
lsame( fact,
'N' )
563 equil =
lsame( fact,
'E' )
564 smlnum =
dlamch(
'Safe minimum' )
565 bignum = one / smlnum
566 IF( nofact .OR. equil )
THEN
570 rcequ =
lsame( equed,
'Y' )
581 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
582 $
lsame( fact,
'F' ) )
THEN
584 ELSE IF( .NOT.
lsame(uplo,
'U') .AND.
585 $ .NOT.
lsame(uplo,
'L') )
THEN
587 ELSE IF( n.LT.0 )
THEN
589 ELSE IF( nrhs.LT.0 )
THEN
591 ELSE IF( lda.LT.max( 1, n ) )
THEN
593 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
595 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
596 $ ( rcequ .OR.
lsame( equed,
'N' ) ) )
THEN
603 smin = min( smin, s(
j ) )
604 smax = max( smax, s(
j ) )
606 IF( smin.LE.zero )
THEN
608 ELSE IF( n.GT.0 )
THEN
609 scond = max( smin, smlnum ) / min( smax, bignum )
615 IF( ldb.LT.max( 1, n ) )
THEN
617 ELSE IF( ldx.LT.max( 1, n ) )
THEN
624 CALL
xerbla(
'DSYSVXX', -info )
632 CALL
dsyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
633 IF( infequ.EQ.0 )
THEN
637 CALL
dlaqsy( uplo, n, a, lda, s, scond, amax, equed )
638 rcequ =
lsame( equed,
'Y' )
644 IF( rcequ ) CALL
dlascl2( n, nrhs, s,
b, ldb )
646 IF( nofact .OR. equil )
THEN
650 CALL
dlacpy( uplo, n, n, a, lda, af, ldaf )
651 CALL
dsytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
671 $ rpvgrw =
dla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
676 CALL
dlacpy(
'Full', n, nrhs,
b, ldb,
x, ldx )
677 CALL
dsytrs( uplo, n, nrhs, af, ldaf, ipiv,
x, ldx, info )
682 CALL
dsyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
683 $ s,
b, ldb,
x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
684 $ err_bnds_comp, nparams, params, work, iwork, info )
LOGICAL function lsame(CA, CB)
LSAME
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
DOUBLE PRECISION function dla_syrpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
DLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite m...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
subroutine dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dsysvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DSYSVXX
subroutine dsyequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
DSYEQUB
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dsyrfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DSYRFSX
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF