264 SUBROUTINE ctrsen( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
265 $ sep, work, lwork, info )
274 INTEGER INFO, LDQ, LDT, LWORK, M, N
279 COMPLEX Q( ldq, * ), T( ldt, * ), W( * ), WORK( * )
286 parameter ( zero = 0.0e+0, one = 1.0e+0 )
289 LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP
290 INTEGER IERR, K, KASE, KS, LWMIN, N1, N2, NN
291 REAL EST, RNORM, SCALE
300 EXTERNAL lsame, clange
312 wantbh = lsame( job,
'B' )
313 wants = lsame( job,
'E' ) .OR. wantbh
314 wantsp = lsame( job,
'V' ) .OR. wantbh
315 wantq = lsame( compq,
'V' )
330 lquery = ( lwork.EQ.-1 )
333 lwmin = max( 1, 2*nn )
334 ELSE IF( lsame( job,
'N' ) )
THEN
336 ELSE IF( lsame( job,
'E' ) )
THEN
340 IF( .NOT.lsame( job,
'N' ) .AND. .NOT.wants .AND. .NOT.wantsp )
343 ELSE IF( .NOT.lsame( compq,
'N' ) .AND. .NOT.wantq )
THEN
345 ELSE IF( n.LT.0 )
THEN
347 ELSE IF( ldt.LT.max( 1, n ) )
THEN
349 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
351 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
360 CALL xerbla(
'CTRSEN', -info )
362 ELSE IF( lquery )
THEN
368 IF( m.EQ.n .OR. m.EQ.0 )
THEN
372 $ sep = clange(
'1', n, n, t, ldt, rwork )
380 IF(
SELECT( k ) )
THEN
386 $
CALL ctrexc( compq, n, t, ldt, q, ldq, k, ks, ierr )
396 CALL clacpy(
'F', n1, n2, t( 1, n1+1 ), ldt, work, n1 )
397 CALL ctrsyl(
'N',
'N', -1, n1, n2, t, ldt, t( n1+1, n1+1 ),
398 $ ldt, work, n1, scale, ierr )
403 rnorm = clange(
'F', n1, n2, work, n1, rwork )
404 IF( rnorm.EQ.zero )
THEN
407 s = scale / ( sqrt( scale*scale / rnorm+rnorm )*
419 CALL clacn2( nn, work( nn+1 ), work, est, kase, isave )
425 CALL ctrsyl(
'N',
'N', -1, n1, n2, t, ldt,
426 $ t( n1+1, n1+1 ), ldt, work, n1, scale,
432 CALL ctrsyl(
'C',
'C', -1, n1, n2, t, ldt,
433 $ t( n1+1, n1+1 ), ldt, work, n1, scale,
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC