146 SUBROUTINE strexc( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK,
156 INTEGER IFST, ILST, INFO, LDQ, LDT, N
159 REAL Q( ldq, * ), T( ldt, * ), WORK( * )
166 parameter ( zero = 0.0e+0 )
170 INTEGER HERE, NBF, NBL, NBNEXT
187 wantq = lsame( compq,
'V' )
188 IF( .NOT.wantq .AND. .NOT.lsame( compq,
'N' ) )
THEN
190 ELSE IF( n.LT.0 )
THEN
192 ELSE IF( ldt.LT.max( 1, n ) )
THEN
194 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.max( 1, n ) ) )
THEN
196 ELSE IF( ifst.LT.1 .OR. ifst.GT.n )
THEN
198 ELSE IF( ilst.LT.1 .OR. ilst.GT.n )
THEN
202 CALL xerbla(
'STREXC', -info )
215 IF( t( ifst, ifst-1 ).NE.zero )
220 IF( t( ifst+1, ifst ).NE.zero )
228 IF( t( ilst, ilst-1 ).NE.zero )
233 IF( t( ilst+1, ilst ).NE.zero )
240 IF( ifst.LT.ilst )
THEN
244 IF( nbf.EQ.2 .AND. nbl.EQ.1 )
246 IF( nbf.EQ.1 .AND. nbl.EQ.2 )
255 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
260 IF( here+nbf+1.LE.n )
THEN
261 IF( t( here+nbf+1, here+nbf ).NE.zero )
264 CALL slaexc( wantq, n, t, ldt, q, ldq, here, nbf, nbnext,
275 IF( t( here+1, here ).EQ.zero )
285 IF( here+3.LE.n )
THEN
286 IF( t( here+3, here+2 ).NE.zero )
289 CALL slaexc( wantq, n, t, ldt, q, ldq, here+1, 1, nbnext,
295 IF( nbnext.EQ.1 )
THEN
299 CALL slaexc( wantq, n, t, ldt, q, ldq, here, 1, nbnext,
306 IF( t( here+2, here+1 ).EQ.zero )
308 IF( nbnext.EQ.2 )
THEN
312 CALL slaexc( wantq, n, t, ldt, q, ldq, here, 1,
313 $ nbnext, work, info )
323 CALL slaexc( wantq, n, t, ldt, q, ldq, here, 1, 1,
325 CALL slaexc( wantq, n, t, ldt, q, ldq, here+1, 1, 1,
341 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
347 IF( t( here-1, here-2 ).NE.zero )
350 CALL slaexc( wantq, n, t, ldt, q, ldq, here-nbnext, nbnext,
361 IF( t( here+1, here ).EQ.zero )
372 IF( t( here-1, here-2 ).NE.zero )
375 CALL slaexc( wantq, n, t, ldt, q, ldq, here-nbnext, nbnext,
381 IF( nbnext.EQ.1 )
THEN
385 CALL slaexc( wantq, n, t, ldt, q, ldq, here, nbnext, 1,
392 IF( t( here, here-1 ).EQ.zero )
394 IF( nbnext.EQ.2 )
THEN
398 CALL slaexc( wantq, n, t, ldt, q, ldq, here-1, 2, 1,
409 CALL slaexc( wantq, n, t, ldt, q, ldq, here, 1, 1,
411 CALL slaexc( wantq, n, t, ldt, q, ldq, here-1, 1, 1,
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine strexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO)
STREXC
subroutine slaexc(WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, INFO)
SLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form...