1 SUBROUTINE dlabrd( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
10 INTEGER LDA, LDX, LDY, M, N, NB
13 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
14 $ tauq( * ), x( ldx, * ), y( ldy, * )
139 DOUBLE PRECISION ZERO, ONE
140 parameter( zero = 0.0d0, one = 1.0d0 )
155 IF( m.LE.0 .OR. n.LE.0 )
166 CALL dgemv(
'No transpose', m-i+1, i-1, -one, a( i, 1 ),
167 $ lda, y( i, 1 ), ldy, one, a( i, i ), 1 )
168 CALL dgemv(
'No transpose', m-i+1, i-1, -one, x( i, 1 ),
169 $ ldx, a( 1, i ), 1, one, a( i, i ), 1 )
173 CALL dlarfg( m-i+1, a( i, i ), a( min( i+1, m ), i ), 1,
181 CALL dgemv(
'Transpose', m-i+1, n-i, one, a( i, i+1 ),
182 $ lda, a( i, i ), 1, zero, y( i+1, i ), 1 )
183 CALL dgemv(
'Transpose', m-i+1, i-1, one, a( i, 1 ), lda,
184 $ a( i, i ), 1, zero, y( 1, i ), 1 )
185 CALL dgemv(
'No transpose', n-i, i-1, -one, y( i+1, 1 ),
186 $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
187 CALL dgemv(
'Transpose', m-i+1, i-1, one, x( i, 1 ), ldx,
188 $ a( i, i ), 1, zero, y( 1, i ), 1 )
189 CALL dgemv(
'Transpose', i-1, n-i, -one, a( 1, i+1 ),
190 $ lda, y( 1, i ), 1, one, y( i+1, i ), 1 )
191 CALL dscal( n-i, tauq( i ), y( i+1, i ), 1 )
195 CALL dgemv(
'No transpose', n-i, i, -one, y( i+1, 1 ),
196 $ ldy, a( i, 1 ), lda, one, a( i, i+1 ), lda )
197 CALL dgemv(
'Transpose', i-1, n-i, -one, a( 1, i+1 ),
198 $ lda, x( i, 1 ), ldx, one, a( i, i+1 ), lda )
202 CALL dlarfg( n-i, a( i, i+1 ), a( i, min( i+2, n ) ),
209 CALL dgemv(
'No transpose', m-i, n-i, one, a( i+1, i+1 ),
210 $ lda, a( i, i+1 ), lda, zero, x( i+1, i ), 1 )
211 CALL dgemv(
'Transpose', n-i, i, one, y( i+1, 1 ), ldy,
212 $ a( i, i+1 ), lda, zero, x( 1, i ), 1 )
213 CALL dgemv(
'No transpose', m-i, i, -one, a( i+1, 1 ),
214 $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
215 CALL dgemv(
'No transpose', i-1, n-i, one, a( 1, i+1 ),
216 $ lda, a( i, i+1 ), lda, zero, x( 1, i ), 1 )
217 CALL dgemv(
'No transpose', m-i, i-1, -one, x( i+1, 1 ),
218 $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
219 CALL dscal( m-i, taup( i ), x( i+1, i ), 1 )
230 CALL dgemv(
'No transpose', n-i+1, i-1, -one, y( i, 1 ),
231 $ ldy, a( i, 1 ), lda, one, a( i, i ), lda )
232 CALL dgemv(
'Transpose', i-1, n-i+1, -one, a( 1, i ), lda,
233 $ x( i, 1 ), ldx, one, a( i, i ), lda )
237 CALL dlarfg( n-i+1, a( i, i ), a( i, min( i+1, n ) ), lda,
245 CALL dgemv(
'No transpose', m-i, n-i+1, one, a( i+1, i ),
246 $ lda, a( i, i ), lda, zero, x( i+1, i ), 1 )
247 CALL dgemv(
'Transpose', n-i+1, i-1, one, y( i, 1 ), ldy,
248 $ a( i, i ), lda, zero, x( 1, i ), 1 )
249 CALL dgemv(
'No transpose', m-i, i-1, -one, a( i+1, 1 ),
250 $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
251 CALL dgemv(
'No transpose', i-1, n-i+1, one, a( 1, i ),
252 $ lda, a( i, i ), lda, zero, x( 1, i ), 1 )
253 CALL dgemv(
'No transpose', m-i, i-1, -one, x( i+1, 1 ),
254 $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
255 CALL dscal( m-i, taup( i ), x( i+1, i ), 1 )
259 CALL dgemv(
'No transpose', m-i, i-1, -one, a( i+1, 1 ),
260 $ lda, y( i, 1 ), ldy, one, a( i+1, i ), 1 )
261 CALL dgemv(
'No transpose', m-i, i, -one, x( i+1, 1 ),
262 $ ldx, a( 1, i ), 1, one, a( i+1, i ), 1 )
266 CALL dlarfg( m-i, a( i+1, i ), a( min( i+2, m ), i ), 1,
273 CALL dgemv(
'Transpose', m-i, n-i, one, a( i+1, i+1 ),
274 $ lda, a( i+1, i ), 1, zero, y( i+1, i ), 1 )
275 CALL dgemv(
'Transpose', m-i, i-1, one, a( i+1, 1 ), lda,
276 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
277 CALL dgemv(
'No transpose', n-i, i-1, -one, y( i+1, 1 ),
278 $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
279 CALL dgemv(
'Transpose', m-i, i, one, x( i+1, 1 ), ldx,
280 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
281 CALL dgemv(
'Transpose', i, n-i, -one, a( 1, i+1 ), lda,
282 $ y( 1, i ), 1, one, y( i+1, i ), 1 )
283 CALL dscal( n-i, tauq( i ), y( i+1, i ), 1 )
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dlabrd(M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY)
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
subroutine dscal(n, da, dx, incx)