495 SUBROUTINE sposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
496 $ s, b, ldb, x, ldx, rcond, rpvgrw, berr,
497 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
498 $ nparams, params, work, iwork, info )
506 CHARACTER EQUED, FACT, UPLO
507 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
513 REAL A( lda, * ), AF( ldaf, * ), B( ldb, * ),
514 $ x( ldx, * ), work( * )
515 REAL S( * ), PARAMS( * ), BERR( * ),
516 $ err_bnds_norm( nrhs, * ),
517 $ err_bnds_comp( nrhs, * )
524 parameter( zero = 0.0e+0, one = 1.0e+0 )
525 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
526 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
527 INTEGER CMP_ERR_I, PIV_GROWTH_I
528 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
530 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
531 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
535 LOGICAL EQUIL, NOFACT, RCEQU
537 REAL AMAX, BIGNUM, SMIN, SMAX,
543 REAL SLAMCH, SLA_PORPVGRW
555 nofact = lsame( fact,
'N' )
556 equil = lsame( fact,
'E' )
557 smlnum = slamch(
'Safe minimum' )
558 bignum = one / smlnum
559 IF( nofact .OR. equil )
THEN
563 rcequ = lsame( equed,
'Y' )
574 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
575 $ lsame( fact,
'F' ) )
THEN
577 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
578 $ .NOT.lsame( uplo,
'L' ) )
THEN
580 ELSE IF( n.LT.0 )
THEN
582 ELSE IF( nrhs.LT.0 )
THEN
584 ELSE IF( lda.LT.max( 1, n ) )
THEN
586 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
588 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
589 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
596 smin = min( smin, s( j ) )
597 smax = max( smax, s( j ) )
599 IF( smin.LE.zero )
THEN
601 ELSE IF( n.GT.0 )
THEN
602 scond = max( smin, smlnum ) / min( smax, bignum )
608 IF( ldb.LT.max( 1, n ) )
THEN
610 ELSE IF( ldx.LT.max( 1, n ) )
THEN
617 CALL xerbla(
'SPOSVXX', -info )
625 CALL spoequb( n, a, lda, s, scond, amax, infequ )
626 IF( infequ.EQ.0 )
THEN
630 CALL slaqsy( uplo, n, a, lda, s, scond, amax, equed )
631 rcequ = lsame( equed,
'Y' )
637 IF( rcequ )
CALL slascl2( n, nrhs, s, b, ldb )
639 IF( nofact .OR. equil )
THEN
643 CALL slacpy( uplo, n, n, a, lda, af, ldaf )
644 CALL spotrf( uplo, n, af, ldaf, info )
654 rpvgrw = sla_porpvgrw( uplo, info, a, lda, af, ldaf, work )
661 rpvgrw = sla_porpvgrw( uplo, n, a, lda, af, ldaf, work )
665 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
666 CALL spotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
671 CALL sporfsx( uplo, equed, n, nrhs, a, lda, af, ldaf,
672 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
673 $ err_bnds_comp, nparams, params, work, iwork, info )
679 CALL slascl2 ( n, nrhs, s, x, ldx )
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 spoequb(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQUB
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a vector.
logical function lsame(CA, CB)
LSAME
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 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 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
real function slamch(CMACH)
SLAMCH
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF