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
537 DOUBLE PRECISION DLAMCH, ZLA_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(
'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 zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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...
double precision function dlamch(CMACH)
DLAMCH
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 zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQUB
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 ...
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON
logical function lsame(CA, CB)
LSAME
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS