195 SUBROUTINE slamtsqr( 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 REAL 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(
'SLAMTSQR', -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 sgemqrt( 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 stpmqrt(
'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 stpmqrt(
'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 sgemqrt(
'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 sgemqrt(
'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 stpmqrt(
'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 stpmqrt(
'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 stpmqrt(
'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 stpmqrt(
'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 sgemqrt(
'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 sgemqrt(
'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 stpmqrt(
'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 stpmqrt(
'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 slamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
subroutine stpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
STPMQRT
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
SGEMQRT