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 zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
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