178 SUBROUTINE slahr2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
185 INTEGER K, LDA, LDT, LDY, N, NB
188 REAL A( LDA, * ), T( LDT, NB ), TAU( NB ),
196 parameter( zero = 0.0e+0,
224 CALL sgemv(
'NO TRANSPOSE', n-k, i-1, -one, y(k+1,1),
226 $ a( k+i-1, 1 ), lda, one, a( k+1, i ), 1 )
238 CALL scopy( i-1, a( k+1, i ), 1, t( 1, nb ), 1 )
239 CALL strmv(
'Lower',
'Transpose',
'UNIT',
241 $ lda, t( 1, nb ), 1 )
245 CALL sgemv(
'Transpose', n-k-i+1, i-1,
247 $ lda, a( k+i, i ), 1, one, t( 1, nb ), 1 )
251 CALL strmv(
'Upper',
'Transpose',
'NON-UNIT',
257 CALL sgemv(
'NO TRANSPOSE', n-k-i+1, i-1, -one,
259 $ lda, t( 1, nb ), 1, one, a( k+i, i ), 1 )
263 CALL strmv(
'Lower',
'NO TRANSPOSE',
265 $ a( k+1, 1 ), lda, t( 1, nb ), 1 )
266 CALL saxpy( i-1, -one, t( 1, nb ), 1, a( k+1, i ), 1 )
274 CALL slarfg( n-k-i+1, a( k+i, i ), a( min( k+i+1, n ), i ),
282 CALL sgemv(
'NO TRANSPOSE', n-k, n-k-i+1,
283 $ one, a( k+1, i+1 ),
284 $ lda, a( k+i, i ), 1, zero, y( k+1, i ), 1 )
285 CALL sgemv(
'Transpose', n-k-i+1, i-1,
286 $ one, a( k+i, 1 ), lda,
287 $ a( k+i, i ), 1, zero, t( 1, i ), 1 )
288 CALL sgemv(
'NO TRANSPOSE', n-k, i-1, -one,
290 $ t( 1, i ), 1, one, y( k+1, i ), 1 )
291 CALL sscal( n-k, tau( i ), y( k+1, i ), 1 )
295 CALL sscal( i-1, -tau( i ), t( 1, i ), 1 )
296 CALL strmv(
'Upper',
'No Transpose',
'NON-UNIT',
306 CALL slacpy(
'ALL', k, nb, a( 1, 2 ), lda, y, ldy )
307 CALL strmm(
'RIGHT',
'Lower',
'NO TRANSPOSE',
309 $ one, a( k+1, 1 ), lda, y, ldy )
311 $
CALL sgemm(
'NO TRANSPOSE',
'NO TRANSPOSE', k,
313 $ a( 1, 2+nb ), lda, a( k+1+nb, 1 ), lda, one, y,
315 CALL strmm(
'RIGHT',
'Upper',
'NO TRANSPOSE',
317 $ one, t, ldt, y, ldy )
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
subroutine slahr2(n, k, nb, a, lda, tau, t, ldt, y, ldy)
SLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elemen...