410 SUBROUTINE zgerfsx( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
411 $ R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS,
412 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
413 $ WORK, RWORK, INFO )
420 CHARACTER TRANS, EQUED
421 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
423 DOUBLE PRECISION RCOND
427 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
428 $ X( LDX , * ), WORK( * )
429 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
430 $ err_bnds_norm( nrhs, * ),
431 $ err_bnds_comp( nrhs, * ), rwork( * )
437 DOUBLE PRECISION ZERO, ONE
438 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
439 DOUBLE PRECISION ITREF_DEFAULT, ITHRESH_DEFAULT
440 DOUBLE PRECISION COMPONENTWISE_DEFAULT, RTHRESH_DEFAULT
441 DOUBLE PRECISION DZTHRESH_DEFAULT
442 parameter( itref_default = 1.0d+0 )
443 parameter( ithresh_default = 10.0d+0 )
444 PARAMETER ( componentwise_default = 1.0d+0 )
445 parameter( rthresh_default = 0.5d+0 )
446 parameter( dzthresh_default = 0.25d+0 )
447 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
449 parameter( la_linrx_itref_i = 1,
450 $ la_linrx_ithresh_i = 2 )
451 parameter( la_linrx_cwise_i = 3 )
452 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
454 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
455 parameter( la_linrx_rcond_i = 3 )
459 LOGICAL ROWEQU, COLEQU, NOTRAN
460 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE
462 DOUBLE PRECISION ANORM, RCOND_TMP
463 DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
466 DOUBLE PRECISION RTHRESH, UNSTABLE_THRESH
472 INTRINSIC max, sqrt, transfer
477 DOUBLE PRECISION DLAMCH, ZLANGE, ZLA_GERCOND_X, ZLA_GERCOND_C
479 INTEGER ILATRANS, ILAPREC
486 trans_type = ilatrans( trans )
487 ref_type = int( itref_default )
488 IF ( nparams .GE. la_linrx_itref_i )
THEN
489 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
490 params( la_linrx_itref_i ) = itref_default
492 ref_type = params( la_linrx_itref_i )
498 illrcond_thresh = dble( n ) * dlamch( 'epsilon
' )
499 ITHRESH = INT( ITHRESH_DEFAULT )
500 RTHRESH = RTHRESH_DEFAULT
501 UNSTABLE_THRESH = DZTHRESH_DEFAULT
502.EQ.
IGNORE_CWISE = COMPONENTWISE_DEFAULT 0.0D+0
504.GE.
IF ( NPARAMSLA_LINRX_ITHRESH_I ) THEN
505.LT.
IF ( PARAMS( LA_LINRX_ITHRESH_I )0.0D+0 ) THEN
506 PARAMS(LA_LINRX_ITHRESH_I) = ITHRESH
508 ITHRESH = INT( PARAMS( LA_LINRX_ITHRESH_I ) )
511.GE.
IF ( NPARAMSLA_LINRX_CWISE_I ) THEN
512.LT.
IF ( PARAMS( LA_LINRX_CWISE_I )0.0D+0 ) THEN
513 IF ( IGNORE_CWISE ) THEN
514 PARAMS( LA_LINRX_CWISE_I ) = 0.0D+0
516 PARAMS( LA_LINRX_CWISE_I ) = 1.0D+0
519.EQ.
IGNORE_CWISE = PARAMS( LA_LINRX_CWISE_I ) 0.0D+0
522.EQ..OR..EQ.
IF ( REF_TYPE 0 N_ERR_BNDS 0 ) THEN
524 ELSE IF ( IGNORE_CWISE ) THEN
530 NOTRAN = LSAME( TRANS, 'n
' )
531 ROWEQU = LSAME( EQUED, 'r.OR.
' ) LSAME( EQUED, 'b
' )
532 COLEQU = LSAME( EQUED, 'c.OR.
' ) LSAME( EQUED, 'b
' )
536.EQ.
IF( TRANS_TYPE-1 ) THEN
538.NOT..AND..NOT..AND.
ELSE IF( ROWEQU COLEQU
539.NOT.
$ LSAME( EQUED, 'n
' ) ) THEN
541.LT.
ELSE IF( N0 ) THEN
543.LT.
ELSE IF( NRHS0 ) THEN
545.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
547.LT.
ELSE IF( LDAFMAX( 1, N ) ) THEN
549.LT.
ELSE IF( LDBMAX( 1, N ) ) THEN
551.LT.
ELSE IF( LDXMAX( 1, N ) ) THEN
555 CALL XERBLA( 'zgerfsx', -INFO )
561.EQ..OR..EQ.
IF( N0 NRHS0 ) THEN
565.GE.
IF ( N_ERR_BNDS 1 ) THEN
566 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
567 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
569.GE.
IF ( N_ERR_BNDS 2 ) THEN
570 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 0.0D+0
571 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 0.0D+0
573.GE.
IF ( N_ERR_BNDS 3 ) THEN
574 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 1.0D+0
575 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 1.0D+0
586.GE.
IF ( N_ERR_BNDS 1 ) THEN
587 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
588 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
590.GE.
IF ( N_ERR_BNDS 2 ) THEN
591 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
592 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
594.GE.
IF ( N_ERR_BNDS 3 ) THEN
595 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 0.0D+0
596 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 0.0D+0
608 ANORM = ZLANGE( NORM, N, N, A, LDA, RWORK )
609 CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO )
613.NE.
IF ( REF_TYPE 0 ) THEN
615 PREC_TYPE = ILAPREC( 'e
' )
618 CALL ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N,
619 $ NRHS, A, LDA, AF, LDAF, IPIV, COLEQU, C, B,
620 $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
621 $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
622 $ TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
623 $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
626 CALL ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N,
627 $ NRHS, A, LDA, AF, LDAF, IPIV, ROWEQU, R, B,
628 $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
629 $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
630 $ TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
631 $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
636 ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'epsilon
' )
637.GE..AND..GE.
IF ( N_ERR_BNDS 1 N_NORMS 1 ) THEN
641.AND.
IF ( COLEQU NOTRAN ) THEN
642 RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV,
643 $ C, .TRUE., INFO, WORK, RWORK )
644.AND..NOT.
ELSE IF ( ROWEQU NOTRAN ) THEN
645 RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV,
646 $ R, .TRUE., INFO, WORK, RWORK )
648 RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV,
649 $ C, .FALSE., INFO, WORK, RWORK )
655.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
656.AND..GT.
$ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) 1.0D+0 )
657 $ ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
661.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
662 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0D+0
663 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 0.0D+0
664.LE.
IF ( INFO N ) INFO = N + J
665.LT.
ELSE IF (ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) ERR_LBND)
667 ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = ERR_LBND
668 ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0D+0
673.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
674 ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = RCOND_TMP
679.GE..AND..GE.
IF ( N_ERR_BNDS 1 N_NORMS 2 ) THEN
689 CWISE_WRONG = SQRT( DLAMCH( 'epsilon
' ) )
691.LT.
IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) CWISE_WRONG )
693 RCOND_TMP = ZLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF,
694 $ IPIV, X(1,J), INFO, WORK, RWORK )
701.GE.
IF ( N_ERR_BNDS LA_LINRX_ERR_I
702.AND..GT.
$ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) 1.0D+0 )
703 $ ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
707.LT.
IF ( RCOND_TMP ILLRCOND_THRESH ) THEN
708 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0
709 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 0.0D+0
710.EQ.
IF ( PARAMS( LA_LINRX_CWISE_I ) 1.0D+0
711.AND..LT.
$ INFON + J ) INFO = N + J
712 ELSE IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I )
713.LT.
$ ERR_LBND ) THEN
714 ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = ERR_LBND
715 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0D+0
720.GE.
IF ( N_ERR_BNDS LA_LINRX_RCOND_I ) THEN
721 ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = RCOND_TMP
double precision function zlange(norm, m, n, a, lda, work)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zla_gerfsx_extended(prec_type, trans_type, n, nrhs, a, lda, af, ldaf, ipiv, colequ, c, b, ldb, y, ldy, berr_out, n_norms, errs_n, errs_c, res, ayb, dy, y_tail, rcond, ithresh, rthresh, dz_ub, ignore_cwise, info)
ZLA_GERFSX_EXTENDED
subroutine zgerfsx(trans, equed, n, nrhs, a, lda, af, ldaf, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
ZGERFSX
double precision function zla_gercond_c(trans, n, a, lda, af, ldaf, ipiv, c, capply, info, work, rwork)
ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices.
double precision function zla_gercond_x(trans, n, a, lda, af, ldaf, ipiv, x, info, work, rwork)
ZLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices.