Skip to content

Commit 26fd4b9

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #4129 from martin-frbg/lapack876
Fix segfault in ?GELSS when NRHS is zero (Reference-LAPACK PR 876)
2 parents 22ad23a + bed3a6a commit 26fd4b9

4 files changed

Lines changed: 22 additions & 28 deletions

File tree

‎lapack-netlib/SRC/cgelss.f‎

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -170,7 +170,7 @@
170170
*> \author Univ. of Colorado Denver
171171
*> \author NAG Ltd.
172172
*
173-
*> \ingroup complexGEsolve
173+
*> \ingroup gelss
174174
*
175175
* =====================================================================
176176
SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@@ -214,8 +214,7 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
214214
* .. External Subroutines ..
215215
EXTERNAL CBDSQR, CCOPY, CGEBRD, CGELQF, CGEMM, CGEMV,
216216
$ CGEQRF, CLACPY, CLASCL, CLASET, CSRSCL, CUNGBR,
217-
$ CUNMBR, CUNMLQ, CUNMQR, SLABAD, SLASCL, SLASET,
218-
$ XERBLA
217+
$ CUNMBR, CUNMLQ, CUNMQR, SLASCL, SLASET, XERBLA
219218
* ..
220219
* .. External Functions ..
221220
INTEGER ILAENV
@@ -388,7 +387,6 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
388387
SFMIN = SLAMCH( 'S' )
389388
SMLNUM = SFMIN / EPS
390389
BIGNUM = ONE / SMLNUM
391-
CALL SLABAD( SMLNUM, BIGNUM )
392390
*
393391
* Scale A if max element outside range [SMLNUM,BIGNUM]
394392
*
@@ -540,7 +538,7 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
540538
$ LDB, CZERO, WORK, N )
541539
CALL CLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
542540
20 CONTINUE
543-
ELSE
541+
ELSE IF( NRHS.EQ.1 ) THEN
544542
CALL CGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
545543
CALL CCOPY( N, WORK, 1, B, 1 )
546544
END IF
@@ -645,7 +643,7 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
645643
CALL CLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
646644
$ LDB )
647645
40 CONTINUE
648-
ELSE
646+
ELSE IF( NRHS.EQ.1 ) THEN
649647
CALL CGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ),
650648
$ 1, CZERO, WORK( IWORK ), 1 )
651649
CALL CCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@@ -737,7 +735,7 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
737735
$ LDB, CZERO, WORK, N )
738736
CALL CLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
739737
60 CONTINUE
740-
ELSE
738+
ELSE IF( NRHS.EQ.1 ) THEN
741739
CALL CGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
742740
CALL CCOPY( N, WORK, 1, B, 1 )
743741
END IF

‎lapack-netlib/SRC/dgelss.f‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,7 @@
164164
*> \author Univ. of Colorado Denver
165165
*> \author NAG Ltd.
166166
*
167-
*> \ingroup doubleGEsolve
167+
*> \ingroup gelss
168168
*
169169
* =====================================================================
170170
SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@@ -203,7 +203,7 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
203203
* ..
204204
* .. External Subroutines ..
205205
EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV,
206-
$ DGEQRF, DLABAD, DLACPY, DLASCL, DLASET, DORGBR,
206+
$ DGEQRF, DLACPY, DLASCL, DLASET, DORGBR,
207207
$ DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA
208208
* ..
209209
* .. External Functions ..
@@ -385,7 +385,6 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
385385
SFMIN = DLAMCH( 'S' )
386386
SMLNUM = SFMIN / EPS
387387
BIGNUM = ONE / SMLNUM
388-
CALL DLABAD( SMLNUM, BIGNUM )
389388
*
390389
* Scale A if max element outside range [SMLNUM,BIGNUM]
391390
*
@@ -529,7 +528,7 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
529528
$ LDB, ZERO, WORK, N )
530529
CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
531530
20 CONTINUE
532-
ELSE
531+
ELSE IF( NRHS.EQ.1 ) THEN
533532
CALL DGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
534533
CALL DCOPY( N, WORK, 1, B, 1 )
535534
END IF
@@ -626,7 +625,7 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
626625
CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
627626
$ LDB )
628627
40 CONTINUE
629-
ELSE
628+
ELSE IF( NRHS.EQ.1 ) THEN
630629
CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
631630
$ 1, ZERO, WORK( IWORK ), 1 )
632631
CALL DCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@@ -712,7 +711,7 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
712711
$ LDB, ZERO, WORK, N )
713712
CALL DLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
714713
60 CONTINUE
715-
ELSE
714+
ELSE IF( NRHS.EQ.1 ) THEN
716715
CALL DGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
717716
CALL DCOPY( N, WORK, 1, B, 1 )
718717
END IF

