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 BLAS_FPINFO_X
510 INTEGER ILATRANS, ILAPREC
517 trans_type = ilatrans( trans )
518 ref_type = int( itref_default )
519 IF ( nparams .GE. la_linrx_itref_i )
THEN
520 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
521 params( la_linrx_itref_i ) = itref_default
523 ref_type = params( la_linrx_itref_i )
529 illrcond_thresh = dble( n ) * dlamch(
'Epsilon' )
530 ithresh = int( ithresh_default )
531 rthresh = rthresh_default
532 unstable_thresh = dzthresh_default
533 ignore_cwise = componentwise_default .EQ. 0.0d+0
535 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
536 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
537 params( la_linrx_ithresh_i ) = ithresh
539 ithresh = int( params( la_linrx_ithresh_i ) )
542 IF ( nparams.GE.la_linrx_cwise_i )
THEN
543 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
544 IF ( ignore_cwise )
THEN
545 params( la_linrx_cwise_i ) = 0.0d+0
547 params( la_linrx_cwise_i ) = 1.0d+0
550 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
553 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
555 ELSE IF ( ignore_cwise )
THEN
561 notran = lsame( trans,
'N' )
562 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
563 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
567 IF( trans_type.EQ.-1 )
THEN
569 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
570 $ .NOT.lsame( equed,
'N' ) )
THEN
572 ELSE IF( n.LT.0 )
THEN
574 ELSE IF( kl.LT.0 )
THEN
576 ELSE IF( ku.LT.0 )
THEN
578 ELSE IF( nrhs.LT.0 )
THEN
580 ELSE IF( ldab.LT.kl+ku+1 )
THEN
582 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
584 ELSE IF( ldb.LT.max( 1, n ) )
THEN
586 ELSE IF( ldx.LT.max( 1, n ) )
THEN
590 CALL xerbla(
'DGBRFSX', -info )
596 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
600 IF ( n_err_bnds .GE. 1 )
THEN
601 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
602 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
604 IF ( n_err_bnds .GE. 2 )
THEN
605 err_bnds_norm( j, la_linrx_err_i ) = 0.0d+0
606 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
608 IF ( n_err_bnds .GE. 3 )
THEN
609 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0d+0
610 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
621 IF ( n_err_bnds .GE. 1 )
THEN
622 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
623 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
625 IF ( n_err_bnds .GE. 2 )
THEN
626 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
627 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
629 IF ( n_err_bnds .GE. 3 )
THEN
630 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
631 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
643 anorm = dlangb( norm, n, kl, ku, ab, ldab, work )
644 CALL dgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
645 $ work, iwork, info )
649 IF ( ref_type .NE. 0 .AND. info .EQ. 0 )
THEN
651 prec_type = ilaprec(
'E' )
655 $ nrhs, ab, ldab, afb, ldafb, ipiv, colequ, c, b,
656 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
657 $ err_bnds_comp, work( n+1 ), work( 1 ), work( 2*n+1 ),
658 $ work( 1 ), rcond, ithresh, rthresh, unstable_thresh,
659 $ ignore_cwise, info )
662 $ nrhs, ab, ldab, afb, ldafb, ipiv, rowequ, r, b,
663 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
664 $ err_bnds_comp, work( n+1 ), work( 1 ), work( 2*n+1 ),
665 $ work( 1 ), rcond, ithresh, rthresh, unstable_thresh,
666 $ ignore_cwise, info )
670 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) ) * dlamch(
'Epsilon' )
671 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
675 IF ( colequ .AND. notran )
THEN
676 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
677 $ ldafb, ipiv, -1, c, info, work, iwork )
678 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
679 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
680 $ ldafb, ipiv, -1, r, info, work, iwork )
682 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
683 $ ldafb, ipiv, 0, r, info, work, iwork )
689 IF ( n_err_bnds .GE. la_linrx_err_i
690 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0d+0 )
691 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
695 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
696 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
697 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+0
698 IF ( info .LE. n ) info = n + j
699 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
701 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
702 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
707 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
708 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
714 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 2)
THEN
724 cwise_wrong = sqrt( dlamch(
'Epsilon' ) )
726 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
728 rcond_tmp = dla_gbrcond( trans, n, kl, ku, ab, ldab, afb,
729 $ ldafb, ipiv, 1, x( 1, j ), info, work, iwork )
736 IF ( n_err_bnds .GE. la_linrx_err_i
737 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0d+0 )
738 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
742 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
743 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
744 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+0
745 IF ( params( la_linrx_cwise_i ) .EQ. 1.0d+0
746 $ .AND. info.LT.n + j ) info = n + j
747 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
748 $ .LT. err_lbnd )
THEN
749 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
750 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
755 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
756 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
integer function ilatrans(TRANS)
ILATRANS
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
subroutine xerbla(SRNAME, INFO)
XERBLA
integer function ilaprec(PREC)
ILAPREC
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 ...
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.
logical function lsame(CA, CB)
LSAME