Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

dgees (3p)

Name

dgees - ues, the real Schur form T, and, optionally, the matrix of Schur vec- tors Z

Synopsis

SUBROUTINE DGEES(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
LDZ, WORK, LDWORK, WORK3, INFO)

CHARACTER*1 JOBZ, SORTEV
INTEGER N, LDA, NOUT, LDZ, LDWORK, INFO
LOGICAL SELECT
LOGICAL WORK3(*)
DOUBLE PRECISION A(LDA,*), WR(*), WI(*), Z(LDZ,*), WORK(*)

SUBROUTINE DGEES_64(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
LDZ, WORK, LDWORK, WORK3, INFO)

CHARACTER*1 JOBZ, SORTEV
INTEGER*8 N, LDA, NOUT, LDZ, LDWORK, INFO
LOGICAL*8 SELECT
LOGICAL*8 WORK3(*)
DOUBLE PRECISION A(LDA,*), WR(*), WI(*), Z(LDZ,*), WORK(*)




F95 INTERFACE
SUBROUTINE GEES(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
LDZ, WORK, LDWORK, WORK3, INFO)

CHARACTER(LEN=1) :: JOBZ, SORTEV
INTEGER :: N, LDA, NOUT, LDZ, LDWORK, INFO
LOGICAL :: SELECT
LOGICAL, DIMENSION(:) :: WORK3
REAL(8), DIMENSION(:) :: WR, WI, WORK
REAL(8), DIMENSION(:,:) :: A, Z

SUBROUTINE GEES_64(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI,
Z, LDZ, WORK, LDWORK, WORK3, INFO)

CHARACTER(LEN=1) :: JOBZ, SORTEV
INTEGER(8) :: N, LDA, NOUT, LDZ, LDWORK, INFO
LOGICAL(8) :: SELECT
LOGICAL(8), DIMENSION(:) :: WORK3
REAL(8), DIMENSION(:) :: WR, WI, WORK
REAL(8), DIMENSION(:,:) :: A, Z




C INTERFACE
#include <sunperf.h>

void  dgees(char jobz, char sortev, int(*select)(double,double), int n,
double *a, int lda, int *nout, double *wr, double *wi, double
*z, int ldz, int *info);

void  dgees_64(char  jobz,  char  sortev, long(*select)(double,double),
long n, double *a, long lda, long *nout, double  *wr,  double
*wi, double *z, long ldz, long *info);

Description

Oracle Solaris Studio Performance Library                            dgees(3P)



NAME
       dgees - compute for an N-by-N real nonsymmetric matrix A, the eigenval-
       ues, the real Schur form T, and, optionally, the matrix of  Schur  vec-
       tors Z


SYNOPSIS
       SUBROUTINE DGEES(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
             LDZ, WORK, LDWORK, WORK3, INFO)

       CHARACTER*1 JOBZ, SORTEV
       INTEGER N, LDA, NOUT, LDZ, LDWORK, INFO
       LOGICAL SELECT
       LOGICAL WORK3(*)
       DOUBLE PRECISION A(LDA,*), WR(*), WI(*), Z(LDZ,*), WORK(*)

       SUBROUTINE DGEES_64(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
             LDZ, WORK, LDWORK, WORK3, INFO)

       CHARACTER*1 JOBZ, SORTEV
       INTEGER*8 N, LDA, NOUT, LDZ, LDWORK, INFO
       LOGICAL*8 SELECT
       LOGICAL*8 WORK3(*)
       DOUBLE PRECISION A(LDA,*), WR(*), WI(*), Z(LDZ,*), WORK(*)




   F95 INTERFACE
       SUBROUTINE GEES(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI, Z,
              LDZ, WORK, LDWORK, WORK3, INFO)

       CHARACTER(LEN=1) :: JOBZ, SORTEV
       INTEGER :: N, LDA, NOUT, LDZ, LDWORK, INFO
       LOGICAL :: SELECT
       LOGICAL, DIMENSION(:) :: WORK3
       REAL(8), DIMENSION(:) :: WR, WI, WORK
       REAL(8), DIMENSION(:,:) :: A, Z

       SUBROUTINE GEES_64(JOBZ, SORTEV, SELECT, N, A, LDA, NOUT, WR, WI,
              Z, LDZ, WORK, LDWORK, WORK3, INFO)

       CHARACTER(LEN=1) :: JOBZ, SORTEV
       INTEGER(8) :: N, LDA, NOUT, LDZ, LDWORK, INFO
       LOGICAL(8) :: SELECT
       LOGICAL(8), DIMENSION(:) :: WORK3
       REAL(8), DIMENSION(:) :: WR, WI, WORK
       REAL(8), DIMENSION(:,:) :: A, Z




   C INTERFACE
       #include <sunperf.h>

       void  dgees(char jobz, char sortev, int(*select)(double,double), int n,
                 double *a, int lda, int *nout, double *wr, double *wi, double
                 *z, int ldz, int *info);

       void  dgees_64(char  jobz,  char  sortev, long(*select)(double,double),
                 long n, double *a, long lda, long *nout, double  *wr,  double
                 *wi, double *z, long ldz, long *info);



