200 SUBROUTINE dlamswlq( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
201 $ ldt, c, ldc, work, lwork, info )
209 CHARACTER SIDE, TRANS
210 INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
213 DOUBLE PRECISION A( lda, * ), WORK( * ), C(ldc, * ),
221 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
222 INTEGER I, II, KK, CTR, LW
235 notran = lsame( trans,
'N' )
236 tran = lsame( trans,
'T' )
237 left = lsame( side,
'L' )
238 right = lsame( side,
'R' )
246 IF( .NOT.left .AND. .NOT.right )
THEN
248 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
250 ELSE IF( m.LT.0 )
THEN
252 ELSE IF( n.LT.0 )
THEN
254 ELSE IF( k.LT.0 )
THEN
256 ELSE IF( lda.LT.max( 1, k ) )
THEN
258 ELSE IF( ldt.LT.max( 1, mb) )
THEN
260 ELSE IF( ldc.LT.max( 1, m ) )
THEN
262 ELSE IF(( lwork.LT.max(1,lw)).AND.(.NOT.lquery))
THEN
267 CALL xerbla(
'DLAMSWLQ', -info )
270 ELSE IF (lquery)
THEN
277 IF( min(m,n,k).EQ.0 )
THEN
281 IF((nb.LE.k).OR.(nb.GE.max(m,n,k)))
THEN
282 CALL dgemlqt( side, trans, m, n, k, mb, a, lda,
283 $ t, ldt, c, ldc, work, info)
287 IF(left.AND.tran)
THEN
291 kk = mod((m-k),(nb-k))
295 CALL dtpmlqt(
'L',
'T',kk , n, k, 0, mb, a(1,ii), lda,
296 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
297 $ c(ii,1), ldc, work, info )
302 DO i=ii-(nb-k),nb+1,-(nb-k)
307 CALL dtpmlqt(
'L',
'T',nb-k , n, k, 0,mb, a(1,i), lda,
308 $ t(1, ctr*k+1),ldt, c(1,1), ldc,
309 $ c(i,1), ldc, work, info )
315 CALL dgemlqt(
'L',
'T',nb , n, k, mb, a(1,1), lda, t
316 $ ,ldt ,c(1,1), ldc, work, info )
318 ELSE IF (left.AND.notran)
THEN
322 kk = mod((m-k),(nb-k))
325 CALL dgemlqt(
'L',
'N',nb , n, k, mb, a(1,1), lda, t
326 $ ,ldt ,c(1,1), ldc, work, info )
328 DO i=nb+1,ii-nb+k,(nb-k)
332 CALL dtpmlqt(
'L',
'N',nb-k , n, k, 0,mb, a(1,i), lda,
333 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
334 $ c(i,1), ldc, work, info )
342 CALL dtpmlqt(
'L',
'N',kk , n, k, 0, mb, a(1,ii), lda,
343 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
344 $ c(ii,1), ldc, work, info )
348 ELSE IF(right.AND.notran)
THEN
352 kk = mod((n-k),(nb-k))
356 CALL dtpmlqt(
'R',
'N',m , kk, k, 0, mb, a(1, ii), lda,
357 $ t(1,ctr *k+1), ldt, c(1,1), ldc,
358 $ c(1,ii), ldc, work, info )
363 DO i=ii-(nb-k),nb+1,-(nb-k)
368 CALL dtpmlqt(
'R',
'N', m, nb-k, k, 0, mb, a(1, i), lda,
369 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
370 $ c(1,i), ldc, work, info )
376 CALL dgemlqt(
'R',
'N',m , nb, k, mb, a(1,1), lda, t
377 $ ,ldt ,c(1,1), ldc, work, info )
379 ELSE IF (right.AND.tran)
THEN
383 kk = mod((n-k),(nb-k))
386 CALL dgemlqt(
'R',
'T',m , nb, k, mb, a(1,1), lda, t
387 $ ,ldt ,c(1,1), ldc, work, info )
389 DO i=nb+1,ii-nb+k,(nb-k)
393 CALL dtpmlqt(
'R',
'T',m , nb-k, k, 0,mb, a(1,i), lda,
394 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
395 $ c(1,i), ldc, work, info )
403 CALL dtpmlqt(
'R',
'T',m , kk, k, 0,mb, a(1,ii), lda,
404 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
405 $ c(1,ii), ldc, work, info )
subroutine dlamswlq(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
subroutine dgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
DGEMLQT
subroutine dtpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
DTPMLQT
subroutine xerbla(SRNAME, INFO)
XERBLA