412 SUBROUTINE cgerfsx( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
413 $ r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds,
414 $ err_bnds_norm, err_bnds_comp, nparams, params,
415 $ work, rwork, info )
423 CHARACTER TRANS, EQUED
424 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
430 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
431 $ x( ldx , * ), work( * )
432 REAL R( * ), C( * ), PARAMS( * ), BERR( * ),
433 $ err_bnds_norm( nrhs, * ),
434 $ err_bnds_comp( nrhs, * ), rwork( * )
441 parameter ( zero = 0.0e+0, one = 1.0e+0 )
442 REAL ITREF_DEFAULT, ITHRESH_DEFAULT,
443 $ componentwise_default
444 REAL RTHRESH_DEFAULT, DZTHRESH_DEFAULT
445 parameter ( itref_default = 1.0 )
446 parameter ( ithresh_default = 10.0 )
447 parameter ( componentwise_default = 1.0 )
448 parameter ( rthresh_default = 0.5 )
449 parameter ( dzthresh_default = 0.25 )
450 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
452 parameter ( la_linrx_itref_i = 1,
453 $ la_linrx_ithresh_i = 2 )
454 parameter ( la_linrx_cwise_i = 3 )
455 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
457 parameter ( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
458 parameter ( la_linrx_rcond_i = 3 )
462 LOGICAL ROWEQU, COLEQU, NOTRAN
463 INTEGER J, TRANS_TYPE, PREC_TYPE, REF_TYPE
465 REAL ANORM, RCOND_TMP
466 REAL ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
469 REAL RTHRESH, UNSTABLE_THRESH
475 INTRINSIC max, sqrt, transfer
480 REAL SLAMCH, CLANGE, CLA_GERCOND_X, CLA_GERCOND_C
482 INTEGER ILATRANS, ILAPREC
489 trans_type = ilatrans( trans )
490 ref_type = int( itref_default )
491 IF ( nparams .GE. la_linrx_itref_i )
THEN
492 IF ( params( la_linrx_itref_i ) .LT. 0.0 )
THEN
493 params( la_linrx_itref_i ) = itref_default
495 ref_type = params( la_linrx_itref_i )
501 illrcond_thresh =
REAL( N ) * SLAMCH(
'Epsilon' )
502 ithresh = int( ithresh_default )
503 rthresh = rthresh_default
504 unstable_thresh = dzthresh_default
505 ignore_cwise = componentwise_default .EQ. 0.0
507 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
508 IF ( params( la_linrx_ithresh_i ).LT.0.0 )
THEN
509 params(la_linrx_ithresh_i) = ithresh
511 ithresh = int( params( la_linrx_ithresh_i ) )
514 IF ( nparams.GE.la_linrx_cwise_i )
THEN
515 IF ( params( la_linrx_cwise_i ).LT.0.0 )
THEN
516 IF ( ignore_cwise )
THEN
517 params( la_linrx_cwise_i ) = 0.0
519 params( la_linrx_cwise_i ) = 1.0
522 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0
525 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
527 ELSE IF ( ignore_cwise )
THEN
533 notran = lsame( trans,
'N' )
534 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
535 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
539 IF( trans_type.EQ.-1 )
THEN
541 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
542 $ .NOT.lsame( equed,
'N' ) )
THEN
544 ELSE IF( n.LT.0 )
THEN
546 ELSE IF( nrhs.LT.0 )
THEN
548 ELSE IF( lda.LT.max( 1, n ) )
THEN
550 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
552 ELSE IF( ldb.LT.max( 1, n ) )
THEN
554 ELSE IF( ldx.LT.max( 1, n ) )
THEN
558 CALL xerbla(
'CGERFSX', -info )
564 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
568 IF ( n_err_bnds .GE. 1 )
THEN
569 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
570 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
572 IF ( n_err_bnds .GE. 2 )
THEN
573 err_bnds_norm( j, la_linrx_err_i ) = 0.0
574 err_bnds_comp( j, la_linrx_err_i ) = 0.0
576 IF ( n_err_bnds .GE. 3 )
THEN
577 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0
578 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0
589 IF ( n_err_bnds .GE. 1 )
THEN
590 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
591 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
593 IF ( n_err_bnds .GE. 2 )
THEN
594 err_bnds_norm( j, la_linrx_err_i ) = 1.0
595 err_bnds_comp( j, la_linrx_err_i ) = 1.0
597 IF ( n_err_bnds .GE. 3 )
THEN
598 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0
599 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0
611 anorm = clange( norm, n, n, a, lda, rwork )
612 CALL cgecon( norm, n, af, ldaf, anorm, rcond, work, rwork, info )
616 IF ( ref_type .NE. 0 )
THEN
618 prec_type = ilaprec(
'D' )
622 $ nrhs, a, lda, af, ldaf, ipiv, colequ, c, b,
623 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
624 $ err_bnds_comp, work, rwork, work(n+1),
625 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
626 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
630 $ nrhs, a, lda, af, ldaf, ipiv, rowequ, r, b,
631 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
632 $ err_bnds_comp, work, rwork, work(n+1),
633 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
634 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
639 err_lbnd = max( 10.0, sqrt(
REAL( N ) ) ) * slamch(
'Epsilon' )
640 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
644 IF ( colequ .AND. notran )
THEN
645 rcond_tmp = cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv,
646 $ c, .true., info, work, rwork )
647 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
648 rcond_tmp = cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv,
649 $ r, .true., info, work, rwork )
651 rcond_tmp = cla_gercond_c( trans, n, a, lda, af, ldaf, ipiv,
652 $ c, .false., info, work, rwork )
658 IF ( n_err_bnds .GE. la_linrx_err_i
659 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0 )
660 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0
664 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
665 err_bnds_norm( j, la_linrx_err_i ) = 1.0
666 err_bnds_norm( j, la_linrx_trust_i ) = 0.0
667 IF ( info .LE. n ) info = n + j
668 ELSE IF (err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd)
670 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
671 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
676 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
677 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
682 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
692 cwise_wrong = sqrt( slamch(
'Epsilon' ) )
694 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
696 rcond_tmp = cla_gercond_x( trans, n, a, lda, af, ldaf,
697 $ ipiv, x(1,j), info, work, rwork )
704 IF ( n_err_bnds .GE. la_linrx_err_i
705 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0 )
706 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0
710 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
711 err_bnds_comp( j, la_linrx_err_i ) = 1.0
712 err_bnds_comp( j, la_linrx_trust_i ) = 0.0
713 IF ( params( la_linrx_cwise_i ) .EQ. 1.0
714 $ .AND. info.LT.n + j ) info = n + j
715 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
716 $ .LT. err_lbnd )
THEN
717 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
718 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
723 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
724 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
real function cla_gercond_x(TRANS, N, A, LDA, AF, LDAF, IPIV, X, INFO, WORK, RWORK)
CLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices...
subroutine cgerfsx(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)
CGERFSX
subroutine cla_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)
CLA_GERFSX_EXTENDED
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
integer function ilatrans(TRANS)
ILATRANS
integer function ilaprec(PREC)
ILAPREC
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
real function cla_gercond_c(TRANS, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
CLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices...