126 $ st, ed, sweep, n, nb, ib,
127 $ a, lda, v, tau, ldvt, work)
139 INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
142 REAL A( lda, * ), V( * ),
143 $ tau( * ), work( * )
150 parameter ( zero = 0.0e+0,
155 INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS,
156 $ dpos, ofdpos, ajeter
172 upper = lsame( uplo,
'U' )
188 vpos = mod( sweep-1, 2 ) * n + st
189 taupos = mod( sweep-1, 2 ) * n + st
191 vpos = mod( sweep-1, 2 ) * n + st
192 taupos = mod( sweep-1, 2 ) * n + st
195 IF( ttype.EQ.1 )
THEN
200 v( vpos+i ) = ( a( ofdpos-i, st+i ) )
201 a( ofdpos-i, st+i ) = zero
203 ctmp = ( a( ofdpos, st ) )
204 CALL slarfg( lm, ctmp, v( vpos+1 ), 1,
206 a( ofdpos, st ) = ctmp
209 CALL slarfy( uplo, lm, v( vpos ), 1,
211 $ a( dpos, st ), lda-1, work)
214 IF( ttype.EQ.3 )
THEN
217 CALL slarfy( uplo, lm, v( vpos ), 1,
219 $ a( dpos, st ), lda-1, work)
222 IF( ttype.EQ.2 )
THEN
228 CALL slarfx(
'Left', ln, lm, v( vpos ),
230 $ a( dpos-nb, j1 ), lda-1, work)
233 vpos = mod( sweep-1, 2 ) * n + j1
234 taupos = mod( sweep-1, 2 ) * n + j1
236 vpos = mod( sweep-1, 2 ) * n + j1
237 taupos = mod( sweep-1, 2 ) * n + j1
243 $ ( a( dpos-nb-i, j1+i ) )
244 a( dpos-nb-i, j1+i ) = zero
246 ctmp = ( a( dpos-nb, j1 ) )
247 CALL slarfg( lm, ctmp, v( vpos+1 ), 1, tau( taupos ) )
248 a( dpos-nb, j1 ) = ctmp
250 CALL slarfx(
'Right', ln-1, lm, v( vpos ),
252 $ a( dpos-nb+1, j1 ), lda-1, work)
261 vpos = mod( sweep-1, 2 ) * n + st
262 taupos = mod( sweep-1, 2 ) * n + st
264 vpos = mod( sweep-1, 2 ) * n + st
265 taupos = mod( sweep-1, 2 ) * n + st
268 IF( ttype.EQ.1 )
THEN
273 v( vpos+i ) = a( ofdpos+i, st-1 )
274 a( ofdpos+i, st-1 ) = zero
276 CALL slarfg( lm, a( ofdpos, st-1 ), v( vpos+1 ), 1,
281 CALL slarfy( uplo, lm, v( vpos ), 1,
283 $ a( dpos, st ), lda-1, work)
287 IF( ttype.EQ.3 )
THEN
290 CALL slarfy( uplo, lm, v( vpos ), 1,
292 $ a( dpos, st ), lda-1, work)
296 IF( ttype.EQ.2 )
THEN
303 CALL slarfx(
'Right', lm, ln, v( vpos ),
304 $ tau( taupos ), a( dpos+nb, st ),
308 vpos = mod( sweep-1, 2 ) * n + j1
309 taupos = mod( sweep-1, 2 ) * n + j1
311 vpos = mod( sweep-1, 2 ) * n + j1
312 taupos = mod( sweep-1, 2 ) * n + j1
317 v( vpos+i ) = a( dpos+nb+i, st )
318 a( dpos+nb+i, st ) = zero
320 CALL slarfg( lm, a( dpos+nb, st ), v( vpos+1 ), 1,
323 CALL slarfx(
'Left', lm, ln-1, v( vpos ),
325 $ a( dpos+nb-1, st+1 ), lda-1, work)
subroutine ssb2st_kernels(UPLO, WANTZ, TTYPE, ST, ED, SWEEP, N, NB, IB, A, LDA, V, TAU, LDVT, WORK)
SSB2ST_KERNELS
subroutine slarfx(SIDE, M, N, V, TAU, C, LDC, WORK)
SLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...
subroutine slarfy(UPLO, N, V, INCV, TAU, C, LDC, WORK)
SLARFY
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).