LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cgegs()

subroutine cgegs ( character  JOBVSL,
character  JOBVSR,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldb, * )  B,
integer  LDB,
complex, dimension( * )  ALPHA,
complex, dimension( * )  BETA,
complex, dimension( ldvsl, * )  VSL,
integer  LDVSL,
complex, dimension( ldvsr, * )  VSR,
integer  LDVSR,
complex, dimension( * )  WORK,
integer  LWORK,
real, dimension( * )  RWORK,
integer  INFO 
)

CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download CGEGS + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 This routine is deprecated and has been replaced by routine CGGES.

 CGEGS computes the eigenvalues, Schur form, and, optionally, the
 left and or/right Schur vectors of a complex matrix pair (A,B).
 Given two square matrices A and B, the generalized Schur
 factorization has the form

    A = Q*S*Z**H,  B = Q*T*Z**H

 where Q and Z are unitary matrices and S and T are upper triangular.
 The columns of Q are the left Schur vectors
 and the columns of Z are the right Schur vectors.

 If only the eigenvalues of (A,B) are needed, the driver routine
 CGEGV should be used instead.  See CGEGV for a description of the
 eigenvalues of the generalized nonsymmetric eigenvalue problem
 (GNEP).
Parameters
[in]JOBVSL
          JOBVSL is CHARACTER*1
          = 'N':  do not compute the left Schur vectors;
          = 'V':  compute the left Schur vectors (returned in VSL).
[in]JOBVSR
          JOBVSR is CHARACTER*1
          = 'N':  do not compute the right Schur vectors;
          = 'V':  compute the right Schur vectors (returned in VSR).
[in]N
          N is INTEGER
          The order of the matrices A, B, VSL, and VSR.  N >= 0.
[in,out]A
          A is COMPLEX array, dimension (LDA, N)
          On entry, the matrix A.
          On exit, the upper triangular matrix S from the generalized
          Schur factorization.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is COMPLEX array, dimension (LDB, N)
          On entry, the matrix B.
          On exit, the upper triangular matrix T from the generalized
          Schur factorization.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHA
          ALPHA is COMPLEX array, dimension (N)
          The complex scalars alpha that define the eigenvalues of
          GNEP.  ALPHA(j) = S(j,j), the diagonal element of the Schur
          form of A.
[out]BETA
          BETA is COMPLEX array, dimension (N)
          The non-negative real scalars beta that define the
          eigenvalues of GNEP.  BETA(j) = T(j,j), the diagonal element
          of the triangular factor T.

          Together, the quantities alpha = ALPHA(j) and beta = BETA(j)
          represent the j-th eigenvalue of the matrix pair (A,B), in
          one of the forms lambda = alpha/beta or mu = beta/alpha.
          Since either lambda or mu may overflow, they should not,
          in general, be computed.
[out]VSL
          VSL is COMPLEX array, dimension (LDVSL,N)
          If JOBVSL = 'V', the matrix of left Schur vectors Q.
          Not referenced if JOBVSL = 'N'.
[in]LDVSL
          LDVSL is INTEGER
          The leading dimension of the matrix VSL. LDVSL >= 1, and
          if JOBVSL = 'V', LDVSL >= N.
[out]VSR
          VSR is COMPLEX array, dimension (LDVSR,N)
          If JOBVSR = 'V', the matrix of right Schur vectors Z.
          Not referenced if JOBVSR = 'N'.
[in]LDVSR
          LDVSR is INTEGER
          The leading dimension of the matrix VSR. LDVSR >= 1, and
          if JOBVSR = 'V', LDVSR >= N.
