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

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

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

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

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

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

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