435 SUBROUTINE zgbrfsx( 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, RWORK,
446 CHARACTER TRANS, EQUED
447 INTEGER , , LDAFB, LDB, LDX, N, KL, KU, NRHS,
448 $ NPARAMS, N_ERR_BNDS
449 DOUBLE PRECISION RCOND
453 COMPLEX*16 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, * ), rwork( * )
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, IGNORE_CWISE
486 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE, N_NORMS,
488 DOUBLE PRECISION ANORM, RCOND_TMP, ILLRCOND_THRESH, ERR_LBND,
495 INTRINSIC max, sqrt, transfer
500 DOUBLE PRECISION , ZLANGB, ZLA_GBRCOND_X, ZLA_GBRCOND_C
502 INTEGER ILATRANS, ILAPREC
509 trans_type = ilatrans( trans )
510 ref_type = int( itref_default )
511 IF ( nparams .GE. la_linrx_itref_i )
THEN
512 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
515 ref_type = params( la_linrx_itref_i )
521 illrcond_thresh = dble( n ) *
dlamch(
'Epsilon' )
522 ithresh = int( ithresh_default )
523 rthresh = rthresh_default
524 unstable_thresh = dzthresh_default
525 ignore_cwise = componentwise_default .EQ. 0.0d+0
527 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
528 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
529 params( la_linrx_ithresh_i ) = ithresh
531 ithresh = int( params( la_linrx_ithresh_i ) )
534 IF ( nparams.GE.la_linrx_cwise_i )
THEN
535 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
536 IF ( ignore_cwise )
THEN
537 params( la_linrx_cwise_i ) = 0.0d+0
539 params( la_linrx_cwise_i ) = 1.0d+0
542 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
545 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
553 notran = lsame( trans,
'N' )
554 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
555 colequ = lsame( equed
'C''B' )
559 IF( trans_type.EQ.-1 )
THEN
561 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
562 $ .NOT.lsame( equed,
'N' ) )
THEN
564 ELSE IF( n.LT.0 )
THEN
566 ELSE IF( kl.LT.0 )
THEN
568 ELSE IF( ku.LT.0 )
THEN
570 ELSE IF( nrhs.LT.0 )
THEN
572 ELSE IF( ldab.LT.kl+ku+1 )
THEN
574 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
576 ELSE IF( ldb.LT.
max( 1, n ) )
THEN
578 ELSE IF( ldx.LT.
max( 1, n ) )
THEN
588.EQ..OR..EQ.
IF( N0 NRHS0 ) THEN
592.GE.
IF ( N_ERR_BNDS 1 ) THEN
593 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
594 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
596.GE.
IF ( N_ERR_BNDS 2 ) THEN
597 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 0.0D+0
598 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 0.0D+0
600.GE.
IF ( N_ERR_BNDS 3 ) THEN
601 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 1.0D+0
602 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 1.0D+0
613.GE.
IF ( N_ERR_BNDS 1 ) THEN
614 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
615 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
617.GE.
IF ( N_ERR_BNDS 2 ) THEN
618 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
619 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
621.GE.
IF ( N_ERR_BNDS 3 ) THEN
622 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 0.0D+0
623 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 0.0D+0
635 ANORM = ZLANGB( NORM, N, KL, KU, AB, LDAB, RWORK )
636 CALL ZGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
637 $ WORK, RWORK, INFO )
641.NE..AND..EQ.
IF ( REF_TYPE 0 INFO 0 ) THEN
643 PREC_TYPE = ILAPREC( 'e
' )
646 CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU,
647 $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B,
648 $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
649 $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
650 $ TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
651 $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
654 CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU,
655 $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B,
656 $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
657 $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
658 $ TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
659 $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
664 ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'epsilon
' )
665.GE..AND..GE.
IF (N_ERR_BNDS 1 N_NORMS 1) THEN
669.AND.
IF ( COLEQU NOTRAN ) THEN
670 RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
671 $ LDAFB, IPIV, C, .TRUE., INFO, WORK, RWORK )
672.AND..NOT.
ELSE IF ( ROWEQU NOTRAN ) THEN
673 RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
674 $ LDAFB, IPIV, R, .TRUE., INFO, WORK, RWORK )
676 RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
677 $ LDAFB, IPIV, C, .FALSE., INFO, WORK, RWORK )
683.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
684.AND..GT.
$ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) 1.0D+0)
685 $ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
689.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
690 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
691 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 0.0D+0
692.LE.
IF ( INFO N ) INFO = N + J
693.LT.
ELSE IF ( ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) ERR_LBND )
695 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = ERR_LBND
696 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
701.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
702 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = RCOND_TMP
708.GE..AND..GE.
IF (N_ERR_BNDS 1 N_NORMS 2) THEN
718 CWISE_WRONG = SQRT( DLAMCH( 'epsilon
' ) )
720.LT.
IF (ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) CWISE_WRONG )
722 RCOND_TMP = ZLA_GBRCOND_X( TRANS, N, KL, KU, AB, LDAB,
723 $ AFB, LDAFB, IPIV, X( 1, J ), INFO, WORK, RWORK )
730.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
731.AND..GT.
$ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) 1.0D+0 )
732 $ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
736.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
737 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
738 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 0.0D+0
739.EQ.
IF ( PARAMS( LA_LINRX_CWISE_I ) 1.0D+0
740.AND..LT.
$ INFON + J ) INFO = N + J
741 ELSE IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I )
742.LT.
$ ERR_LBND ) THEN
743 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = ERR_LBND
744 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
749.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
750 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = RCOND_TMP
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...
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...
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...
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