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