Skip to content

Commit 29d6024

Browse files
martin-frbgmartin-frbg
authored
Handle corner cases of LWORK (Reference-LAPACK PR 942)
1 parent 0814491 commit 29d6024

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

48 files changed

+751
-510
lines changed

‎lapack-netlib/SRC/dgebrd.f

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,8 @@
122122
*> \param[in] LWORK
123123
*> \verbatim
124124
*> LWORK is INTEGER
125-
*> The length of the array WORK. LWORK >= max(1,M,N).
125+
*> The length of the array WORK.
126+
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
126127
*> For optimum performance LWORK >= (M+N)*NB, where NB
127128
*> is the optimal blocksize.
128129
*>
@@ -147,7 +148,7 @@
147148
*> \author Univ. of Colorado Denver
148149
*> \author NAG Ltd.
149150
*
150-
*> \ingroup doubleGEcomputational
151+
*> \ingroup gebrd
151152
*
152153
*> \par Further Details:
153154
* =====================
@@ -223,8 +224,8 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
223224
* ..
224225
* .. Local Scalars ..
225226
LOGICAL LQUERY
226-
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
227-
$ NBMIN, NX, WS
227+
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
228+
$ MINMN, NB, NBMIN, NX, WS
228229
* ..
229230
* .. External Subroutines ..
230231
EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
@@ -241,17 +242,25 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
241242
* Test the input parameters
242243
*
243244
INFO = 0
244-
NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
245-
LWKOPT = ( M+N )*NB
245+
MINMN = MIN( M, N )
246+
IF( MINMN.EQ.0 ) THEN
247+
LWKMIN = 1
248+
LWKOPT = 1
249+
ELSE
250+
LWKMIN = MAX( M, N )
251+
NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
252+
LWKOPT = ( M+N )*NB
253+
ENDIF
246254
WORK( 1 ) = DBLE( LWKOPT )
255+
*
247256
LQUERY = ( LWORK.EQ.-1 )
248257
IF( M.LT.0 ) THEN
249258
INFO = -1
250259
ELSE IF( N.LT.0 ) THEN
251260
INFO = -2
252261
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
253262
INFO = -4
254-
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
263+
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
255264
INFO = -10
256265
END IF
257266
IF( INFO.LT.0 ) THEN
@@ -263,7 +272,6 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
263272
*
264273
* Quick return if possible
265274
*
266-
MINMN = MIN( M, N )
267275
IF( MINMN.EQ.0 ) THEN
268276
WORK( 1 ) = 1
269277
RETURN
@@ -282,7 +290,7 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
282290
* Determine when to switch from blocked to unblocked code.
283291
*
284292
IF( NX.LT.MINMN ) THEN
285-
WS = ( M+N )*NB
293+
WS = LWKOPT
286294
IF( LWORK.LT.WS ) THEN
287295
*
288296
* Not enough work space for the optimal NB, consider using

‎lapack-netlib/SRC/dgehrd.f

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@
8989
*>
9090
*> \param[out] WORK
9191
*> \verbatim
92-
*> WORK is DOUBLE PRECISION array, dimension (LWORK)
92+
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
9393
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
9494
*> \endverbatim
9595
*>
@@ -120,7 +120,7 @@
120120
*> \author Univ. of Colorado Denver
121121
*> \author NAG Ltd.
122122
*
123-
*> \ingroup doubleGEcomputational
123+
*> \ingroup gehrd
124124
*
125125
*> \par Further Details:
126126
* =====================
@@ -173,7 +173,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
173173
INTEGER IHI, ILO, INFO, LDA, LWORK, N
174174
* ..
175175
* .. Array Arguments ..
176-
DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
176+
DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
177177
* ..
178178
*
179179
* =====================================================================
@@ -182,15 +182,15 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
182182
INTEGER NBMAX, LDT, TSIZE
183183
PARAMETER ( NBMAX = 64, LDT = NBMAX+1,
184184
$ TSIZE = LDT*NBMAX )
185-
DOUBLE PRECISION ZERO, ONE
185+
DOUBLE PRECISION ZERO, ONE
186186
PARAMETER ( ZERO = 0.0D+0,
187187
$ ONE = 1.0D+0 )
188188
* ..
189189
* .. Local Scalars ..
190190
LOGICAL LQUERY
191191
INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
192192
$ NBMIN, NH, NX
193-
DOUBLE PRECISION EI
193+
DOUBLE PRECISION EI
194194
* ..
195195
* .. External Subroutines ..
196196
EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM,
@@ -221,12 +221,18 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
221221
INFO = -8
222222
END IF
223223
*
224+
NH = IHI - ILO + 1
224225
IF( INFO.EQ.0 ) THEN
225226
*
226227
* Compute the workspace requirements
227228
*
228-
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) )
229-
LWKOPT = N*NB + TSIZE
229+
IF( NH.LE.1 ) THEN
230+
LWKOPT = 1
231+
ELSE
232+
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
233+
$ -1 ) )
234+
LWKOPT = N*NB + TSIZE
235+
ENDIF
230236
WORK( 1 ) = LWKOPT
231237
END IF
232238
*
@@ -248,7 +254,6 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
248254
*
249255
* Quick return if possible
250256
*
251-
NH = IHI - ILO + 1
252257
IF( NH.LE.1 ) THEN
253258
WORK( 1 ) = 1
254259
RETURN
@@ -268,7 +273,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
268273
*
269274
* Determine if workspace is large enough for blocked code
270275
*
271-
IF( LWORK.LT.N*NB+TSIZE ) THEN
276+
IF( LWORK.LT.LWKOPT ) THEN
272277
*
273278
* Not enough workspace to use optimal NB: determine the
274279
* minimum value of NB, and reduce NB or force use of
@@ -344,6 +349,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
344349
* Use unblocked code to reduce the rest of the matrix
345350
*
346351
CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
352+
*
347353
WORK( 1 ) = LWKOPT
348354
*
349355
RETURN

