437 SUBROUTINE dgbrfsx( 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, iwork,
449 CHARACTER TRANS, EQUED
450 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, KL, KU, NRHS,
451 $ nparams, n_err_bnds
452 DOUBLE PRECISION RCOND
455 INTEGER IPIV( * ), IWORK( * )
456 DOUBLE PRECISION 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, * )
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
489 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE
491 DOUBLE PRECISION ANORM, RCOND_TMP
492 DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
495 DOUBLE PRECISION RTHRESH, UNSTABLE_THRESH
507 DOUBLE PRECISION DLAMCH, DLANGB, DLA_GBRCOND
509 INTEGER ILATRANS, ILAPREC
516 trans_type = ilatrans( trans )
517 ref_type = int( itref_default )
518 IF ( nparams .GE. la_linrx_itref_i )
THEN
519 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
520 params( la_linrx_itref_i ) = itref_default
522 ref_type = params( la_linrx_itref_i )
528 illrcond_thresh = dble( n ) * dlamch(
'Epsilon' )
529 ithresh = int( ithresh_default )
530 rthresh = rthresh_default
531 unstable_thresh = dzthresh_default
532 ignore_cwise = componentwise_default .EQ. 0.0d+0
534 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
535 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
536 params( la_linrx_ithresh_i ) = ithresh
538 ithresh = int( params( la_linrx_ithresh_i ) )
541 IF ( nparams.GE.la_linrx_cwise_i )
THEN
542 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
543 IF ( ignore_cwise )
THEN
544 params( la_linrx_cwise_i ) = 0.0d+0
546 params( la_linrx_cwise_i ) = 1.0d+0
549 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
552 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
554 ELSE IF ( ignore_cwise )
THEN
560 notran = lsame( trans,
'N' )
561 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
562 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
566 IF( trans_type.EQ.-1 )
THEN
568 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
569 $ .NOT.lsame( equed,
'N' ) )
THEN
571 ELSE IF( n.LT.0 )
THEN
573 ELSE IF( kl.LT.0 )
THEN
575 ELSE IF( ku.LT.0 )
THEN
577 ELSE IF( nrhs.LT.0 )
THEN
579 ELSE IF( ldab.LT.kl+ku+1 )
THEN
581 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
583 ELSE IF( ldb.LT.max( 1, n ) )
THEN
585 ELSE IF( ldx.LT.max( 1, n ) )
THEN
589 CALL xerbla(
'DGBRFSX', -info )
595 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
599 IF ( n_err_bnds .GE. 1 )
THEN
600 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
601 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
603 IF ( n_err_bnds .GE. 2 )
THEN
604 err_bnds_norm( j, la_linrx_err_i ) = 0.0d+0
605 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
607 IF ( n_err_bnds .GE. 3 )
THEN
608 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0d+0
609 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
620 IF ( n_err_bnds .GE. 1 )
THEN
621 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
622 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
624 IF ( n_err_bnds .GE. 2 )
THEN
625 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
626 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
628 IF ( n_err_bnds .GE. 3 )
THEN
629 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
630 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
642 anorm = dlangb( norm, n, kl, ku, ab, ldab, work )
643 CALL dgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
644 $ work, iwork, info )
648 IF ( ref_type .NE. 0 .AND. info .EQ. 0 )
THEN
650 prec_type = ilaprec(
'E' )
654 $ nrhs, ab, ldab, afb, ldafb, ipiv, colequ, c, b,
655 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
656 $ err_bnds_comp, work( n+1 ), work( 1 ), work( 2*n+1 ),
657 $ work( 1 ), rcond, ithresh, rthresh, unstable_thresh,
658 $ ignore_cwise, info )
661 $ nrhs, ab, ldab, afb, ldafb, ipiv, rowequ, r, b,
662 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
663 $ err_bnds_comp, work( n+1 ), work( 1 ), work( 2*n+1 ),
664 $ work( 1 ), rcond, ithresh, rthresh, unstable_thresh,
665 $ ignore_cwise, info )
669 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) ) * dlamch(
'Epsilon' )
670 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
674 IF ( colequ .AND. notran )
THEN
675 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
676 $ ldafb, ipiv, -1, c, info, work, iwork )
677 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
678 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
679 $ ldafb, ipiv, -1, r, info, work, iwork )
681 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
682 $ ldafb, ipiv, 0, r, info, work, iwork )
688 IF ( n_err_bnds .GE. la_linrx_err_i
689 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0d+0 )
690 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
694 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
695 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
696 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+0
697 IF ( info .LE. n ) info = n + j
698 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
700 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
701 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
706 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
707 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
713 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 2)
THEN
723 cwise_wrong = sqrt( dlamch(
'Epsilon' ) )
725 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
727 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
728 $ ldafb, ipiv, 1, x( 1, j ), info, work, iwork )
735 IF ( n_err_bnds .GE. la_linrx_err_i
736 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0d+0 )
737 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
741 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
742 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
743 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+0
744 IF ( params( la_linrx_cwise_i ) .EQ. 1.0d+0
745 $ .AND. info.LT.n + j ) info = n + j
746 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
747 $ .LT. err_lbnd )
THEN
748 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
749 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
754 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
755 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
double precision function dlamch(CMACH)
DLAMCH
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...
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
integer function ilatrans(TRANS)
ILATRANS
double precision function dlangb(NORM, N, KL, KU, AB, LDAB, WORK)
DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
integer function ilaprec(PREC)
ILAPREC
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
double precision function dla_gbrcond(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, CMODE, C, INFO, WORK, IWORK)
DLA_GBRCOND estimates the Skeel condition number for a general banded matrix.