PURPOSE
       dgees  computes for an N-by-N real nonsymmetric matrix A, the eigenval-
       ues, the real Schur form T, and, optionally, the matrix of  Schur  vec-
       tors Z.  This gives the Schur factorization A = Z*T*(Z**T).

       Optionally,  it also orders the eigenvalues on the diagonal of the real
       Schur form so that selected eigenvalues are at the top left.  The lead-
       ing  columns of Z then form an orthonormal basis for the invariant sub-
       space corresponding to the selected eigenvalues.

       A matrix is in real Schur form if it  is  upper  quasi-triangular  with
       1-by-1  and  2-by-2  blocks.  2-by-2 blocks will be standardized in the
       form
               [  a  b  ]
               [  c  a  ]

       where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).


ARGUMENTS
       JOBZ (input)
                 = 'N': Schur vectors are not computed;
                 = 'V': Schur vectors are computed.


       SORTEV (input)
                 Specifies whether or not to  order  the  eigenvalues  on  the
                 diagonal  of  the  Schur  form.   =  'N': Eigenvalues are not
                 ordered;
                 = 'S': Eigenvalues are ordered (see SELECT).


       SELECT (input)
                 LOGICAL FUNCTION of two  DOUBLE  PRECISION  arguments  SELECT
                 must  be  declared  EXTERNAL  in  the calling subroutine.  If
                 SORTEV = 'S', SELECT is used to select eigenvalues to sort to
                 the  top  left of the Schur form.  If SORTEV = 'N', SELECT is
                 not  referenced.   An  eigenvalue   WR(j)+sqrt(-1)*WI(j)   is
                 selected  if SELECT(WR(j),WI(j)) is true; i.e., if either one
                 of a complex conjugate pair of eigenvalues is selected,  then
                 both  complex eigenvalues are selected.  Note that a selected
                 complex eigenvalue may no longer satisfy  SELECT(WR(j),WI(j))
                 =  .TRUE. after ordering, since ordering may change the value
                 of complex eigenvalues (especially if the eigenvalue is  ill-
                 conditioned);  in  this  case  INFO  is  set to N+2 (see INFO
                 below).


       N (input) The order of the matrix A. N >= 0.


       A (input/output)
                 DOUBLE PRECISION array, dimension(LDA,N) On entry, the N-by-N
                 matrix  A.  On exit, A has been overwritten by its real Schur
                 form T.


       LDA (input)
                 The leading dimension of the array A.  LDA >= max(1,N).


       NOUT (output)
                 If SORTEV = 'N', NOUT = 0.  If SORTEV = 'S', NOUT = number of
                 eigenvalues  (after  sorting) for which SELECT is true. (Com-
                 plex conjugate pairs for which SELECT is true for either  ei-
                 genvalue count as 2.)


       WR (output)
                 WR and WI contain the real and imaginary parts, respectively,
                 of the computed eigenvalues  in  the  same  order  that  they
                 appear  on  the diagonal of the output Schur form T.  Complex
                 conjugate pairs of eigenvalues will appear consecutively with
                 the eigenvalue having the positive imaginary part first.


       WI (output)
                 See the description for WR.


       Z (output)
                 If  JOBZ  =  'V', Z contains the orthogonal matrix Z of Schur
                 vectors.  If JOBZ = 'N', Z is not referenced.


       LDZ (input)
                 The leading dimension of the array Z.  LDZ >= 1;  if  JOBZ  =
                 'V', LDZ >= N.


       WORK (workspace)
                 On exit, if INFO = 0, WORK(1) contains the optimal LDWORK.


       LDWORK (input)
                 The  dimension of the array WORK.  LDWORK >= max(1,3*N).  For
                 good performance, LDWORK must generally be larger.

                 If LDWORK = -1, then a workspace query is assumed;  the  rou-
                 tine  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 LDWORK is issued by XERBLA.


       WORK3 (workspace)
                 dimension(N) Not referenced if SORTEV = 'N'.


       INFO (output)
                 = 0: successful exit
                 < 0: if INFO = -i, the i-th argument had an illegal value.
                 > 0: if INFO = i, and i is
                 <= N: the QR algorithm failed to compute all the
                 eigenvalues;  elements 1:ILO-1 and i+1:N of WR and WI contain
                 those eigenvalues which have converged; if JOBZ = 'V', Z con-
                 tains  the  matrix which reduces A to its partially converged
                 Schur form.  = N+1: the eigenvalues could  not  be  reordered
                 because  some  eigenvalues  were  too  close to separate (the
                 problem is very ill-conditioned); =  N+2:  after  reordering,
                 roundoff  changed  values of some complex eigenvalues so that
                 leading eigenvalues in  the  Schur  form  no  longer  satisfy
                 SELECT=.TRUE.   This could also be caused by underflow due to
                 scaling.




                                  7 Nov 2015                         dgees(3P)