‎lapack-netlib/SRC/dgelq.f

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@
9898
*> \param[in] LWORK
9999
*> \verbatim
100100
*> LWORK is INTEGER
101-
*> The dimension of the array WORK.
101+
*> The dimension of the array WORK. LWORK >= 1.
102102
*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
103103
*> only calculates the sizes of the T and WORK arrays, returns these
104104
*> values as the first entries of the T and WORK arrays, and no error
@@ -166,6 +166,8 @@
166166
*> the LQ factorization.
167167
*> \endverbatim
168168
*>
169+
*> \ingroup gelq
170+
*>
169171
* =====================================================================
170172
SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
171173
$ INFO )

‎lapack-netlib/SRC/dgelqf.f

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,8 @@
9393
*> \param[in] LWORK
9494
*> \verbatim
9595
*> LWORK is INTEGER
96-
*> The dimension of the array WORK. LWORK >= max(1,M).
96+
*> The dimension of the array WORK.
97+
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
9798
*> For optimum performance LWORK >= M*NB, where NB is the
9899
*> optimal blocksize.
99100
*>
@@ -118,7 +119,7 @@
118119
*> \author Univ. of Colorado Denver
119120
*> \author NAG Ltd.
120121
*
121-
*> \ingroup doubleGEcomputational
122+
*> \ingroup gelqf
122123
*
123124
*> \par Further Details:
124125
* =====================
@@ -174,29 +175,34 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
174175
* Test the input arguments
175176
*
176177
INFO = 0
178+
K = MIN( M, N )
177179
NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
178-
LWKOPT = M*NB
179-
WORK( 1 ) = LWKOPT
180180
LQUERY = ( LWORK.EQ.-1 )
181181
IF( M.LT.0 ) THEN
182182
INFO = -1
183183
ELSE IF( N.LT.0 ) THEN
184184
INFO = -2
185185
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
186186
INFO = -4
187-
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
188-
INFO = -7
187+
ELSE IF( .NOT.LQUERY ) THEN
188+
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
189+
$ INFO = -7
189190
END IF
190191
IF( INFO.NE.0 ) THEN
191192
CALL XERBLA( 'DGELQF', -INFO )
192193
RETURN
193194
ELSE IF( LQUERY ) THEN
195+
IF( K.EQ.0 ) THEN
196+
LWKOPT = 1
197+
ELSE
198+
LWKOPT = M*NB
199+
END IF
200+
WORK( 1 ) = LWKOPT
194201
RETURN
195202
END IF
196203
*
197204
* Quick return if possible
198205
*
199-
K = MIN( M, N )
200206
IF( K.EQ.0 ) THEN
201207
WORK( 1 ) = 1
202208
RETURN

