310 SUBROUTINE ztgsna( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL,
311 $ ldvl, vr, ldvr, s, dif, mm, m, work, lwork,
320 CHARACTER HOWMNY, JOB
321 INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, M, MM, N
326 DOUBLE PRECISION DIF( * ), S( * )
327 COMPLEX*16 A( lda, * ), B( ldb, * ), VL( ldvl, * ),
328 $ vr( ldvr, * ), work( * )
334 DOUBLE PRECISION ZERO, ONE
336 parameter ( zero = 0.0d+0, one = 1.0d+0, idifjb = 3 )
339 LOGICAL LQUERY, SOMCON, WANTBH, WANTDF, WANTS
340 INTEGER I, IERR, IFST, ILST, K, KS, LWMIN, N1, N2
341 DOUBLE PRECISION BIGNUM, COND, EPS, LNRM, RNRM, SCALE, SMLNUM
342 COMPLEX*16 YHAX, YHBX
345 COMPLEX*16 DUMMY( 1 ), DUMMY1( 1 )
349 DOUBLE PRECISION DLAMCH, DLAPY2, DZNRM2
351 EXTERNAL lsame, dlamch, dlapy2, dznrm2, zdotc
357 INTRINSIC abs, dcmplx, max
363 wantbh = lsame( job,
'B' )
364 wants = lsame( job,
'E' ) .OR. wantbh
365 wantdf = lsame( job,
'V' ) .OR. wantbh
367 somcon = lsame( howmny,
'S' )
370 lquery = ( lwork.EQ.-1 )
372 IF( .NOT.wants .AND. .NOT.wantdf )
THEN
374 ELSE IF( .NOT.lsame( howmny,
'A' ) .AND. .NOT.somcon )
THEN
376 ELSE IF( n.LT.0 )
THEN
378 ELSE IF( lda.LT.max( 1, n ) )
THEN
380 ELSE IF( ldb.LT.max( 1, n ) )
THEN
382 ELSE IF( wants .AND. ldvl.LT.n )
THEN
384 ELSE IF( wants .AND. ldvr.LT.n )
THEN
403 ELSE IF( lsame( job,
'V' ) .OR. lsame( job,
'B' ) )
THEN
412 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
418 CALL xerbla(
'ZTGSNA', -info )
420 ELSE IF( lquery )
THEN
432 smlnum = dlamch(
'S' ) / eps
433 bignum = one / smlnum
434 CALL dlabad( smlnum, bignum )
442 IF( .NOT.
SELECT( k ) )
453 rnrm = dznrm2( n, vr( 1, ks ), 1 )
454 lnrm = dznrm2( n, vl( 1, ks ), 1 )
455 CALL zgemv(
'N', n, n, dcmplx( one, zero ), a, lda,
456 $ vr( 1, ks ), 1, dcmplx( zero, zero ), work, 1 )
457 yhax = zdotc( n, work, 1, vl( 1, ks ), 1 )
458 CALL zgemv(
'N', n, n, dcmplx( one, zero ), b, ldb,
459 $ vr( 1, ks ), 1, dcmplx( zero, zero ), work, 1 )
460 yhbx = zdotc( n, work, 1, vl( 1, ks ), 1 )
461 cond = dlapy2( abs( yhax ), abs( yhbx ) )
462 IF( cond.EQ.zero )
THEN
465 s( ks ) = cond / ( rnrm*lnrm )
471 dif( ks ) = dlapy2( abs( a( 1, 1 ) ), abs( b( 1, 1 ) ) )
480 CALL zlacpy(
'Full', n, n, a, lda, work, n )
481 CALL zlacpy(
'Full', n, n, b, ldb, work( n*n+1 ), n )
485 CALL ztgexc( .false., .false., n, work, n, work( n*n+1 ),
486 $ n, dummy, 1, dummy1, 1, ifst, ilst, ierr )
504 CALL ztgsyl(
'N', idifjb, n2, n1, work( n*n1+n1+1 ),
505 $ n, work, n, work( n1+1 ), n,
506 $ work( n*n1+n1+i ), n, work( i ), n,
507 $ work( n1+i ), n, scale, dif( ks ), dummy,
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine ztgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, INFO)
ZTGEXC
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine ztgsyl(TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, IWORK, INFO)
ZTGSYL
subroutine ztgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
ZTGSNA