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*16 A( lda, * ), V( * ),
143 $ tau( * ), work( * )
150 parameter ( zero = ( 0.0d+0, 0.0d+0 ),
151 $ one = ( 1.0d+0, 0.0d+0 ) )
155 INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS,
156 $ dpos, ofdpos, ajeter
163 INTRINSIC dconjg, mod
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 ) = dconjg( a( ofdpos-i, st+i ) )
201 a( ofdpos-i, st+i ) = zero
203 ctmp = dconjg( a( ofdpos, st ) )
204 CALL zlarfg( lm, ctmp, v( vpos+1 ), 1,
206 a( ofdpos, st ) = ctmp
209 CALL zlarfy( uplo, lm, v( vpos ), 1,
210 $ dconjg( tau( taupos ) ),
211 $ a( dpos, st ), lda-1, work)
214 IF( ttype.EQ.3 )
THEN
217 CALL zlarfy( uplo, lm, v( vpos ), 1,
218 $ dconjg( tau( taupos ) ),
219 $ a( dpos, st ), lda-1, work)
222 IF( ttype.EQ.2 )
THEN
228 CALL zlarfx(
'Left', ln, lm, v( vpos ),
229 $ dconjg( 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 $ dconjg( a( dpos-nb-i, j1+i ) )
244 a( dpos-nb-i, j1+i ) = zero
246 ctmp = dconjg( a( dpos-nb, j1 ) )
247 CALL zlarfg( lm, ctmp, v( vpos+1 ), 1, tau( taupos ) )
248 a( dpos-nb, j1 ) = ctmp
250 CALL zlarfx(
'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 zlarfg( lm, a( ofdpos, st-1 ), v( vpos+1 ), 1,
281 CALL zlarfy( uplo, lm, v( vpos ), 1,
282 $ dconjg( tau( taupos ) ),
283 $ a( dpos, st ), lda-1, work)
287 IF( ttype.EQ.3 )
THEN
290 CALL zlarfy( uplo, lm, v( vpos ), 1,
291 $ dconjg( tau( taupos ) ),
292 $ a( dpos, st ), lda-1, work)
296 IF( ttype.EQ.2 )
THEN
303 CALL zlarfx(
'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 zlarfg( lm, a( dpos+nb, st ), v( vpos+1 ), 1,
323 CALL zlarfx(
'Left', lm, ln-1, v( vpos ),
324 $ dconjg( tau( taupos ) ),
325 $ a( dpos+nb-1, st+1 ), lda-1, work)
subroutine zlarfx(SIDE, M, N, V, TAU, C, LDC, WORK)
ZLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...
subroutine zhb2st_kernels(UPLO, WANTZ, TTYPE, ST, ED, SWEEP, N, NB, IB, A, LDA, V, TAU, LDVT, WORK)
ZHB2ST_KERNELS
subroutine zlarfy(UPLO, N, V, INCV, TAU, C, LDC, WORK)
ZLARFY
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).