490 SUBROUTINE dposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
491 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
492 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
493 $ NPARAMS, PARAMS, WORK, IWORK, INFO )
500 CHARACTER EQUED, FACT, UPLO
501 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
503 DOUBLE PRECISION RCOND, RPVGRW
507 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
508 $ X( LDX, * ), WORK( * )
509 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
510 $ err_bnds_norm( nrhs, * ),
511 $ err_bnds_comp( nrhs, * )
517 DOUBLE PRECISION ZERO, ONE
518 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
519 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
520 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
521 INTEGER CMP_ERR_I, PIV_GROWTH_I
522 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
524 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
525 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
529 LOGICAL EQUIL, NOFACT, RCEQU
531 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX,
537 DOUBLE PRECISION DLAMCH, DLA_PORPVGRW
549 nofact = lsame( fact,
'N' )
550 equil = lsame( fact,
'E' )
551 smlnum = dlamch(
'Safe minimum' )
552 bignum = one / smlnum
553 IF( nofact .OR. equil )
THEN
557 rcequ = lsame( equed,
'Y' )
568 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
569 $ lsame( fact,
'F' ) )
THEN
571 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
572 $ .NOT.lsame( uplo,
'L' ) )
THEN
574 ELSE IF( n.LT.0 )
THEN
576 ELSE IF( nrhs.LT.0 )
THEN
578 ELSE IF( lda.LT.
max( 1, n ) )
THEN
580 ELSE IF( ldaf.LT.
max( 1, n ) )
THEN
582 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
583 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
590 smin =
min( smin, s( j ) )
591 smax =
max( smax, s( j ) )
593 IF( smin.LE.zero )
THEN
595 ELSE IF( n.GT.0 )
THEN
596 scond =
max( smin, smlnum ) /
min( smax, bignum )
602 IF( ldb.LT.
max( 1, n ) )
THEN
604 ELSE IF( ldx.LT.
max( 1, n ) )
THEN
611 CALL xerbla(
'DPOSVXX', -info )
619 CALL dpoequb( n, a, lda, s, scond, amax, infequ )
620 IF( infequ.EQ.0 )
THEN
624 CALL dlaqsy( uplo, n, a, lda, s, scond, amax, equed )
625 rcequ = lsame( equed, 'y
' )
631 IF( RCEQU ) CALL DLASCL2( N, NRHS, S, B, LDB )
633.OR.
IF( NOFACT EQUIL ) THEN
637 CALL DLACPY( UPLO, N, N, A, LDA, AF, LDAF )
638 CALL DPOTRF( UPLO, N, AF, LDAF, INFO )
648 RPVGRW = DLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, WORK )
655 RPVGRW = DLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, WORK )
659 CALL DLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
660 CALL DPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
665 CALL DPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF,
666 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM,
667 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO )
673 CALL DLASCL2 ( N, NRHS, S, X, LDX )
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine dlascl2(m, n, d, x, ldx)
DLASCL2 performs diagonal scaling on a vector.
subroutine dporfsx(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)
DPORFSX
subroutine dpoequb(n, a, lda, s, scond, amax, info)
DPOEQUB
double precision function dla_porpvgrw(uplo, ncols, a, lda, af, ldaf, work)
DLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
subroutine dpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
DPOTRS
subroutine dpotrf(uplo, n, a, lda, info)
DPOTRF
subroutine dposvxx(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)
DPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
subroutine dlaqsy(uplo, n, a, lda, s, scond, amax, equed)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
double precision function dlamch(cmach)
DLAMCH