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 )
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 ctgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
CTGSNA
subroutine xerbla(SRNAME, INFO)
XERBLA
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ctgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, INFO)
CTGEXC
logical function lsame(CA, CB)
LSAME
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function scnrm2(N, X, INCX)
SCNRM2
real function slamch(CMACH)
SLAMCH
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 slabad(SMALL, LARGE)
SLABAD
real function slapy2(X, Y)
SLAPY2 returns sqrt(x2+y2).