From 39231cbdd6b8cad707257b6a3fcd14e2fc5e012a Mon Sep 17 00:00:00 2001 From: Hao Xu Date: Fri, 19 Jul 2024 14:46:04 -0400 Subject: [PATCH] Fix dstevx.f and sstevx.f: N=1 quick return and scaling of ABSTOL. --- SRC/dstevx.f | 15 ++++++++++----- SRC/sstevx.f | 15 ++++++++++----- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/SRC/dstevx.f b/SRC/dstevx.f index 390ef92f57..921508b4dc 100644 --- a/SRC/dstevx.f +++ b/SRC/dstevx.f @@ -251,8 +251,8 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, CHARACTER ORDER INTEGER I, IMAX, INDISP, INDIWO, INDWRK, $ ISCALE, ITMP1, J, JJ, NSPLIT - DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM, - $ TMP1, TNRM, VLL, VUU + DOUBLE PRECISION ABSTLL, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, + $ SMLNUM, TMP1, TNRM, VLL, VUU * .. * .. External Functions .. LOGICAL LSAME @@ -321,8 +321,10 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, W( 1 ) = D( 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * @@ -338,6 +340,7 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * Scale matrix to allowable range, if necessary. * ISCALE = 0 + ABSTLL = ABSTOL IF( VALEIG ) THEN VLL = VL VUU = VU @@ -356,6 +359,8 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( ISCALE.EQ.1 ) THEN CALL DSCAL( N, SIGMA, D, 1 ) CALL DSCAL( N-1, SIGMA, E( 1 ), 1 ) + IF( ABSTOL.GT.0 ) + $ ABSTLL = ABSTOL*SIGMA IF( VALEIG ) THEN VLL = VL*SIGMA VUU = VU*SIGMA @@ -404,7 +409,7 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, INDWRK = 1 INDISP = 1 + N INDIWO = INDISP + N - CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, D, E, $ M, $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ), $ WORK( INDWRK ), IWORK( INDIWO ), INFO ) diff --git a/SRC/sstevx.f b/SRC/sstevx.f index 84a8f3802a..f87177b9e8 100644 --- a/SRC/sstevx.f +++ b/SRC/sstevx.f @@ -251,8 +251,8 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, CHARACTER ORDER INTEGER I, IMAX, INDISP, INDIWO, INDWRK, $ ISCALE, ITMP1, J, JJ, NSPLIT - REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM, - $ TMP1, TNRM, VLL, VUU + REAL ABSTLL, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, + $ SMLNUM, TMP1, TNRM, VLL, VUU * .. * .. External Functions .. LOGICAL LSAME @@ -321,8 +321,10 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, W( 1 ) = D( 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * @@ -338,6 +340,7 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * Scale matrix to allowable range, if necessary. * ISCALE = 0 + ABSTLL = ABSTOL IF ( VALEIG ) THEN VLL = VL VUU = VU @@ -356,6 +359,8 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( ISCALE.EQ.1 ) THEN CALL SSCAL( N, SIGMA, D, 1 ) CALL SSCAL( N-1, SIGMA, E( 1 ), 1 ) + IF( ABSTOL.GT.0 ) + $ ABSTLL = ABSTOL*SIGMA IF( VALEIG ) THEN VLL = VL*SIGMA VUU = VU*SIGMA @@ -404,7 +409,7 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, INDWRK = 1 INDISP = 1 + N INDIWO = INDISP + N - CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, D, E, $ M, $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ), $ WORK( INDWRK ), IWORK( INDIWO ), INFO )