220 SUBROUTINE dtgexc( 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 DOUBLE PRECISION A( lda, * ), B( ldb, * ), Q( ldq, * ),
234 $ work( * ), z( ldz, * )
240 DOUBLE PRECISION ZERO
241 parameter ( zero = 0.0d+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(
'DTGEXC', -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 dtgex2( 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 dtgex2( 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 dtgex2( 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 dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
406 $ z, ldz, here, 1, nbnext, work, lwork,
417 CALL dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
418 $ z, ldz, here, 1, 1, work, lwork, info )
424 CALL dtgex2( 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 dtgex2( 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 dtgex2( 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 dtgex2( 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 dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
508 $ z, ldz, here-1, 2, 1, work, lwork, info )
518 CALL dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
519 $ z, ldz, here, 1, 1, work, lwork, info )
525 CALL dtgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq,
526 $ z, ldz, here, 1, 1, work, lwork, info )
subroutine dtgex2(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, J1, N1, N2, WORK, LWORK, INFO)
DTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equ...
subroutine dtgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, WORK, LWORK, INFO)
DTGEXC
subroutine xerbla(SRNAME, INFO)
XERBLA