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...