195 SUBROUTINE clamtsqr( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
196 $ ldt, c, ldc, work, lwork, info )
204 CHARACTER SIDE, TRANS
205 INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
208 COMPLEX A( lda, * ), WORK( * ), C(ldc, * ),
216 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
217 INTEGER I, II, KK, LW, CTR
230 notran = lsame( trans,
'N' )
231 tran = lsame( trans,
'C' )
232 left = lsame( side,
'L' )
233 right = lsame( side,
'R' )
241 IF( .NOT.left .AND. .NOT.right )
THEN
243 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
245 ELSE IF( m.LT.0 )
THEN
247 ELSE IF( n.LT.0 )
THEN
249 ELSE IF( k.LT.0 )
THEN
251 ELSE IF( lda.LT.max( 1, k ) )
THEN
253 ELSE IF( ldt.LT.max( 1, nb) )
THEN
255 ELSE IF( ldc.LT.max( 1, m ) )
THEN
257 ELSE IF(( lwork.LT.max(1,lw)).AND.(.NOT.lquery))
THEN
268 CALL xerbla(
'CLAMTSQR', -info )
270 ELSE IF (lquery)
THEN
276 IF( min(m,n,k).EQ.0 )
THEN
280 IF((mb.LE.k).OR.(mb.GE.max(m,n,k)))
THEN
281 CALL cgemqrt( side, trans, m, n, k, nb, a, lda,
282 $ t, ldt, c, ldc, work, info)
286 IF(left.AND.notran)
THEN
290 kk = mod((m-k),(mb-k))
294 CALL ctpmqrt(
'L',
'N',kk , n, k, 0, nb, a(ii,1), lda,
295 $ t(1, ctr*k+1),ldt , c(1,1), ldc,
296 $ c(ii,1), ldc, work, info )
301 DO i=ii-(mb-k),mb+1,-(mb-k)
306 CALL ctpmqrt(
'L',
'N',mb-k , n, k, 0,nb, a(i,1), lda,
307 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
308 $ c(i,1), ldc, work, info )
314 CALL cgemqrt(
'L',
'N',mb , n, k, nb, a(1,1), lda, t
315 $ ,ldt ,c(1,1), ldc, work, info )
317 ELSE IF (left.AND.tran)
THEN
321 kk = mod((m-k),(mb-k))
324 CALL cgemqrt(
'L',
'C',mb , n, k, nb, a(1,1), lda, t
325 $ ,ldt ,c(1,1), ldc, work, info )
327 DO i=mb+1,ii-mb+k,(mb-k)
331 CALL ctpmqrt(
'L',
'C',mb-k , n, k, 0,nb, a(i,1), lda,
332 $ t(1, ctr*k+1),ldt, c(1,1), ldc,
333 $ c(i,1), ldc, work, info )
341 CALL ctpmqrt(
'L',
'C',kk , n, k, 0,nb, a(ii,1), lda,
342 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
343 $ c(ii,1), ldc, work, info )
347 ELSE IF(right.AND.tran)
THEN
351 kk = mod((n-k),(mb-k))
355 CALL ctpmqrt(
'R',
'C',m , kk, k, 0, nb, a(ii,1), lda,
356 $ t(1, ctr*k+1), ldt, c(1,1), ldc,
357 $ c(1,ii), ldc, work, info )
362 DO i=ii-(mb-k),mb+1,-(mb-k)
367 CALL ctpmqrt(
'R',
'C',m , mb-k, k, 0,nb, a(i,1), lda,
368 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
369 $ c(1,i), ldc, work, info )
374 CALL cgemqrt(
'R',
'C',m , mb, k, nb, a(1,1), lda, t
375 $ ,ldt ,c(1,1), ldc, work, info )
377 ELSE IF (right.AND.notran)
THEN
381 kk = mod((n-k),(mb-k))
384 CALL cgemqrt(
'R',
'N', m, mb , k, nb, a(1,1), lda, t
385 $ ,ldt ,c(1,1), ldc, work, info )
387 DO i=mb+1,ii-mb+k,(mb-k)
391 CALL ctpmqrt(
'R',
'N', m, mb-k, k, 0,nb, a(i,1), lda,
392 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
393 $ c(1,i), ldc, work, info )
401 CALL ctpmqrt(
'R',
'N', m, kk , k, 0,nb, a(ii,1), lda,
402 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
403 $ c(1,ii), ldc, work, info )
subroutine clamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
subroutine cgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
CGEMQRT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
CTPMQRT