Skip to content

Commit 0814491

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

Some content is hidden

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

47 files changed

+783
-533
lines changed

‎lapack-netlib/SRC/cgebrd.f

Lines changed: 20 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,8 @@
123123
*> \param[in] LWORK
124124
*> \verbatim
125125
*> LWORK is INTEGER
126-
*> The length of the array WORK. LWORK >= max(1,M,N).
126+
*> The length of the array WORK.
127+
*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
127128
*> For optimum performance LWORK >= (M+N)*NB, where NB
128129
*> is the optimal blocksize.
129130
*>
@@ -148,7 +149,7 @@
148149
*> \author Univ. of Colorado Denver
149150
*> \author NAG Ltd.
150151
*
151-
*> \ingroup complexGEcomputational
152+
*> \ingroup gebrd
152153
*
153154
*> \par Further Details:
154155
* =====================
@@ -225,8 +226,8 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
225226
* ..
226227
* .. Local Scalars ..
227228
LOGICAL LQUERY
228-
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
229-
$ NBMIN, NX, WS
229+
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
230+
$ MINMN, NB, NBMIN, NX, WS
230231
* ..
231232
* .. External Subroutines ..
232233
EXTERNAL CGEBD2, CGEMM, CLABRD, XERBLA
@@ -236,24 +237,32 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
236237
* ..
237238
* .. External Functions ..
238239
INTEGER ILAENV
239-
EXTERNAL ILAENV
240+
REAL SROUNDUP_LWORK
241+
EXTERNAL ILAENV, SROUNDUP_LWORK
240242
* ..
241243
* .. Executable Statements ..
242244
*
243245
* Test the input parameters
244246
*
245247
INFO = 0
246-
NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) )
247-
LWKOPT = ( M+N )*NB
248-
WORK( 1 ) = REAL( LWKOPT )
248+
MINMN = MIN( M, N )
249+
IF( MINMN.EQ.0 ) THEN
250+
LWKMIN = 1
251+
LWKOPT = 1
252+
ELSE
253+
LWKMIN = MAX( M, N )
254+
NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) )
255+
LWKOPT = ( M+N )*NB
256+
END IF
257+
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
249258
LQUERY = ( LWORK.EQ.-1 )
250259
IF( M.LT.0 ) THEN
251260
INFO = -1
252261
ELSE IF( N.LT.0 ) THEN
253262
INFO = -2
254263
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
255264
INFO = -4
256-
ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
265+
ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
257266
INFO = -10
258267
END IF
259268
IF( INFO.LT.0 ) THEN
@@ -265,7 +274,6 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
265274
*
266275
* Quick return if possible
267276
*
268-
MINMN = MIN( M, N )
269277
IF( MINMN.EQ.0 ) THEN
270278
WORK( 1 ) = 1
271279
RETURN
@@ -284,7 +292,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
284292
* Determine when to switch from blocked to unblocked code.
285293
*
286294
IF( NX.LT.MINMN ) THEN
287-
WS = ( M+N )*NB
295+
WS = LWKOPT
288296
IF( LWORK.LT.WS ) THEN
289297
*
290298
* Not enough work space for the optimal NB, consider using
@@ -343,7 +351,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
343351
*
344352
CALL CGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
345353
$ TAUQ( I ), TAUP( I ), WORK, IINFO )
346-
WORK( 1 ) = WS
354+
WORK( 1 ) = SROUNDUP_LWORK( WS )
347355
RETURN
348356
*
349357
* End of CGEBRD

