183 SUBROUTINE clarzb( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
184 $ ldv, t, ldt, c, ldc, work, ldwork )
192 CHARACTER DIRECT, SIDE, STOREV, TRANS
193 INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
196 COMPLEX C( ldc, * ), T( ldt, * ), V( ldv, * ),
204 parameter ( one = ( 1.0e+0, 0.0e+0 ) )
221 IF( m.LE.0 .OR. n.LE.0 )
227 IF( .NOT.lsame( direct,
'B' ) )
THEN
229 ELSE IF( .NOT.lsame( storev,
'R' ) )
THEN
233 CALL xerbla(
'CLARZB', -info )
237 IF( lsame( trans,
'N' ) )
THEN
243 IF( lsame( side,
'L' ) )
THEN
250 CALL ccopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
257 $
CALL cgemm(
'Transpose',
'Conjugate transpose', n, k, l,
258 $ one, c( m-l+1, 1 ), ldc, v, ldv, one, work,
263 CALL ctrmm(
'Right',
'Lower', transt,
'Non-unit', n, k, one, t,
264 $ ldt, work, ldwork )
270 c( i, j ) = c( i, j ) - work( j, i )
278 $
CALL cgemm(
'Transpose',
'Transpose', l, n, k, -one, v, ldv,
279 $ work, ldwork, one, c( m-l+1, 1 ), ldc )
281 ELSE IF( lsame( side,
'R' ) )
THEN
288 CALL ccopy( m, c( 1, j ), 1, work( 1, j ), 1 )
295 $
CALL cgemm(
'No transpose',
'Transpose', m, k, l, one,
296 $ c( 1, n-l+1 ), ldc, v, ldv, one, work, ldwork )
302 CALL clacgv( k-j+1, t( j, j ), 1 )
304 CALL ctrmm(
'Right',
'Lower', trans,
'Non-unit', m, k, one, t,
305 $ ldt, work, ldwork )
307 CALL clacgv( k-j+1, t( j, j ), 1 )
314 c( i, j ) = c( i, j ) - work( i, j )
322 CALL clacgv( k, v( 1, j ), 1 )
325 $
CALL cgemm(
'No transpose',
'No transpose', m, l, k, -one,
326 $ work, ldwork, v, ldv, one, c( 1, n-l+1 ), ldc )
328 CALL clacgv( k, v( 1, j ), 1 )
subroutine clarzb(SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
CLARZB applies a block reflector or its conjugate-transpose to a general matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM