Skip to content

*evr, *stevr: use fast CSTEMR path for partial eigenvalue ranges on I… #1295

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
jschueller wants to merge 1 commit into
base: master
Choose a base branch
from
Open

*evr, *stevr: use fast CSTEMR path for partial eigenvalue ranges on I… #1295

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 22 additions & 24 deletions SRC/cheevr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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,
Expand All @@ -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.
Expand Down
46 changes: 22 additions & 24 deletions SRC/cheevr_2stage.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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,
Expand All @@ -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.
Expand Down
44 changes: 22 additions & 22 deletions SRC/dstevr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
48 changes: 24 additions & 24 deletions SRC/dsyevr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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 )
*
*
*
Expand All @@ -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.
Expand Down
48 changes: 24 additions & 24 deletions SRC/dsyevr_2stage.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 )
Expand All @@ -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 )
*
*
*
Expand All @@ -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.
Expand Down
Loading
Loading