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 )
logical function lsame(CA, CB)
LSAME
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
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 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 dpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
DPOEQUB
double precision function dlamch(CMACH)
DLAMCH
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