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 IF( nofact .OR. 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 xerbla(srname, info)
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 dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
double precision function dlamch(cmach)
DLAMCH
subroutine dlaqsy(uplo, n, a, lda, s, scond, amax, equed)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine dlascl2(m, n, d, x, ldx)
DLASCL2 performs diagonal scaling on a matrix.
logical function lsame(ca, cb)
LSAME
subroutine dpoequb(n, a, lda, s, scond, amax, info)
DPOEQUB
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 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 dpotrf(uplo, n, a, lda, info)
DPOTRF
subroutine dpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
DPOTRS