diff options
| author | julie <julielangou@users.noreply.github.com> | 2011-12-10 06:45:16 +0000 |
|---|---|---|
| committer | julie <julielangou@users.noreply.github.com> | 2011-12-10 06:45:16 +0000 |
| commit | 3076651009a1793e1767fcadaa5ab38ad082ff89 (patch) | |
| tree | 23aa5fe841e3faae15b00fc2506b31732e16c8ac /SRC/zherfsx.f | |
| parent | 758888bfa2c99a52ae368c9bf29530dcc321ad3e (diff) | |
| download | lapack-3076651009a1793e1767fcadaa5ab38ad082ff89.tar.gz lapack-3076651009a1793e1767fcadaa5ab38ad082ff89.tar.bz2 lapack-3076651009a1793e1767fcadaa5ab38ad082ff89.zip | |
Fix bug bug0088 reported by Mike Pont from NAG on the forum
(see http://icl.cs.utk.edu/lapack-forum/viewtopic.php?f=13&t=2893)
This is related to the LAPACK-XBLAS routine: zherfsx.f
Here is what I did:
- Introduce IINFO so that INFO is not overwritten
- Use IGNORE_CWISE as suggested to prevent use of unitialize variable PARAMS
But this did not fix the problem reported.
INFO has new value in ZHERFSX (see description of INFO between ZHESVX and ZHESVXX)
This is set on line 634 (IF ( INFO .LE. N ) INFO = N + J) of zherfsx.f
And this is not handled by the testing LIN/zdrvhex.f
I just add .AND. INFO.LE.N at line 638 to avoid raising an error when INFO = N + J
Please send feedback as I am not sure this is the best way to fix the issue.
I will commit other precision once fix approved.
Thanks
Julie
Diffstat (limited to 'SRC/zherfsx.f')
| -rw-r--r-- | SRC/zherfsx.f | 18 |
1 files changed, 9 insertions, 9 deletions
diff --git a/SRC/zherfsx.f b/SRC/zherfsx.f index 84b09066..62fdf989 100644 --- a/SRC/zherfsx.f +++ b/SRC/zherfsx.f @@ -312,7 +312,7 @@ *> *> \param[in,out] PARAMS *> \verbatim -*> PARAMS is / output) DOUBLE PRECISION array, dimension NPARAMS +*> PARAMS is DOUBLE PRECISION array, dimension NPARAMS *> Specifies algorithm parameters. If an entry is .LT. 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults @@ -446,7 +446,7 @@ * .. Local Scalars .. CHARACTER(1) NORM LOGICAL RCEQU - INTEGER J, PREC_TYPE, REF_TYPE + INTEGER IINFO, J, PREC_TYPE, REF_TYPE INTEGER N_NORMS DOUBLE PRECISION ANORM, RCOND_TMP DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG @@ -589,7 +589,7 @@ NORM = 'I' ANORM = ZLANHE( NORM, UPLO, N, A, LDA, RWORK ) CALL ZHECON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, - $ INFO ) + $ IINFO ) * * Perform refinement on each right-hand side * @@ -603,7 +603,7 @@ $ WORK, RWORK, WORK(N+1), $ TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N), RCOND, $ ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE, - $ INFO ) + $ IINFO ) END IF ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) @@ -613,10 +613,10 @@ * IF ( RCEQU ) THEN RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, - $ S, .TRUE., INFO, WORK, RWORK ) + $ S, .TRUE., IINFO, WORK, RWORK ) ELSE RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, - $ S, .FALSE., INFO, WORK, RWORK ) + $ S, .FALSE., IINFO, WORK, RWORK ) END IF DO J = 1, NRHS * @@ -661,7 +661,7 @@ IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG ) $ THEN RCOND_TMP = ZLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, - $ IPIV, X( 1, J ), INFO, WORK, RWORK ) + $ IPIV, X( 1, J ), IINFO, WORK, RWORK ) ELSE RCOND_TMP = 0.0D+0 END IF @@ -677,8 +677,8 @@ IF ( RCOND_TMP .LT. ILLRCOND_THRESH ) THEN ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0D+0 ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 0.0D+0 - IF ( PARAMS( LA_LINRX_CWISE_I ) .EQ. 1.0D+0 - $ .AND. INFO.LT.N + J ) INFO = N + J + IF ( .NOT. IGNORE_CWISE + $ .AND. INFO.LT.N + J ) INFO = N + J ELSE IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) $ .LT. ERR_LBND ) THEN ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = ERR_LBND |