179 SUBROUTINE zlarzb( 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*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
199 parameter( one = ( 1.0d+0, 0.0d+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(
'ZLARZB', -info )
232 IF( lsame( trans,
'N' ) )
THEN
238 IF( lsame( side,
'L' ) )
THEN
245 CALL zcopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
252 $
CALL zgemm(
'Transpose',
'Conjugate transpose', n, k, l,
253 $ one, c( m-l+1, 1 ), ldc, v, ldv, one, work,
258 CALL ztrmm(
'Right',
'Lower', transt,
'Non-unit', n, k, one,
260 $ ldt, work, ldwork )
266 c( i, j ) = c( i, j ) - work( j, i )
274 $
CALL zgemm(
'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 zcopy( m, c( 1, j ), 1, work( 1, j ), 1 )
292 $
CALL zgemm(
'No transpose',
'Transpose', m, k, l, one,
293 $ c( 1, n-l+1 ), ldc, v, ldv, one, work, ldwork )
299 CALL zlacgv( k-j+1, t( j, j ), 1 )
301 CALL ztrmm(
'Right',
'Lower', trans,
'Non-unit', m, k, one,
303 $ ldt, work, ldwork )
305 CALL zlacgv( k-j+1, t( j, j ), 1 )
312 c( i, j ) = c( i, j ) - work( i, j )
320 CALL zlacgv( k, v( 1, j ), 1 )
323 $
CALL zgemm(
'No transpose',
'No transpose', m, l, k,
325 $ work, ldwork, v, ldv, one, c( 1, n-l+1 ), ldc )
327 CALL zlacgv( k, v( 1, j ), 1 )
subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMM
subroutine zlarzb(side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, c, ldc, work, ldwork)
ZLARZB applies a block reflector or its conjugate-transpose to a general matrix.
subroutine ztrmm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
ZTRMM