LAPACK  3.10.0
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
9 *> Download CTREVC3 + dependencies
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, VR,
22 * LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, 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 *> \ingroup complexOTHERcomputational
226 *
227 *> \par Further Details:
228 * =====================
229 *>
230 *> \verbatim
231 *>
232 *> The algorithm used in this program is basically backward (forward)
233 *> substitution, with scaling to make the the code robust against
234 *> possible overflow.
235 *>
236 *> Each eigenvector is normalized so that the element of largest
237 *> magnitude has magnitude 1; here the magnitude of a complex number
238 *> (x,y) is taken to be |x| + |y|.
239 *> \endverbatim
240 *>
241 * =====================================================================
242  SUBROUTINE ctrevc3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
243  $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
244  IMPLICIT NONE
245 *
246 * -- LAPACK computational routine --
247 * -- LAPACK is a software package provided by Univ. of Tennessee, --
248 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
249 *
250 * .. Scalar Arguments ..
251  CHARACTER HOWMNY, SIDE
252  INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N
253 * ..
254 * .. Array Arguments ..
255  LOGICAL SELECT( * )
256  REAL RWORK( * )
257  COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
258  $ work( * )
259 * ..
260 *
261 * =====================================================================
262 *
263 * .. Parameters ..
264  REAL ZERO, ONE
265  parameter( zero = 0.0e+0, one = 1.0e+0 )
266  COMPLEX CZERO, CONE
267  parameter( czero = ( 0.0e+0, 0.0e+0 ),
268  $ cone = ( 1.0e+0, 0.0e+0 ) )
269  INTEGER NBMIN, NBMAX
270  parameter( nbmin = 8, nbmax = 128 )
271 * ..
272 * .. Local Scalars ..
273  LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV
274  INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB
275  REAL OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL
276  COMPLEX CDUM
277 * ..
278 * .. External Functions ..
279  LOGICAL LSAME
280  INTEGER ILAENV, ICAMAX
281  REAL SLAMCH, SCASUM
282  EXTERNAL lsame, ilaenv, icamax, slamch, scasum
283 * ..
284 * .. External Subroutines ..
285  EXTERNAL xerbla, ccopy, claset, csscal, cgemm, cgemv,
286  $ clatrs, clacpy, slabad
287 * ..
288 * .. Intrinsic Functions ..
289  INTRINSIC abs, real, cmplx, conjg, aimag, max
290 * ..
291 * .. Statement Functions ..
292  REAL CABS1
293 * ..
294 * .. Statement Function definitions ..
295  cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
296 * ..
297 * .. Executable Statements ..
298 *
299 * Decode and test the input parameters
300 *
301  bothv = lsame( side, 'B' )
302  rightv = lsame( side, 'R' ) .OR. bothv
303  leftv = lsame( side, 'L' ) .OR. bothv
304 *
305  allv = lsame( howmny, 'A' )
306  over = lsame( howmny, 'B' )
307  somev = lsame( howmny, 'S' )
308 *
309 * Set M to the number of columns required to store the selected
310 * eigenvectors.
311 *
312  IF( somev ) THEN
313  m = 0
314  DO 10 j = 1, n
315  IF( SELECT( j ) )
316  $ m = m + 1
317  10 CONTINUE
318  ELSE
319  m = n
320  END IF
321 *
322  info = 0
323  nb = ilaenv( 1, 'CTREVC', side // howmny, n, -1, -1, -1 )
324  maxwrk = n + 2*n*nb
325  work(1) = maxwrk
326  rwork(1) = n
327  lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 )
328  IF( .NOT.rightv .AND. .NOT.leftv ) THEN
329  info = -1
330  ELSE IF( .NOT.allv .AND. .NOT.over .AND. .NOT.somev ) THEN
331  info = -2
332  ELSE IF( n.LT.0 ) THEN
333  info = -4
334  ELSE IF( ldt.LT.max( 1, n ) ) THEN
335  info = -6
336  ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) ) THEN
337  info = -8
338  ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) ) THEN
339  info = -10
340  ELSE IF( mm.LT.m ) THEN
341  info = -11
342  ELSE IF( lwork.LT.max( 1, 2*n ) .AND. .NOT.lquery ) THEN
343  info = -14
344  ELSE IF ( lrwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
345  info = -16
346  END IF
347  IF( info.NE.0 ) THEN
348  CALL xerbla( 'CTREVC3', -info )
349  RETURN
350  ELSE IF( lquery ) THEN
351  RETURN
352  END IF
353 *
354 * Quick return if possible.
355 *
356  IF( n.EQ.0 )
357  $ RETURN
358 *
359 * Use blocked version of back-transformation if sufficient workspace.
360 * Zero-out the workspace to avoid potential NaN propagation.
361 *
362  IF( over .AND. lwork .GE. n + 2*n*nbmin ) THEN
363  nb = (lwork - n) / (2*n)
364  nb = min( nb, nbmax )
365  CALL claset( 'F', n, 1+2*nb, czero, czero, work, n )
366  ELSE
367  nb = 1
368  END IF
369 *
370 * Set the constants to control overflow.
371 *
372  unfl = slamch( 'Safe minimum' )
373  ovfl = one / unfl
374  CALL slabad( unfl, ovfl )
375  ulp = slamch( 'Precision' )
376  smlnum = unfl*( n / ulp )
377 *
378 * Store the diagonal elements of T in working array WORK.
379 *
380  DO 20 i = 1, n
381  work( i ) = t( i, i )
382  20 CONTINUE
383 *
384 * Compute 1-norm of each column of strictly upper triangular
385 * part of T to control overflow in triangular solver.
386 *
387  rwork( 1 ) = zero
388  DO 30 j = 2, n
389  rwork( j ) = scasum( j-1, t( 1, j ), 1 )
390  30 CONTINUE
391 *
392  IF( rightv ) THEN
393 *
394 * ============================================================
395 * Compute right eigenvectors.
396 *
397 * IV is index of column in current block.
398 * Non-blocked version always uses IV=NB=1;
399 * blocked version starts with IV=NB, goes down to 1.
400 * (Note the "0-th" column is used to store the original diagonal.)
401  iv = nb
402  is = m
403  DO 80 ki = n, 1, -1
404  IF( somev ) THEN
405  IF( .NOT.SELECT( ki ) )
406  $ GO TO 80
407  END IF
408  smin = max( ulp*( cabs1( t( ki, ki ) ) ), smlnum )
409 *
410 * --------------------------------------------------------
411 * Complex right eigenvector
412 *
413  work( ki + iv*n ) = cone
414 *
415 * Form right-hand side.
416 *
417  DO 40 k = 1, ki - 1
418  work( k + iv*n ) = -t( k, ki )
419  40 CONTINUE
420 *
421 * Solve upper triangular system:
422 * [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK.
423 *
424  DO 50 k = 1, ki - 1
425  t( k, k ) = t( k, k ) - t( ki, ki )
426  IF( cabs1( t( k, k ) ).LT.smin )
427  $ t( k, k ) = smin
428  50 CONTINUE
429 *
430  IF( ki.GT.1 ) THEN
431  CALL clatrs( 'Upper', 'No transpose', 'Non-unit', 'Y',
432  $ ki-1, t, ldt, work( 1 + iv*n ), scale,
433  $ rwork, info )
434  work( ki + iv*n ) = scale
435  END IF
436 *
437 * Copy the vector x or Q*x to VR and normalize.
438 *
439  IF( .NOT.over ) THEN
440 * ------------------------------
441 * no back-transform: copy x to VR and normalize.
442  CALL ccopy( ki, work( 1 + iv*n ), 1, vr( 1, is ), 1 )
443 *
444  ii = icamax( ki, vr( 1, is ), 1 )
445  remax = one / cabs1( vr( ii, is ) )
446  CALL csscal( ki, remax, vr( 1, is ), 1 )
447 *
448  DO 60 k = ki + 1, n
449  vr( k, is ) = czero
450  60 CONTINUE
451 *
452  ELSE IF( nb.EQ.1 ) THEN
453 * ------------------------------
454 * version 1: back-transform each vector with GEMV, Q*x.
455  IF( ki.GT.1 )
456  $ CALL cgemv( 'N', n, ki-1, cone, vr, ldvr,
457  $ work( 1 + iv*n ), 1, cmplx( scale ),
458  $ vr( 1, ki ), 1 )
459 *
460  ii = icamax( n, vr( 1, ki ), 1 )
461  remax = one / cabs1( vr( ii, ki ) )
462  CALL csscal( n, remax, vr( 1, ki ), 1 )
463 *
464  ELSE
465 * ------------------------------
466 * version 2: back-transform block of vectors with GEMM
467 * zero out below vector
468  DO k = ki + 1, n
469  work( k + iv*n ) = czero
470  END DO
471 *
472 * Columns IV:NB of work are valid vectors.
473 * When the number of vectors stored reaches NB,
474 * or if this was last vector, do the GEMM
475  IF( (iv.EQ.1) .OR. (ki.EQ.1) ) THEN
476  CALL cgemm( 'N', 'N', n, nb-iv+1, ki+nb-iv, cone,
477  $ vr, ldvr,
478  $ work( 1 + (iv)*n ), n,
479  $ czero,
480  $ work( 1 + (nb+iv)*n ), n )
481 * normalize vectors
482  DO k = iv, nb
483  ii = icamax( n, work( 1 + (nb+k)*n ), 1 )
484  remax = one / cabs1( work( ii + (nb+k)*n ) )
485  CALL csscal( n, remax, work( 1 + (nb+k)*n ), 1 )
486  END DO
487  CALL clacpy( 'F', n, nb-iv+1,
488  $ work( 1 + (nb+iv)*n ), n,
489  $ vr( 1, ki ), ldvr )
490  iv = nb
491  ELSE
492  iv = iv - 1
493  END IF
494  END IF
495 *
496 * Restore the original diagonal elements of T.
497 *
498  DO 70 k = 1, ki - 1
499  t( k, k ) = work( k )
500  70 CONTINUE
501 *
502  is = is - 1
503  80 CONTINUE
504  END IF
505 *
506  IF( leftv ) THEN
507 *
508 * ============================================================
509 * Compute left eigenvectors.
510 *
511 * IV is index of column in current block.
512 * Non-blocked version always uses IV=1;
513 * blocked version starts with IV=1, goes up to NB.
514 * (Note the "0-th" column is used to store the original diagonal.)
515  iv = 1
516  is = 1
517  DO 130 ki = 1, n
518 *
519  IF( somev ) THEN
520  IF( .NOT.SELECT( ki ) )
521  $ GO TO 130
522  END IF
523  smin = max( ulp*( cabs1( t( ki, ki ) ) ), smlnum )
524 *
525 * --------------------------------------------------------
526 * Complex left eigenvector
527 *
528  work( ki + iv*n ) = cone
529 *
530 * Form right-hand side.
531 *
532  DO 90 k = ki + 1, n
533  work( k + iv*n ) = -conjg( t( ki, k ) )
534  90 CONTINUE
535 *
536 * Solve conjugate-transposed triangular system:
537 * [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK.
538 *
539  DO 100 k = ki + 1, n
540  t( k, k ) = t( k, k ) - t( ki, ki )
541  IF( cabs1( t( k, k ) ).LT.smin )
542  $ t( k, k ) = smin
543  100 CONTINUE
544 *
545  IF( ki.LT.n ) THEN
546  CALL clatrs( 'Upper', 'Conjugate transpose', 'Non-unit',
547  $ 'Y', n-ki, t( ki+1, ki+1 ), ldt,
548  $ work( ki+1 + iv*n ), scale, rwork, info )
549  work( ki + iv*n ) = scale
550  END IF
551 *
552 * Copy the vector x or Q*x to VL and normalize.
553 *
554  IF( .NOT.over ) THEN
555 * ------------------------------
556 * no back-transform: copy x to VL and normalize.
557  CALL ccopy( n-ki+1, work( ki + iv*n ), 1, vl(ki,is), 1 )
558 *
559  ii = icamax( n-ki+1, vl( ki, is ), 1 ) + ki - 1
560  remax = one / cabs1( vl( ii, is ) )
561  CALL csscal( n-ki+1, remax, vl( ki, is ), 1 )
562 *
563  DO 110 k = 1, ki - 1
564  vl( k, is ) = czero
565  110 CONTINUE
566 *
567  ELSE IF( nb.EQ.1 ) THEN
568 * ------------------------------
569 * version 1: back-transform each vector with GEMV, Q*x.
570  IF( ki.LT.n )
571  $ CALL cgemv( 'N', n, n-ki, cone, vl( 1, ki+1 ), ldvl,
572  $ work( ki+1 + iv*n ), 1, cmplx( scale ),
573  $ vl( 1, ki ), 1 )
574 *
575  ii = icamax( n, vl( 1, ki ), 1 )
576  remax = one / cabs1( vl( ii, ki ) )
577  CALL csscal( n, remax, vl( 1, ki ), 1 )
578 *
579  ELSE
580 * ------------------------------
581 * version 2: back-transform block of vectors with GEMM
582 * zero out above vector
583 * could go from KI-NV+1 to KI-1
584  DO k = 1, ki - 1
585  work( k + iv*n ) = czero
586  END DO
587 *
588 * Columns 1:IV of work are valid vectors.
589 * When the number of vectors stored reaches NB,
590 * or if this was last vector, do the GEMM
591  IF( (iv.EQ.nb) .OR. (ki.EQ.n) ) THEN
592  CALL cgemm( 'N', 'N', n, iv, n-ki+iv, cone,
593  $ vl( 1, ki-iv+1 ), ldvl,
594  $ work( ki-iv+1 + (1)*n ), n,
595  $ czero,
596  $ work( 1 + (nb+1)*n ), n )
597 * normalize vectors
598  DO k = 1, iv
599  ii = icamax( n, work( 1 + (nb+k)*n ), 1 )
600  remax = one / cabs1( work( ii + (nb+k)*n ) )
601  CALL csscal( n, remax, work( 1 + (nb+k)*n ), 1 )
602  END DO
603  CALL clacpy( 'F', n, iv,
604  $ work( 1 + (nb+1)*n ), n,
605  $ vl( 1, ki-iv+1 ), ldvl )
606  iv = 1
607  ELSE
608  iv = iv + 1
609  END IF
610  END IF
611 *
612 * Restore the original diagonal elements of T.
613 *
614  DO 120 k = ki + 1, n
615  t( k, k ) = work( k )
616  120 CONTINUE
617 *
618  is = is + 1
619  130 CONTINUE
620  END IF
621 *
622  RETURN
623 *
624 * End of CTREVC3
625 *
626  END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:158
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:187
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:239
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:106
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine ctrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
CTREVC3
Definition: ctrevc3.f:244