floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix segfault when NRHS is zero (Reference-LAPACK PR 876)

This commit is contained in:
Martin Kroeker 2023-07-07 10:13:41 +02:00 committed by GitHub
parent 4d0b7fbec0
commit bed3a6a304
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 22 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lapack-netlib/SRC/cgelss.f
View File

@ -170,7 +170,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexGEsolve
*> \ingroup gelss
*
* =====================================================================
SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@ -214,8 +214,7 @@
* .. External Subroutines ..
EXTERNAL CBDSQR, CCOPY, CGEBRD, CGELQF, CGEMM, CGEMV,
$ CGEQRF, CLACPY, CLASCL, CLASET, CSRSCL, CUNGBR,
$ CUNMBR, CUNMLQ, CUNMQR, SLABAD, SLASCL, SLASET,
$ XERBLA
$ CUNMBR, CUNMLQ, CUNMQR, SLASCL, SLASET, XERBLA
* ..
* .. External Functions ..
INTEGER ILAENV
@ -388,7 +387,6 @@
SFMIN = SLAMCH( 'S' )
SMLNUM = SFMIN / EPS
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
*
* Scale A if max element outside range [SMLNUM,BIGNUM]
*
@ -540,7 +538,7 @@
$ LDB, CZERO, WORK, N )
CALL CLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
20 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL CGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
CALL CCOPY( N, WORK, 1, B, 1 )
END IF
@ -645,7 +643,7 @@
CALL CLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL CGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ),
$ 1, CZERO, WORK( IWORK ), 1 )
CALL CCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@ -737,7 +735,7 @@
$ LDB, CZERO, WORK, N )
CALL CLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
60 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL CGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
CALL CCOPY( N, WORK, 1, B, 1 )
END IF

11
lapack-netlib/SRC/dgelss.f
View File

@ -164,7 +164,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup doubleGEsolve
*> \ingroup gelss
*
* =====================================================================
SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@ -203,7 +203,7 @@
* ..
* .. External Subroutines ..
EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV,
$ DGEQRF, DLABAD, DLACPY, DLASCL, DLASET, DORGBR,
$ DGEQRF, DLACPY, DLASCL, DLASET, DORGBR,
$ DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA
* ..
* .. External Functions ..
@ -385,7 +385,6 @@
SFMIN = DLAMCH( 'S' )
SMLNUM = SFMIN / EPS
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
*
* Scale A if max element outside range [SMLNUM,BIGNUM]
*
@ -529,7 +528,7 @@
$ LDB, ZERO, WORK, N )
CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
20 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL DGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
CALL DCOPY( N, WORK, 1, B, 1 )
END IF
@ -626,7 +625,7 @@
CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
$ 1, ZERO, WORK( IWORK ), 1 )
CALL DCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@ -712,7 +711,7 @@
$ LDB, ZERO, WORK, N )
CALL DLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
60 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL DGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
CALL DCOPY( N, WORK, 1, B, 1 )
END IF

11
lapack-netlib/SRC/sgelss.f
View File

@ -164,7 +164,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup realGEsolve
*> \ingroup gelss
*
* =====================================================================
SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@ -202,7 +202,7 @@
* ..
* .. External Subroutines ..
EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, SGEMV,
$ SGEQRF, SLABAD, SLACPY, SLASCL, SLASET, SORGBR,
$ SGEQRF, SLACPY, SLASCL, SLASET, SORGBR,
$ SORMBR, SORMLQ, SORMQR, SRSCL, XERBLA
* ..
* .. External Functions ..
@ -381,7 +381,6 @@
SFMIN = SLAMCH( 'S' )
SMLNUM = SFMIN / EPS
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
*
* Scale A if max element outside range [SMLNUM,BIGNUM]
*
@ -525,7 +524,7 @@
$ LDB, ZERO, WORK, N )
CALL SLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
20 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL SGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
CALL SCOPY( N, WORK, 1, B, 1 )
END IF
@ -622,7 +621,7 @@
CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL SGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
$ 1, ZERO, WORK( IWORK ), 1 )
CALL SCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@ -708,7 +707,7 @@
$ LDB, ZERO, WORK, N )
CALL SLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
60 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL SGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
CALL SCOPY( N, WORK, 1, B, 1 )
END IF

16
lapack-netlib/SRC/zgelss.f
View File

@ -170,7 +170,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16GEsolve
*> \ingroup gelss
*
* =====================================================================
SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@ -212,10 +212,9 @@
COMPLEX*16 DUM( 1 )
* ..
* .. External Subroutines ..
EXTERNAL DLABAD, DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY,
$ ZDRSCL, ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF,
$ ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ,
$ ZUNMQR
EXTERNAL DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, ZDRSCL,
$ ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF, ZLACPY,
$ ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ
* ..
* .. External Functions ..
INTEGER ILAENV
@ -388,7 +387,6 @@
SFMIN = DLAMCH( 'S' )
SMLNUM = SFMIN / EPS
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
*
* Scale A if max element outside range [SMLNUM,BIGNUM]
*
@ -540,7 +538,7 @@
$ LDB, CZERO, WORK, N )
CALL ZLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
20 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL ZGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
CALL ZCOPY( N, WORK, 1, B, 1 )
END IF
@ -645,7 +643,7 @@
CALL ZLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
$ LDB )
40 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL ZGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ),
$ 1, CZERO, WORK( IWORK ), 1 )
CALL ZCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@ -737,7 +735,7 @@
$ LDB, CZERO, WORK, N )
CALL ZLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
60 CONTINUE
ELSE
ELSE IF( NRHS.EQ.1 ) THEN
CALL ZGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
CALL ZCOPY( N, WORK, 1, B, 1 )
END IF