168 SUBROUTINE sgemqrt( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
169 $ c, ldc, work, info )
177 CHARACTER side, trans
178 INTEGER info, k, ldv, ldc, m, n, nb, ldt
181 REAL v( ldv, * ), c( ldc, * ), t( ldt, * ), work( * )
188 LOGICAL left, right, tran, notran
189 INTEGER i, ib, ldwork, kf, q
206 left =
lsame( side,
'L' )
207 right =
lsame( side,
'R' )
208 tran =
lsame( trans,
'T' )
209 notran =
lsame( trans,
'N' )
214 ELSE IF ( right )
THEN
218 IF( .NOT.left .AND. .NOT.right )
THEN
220 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
222 ELSE IF( m.LT.0 )
THEN
224 ELSE IF( n.LT.0 )
THEN
226 ELSE IF( k.LT.0 .OR. k.GT.q )
THEN
228 ELSE IF( nb.LT.1 .OR. (nb.GT.k .AND. k.GT.0))
THEN
230 ELSE IF( ldv.LT.max( 1, q ) )
THEN
232 ELSE IF( ldt.LT.nb )
THEN
234 ELSE IF( ldc.LT.max( 1, m ) )
THEN
239 CALL
xerbla(
'SGEMQRT', -info )
245 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
RETURN
247 IF( left .AND. tran )
THEN
250 ib = min( nb, k-i+1 )
251 CALL
slarfb(
'L',
'T',
'F',
'C', m-i+1, n, ib,
252 $ v( i, i ), ldv, t( 1, i ), ldt,
253 $ c( i, 1 ), ldc, work, ldwork )
256 ELSE IF( right .AND. notran )
THEN
259 ib = min( nb, k-i+1 )
260 CALL
slarfb(
'R',
'N',
'F',
'C', m, n-i+1, ib,
261 $ v( i, i ), ldv, t( 1, i ), ldt,
262 $ c( 1, i ), ldc, work, ldwork )
265 ELSE IF( left .AND. notran )
THEN
269 ib = min( nb, k-i+1 )
270 CALL
slarfb(
'L',
'N',
'F',
'C', m-i+1, n, ib,
271 $ v( i, i ), ldv, t( 1, i ), ldt,
272 $ c( i, 1 ), ldc, work, ldwork )
275 ELSE IF( right .AND. tran )
THEN
279 ib = min( nb, k-i+1 )
280 CALL
slarfb(
'R',
'T',
'F',
'C', m, n-i+1, ib,
281 $ v( i, i ), ldv, t( 1, i ), ldt,
282 $ c( 1, i ), ldc, work, ldwork )
subroutine sgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
SGEMQRT
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine slarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
SLARFB applies a block reflector or its transpose to a general rectangular matrix.