179 SUBROUTINE clarzb( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
180 $ LDV, T, LDT, C, LDC, WORK, LDWORK )
187 CHARACTER DIRECT, SIDE, STOREV, TRANS
188 INTEGER K, L, LDC, LDT, LDV, LDWORK, M, N
191 COMPLEX C( LDC, * ), T( LDT, * ), V( LDV, * ),
199 parameter( one = ( 1.0e+0, 0.0e+0 ) )
216 IF( m.LE.0 .OR. n.LE.0 )
222 IF( .NOT.lsame( direct,
'B' ) )
THEN
224 ELSE IF( .NOT.lsame( storev,
'R' ) )
THEN
228 CALL xerbla(
'CLARZB', -info )
232 IF( lsame( trans,
'N' ) )
THEN
238 IF( lsame( side,
'L' ) )
THEN
245 CALL ccopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
252 $
CALL cgemm(
'Transpose',
'Conjugate transpose', n, k, l,
253 $ one, c( m-l+1, 1 ), ldc, v, ldv, one, work,
258 CALL ctrmm(
'Right',
'Lower', transt,
'Non-unit', n, k, one,
260 $ ldt, work, ldwork )
266 c( i, j ) = c( i, j ) - work( j, i )
274 $
CALL cgemm(
'Transpose',
'Transpose', l, n, k, -one, v,
276 $ work, ldwork, one, c( m-l+1, 1 ), ldc )
278 ELSE IF( lsame( side,
'R' ) )
THEN
285 CALL ccopy( m, c( 1, j ), 1, work( 1, j ), 1 )
292 $
CALL cgemm(
'No transpose',
'Transpose', m, k, l, one,
293 $ c( 1, n-l+1 ), ldc, v, ldv, one, work, ldwork )
299 CALL clacgv( k-j+1, t( j, j ), 1 )
301 CALL ctrmm(
'Right',
'Lower', trans,
'Non-unit', m, k, one,
303 $ ldt, work, ldwork )
305 CALL clacgv( k-j+1, t( j, j ), 1 )
312 c( i, j ) = c( i, j ) - work( i, j )
320 CALL clacgv( k, v( 1, j ), 1 )
323 $
CALL cgemm(
'No transpose',
'No transpose', m, l, k,
325 $ work, ldwork, v, ldv, one, c( 1, n-l+1 ), ldc )
327 CALL clacgv( k, v( 1, j ), 1 )
subroutine cgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
CGEMM
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 ctrmm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRMM