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 )
LOGICAL function lsame(CA, CB)
LSAME
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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