‎lapack-netlib/SRC/sgelss.f‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,7 @@
164164
*> \author Univ. of Colorado Denver
165165
*> \author NAG Ltd.
166166
*
167-
*> \ingroup realGEsolve
167+
*> \ingroup gelss
168168
*
169169
* =====================================================================
170170
SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@@ -202,7 +202,7 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
202202
* ..
203203
* .. External Subroutines ..
204204
EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, SGEMV,
205-
$ SGEQRF, SLABAD, SLACPY, SLASCL, SLASET, SORGBR,
205+
$ SGEQRF, SLACPY, SLASCL, SLASET, SORGBR,
206206
$ SORMBR, SORMLQ, SORMQR, SRSCL, XERBLA
207207
* ..
208208
* .. External Functions ..
@@ -381,7 +381,6 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
381381
SFMIN = SLAMCH( 'S' )
382382
SMLNUM = SFMIN / EPS
383383
BIGNUM = ONE / SMLNUM
384-
CALL SLABAD( SMLNUM, BIGNUM )
385384
*
386385
* Scale A if max element outside range [SMLNUM,BIGNUM]
387386
*
@@ -525,7 +524,7 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
525524
$ LDB, ZERO, WORK, N )
526525
CALL SLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
527526
20 CONTINUE
528-
ELSE
527+
ELSE IF( NRHS.EQ.1 ) THEN
529528
CALL SGEMV( 'T', N, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
530529
CALL SCOPY( N, WORK, 1, B, 1 )
531530
END IF
@@ -622,7 +621,7 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
622621
CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
623622
$ LDB )
624623
40 CONTINUE
625-
ELSE
624+
ELSE IF( NRHS.EQ.1 ) THEN
626625
CALL SGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ),
627626
$ 1, ZERO, WORK( IWORK ), 1 )
628627
CALL SCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@@ -708,7 +707,7 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
708707
$ LDB, ZERO, WORK, N )
709708
CALL SLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
710709
60 CONTINUE
711-
ELSE
710+
ELSE IF( NRHS.EQ.1 ) THEN
712711
CALL SGEMV( 'T', M, N, ONE, A, LDA, B, 1, ZERO, WORK, 1 )
713712
CALL SCOPY( N, WORK, 1, B, 1 )
714713
END IF

‎lapack-netlib/SRC/zgelss.f‎

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -170,7 +170,7 @@
170170
*> \author Univ. of Colorado Denver
171171
*> \author NAG Ltd.
172172
*
173-
*> \ingroup complex16GEsolve
173+
*> \ingroup gelss
174174
*
175175
* =====================================================================
176176
SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
@@ -212,10 +212,9 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
212212
COMPLEX*16 DUM( 1 )
213213
* ..
214214
* .. External Subroutines ..
215-
EXTERNAL DLABAD, DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY,
216-
$ ZDRSCL, ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF,
217-
$ ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ,
218-
$ ZUNMQR
215+
EXTERNAL DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, ZDRSCL,
216+
$ ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF, ZLACPY,
217+
$ ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ
219218
* ..
220219
* .. External Functions ..
221220
INTEGER ILAENV
@@ -388,7 +387,6 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
388387
SFMIN = DLAMCH( 'S' )
389388
SMLNUM = SFMIN / EPS
390389
BIGNUM = ONE / SMLNUM
391-
CALL DLABAD( SMLNUM, BIGNUM )
392390
*
393391
* Scale A if max element outside range [SMLNUM,BIGNUM]
394392
*
@@ -540,7 +538,7 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
540538
$ LDB, CZERO, WORK, N )
541539
CALL ZLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB )
542540
20 CONTINUE
543-
ELSE
541+
ELSE IF( NRHS.EQ.1 ) THEN
544542
CALL ZGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
545543
CALL ZCOPY( N, WORK, 1, B, 1 )
546544
END IF
@@ -645,7 +643,7 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
645643
CALL ZLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ),
646644
$ LDB )
647645
40 CONTINUE
648-
ELSE
646+
ELSE IF( NRHS.EQ.1 ) THEN
649647
CALL ZGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ),
650648
$ 1, CZERO, WORK( IWORK ), 1 )
651649
CALL ZCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 )
@@ -737,7 +735,7 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
737735
$ LDB, CZERO, WORK, N )
738736
CALL ZLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB )
739737
60 CONTINUE
740-
ELSE
738+
ELSE IF( NRHS.EQ.1 ) THEN
741739
CALL ZGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 )
742740
CALL ZCOPY( N, WORK, 1, B, 1 )
743741
END IF

0 commit comments

Comments
 (0)