506 SUBROUTINE ssysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
507 $ equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr,
508 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
509 $ nparams, params, work, iwork, info )
517 CHARACTER EQUED, FACT, UPLO
518 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
523 INTEGER IPIV( * ), IWORK( * )
524 REAL A( lda, * ), AF( ldaf, * ), B( ldb, * ),
525 $ x( ldx, * ), work( * )
526 REAL S( * ), PARAMS( * ), BERR( * ),
527 $ err_bnds_norm( nrhs, * ),
528 $ err_bnds_comp( nrhs, * )
535 parameter ( zero = 0.0e+0, one = 1.0e+0 )
536 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
537 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
538 INTEGER CMP_ERR_I, PIV_GROWTH_I
539 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
541 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
542 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
546 LOGICAL EQUIL, NOFACT, RCEQU
548 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
553 REAL SLAMCH, SLA_SYRPVGRW
565 nofact = lsame( fact,
'N' )
566 equil = lsame( fact,
'E' )
567 smlnum = slamch(
'Safe minimum' )
568 bignum = one / smlnum
569 IF( nofact .OR. equil )
THEN
573 rcequ = lsame( equed,
'Y' )
584 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
585 $ lsame( fact,
'F' ) )
THEN
587 ELSE IF( .NOT.lsame(uplo,
'U') .AND.
588 $ .NOT.lsame(uplo,
'L') )
THEN
590 ELSE IF( n.LT.0 )
THEN
592 ELSE IF( nrhs.LT.0 )
THEN
594 ELSE IF( lda.LT.max( 1, n ) )
THEN
596 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
598 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
599 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
606 smin = min( smin, s( j ) )
607 smax = max( smax, s( j ) )
609 IF( smin.LE.zero )
THEN
611 ELSE IF( n.GT.0 )
THEN
612 scond = max( smin, smlnum ) / min( smax, bignum )
618 IF( ldb.LT.max( 1, n ) )
THEN
620 ELSE IF( ldx.LT.max( 1, n ) )
THEN
627 CALL xerbla(
'SSYSVXX', -info )
635 CALL ssyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
636 IF( infequ.EQ.0 )
THEN
640 CALL slaqsy( uplo, n, a, lda, s, scond, amax, equed )
641 rcequ = lsame( equed,
'Y' )
647 IF( rcequ )
CALL slascl2( n, nrhs, s, b, ldb )
649 IF( nofact .OR. equil )
THEN
653 CALL slacpy( uplo, n, n, a, lda, af, ldaf )
654 CALL ssytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
665 $ rpvgrw = sla_syrpvgrw(uplo, n, info, a, lda, af,
674 $ rpvgrw = sla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
679 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
680 CALL ssytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
685 CALL ssyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
686 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
687 $ err_bnds_comp, nparams, params, work, iwork, info )
692 CALL slascl2 ( n, nrhs, s, x, ldx )
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 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 vector.
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 ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
subroutine xerbla(SRNAME, INFO)
XERBLA
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
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.
real function slamch(CMACH)
SLAMCH
logical function lsame(CA, CB)
LSAME