168 $ ST, ED, SWEEP, N, NB, IB,
169 $ A, LDA, V, TAU, LDVT, WORK)
180 INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
183 COMPLEX*16 A( LDA, * ), V( * ),
184 $ TAU( * ), WORK( * )
191 PARAMETER ( ZERO = ( 0.0d+0, 0.0d+0 ),
192 $ one = ( 1.0d+0, 0.0d+0 ) )
196 INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS,
197 $ dpos, ofdpos, ajeter
204 INTRINSIC dconjg, mod
213 upper = lsame( uplo,
'U' )
229 vpos = mod( sweep-1, 2 ) * n + st
230 taupos = mod( sweep-1, 2 ) * n + st
232 vpos = mod( sweep-1, 2 ) * n + st
233 taupos = mod( sweep-1, 2 ) * n + st
236 IF( ttype.EQ.1 )
THEN
241 v( vpos+i ) = dconjg( a( ofdpos-i, st+i ) )
242 a( ofdpos-i, st+i ) = zero
244 ctmp = dconjg( a( ofdpos, st ) )
245 CALL zlarfg( lm, ctmp, v( vpos+1 ), 1,
247 a( ofdpos, st ) = ctmp
250 CALL zlarfy( uplo, lm, v( vpos ), 1,
251 $ dconjg( tau( taupos ) ),
252 $ a( dpos, st ), lda-1, work)
255 IF( ttype.EQ.3 )
THEN
258 CALL zlarfy( uplo, lm, v( vpos ), 1,
259 $ dconjg( tau( taupos ) ),
260 $ a( dpos, st ), lda-1, work)
263 IF( ttype.EQ.2 )
THEN
269 CALL zlarfx(
'Left', ln, lm, v( vpos ),
270 $ dconjg( tau( taupos ) ),
271 $ a( dpos-nb, j1 ), lda-1, work)
274 vpos = mod( sweep-1, 2 ) * n + j1
275 taupos = mod( sweep-1, 2 ) * n + j1
277 vpos = mod( sweep-1, 2 ) * n + j1
278 taupos = mod( sweep-1, 2 ) * n + j1
284 $ dconjg( a( dpos-nb-i, j1+i ) )
285 a( dpos-nb-i, j1+i ) = zero
287 ctmp = dconjg( a( dpos-nb, j1 ) )
288 CALL zlarfg( lm, ctmp, v( vpos+1 ), 1, tau( taupos ) )
289 a( dpos-nb, j1 ) = ctmp
291 CALL zlarfx(
'Right', ln-1, lm, v( vpos ),
293 $ a( dpos-nb+1, j1 ), lda-1, work)
302 vpos = mod( sweep-1, 2 ) * n + st
303 taupos = mod( sweep-1, 2 ) * n + st
305 vpos = mod( sweep-1, 2 ) * n + st
306 taupos = mod( sweep-1, 2 ) * n + st
309 IF( ttype.EQ.1 )
THEN
314 v( vpos+i ) = a( ofdpos+i, st-1 )
315 a( ofdpos+i, st-1 ) = zero
317 CALL zlarfg( lm, a( ofdpos, st-1 ), v( vpos+1 ), 1,
322 CALL zlarfy( uplo, lm, v( vpos ), 1,
323 $ dconjg( tau( taupos ) ),
324 $ a( dpos, st ), lda-1, work)
328 IF( ttype.EQ.3 )
THEN
331 CALL zlarfy( uplo, lm, v( vpos ), 1,
332 $ dconjg( tau( taupos ) ),
333 $ a( dpos, st ), lda-1, work)
337 IF( ttype.EQ.2 )
THEN
344 CALL zlarfx(
'Right', lm, ln, v( vpos ),
345 $ tau( taupos ), a( dpos+nb, st ),
349 vpos = mod( sweep-1, 2 ) * n + j1
350 taupos = mod( sweep-1, 2 ) * n + j1
352 vpos = mod( sweep-1, 2 ) * n + j1
353 taupos = mod( sweep-1, 2 ) * n + j1
358 v( vpos+i ) = a( dpos+nb+i, st )
359 a( dpos+nb+i, st ) = zero
361 CALL zlarfg( lm, a( dpos+nb, st ), v( vpos+1 ), 1,
364 CALL zlarfx(
'Left', lm, ln-1, v( vpos ),
365 $ dconjg( tau( taupos ) ),
366 $ 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 zlarfy(UPLO, N, V, INCV, TAU, C, LDC, WORK)
ZLARFY
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
subroutine zhb2st_kernels(UPLO, WANTZ, TTYPE, ST, ED, SWEEP, N, NB, IB, A, LDA, V, TAU, LDVT, WORK)
ZHB2ST_KERNELS