[out]WORK
          WORK is COMPLEX array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,2*N).
          For good performance, LWORK must generally be larger.
          To compute the optimal value of LWORK, call ILAENV to get
          blocksizes (for CGEQRF, CUNMQR, and CUNGQR.)  Then compute:
          NB  -- MAX of the blocksizes for CGEQRF, CUNMQR, and CUNGQR;
          the optimal LWORK is N*(NB+1).

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]RWORK
          RWORK is REAL array, dimension (3*N)
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          =1,...,N:
                The QZ iteration failed.  (A,B) are not in Schur
                form, but ALPHA(j) and BETA(j) should be correct for
                j=INFO+1,...,N.
          > N:  errors that usually indicate LAPACK problems:
                =N+1: error return from CGGBAL
                =N+2: error return from CGEQRF
                =N+3: error return from CUNMQR
                =N+4: error return from CUNGQR
                =N+5: error return from CGGHRD
                =N+6: error return from CHGEQZ (other than failed
                                               iteration)
                =N+7: error return from CGGBAK (computing VSL)
                =N+8: error return from CGGBAK (computing VSR)
                =N+9: error return from CLASCL (various places)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 227 of file cgegs.f.

227 *
228 * -- LAPACK driver routine (version 3.7.0) --
229 * -- LAPACK is a software package provided by Univ. of Tennessee, --
230 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
231 * December 2016
232 *
233 * .. Scalar Arguments ..
234  CHARACTER jobvsl, jobvsr
235  INTEGER info, lda, ldb, ldvsl, ldvsr, lwork, n
236 * ..
237 * .. Array Arguments ..
238  REAL rwork( * )
239  COMPLEX a( lda, * ), alpha( * ), b( ldb, * ),
240  $ beta( * ), vsl( ldvsl, * ), vsr( ldvsr, * ),
241  $ work( * )
242 * ..
243 *
244 * =====================================================================
245 *
246 * .. Parameters ..
247  REAL zero, one
248  parameter( zero = 0.0e0, one = 1.0e0 )
249  COMPLEX czero, cone
250  parameter( czero = ( 0.0e0, 0.0e0 ),
251  $ cone = ( 1.0e0, 0.0e0 ) )
252 * ..
253 * .. Local Scalars ..
254  LOGICAL ilascl, ilbscl, ilvsl, ilvsr, lquery
255  INTEGER icols, ihi, iinfo, ijobvl, ijobvr, ileft,
256  $ ilo, iright, irows, irwork, itau, iwork,
257  $ lopt, lwkmin, lwkopt, nb, nb1, nb2, nb3
258  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps,
259  $ safmin, smlnum
260 * ..
261 * .. External Subroutines ..
262  EXTERNAL cgeqrf, cggbak, cggbal, cgghrd, chgeqz, clacpy,
264 * ..
265 * .. External Functions ..
266  LOGICAL lsame
267  INTEGER ilaenv
268  REAL clange, slamch
269  EXTERNAL ilaenv, lsame, clange, slamch
270 * ..
271 * .. Intrinsic Functions ..
272  INTRINSIC int, max
273 * ..
274 * .. Executable Statements ..
275 *
276 * Decode the input arguments
277 *
278  IF( lsame( jobvsl, 'N' ) ) THEN
279  ijobvl = 1
280  ilvsl = .false.
281  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
282  ijobvl = 2
283  ilvsl = .true.
284  ELSE
285  ijobvl = -1
286  ilvsl = .false.
287  END IF
288 *
289  IF( lsame( jobvsr, 'N' ) ) THEN
290  ijobvr = 1
291  ilvsr = .false.
292  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
293  ijobvr = 2
294  ilvsr = .true.
295  ELSE
296  ijobvr = -1
297  ilvsr = .false.
298  END IF
299 *
300 * Test the input arguments
301 *
302  lwkmin = max( 2*n, 1 )
303  lwkopt = lwkmin
304  work( 1 ) = lwkopt
305  lquery = ( lwork.EQ.-1 )
306  info = 0
307  IF( ijobvl.LE.0 ) THEN
308  info = -1
309  ELSE IF( ijobvr.LE.0 ) THEN
310  info = -2
311  ELSE IF( n.LT.0 ) THEN
312  info = -3
313  ELSE IF( lda.LT.max( 1, n ) ) THEN
314  info = -5
315  ELSE IF( ldb.LT.max( 1, n ) ) THEN
316  info = -7
317  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
318  info = -11
319  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
320  info = -13
321  ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery ) THEN
322  info = -15
323  END IF
324 *
325  IF( info.EQ.0 ) THEN
326  nb1 = ilaenv( 1, 'CGEQRF', ' ', n, n, -1, -1 )
327  nb2 = ilaenv( 1, 'CUNMQR', ' ', n, n, n, -1 )
328  nb3 = ilaenv( 1, 'CUNGQR', ' ', n, n, n, -1 )
329  nb = max( nb1, nb2, nb3 )
330  lopt = n*(nb+1)
331  work( 1 ) = lopt
332  END IF
333 *
334  IF( info.NE.0 ) THEN
335  CALL xerbla( 'CGEGS ', -info )
336  RETURN
337  ELSE IF( lquery ) THEN
338  RETURN
339  END IF
340 *
341 * Quick return if possible
342 *
343  IF( n.EQ.0 )
344  $ RETURN
345 *
346 * Get machine constants
347 *
348  eps = slamch( 'E' )*slamch( 'B' )
349  safmin = slamch( 'S' )
350  smlnum = n*safmin / eps
351  bignum = one / smlnum
352 *
353 * Scale A if max element outside range [SMLNUM,BIGNUM]
354 *
355  anrm = clange( 'M', n, n, a, lda, rwork )
356  ilascl = .false.
357  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
358  anrmto = smlnum
359  ilascl = .true.
360  ELSE IF( anrm.GT.bignum ) THEN
361  anrmto = bignum
362  ilascl = .true.
363  END IF
364 *
365  IF( ilascl ) THEN
366  CALL clascl( 'G', -1, -1, anrm, anrmto, n, n, a, lda, iinfo )
367  IF( iinfo.NE.0 ) THEN
368  info = n + 9
369  RETURN
370  END IF
371  END IF
372 *
373 * Scale B if max element outside range [SMLNUM,BIGNUM]
374 *
375  bnrm = clange( 'M', n, n, b, ldb, rwork )
376  ilbscl = .false.
377  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
378  bnrmto = smlnum
379  ilbscl = .true.
380  ELSE IF( bnrm.GT.bignum ) THEN
381  bnrmto = bignum
382  ilbscl = .true.
383  END IF
384 *
385  IF( ilbscl ) THEN
386  CALL clascl( 'G', -1, -1, bnrm, bnrmto, n, n, b, ldb, iinfo )
387  IF( iinfo.NE.0 ) THEN
388  info = n + 9
389  RETURN
390  END IF
391  END IF
392 *
393 * Permute the matrix to make it more nearly triangular
394 *
395  ileft = 1
396  iright = n + 1
397  irwork = iright + n
398  iwork = 1
399  CALL cggbal( 'P', n, a, lda, b, ldb, ilo, ihi, rwork( ileft ),
400  $ rwork( iright ), rwork( irwork ), iinfo )
401  IF( iinfo.NE.0 ) THEN
402  info = n + 1
403  GO TO 10
404  END IF
405 *
406 * Reduce B to triangular form, and initialize VSL and/or VSR
407 *
408  irows = ihi + 1 - ilo
409  icols = n + 1 - ilo
410  itau = iwork
411  iwork = itau + irows
412  CALL cgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
413  $ work( iwork ), lwork+1-iwork, iinfo )
414  IF( iinfo.GE.0 )
415  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
416  IF( iinfo.NE.0 ) THEN
417  info = n + 2
418  GO TO 10
419  END IF
420 *
421  CALL cunmqr( 'L', 'C', irows, icols, irows, b( ilo, ilo ), ldb,
422  $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
423  $ lwork+1-iwork, iinfo )
424  IF( iinfo.GE.0 )
425  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
426  IF( iinfo.NE.0 ) THEN
427  info = n + 3
428  GO TO 10
429  END IF
430 *
431  IF( ilvsl ) THEN
432  CALL claset( 'Full', n, n, czero, cone, vsl, ldvsl )
433  CALL clacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
434  $ vsl( ilo+1, ilo ), ldvsl )
435  CALL cungqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
436  $ work( itau ), work( iwork ), lwork+1-iwork,
437  $ iinfo )
438  IF( iinfo.GE.0 )
439  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
440  IF( iinfo.NE.0 ) THEN
441  info = n + 4
442  GO TO 10
443  END IF
444  END IF
445 *
446  IF( ilvsr )
447  $ CALL claset( 'Full', n, n, czero, cone, vsr, ldvsr )
448 *
449 * Reduce to generalized Hessenberg form
450 *
451  CALL cgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
452  $ ldvsl, vsr, ldvsr, iinfo )
453  IF( iinfo.NE.0 ) THEN
454  info = n + 5
455  GO TO 10
456  END IF
457 *
458 * Perform QZ algorithm, computing Schur vectors if desired
459 *
460  iwork = itau
461  CALL chgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
462  $ alpha, beta, vsl, ldvsl, vsr, ldvsr, work( iwork ),
463  $ lwork+1-iwork, rwork( irwork ), iinfo )
464  IF( iinfo.GE.0 )
465  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
466  IF( iinfo.NE.0 ) THEN
467  IF( iinfo.GT.0 .AND. iinfo.LE.n ) THEN
468  info = iinfo
469  ELSE IF( iinfo.GT.n .AND. iinfo.LE.2*n ) THEN
470  info = iinfo - n
471  ELSE
472  info = n + 6
473  END IF
474  GO TO 10
475  END IF
476 *
477 * Apply permutation to VSL and VSR
478 *
479  IF( ilvsl ) THEN
480  CALL cggbak( 'P', 'L', n, ilo, ihi, rwork( ileft ),
481  $ rwork( iright ), n, vsl, ldvsl, iinfo )
482  IF( iinfo.NE.0 ) THEN
483  info = n + 7
484  GO TO 10
485  END IF
486  END IF
487  IF( ilvsr ) THEN
488  CALL cggbak( 'P', 'R', n, ilo, ihi, rwork( ileft ),
489  $ rwork( iright ), n, vsr, ldvsr, iinfo )
490  IF( iinfo.NE.0 ) THEN
491  info = n + 8
492  GO TO 10
493  END IF
494  END IF
495 *
496 * Undo scaling
497 *
498  IF( ilascl ) THEN
499  CALL clascl( 'U', -1, -1, anrmto, anrm, n, n, a, lda, iinfo )
500  IF( iinfo.NE.0 ) THEN
501  info = n + 9
502  RETURN
503  END IF
504  CALL clascl( 'G', -1, -1, anrmto, anrm, n, 1, alpha, n, iinfo )
505  IF( iinfo.NE.0 ) THEN
506  info = n + 9
507  RETURN
508  END IF
509  END IF
510 *
511  IF( ilbscl ) THEN
512  CALL clascl( 'U', -1, -1, bnrmto, bnrm, n, n, b, ldb, iinfo )
513  IF( iinfo.NE.0 ) THEN
514  info = n + 9
515  RETURN
516  END IF
517  CALL clascl( 'G', -1, -1, bnrmto, bnrm, n, 1, beta, n, iinfo )
518  IF( iinfo.NE.0 ) THEN
519  info = n + 9
520  RETURN
521  END IF
522  END IF
523 *
524  10 CONTINUE
525  work( 1 ) = lwkopt
526 *
527  RETURN
528 *
529 * End of CGEGS
530 *
subroutine cggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
CGGBAL
Definition: cggbal.f:179
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 cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
Definition: cungqr.f:130
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: clascl.f:145
subroutine chgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, INFO)
CHGEQZ
Definition: chgeqz.f:286
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: tstiee.f:83
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
Definition: cgeqrf.f:138
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
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 cgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
CGGHRD
Definition: cgghrd.f:206
subroutine cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
Definition: cggbak.f:150
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
Definition: cunmqr.f:170
Here is the call graph for this function: