437 SUBROUTINE zgbrfsx( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB,
438 $ ldafb, ipiv, r, c, b, ldb, x, ldx, rcond,
439 $ berr, n_err_bnds, err_bnds_norm,
440 $ err_bnds_comp, nparams, params, work, rwork,
449 CHARACTER TRANS, EQUED
450 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, KL, KU, NRHS,
451 $ nparams, n_err_bnds
452 DOUBLE PRECISION RCOND
456 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
457 $ x( ldx , * ),work( * )
458 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
459 $ err_bnds_norm( nrhs, * ),
460 $ err_bnds_comp( nrhs, * ), rwork( * )
466 DOUBLE PRECISION ZERO, ONE
467 parameter( zero = 0.0d+0, one = 1.0d+0 )
468 DOUBLE PRECISION ITREF_DEFAULT, ITHRESH_DEFAULT
469 DOUBLE PRECISION COMPONENTWISE_DEFAULT, RTHRESH_DEFAULT
470 DOUBLE PRECISION DZTHRESH_DEFAULT
471 parameter( itref_default = 1.0d+0 )
472 parameter( ithresh_default = 10.0d+0 )
473 parameter( componentwise_default = 1.0d+0 )
474 parameter( rthresh_default = 0.5d+0 )
475 parameter( dzthresh_default = 0.25d+0 )
476 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
478 parameter( la_linrx_itref_i = 1,
479 $ la_linrx_ithresh_i = 2 )
480 parameter( la_linrx_cwise_i = 3 )
481 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
483 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
484 parameter( la_linrx_rcond_i = 3 )
488 LOGICAL ROWEQU, COLEQU, NOTRAN, IGNORE_CWISE
489 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE, N_NORMS,
491 DOUBLE PRECISION ANORM, RCOND_TMP, ILLRCOND_THRESH, ERR_LBND,
492 $ cwise_wrong, rthresh, unstable_thresh
498 INTRINSIC max, sqrt, transfer
503 DOUBLE PRECISION DLAMCH, ZLANGB, ZLA_GBRCOND_X, ZLA_GBRCOND_C
505 INTEGER BLAS_FPINFO_X
506 INTEGER ILATRANS, ILAPREC
513 trans_type = ilatrans( trans )
514 ref_type = int( itref_default )
515 IF ( nparams .GE. la_linrx_itref_i )
THEN
516 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
517 params( la_linrx_itref_i ) = itref_default
519 ref_type = params( la_linrx_itref_i )
525 illrcond_thresh = dble( n ) * dlamch(
'Epsilon' )
526 ithresh = int( ithresh_default )
527 rthresh = rthresh_default
528 unstable_thresh = dzthresh_default
529 ignore_cwise = componentwise_default .EQ. 0.0d+0
531 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
532 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
533 params( la_linrx_ithresh_i ) = ithresh
535 ithresh = int( params( la_linrx_ithresh_i ) )
538 IF ( nparams.GE.la_linrx_cwise_i )
THEN
539 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
540 IF ( ignore_cwise )
THEN
541 params( la_linrx_cwise_i ) = 0.0d+0
543 params( la_linrx_cwise_i ) = 1.0d+0
546 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
549 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
551 ELSE IF ( ignore_cwise )
THEN
557 notran = lsame( trans,
'N' )
558 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
559 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
563 IF( trans_type.EQ.-1 )
THEN
565 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
566 $ .NOT.lsame( equed,
'N' ) )
THEN
568 ELSE IF( n.LT.0 )
THEN
570 ELSE IF( kl.LT.0 )
THEN
572 ELSE IF( ku.LT.0 )
THEN
574 ELSE IF( nrhs.LT.0 )
THEN
576 ELSE IF( ldab.LT.kl+ku+1 )
THEN
578 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
580 ELSE IF( ldb.LT.max( 1, n ) )
THEN
582 ELSE IF( ldx.LT.max( 1, n ) )
THEN
586 CALL xerbla(
'ZGBRFSX', -info )
592 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
596 IF ( n_err_bnds .GE. 1 )
THEN
597 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
598 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
600 IF ( n_err_bnds .GE. 2 )
THEN
601 err_bnds_norm( j, la_linrx_err_i ) = 0.0d+0
602 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
604 IF ( n_err_bnds .GE. 3 )
THEN
605 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0d+0
606 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
617 IF ( n_err_bnds .GE. 1 )
THEN
618 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
619 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
621 IF ( n_err_bnds .GE. 2 )
THEN
622 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
623 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
625 IF ( n_err_bnds .GE. 3 )
THEN
626 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
627 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
639 anorm = zlangb( norm, n, kl, ku, ab, ldab, rwork )
640 CALL zgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
641 $ work, rwork, info )
645 IF ( ref_type .NE. 0 )
THEN
647 prec_type = ilaprec(
'E' )
651 $ nrhs, ab, ldab, afb, ldafb, ipiv, colequ, c, b,
652 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
653 $ err_bnds_comp, work, rwork, work(n+1),
654 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
655 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
659 $ nrhs, ab, ldab, afb, ldafb, ipiv, rowequ, r, b,
660 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
661 $ err_bnds_comp, work, rwork, work(n+1),
662 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
663 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
668 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) ) * dlamch(
'Epsilon' )
669 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
673 IF ( colequ .AND. notran )
THEN
674 rcond_tmp = zla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,
675 $ ldafb, ipiv, c, .true., info, work, rwork )
676 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
677 rcond_tmp = zla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,
678 $ ldafb, ipiv, r, .true., info, work, rwork )
680 rcond_tmp = zla_gbrcond_c( trans, n, kl, ku, ab, ldab, afb,
681 $ ldafb, ipiv, c, .false., info, work, rwork )
687 IF ( n_err_bnds .GE. la_linrx_err_i
688 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0d+0)
689 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
693 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
694 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
695 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+0
696 IF ( info .LE. n ) info = n + j
697 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
699 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
700 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
705 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
706 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
712 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 2)
THEN
722 cwise_wrong = sqrt( dlamch(
'Epsilon' ) )
724 IF (err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
726 rcond_tmp = zla_gbrcond_x( trans, n, kl, ku, ab, ldab,
727 $ afb, ldafb, ipiv, x( 1, j ), info, work, rwork )
734 IF ( n_err_bnds .GE. la_linrx_err_i
735 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0d+0 )
736 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
740 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
741 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
742 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+0
743 IF ( params( la_linrx_cwise_i ) .EQ. 1.0d+0
744 $ .AND. info.LT.n + j ) info = n + j
745 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
746 $ .LT. err_lbnd )
THEN
747 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
748 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
753 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
754 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
integer function ilatrans(TRANS)
ILATRANS
subroutine zla_gbrfsx_extended(PREC_TYPE, TRANS_TYPE, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B, LDB, Y, LDY, BERR_OUT, N_NORMS, ERR_BNDS_NORM, ERR_BNDS_COMP, RES, AYB, DY, Y_TAIL, RCOND, ITHRESH, RTHRESH, DZ_UB, IGNORE_CWISE, INFO)
ZLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded...
double precision function zlangb(NORM, N, KL, KU, AB, LDAB, WORK)
ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function zla_gbrcond_x(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, X, INFO, WORK, RWORK)
ZLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrice...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgbrfsx(TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZGBRFSX
double precision function zla_gbrcond_c(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_GBRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general banded ma...
logical function lsame(CA, CB)
LSAME
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
integer function ilaprec(PREC)
ILAPREC
double precision function dlamch(CMACH)
DLAMCH