487 SUBROUTINE zposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF,
489 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
490 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
491 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
498 CHARACTER EQUED, FACT, UPLO
499 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
501 DOUBLE PRECISION RCOND, RPVGRW
504 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
505 $ work( * ), x( ldx, * )
506 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
507 $ ERR_BNDS_NORM( NRHS, * ),
508 $ err_bnds_comp( nrhs, * )
514 DOUBLE PRECISION ZERO, ONE
515 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
516 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
517 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
518 INTEGER CMP_ERR_I, PIV_GROWTH_I
519 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
521 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
522 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
526 LOGICAL EQUIL, NOFACT, RCEQU
528 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
533 DOUBLE PRECISION DLAMCH, ZLA_PORPVGRW
545 nofact = lsame( fact,
'N' )
546 equil = lsame( fact,
'E' )
547 smlnum = dlamch(
'Safe minimum' )
548 bignum = one / smlnum
549 IF( nofact .OR. equil )
THEN
553 rcequ = lsame( equed,
'Y' )
564 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
565 $ lsame( fact,
'F' ) )
THEN
567 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
568 $ .NOT.lsame( uplo,
'L' ) )
THEN
570 ELSE IF( n.LT.0 )
THEN
572 ELSE IF( nrhs.LT.0 )
THEN
574 ELSE IF( lda.LT.max( 1, n ) )
THEN
576 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
578 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
579 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
586 smin = min( smin, s( j ) )
587 smax = max( smax, s( j ) )
589 IF( smin.LE.zero )
THEN
591 ELSE IF( n.GT.0 )
THEN
592 scond = max( smin, smlnum ) / min( smax, bignum )
598 IF( ldb.LT.max( 1, n ) )
THEN
600 ELSE IF( ldx.LT.max( 1, n ) )
THEN
607 CALL xerbla(
'ZPOSVXX', -info )
615 CALL zpoequb( n, a, lda, s, scond, amax, infequ )
616 IF( infequ.EQ.0 )
THEN
620 CALL zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
621 rcequ = lsame( equed,
'Y' )
627 IF( rcequ )
CALL zlascl2( n, nrhs, s, b, ldb )
629 IF( nofact .OR. equil )
THEN
633 CALL zlacpy( uplo, n, n, a, lda, af, ldaf )
634 CALL zpotrf( uplo, n, af, ldaf, info )
644 rpvgrw = zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
651 rpvgrw = zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
655 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
656 CALL zpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
661 CALL zporfsx( uplo, equed, n, nrhs, a, lda, af, ldaf,
662 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
663 $ err_bnds_comp, nparams, params, work, rwork, info )
669 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 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