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,
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 )
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
LOGICAL function lsame(CA, CB)
LSAME
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 xerbla(SRNAME, INFO)
XERBLA
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
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 dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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 ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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