Skip to content

Call *rot to perform eigenvector update of *steqr #1120

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
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Call *rot to perform eigenvector update of *steqr #1120

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
17 changes: 1 addition & 16 deletions LAPACKE/src/lapacke_dsteqr.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,23 +59,8 @@ lapack_int API_SUFFIX(LAPACKE_dsteqr)( int matrix_layout, char compz, lapack_int
}
}
#endif
/* Additional scalars initializations for work arrays */
if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) {
lwork = 1;
} else {
lwork = MAX(1,2*n-2);
}
/* Allocate memory for working array(s) */
work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = API_SUFFIX(LAPACKE_dsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
info = API_SUFFIX(LAPACKE_dsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, NULL );
if( info == LAPACK_WORK_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr", info );
}
Expand Down
15 changes: 1 addition & 14 deletions LAPACKE/src/lapacke_dstev.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,21 +52,8 @@ lapack_int API_SUFFIX(LAPACKE_dstev)( int matrix_layout, char jobz, lapack_int n
}
}
#endif
/* Allocate memory for working array(s) */
if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n-2) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
/* Call middle-level interface */
info = API_SUFFIX(LAPACKE_dstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work );
/* Release memory and exit */
if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
LAPACKE_free( work );
}
exit_level_0:
info = API_SUFFIX(LAPACKE_dstev_work)( matrix_layout, jobz, n, d, e, z, ldz, NULL );
if( info == LAPACK_WORK_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev", info );
}
Expand Down
17 changes: 1 addition & 16 deletions LAPACKE/src/lapacke_ssteqr.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,23 +59,8 @@ lapack_int API_SUFFIX(LAPACKE_ssteqr)( int matrix_layout, char compz, lapack_int
}
}
#endif
/* Additional scalars initializations for work arrays */
if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) {
lwork = 1;
} else {
lwork = MAX(1,2*n-2);
}
/* Allocate memory for working array(s) */
work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = API_SUFFIX(LAPACKE_ssteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
info = API_SUFFIX(LAPACKE_ssteqr_work)( matrix_layout, compz, n, d, e, z, ldz, NULL );
if( info == LAPACK_WORK_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr", info );
}
Expand Down
15 changes: 1 addition & 14 deletions LAPACKE/src/lapacke_sstev.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,21 +52,8 @@ lapack_int API_SUFFIX(LAPACKE_sstev)( int matrix_layout, char jobz, lapack_int n
}
}
#endif
/* Allocate memory for working array(s) */
if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n-2) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
/* Call middle-level interface */
info = API_SUFFIX(LAPACKE_sstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work );
/* Release memory and exit */
if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
LAPACKE_free( work );
}
exit_level_0:
info = API_SUFFIX(LAPACKE_sstev_work)( matrix_layout, jobz, n, d, e, z, ldz, NULL );
if( info == LAPACK_WORK_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev", info );
}
Expand Down
40 changes: 7 additions & 33 deletions SRC/dsteqr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,8 +97,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
*> If COMPZ = 'N', then WORK is not referenced.
*> WORK is DOUBLE PRECISION array.
*> WORK is not referenced.
*> \endverbatim
*>
*> \param[out] INFO
Expand Down Expand Up @@ -162,7 +162,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* ..
* .. External Subroutines ..
EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASET,
$ DLASR,
$ DROT,
$ DLASRT, DSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -321,10 +321,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
IF( ICOMPZ.GT.0 ) THEN
CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C,
$ S )
WORK( L ) = C
WORK( N-1+L ) = S
CALL DLASR( 'R', 'V', 'B', N, 2, WORK( L ),
$ WORK( N-1+L ), Z( 1, L ), LDZ )
CALL DROT(N, Z( 1, L ), 1, Z( 1, L+1 ), 1, C, S)
ELSE
CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
END IF
Expand Down Expand Up @@ -369,20 +366,10 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then save rotations.
*
IF( ICOMPZ.GT.0 ) THEN
WORK( I ) = C
WORK( N-1+I ) = -S
CALL DROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, -S)
END IF
*
70 CONTINUE
*
* If eigenvectors are desired, then apply saved rotations.
*
IF( ICOMPZ.GT.0 ) THEN
MM = M - L + 1
CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ),
$ WORK( N-1+L ),
$ Z( 1, L ), LDZ )
END IF
*
D( L ) = D( L ) - P
E( L ) = G
Expand Down Expand Up @@ -430,10 +417,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
IF( ICOMPZ.GT.0 ) THEN
CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C,
$ S )
WORK( M ) = C
WORK( N-1+M ) = S
CALL DLASR( 'R', 'V', 'F', N, 2, WORK( M ),
$ WORK( N-1+M ), Z( 1, L-1 ), LDZ )
CALL DROT(N, Z( 1, L-1 ), 1, Z( 1, L ), 1, C, S)
ELSE
CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
END IF
Expand Down Expand Up @@ -478,20 +462,10 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then save rotations.
*
IF( ICOMPZ.GT.0 ) THEN
WORK( I ) = C
WORK( N-1+I ) = S
CALL DROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, S)
END IF
*
120 CONTINUE
*
* If eigenvectors are desired, then apply saved rotations.
*
IF( ICOMPZ.GT.0 ) THEN
MM = L - M + 1
CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ),
$ WORK( N-1+M ),
$ Z( 1, M ), LDZ )
END IF
*
D( L ) = D( L ) - P
E( LM1 ) = G
Expand Down
4 changes: 2 additions & 2 deletions SRC/dstev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
*> If JOBZ = 'N', WORK is not referenced.
*> WORK is DOUBLE PRECISION array
*> WORK is not referenced.
*> \endverbatim
*>
*> \param[out] INFO
Expand Down
40 changes: 7 additions & 33 deletions SRC/ssteqr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,8 +97,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (max(1,2*N-2))
*> If COMPZ = 'N', then WORK is not referenced.
*> WORK is REAL array.
*> WORK is not referenced.
*> \endverbatim
*>
*> \param[out] INFO
Expand Down Expand Up @@ -162,7 +162,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* ..
* .. External Subroutines ..
EXTERNAL SLAE2, SLAEV2, SLARTG, SLASCL, SLASET,
$ SLASR,
$ SROT,
$ SLASRT, SSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -321,10 +321,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
IF( ICOMPZ.GT.0 ) THEN
CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C,
$ S )
WORK( L ) = C
WORK( N-1+L ) = S
CALL SLASR( 'R', 'V', 'B', N, 2, WORK( L ),
$ WORK( N-1+L ), Z( 1, L ), LDZ )
CALL SROT(N, Z( 1, L ), 1, Z( 1, L+1 ), 1, C, S)
ELSE
CALL SLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
END IF
Expand Down Expand Up @@ -369,20 +366,10 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then save rotations.
*
IF( ICOMPZ.GT.0 ) THEN
WORK( I ) = C
WORK( N-1+I ) = -S
CALL SROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, -S)
END IF
*
70 CONTINUE
*
* If eigenvectors are desired, then apply saved rotations.
*
IF( ICOMPZ.GT.0 ) THEN
MM = M - L + 1
CALL SLASR( 'R', 'V', 'B', N, MM, WORK( L ),
$ WORK( N-1+L ),
$ Z( 1, L ), LDZ )
END IF
*
D( L ) = D( L ) - P
E( L ) = G
Expand Down Expand Up @@ -430,10 +417,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
IF( ICOMPZ.GT.0 ) THEN
CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C,
$ S )
WORK( M ) = C
WORK( N-1+M ) = S
CALL SLASR( 'R', 'V', 'F', N, 2, WORK( M ),
$ WORK( N-1+M ), Z( 1, L-1 ), LDZ )
CALL SROT(N, Z( 1, L-1 ), 1, Z( 1, L ), 1, C, S)
ELSE
CALL SLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
END IF
Expand Down Expand Up @@ -478,20 +462,10 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then save rotations.
*
IF( ICOMPZ.GT.0 ) THEN
WORK( I ) = C
WORK( N-1+I ) = S
CALL SROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, S)
END IF
*
120 CONTINUE
*
* If eigenvectors are desired, then apply saved rotations.
*
IF( ICOMPZ.GT.0 ) THEN
MM = L - M + 1
CALL SLASR( 'R', 'V', 'F', N, MM, WORK( M ),
$ WORK( N-1+M ),
$ Z( 1, M ), LDZ )
END IF
*
D( L ) = D( L ) - P
E( LM1 ) = G
Expand Down
4 changes: 2 additions & 2 deletions SRC/sstev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,8 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is REAL array, dimension (max(1,2*N-2))
*> If JOBZ = 'N', WORK is not referenced.
*> WORK is REAL array.
*> WORK is not referenced.
*> \endverbatim
*>
*> \param[out] INFO
Expand Down