LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sgegs()

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

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

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

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

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

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

 where Q and Z are orthogonal matrices, T is upper triangular, and S
 is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
 blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
 of eigenvalues of (A,B).  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
 SGEGV should be used instead.  See SGEGV 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 REAL array, dimension (LDA, N)
          On entry, the matrix A.
          On exit, the upper quasi-triangular matrix S from the
          generalized real Schur factorization.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is REAL array, dimension (LDB, N)
          On entry, the matrix B.
          On exit, the upper triangular matrix T from the generalized
          real Schur factorization.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is REAL array, dimension (N)
          The real parts of each scalar alpha defining an eigenvalue
          of GNEP.
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
          The imaginary parts of each scalar alpha defining an
          eigenvalue of GNEP.  If ALPHAI(j) is zero, then the j-th
          eigenvalue is real; if positive, then the j-th and (j+1)-st
          eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) = -ALPHAI(j).
[out]BETA
          BETA is REAL array, dimension (N)
          The scalars beta that define the eigenvalues of GNEP.
          Together, the quantities alpha = (ALPHAR(j),ALPHAI(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 REAL 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 REAL 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 REAL 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,4*N).
          For good performance, LWORK must generally be larger.
          To compute the optimal value of LWORK, call ILAENV to get
          blocksizes (for SGEQRF, SORMQR, and SORGQR.)  Then compute:
          NB  -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR
          The optimal LWORK is  2*N + 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]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 ALPHAR(j), ALPHAI(j), and BETA(j) should
                be correct for j=INFO+1,...,N.
          > N:  errors that usually indicate LAPACK problems:
                =N+1: error return from SGGBAL
                =N+2: error return from SGEQRF
                =N+3: error return from SORMQR
                =N+4: error return from SORGQR
                =N+5: error return from SGGHRD
                =N+6: error return from SHGEQZ (other than failed
                                                iteration)
                =N+7: error return from SGGBAK (computing VSL)
                =N+8: error return from SGGBAK (computing VSR)
                =N+9: error return from SLASCL (various places)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 224 of file sgegs.f.

