Skip to content

Copy updated zero-pivot columns back in xLASYF and xLAHEF #1433

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

Merged
ACSimon33 merged 2 commits into from
Oct 4, 2026
Merged

Copy updated zero-pivot columns back in xLASYF and xLAHEF #1433

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
993978c
Fix zero-pivot columns in blocked symmetric factorizations
rioyu123 Oct 3, 2026
5b14af5
Remove redundant real-diagonal assignments after panel copies
rioyu123 Oct 4, 2026
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
4 changes: 2 additions & 2 deletions SRC/clahef.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -286,7 +286,7 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
A( K, K ) = REAL( A( K, K ) )
CALL CCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
*
* ============================================================
Expand Down Expand Up @@ -637,7 +637,7 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
A( K, K ) = REAL( A( K, K ) )
CALL CCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
*
* ============================================================
Expand Down
2 changes: 2 additions & 0 deletions SRC/clasyf.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -281,6 +281,7 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL CCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down Expand Up @@ -562,6 +563,7 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL CCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down
2 changes: 2 additions & 0 deletions SRC/dlasyf.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,6 +272,7 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL DCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down Expand Up @@ -554,6 +555,7 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL DCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down
2 changes: 2 additions & 0 deletions SRC/slasyf.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,6 +272,7 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL SCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down Expand Up @@ -554,6 +555,7 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL SCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zlahef.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -285,7 +285,7 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
A( K, K ) = DBLE( A( K, K ) )
CALL ZCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
*
* ============================================================
Expand Down Expand Up @@ -636,7 +636,7 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
A( K, K ) = DBLE( A( K, K ) )
CALL ZCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
*
* ============================================================
Expand Down
2 changes: 2 additions & 0 deletions SRC/zlasyf.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -280,6 +280,7 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL ZCOPY( K, W( 1, KW ), 1, A( 1, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down Expand Up @@ -560,6 +561,7 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
IF( INFO.EQ.0 )
$ INFO = K
KP = K
CALL ZCOPY( N-K+1, W( K, K ), 1, A( K, K ), 1 )
ELSE
IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
*
Expand Down
64 changes: 64 additions & 0 deletions TESTING/LIN/cchkhe.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -663,10 +663,74 @@ SUBROUTINE CCHKHE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 CONTINUE
180 CONTINUE
*
*
* Check an exact zero pivot created by updating a rank-one block
* when the singular matrix tests are requested.
* Unlike a row that is zero on input, its original diagonal must
* be replaced by the updated zero before returning the factors.
*
IF( .NOT.DOTYPE( 3 ) ) GO TO 260
DO 250 IN = 1, NN
N = NVAL( IN )
IF( N.LT.3 ) GO TO 250
LDA = N
DO 240 IUPLO = 1, 2
UPLO = UPLOS( IUPLO )
I1 = 1
IF( IUPLO.EQ.1 ) I1 = N - 1
I2 = I1 + 1
IZERO = I2
IF( IUPLO.EQ.1 ) IZERO = I1
DO 230 MODE = 1, 2
DO 200 J = 1, N
DO 190 I = 1, N
A( I+( J-1 )*LDA ) = ZERO
190 CONTINUE
A( J+( J-1 )*LDA ) = 1.0E+0
200 CONTINUE
A( I1+( I1-1 )*LDA ) = 0.0625E+0
A( I2+( I2-1 )*LDA ) = 0.0625E+0
A( I1+( I2-1 )*LDA ) = 0.0625E+0
A( I2+( I1-1 )*LDA ) = 0.0625E+0
IF( MODE.EQ.2 ) THEN
A( I1+( I2-1 )*LDA ) = ( 0.0E+0, 0.0625E+0 )
A( I2+( I1-1 )*LDA ) = -
$ A( I1+( I2-1 )*LDA )
END IF
DO 220 INB = 1, NNB
NB = NBVAL( INB )
CALL XLAENV( 1, NB )
CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
LWORK = MAX( 2, NB )*LDA
SRNAMT = 'CHETRF'
CALL CHETRF( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
IF( INFO.NE.IZERO )
$ CALL ALAERH( PATH, 'CHETRF', INFO, IZERO,
$ UPLO, N, N, -1, -1, NB, 3, NFAIL,
$ NERRS, NOUT )
CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
$ AINV, LDA, RWORK, RESULT( 1 ) )
IF( RESULT( 1 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )UPLO, N, NB, MODE,
$ RESULT( 1 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 1
220 CONTINUE
230 CONTINUE
240 CONTINUE
250 CONTINUE
260 CONTINUE
*
* Print a summary of the results.
*
CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
*
9996 FORMAT( ' Zero pivot: UPLO = ''', A1, ''', N =', I5,
$ ', NB =', I4, ', mode =', I2, ', ratio =', G12.5 )
9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
$ I2, ', test ', I2, ', ratio =', G12.5 )
9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
Expand Down
65 changes: 65 additions & 0 deletions TESTING/LIN/cchksy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -670,10 +670,75 @@ SUBROUTINE CCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 CONTINUE
180 CONTINUE
*
*
* Check an exact zero pivot created by updating a rank-one block
* when the singular matrix tests are requested.
* Unlike a row that is zero on input, its original diagonal must
* be replaced by the updated zero before returning the factors.
*
IF( .NOT.DOTYPE( 3 ) ) GO TO 260
DO 250 IN = 1, NN
N = NVAL( IN )
IF( N.LT.3 ) GO TO 250
LDA = N
DO 240 IUPLO = 1, 2
UPLO = UPLOS( IUPLO )
I1 = 1
IF( IUPLO.EQ.1 ) I1 = N - 1
I2 = I1 + 1
IZERO = I2
IF( IUPLO.EQ.1 ) IZERO = I1
DO 230 MODE = 1, 2
DO 200 J = 1, N
DO 190 I = 1, N
A( I+( J-1 )*LDA ) = ZERO
190 CONTINUE
A( J+( J-1 )*LDA ) = 1.0E+0
200 CONTINUE
A( I1+( I1-1 )*LDA ) = 0.0625E+0
A( I2+( I2-1 )*LDA ) = 0.0625E+0
A( I1+( I2-1 )*LDA ) = 0.0625E+0
A( I2+( I1-1 )*LDA ) = 0.0625E+0
IF( MODE.EQ.2 ) THEN
A( I1+( I2-1 )*LDA ) = ( 0.0E+0, 0.0625E+0 )
A( I2+( I1-1 )*LDA ) =
$ A( I1+( I2-1 )*LDA )
A( I2+( I2-1 )*LDA ) = -0.0625E+0
END IF
DO 220 INB = 1, NNB
NB = NBVAL( INB )
CALL XLAENV( 1, NB )
CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
LWORK = MAX( 2, NB )*LDA
SRNAMT = 'CSYTRF'
CALL CSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
IF( INFO.NE.IZERO )
$ CALL ALAERH( PATH, 'CSYTRF', INFO, IZERO,
$ UPLO, N, N, -1, -1, NB, 3, NFAIL,
$ NERRS, NOUT )
CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
$ AINV, LDA, RWORK, RESULT( 1 ) )
IF( RESULT( 1 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )UPLO, N, NB, MODE,
$ RESULT( 1 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 1
220 CONTINUE
230 CONTINUE
240 CONTINUE
250 CONTINUE
260 CONTINUE
*
* Print a summary of the results.
*
CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
*
9996 FORMAT( ' Zero pivot: UPLO = ''', A1, ''', N =', I5,
$ ', NB =', I4, ', mode =', I2, ', ratio =', G12.5 )
9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
$ I2, ', test ', I2, ', ratio =', G12.5 )
9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
Expand Down
59 changes: 59 additions & 0 deletions TESTING/LIN/dchksy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -656,10 +656,69 @@ SUBROUTINE DCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 CONTINUE
180 CONTINUE
*
*
* Check an exact zero pivot created by updating a rank-one block
* when the singular matrix tests are requested.
* Unlike a row that is zero on input, its original diagonal must
* be replaced by the updated zero before returning the factors.
*
IF( .NOT.DOTYPE( 3 ) ) GO TO 260
DO 250 IN = 1, NN
N = NVAL( IN )
IF( N.LT.3 ) GO TO 250
LDA = N
DO 240 IUPLO = 1, 2
UPLO = UPLOS( IUPLO )
I1 = 1
IF( IUPLO.EQ.1 ) I1 = N - 1
I2 = I1 + 1
IZERO = I2
IF( IUPLO.EQ.1 ) IZERO = I1
DO 230 MODE = 1, 1
DO 200 J = 1, N
DO 190 I = 1, N
A( I+( J-1 )*LDA ) = ZERO
190 CONTINUE
A( J+( J-1 )*LDA ) = 1.0D+0
200 CONTINUE
A( I1+( I1-1 )*LDA ) = 0.0625D+0
A( I2+( I2-1 )*LDA ) = 0.0625D+0
A( I1+( I2-1 )*LDA ) = 0.0625D+0
A( I2+( I1-1 )*LDA ) = 0.0625D+0
DO 220 INB = 1, NNB
NB = NBVAL( INB )
CALL XLAENV( 1, NB )
CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
LWORK = MAX( 2, NB )*LDA
SRNAMT = 'DSYTRF'
CALL DSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
IF( INFO.NE.IZERO )
$ CALL ALAERH( PATH, 'DSYTRF', INFO, IZERO,
$ UPLO, N, N, -1, -1, NB, 3, NFAIL,
$ NERRS, NOUT )
CALL DSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
$ AINV, LDA, RWORK, RESULT( 1 ) )
IF( RESULT( 1 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )UPLO, N, NB, MODE,
$ RESULT( 1 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 1
220 CONTINUE
230 CONTINUE
240 CONTINUE
250 CONTINUE
260 CONTINUE
*
* Print a summary of the results.
*
CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
*
9996 FORMAT( ' Zero pivot: UPLO = ''', A1, ''', N =', I5,
$ ', NB =', I4, ', mode =', I2, ', ratio =', G12.5 )
9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
$ I2, ', test ', I2, ', ratio =', G12.5 )
9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
Expand Down
59 changes: 59 additions & 0 deletions TESTING/LIN/schksy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -655,10 +655,69 @@ SUBROUTINE SCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 CONTINUE
180 CONTINUE
*
*
* Check an exact zero pivot created by updating a rank-one block
* when the singular matrix tests are requested.
* Unlike a row that is zero on input, its original diagonal must
* be replaced by the updated zero before returning the factors.
*
IF( .NOT.DOTYPE( 3 ) ) GO TO 260
DO 250 IN = 1, NN
N = NVAL( IN )
IF( N.LT.3 ) GO TO 250
LDA = N
DO 240 IUPLO = 1, 2
UPLO = UPLOS( IUPLO )
I1 = 1
IF( IUPLO.EQ.1 ) I1 = N - 1
I2 = I1 + 1
IZERO = I2
IF( IUPLO.EQ.1 ) IZERO = I1
DO 230 MODE = 1, 1
DO 200 J = 1, N
DO 190 I = 1, N
A( I+( J-1 )*LDA ) = ZERO
190 CONTINUE
A( J+( J-1 )*LDA ) = 1.0E+0
200 CONTINUE
A( I1+( I1-1 )*LDA ) = 0.0625E+0
A( I2+( I2-1 )*LDA ) = 0.0625E+0
A( I1+( I2-1 )*LDA ) = 0.0625E+0
A( I2+( I1-1 )*LDA ) = 0.0625E+0
DO 220 INB = 1, NNB
NB = NBVAL( INB )
CALL XLAENV( 1, NB )
CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
LWORK = MAX( 2, NB )*LDA
SRNAMT = 'SSYTRF'
CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV,
$ LWORK, INFO )
IF( INFO.NE.IZERO )
$ CALL ALAERH( PATH, 'SSYTRF', INFO, IZERO,
$ UPLO, N, N, -1, -1, NB, 3, NFAIL,
$ NERRS, NOUT )
CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
$ AINV, LDA, RWORK, RESULT( 1 ) )
IF( RESULT( 1 ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
$ CALL ALAHD( NOUT, PATH )
WRITE( NOUT, FMT = 9996 )UPLO, N, NB, MODE,
$ RESULT( 1 )
NFAIL = NFAIL + 1
END IF
NRUN = NRUN + 1
220 CONTINUE
230 CONTINUE
240 CONTINUE
250 CONTINUE
260 CONTINUE
*
* Print a summary of the results.
*
CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
*
9996 FORMAT( ' Zero pivot: UPLO = ''', A1, ''', N =', I5,
$ ', NB =', I4, ', mode =', I2, ', ratio =', G12.5 )
9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
$ I2, ', test ', I2, ', ratio =', G12.5 )
9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
Expand Down
Loading
Loading