‎lapack-netlib/SRC/dgelsd.f

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@
188188
*> \author Univ. of Colorado Denver
189189
*> \author NAG Ltd.
190190
*
191-
*> \ingroup doubleGEsolve
191+
*> \ingroup gelsd
192192
*
193193
*> \par Contributors:
194194
* ==================
@@ -228,7 +228,7 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
228228
DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
229229
* ..
230230
* .. External Subroutines ..
231-
EXTERNAL DGEBRD, DGELQF, DGEQRF, DLABAD, DLACPY, DLALSD,
231+
EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, DLALSD,
232232
$ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA
233233
* ..
234234
* .. External Functions ..
@@ -276,7 +276,7 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
276276
$ LOG( TWO ) ) + 1, 0 )
277277
*
278278
IF( INFO.EQ.0 ) THEN
279-
MAXWRK = 0
279+
MAXWRK = 1
280280
LIWORK = 3*MINMN*NLVL + 11*MINMN
281281
MM = M
282282
IF( M.GE.N .AND. M.GE.MNTHR ) THEN
@@ -372,7 +372,6 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
372372
SFMIN = DLAMCH( 'S' )
373373
SMLNUM = SFMIN / EPS
374374
BIGNUM = ONE / SMLNUM
375-
CALL DLABAD( SMLNUM, BIGNUM )
376375
*
377376
* Scale A if max entry outside range [SMLNUM,BIGNUM].
378377
*

‎lapack-netlib/SRC/dgemlq.f

Lines changed: 21 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -111,16 +111,17 @@
111111
*>
112112
*> \param[out] WORK
113113
*> \verbatim
114-
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
114+
*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
115+
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
115116
*> \endverbatim
116117
*>
117118
*> \param[in] LWORK
118119
*> \verbatim
119120
*> LWORK is INTEGER
120-
*> The dimension of the array WORK.
121+
*> The dimension of the array WORK. LWORK >= 1.
121122
*> If LWORK = -1, then a workspace query is assumed. The routine
122123
*> only calculates the size of the WORK array, returns this
123-
*> value as WORK(1), and no error message related to WORK
124+
*> value as WORK(1), and no error message related to WORK
124125
*> is issued by XERBLA.
125126
*> \endverbatim
126127
*>
@@ -144,7 +145,7 @@
144145
*>
145146
*> \verbatim
146147
*>
147-
*> These details are particular for this LAPACK implementation. Users should not
148+
*> These details are particular for this LAPACK implementation. Users should not
148149
*> take them for granted. These details may change in the future, and are not likely
149150
*> true for another LAPACK implementation. These details are relevant if one wants
150151
*> to try to understand the code. They are not part of the interface.
@@ -160,11 +161,13 @@
160161
*> block sizes MB and NB returned by ILAENV, DGELQ will use either
161162
*> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute
162163
*> the LQ factorization.
163-
*> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to
164+
*> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to
164165
*> multiply matrix Q by another matrix.
165166
*> Further Details in DLAMSWLQ or DGEMLQT.
166167
*> \endverbatim
167168
*>
169+
*> \ingroup gemlq
170+
*>
168171
* =====================================================================
169172
SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
170173
$ C, LDC, WORK, LWORK, INFO )
@@ -186,7 +189,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
186189
* ..
187190
* .. Local Scalars ..
188191
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
189-
INTEGER MB, NB, LW, NBLCKS, MN
192+
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
190193
* ..
191194
* .. External Functions ..
192195
LOGICAL LSAME
@@ -202,7 +205,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
202205
*
203206
* Test the input arguments
204207
*
205-
LQUERY = LWORK.EQ.-1
208+
LQUERY = ( LWORK.EQ.-1 )
206209
NOTRAN = LSAME( TRANS, 'N' )
207210
TRAN = LSAME( TRANS, 'T' )
208211
LEFT = LSAME( SIDE, 'L' )
@@ -217,6 +220,13 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
217220
LW = M * MB
218221
MN = N
219222
END IF
223+
*
224+
MINMNK = MIN( M, N, K )
225+
IF( MINMNK.EQ.0 ) THEN
226+
LWMIN = 1
227+
ELSE
228+
LWMIN = MAX( 1, LW )
229+
END IF
220230
*
221231
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
222232
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@@ -245,12 +255,12 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
245255
INFO = -9
246256
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
247257
INFO = -11
248-
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
258+
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
249259
INFO = -13
250260
END IF
251261
*
252262
IF( INFO.EQ.0 ) THEN
253-
WORK( 1 ) = LW
263+
WORK( 1 ) = LWMIN
254264
END IF
255265
*
256266
IF( INFO.NE.0 ) THEN
@@ -262,7 +272,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
262272
*
263273
* Quick return if possible
264274
*
265-
IF( MIN( M, N, K ).EQ.0 ) THEN
275+
IF( MINMNK.EQ.0 ) THEN
266276
RETURN
267277
END IF
268278
*
@@ -275,7 +285,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
275285
$ MB, C, LDC, WORK, LWORK, INFO )
276286
END IF
277287
*
278-
WORK( 1 ) = LW
288+
WORK( 1 ) = LWMIN
279289
*
280290
RETURN
281291
*

0 commit comments

Comments
 (0)