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
550 DOUBLE PRECISION DLAMCH, DLA_SYRPVGRW
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 )
662 $ rpvgrw = dla_syrpvgrw(uplo, n, info, a, lda, af,
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 )
689 CALL
dlascl2( n, nrhs, s, x, ldx )
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
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.
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
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 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 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