493 SUBROUTINE sposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
494 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
495 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
496 $ NPARAMS, PARAMS, WORK, IWORK, INFO )
503 CHARACTER EQUED, FACT, UPLO
504 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
510 REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
511 $ X( LDX, * ), WORK( * )
512 REAL S( * ), PARAMS( * ), BERR( * ),
513 $ err_bnds_norm( nrhs, * ),
514 $ err_bnds_comp( nrhs, * )
521 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
522 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
523 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
524 INTEGER CMP_ERR_I, PIV_GROWTH_I
525 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
527 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
528 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
532 LOGICAL EQUIL, NOFACT, RCEQU
534 REAL AMAX, BIGNUM, SMIN, SMAX,
540 REAL SLAMCH, SLA_PORPVGRW
552 nofact = lsame( fact,
'N' )
553 equil = lsame( fact, 'e
' )
554 SMLNUM = SLAMCH( 'safe minimum
' )
555 BIGNUM = ONE / SMLNUM
556.OR.
IF( NOFACT EQUIL ) THEN
560 RCEQU = LSAME( EQUED, 'y
' )
571.NOT..AND..NOT..AND..NOT.
IF( NOFACT EQUIL
572 $ LSAME( FACT, 'f
' ) ) THEN
574.NOT.
ELSE IF( LSAME( UPLO, 'u.AND.
' )
575.NOT.
$ LSAME( UPLO, 'l
' ) ) THEN
577.LT.
ELSE IF( N0 ) THEN
579.LT.
ELSE IF( NRHS0 ) THEN
581.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
583.LT.
ELSE IF( LDAFMAX( 1, N ) ) THEN
585 ELSE IF( LSAME( FACT, 'f.AND..NOT.
' )
586.OR.
$ ( RCEQU LSAME( EQUED, 'n
' ) ) ) THEN
593 SMIN = MIN( SMIN, S( J ) )
594 SMAX = MAX( SMAX, S( J ) )
596.LE.
IF( SMINZERO ) THEN
598.GT.
ELSE IF( N0 ) THEN
599 SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
605.LT.
IF( LDBMAX( 1, N ) ) THEN
607.LT.
ELSE IF( LDXMAX( 1, N ) ) THEN
614 CALL XERBLA( 'sposvxx', -INFO )
622 CALL SPOEQUB( N, A, LDA, S, SCOND, AMAX, INFEQU )
623.EQ.
IF( INFEQU0 ) THEN
627 CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
628 RCEQU = LSAME( EQUED, 'y
' )
634 IF( RCEQU ) CALL SLASCL2( N, NRHS, S, B, LDB )
636.OR.
IF( NOFACT EQUIL ) THEN
640 CALL SLACPY( UPLO, N, N, A, LDA, AF, LDAF )
641 CALL SPOTRF( UPLO, N, AF, LDAF, INFO )
651 RPVGRW = SLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, WORK )
658 RPVGRW = SLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, WORK )
662 CALL SLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
663 CALL SPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
668 CALL SPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF,
669 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM,
670 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO )
676 CALL SLASCL2 ( N, NRHS, S, X, LDX )
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine slascl2(m, n, d, x, ldx)
SLASCL2 performs diagonal scaling on a vector.
subroutine spotrs(uplo, n, nrhs, a, lda, b, ldb, info)
SPOTRS
subroutine spoequb(n, a, lda, s, scond, amax, info)
SPOEQUB
real function sla_porpvgrw(uplo, ncols, a, lda, af, ldaf, work)
SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
subroutine sporfsx(uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork, info)
SPORFSX
subroutine spotrf(uplo, n, a, lda, info)
SPOTRF
subroutine sposvxx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork, info)
SPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
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