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 DOUBLE PRECISION A( lda, * ), V( * ),
143 $ tau( * ), work( * )
149 DOUBLE PRECISION ZERO, ONE
150 parameter ( zero = 0.0d+0,
155 INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS,
156 $ dpos, ofdpos, ajeter
157 DOUBLE PRECISION CTMP
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 dlarfg( lm, ctmp, v( vpos+1 ), 1,
206 a( ofdpos, st ) = ctmp
209 CALL dlarfy( uplo, lm, v( vpos ), 1,
211 $ a( dpos, st ), lda-1, work)
214 IF( ttype.EQ.3 )
THEN
217 CALL dlarfy( uplo, lm, v( vpos ), 1,
219 $ a( dpos, st ), lda-1, work)
222 IF( ttype.EQ.2 )
THEN
228 CALL dlarfx(
'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 dlarfg( lm, ctmp, v( vpos+1 ), 1, tau( taupos ) )
248 a( dpos-nb, j1 ) = ctmp
250 CALL dlarfx(
'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 dlarfg( lm, a( ofdpos, st-1 ), v( vpos+1 ), 1,
281 CALL dlarfy( uplo, lm, v( vpos ), 1,
283 $ a( dpos, st ), lda-1, work)
287 IF( ttype.EQ.3 )
THEN
290 CALL dlarfy( uplo, lm, v( vpos ), 1,
292 $ a( dpos, st ), lda-1, work)
296 IF( ttype.EQ.2 )
THEN
303 CALL dlarfx(
'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 dlarfg( lm, a( dpos+nb, st ), v( vpos+1 ), 1,
323 CALL dlarfx(
'Left', lm, ln-1, v( vpos ),
325 $ a( dpos+nb-1, st+1 ), lda-1, work)
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dsb2st_kernels(UPLO, WANTZ, TTYPE, ST, ED, SWEEP, N, NB, IB, A, LDA, V, TAU, LDVT, WORK)
DSB2ST_KERNELS
subroutine dlarfy(UPLO, N, V, INCV, TAU, C, LDC, WORK)
DLARFY
subroutine dlarfx(SIDE, M, N, V, TAU, C, LDC, WORK)
DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...