LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
ctrevc3.f
Go to the documentation of this file.
1 *> \brief \b CTREVC3
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrevc3.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrevc3.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrevc3.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
22 * VR, LDVR, MM, M, WORK, LWORK, RWORK, INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER HOWMNY, SIDE
26 * INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N
27 * ..
28 * .. Array Arguments ..
29 * LOGICAL SELECT( * )
30 * REAL RWORK( * )
31 * COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
32 * \$ WORK( * )
33 * ..
34 *
35 *
36 *> \par Purpose:
37 * =============
38 *>
39 *> \verbatim
40 *>
41 *> CTREVC3 computes some or all of the right and/or left eigenvectors of
42 *> a complex upper triangular matrix T.
43 *> Matrices of this type are produced by the Schur factorization of
44 *> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR.
45 *>
46 *> The right eigenvector x and the left eigenvector y of T corresponding
47 *> to an eigenvalue w are defined by:
48 *>
49 *> T*x = w*x, (y**H)*T = w*(y**H)
50 *>
51 *> where y**H denotes the conjugate transpose of the vector y.
52 *> The eigenvalues are not input to this routine, but are read directly
53 *> from the diagonal of T.
54 *>
55 *> This routine returns the matrices X and/or Y of right and left
56 *> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an
57 *> input matrix. If Q is the unitary factor that reduces a matrix A to
58 *> Schur form T, then Q*X and Q*Y are the matrices of right and left
59 *> eigenvectors of A.
60 *>
61 *> This uses a Level 3 BLAS version of the back transformation.
62 *> \endverbatim
63 *
64 * Arguments:
65 * ==========
66 *
67 *> \param[in] SIDE
68 *> \verbatim
69 *> SIDE is CHARACTER*1
70 *> = 'R': compute right eigenvectors only;
71 *> = 'L': compute left eigenvectors only;
72 *> = 'B': compute both right and left eigenvectors.
73 *> \endverbatim
74 *>
75 *> \param[in] HOWMNY
76 *> \verbatim
77 *> HOWMNY is CHARACTER*1
78 *> = 'A': compute all right and/or left eigenvectors;
79 *> = 'B': compute all right and/or left eigenvectors,
80 *> backtransformed using the matrices supplied in
81 *> VR and/or VL;
82 *> = 'S': compute selected right and/or left eigenvectors,
83 *> as indicated by the logical array SELECT.
84 *> \endverbatim
85 *>
86 *> \param[in] SELECT
87 *> \verbatim
88 *> SELECT is LOGICAL array, dimension (N)
89 *> If HOWMNY = 'S', SELECT specifies the eigenvectors to be
90 *> computed.
91 *> The eigenvector corresponding to the j-th eigenvalue is
92 *> computed if SELECT(j) = .TRUE..
93 *> Not referenced if HOWMNY = 'A' or 'B'.
94 *> \endverbatim
95 *>
96 *> \param[in] N
97 *> \verbatim
98 *> N is INTEGER
99 *> The order of the matrix T. N >= 0.
100 *> \endverbatim
101 *>
102 *> \param[in,out] T
103 *> \verbatim
104 *> T is COMPLEX array, dimension (LDT,N)
105 *> The upper triangular matrix T. T is modified, but restored
106 *> on exit.
107 *> \endverbatim
108 *>
109 *> \param[in] LDT
110 *> \verbatim
111 *> LDT is INTEGER
112 *> The leading dimension of the array T. LDT >= max(1,N).
113 *> \endverbatim
114 *>
115 *> \param[in,out] VL
116 *> \verbatim
117 *> VL is COMPLEX array, dimension (LDVL,MM)
118 *> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
119 *> contain an N-by-N matrix Q (usually the unitary matrix Q of
120 *> Schur vectors returned by CHSEQR).
121 *> On exit, if SIDE = 'L' or 'B', VL contains:
122 *> if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
123 *> if HOWMNY = 'B', the matrix Q*Y;
124 *> if HOWMNY = 'S', the left eigenvectors of T specified by
125 *> SELECT, stored consecutively in the columns
126 *> of VL, in the same order as their
127 *> eigenvalues.
128 *> Not referenced if SIDE = 'R'.
129 *> \endverbatim
130 *>
131 *> \param[in] LDVL
132 *> \verbatim
133 *> LDVL is INTEGER
134 *> The leading dimension of the array VL.
135 *> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N.
136 *> \endverbatim
137 *>
138 *> \param[in,out] VR
139 *> \verbatim
140 *> VR is COMPLEX array, dimension (LDVR,MM)
141 *> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
142 *> contain an N-by-N matrix Q (usually the unitary matrix Q of
143 *> Schur vectors returned by CHSEQR).
144 *> On exit, if SIDE = 'R' or 'B', VR contains:
145 *> if HOWMNY = 'A', the matrix X of right eigenvectors of T;
146 *> if HOWMNY = 'B', the matrix Q*X;
147 *> if HOWMNY = 'S', the right eigenvectors of T specified by
148 *> SELECT, stored consecutively in the columns
149 *> of VR, in the same order as their
150 *> eigenvalues.
151 *> Not referenced if SIDE = 'L'.
152 *> \endverbatim
153 *>
154 *> \param[in] LDVR
155 *> \verbatim
156 *> LDVR is INTEGER
157 *> The leading dimension of the array VR.
158 *> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N.
159 *> \endverbatim
160 *>
161 *> \param[in] MM
162 *> \verbatim
163 *> MM is INTEGER
164 *> The number of columns in the arrays VL and/or VR. MM >= M.
165 *> \endverbatim
166 *>
167 *> \param[out] M
168 *> \verbatim
169 *> M is INTEGER
170 *> The number of columns in the arrays VL and/or VR actually
171 *> used to store the eigenvectors.
172 *> If HOWMNY = 'A' or 'B', M is set to N.
173 *> Each selected eigenvector occupies one column.
174 *> \endverbatim
175 *>
176 *> \param[out] WORK
177 *> \verbatim
178 *> WORK is COMPLEX array, dimension (MAX(1,LWORK))
179 *> \endverbatim
180 *>
181 *> \param[in] LWORK
182 *> \verbatim
183 *> LWORK is INTEGER
184 *> The dimension of array WORK. LWORK >= max(1,2*N).
185 *> For optimum performance, LWORK >= N + 2*N*NB, where NB is
186 *> the optimal blocksize.
187 *>
188 *> If LWORK = -1, then a workspace query is assumed; the routine
189 *> only calculates the optimal size of the WORK array, returns
190 *> this value as the first entry of the WORK array, and no error
191 *> message related to LWORK is issued by XERBLA.
192 *> \endverbatim
193 *>
194 *> \param[out] RWORK
195 *> \verbatim
196 *> RWORK is REAL array, dimension (LRWORK)
197 *> \endverbatim
198 *>
199 *> \param[in] LRWORK
200 *> \verbatim
201 *> LRWORK is INTEGER
202 *> The dimension of array RWORK. LRWORK >= max(1,N).
203 *>
204 *> If LRWORK = -1, then a workspace query is assumed; the routine
205 *> only calculates the optimal size of the RWORK array, returns
206 *> this value as the first entry of the RWORK array, and no error
207 *> message related to LRWORK is issued by XERBLA.
208 *> \endverbatim
209 *>
210 *> \param[out] INFO
211 *> \verbatim
212 *> INFO is INTEGER
213 *> = 0: successful exit
214 *> < 0: if INFO = -i, the i-th argument had an illegal value
215 *> \endverbatim
216 *
217 * Authors:
218 * ========
219 *
220 *> \author Univ. of Tennessee
221 *> \author Univ. of California Berkeley
222 *> \author Univ. of Colorado Denver
223 *> \author NAG Ltd.
224 *
225 *> \date November 2011
226 *
227 * @generated from ztrevc3.f, fortran z -> c, Tue Apr 19 01:47:44 2016
228 *
229 *> \ingroup complexOTHERcomputational
230 *
231 *> \par Further Details:
232 * =====================
233 *>
234 *> \verbatim
235 *>
236 *> The algorithm used in this program is basically backward (forward)
237 *> substitution, with scaling to make the the code robust against
238 *> possible overflow.
239 *>
240 *> Each eigenvector is normalized so that the element of largest
241 *> magnitude has magnitude 1; here the magnitude of a complex number
242 *> (x,y) is taken to be |x| + |y|.
243 *> \endverbatim
244 *>
245 * =====================================================================
246  SUBROUTINE ctrevc3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
247  \$ ldvr, mm, m, work, lwork, rwork, lrwork, info)
248  IMPLICIT NONE
249 *
250 * -- LAPACK computational routine (version 3.4.0) --
251 * -- LAPACK is a software package provided by Univ. of Tennessee, --
252 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
253 * November 2011
254 *
255 * .. Scalar Arguments ..
256  CHARACTER HOWMNY, SIDE
257  INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N
258 * ..
259 * .. Array Arguments ..
260  LOGICAL SELECT( * )
261  REAL RWORK( * )
262  COMPLEX T( ldt, * ), VL( ldvl, * ), VR( ldvr, * ),
263  \$ work( * )
264 * ..
265 *
266 * =====================================================================
267 *
268 * .. Parameters ..
269  REAL ZERO, ONE
270  parameter ( zero = 0.0e+0, one = 1.0e+0 )
271  COMPLEX CZERO, CONE
272  parameter ( czero = ( 0.0e+0, 0.0e+0 ),
273  \$ cone = ( 1.0e+0, 0.0e+0 ) )
274  INTEGER NBMIN, NBMAX
275  parameter ( nbmin = 8, nbmax = 128 )
276 * ..
277 * .. Local Scalars ..
278  LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV
279  INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB
280  REAL OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL
281  COMPLEX CDUM
282 * ..
283 * .. External Functions ..
284  LOGICAL LSAME
285  INTEGER ILAENV, ICAMAX
286  REAL SLAMCH, SCASUM
287  EXTERNAL lsame, ilaenv, icamax, slamch, scasum
288 * ..
289 * .. External Subroutines ..
290  EXTERNAL xerbla, ccopy, csscal, cgemv, clatrs
291 * ..
292 * .. Intrinsic Functions ..
293  INTRINSIC abs, REAL, CMPLX, CONJG, AIMAG, MAX
294 * ..
295 * .. Statement Functions ..
296  REAL CABS1
297 * ..
298 * .. Statement Function definitions ..
299  cabs1( cdum ) = abs( REAL( CDUM ) ) + abs( AIMAG( cdum ) )
300 * ..
301 * .. Executable Statements ..
302 *
303 * Decode and test the input parameters
304 *
305  bothv = lsame( side, 'B' )
306  rightv = lsame( side, 'R' ) .OR. bothv
307  leftv = lsame( side, 'L' ) .OR. bothv
308 *
309  allv = lsame( howmny, 'A' )
310  over = lsame( howmny, 'B' )
311  somev = lsame( howmny, 'S' )
312 *
313 * Set M to the number of columns required to store the selected
314 * eigenvectors.
315 *
316  IF( somev ) THEN
317  m = 0
318  DO 10 j = 1, n
319  IF( SELECT( j ) )
320  \$ m = m + 1
321  10 CONTINUE
322  ELSE
323  m = n
324  END IF
325 *
326  info = 0
327  nb = ilaenv( 1, 'CTREVC', side // howmny, n, -1, -1, -1 )
328  maxwrk = n + 2*n*nb
329  work(1) = maxwrk
330  rwork(1) = n
331  lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 )
332  IF( .NOT.rightv .AND. .NOT.leftv ) THEN
333  info = -1
334  ELSE IF( .NOT.allv .AND. .NOT.over .AND. .NOT.somev ) THEN
335  info = -2
336  ELSE IF( n.LT.0 ) THEN
337  info = -4
338  ELSE IF( ldt.LT.max( 1, n ) ) THEN
339  info = -6
340  ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) ) THEN
341  info = -8
342  ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) ) THEN
343  info = -10
344  ELSE IF( mm.LT.m ) THEN
345  info = -11
346  ELSE IF( lwork.LT.max( 1, 2*n ) .AND. .NOT.lquery ) THEN
347  info = -14
348  ELSE IF ( lrwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
349  info = -16
350  END IF
351  IF( info.NE.0 ) THEN
352  CALL xerbla( 'CTREVC3', -info )
353  RETURN
354  ELSE IF( lquery ) THEN
355  RETURN
356  END IF
357 *
358 * Quick return if possible.
359 *
360  IF( n.EQ.0 )
361  \$ RETURN
362 *
363 * Use blocked version of back-transformation if sufficient workspace.
364 * Zero-out the workspace to avoid potential NaN propagation.
365 *
366  IF( over .AND. lwork .GE. n + 2*n*nbmin ) THEN
367  nb = (lwork - n) / (2*n)
368  nb = min( nb, nbmax )
369  CALL claset( 'F', n, 1+2*nb, czero, czero, work, n )
370  ELSE
371  nb = 1
372  END IF
373 *
374 * Set the constants to control overflow.
375 *
376  unfl = slamch( 'Safe minimum' )
377  ovfl = one / unfl
378  CALL slabad( unfl, ovfl )
379  ulp = slamch( 'Precision' )
380  smlnum = unfl*( n / ulp )
381 *
382 * Store the diagonal elements of T in working array WORK.
383 *
384  DO 20 i = 1, n
385  work( i ) = t( i, i )
386  20 CONTINUE
387 *
388 * Compute 1-norm of each column of strictly upper triangular
389 * part of T to control overflow in triangular solver.
390 *
391  rwork( 1 ) = zero
392  DO 30 j = 2, n
393  rwork( j ) = scasum( j-1, t( 1, j ), 1 )
394  30 CONTINUE
395 *
396  IF( rightv ) THEN
397 *
398 * ============================================================
399 * Compute right eigenvectors.
400 *
401 * IV is index of column in current block.
402 * Non-blocked version always uses IV=NB=1;
403 * blocked version starts with IV=NB, goes down to 1.
404 * (Note the "0-th" column is used to store the original diagonal.)
405  iv = nb
406  is = m
407  DO 80 ki = n, 1, -1
408  IF( somev ) THEN
409  IF( .NOT.SELECT( ki ) )
410  \$ GO TO 80
411  END IF
412  smin = max( ulp*( cabs1( t( ki, ki ) ) ), smlnum )
413 *
414 * --------------------------------------------------------
415 * Complex right eigenvector
416 *
417  work( ki + iv*n ) = cone
418 *
419 * Form right-hand side.
420 *
421  DO 40 k = 1, ki - 1
422  work( k + iv*n ) = -t( k, ki )
423  40 CONTINUE
424 *
425 * Solve upper triangular system:
426 * [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK.
427 *
428  DO 50 k = 1, ki - 1
429  t( k, k ) = t( k, k ) - t( ki, ki )
430  IF( cabs1( t( k, k ) ).LT.smin )
431  \$ t( k, k ) = smin
432  50 CONTINUE
433 *
434  IF( ki.GT.1 ) THEN
435  CALL clatrs( 'Upper', 'No transpose', 'Non-unit', 'Y',
436  \$ ki-1, t, ldt, work( 1 + iv*n ), scale,
437  \$ rwork, info )
438  work( ki + iv*n ) = scale
439  END IF
440 *
441 * Copy the vector x or Q*x to VR and normalize.
442 *
443  IF( .NOT.over ) THEN
444 * ------------------------------
445 * no back-transform: copy x to VR and normalize.
446  CALL ccopy( ki, work( 1 + iv*n ), 1, vr( 1, is ), 1 )
447 *
448  ii = icamax( ki, vr( 1, is ), 1 )
449  remax = one / cabs1( vr( ii, is ) )
450  CALL csscal( ki, remax, vr( 1, is ), 1 )
451 *
452  DO 60 k = ki + 1, n
453  vr( k, is ) = czero
454  60 CONTINUE
455 *
456  ELSE IF( nb.EQ.1 ) THEN
457 * ------------------------------
458 * version 1: back-transform each vector with GEMV, Q*x.
459  IF( ki.GT.1 )
460  \$ CALL cgemv( 'N', n, ki-1, cone, vr, ldvr,
461  \$ work( 1 + iv*n ), 1, cmplx( scale ),
462  \$ vr( 1, ki ), 1 )
463 *
464  ii = icamax( n, vr( 1, ki ), 1 )
465  remax = one / cabs1( vr( ii, ki ) )
466  CALL csscal( n, remax, vr( 1, ki ), 1 )
467 *
468  ELSE
469 * ------------------------------
470 * version 2: back-transform block of vectors with GEMM
471 * zero out below vector
472  DO k = ki + 1, n
473  work( k + iv*n ) = czero
474  END DO
475 *
476 * Columns IV:NB of work are valid vectors.
477 * When the number of vectors stored reaches NB,
478 * or if this was last vector, do the GEMM
479  IF( (iv.EQ.1) .OR. (ki.EQ.1) ) THEN
480  CALL cgemm( 'N', 'N', n, nb-iv+1, ki+nb-iv, cone,
481  \$ vr, ldvr,
482  \$ work( 1 + (iv)*n ), n,
483  \$ czero,
484  \$ work( 1 + (nb+iv)*n ), n )
485 * normalize vectors
486  DO k = iv, nb
487  ii = icamax( n, work( 1 + (nb+k)*n ), 1 )
488  remax = one / cabs1( work( ii + (nb+k)*n ) )
489  CALL csscal( n, remax, work( 1 + (nb+k)*n ), 1 )
490  END DO
491  CALL clacpy( 'F', n, nb-iv+1,
492  \$ work( 1 + (nb+iv)*n ), n,
493  \$ vr( 1, ki ), ldvr )
494  iv = nb
495  ELSE
496  iv = iv - 1
497  END IF
498  END IF
499 *
500 * Restore the original diagonal elements of T.
501 *
502  DO 70 k = 1, ki - 1
503  t( k, k ) = work( k )
504  70 CONTINUE
505 *
506  is = is - 1
507  80 CONTINUE
508  END IF
509 *
510  IF( leftv ) THEN
511 *
512 * ============================================================
513 * Compute left eigenvectors.
514 *
515 * IV is index of column in current block.
516 * Non-blocked version always uses IV=1;
517 * blocked version starts with IV=1, goes up to NB.
518 * (Note the "0-th" column is used to store the original diagonal.)
519  iv = 1
520  is = 1
521  DO 130 ki = 1, n
522 *
523  IF( somev ) THEN
524  IF( .NOT.SELECT( ki ) )
525  \$ GO TO 130
526  END IF
527  smin = max( ulp*( cabs1( t( ki, ki ) ) ), smlnum )
528 *
529 * --------------------------------------------------------
530 * Complex left eigenvector
531 *
532  work( ki + iv*n ) = cone
533 *
534 * Form right-hand side.
535 *
536  DO 90 k = ki + 1, n
537  work( k + iv*n ) = -conjg( t( ki, k ) )
538  90 CONTINUE
539 *
540 * Solve conjugate-transposed triangular system:
541 * [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK.
542 *
543  DO 100 k = ki + 1, n
544  t( k, k ) = t( k, k ) - t( ki, ki )
545  IF( cabs1( t( k, k ) ).LT.smin )
546  \$ t( k, k ) = smin
547  100 CONTINUE
548 *
549  IF( ki.LT.n ) THEN
550  CALL clatrs( 'Upper', 'Conjugate transpose', 'Non-unit',
551  \$ 'Y', n-ki, t( ki+1, ki+1 ), ldt,
552  \$ work( ki+1 + iv*n ), scale, rwork, info )
553  work( ki + iv*n ) = scale
554  END IF
555 *
556 * Copy the vector x or Q*x to VL and normalize.
557 *
558  IF( .NOT.over ) THEN
559 * ------------------------------
560 * no back-transform: copy x to VL and normalize.
561  CALL ccopy( n-ki+1, work( ki + iv*n ), 1, vl(ki,is), 1 )
562 *
563  ii = icamax( n-ki+1, vl( ki, is ), 1 ) + ki - 1
564  remax = one / cabs1( vl( ii, is ) )
565  CALL csscal( n-ki+1, remax, vl( ki, is ), 1 )
566 *
567  DO 110 k = 1, ki - 1
568  vl( k, is ) = czero
569  110 CONTINUE
570 *
571  ELSE IF( nb.EQ.1 ) THEN
572 * ------------------------------
573 * version 1: back-transform each vector with GEMV, Q*x.
574  IF( ki.LT.n )
575  \$ CALL cgemv( 'N', n, n-ki, cone, vl( 1, ki+1 ), ldvl,
576  \$ work( ki+1 + iv*n ), 1, cmplx( scale ),
577  \$ vl( 1, ki ), 1 )
578 *
579  ii = icamax( n, vl( 1, ki ), 1 )
580  remax = one / cabs1( vl( ii, ki ) )
581  CALL csscal( n, remax, vl( 1, ki ), 1 )
582 *
583  ELSE
584 * ------------------------------
585 * version 2: back-transform block of vectors with GEMM
586 * zero out above vector
587 * could go from KI-NV+1 to KI-1
588  DO k = 1, ki - 1
589  work( k + iv*n ) = czero
590  END DO
591 *
592 * Columns 1:IV of work are valid vectors.
593 * When the number of vectors stored reaches NB,
594 * or if this was last vector, do the GEMM
595  IF( (iv.EQ.nb) .OR. (ki.EQ.n) ) THEN
596  CALL cgemm( 'N', 'N', n, iv, n-ki+iv, one,
597  \$ vl( 1, ki-iv+1 ), ldvl,
598  \$ work( ki-iv+1 + (1)*n ), n,
599  \$ czero,
600  \$ work( 1 + (nb+1)*n ), n )
601 * normalize vectors
602  DO k = 1, iv
603  ii = icamax( n, work( 1 + (nb+k)*n ), 1 )
604  remax = one / cabs1( work( ii + (nb+k)*n ) )
605  CALL csscal( n, remax, work( 1 + (nb+k)*n ), 1 )
606  END DO
607  CALL clacpy( 'F', n, iv,
608  \$ work( 1 + (nb+1)*n ), n,
609  \$ vl( 1, ki-iv+1 ), ldvl )
610  iv = 1
611  ELSE
612  iv = iv + 1
613  END IF
614  END IF
615 *
616 * Restore the original diagonal elements of T.
617 *
618  DO 120 k = ki + 1, n
619  t( k, k ) = work( k )
620  120 CONTINUE
621 *
622  is = is + 1
623  130 CONTINUE
624  END IF
625 *
626  RETURN
627 *
628 * End of CTREVC3
629 *
630  END
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
Definition: clatrs.f:241
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine ctrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
CTREVC3
Definition: ctrevc3.f:248
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:189
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:54