494 SUBROUTINE cposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
495 $ s, b, ldb, x, ldx, rcond, rpvgrw, berr,
496 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
497 $ nparams, params, work, rwork, info )
505 CHARACTER EQUED, FACT, UPLO
506 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
511 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
512 $ work( * ), x( ldx, * )
513 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
514 $ err_bnds_norm( nrhs, * ),
515 $ err_bnds_comp( nrhs, * )
522 parameter ( zero = 0.0e+0, one = 1.0e+0 )
523 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
524 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
525 INTEGER CMP_ERR_I, PIV_GROWTH_I
526 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
528 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
529 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
533 LOGICAL EQUIL, NOFACT, RCEQU
535 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
540 REAL SLAMCH, CLA_PORPVGRW
552 nofact = lsame( fact,
'N' )
553 equil = lsame( fact,
'E' )
554 smlnum = slamch(
'Safe minimum' )
555 bignum = one / smlnum
556 IF( nofact .OR. equil )
THEN
560 rcequ = lsame( equed,
'Y' )
571 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
572 $ lsame( fact,
'F' ) )
THEN
574 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
575 $ .NOT.lsame( uplo,
'L' ) )
THEN
577 ELSE IF( n.LT.0 )
THEN
579 ELSE IF( nrhs.LT.0 )
THEN
581 ELSE IF( lda.LT.max( 1, n ) )
THEN
583 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
585 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
586 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
593 smin = min( smin, s( j ) )
594 smax = max( smax, s( j ) )
596 IF( smin.LE.zero )
THEN
598 ELSE IF( n.GT.0 )
THEN
599 scond = max( smin, smlnum ) / min( smax, bignum )
605 IF( ldb.LT.max( 1, n ) )
THEN
607 ELSE IF( ldx.LT.max( 1, n ) )
THEN
614 CALL xerbla(
'CPOSVXX', -info )
622 CALL cpoequb( n, a, lda, s, scond, amax, infequ )
623 IF( infequ.EQ.0 )
THEN
627 CALL claqhe( uplo, n, a, lda, s, scond, amax, equed )
628 rcequ = lsame( equed,
'Y' )
634 IF( rcequ )
CALL clascl2( n, nrhs, s, b, ldb )
636 IF( nofact .OR. equil )
THEN
640 CALL clacpy( uplo, n, n, a, lda, af, ldaf )
641 CALL cpotrf( uplo, n, af, ldaf, info )
651 rpvgrw = cla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
658 rpvgrw = cla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
662 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
663 CALL cpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
668 CALL cporfsx( uplo, equed, n, nrhs, a, lda, af, ldaf,
669 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
670 $ err_bnds_comp, nparams, params, work, rwork, info )
676 CALL clascl2( n, nrhs, s, x, ldx )
subroutine cposvxx(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)
CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
subroutine claqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
CLAQHE scales a Hermitian matrix.
subroutine cpoequb(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQUB
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clascl2(M, N, D, X, LDX)
CLASCL2 performs diagonal scaling on a vector.
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
real function cla_porpvgrw(UPLO, NCOLS, A, LDA, AF, LDAF, WORK)
CLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
subroutine cporfsx(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)
CPORFSX