491 SUBROUTINE zposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
492 $ s,
b, ldb, x, ldx, rcond, rpvgrw, berr,
493 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
494 $ nparams, params, work, rwork, info )
502 CHARACTER equed, fact, uplo
503 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
505 DOUBLE PRECISION rcond, rpvgrw
508 COMPLEX*16 a( lda, * ), af( ldaf, * ),
b( ldb, * ),
509 $ work( * ), x( ldx, * )
510 DOUBLE PRECISION s( * ), params( * ), berr( * ), rwork( * ),
511 $ err_bnds_norm( nrhs, * ),
512 $ err_bnds_comp( nrhs, * )
518 DOUBLE PRECISION zero, one
519 parameter( zero = 0.0d+0, one = 1.0d+0 )
520 INTEGER final_nrm_err_i, final_cmp_err_i, berr_i
521 INTEGER rcond_i, nrm_rcond_i, nrm_err_i, cmp_rcond_i
522 INTEGER cmp_err_i, piv_growth_i
523 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
525 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
526 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
530 LOGICAL equil, nofact, rcequ
532 DOUBLE PRECISION amax, bignum, smin, smax, scond, smlnum
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(
'ZPOSVXX', -info )
619 CALL
zpoequb( n, a, lda, s, scond, amax, infequ )
620 IF( infequ.EQ.0 )
THEN
624 CALL
zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
625 rcequ =
lsame( equed,
'Y' )
631 IF( rcequ ) CALL
zlascl2( n, nrhs, s,
b, ldb )
633 IF( nofact .OR. equil )
THEN
637 CALL
zlacpy( uplo, n, n, a, lda, af, ldaf )
638 CALL
zpotrf( uplo, n, af, ldaf, info )
648 rpvgrw =
zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
655 rpvgrw =
zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
659 CALL
zlacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
660 CALL
zpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
665 CALL
zporfsx( 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, rwork, info )
673 CALL
zlascl2( n, nrhs, s, x, ldx )
subroutine zporfsx(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, RWORK, INFO)
ZPORFSX
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQUB
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function zla_porpvgrw(UPLO, NCOLS, A, LDA, AF, LDAF, WORK)
ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON
subroutine zposvxx(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, RWORK, INFO)
ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...