408 $ nrhs, ab, ldab, afb, ldafb, ipiv,
409 $ colequ, c, b, ldb, y, ldy,
410 $ berr_out, n_norms, err_bnds_norm,
411 $ err_bnds_comp, res, ayb, dy,
412 $ y_tail, rcond, ithresh, rthresh,
413 $ dz_ub, ignore_cwise, info )
421 INTEGER INFO, LDAB, LDAFB, LDB, LDY, N, KL, KU, NRHS,
422 $ prec_type, trans_type, n_norms, ithresh
423 LOGICAL COLEQU, IGNORE_CWISE
424 DOUBLE PRECISION RTHRESH, DZ_UB
428 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
429 $ y( ldy, * ), res( * ), dy( * ), y_tail( * )
430 DOUBLE PRECISION C( * ), AYB(*), RCOND, BERR_OUT( * ),
431 $ err_bnds_norm( nrhs, * ),
432 $ err_bnds_comp( nrhs, * )
439 INTEGER CNT, I, J, M, X_STATE, Z_STATE, Y_PREC_STATE
440 DOUBLE PRECISION YK, DYK, YMIN, NORMY, NORMX, NORMDX, DXRAT,
441 $ dzrat, prevnormdx, prev_dz_z, dxratmax,
442 $ dzratmax, dx_x, dz_z, final_dx_x, final_dz_z,
443 $ eps, hugeval, incr_thresh
448 INTEGER UNSTABLE_STATE, WORKING_STATE, CONV_STATE,
449 $ noprog_state, base_residual, extra_residual,
451 parameter ( unstable_state = 0, working_state = 1,
452 $ conv_state = 2, noprog_state = 3 )
453 parameter ( base_residual = 0, extra_residual = 1,
455 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
456 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
457 INTEGER CMP_ERR_I, PIV_GROWTH_I
458 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
460 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
461 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
463 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
465 parameter ( la_linrx_itref_i = 1,
466 $ la_linrx_ithresh_i = 2 )
467 parameter ( la_linrx_cwise_i = 3 )
468 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
470 parameter ( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
471 parameter ( la_linrx_rcond_i = 3 )
477 DOUBLE PRECISION DLAMCH
478 CHARACTER CHLA_TRANSTYPE
481 INTRINSIC abs, max, min
484 DOUBLE PRECISION CABS1
487 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
491 IF (info.NE.0)
RETURN
492 trans = chla_transtype(trans_type)
493 eps = dlamch(
'Epsilon' )
494 hugeval = dlamch(
'Overflow' )
496 hugeval = hugeval * hugeval
498 incr_thresh = dble( n ) * eps
502 y_prec_state = extra_residual
503 IF ( y_prec_state .EQ. extra_y )
THEN
520 x_state = working_state
521 z_state = unstable_state
529 CALL zcopy( n, b( 1, j ), 1, res, 1 )
530 IF ( y_prec_state .EQ. base_residual )
THEN
531 CALL zgbmv( trans, m, n, kl, ku, (-1.0d+0,0.0d+0), ab,
532 $ ldab, y( 1, j ), 1, (1.0d+0,0.0d+0), res, 1 )
533 ELSE IF ( y_prec_state .EQ. extra_residual )
THEN
534 CALL blas_zgbmv_x( trans_type, n, n, kl, ku,
535 $ (-1.0d+0,0.0d+0), ab, ldab, y( 1, j ), 1,
536 $ (1.0d+0,0.0d+0), res, 1, prec_type )
538 CALL blas_zgbmv2_x( trans_type, n, n, kl, ku,
539 $ (-1.0d+0,0.0d+0), ab, ldab, y( 1, j ), y_tail, 1,
540 $ (1.0d+0,0.0d+0), res, 1, prec_type )
544 CALL zcopy( n, res, 1, dy, 1 )
545 CALL zgbtrs( trans, n, kl, ku, 1, afb, ldafb, ipiv, dy, n,
557 yk = cabs1( y( i, j ) )
558 dyk = cabs1( dy( i ) )
560 IF (yk .NE. 0.0d+0)
THEN
561 dz_z = max( dz_z, dyk / yk )
562 ELSE IF ( dyk .NE. 0.0d+0 )
THEN
566 ymin = min( ymin, yk )
568 normy = max( normy, yk )
571 normx = max( normx, yk * c( i ) )
572 normdx = max(normdx, dyk * c(i))
575 normdx = max( normdx, dyk )
579 IF ( normx .NE. 0.0d+0 )
THEN
580 dx_x = normdx / normx
581 ELSE IF ( normdx .EQ. 0.0d+0 )
THEN
587 dxrat = normdx / prevnormdx
588 dzrat = dz_z / prev_dz_z
592 IF (.NOT.ignore_cwise
593 $ .AND. ymin*rcond .LT. incr_thresh*normy
594 $ .AND. y_prec_state .LT. extra_y )
597 IF ( x_state .EQ. noprog_state .AND. dxrat .LE. rthresh )
598 $ x_state = working_state
599 IF ( x_state .EQ. working_state )
THEN
600 IF ( dx_x .LE. eps )
THEN
602 ELSE IF ( dxrat .GT. rthresh )
THEN
603 IF ( y_prec_state .NE. extra_y )
THEN
606 x_state = noprog_state
609 IF ( dxrat .GT. dxratmax ) dxratmax = dxrat
611 IF ( x_state .GT. working_state ) final_dx_x = dx_x
614 IF ( z_state .EQ. unstable_state .AND. dz_z .LE. dz_ub )
615 $ z_state = working_state
616 IF ( z_state .EQ. noprog_state .AND. dzrat .LE. rthresh )
617 $ z_state = working_state
618 IF ( z_state .EQ. working_state )
THEN
619 IF ( dz_z .LE. eps )
THEN
621 ELSE IF ( dz_z .GT. dz_ub )
THEN
622 z_state = unstable_state
625 ELSE IF ( dzrat .GT. rthresh )
THEN
626 IF ( y_prec_state .NE. extra_y )
THEN
629 z_state = noprog_state
632 IF ( dzrat .GT. dzratmax ) dzratmax = dzrat
634 IF ( z_state .GT. working_state ) final_dz_z = dz_z
641 IF ( x_state.NE.working_state )
THEN
642 IF ( ignore_cwise )
GOTO 666
643 IF ( z_state.EQ.noprog_state .OR. z_state.EQ.conv_state )
645 IF ( z_state.EQ.unstable_state .AND. cnt.GT.1 )
GOTO 666
648 IF ( incr_prec )
THEN
650 y_prec_state = y_prec_state + 1
661 IF ( y_prec_state .LT. extra_y )
THEN
662 CALL zaxpy( n, (1.0d+0,0.0d+0), dy, 1, y(1,j), 1 )
673 IF ( x_state .EQ. working_state ) final_dx_x = dx_x
674 IF ( z_state .EQ. working_state ) final_dz_z = dz_z
678 IF ( n_norms .GE. 1 )
THEN
679 err_bnds_norm( j, la_linrx_err_i ) =
680 $ final_dx_x / (1 - dxratmax)
682 IF ( n_norms .GE. 2 )
THEN
683 err_bnds_comp( j, la_linrx_err_i ) =
684 $ final_dz_z / (1 - dzratmax)
695 CALL zcopy( n, b( 1, j ), 1, res, 1 )
696 CALL zgbmv( trans, n, n, kl, ku, (-1.0d+0,0.0d+0), ab, ldab,
697 $ y(1,j), 1, (1.0d+0,0.0d+0), res, 1 )
700 ayb( i ) = cabs1( b( i, j ) )
705 CALL zla_gbamv( trans_type, n, n, kl, ku, 1.0d+0,
706 $ ab, ldab, y(1, j), 1, 1.0d+0, ayb, 1 )
double precision function dlamch(CMACH)
DLAMCH
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zla_gbamv(TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, INCX, BETA, Y, INCY)
ZLA_GBAMV performs a matrix-vector operation to calculate error bounds.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGBMV
subroutine zla_lin_berr(N, NZ, NRHS, RES, AYB, BERR)
ZLA_LIN_BERR computes a component-wise relative backward error.
subroutine zla_wwaddw(N, X, Y, W)
ZLA_WWADDW adds a vector into a doubled-single vector.
character *1 function chla_transtype(TRANS)
CHLA_TRANSTYPE
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
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...