195 SUBROUTINE clamtsqr( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
196 $ LDT, C, LDC, WORK, LWORK, INFO )
203 CHARACTER SIDE, TRANS
204 INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
207 COMPLEX A( LDA, * ), WORK( * ), C(LDC, * ),
215 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
216 INTEGER I, II, KK, LW, CTR, Q
229 notran = lsame( trans,
'N' )
230 tran = lsame( trans,
'C' )
231 left = lsame( side,
'L' )
232 right = lsame( side,
'R' )
242 IF( .NOT.left .AND. .NOT.right )
THEN
244 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
246 ELSE IF( m.LT.k )
THEN
248 ELSE IF( n.LT.0 )
THEN
250 ELSE IF( k.LT.0 )
THEN
252 ELSE IF( k.LT.nb .OR. nb.LT.1 )
THEN
254 ELSE IF( lda.LT.max( 1, q ) )
THEN
256 ELSE IF( ldt.LT.max( 1, nb) )
THEN
258 ELSE IF( ldc.LT.max( 1, m ) )
THEN
260 ELSE IF(( lwork.LT.max(1,lw)).AND.(.NOT.lquery))
THEN
271 CALL xerbla(
'CLAMTSQR', -info )
273 ELSE IF (lquery)
THEN
279 IF( min(m,n,k).EQ.0 )
THEN
283 IF((mb.LE.k).OR.(mb.GE.max(m,n,k)))
THEN
284 CALL cgemqrt( side, trans, m, n, k, nb, a, lda,
285 $ t, ldt, c, ldc, work, info)
289 IF(left.AND.notran)
THEN
293 kk = mod((m-k),(mb-k))
297 CALL ctpmqrt(
'L',
'N',kk , n, k, 0, nb, a(ii,1), lda,
298 $ t(1, ctr*k+1),ldt , c(1,1), ldc,
299 $ c(ii,1), ldc, work, info )
304 DO i=ii-(mb-k),mb+1,-(mb-k)
309 CALL ctpmqrt(
'L',
'N',mb-k , n, k, 0,nb, a(i,1), lda,
310 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
311 $ c(i,1), ldc, work, info )
317 CALL cgemqrt(
'L',
'N',mb , n, k, nb, a(1,1), lda, t
318 $ ,ldt ,c(1,1), ldc, work, info )
320 ELSE IF (left.AND.tran)
THEN
324 kk = mod((m-k),(mb-k))
327 CALL cgemqrt(
'L',
'C',mb , n, k, nb, a(1,1), lda, t
328 $ ,ldt ,c(1,1), ldc, work, info )
330 DO i=mb+1,ii-mb+k,(mb-k)
334 CALL ctpmqrt(
'L',
'C',mb-k , n, k, 0,nb, a(i,1), lda,
335 $ t(1, ctr*k+1),ldt, c(1,1), ldc,
336 $ c(i,1), ldc, work, info )
344 CALL ctpmqrt(
'L',
'C',kk , n, k, 0,nb, a(ii,1), lda,
345 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
346 $ c(ii,1), ldc, work, info )
350 ELSE IF(right.AND.tran)
THEN
354 kk = mod((n-k),(mb-k))
358 CALL ctpmqrt(
'R',
'C',m , kk, k, 0, nb, a(ii,1), lda,
359 $ t(1, ctr*k+1), ldt, c(1,1), ldc,
360 $ c(1,ii), ldc, work, info )
365 DO i=ii-(mb-k),mb+1,-(mb-k)
370 CALL ctpmqrt(
'R',
'C',m , mb-k, k, 0,nb, a(i,1), lda,
371 $ t(1,ctr*k+1), ldt, c(1,1), ldc,
372 $ c(1,i), ldc, work, info )
377 CALL cgemqrt(
'R',
'C',m , mb, k, nb, a(1,1), lda, t
378 $ ,ldt ,c(1,1), ldc, work, info )
380 ELSE IF (right.AND.notran)
THEN
384 kk = mod((n-k),(mb-k))
387 CALL cgemqrt(
'R',
'N', m, mb , k, nb, a(1,1), lda, t
388 $ ,ldt ,c(1,1), ldc, work, info )
390 DO i=mb+1,ii-mb+k,(mb-k)
394 CALL ctpmqrt(
'R',
'N', m, mb-k, k, 0,nb, a(i,1), lda,
395 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
396 $ c(1,i), ldc, work, info )
404 CALL ctpmqrt(
'R',
'N', m, kk , k, 0,nb, a(ii,1), lda,
405 $ t(1,ctr*k+1),ldt, c(1,1), ldc,
406 $ c(1,ii), ldc, work, info )
subroutine clamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
CLAMTSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
CGEMQRT
subroutine ctpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
CTPMQRT