183 SUBROUTINE dlarzb( 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 DOUBLE PRECISION C( ldc, * ), T( ldt, * ), V( ldv, * ),
204 parameter( one = 1.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(
'DLARZB', -info )
237 IF( lsame( trans,
'N' ) )
THEN
243 IF( lsame( side,
'L' ) )
THEN
250 CALL
dcopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
257 $ CALL
dgemm(
'Transpose',
'Transpose', n, k, l, one,
258 $ c( m-l+1, 1 ), ldc, v, ldv, one, work, ldwork )
262 CALL
dtrmm(
'Right',
'Lower', transt,
'Non-unit', n, k, one, t,
263 $ ldt, work, ldwork )
269 c( i, j ) = c( i, j ) - work( j, i )
277 $ CALL
dgemm(
'Transpose',
'Transpose', l, n, k, -one, v, ldv,
278 $ work, ldwork, one, c( m-l+1, 1 ), ldc )
280 ELSE IF( lsame( side,
'R' ) )
THEN
287 CALL
dcopy( m, c( 1, j ), 1, work( 1, j ), 1 )
294 $ CALL
dgemm(
'No transpose',
'Transpose', m, k, l, one,
295 $ c( 1, n-l+1 ), ldc, v, ldv, one, work, ldwork )
299 CALL
dtrmm(
'Right',
'Lower', trans,
'Non-unit', m, k, one, t,
300 $ ldt, work, ldwork )
306 c( i, j ) = c( i, j ) - work( i, j )
314 $ CALL
dgemm(
'No transpose',
'No transpose', m, l, k, -one,
315 $ work, ldwork, v, ldv, one, c( 1, n-l+1 ), ldc )
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlarzb(SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
DLARZB applies a block reflector or its transpose to a general matrix.
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM