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 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 slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a vector.
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 spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
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 spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
subroutine spoequb(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQUB
real function slamch(CMACH)
SLAMCH
logical function lsame(CA, CB)
LSAME