394 $ af, ldaf, ipiv, colequ, c, b, ldb,
395 $ y, ldy, berr_out, n_norms,
396 $ err_bnds_norm, err_bnds_comp, res,
397 $ ayb, dy, y_tail, rcond, ithresh,
398 $ rthresh, dz_ub, ignore_cwise,
407 INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
410 LOGICAL COLEQU, IGNORE_CWISE
411 DOUBLE PRECISION RTHRESH, DZ_UB
415 COMPLEX*16 A( lda, * ), AF( ldaf, * ), B( ldb, * ),
416 $ y( ldy, * ), res( * ), dy( * ), y_tail( * )
417 DOUBLE PRECISION C( * ), AYB( * ), RCOND, BERR_OUT( * ),
418 $ err_bnds_norm( nrhs, * ),
419 $ err_bnds_comp( nrhs, * )
425 INTEGER UPLO2, CNT, I, J, X_STATE, Z_STATE,
427 DOUBLE PRECISION YK, DYK, YMIN, NORMY, NORMX, NORMDX, DXRAT,
428 $ dzrat, prevnormdx, prev_dz_z, dxratmax,
429 $ dzratmax, dx_x, dz_z, final_dx_x, final_dz_z,
430 $ eps, hugeval, incr_thresh
431 LOGICAL INCR_PREC, UPPER
435 INTEGER UNSTABLE_STATE, WORKING_STATE, CONV_STATE,
436 $ noprog_state, base_residual, extra_residual,
438 parameter ( unstable_state = 0, working_state = 1,
439 $ conv_state = 2, noprog_state = 3 )
440 parameter ( base_residual = 0, extra_residual = 1,
442 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
443 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
444 INTEGER CMP_ERR_I, PIV_GROWTH_I
445 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
447 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
448 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
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 )
469 DOUBLE PRECISION DLAMCH
472 INTRINSIC abs, dble, dimag, max, min
475 DOUBLE PRECISION CABS1
478 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
483 upper = lsame( uplo,
'U' )
484 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
486 ELSE IF( n.LT.0 )
THEN
488 ELSE IF( nrhs.LT.0 )
THEN
490 ELSE IF( lda.LT.max( 1, n ) )
THEN
492 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
494 ELSE IF( ldb.LT.max( 1, n ) )
THEN
496 ELSE IF( ldy.LT.max( 1, n ) )
THEN
500 CALL xerbla(
'ZLA_HERFSX_EXTENDED', -info )
503 eps = dlamch(
'Epsilon' )
504 hugeval = dlamch(
'Overflow' )
506 hugeval = hugeval * hugeval
508 incr_thresh = dble( n ) * eps
510 IF ( lsame( uplo,
'L' ) )
THEN
511 uplo2 = ilauplo(
'L' )
513 uplo2 = ilauplo(
'U' )
517 y_prec_state = extra_residual
518 IF ( y_prec_state .EQ. extra_y )
THEN
535 x_state = working_state
536 z_state = unstable_state
544 CALL zcopy( n, b( 1, j ), 1, res, 1 )
545 IF ( y_prec_state .EQ. base_residual )
THEN
546 CALL zhemv( uplo, n, dcmplx(-1.0d+0), a, lda, y( 1, j ),
547 $ 1, dcmplx(1.0d+0), res, 1 )
548 ELSE IF ( y_prec_state .EQ. extra_residual )
THEN
549 CALL blas_zhemv_x( uplo2, n, dcmplx(-1.0d+0), a, lda,
550 $ y( 1, j ), 1, dcmplx(1.0d+0), res, 1, prec_type)
552 CALL blas_zhemv2_x(uplo2, n, dcmplx(-1.0d+0), a, lda,
553 $ y(1, j), y_tail, 1, dcmplx(1.0d+0), res, 1,
558 CALL zcopy( n, res, 1, dy, 1 )
559 CALL zhetrs( uplo, n, 1, af, ldaf, ipiv, dy, n, info )
570 yk = cabs1( y( i, j ) )
571 dyk = cabs1( dy( i ) )
573 IF (yk .NE. 0.0d+0)
THEN
574 dz_z = max( dz_z, dyk / yk )
575 ELSE IF ( dyk .NE. 0.0d+0 )
THEN
579 ymin = min( ymin, yk )
581 normy = max( normy, yk )
584 normx = max( normx, yk * c( i ) )
585 normdx = max( normdx, dyk * c( i ) )
588 normdx = max( normdx, dyk )
592 IF ( normx .NE. 0.0d+0 )
THEN
593 dx_x = normdx / normx
594 ELSE IF ( normdx .EQ. 0.0d+0 )
THEN
600 dxrat = normdx / prevnormdx
601 dzrat = dz_z / prev_dz_z
605 IF ( ymin*rcond .LT. incr_thresh*normy
606 $ .AND. y_prec_state .LT. extra_y )
609 IF ( x_state .EQ. noprog_state .AND. dxrat .LE. rthresh )
610 $ x_state = working_state
611 IF ( x_state .EQ. working_state )
THEN
612 IF ( dx_x .LE. eps )
THEN
614 ELSE IF ( dxrat .GT. rthresh )
THEN
615 IF ( y_prec_state .NE. extra_y )
THEN
618 x_state = noprog_state
621 IF (dxrat .GT. dxratmax) dxratmax = dxrat
623 IF ( x_state .GT. working_state ) final_dx_x = dx_x
626 IF ( z_state .EQ. unstable_state .AND. dz_z .LE. dz_ub )
627 $ z_state = working_state
628 IF ( z_state .EQ. noprog_state .AND. dzrat .LE. rthresh )
629 $ z_state = working_state
630 IF ( z_state .EQ. working_state )
THEN
631 IF ( dz_z .LE. eps )
THEN
633 ELSE IF ( dz_z .GT. dz_ub )
THEN
634 z_state = unstable_state
637 ELSE IF ( dzrat .GT. rthresh )
THEN
638 IF ( y_prec_state .NE. extra_y )
THEN
641 z_state = noprog_state
644 IF ( dzrat .GT. dzratmax ) dzratmax = dzrat
646 IF ( z_state .GT. working_state ) final_dz_z = dz_z
649 IF ( x_state.NE.working_state.AND.
650 $ ( ignore_cwise.OR.z_state.NE.working_state ) )
653 IF ( incr_prec )
THEN
655 y_prec_state = y_prec_state + 1
666 IF ( y_prec_state .LT. extra_y )
THEN
667 CALL zaxpy( n, dcmplx(1.0d+0), dy, 1, y(1,j), 1 )
678 IF ( x_state .EQ. working_state ) final_dx_x = dx_x
679 IF ( z_state .EQ. working_state ) final_dz_z = dz_z
683 IF ( n_norms .GE. 1 )
THEN
684 err_bnds_norm( j, la_linrx_err_i ) =
685 $ final_dx_x / (1 - dxratmax)
687 IF (n_norms .GE. 2)
THEN
688 err_bnds_comp( j, la_linrx_err_i ) =
689 $ final_dz_z / (1 - dzratmax)
700 CALL zcopy( n, b( 1, j ), 1, res, 1 )
701 CALL zhemv( uplo, n, dcmplx(-1.0d+0), a, lda, y(1,j), 1,
702 $ dcmplx(1.0d+0), res, 1 )
705 ayb( i ) = cabs1( b( i, j ) )
711 $ a, lda, y(1, j), 1, 1.0d+0, ayb, 1 )
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zla_lin_berr(N, NZ, NRHS, RES, AYB, BERR)
ZLA_LIN_BERR computes a component-wise relative backward error.
subroutine zla_heamv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bou...
subroutine xerbla(SRNAME, INFO)
XERBLA
integer function ilauplo(UPLO)
ILAUPLO
subroutine zla_wwaddw(N, X, Y, W)
ZLA_WWADDW adds a vector into a doubled-single vector.
subroutine zla_herfsx_extended(PREC_TYPE, UPLO, N, NRHS, A, LDA, AF, LDAF, 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_HERFSX_EXTENDED improves the computed solution to a system of linear equations for Hermitian inde...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY