Skip to content

Commit 992d7ca

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #2845 from martin-frbg/lapack443
Fix workspace query in LAPACK xGELQ (Reference-LAPACK 443)
2 parents b1e0bcc + 7e4d5c2 commit 992d7ca

File tree

8 files changed

+88
-40
lines changed

8 files changed

+88
-40
lines changed

‎lapack-netlib/SRC/cgelq.f

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
*> where:
2727
*>
2828
*> Q is a N-by-N orthogonal matrix;
29-
*> L is an lower-triangular M-by-M matrix;
29+
*> L is a lower-triangular M-by-M matrix;
3030
*> 0 is a M-by-(N-M) zero matrix, if M < N.
3131
*>
3232
*> \endverbatim
@@ -187,7 +187,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
187187
* ..
188188
* .. Local Scalars ..
189189
LOGICAL LQUERY, LMINWS, MINT, MINW
190-
INTEGER MB, NB, MINTSZ, NBLCKS
190+
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
191191
* ..
192192
* .. External Functions ..
193193
LOGICAL LSAME
@@ -243,20 +243,32 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
243243
*
244244
* Determine if the workspace size satisfies minimal size
245245
*
246+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
247+
LWMIN = MAX( 1, N )
248+
LWOPT = MAX( 1, MB*N )
249+
ELSE
250+
LWMIN = MAX( 1, M )
251+
LWOPT = MAX( 1, MB*M )
252+
END IF
246253
LMINWS = .FALSE.
247-
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
248-
$ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
254+
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT )
255+
$ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ )
249256
$ .AND. ( .NOT.LQUERY ) ) THEN
250257
IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
251258
LMINWS = .TRUE.
252259
MB = 1
253260
NB = N
254261
END IF
255-
IF( LWORK.LT.MB*M ) THEN
262+
IF( LWORK.LT.LWOPT ) THEN
256263
LMINWS = .TRUE.
257264
MB = 1
258265
END IF
259266
END IF
267+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
268+
LWREQ = MAX( 1, MB*N )
269+
ELSE
270+
LWREQ = MAX( 1, MB*M )
271+
END IF
260272
*
261273
IF( M.LT.0 ) THEN
262274
INFO = -1
@@ -267,7 +279,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
267279
ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
268280
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
269281
INFO = -6
270-
ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
282+
ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY )
271283
$ .AND. ( .NOT.LMINWS ) ) THEN
272284
INFO = -8
273285
END IF
@@ -281,9 +293,9 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
281293
T( 2 ) = MB
282294
T( 3 ) = NB
283295
IF( MINW ) THEN
284-
WORK( 1 ) = MAX( 1, N )
296+
WORK( 1 ) = LWMIN
285297
ELSE
286-
WORK( 1 ) = MAX( 1, MB*M )
298+
WORK( 1 ) = LWREQ
287299
END IF
288300
END IF
289301
IF( INFO.NE.0 ) THEN
@@ -308,7 +320,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
308320
$ LWORK, INFO )
309321
END IF
310322
*
311-
WORK( 1 ) = MAX( 1, MB*M )
323+
WORK( 1 ) = LWREQ
312324
*
313325
RETURN
314326
*

‎lapack-netlib/SRC/cgetsls.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -261,7 +261,7 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
261261
TSZM = INT( TQ( 1 ) )
262262
LWM = INT( WORKQ( 1 ) )
263263
CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
264-
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
264+
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
265265
LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
266266
WSIZEO = TSZO + LWO
267267
WSIZEM = TSZM + LWM

