199 SUBROUTINE clamtsqr( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
200 $ LDT, C, LDC, WORK, LWORK, INFO )
207 CHARACTER SIDE, TRANS
208 INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
211 COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ),
219 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
220 INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN
225 EXTERNAL lsame, sroundup_lwork
235 lquery = ( lwork.EQ.-1 )
236 notran = lsame( trans,
'N' )
237 tran = lsame( trans,
'C' )
238 left = lsame( side,
'L' )
239 right = lsame( side,
'R' )
248 minmnk = min( m, n, k )
249 IF( minmnk.EQ.0 )
THEN
255 IF( .NOT.left .AND. .NOT.right )
THEN
257 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
259 ELSE IF( m.LT.k )
THEN
261 ELSE IF( n.LT.0 )
THEN
263 ELSE IF( k.LT.0 )
THEN
265 ELSE IF( k.LT.nb .OR. nb.LT.1 )
THEN
267 ELSE IF( lda.LT.max( 1, q ) )
THEN
269 ELSE IF( ldt.LT.max( 1, nb ) )
THEN
271 ELSE IF( ldc.LT.max( 1, m ) )
THEN
273 ELSE IF( lwork.LT.lwmin .AND. (.NOT.lquery) )
THEN
278 work( 1 ) = sroundup_lwork( lwmin )
282 CALL xerbla(
'CLAMTSQR', -info )
284 ELSE IF( lquery )
THEN
290 IF( minmnk.EQ.0 )
THEN
296 IF((mb.LE.k).OR.(mb.GE.max(m,n,k)))
THEN
297 CALL cgemqrt( side, trans, m, n, k, nb, a, lda,
298 $ t, ldt, c, ldc, work, info )
302 IF(left.AND.notran)
THEN
306 kk = mod((m-k),(mb-k))
310 CALL ctpmqrt(
'L',
'N',kk , n, k, 0, nb, a(ii,1), lda,
311 $ t(1, ctr*k+1),ldt , c(1,1), ldc,
312 $ c(ii,1), ldc, work, info )
317 DO i=ii-(mb-k),mb+1,-(mb-k)
322 CALL ctpmqrt(
'L',
'N',mb-k , n, k, 0,nb, a(i,1), lda,
323 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
324 $ c(i,1), ldc, work, info )
330 CALL cgemqrt(
'L',
'N',mb , n, k, nb, a(1,1), lda, t
331 $ ,ldt ,c(1,1), ldc, work, info )
333 ELSE IF (left.AND.tran)
THEN
337 kk = mod((m-k),(mb-k))
340 CALL cgemqrt(
'L',
'C',mb , n, k, nb, a(1,1), lda, t
341 $ ,ldt ,c(1,1), ldc, work, info )
343 DO i=mb+1,ii-mb+k,(mb-k)
347 CALL ctpmqrt(
'L',
'C',mb-k , n, k, 0,nb, a(i,1), lda,
348 $ t(1, ctr*k+1),ldt, c(1,1), ldc,
349 $ c(i,1), ldc, work, info )
357 CALL ctpmqrt(
'L',
'C',kk , n, k, 0,nb, a(ii,1), lda,
358 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
359 $ c(ii,1), ldc, work, info )
363 ELSE IF(right.AND.tran)
THEN
367 kk = mod((n-k),(mb-k))
371 CALL ctpmqrt(
'R',
'C',m , kk, k, 0, nb, a(ii,1), lda,
372 $ t(1, ctr*k+1), ldt, c(1,1), ldc,
373 $ c(1,ii), ldc, work, info )
378 DO i=ii-(mb-k),mb+1,-(mb-k)
383 CALL ctpmqrt(
'R',
'C',m , mb-k, k, 0,nb, a(i,1), lda,
384 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
385 $ c(1,i), ldc, work, info )
390 CALL cgemqrt(
'R',
'C',m , mb, k, nb, a(1,1), lda, t
391 $ ,ldt ,c(1,1), ldc, work, info )
393 ELSE IF (right.AND.notran)
THEN
397 kk = mod((n-k),(mb-k))
400 CALL cgemqrt(
'R',
'N', m, mb , k, nb, a(1,1), lda, t
401 $ ,ldt ,c(1,1), ldc, work, info )
403 DO i=mb+1,ii-mb+k,(mb-k)
407 CALL ctpmqrt(
'R',
'N', m, mb-k, k, 0,nb, a(i,1), lda,
408 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
409 $ c(1,i), ldc, work, info )
417 CALL ctpmqrt(
'R',
'N', m, kk , k, 0,nb, a(ii,1), lda,
418 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
419 $ c(1,ii), ldc, work, info )
425 work( 1 ) = sroundup_lwork( lwmin )