200 SUBROUTINE slamswlq( 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 REAL A( lda, * ), WORK( * ), C(ldc, * ),
221 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
222 INTEGER I, II, KK, LW, CTR
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(
'SLAMSWLQ', -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))
296 CALL stpmlqt(
'L',
'T',kk , n, k, 0, mb, a(1,ii), lda,
297 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
298 $ c(ii,1), ldc, work, info )
303 DO i=ii-(nb-k),nb+1,-(nb-k)
308 CALL stpmlqt(
'L',
'T',nb-k , n, k, 0,mb, a(1,i), lda,
309 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
310 $ c(i,1), ldc, work, info )
315 CALL sgemlqt(
'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 sgemlqt(
'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 stpmlqt(
'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 stpmlqt(
'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 stpmlqt(
'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 stpmlqt(
'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 sgemlqt(
'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 sgemlqt(
'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 stpmlqt(
'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 stpmlqt(
'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 slamswlq(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
subroutine sgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
subroutine dgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
DGEMLQT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine stpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
DTPMLQT