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 )
logical function lsame(CA, CB)
LSAME
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF
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 zpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQUB
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
double precision function dlamch(CMACH)
DLAMCH
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 zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
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 zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a matrix.