501 SUBROUTINE dsysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
502 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
503 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
504 $ NPARAMS, PARAMS, WORK, IWORK, INFO )
511 CHARACTER EQUED, FACT, UPLO
512 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
514 DOUBLE PRECISION RCOND, RPVGRW
517 INTEGER IPIV( * ), IWORK( * )
518 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), B( ldb, * ),
519 $ x( ldx, * ), work( * )
520 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
521 $ err_bnds_norm( nrhs, * ),
522 $ err_bnds_comp( nrhs, * )
528 DOUBLE PRECISION ZERO, ONE
529 parameter( zero = 0.0d+0, one = 1.0d+0 )
530 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
531 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
532 INTEGER CMP_ERR_I, PIV_GROWTH_I
533 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
535 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
536 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
540 LOGICAL EQUIL, NOFACT, RCEQU
542 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
547 DOUBLE PRECISION DLAMCH, DLA_SYRPVGRW
559 nofact = lsame( fact,
'N' )
560 equil = lsame( fact,
'E' )
561 smlnum = dlamch(
'Safe minimum' )
562 bignum = one / smlnum
563 IF( nofact .OR. equil )
THEN 567 rcequ = lsame( equed,
'Y' )
578 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
579 $ lsame( fact,
'F' ) )
THEN 581 ELSE IF( .NOT.lsame(uplo,
'U') .AND.
582 $ .NOT.lsame(uplo,
'L') )
THEN 584 ELSE IF( n.LT.0 )
THEN 586 ELSE IF( nrhs.LT.0 )
THEN 588 ELSE IF( lda.LT.max( 1, n ) )
THEN 590 ELSE IF( ldaf.LT.max( 1, n ) )
THEN 592 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
593 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN 600 smin = min( smin, s( j ) )
601 smax = max( smax, s( j ) )
603 IF( smin.LE.zero )
THEN 605 ELSE IF( n.GT.0 )
THEN 606 scond = max( smin, smlnum ) / min( smax, bignum )
612 IF( ldb.LT.max( 1, n ) )
THEN 614 ELSE IF( ldx.LT.max( 1, n ) )
THEN 621 CALL xerbla(
'DSYSVXX', -info )
629 CALL dsyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
630 IF( infequ.EQ.0 )
THEN 634 CALL dlaqsy( uplo, n, a, lda, s, scond, amax, equed )
635 rcequ = lsame( equed,
'Y' )
641 IF( rcequ )
CALL dlascl2( n, nrhs, s, b, ldb )
643 IF( nofact .OR. equil )
THEN 647 CALL dlacpy( uplo, n, n, a, lda, af, ldaf )
648 CALL dsytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
659 $ rpvgrw = dla_syrpvgrw(uplo, n, info, a, lda, af,
668 $ rpvgrw = dla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
673 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
674 CALL dsytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
679 CALL dsyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
680 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
681 $ err_bnds_comp, nparams, params, work, iwork, info )
686 CALL dlascl2 ( n, nrhs, s, x, ldx )
logical function lsame(CA, CB)
LSAME
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 dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsyequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
DSYEQUB
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
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...
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