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
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 )
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 )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a vector.
subroutine slaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
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
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 ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
subroutine ssyequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
SSYEQUB