195 SUBROUTINE slamtsqr( 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 REAL 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,
'T' )
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(
'SLAMTSQR', -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 sgemqrt( 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 stpmqrt(
'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 stpmqrt(
'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 sgemqrt(
'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 sgemqrt(
'L',
'T',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 stpmqrt(
'L',
'T',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 stpmqrt(
'L',
'T',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 stpmqrt(
'R',
'T',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 stpmqrt(
'R',
'T',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 )
378 CALL sgemqrt(
'R',
'T',m , mb, k, nb, a(1,1), lda, t
379 $ ,ldt ,c(1,1), ldc, work, info )
381 ELSE IF (right.AND.notran)
THEN
385 kk = mod((n-k),(mb-k))
388 CALL sgemqrt(
'R',
'N', m, mb , k, nb, a(1,1), lda, t
389 $ ,ldt ,c(1,1), ldc, work, info )
391 DO i=mb+1,ii-mb+k,(mb-k)
395 CALL stpmqrt(
'R',
'N', m, mb-k, k, 0,nb, a(i,1), lda,
396 $ t(1, ctr * k + 1),ldt, c(1,1), ldc,
397 $ c(1,i), ldc, work, info )
405 CALL stpmqrt(
'R',
'N', m, kk , k, 0,nb, a(ii,1), lda,
406 $ t(1, ctr * k + 1),ldt, c(1,1), ldc,
407 $ c(1,ii), ldc, work, info )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
SGEMQRT
subroutine stpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
STPMQRT
subroutine slamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
SLAMTSQR