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 COMPLEX A( lda, * ), V( * ),
143 $ tau( * ), work( * )
150 parameter ( zero = ( 0.0e+0, 0.0e+0 ),
151 $ one = ( 1.0e+0, 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 ) = conjg( a( ofdpos-i, st+i ) )
201 a( ofdpos-i, st+i ) = zero
203 ctmp = conjg( a( ofdpos, st ) )
204 CALL clarfg( lm, ctmp, v( vpos+1 ), 1,
206 a( ofdpos, st ) = ctmp
209 CALL clarfy( uplo, lm, v( vpos ), 1,
210 $ conjg( tau( taupos ) ),
211 $ a( dpos, st ), lda-1, work)
214 IF( ttype.EQ.3 )
THEN
217 CALL clarfy( uplo, lm, v( vpos ), 1,
218 $ conjg( tau( taupos ) ),
219 $ a( dpos, st ), lda-1, work)
222 IF( ttype.EQ.2 )
THEN
228 CALL clarfx(
'Left', ln, lm, v( vpos ),
229 $ conjg( tau( taupos ) ),
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 $ conjg( a( dpos-nb-i, j1+i ) )
244 a( dpos-nb-i, j1+i ) = zero
246 ctmp = conjg( a( dpos-nb, j1 ) )
247 CALL clarfg( lm, ctmp, v( vpos+1 ), 1, tau( taupos ) )
248 a( dpos-nb, j1 ) = ctmp
250 CALL clarfx(
'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 clarfg( lm, a( ofdpos, st-1 ), v( vpos+1 ), 1,
281 CALL clarfy( uplo, lm, v( vpos ), 1,
282 $ conjg( tau( taupos ) ),
283 $ a( dpos, st ), lda-1, work)
287 IF( ttype.EQ.3 )
THEN
290 CALL clarfy( uplo, lm, v( vpos ), 1,
291 $ conjg( tau( taupos ) ),
292 $ a( dpos, st ), lda-1, work)
296 IF( ttype.EQ.2 )
THEN
303 CALL clarfx(
'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 clarfg( lm, a( dpos+nb, st ), v( vpos+1 ), 1,
323 CALL clarfx(
'Left', lm, ln-1, v( vpos ),
324 $ conjg( tau( taupos ) ),
325 $ a( dpos+nb-1, st+1 ), lda-1, work)
subroutine clarfx(SIDE, M, N, V, TAU, C, LDC, WORK)
CLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
subroutine chb2st_kernels(UPLO, WANTZ, TTYPE, ST, ED, SWEEP, N, NB, IB, A, LDA, V, TAU, LDVT, WORK)
CHB2ST_KERNELS
subroutine clarfy(UPLO, N, V, INCV, TAU, C, LDC, WORK)
CLARFY