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 xerbla(SRNAME, INFO)
XERBLA
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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dtgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, WORK, LWORK, INFO)
DTGEXC