Skip to content

BLAS and LAPACK Subroutines of Real Skew-symmetric Matrix #1049

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 25 commits into
base: master
Choose a base branch
from
Open

BLAS and LAPACK Subroutines of Real Skew-symmetric Matrix #1049

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
25 commits
Select commit Hold shift + click to select a range
f46d51b
Add algorithms of skew-symmetric matrix
sh-zheng Aug 20, 2024
39d70a4
Add testcases for skew-symmetric algorithm
sh-zheng Aug 20, 2024
c17ac0a
Add cblas and lapacke interfaces for skew-symmetric subroutines
sh-zheng Aug 21, 2024
f9096df
Add cblas testcases for skew-symmetric subroutines
sh-zheng Aug 22, 2024
08a4705
Use blas subroutines to perform transformation in *kyeqr
sh-zheng Sep 3, 2024
63b8293
Update CMakelists
sh-zheng Sep 3, 2024
3275c32
Fix fortran text overflow in *kteqr
sh-zheng Sep 4, 2024
ace1953
Add missing subroutine parameter checks for linear solver
sh-zheng Sep 5, 2024
58ce56e
Fix a typo and resolve a conflict in BLAS/TESTING
sh-zheng Feb 8, 2025
ae2ea5d
Merge branch 'master' into skew-symmetric-new
sh-zheng Feb 9, 2025
b9b2875
Keep consistency with pr 1101
sh-zheng Feb 10, 2025
6731c0f
Delete unnecessary work buffer usage of *ktev and *kteqr in lapacke
sh-zheng Apr 10, 2025
b15a164
Remove redundant *lagky in TESTING/
sh-zheng May 7, 2025
2bb3d99
Merge branch 'master' into skew-symmetric-new
sh-zheng Jun 15, 2025
020cd26
Call *lasr to update eigenvector instead of *rot
sh-zheng Jul 3, 2025
fcbee19
Fix compiler error of column limit
sh-zheng Jul 4, 2025
eb160c9
Fix compiler error of column limit, supplementary submission
sh-zheng Jul 6, 2025
38f90b3
Update contributors information, and doxygen doc
sh-zheng Jul 6, 2025
30042e4
Merge branch 'Reference-LAPACK:master' into skew-symmetric-new
sh-zheng Aug 1, 2025
98d9c6a
implicit none of skew-symmetric subroutines, keep consistency with pr…
sh-zheng Sep 1, 2025
eec055e
Merge branch 'Reference-LAPACK:master' into skew-symmetric-new
sh-zheng Sep 1, 2025
ec0c276
End with newline in BLAS/TESTING
sh-zheng Sep 4, 2025
c9a448b
Add expert driver subroutines *kysvx, *kycon and *kyrfs
sh-zheng Oct 11, 2025
ff8bcde
Update doc and comment
sh-zheng Oct 12, 2025
9261f0f
Fix potential distrub of diagonal elements
sh-zheng Oct 26, 2025
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
Prev Previous commit
Next Next commit
Use blas subroutines to perform transformation in *kyeqr
  • Loading branch information
