492 SUBROUTINE dposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
493 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
494 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
495 $ NPARAMS, PARAMS, WORK, IWORK, INFO )
503 CHARACTER EQUED, FACT, UPLO
504 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
506 DOUBLE PRECISION RCOND, RPVGRW
510 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), B( ldb, * ),
511 $ x( ldx, * ), work( * )
512 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
513 $ err_bnds_norm( nrhs, * ),
514 $ err_bnds_comp( nrhs, * )
520 DOUBLE PRECISION ZERO, ONE
521 parameter( zero = 0.0d+0, one = 1.0d+0 )
522 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
523 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
524 INTEGER CMP_ERR_I, PIV_GROWTH_I
525 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
527 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
528 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
532 LOGICAL EQUIL, NOFACT, RCEQU
534 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX,
540 DOUBLE PRECISION DLAMCH, DLA_PORPVGRW
552 nofact = lsame( fact,
'N' )
553 equil = lsame( fact,
'E' )
554 smlnum = dlamch(
'Safe minimum' )
555 bignum = one / smlnum
556 IF( nofact .OR. equil )
THEN 560 rcequ = lsame( equed,
'Y' )
571 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
572 $ lsame( fact,
'F' ) )
THEN 574 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
575 $ .NOT.lsame( uplo,
'L' ) )
THEN 577 ELSE IF( n.LT.0 )
THEN 579 ELSE IF( nrhs.LT.0 )
THEN 581 ELSE IF( lda.LT.max( 1, n ) )
THEN 583 ELSE IF( ldaf.LT.max( 1, n ) )
THEN 585 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
586 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN 593 smin = min( smin, s( j ) )
594 smax = max( smax, s( j ) )
596 IF( smin.LE.zero )
THEN 598 ELSE IF( n.GT.0 )
THEN 599 scond = max( smin, smlnum ) / min( smax, bignum )
605 IF( ldb.LT.max( 1, n ) )
THEN 607 ELSE IF( ldx.LT.max( 1, n ) )
THEN 614 CALL xerbla(
'DPOSVXX', -info )
622 CALL dpoequb( n, a, lda, s, scond, amax, infequ )
623 IF( infequ.EQ.0 )
THEN 627 CALL dlaqsy( uplo, n, a, lda, s, scond, amax, equed )
628 rcequ = lsame( equed,
'Y' )
634 IF( rcequ )
CALL dlascl2( n, nrhs, s, b, ldb )
636 IF( nofact .OR. equil )
THEN 640 CALL dlacpy( uplo, n, n, a, lda, af, ldaf )
641 CALL dpotrf( uplo, n, af, ldaf, info )
651 rpvgrw = dla_porpvgrw( uplo, info, a, lda, af, ldaf, work )
658 rpvgrw = dla_porpvgrw( uplo, n, a, lda, af, ldaf, work )
662 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
663 CALL dpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
668 CALL dporfsx( uplo, equed, n, nrhs, a, lda, af, ldaf,
669 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
670 $ err_bnds_comp, nparams, params, work, iwork, info )
676 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.
double precision function dlamch(CMACH)
DLAMCH
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 ...
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 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
subroutine dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME