435 SUBROUTINE dgbrfsx( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB,
436 $ LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND,
437 $ BERR, N_ERR_BNDS, ERR_BNDS_NORM,
438 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK,
446 CHARACTER TRANS, EQUED
447 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, , KU, NRHS,
448 $ NPARAMS, N_ERR_BNDS
449 DOUBLE PRECISION RCOND
452 INTEGER IPIV( * ), IWORK( * )
453 DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
454 $ X( LDX , * ),WORK( * )
455 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
456 $ err_bnds_norm( nrhs, * ),
457 $ err_bnds_comp( nrhs, * )
463 DOUBLE PRECISION ZERO, ONE
464 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
465 DOUBLE PRECISION ITREF_DEFAULT, ITHRESH_DEFAULT
466 DOUBLE PRECISION COMPONENTWISE_DEFAULT, RTHRESH_DEFAULT
467 DOUBLE PRECISION DZTHRESH_DEFAULT
468 parameter( itref_default = 1.0d+0 )
469 parameter( ithresh_default = 10.0d+0 )
470 parameter( componentwise_default = 1.0d+0 )
471 parameter( rthresh_default = 0.5d+0 )
472 parameter( dzthresh_default = 0.25d+0 )
473 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
475 parameter( la_linrx_itref_i = 1,
476 $ la_linrx_ithresh_i = 2 )
477 parameter( la_linrx_cwise_i = 3 )
478 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
480 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
481 parameter( la_linrx_rcond_i = 3 )
485 LOGICAL ROWEQU, COLEQU, NOTRAN
486 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE
488 DOUBLE PRECISION ANORM, RCOND_TMP
489 DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
492 DOUBLE PRECISION RTHRESH, UNSTABLE_THRESH
504 DOUBLE PRECISION DLAMCH, DLANGB, DLA_GBRCOND
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(
'DGBRFSX', -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 = DLANGB( NORM, N, KL, KU, AB, LDAB, WORK )
640 CALL DGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
641 $ WORK, IWORK, INFO )
645.NE..AND..EQ.
IF ( REF_TYPE 0 INFO 0 ) THEN
647 PREC_TYPE = ILAPREC( 'e
' )
650 CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU,
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( N+1 ), WORK( 1 ), WORK( 2*N+1 ),
654 $ WORK( 1 ), RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH,
655 $ IGNORE_CWISE, INFO )
657 CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU,
658 $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B,
659 $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
660 $ ERR_BNDS_COMP, WORK( N+1 ), WORK( 1 ), WORK( 2*N+1 ),
661 $ WORK( 1 ), RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH,
662 $ IGNORE_CWISE, INFO )
666 ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'epsilon
' )
667.GE..AND..GE.
IF ( N_ERR_BNDS 1 N_NORMS 1 ) THEN
671.AND.
IF ( COLEQU NOTRAN ) THEN
672 RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB,
673 $ LDAFB, IPIV, -1, C, INFO, WORK, IWORK )
674.AND..NOT.
ELSE IF ( ROWEQU NOTRAN ) THEN
675 RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB,
676 $ LDAFB, IPIV, -1, R, INFO, WORK, IWORK )
678 RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB,
679 $ LDAFB, IPIV, 0, R, INFO, WORK, IWORK )
685.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
686.AND..GT.
$ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) 1.0D+0 )
687 $ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
691.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
692 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
693 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 0.0D+0
694.LE.
IF ( INFO N ) INFO = N + J
695.LT.
ELSE IF ( ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) ERR_LBND )
697 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = ERR_LBND
698 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
703.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
704 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = RCOND_TMP
710.GE..AND..GE.
IF (N_ERR_BNDS 1 N_NORMS 2) THEN
720 CWISE_WRONG = SQRT( DLAMCH( 'epsilon
' ) )
722.LT.
IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) CWISE_WRONG )
724 RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB,
725 $ LDAFB, IPIV, 1, X( 1, J ), INFO, WORK, IWORK )
732.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
733.AND..GT.
$ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) 1.0D+0 )
734 $ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
738.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
739 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
740 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 0.0D+0
741.EQ.
IF ( PARAMS( LA_LINRX_CWISE_I ) 1.0D+0
742.AND..LT.
$ INFON + J ) INFO = N + J
743 ELSE IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I )
744.LT.
$ ERR_LBND ) THEN
745 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = ERR_LBND
746 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
751.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
752 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = RCOND_TMP
subroutine dgbrfsx(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, iwork, info)
DGBRFSX
subroutine dla_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)
DLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded...