diff --git a/SRC/cheevr.f b/SRC/cheevr.f index bab9353f8..e4ef7450c 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -93,10 +93,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : CHEEVR calls CSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> CHEEVR calls SSTEBZ and CSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : CHEEVR calls CSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). CHEEVR +*> calls SSTEBZ and CSTEIN on non-ieee machines. *> *> Normal execution of CSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -618,20 +617,22 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL CHETRD( UPLO, N, A, LDA, RWORK( INDRD ), RWORK( INDRE ), $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call SSTERF or CSTEMR and CUNMTR. +* On IEEE-754 compliant machines, call SSTERF or CSTEMR and CUNMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 ) - CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) - CALL SSTERF( N, W, RWORK( INDREE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 ) + CALL SCOPY( N-1, RWORK( INDRE ), 1, + $ RWORK( INDREE ), 1 ) + CALL SSTERF( N, W, RWORK( INDREE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) @@ -641,7 +642,7 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, ELSE TRYRAC = .FALSE. END IF - CALL CSTEMR( JOBZ, 'A', N, RWORK( INDRDD ), + CALL CSTEMR( JOBZ, RANGE, N, RWORK( INDRDD ), $ RWORK( INDREE ), VL, VU, IL, IU, M, W, $ Z, LDZ, N, ISUPPZ, TRYRAC, $ RWORK( INDRWK ), LLRWORK, @@ -657,14 +658,11 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN. diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index 5bd16f449..cfc51588e 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -92,10 +92,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : CHEEVR_2STAGE calls CSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> CHEEVR_2STAGE calls SSTEBZ and CSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : CHEEVR_2STAGE calls CSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). CHEEVR_2STAGE +*> calls SSTEBZ and CSTEIN on non-ieee machines. *> *> Normal execution of CSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -662,20 +661,22 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDHOUS ), LHTRD, $ WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call SSTERF or CSTEMR and CUNMTR. +* On IEEE-754 compliant machines, call SSTERF or CSTEMR and CUNMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 ) - CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) - CALL SSTERF( N, W, RWORK( INDREE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 ) + CALL SCOPY( N-1, RWORK( INDRE ), 1, + $ RWORK( INDREE ), 1 ) + CALL SSTERF( N, W, RWORK( INDREE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) @@ -685,7 +686,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, ELSE TRYRAC = .FALSE. END IF - CALL CSTEMR( JOBZ, 'A', N, RWORK( INDRDD ), + CALL CSTEMR( JOBZ, RANGE, N, RWORK( INDRDD ), $ RWORK( INDREE ), VL, VU, IL, IU, M, W, $ Z, LDZ, N, ISUPPZ, TRYRAC, $ RWORK( INDRWK ), LLRWORK, @@ -701,14 +702,11 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN. diff --git a/SRC/dstevr.f b/SRC/dstevr.f index d75afcb37..07f2d4dbd 100644 --- a/SRC/dstevr.f +++ b/SRC/dstevr.f @@ -67,10 +67,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : DSTEVR calls DSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> DSTEVR calls DSTEBZ and DSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : DSTEVR calls DSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). DSTEVR +*> calls DSTEBZ and DSTEIN on non-ieee machines. *> *> Normal execution of DSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -484,34 +483,35 @@ SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * try DSTEBZ. * * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG .OR. TEST ) .AND. IEEEOK.EQ.1 ) THEN - CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL DCOPY( N, D, 1, W, 1 ) - CALL DSTERF( N, W, WORK, INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) + CALL DCOPY( N, D, 1, W, 1 ) + CALL DSTERF( N, W, WORK, INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 10 + END IF + INFO = 0 + END IF ELSE + CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) CALL DCOPY( N, D, 1, WORK( N+1 ), 1 ) IF (ABSTOL .LE. TWO*N*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. END IF - CALL DSTEMR( JOBZ, 'A', N, WORK( N+1 ), WORK, VL, VU, IL, - $ IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC, + CALL DSTEMR( JOBZ, RANGE, N, WORK( N+1 ), WORK, VL, VU, + $ IL, IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC, $ WORK( 2*N+1 ), LWORK-2*N, IWORK, LIWORK, INFO ) -* - END IF - IF( INFO.EQ.0 ) THEN - M = N - GO TO 10 + IF( INFO.EQ.0 ) THEN + GO TO 10 + END IF + INFO = 0 END IF - INFO = 0 END IF * * Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN. diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 92166fa1b..8fc1a4a9e 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -91,10 +91,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : DSYEVR calls DSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). DSYEVR +*> calls DSTEBZ and DSTEIN on non-ieee machines. *> *> Normal execution of DSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -574,15 +573,21 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL DSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ), $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call DSTERF or DSTEMR and DORMTR. +* On IEEE-754 compliant machines, call DSTERF or DSTEMR and DORMTR. * - IF( ( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) .AND. - $ IEEEOK.EQ.1 ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL DCOPY( N, WORK( INDD ), 1, W, 1 ) - CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) - CALL DSTERF( N, W, WORK( INDEE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL DCOPY( N, WORK( INDD ), 1, W, 1 ) + CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) + CALL DSTERF( N, W, WORK( INDEE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL DCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) @@ -592,10 +597,10 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, ELSE TRYRAC = .FALSE. END IF - CALL DSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ), - $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ, - $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK, - $ INFO ) + CALL DSTEMR( JOBZ, RANGE, N, WORK( INDDD ), + $ WORK( INDEE ), VL, VU, IL, IU, M, W, Z, LDZ, + $ N, ISUPPZ, TRYRAC, WORK( INDWK ), LWORK, + $ IWORK, LIWORK, INFO ) * * * @@ -609,16 +614,11 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN -* Everything worked. Skip DSTEBZ/DSTEIN. IWORK(:) are -* undefined. - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN. diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 180800e26..f75379c36 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -89,10 +89,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : DSYEVR_2STAGE calls DSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> DSYEVR_2STAGE calls DSTEBZ and SSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : DSYEVR_2STAGE calls DSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). DSYEVR_2STAGE +*> calls DSTEBZ and SSTEIN on non-ieee machines. *> *> Normal execution of DSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -624,15 +623,21 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ), $ LHTRD, WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call DSTERF or DSTEMR and DORMTR. +* On IEEE-754 compliant machines, call DSTERF or DSTEMR and DORMTR. * - IF( ( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) .AND. - $ IEEEOK.EQ.1 ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL DCOPY( N, WORK( INDD ), 1, W, 1 ) - CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) - CALL DSTERF( N, W, WORK( INDEE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL DCOPY( N, WORK( INDD ), 1, W, 1 ) + CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) + CALL DSTERF( N, W, WORK( INDEE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL DCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL DCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) @@ -642,10 +647,10 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, ELSE TRYRAC = .FALSE. END IF - CALL DSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ), - $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ, - $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK, - $ INFO ) + CALL DSTEMR( JOBZ, RANGE, N, WORK( INDDD ), + $ WORK( INDEE ), VL, VU, IL, IU, M, W, Z, LDZ, + $ N, ISUPPZ, TRYRAC, WORK( INDWK ), LWORK, + $ IWORK, LIWORK, INFO ) * * * @@ -659,16 +664,11 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN -* Everything worked. Skip DSTEBZ/DSTEIN. IWORK(:) are -* undefined. - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call DSTEBZ and, if eigenvectors are desired, DSTEIN. diff --git a/SRC/sstevr.f b/SRC/sstevr.f index 0b72c2f0e..6dbda9312 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -67,10 +67,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : SSTEVR calls SSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> SSTEVR calls SSTEBZ and SSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : SSTEVR calls SSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). SSTEVR +*> calls SSTEBZ and SSTEIN on non-ieee machines. *> *> Normal execution of SSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -486,34 +485,35 @@ SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * try SSTEBZ. * * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG .OR. TEST ) .AND. IEEEOK.EQ.1 ) THEN - CALL SCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL SCOPY( N, D, 1, W, 1 ) - CALL SSTERF( N, W, WORK, INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL SCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) + CALL SCOPY( N, D, 1, W, 1 ) + CALL SSTERF( N, W, WORK, INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 10 + END IF + INFO = 0 + END IF ELSE + CALL SCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 ) CALL SCOPY( N, D, 1, WORK( N+1 ), 1 ) IF (ABSTOL .LE. TWO*REAL( N )*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. END IF - CALL SSTEMR( JOBZ, 'A', N, WORK( N+1 ), WORK, VL, VU, IL, - $ IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC, + CALL SSTEMR( JOBZ, RANGE, N, WORK( N+1 ), WORK, VL, VU, + $ IL, IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC, $ WORK( 2*N+1 ), LWORK-2*N, IWORK, LIWORK, INFO ) -* - END IF - IF( INFO.EQ.0 ) THEN - M = N - GO TO 10 + IF( INFO.EQ.0 ) THEN + GO TO 10 + END IF + INFO = 0 END IF - INFO = 0 END IF * * Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN. diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 6a848bb1c..59c10a257 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -91,10 +91,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : SSYEVR calls SSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : SSYEVR calls SSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). SSYEVR +*> calls SSTEBZ and SSTEIN on non-ieee machines. *> *> Normal execution of SSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -579,20 +578,21 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL SSYTRD( UPLO, N, A, LDA, WORK( INDD ), WORK( INDE ), $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call SSTERF or SSTEMR and SORMTR. +* On IEEE-754 compliant machines, call SSTERF or SSTEMR and SORMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL SCOPY( N, WORK( INDD ), 1, W, 1 ) - CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) - CALL SSTERF( N, W, WORK( INDEE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL SCOPY( N, WORK( INDD ), 1, W, 1 ) + CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) + CALL SSTERF( N, W, WORK( INDEE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) @@ -602,10 +602,10 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, ELSE TRYRAC = .FALSE. END IF - CALL SSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ), - $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ, - $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK, - $ INFO ) + CALL SSTEMR( JOBZ, RANGE, N, WORK( INDDD ), + $ WORK( INDEE ), VL, VU, IL, IU, M, W, Z, LDZ, + $ N, ISUPPZ, TRYRAC, WORK( INDWK ), LWORK, + $ IWORK, LIWORK, INFO ) * * * @@ -619,16 +619,11 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN -* Everything worked. Skip SSTEBZ/SSTEIN. IWORK(:) are -* undefined. - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN. diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 63f002388..e0117c265 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -89,10 +89,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : SSYEVR_2STAGE calls SSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> SSYEVR_2STAGE calls SSTEBZ and SSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : SSYEVR_2STAGE calls SSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). SSYEVR_2STAGE +*> calls SSTEBZ and SSTEIN on non-ieee machines. *> *> Normal execution of SSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -625,20 +624,21 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDE ), WORK( INDTAU ), WORK( INDHOUS ), $ LHTRD, WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call SSTERF or SSTEMR and SORMTR. +* On IEEE-754 compliant machines, call SSTERF or SSTEMR and SORMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL SCOPY( N, WORK( INDD ), 1, W, 1 ) - CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) - CALL SSTERF( N, W, WORK( INDEE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL SCOPY( N, WORK( INDD ), 1, W, 1 ) + CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) + CALL SSTERF( N, W, WORK( INDEE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) @@ -648,10 +648,10 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, ELSE TRYRAC = .FALSE. END IF - CALL SSTEMR( JOBZ, 'A', N, WORK( INDDD ), WORK( INDEE ), - $ VL, VU, IL, IU, M, W, Z, LDZ, N, ISUPPZ, - $ TRYRAC, WORK( INDWK ), LWORK, IWORK, LIWORK, - $ INFO ) + CALL SSTEMR( JOBZ, RANGE, N, WORK( INDDD ), + $ WORK( INDEE ), VL, VU, IL, IU, M, W, Z, LDZ, + $ N, ISUPPZ, TRYRAC, WORK( INDWK ), LWORK, + $ IWORK, LIWORK, INFO ) * * * @@ -665,16 +665,11 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN -* Everything worked. Skip SSTEBZ/SSTEIN. IWORK(:) are -* undefined. - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN. diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 038738ec8..36e433cc8 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -93,10 +93,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : ZHEEVR calls ZSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : ZHEEVR calls ZSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). ZHEEVR +*> calls DSTEBZ and ZSTEIN on non-ieee machines. *> *> Normal execution of ZSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -617,20 +616,22 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL ZHETRD( UPLO, N, A, LDA, RWORK( INDRD ), RWORK( INDRE ), $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call DSTERF or ZSTEMR and ZUNMTR. +* On IEEE-754 compliant machines, call DSTERF or ZSTEMR and ZUNMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 ) - CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) - CALL DSTERF( N, W, RWORK( INDREE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 ) + CALL DCOPY( N-1, RWORK( INDRE ), 1, + $ RWORK( INDREE ), 1 ) + CALL DSTERF( N, W, RWORK( INDREE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL DCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) @@ -640,7 +641,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, ELSE TRYRAC = .FALSE. END IF - CALL ZSTEMR( JOBZ, 'A', N, RWORK( INDRDD ), + CALL ZSTEMR( JOBZ, RANGE, N, RWORK( INDRDD ), $ RWORK( INDREE ), VL, VU, IL, IU, M, W, $ Z, LDZ, N, ISUPPZ, TRYRAC, $ RWORK( INDRWK ), LLRWORK, @@ -656,14 +657,11 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN. diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index 0ba5a2953..4ac804dfa 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -92,10 +92,9 @@ *> UC Berkeley, May 1997. *> *> -*> Note 1 : ZHEEVR_2STAGE calls ZSTEMR when the full spectrum is requested -*> on machines which conform to the ieee-754 floating point standard. -*> ZHEEVR_2STAGE calls DSTEBZ and ZSTEIN on non-ieee machines and -*> when partial spectrum requests are made. +*> Note 1 : ZHEEVR_2STAGE calls ZSTEMR when possible (i.e., on machines +*> which conform to the ieee-754 floating point standard). ZHEEVR_2STAGE +*> calls DSTEBZ and ZSTEIN on non-ieee machines. *> *> Normal execution of ZSTEMR may create NaNs and infinities and *> hence may abort due to a floating point exception in environments @@ -662,20 +661,22 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDHOUS ), LHTRD, $ WORK( INDWK ), LLWORK, IINFO ) * -* If all eigenvalues are desired -* then call DSTERF or ZSTEMR and ZUNMTR. +* On IEEE-754 compliant machines, call DSTERF or ZSTEMR and ZUNMTR. * - TEST = .FALSE. - IF( INDEIG ) THEN - IF( IL.EQ.1 .AND. IU.EQ.N ) THEN - TEST = .TRUE. - END IF - END IF - IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN + IF( IEEEOK.EQ.1 ) THEN IF( .NOT.WANTZ ) THEN - CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 ) - CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) - CALL DSTERF( N, W, RWORK( INDREE ), INFO ) + IF( ALLEIG .OR. ( INDEIG .AND. IL.EQ.1 .AND. IU.EQ.N ) ) + $ THEN + CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 ) + CALL DCOPY( N-1, RWORK( INDRE ), 1, + $ RWORK( INDREE ), 1 ) + CALL DSTERF( N, W, RWORK( INDREE ), INFO ) + IF( INFO.EQ.0 ) THEN + M = N + GO TO 30 + END IF + INFO = 0 + END IF ELSE CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL DCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) @@ -685,7 +686,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, ELSE TRYRAC = .FALSE. END IF - CALL ZSTEMR( JOBZ, 'A', N, RWORK( INDRDD ), + CALL ZSTEMR( JOBZ, RANGE, N, RWORK( INDRDD ), $ RWORK( INDREE ), VL, VU, IL, IU, M, W, $ Z, LDZ, N, ISUPPZ, TRYRAC, $ RWORK( INDRWK ), LLRWORK, @@ -701,14 +702,11 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ), $ LLWRKN, IINFO ) END IF + IF( INFO.EQ.0 ) THEN + GO TO 30 + END IF + INFO = 0 END IF -* -* - IF( INFO.EQ.0 ) THEN - M = N - GO TO 30 - END IF - INFO = 0 END IF * * Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN.