151 SUBROUTINE cgemlqt( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
152 $ c, ldc, work, info )
160 CHARACTER SIDE, TRANS
161 INTEGER INFO, K, LDV, LDC, M, N, MB, LDT
164 COMPLEX V( ldv, * ), C( ldc, * ), T( ldt, * ), WORK( * )
171 LOGICAL LEFT, RIGHT, TRAN, NOTRAN
172 INTEGER I, IB, LDWORK, KF, Q
189 left = lsame( side,
'L' )
190 right = lsame( side,
'R' )
191 tran = lsame( trans,
'C' )
192 notran = lsame( trans,
'N' )
196 ELSE IF ( right )
THEN
199 IF( .NOT.left .AND. .NOT.right )
THEN
201 ELSE IF( .NOT.tran .AND. .NOT.notran )
THEN
203 ELSE IF( m.LT.0 )
THEN
205 ELSE IF( n.LT.0 )
THEN
207 ELSE IF( k.LT.0)
THEN
209 ELSE IF( mb.LT.1 .OR. (mb.GT.k .AND. k.GT.0))
THEN
211 ELSE IF( ldv.LT.max( 1, k ) )
THEN
213 ELSE IF( ldt.LT.mb )
THEN
215 ELSE IF( ldc.LT.max( 1, m ) )
THEN
220 CALL xerbla(
'CGEMLQT', -info )
226 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
RETURN
228 IF( left .AND. notran )
THEN
231 ib = min( mb, k-i+1 )
232 CALL clarfb(
'L',
'C',
'F',
'R', m-i+1, n, ib,
233 $ v( i, i ), ldv, t( 1, i ), ldt,
234 $ c( i, 1 ), ldc, work, ldwork )
237 ELSE IF( right .AND. tran )
THEN
240 ib = min( mb, k-i+1 )
241 CALL clarfb(
'R',
'N',
'F',
'R', m, n-i+1, ib,
242 $ v( i, i ), ldv, t( 1, i ), ldt,
243 $ c( 1, i ), ldc, work, ldwork )
246 ELSE IF( left .AND. tran )
THEN
250 ib = min( mb, k-i+1 )
251 CALL clarfb(
'L',
'N',
'F',
'R', 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
260 ib = min( mb, k-i+1 )
261 CALL clarfb(
'R',
'C',
'F',
'R', m, n-i+1, ib,
262 $ v( i, i ), ldv, t( 1, i ), ldt,
263 $ c( 1, i ), ldc, work, ldwork )
subroutine cgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...