504 SUBROUTINE ssysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
505 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
506 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
507 $ NPARAMS, PARAMS, WORK, IWORK, INFO )
514 CHARACTER EQUED, FACT, UPLO
515 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
520 INTEGER IPIV( * ), IWORK( * )
521 REAL A( lda, * ), AF( ldaf, * ), B( ldb, * ),
522 $ x( ldx, * ), work( * )
523 REAL S( * ), PARAMS( * ), BERR( * ),
524 $ err_bnds_norm( nrhs, * ),
525 $ err_bnds_comp( nrhs, * )
532 parameter( zero = 0.0e+0, one = 1.0e+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 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
550 REAL SLAMCH, SLA_SYRPVGRW
562 nofact = lsame( fact,
'N' )
563 equil = lsame( fact,
'E' )
564 smlnum = slamch(
'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(
'SSYSVXX', -info )
632 CALL ssyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
633 IF( infequ.EQ.0 )
THEN 637 CALL slaqsy( uplo, n, a, lda, s, scond, amax, equed )
638 rcequ = lsame( equed,
'Y' )
644 IF( rcequ )
CALL slascl2( n, nrhs, s, b, ldb )
646 IF( nofact .OR. equil )
THEN 650 CALL slacpy( uplo, n, n, a, lda, af, ldaf )
651 CALL ssytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
662 $ rpvgrw = sla_syrpvgrw(uplo, n, info, a, lda, af,
671 $ rpvgrw = sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
676 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
677 CALL ssytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
682 CALL ssyrfsx( 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 slascl2 ( n, nrhs, s, x, ldx )
logical function lsame(CA, CB)
LSAME
real function sla_syrpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
SLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite m...
subroutine slaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssyrfsx(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)
SSYRFSX
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a matrix.
real function slamch(CMACH)
SLAMCH
subroutine ssysvxx(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)
SSYSVXX
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssyequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
SSYEQUB