489 SUBROUTINE zposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
490 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
491 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
492 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
499 CHARACTER EQUED, FACT, UPLO
500 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
502 DOUBLE PRECISION RCOND, RPVGRW
505 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
506 $ WORK( * ), X( LDX, * )
507 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
508 $ err_bnds_norm( nrhs, * ),
509 $ err_bnds_comp( nrhs, * )
515 DOUBLE PRECISION ZERO, ONE
516 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
517 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
518 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
519 INTEGER CMP_ERR_I, PIV_GROWTH_I
520 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
522 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
523 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
527 LOGICAL EQUIL, NOFACT, RCEQU
529 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
534 DOUBLE PRECISION DLAMCH, ZLA_PORPVGRW
546 nofact = lsame( fact,
'N' )
547 equil = lsame( fact,
'E' )
548 smlnum = dlamch(
'Safe minimum' )
549 bignum = one / smlnum
550 IF( nofact .OR. equil )
THEN
554 rcequ = lsame( equed,
'Y' )
565 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
566 $ lsame( fact,
'F' ) )
THEN
568 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
569 $ .NOT.lsame( uplo,
'L' ) )
THEN
571 ELSE IF( n.LT.0 )
THEN
573 ELSE IF( nrhs.LT.0 )
THEN
575 ELSE IF( lda.LT.max( 1, n ) )
THEN
577 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
579 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
580 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
587 smin = min( smin, s( j ) )
588 smax = max( smax, s( j ) )
590 IF( smin.LE.zero )
THEN
592 ELSE IF( n.GT.0 )
THEN
593 scond = max( smin, smlnum ) / min( smax, bignum )
599 IF( ldb.LT.max( 1, n ) )
THEN
601 ELSE IF( ldx.LT.max( 1, n ) )
THEN
608 CALL xerbla(
'ZPOSVXX', -info )
616 CALL zpoequb( n, a, lda, s, scond, amax, infequ )
617 IF( infequ.EQ.0 )
THEN
621 CALL zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
622 rcequ = lsame( equed,
'Y' )
628 IF( rcequ )
CALL zlascl2( n, nrhs, s, b, ldb )
630 IF( nofact .OR. equil )
THEN
634 CALL zlacpy( uplo, n, n, a, lda, af, ldaf )
635 CALL zpotrf( uplo, n, af, ldaf, info )
645 rpvgrw = zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
652 rpvgrw = zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
656 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
657 CALL zpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
662 CALL zporfsx( uplo, equed, n, nrhs, a, lda, af, ldaf,
663 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
664 $ err_bnds_comp, nparams, params, work, rwork, info )
670 CALL zlascl2( n, nrhs, s, x, ldx )
double precision function dlamch(CMACH)
DLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a matrix.
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
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...
subroutine zpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQUB
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
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 zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.