Skip to content
Open
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
Fix compiler error of column limit
  • Loading branch information
sh-zheng committed Jul 4, 2025
commit fcbee19403e840483e6c762d71b35a7e78b0d32b
8 changes: 4 additions & 4 deletions SRC/dkteqr.f
Original file line number Diff line number Diff line change
Expand Up @@ -777,11 +777,11 @@ SUBROUTINE DKTEQR( COMPZ, N, E, Z, LDZ, WORK, INFO )
*
140 CONTINUE
IF( ISCALE.EQ.1 ) THEN
CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E(LSV),
$ N, INFO )
CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1,
$ E(LSV), N, INFO )
ELSE IF( ISCALE.EQ.2 ) THEN
CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E(LSV),
$ N, INFO )
CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1,
$ E(LSV), N, INFO )
END IF
*
* Check for no convergence to an eigenvalue after a total
Expand Down
4 changes: 2 additions & 2 deletions SRC/dkyev.f
Original file line number Diff line number Diff line change
Expand Up @@ -257,8 +257,8 @@ SUBROUTINE DKYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
* DORGTR to generate the orthogonal matrix, then call DKTEQR.
*
IF( WANTZ ) THEN
CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
$ LLWORK, IINFO )
CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ),
$ WORK( INDWRK ), LLWORK, IINFO )
END IF
IF(.NOT.LOWER)
$ CALL DSCAL(N-1, -ONE, W, 1)
Expand Down
12 changes: 6 additions & 6 deletions SRC/dkygs2.f
Original file line number Diff line number Diff line change
Expand Up @@ -227,8 +227,8 @@ SUBROUTINE DKYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
BKK = B( K, K )
CALL DTRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
$ LDB, A( 1, K ), 1 )
CALL DKYR2( UPLO, K-1, -ONE, A( 1, K ), 1, B( 1, K ), 1,
$ A, LDA )
CALL DKYR2( UPLO, K-1, -ONE, A( 1, K ), 1, B( 1, K ),
$ 1, A, LDA )
CALL DSCAL( K-1, BKK, A( 1, K ), 1 )
30 CONTINUE
ELSE
Expand All @@ -240,10 +240,10 @@ SUBROUTINE DKYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
* Update the lower triangle of A(1:k,1:k)
*
BKK = B( K, K )
CALL DTRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, LDB,
$ A( K, 1 ), LDA )
CALL DKYR2( UPLO, K-1, ONE, A( K, 1 ), LDA, B( K, 1 ),
$ LDB, A, LDA )
CALL DTRMV( UPLO, 'Transpose', 'Non-unit', K-1, B,
$ LDB, A( K, 1 ), LDA )
CALL DKYR2( UPLO, K-1, ONE, A( K, 1 ), LDA,
$ B( K, 1 ), LDB, A, LDA )
CALL DSCAL( K-1, BKK, A( K, 1 ), LDA )
40 CONTINUE
END IF
Expand Down
91 changes: 50 additions & 41 deletions SRC/dkygst.f
Original file line number Diff line number Diff line change
Expand Up @@ -210,18 +210,19 @@ SUBROUTINE DKYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
CALL DKYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
$ B( K, K ), LDB, INFO )
IF( K+KB.LE.N ) THEN
CALL DTRSM( 'Left', UPLO, 'Transpose', 'Non-unit',
$ KB, N-K-KB+1, ONE, B( K, K ), LDB,
$ A( K, K+KB ), LDA )
CALL DTRSM( 'Left', UPLO, 'Transpose',
$ 'Non-unit', KB, N-K-KB+1, ONE,
$ B( K, K ), LDB, A( K, K+KB ), LDA )
CALL DKYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
$ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
$ A( K, K+KB ), LDA )
CALL DKYR2K( UPLO, 'Transpose', N-K-KB+1, KB, -ONE,
$ A( K, K+KB ), LDA, B( K, K+KB ), LDB,
$ ONE, A( K+KB, K+KB ), LDA )
$ A( K, K ), LDA, B( K, K+KB ), LDB,
$ ONE, A( K, K+KB ), LDA )
CALL DKYR2K( UPLO, 'Transpose', N-K-KB+1, KB,
$ -ONE, A( K, K+KB ), LDA,
$ B( K, K+KB ), LDB, ONE,
$ A( K+KB, K+KB ), LDA )
CALL DKYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF,
$ A( K, K ), LDA, B( K, K+KB ), LDB, ONE,
$ A( K, K+KB ), LDA )
$ A( K, K ), LDA, B( K, K+KB ), LDB,
$ ONE, A( K, K+KB ), LDA )
CALL DTRSM( 'Right', UPLO, 'No transpose',
$ 'Non-unit', KB, N-K-KB+1, ONE,
$ B( K+KB, K+KB ), LDB, A( K, K+KB ),
Expand All @@ -240,18 +241,19 @@ SUBROUTINE DKYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
CALL DKYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
$ B( K, K ), LDB, INFO )
IF( K+KB.LE.N ) THEN
CALL DTRSM( 'Right', UPLO, 'Transpose', 'Non-unit',
$ N-K-KB+1, KB, ONE, B( K, K ), LDB,
$ A( K+KB, K ), LDA )
CALL DTRSM( 'Right', UPLO, 'Transpose',
$ 'Non-unit', N-K-KB+1, KB, ONE,
$ B( K, K ), LDB, A( K+KB, K ), LDA )
CALL DKYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
$ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
$ A( K+KB, K ), LDA )
CALL DKYR2K( UPLO, 'No transpose', N-K-KB+1, KB,
$ ONE, A( K+KB, K ), LDA, B( K+KB, K ),
$ LDB, ONE, A( K+KB, K+KB ), LDA )
$ A( K, K ), LDA, B( K+KB, K ), LDB,
$ ONE, A( K+KB, K ), LDA )
CALL DKYR2K( UPLO, 'No transpose', N-K-KB+1,
$ KB, ONE, A( K+KB, K ), LDA,
$ B( K+KB, K ), LDB, ONE,
$ A( K+KB, K+KB ), LDA )
CALL DKYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF,
$ A( K, K ), LDA, B( K+KB, K ), LDB, ONE,
$ A( K+KB, K ), LDA )
$ A( K, K ), LDA, B( K+KB, K ), LDB,
$ ONE, A( K+KB, K ), LDA )
CALL DTRSM( 'Left', UPLO, 'No transpose',
$ 'Non-unit', N-K-KB+1, KB, ONE,
$ B( K+KB, K+KB ), LDB, A( K+KB, K ),
Expand All @@ -269,18 +271,21 @@ SUBROUTINE DKYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
*
* Update the upper triangle of A(1:k+kb-1,1:k+kb-1)
*
CALL DTRMM( 'Left', UPLO, 'No transpose', 'Non-unit',
$ K-1, KB, ONE, B, LDB, A( 1, K ), LDA )
CALL DKYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
$ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
CALL DTRMM( 'Left', UPLO, 'No transpose',
$ 'Non-unit', K-1, KB, ONE, B, LDB,
$ A( 1, K ), LDA )
CALL DKYMM( 'Right', UPLO, K-1, KB, HALF,
$ A( K, K ), LDA, B( 1, K ), LDB, ONE,
$ A( 1, K ), LDA )
CALL DKYR2K( UPLO, 'No transpose', K-1, KB, -ONE,
$ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A,
$ LDA )
CALL DKYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ),
$ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA )
CALL DTRMM( 'Right', UPLO, 'Transpose', 'Non-unit',
$ K-1, KB, ONE, B( K, K ), LDB, A( 1, K ),
$ LDA )
$ A( 1, K ), LDA, B( 1, K ), LDB, ONE,
$ A, LDA )
CALL DKYMM( 'Right', UPLO, K-1, KB, HALF,
$ A( K, K ), LDA, B( 1, K ), LDB, ONE,
$ A( 1, K ), LDA )
CALL DTRMM( 'Right', UPLO, 'Transpose',
$ 'Non-unit', K-1, KB, ONE, B( K, K ),
$ LDB, A( 1, K ), LDA )
CALL DKYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
$ B( K, K ), LDB, INFO )
30 CONTINUE
Expand All @@ -293,17 +298,21 @@ SUBROUTINE DKYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
*
* Update the lower triangle of A(1:k+kb-1,1:k+kb-1)
*
CALL DTRMM( 'Right', UPLO, 'No transpose', 'Non-unit',
$ KB, K-1, ONE, B, LDB, A( K, 1 ), LDA )
CALL DKYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
$ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
CALL DTRMM( 'Right', UPLO, 'No transpose',
$ 'Non-unit', KB, K-1, ONE, B, LDB,
$ A( K, 1 ), LDA )
CALL DKYMM( 'Left', UPLO, KB, K-1, HALF,
$ A( K, K ), LDA, B( K, 1 ), LDB, ONE,
$ A( K, 1 ), LDA )
CALL DKYR2K( UPLO, 'Transpose', K-1, KB, ONE,
$ A( K, 1 ), LDA, B( K, 1 ), LDB, ONE, A,
$ LDA )
CALL DKYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ),
$ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA )
CALL DTRMM( 'Left', UPLO, 'Transpose', 'Non-unit', KB,
$ K-1, ONE, B( K, K ), LDB, A( K, 1 ), LDA )
$ A( K, 1 ), LDA, B( K, 1 ), LDB, ONE,
$ A, LDA )
CALL DKYMM( 'Left', UPLO, KB, K-1, HALF,
$ A( K, K ), LDA, B( K, 1 ), LDB, ONE,
$ A( K, 1 ), LDA )
CALL DTRMM( 'Left', UPLO, 'Transpose',
$ 'Non-unit', KB, K-1, ONE, B( K, K ),
$ LDB, A( K, 1 ), LDA )
CALL DKYGS2( ITYPE, UPLO, KB, A( K, K ), LDA,
$ B( K, K ), LDB, INFO )
40 CONTINUE
Expand Down
2 changes: 1 addition & 1 deletion SRC/dkytf2.f
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,7 @@ SUBROUTINE DKYTF2( UPLO, N, A, LDA, IPIV, INFO )
* ..
* .. Local Scalars ..
LOGICAL UPPER
INTEGER I, IMAX1, IMAX2, J,KSTEP
INTEGER I, IMAX1, IMAX2, J, K, KP, KSTEP
DOUBLE PRECISION ABSAKP1K, COLMAX1, COLMAX2,
$ D21, T, WK, WKM1, WKP1
* ..
Expand Down
8 changes: 4 additions & 4 deletions SRC/dkytri2x.f
Original file line number Diff line number Diff line change
Expand Up @@ -511,16 +511,16 @@ SUBROUTINE DKYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
DO WHILE ( I .GT. 1 )
IF( IPIV(I-1) .GT. 0 ) THEN
IP=IPIV(I-1)
IF ( I .LT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, I ,
IF ( I .LT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, I,
$ IP )
IF ( I .GT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, IP ,
IF ( I .GT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, IP,
$ I )
I=I-1
ELSEIF( IPIV(I-1) .LT. 0 ) THEN
IP=-IPIV(I-1)
IF ( I .LT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, I ,
IF ( I .LT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, I,
$ IP )
IF ( I .GT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, IP ,
IF ( I .GT. IP) CALL DKYSWAPR( UPLO, N, A, LDA, IP,
$ I )
CALL DKYSWAPR( UPLO, N, A, LDA, I-1 ,I )
I=I-1
Expand Down
45 changes: 24 additions & 21 deletions SRC/dkytrs.f
Original file line number Diff line number Diff line change
Expand Up @@ -206,8 +206,8 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* Multiply by inv(U(K)), where U(K) is the transformation
* stored in columns K-1 and K of A.
*
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
$ B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
$ LDB, B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
$ LDB, B( 1, 1 ), LDB )
*
Expand All @@ -233,8 +233,8 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* Multiply by inv(U(K)), where U(K) is the transformation
* stored in columns K-1 and K of A.
*
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
$ B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
$ LDB, B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
$ LDB, B( 1, 1 ), LDB )
*
Expand All @@ -252,8 +252,8 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* Multiply by inv(U(K)), where U(K) is the transformation
* stored in columns K-1 and K of A.
*
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
$ B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
$ LDB, B( 1, 1 ), LDB )
CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
$ LDB, B( 1, 1 ), LDB )
*
Expand Down Expand Up @@ -460,11 +460,12 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* stored in columns K-1 and K of A.
*
IF( K.LT.N ) THEN
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
$ LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K ),
$ 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K-1 ), 1,
$ ONE, B( K-1, 1 ), LDB )
END IF
*
* Interchange rows K and IPIV(K).
Expand All @@ -482,11 +483,12 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* stored in columns K-1 and K of A.
*
IF( K.LT.N ) THEN
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
$ LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K ),
$ 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K-1 ), 1,
$ ONE, B( K-1, 1 ), LDB )
END IF
*
* Interchange rows K and -IPIV(K), then K and K-1.
Expand All @@ -505,11 +507,12 @@ SUBROUTINE DKYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
* stored in columns K-1 and K of A.
*
IF( K.LT.N ) THEN
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K ), 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE, B( K+1, 1 ),
$ LDB, A( K+1, K-1 ), 1, ONE, B( K-1, 1 ),
$ LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K ),
$ 1, ONE, B( K, 1 ), LDB )
CALL DGEMV( 'Transpose', N-K, NRHS, -ONE,
$ B( K+1, 1 ), LDB, A( K+1, K-1 ), 1,
$ ONE, B( K-1, 1 ), LDB )
END IF
K = K - 2
END IF
Expand Down
11 changes: 6 additions & 5 deletions SRC/dlakyf.f
Original file line number Diff line number Diff line change
Expand Up @@ -435,8 +435,8 @@ SUBROUTINE DLAKYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
* Interchange rows K and K-1, then K-1 and IMAX2 in last K+1 columns of A
*
IF( K.LT.N ) THEN
CALL DSWAP( N-K, A( K, K+1 ), LDA, A( K-1, K+1 ),
$ LDA )
CALL DSWAP( N-K, A( K, K+1 ), LDA,
$ A( K-1, K+1 ), LDA )

CALL DSWAP( N-K, A( K-1, K+1 ), LDA,
$ A( IMAX2, K+1 ), LDA )
Expand Down Expand Up @@ -795,9 +795,10 @@ SUBROUTINE DLAKYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
* Update the rectangular subdiagonal block
*
IF( J+JB.LE.N )
$ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
$ K-1, ONE, A( J+JB, 1 ), LDA, W( J, 1 ),
$ LDW, ONE, A( J+JB, J ), LDA )
$ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1,
$ JB, K-1, ONE, A( J+JB, 1 ), LDA,
$ W( J, 1 ), LDW, ONE, A( J+JB, J ),
$ LDA )
110 CONTINUE
*
* Put L21 in standard form by partially undoing the interchanges
Expand Down
Loading