195 SUBROUTINE dlamtsqr( 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 DOUBLE PRECISION 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,
'T' )
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(
'DLAMTSQR', -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 dgemqrt( 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 dtpmqrt(
'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 dtpmqrt(
'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 dgemqrt(
'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 dgemqrt(
'L',
'T',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 dtpmqrt(
'L',
'T',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 dtpmqrt(
'L',
'T',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 dtpmqrt(
'R',
'T',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 dtpmqrt(
'R',
'T',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 dgemqrt(
'R',
'T',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 dgemqrt(
'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 dtpmqrt(
'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 dtpmqrt(
'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 dgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
DGEMQRT
subroutine dtpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
DTPMQRT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)