‎lapack-netlib/SRC/cgehrd.f

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@
8989
*>
9090
*> \param[out] WORK
9191
*> \verbatim
92-
*> WORK is COMPLEX array, dimension (LWORK)
92+
*> WORK is COMPLEX array, dimension (MAX(1,LWORK))
9393
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
9494
*> \endverbatim
9595
*>
@@ -222,13 +222,19 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
222222
INFO = -8
223223
END IF
224224
*
225+
NH = IHI - ILO + 1
225226
IF( INFO.EQ.0 ) THEN
226227
*
227228
* Compute the workspace requirements
228229
*
229-
NB = MIN( NBMAX, ILAENV( 1, 'CGEHRD', ' ', N, ILO, IHI, -1 ) )
230-
LWKOPT = N*NB + TSIZE
231-
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
230+
IF( NH.LE.1 ) THEN
231+
LWKOPT = 1
232+
ELSE
233+
NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI,
234+
$ -1 ) )
235+
LWKOPT = N*NB + TSIZE
236+
END IF
237+
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
232238
END IF
233239
*
234240
IF( INFO.NE.0 ) THEN
@@ -249,7 +255,6 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
249255
*
250256
* Quick return if possible
251257
*
252-
NH = IHI - ILO + 1
253258
IF( NH.LE.1 ) THEN
254259
WORK( 1 ) = 1
255260
RETURN
@@ -269,7 +274,7 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
269274
*
270275
* Determine if workspace is large enough for blocked code
271276
*
272-
IF( LWORK.LT.N*NB+TSIZE ) THEN
277+
IF( LWORK.LT.LWKOPT ) THEN
273278
*
274279
* Not enough workspace to use optimal NB: determine the
275280
* minimum value of NB, and reduce NB or force use of
@@ -345,7 +350,8 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
345350
* Use unblocked code to reduce the rest of the matrix
346351
*
347352
CALL CGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
348-
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
353+
*
354+
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
349355
*
350356
RETURN
351357
*

‎lapack-netlib/SRC/cgelq.f

Lines changed: 4 additions & 4 deletions
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
@@ -295,9 +295,9 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
295295
T( 2 ) = MB
296296
T( 3 ) = NB
297297
IF( MINW ) THEN
298-
WORK( 1 ) = SROUNDUP_LWORK(LWMIN)
298+
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
299299
ELSE
300-
WORK( 1 ) = SROUNDUP_LWORK(LWREQ)
300+
WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
301301
END IF
302302
END IF
303303
IF( INFO.NE.0 ) THEN
@@ -322,7 +322,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
322322
$ LWORK, INFO )
323323
END IF
324324
*
325-
WORK( 1 ) = SROUNDUP_LWORK(LWREQ)
325+
WORK( 1 ) = SROUNDUP_LWORK( LWREQ )
326326
*
327327
RETURN
328328
*

‎lapack-netlib/SRC/cgelqf.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
*>
@@ -175,29 +176,34 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
175176
* Test the input arguments
176177
*
177178
INFO = 0
179+
K = MIN( M, N )
178180
NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 )
179-
LWKOPT = M*NB
180-
WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
181181
LQUERY = ( LWORK.EQ.-1 )
182182
IF( M.LT.0 ) THEN
183183
INFO = -1
184184
ELSE IF( N.LT.0 ) THEN
185185
INFO = -2
186186
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
187187
INFO = -4
188-
ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
189-
INFO = -7
188+
ELSE IF( .NOT.LQUERY ) THEN
189+
IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
190+
$ INFO = -7
190191
END IF
191192
IF( INFO.NE.0 ) THEN
192193
CALL XERBLA( 'CGELQF', -INFO )
193194
RETURN
194195
ELSE IF( LQUERY ) THEN
196+
IF( K.EQ.0 ) THEN
197+
LWKOPT = 1
198+
ELSE
199+
LWKOPT = M*NB
200+
END IF
201+
WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
195202
RETURN
196203
END IF
197204
*
198205
* Quick return if possible
199206
*
200-
K = MIN( M, N )
201207
IF( K.EQ.0 ) THEN
202208
WORK( 1 ) = 1
203209
RETURN
@@ -267,7 +273,7 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
267273
$ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
268274
$ IINFO )
269275
*
270-
WORK( 1 ) = SROUNDUP_LWORK(IWS)
276+
WORK( 1 ) = SROUNDUP_LWORK( IWS )
271277
RETURN
272278
*
273279
* End of CGELQF

‎lapack-netlib/SRC/cgemlq.f

