218 SUBROUTINE stgexc( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
219 $ LDZ, IFST, ILST, WORK, LWORK, INFO )
227 INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
230 REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
231 $ work( * ), z( ldz, * )
238 parameter( zero = 0.0e+0 )
242 INTEGER HERE, LWMIN, NBF, NBL, NBNEXT
255 lquery = ( lwork.EQ.-1 )
258 ELSE IF( lda.LT.max( 1, n ) )
THEN
260 ELSE IF( ldb.LT.max( 1, n ) )
THEN
262 ELSE IF( ldq.LT.1 .OR. wantq .AND. ( ldq.LT.max( 1, n ) ) )
THEN
264 ELSE IF( ldz.LT.1 .OR. wantz .AND. ( ldz.LT.max( 1, n ) ) )
THEN
266 ELSE IF( ifst.LT.1 .OR. ifst.GT.n )
THEN
268 ELSE IF( ilst.LT.1 .OR. ilst.GT.n )
THEN
280 IF (lwork.LT.lwmin .AND. .NOT.lquery)
THEN
286 CALL xerbla(
'STGEXC', -info )
288 ELSE IF( lquery )
THEN
301 IF( a( ifst, ifst-1 ).NE.zero )
306 IF( a( ifst+1, ifst ).NE.zero )
314 IF( a( ilst, ilst-1 ).NE.zero )
319 IF( a( ilst+1, ilst ).NE.zero )
325 IF( ifst.LT.ilst )
THEN
329 IF( nbf.EQ.2 .AND. nbl.EQ.1 )
331 IF( nbf.EQ.1 .AND. nbl.EQ.2 )
340 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
345 IF( here+nbf+1.LE.n )
THEN
346 IF( a( here+nbf+1, here+nbf ).NE.zero )
349 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
350 $ ldz, here, nbf, nbnext, work, lwork, info )
360 IF( a( here+1, here ).EQ.zero )
370 IF( here+3.LE.n )
THEN
371 IF( a( here+3, here+2 ).NE.zero )
374 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
375 $ ldz, here+1, 1, nbnext, work, lwork, info )
380 IF( nbnext.EQ.1 )
THEN
384 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
385 $ ldz, here, 1, 1, work, lwork, info )
396 IF( a( here+2, here+1 ).EQ.zero )
398 IF( nbnext.EQ.2 )
THEN
402 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
403 $ z, ldz, here, 1, nbnext, work, lwork,
414 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
415 $ z, ldz, here, 1, 1, work, lwork, info )
421 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
422 $ z, ldz, here, 1, 1, work, lwork, info )
441 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
447 IF( a( here-1, here-2 ).NE.zero )
450 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
451 $ ldz, here-nbnext, nbnext, nbf, work, lwork,
462 IF( a( here+1, here ).EQ.zero )
473 IF( a( here-1, here-2 ).NE.zero )
476 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
477 $ ldz, here-nbnext, nbnext, 1, work, lwork,
483 IF( nbnext.EQ.1 )
THEN
487 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
488 $ ldz, here, nbnext, 1, work, lwork, info )
498 IF( a( here, here-1 ).EQ.zero )
500 IF( nbnext.EQ.2 )
THEN
504 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
505 $ z, ldz, here-1, 2, 1, work, lwork, info )
515 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
516 $ z, ldz, here, 1, 1, work, lwork, info )
522 CALL stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
523 $ z, ldz, here, 1, 1, work, lwork, info )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine stgex2(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, J1, N1, N2, WORK, LWORK, INFO)
STGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equ...
subroutine stgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, WORK, LWORK, INFO)
STGEXC