200 SUBROUTINE clamswlq( 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 COMPLEX 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,
'C' )
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(
'CLAMSWLQ', -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 cgemlqt( 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 ctpmlqt(
'L',
'C',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 ctpmlqt(
'L',
'C',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 cgemlqt(
'L',
'C',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 cgemlqt(
'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 ctpmlqt(
'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 ctpmlqt(
'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 ctpmlqt(
'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 ctpmlqt(
'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 )
375 CALL cgemlqt(
'R',
'N',m , nb, k, mb, a(1,1), lda, t
376 $ ,ldt ,c(1,1), ldc, work, info )
378 ELSE IF (right.AND.tran)
THEN
382 kk = mod((n-k),(nb-k))
385 CALL cgemlqt(
'R',
'C',m , nb, k, mb, a(1,1), lda, t
386 $ ,ldt ,c(1,1), ldc, work, info )
388 DO i=nb+1,ii-nb+k,(nb-k)
392 CALL ctpmlqt(
'R',
'C',m , nb-k, k, 0,mb, a(1,i), lda,
393 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
394 $ c(1,i), ldc, work, info )
402 CALL ctpmlqt(
'R',
'C',m , kk, k, 0,mb, a(1,ii), lda,
403 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
404 $ c(1,ii), ldc, work, info )
subroutine ctpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
subroutine clamswlq(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
subroutine cgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
subroutine xerbla(SRNAME, INFO)
XERBLA