Lines changed: 23 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -110,16 +110,17 @@
110110
*>
111111
*> \param[out] WORK
112112
*> \verbatim
113-
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
113+
*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
114+
*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK.
114115
*> \endverbatim
115116
*>
116117
*> \param[in] LWORK
117118
*> \verbatim
118119
*> LWORK is INTEGER
119-
*> The dimension of the array WORK.
120+
*> The dimension of the array WORK. LWORK >= 1.
120121
*> If LWORK = -1, then a workspace query is assumed. The routine
121122
*> only calculates the size of the WORK array, returns this
122-
*> value as WORK(1), and no error message related to WORK
123+
*> value as WORK(1), and no error message related to WORK
123124
*> is issued by XERBLA.
124125
*> \endverbatim
125126
*>
@@ -143,7 +144,7 @@
143144
*>
144145
*> \verbatim
145146
*>
146-
*> These details are particular for this LAPACK implementation. Users should not
147+
*> These details are particular for this LAPACK implementation. Users should not
147148
*> take them for granted. These details may change in the future, and are not likely
148149
*> true for another LAPACK implementation. These details are relevant if one wants
149150
*> to try to understand the code. They are not part of the interface.
@@ -159,11 +160,13 @@
159160
*> block sizes MB and NB returned by ILAENV, CGELQ will use either
160161
*> CLASWLQ (if the matrix is wide-and-short) or CGELQT to compute
161162
*> the LQ factorization.
162-
*> This version of CGEMLQ will use either CLAMSWLQ or CGEMLQT to
163+
*> This version of CGEMLQ will use either CLAMSWLQ or CGEMLQT to
163164
*> multiply matrix Q by another matrix.
164165
*> Further Details in CLAMSWLQ or CGEMLQT.
165166
*> \endverbatim
166167
*>
168+
*> \ingroup gemlq
169+
*>
167170
* =====================================================================
168171
SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
169172
$ C, LDC, WORK, LWORK, INFO )
@@ -185,11 +188,12 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
185188
* ..
186189
* .. Local Scalars ..
187190
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
188-
INTEGER MB, NB, LW, NBLCKS, MN
191+
INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN
189192
* ..
190193
* .. External Functions ..
191194
LOGICAL LSAME
192-
EXTERNAL LSAME
195+
REAL SROUNDUP_LWORK
196+
EXTERNAL LSAME, SROUNDUP_LWORK
193197
* ..
194198
* .. External Subroutines ..
195199
EXTERNAL CLAMSWLQ, CGEMLQT, XERBLA
@@ -201,7 +205,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
201205
*
202206
* Test the input arguments
203207
*
204-
LQUERY = LWORK.EQ.-1
208+
LQUERY = ( LWORK.EQ.-1 )
205209
NOTRAN = LSAME( TRANS, 'N' )
206210
TRAN = LSAME( TRANS, 'C' )
207211
LEFT = LSAME( SIDE, 'L' )
@@ -216,6 +220,13 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
216220
LW = M * MB
217221
MN = N
218222
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
219230
*
220231
IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
221232
IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
@@ -244,12 +255,12 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
244255
INFO = -9
245256
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
246257
INFO = -11
247-
ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
258+
ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN
248259
INFO = -13
249260
END IF
250261
*
251262
IF( INFO.EQ.0 ) THEN
252-
WORK( 1 ) = REAL( LW )
263+
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
253264
END IF
254265
*
255266
IF( INFO.NE.0 ) THEN
@@ -261,7 +272,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
261272
*
262273
* Quick return if possible
263274
*
264-
IF( MIN( M, N, K ).EQ.0 ) THEN
275+
IF( MINMNK.EQ.0 ) THEN
265276
RETURN
266277
END IF
267278
*
@@ -274,7 +285,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
274285
$ MB, C, LDC, WORK, LWORK, INFO )
275286
END IF
276287
*
277-
WORK( 1 ) = REAL( LW )
288+
WORK( 1 ) = SROUNDUP_LWORK( LWMIN )
278289
*
279290
RETURN
280291
*

0 commit comments

Comments
 (0)