220 SUBROUTINE stgexc( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
221 $ ldz, ifst, ilst, work, lwork, info )
230 INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
233 REAL A( lda, * ), B( ldb, * ), Q( ldq, * ),
234 $ work( * ), z( ldz, * )
241 parameter( zero = 0.0e+0 )
245 INTEGER HERE, LWMIN, NBF, NBL, NBNEXT
258 lquery = ( lwork.EQ.-1 )
261 ELSE IF( lda.LT.max( 1, n ) )
THEN
263 ELSE IF( ldb.LT.max( 1, n ) )
THEN
265 ELSE IF( ldq.LT.1 .OR. wantq .AND. ( ldq.LT.max( 1, n ) ) )
THEN
267 ELSE IF( ldz.LT.1 .OR. wantz .AND. ( ldz.LT.max( 1, n ) ) )
THEN
269 ELSE IF( ifst.LT.1 .OR. ifst.GT.n )
THEN
271 ELSE IF( ilst.LT.1 .OR. ilst.GT.n )
THEN
283 IF (lwork.LT.lwmin .AND. .NOT.lquery)
THEN
289 CALL
xerbla(
'STGEXC', -info )
291 ELSE IF( lquery )
THEN
304 IF( a( ifst, ifst-1 ).NE.zero )
309 IF( a( ifst+1, ifst ).NE.zero )
317 IF( a( ilst, ilst-1 ).NE.zero )
322 IF( a( ilst+1, ilst ).NE.zero )
328 IF( ifst.LT.ilst )
THEN
332 IF( nbf.EQ.2 .AND. nbl.EQ.1 )
334 IF( nbf.EQ.1 .AND. nbl.EQ.2 )
343 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
348 IF( here+nbf+1.LE.n )
THEN
349 IF( a( here+nbf+1, here+nbf ).NE.zero )
352 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
353 $ ldz, here, nbf, nbnext, work, lwork, info )
363 IF( a( here+1, here ).EQ.zero )
373 IF( here+3.LE.n )
THEN
374 IF( a( here+3, here+2 ).NE.zero )
377 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
378 $ ldz, here+1, 1, nbnext, work, lwork, info )
383 IF( nbnext.EQ.1 )
THEN
387 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
388 $ ldz, here, 1, 1, work, lwork, info )
399 IF( a( here+2, here+1 ).EQ.zero )
401 IF( nbnext.EQ.2 )
THEN
405 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
406 $ z, ldz, here, 1, nbnext, work, lwork,
417 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
418 $ z, ldz, here, 1, 1, work, lwork, info )
424 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
425 $ z, ldz, here, 1, 1, work, lwork, info )
444 IF( nbf.EQ.1 .OR. nbf.EQ.2 )
THEN
450 IF( a( here-1, here-2 ).NE.zero )
453 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
454 $ ldz, here-nbnext, nbnext, nbf, work, lwork,
465 IF( a( here+1, here ).EQ.zero )
476 IF( a( here-1, here-2 ).NE.zero )
479 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
480 $ ldz, here-nbnext, nbnext, 1, work, lwork,
486 IF( nbnext.EQ.1 )
THEN
490 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z,
491 $ ldz, here, nbnext, 1, work, lwork, info )
501 IF( a( here, here-1 ).EQ.zero )
503 IF( nbnext.EQ.2 )
THEN
507 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
508 $ z, ldz, here-1, 2, 1, work, lwork, info )
518 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
519 $ z, ldz, here, 1, 1, work, lwork, info )
525 CALL
stgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
526 $ 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