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 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
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 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 ...