227 *
228 * -- LAPACK driver routine --
229 * -- LAPACK is a software package provided by Univ. of Tennessee, --
230 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
231 *
232 * .. Scalar Arguments ..
233  CHARACTER JOBVSL, JOBVSR
234  INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N
235 * ..
236 * .. Array Arguments ..
237  REAL A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
238  $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
239  $ VSR( LDVSR, * ), WORK( * )
240 * ..
241 *
242 * =====================================================================
243 *
244 * .. Parameters ..
245  REAL ZERO, ONE
246  parameter( zero = 0.0e0, one = 1.0e0 )
247 * ..
248 * .. Local Scalars ..
249  LOGICAL ILASCL, ILBSCL, ILVSL, ILVSR, LQUERY
250  INTEGER ICOLS, IHI, IINFO, IJOBVL, IJOBVR, ILEFT,
251  $ ILO, IRIGHT, IROWS, ITAU, IWORK, LOPT, LWKMIN,
252  $ LWKOPT, NB, NB1, NB2, NB3
253  REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS,
254  $ SAFMIN, SMLNUM
255 * ..
256 * .. External Subroutines ..
257  EXTERNAL sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slacpy,
259 * ..
260 * .. External Functions ..
261  LOGICAL LSAME
262  INTEGER ILAENV
263  REAL SLAMCH, SLANGE
264  EXTERNAL ilaenv, lsame, slamch, slange
265 * ..
266 * .. Intrinsic Functions ..
267  INTRINSIC int, max
268 * ..
269 * .. Executable Statements ..
270 *
271 * Decode the input arguments
272 *
273  IF( lsame( jobvsl, 'N' ) ) THEN
274  ijobvl = 1
275  ilvsl = .false.
276  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
277  ijobvl = 2
278  ilvsl = .true.
279  ELSE
280  ijobvl = -1
281  ilvsl = .false.
282  END IF
283 *
284  IF( lsame( jobvsr, 'N' ) ) THEN
285  ijobvr = 1
286  ilvsr = .false.
287  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
288  ijobvr = 2
289  ilvsr = .true.
290  ELSE
291  ijobvr = -1
292  ilvsr = .false.
293  END IF
294 *
295 * Test the input arguments
296 *
297  lwkmin = max( 4*n, 1 )
298  lwkopt = lwkmin
299  work( 1 ) = lwkopt
300  lquery = ( lwork.EQ.-1 )
301  info = 0
302  IF( ijobvl.LE.0 ) THEN
303  info = -1
304  ELSE IF( ijobvr.LE.0 ) THEN
305  info = -2
306  ELSE IF( n.LT.0 ) THEN
307  info = -3
308  ELSE IF( lda.LT.max( 1, n ) ) THEN
309  info = -5
310  ELSE IF( ldb.LT.max( 1, n ) ) THEN
311  info = -7
312  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
313  info = -12
314  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
315  info = -14
316  ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery ) THEN
317  info = -16
318  END IF
319 *
320  IF( info.EQ.0 ) THEN
321  nb1 = ilaenv( 1, 'SGEQRF', ' ', n, n, -1, -1 )
322  nb2 = ilaenv( 1, 'SORMQR', ' ', n, n, n, -1 )
323  nb3 = ilaenv( 1, 'SORGQR', ' ', n, n, n, -1 )
324  nb = max( nb1, nb2, nb3 )
325  lopt = 2*n+n*(nb+1)
326  work( 1 ) = lopt
327  END IF
328 *
329  IF( info.NE.0 ) THEN
330  CALL xerbla( 'SGEGS ', -info )
331  RETURN
332  ELSE IF( lquery ) THEN
333  RETURN
334  END IF
335 *
336 * Quick return if possible
337 *
338  IF( n.EQ.0 )
339  $ RETURN
340 *
341 * Get machine constants
342 *
343  eps = slamch( 'E' )*slamch( 'B' )
344  safmin = slamch( 'S' )
345  smlnum = n*safmin / eps
346  bignum = one / smlnum
347 *
348 * Scale A if max element outside range [SMLNUM,BIGNUM]
349 *
350  anrm = slange( 'M', n, n, a, lda, work )
351  ilascl = .false.
352  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
353  anrmto = smlnum
354  ilascl = .true.
355  ELSE IF( anrm.GT.bignum ) THEN
356  anrmto = bignum
357  ilascl = .true.
358  END IF
359 *
360  IF( ilascl ) THEN
361  CALL slascl( 'G', -1, -1, anrm, anrmto, n, n, a, lda, iinfo )
362  IF( iinfo.NE.0 ) THEN
363  info = n + 9
364  RETURN
365  END IF
366  END IF
367 *
368 * Scale B if max element outside range [SMLNUM,BIGNUM]
369 *
370  bnrm = slange( 'M', n, n, b, ldb, work )
371  ilbscl = .false.
372  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
373  bnrmto = smlnum
374  ilbscl = .true.
375  ELSE IF( bnrm.GT.bignum ) THEN
376  bnrmto = bignum
377  ilbscl = .true.
378  END IF
379 *
380  IF( ilbscl ) THEN
381  CALL slascl( 'G', -1, -1, bnrm, bnrmto, n, n, b, ldb, iinfo )
382  IF( iinfo.NE.0 ) THEN
383  info = n + 9
384  RETURN
385  END IF
386  END IF
387 *
388 * Permute the matrix to make it more nearly triangular
389 * Workspace layout: (2*N words -- "work..." not actually used)
390 * left_permutation, right_permutation, work...
391 *
392  ileft = 1
393  iright = n + 1
394  iwork = iright + n
395  CALL sggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
396  $ work( iright ), work( iwork ), iinfo )
397  IF( iinfo.NE.0 ) THEN
398  info = n + 1
399  GO TO 10
400  END IF
401 *
402 * Reduce B to triangular form, and initialize VSL and/or VSR
403 * Workspace layout: ("work..." must have at least N words)
404 * left_permutation, right_permutation, tau, work...
405 *
406  irows = ihi + 1 - ilo
407  icols = n + 1 - ilo
408  itau = iwork
409  iwork = itau + irows
410  CALL sgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
411  $ work( iwork ), lwork+1-iwork, iinfo )
412  IF( iinfo.GE.0 )
413  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
414  IF( iinfo.NE.0 ) THEN
415  info = n + 2
416  GO TO 10
417  END IF
418 *
419  CALL sormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
420  $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
421  $ lwork+1-iwork, iinfo )
422  IF( iinfo.GE.0 )
423  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
424  IF( iinfo.NE.0 ) THEN
425  info = n + 3
426  GO TO 10
427  END IF
428 *
429  IF( ilvsl ) THEN
430  CALL slaset( 'Full', n, n, zero, one, vsl, ldvsl )
431  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
432  $ vsl( ilo+1, ilo ), ldvsl )
433  CALL sorgqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
434  $ work( itau ), work( iwork ), lwork+1-iwork,
435  $ iinfo )
436  IF( iinfo.GE.0 )
437  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
438  IF( iinfo.NE.0 ) THEN
439  info = n + 4
440  GO TO 10
441  END IF
442  END IF
443 *
444  IF( ilvsr )
445  $ CALL slaset( 'Full', n, n, zero, one, vsr, ldvsr )
446 *
447 * Reduce to generalized Hessenberg form
448 *
449  CALL sgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
450  $ ldvsl, vsr, ldvsr, iinfo )
451  IF( iinfo.NE.0 ) THEN
452  info = n + 5
453  GO TO 10
454  END IF
455 *
456 * Perform QZ algorithm, computing Schur vectors if desired
457 * Workspace layout: ("work..." must have at least 1 word)
458 * left_permutation, right_permutation, work...
459 *
460  iwork = itau
461  CALL shgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
462  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
463  $ work( iwork ), lwork+1-iwork, 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 sggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
481  $ work( 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 sggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
489  $ work( 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 slascl( 'H', -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 slascl( 'G', -1, -1, anrmto, anrm, n, 1, alphar, n,
505  $ iinfo )
506  IF( iinfo.NE.0 ) THEN
507  info = n + 9
508  RETURN
509  END IF
510  CALL slascl( 'G', -1, -1, anrmto, anrm, n, 1, alphai, n,
511  $ iinfo )
512  IF( iinfo.NE.0 ) THEN
513  info = n + 9
514  RETURN
515  END IF
516  END IF
517 *
518  IF( ilbscl ) THEN
519  CALL slascl( 'U', -1, -1, bnrmto, bnrm, n, n, b, ldb, iinfo )
520  IF( iinfo.NE.0 ) THEN
521  info = n + 9
522  RETURN
523  END IF
524  CALL slascl( 'G', -1, -1, bnrmto, bnrm, n, 1, beta, n, iinfo )
525  IF( iinfo.NE.0 ) THEN
526  info = n + 9
527  RETURN
528  END IF
529  END IF
530 *
531  10 CONTINUE
532  work( 1 ) = lwkopt
533 *
534  RETURN
535 *
536 * End of SGEGS
537 *
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:143
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:147
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:177
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:114
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:145
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:304
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:128
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:168
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:207
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function: