183 SUBROUTINE zlarzb( 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*16 C( ldc, * ), T( ldt, * ), V( ldv, * ),
204 parameter ( one = ( 1.0d+0, 0.0d+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(
'ZLARZB', -info )
237 IF( lsame( trans,
'N' ) )
THEN
243 IF( lsame( side,
'L' ) )
THEN
250 CALL zcopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
257 $
CALL zgemm(
'Transpose',
'Conjugate transpose', n, k, l,
258 $ one, c( m-l+1, 1 ), ldc, v, ldv, one, work,
263 CALL ztrmm(
'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 zgemm(
'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 zcopy( m, c( 1, j ), 1, work( 1, j ), 1 )
295 $
CALL zgemm(
'No transpose',
'Transpose', m, k, l, one,
296 $ c( 1, n-l+1 ), ldc, v, ldv, one, work, ldwork )
302 CALL zlacgv( k-j+1, t( j, j ), 1 )
304 CALL ztrmm(
'Right',
'Lower', trans,
'Non-unit', m, k, one, t,
305 $ ldt, work, ldwork )
307 CALL zlacgv( k-j+1, t( j, j ), 1 )
314 c( i, j ) = c( i, j ) - work( i, j )
322 CALL zlacgv( k, v( 1, j ), 1 )
325 $
CALL zgemm(
'No transpose',
'No transpose', m, l, k, -one,
326 $ work, ldwork, v, ldv, one, c( 1, n-l+1 ), ldc )
328 CALL zlacgv( k, v( 1, j ), 1 )
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
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 xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.