310 SUBROUTINE ctgsna( 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 REAL DIF( * ), S( * )
327 COMPLEX A( lda, * ), B( ldb, * ), VL( ldvl, * ),
328 $ vr( ldvr, * ), work( * )
336 parameter ( zero = 0.0e+0, one = 1.0e+0, idifjb = 3 )
339 LOGICAL LQUERY, SOMCON, WANTBH, WANTDF, WANTS
340 INTEGER I, IERR, IFST, ILST, K, KS, LWMIN, N1, N2
341 REAL BIGNUM, COND, EPS, LNRM, RNRM, SCALE, SMLNUM
345 COMPLEX DUMMY( 1 ), DUMMY1( 1 )
349 REAL SCNRM2, SLAMCH, SLAPY2
351 EXTERNAL lsame, scnrm2, slamch, slapy2, cdotc
357 INTRINSIC abs, cmplx, 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(
'CTGSNA', -info )
420 ELSE IF( lquery )
THEN
432 smlnum = slamch(
'S' ) / eps
433 bignum = one / smlnum
434 CALL slabad( smlnum, bignum )
442 IF( .NOT.
SELECT( k ) )
453 rnrm = scnrm2( n, vr( 1, ks ), 1 )
454 lnrm = scnrm2( n, vl( 1, ks ), 1 )
455 CALL cgemv(
'N', n, n, cmplx( one, zero ), a, lda,
456 $ vr( 1, ks ), 1, cmplx( zero, zero ), work, 1 )
457 yhax = cdotc( n, work, 1, vl( 1, ks ), 1 )
458 CALL cgemv(
'N', n, n, cmplx( one, zero ), b, ldb,
459 $ vr( 1, ks ), 1, cmplx( zero, zero ), work, 1 )
460 yhbx = cdotc( n, work, 1, vl( 1, ks ), 1 )
461 cond = slapy2( abs( yhax ), abs( yhbx ) )
462 IF( cond.EQ.zero )
THEN
465 s( ks ) = cond / ( rnrm*lnrm )
471 dif( ks ) = slapy2( abs( a( 1, 1 ) ), abs( b( 1, 1 ) ) )
480 CALL clacpy(
'Full', n, n, a, lda, work, n )
481 CALL clacpy(
'Full', n, n, b, ldb, work( n*n+1 ), n )
485 CALL ctgexc( .false., .false., n, work, n, work( n*n+1 ),
486 $ n, dummy, 1, dummy1, 1, ifst, ilst, ierr )
504 CALL ctgsyl(
'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 slabad(SMALL, LARGE)
SLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine ctgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
CTGSNA
subroutine ctgsyl(TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, IWORK, INFO)
CTGSYL
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ctgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, INFO)
CTGEXC