‎lapack-netlib/SRC/dgelq.f

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
*> where:
2727
*>
2828
*> Q is a N-by-N orthogonal matrix;
29-
*> L is an lower-triangular M-by-M matrix;
29+
*> L is a lower-triangular M-by-M matrix;
3030
*> 0 is a M-by-(N-M) zero matrix, if M < N.
3131
*>
3232
*> \endverbatim
@@ -187,7 +187,7 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
187187
* ..
188188
* .. Local Scalars ..
189189
LOGICAL LQUERY, LMINWS, MINT, MINW
190-
INTEGER MB, NB, MINTSZ, NBLCKS
190+
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
191191
* ..
192192
* .. External Functions ..
193193
LOGICAL LSAME
@@ -243,20 +243,32 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
243243
*
244244
* Determine if the workspace size satisfies minimal size
245245
*
246+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
247+
LWMIN = MAX( 1, N )
248+
LWOPT = MAX( 1, MB*N )
249+
ELSE
250+
LWMIN = MAX( 1, M )
251+
LWOPT = MAX( 1, MB*M )
252+
END IF
246253
LMINWS = .FALSE.
247-
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
248-
$ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
254+
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT )
255+
$ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ )
249256
$ .AND. ( .NOT.LQUERY ) ) THEN
250257
IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
251258
LMINWS = .TRUE.
252259
MB = 1
253260
NB = N
254261
END IF
255-
IF( LWORK.LT.MB*M ) THEN
262+
IF( LWORK.LT.LWOPT ) THEN
256263
LMINWS = .TRUE.
257264
MB = 1
258265
END IF
259266
END IF
267+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
268+
LWREQ = MAX( 1, MB*N )
269+
ELSE
270+
LWREQ = MAX( 1, MB*M )
271+
END IF
260272
*
261273
IF( M.LT.0 ) THEN
262274
INFO = -1
@@ -267,7 +279,7 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
267279
ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
268280
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
269281
INFO = -6
270-
ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
282+
ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY )
271283
$ .AND. ( .NOT.LMINWS ) ) THEN
272284
INFO = -8
273285
END IF
@@ -281,9 +293,9 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
281293
T( 2 ) = MB
282294
T( 3 ) = NB
283295
IF( MINW ) THEN
284-
WORK( 1 ) = MAX( 1, N )
296+
WORK( 1 ) = LWMIN
285297
ELSE
286-
WORK( 1 ) = MAX( 1, MB*M )
298+
WORK( 1 ) = LWREQ
287299
END IF
288300
END IF
289301
IF( INFO.NE.0 ) THEN
@@ -308,7 +320,7 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
308320
$ LWORK, INFO )
309321
END IF
310322
*
311-
WORK( 1 ) = MAX( 1, MB*M )
323+
WORK( 1 ) = LWREQ
312324
*
313325
RETURN
314326
*

‎lapack-netlib/SRC/dgetsls.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -258,7 +258,7 @@ SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
258258
TSZM = INT( TQ( 1 ) )
259259
LWM = INT( WORKQ( 1 ) )
260260
CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
261-
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
261+
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
262262
LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
263263
WSIZEO = TSZO + LWO
264264
WSIZEM = TSZM + LWM

‎lapack-netlib/SRC/sgelq.f

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
*> where:
2727
*>
2828
*> Q is a N-by-N orthogonal matrix;
29-
*> L is an lower-triangular M-by-M matrix;
29+
*> L is a lower-triangular M-by-M matrix;
3030
*> 0 is a M-by-(N-M) zero matrix, if M < N.
3131
*>
3232
*> \endverbatim
@@ -187,7 +187,7 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
187187
* ..
188188
* .. Local Scalars ..
189189
LOGICAL LQUERY, LMINWS, MINT, MINW
190-
INTEGER MB, NB, MINTSZ, NBLCKS
190+
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
191191
* ..
192192
* .. External Functions ..
193193
LOGICAL LSAME
@@ -243,20 +243,32 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
243243
*
244244
* Determine if the workspace size satisfies minimal size
245245
*
246+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
247+
LWMIN = MAX( 1, N )
248+
LWOPT = MAX( 1, MB*N )
249+
ELSE
250+
LWMIN = MAX( 1, M )
251+
LWOPT = MAX( 1, MB*M )
252+
END IF
246253
LMINWS = .FALSE.
247-
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
248-
$ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
254+
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT )
255+
$ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ )
249256
$ .AND. ( .NOT.LQUERY ) ) THEN
250257
IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
251258
LMINWS = .TRUE.
252259
MB = 1
253260
NB = N
254261
END IF
255-
IF( LWORK.LT.MB*M ) THEN
262+
IF( LWORK.LT.LWOPT ) THEN
256263
LMINWS = .TRUE.
257264
MB = 1
258265
END IF
259266
END IF
267+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
268+
LWREQ = MAX( 1, MB*N )
269+
ELSE
270+
LWREQ = MAX( 1, MB*M )
271+
END IF
260272
*
261273
IF( M.LT.0 ) THEN
262274
INFO = -1
@@ -267,7 +279,7 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
267279
ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
268280
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
269281
INFO = -6
270-
ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
282+
ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY )
271283
$ .AND. ( .NOT.LMINWS ) ) THEN
272284
INFO = -8
273285
END IF
@@ -281,9 +293,9 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
281293
T( 2 ) = MB
282294
T( 3 ) = NB
283295
IF( MINW ) THEN
284-
WORK( 1 ) = MAX( 1, N )
296+
WORK( 1 ) = LWMIN
285297
ELSE
286-
WORK( 1 ) = MAX( 1, MB*M )
298+
WORK( 1 ) = LWREQ
287299
END IF
288300
END IF
289301
IF( INFO.NE.0 ) THEN
@@ -308,7 +320,7 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
308320
$ LWORK, INFO )
309321
END IF
310322
*
311-
WORK( 1 ) = MAX( 1, MB*M )
323+
WORK( 1 ) = LWREQ
312324
RETURN
313325
*
314326
* End of SGELQ