@sh-zheng
sh-zheng committed Sep 3, 2024
commit 08a4705e10e26e4cea03fd89403b08fcc327ac70
76 changes: 22 additions & 54 deletions SRC/dkteqr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* ..
* .. Local Scalars ..
INTEGER I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
$ LENDM1, LENDP1, LENDSV, LM3, LSV, M, MM, MM1,
$ LENDM1, LENDP1, LENDSV, LM3, LSV, M, MM1,
$ NM1, NMAXIT
DOUBLE PRECISION ANORM, B, EPS, EPS2, P, R, VA, VB, E3,
$ S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST, TEMP
Expand All @@ -165,7 +165,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* ..
* .. External Subroutines ..
EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASET,
$ DLASRT, DSWAP, XERBLA
$ DLASRT, DSWAP, DSCAL, DROT, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SIGN, SQRT
Expand Down Expand Up @@ -386,11 +386,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M-2 )
Z( J, M-2 ) = VB*TEMP - VA*Z( J, M-2 )
END DO
CALL DROT(N, Z(1, M), 1, Z(1, M-2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, M-2), 1)
END IF
*
I = L + 1
Expand All @@ -403,9 +400,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL DSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 40
Expand Down Expand Up @@ -441,11 +436,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M-2 )
Z( J, M-2 ) = VB*TEMP - VA*Z( J, M-2 )
END DO
CALL DROT(N, Z(1, M), 1, Z(1, M-2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, M-2), 1)
END IF
*
* Inner loop
Expand Down Expand Up @@ -479,11 +471,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I-2 )
Z( J, I-2 ) = VB*TEMP - VA*Z( J, I-2 )
END DO
CALL DROT(N, Z(1, I), 1, Z(1, I-2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, I-2), 1)
END IF
*
70 CONTINUE
Expand Down Expand Up @@ -514,11 +503,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I-2 )
Z( J, I-2 ) = VB*TEMP - VA*Z( J, I-2 )
END DO
CALL DROT(N, Z(1, I), 1, Z(1, I-2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, I-2), 1)
END IF
*
I = L + 1
Expand All @@ -531,9 +517,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL DSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 40
Expand Down Expand Up @@ -623,11 +607,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M+2 )
Z( J, M+2 ) = VB*TEMP - VA*Z( J, M+2 )
END DO
CALL DROT(N, Z(1, M), 1, Z(1, M+2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, M+2), 1)
END IF
*
I = L - 1
Expand All @@ -640,9 +621,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL DSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 90
Expand Down Expand Up @@ -678,11 +657,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M+2 )
Z( J, M+2 ) = VB*TEMP - VA*Z( J, M+2 )
END DO
CALL DROT(N, Z(1, M), 1, Z(1, M+2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, M+2), 1)
END IF
*
* Inner loop
Expand Down Expand Up @@ -716,11 +692,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I+2 )
Z( J, I+2 ) = VB*TEMP - VA*Z( J, I+2 )
END DO
CALL DROT(N, Z(1, I), 1, Z(1, I+2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, I+2), 1)
END IF
*
120 CONTINUE
Expand Down Expand Up @@ -751,11 +724,8 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I+2 )
Z( J, I+2 ) = VB*TEMP - VA*Z( J, I+2 )
END DO
CALL DROT(N, Z(1, I), 1, Z(1, I+2), 1, VA, VB)
CALL DSCAL(N, -ONE, Z(1, I+2), 1)
END IF
*
I = L - 1
Expand All @@ -768,9 +738,7 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL DSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 90
Expand Down
4 changes: 2 additions & 2 deletions SRC/dkyev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,8 +104,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,3*N-1).
*> For optimal efficiency, LWORK >= (NB+2)*N,
*> The length of the array WORK. LWORK >= max(1,2*N-1).
*> For optimal efficiency, LWORK >= (NB+1)*N,
*> where NB is the blocksize for DKYTRD returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
Expand Down
76 changes: 22 additions & 54 deletions SRC/skteqr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* ..
* .. Local Scalars ..
INTEGER I, ICOMPZ, II, ISCALE, J, JTOT, K, L, L1, LEND,
$ LENDM1, LENDP1, LENDSV, LM3, LSV, M, MM, MM1,
$ LENDM1, LENDP1, LENDSV, LM3, LSV, M, MM1,
$ NM1, NMAXIT
REAL ANORM, B, EPS, EPS2, P, R, VA, VB, E3,
$ S, SAFMAX, SAFMIN, SSFMAX, SSFMIN, TST, TEMP
Expand All @@ -165,7 +165,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* ..
* .. External Subroutines ..
EXTERNAL SLAE2, SLAEV2, SLARTG, SLASCL, SLASET,
$ SLASRT, SSWAP, XERBLA
$ SLASRT, SSWAP, SSCAL, SROT, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SIGN, SQRT
Expand Down Expand Up @@ -386,11 +386,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M-2 )
Z( J, M-2 ) = VB*TEMP - VA*Z( J, M-2 )
END DO
CALL SROT(N, Z(1, M), 1, Z(1, M-2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, M-2), 1)
END IF
*
I = L + 1
Expand All @@ -403,9 +400,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL SSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 40
Expand Down Expand Up @@ -441,11 +436,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M-2 )
Z( J, M-2 ) = VB*TEMP - VA*Z( J, M-2 )
END DO
CALL SROT(N, Z(1, M), 1, Z(1, M-2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, M-2), 1)
END IF
*
* Inner loop
Expand Down Expand Up @@ -479,11 +471,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I-2 )
Z( J, I-2 ) = VB*TEMP - VA*Z( J, I-2 )
END DO
CALL SROT(N, Z(1, I), 1, Z(1, I-2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, I-2), 1)
END IF
*
70 CONTINUE
Expand Down Expand Up @@ -514,11 +503,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I-2 )
Z( J, I-2 ) = VB*TEMP - VA*Z( J, I-2 )
END DO
CALL SROT(N, Z(1, I), 1, Z(1, I-2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, I-2), 1)
END IF
*
I = L + 1
Expand All @@ -531,9 +517,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL SSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 40
Expand Down Expand Up @@ -623,11 +607,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M+2 )
Z( J, M+2 ) = VB*TEMP - VA*Z( J, M+2 )
END DO
CALL SROT(N, Z(1, M), 1, Z(1, M+2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, M+2), 1)
END IF
*
I = L - 1
Expand All @@ -640,9 +621,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL SSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 90
Expand Down Expand Up @@ -678,11 +657,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z initially.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, M )
Z( J, M ) = VA*Z( J, M ) + VB*Z( J, M+2 )
Z( J, M+2 ) = VB*TEMP - VA*Z( J, M+2 )
END DO
CALL SROT(N, Z(1, M), 1, Z(1, M+2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, M+2), 1)
END IF
*
* Inner loop
Expand Down Expand Up @@ -716,11 +692,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I+2 )
Z( J, I+2 ) = VB*TEMP - VA*Z( J, I+2 )
END DO
CALL SROT(N, Z(1, I), 1, Z(1, I+2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, I+2), 1)
END IF
*
120 CONTINUE
Expand Down Expand Up @@ -751,11 +724,8 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
TEMP = Z( J, I )
Z( J, I ) = VA*Z( J, I ) + VB*Z( J, I+2 )
Z( J, I+2 ) = VB*TEMP - VA*Z( J, I+2 )
END DO
CALL SROT(N, Z(1, I), 1, Z(1, I+2), 1, VA, VB)
CALL SSCAL(N, -ONE, Z(1, I+2), 1)
END IF
*
I = L - 1
Expand All @@ -768,9 +738,7 @@ SUBROUTINE SKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
* If eigenvectors are desired, then update Z.
*
IF( ICOMPZ.GT.0 ) THEN
DO J = 1, N
Z( J, I ) = -Z( J, I )
END DO
CALL SSCAL(N, -ONE, Z(1, I), 1)
END IF
*
GO TO 90
Expand Down
4 changes: 2 additions & 2 deletions SRC/skyev.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,8 +104,8 @@
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The length of the array WORK. LWORK >= max(1,3*N-1).
*> For optimal efficiency, LWORK >= (NB+2)*N,
*> The length of the array WORK. LWORK >= max(1,2*N-1).
*> For optimal efficiency, LWORK >= (NB+1)*N,
*> where NB is the blocksize for SKYTRD returned by ILAENV.
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
Expand Down