‎lapack-netlib/SRC/sgetsls.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -258,7 +258,7 @@ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
258258
TSZM = INT( TQ( 1 ) )
259259
LWM = INT( WORKQ( 1 ) )
260260
CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
261-
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
261+
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
262262
LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
263263
WSIZEO = TSZO + LWO
264264
WSIZEM = TSZM + LWM

‎lapack-netlib/SRC/zgelq.f

Lines changed: 21 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626
*> where:
2727
*>
2828
*> Q is a N-by-N orthogonal matrix;
29-
*> L is an lower-triangular M-by-M matrix;
29+
*> L is a lower-triangular M-by-M matrix;
3030
*> 0 is a M-by-(N-M) zero matrix, if M < N.
3131
*>
3232
*> \endverbatim
@@ -187,7 +187,7 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
187187
* ..
188188
* .. Local Scalars ..
189189
LOGICAL LQUERY, LMINWS, MINT, MINW
190-
INTEGER MB, NB, MINTSZ, NBLCKS
190+
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
191191
* ..
192192
* .. External Functions ..
193193
LOGICAL LSAME
@@ -243,20 +243,32 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
243243
*
244244
* Determine if the workspace size satisfies minimal size
245245
*
246+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
247+
LWMIN = MAX( 1, N )
248+
LWOPT = MAX( 1, MB*N )
249+
ELSE
250+
LWMIN = MAX( 1, M )
251+
LWOPT = MAX( 1, MB*M )
252+
END IF
246253
LMINWS = .FALSE.
247-
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
248-
$ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
254+
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT )
255+
$ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ )
249256
$ .AND. ( .NOT.LQUERY ) ) THEN
250257
IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
251258
LMINWS = .TRUE.
252259
MB = 1
253260
NB = N
254261
END IF
255-
IF( LWORK.LT.MB*M ) THEN
262+
IF( LWORK.LT.LWOPT ) THEN
256263
LMINWS = .TRUE.
257264
MB = 1
258265
END IF
259266
END IF
267+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
268+
LWREQ = MAX( 1, MB*N )
269+
ELSE
270+
LWREQ = MAX( 1, MB*M )
271+
END IF
260272
*
261273
IF( M.LT.0 ) THEN
262274
INFO = -1
@@ -267,7 +279,7 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
267279
ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
268280
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
269281
INFO = -6
270-
ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
282+
ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY )
271283
$ .AND. ( .NOT.LMINWS ) ) THEN
272284
INFO = -8
273285
END IF
@@ -281,9 +293,9 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
281293
T( 2 ) = MB
282294
T( 3 ) = NB
283295
IF( MINW ) THEN
284-
WORK( 1 ) = MAX( 1, N )
296+
WORK( 1 ) = LWMIN
285297
ELSE
286-
WORK( 1 ) = MAX( 1, MB*M )
298+
WORK( 1 ) = LWREQ
287299
END IF
288300
END IF
289301
IF( INFO.NE.0 ) THEN
@@ -308,7 +320,7 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
308320
$ LWORK, INFO )
309321
END IF
310322
*
311-
WORK( 1 ) = MAX( 1, MB*M )
323+
WORK( 1 ) = LWREQ
312324
*
313325
RETURN
314326
*

‎lapack-netlib/SRC/zgetsls.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -261,7 +261,7 @@ SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
261261
TSZM = INT( TQ( 1 ) )
262262
LWM = INT( WORKQ( 1 ) )
263263
CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
264-
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
264+
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
265265
LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
266266
WSIZEO = TSZO + LWO
267267
WSIZEM = TSZM + LWM

0 commit comments

Comments
 (0)