Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

strevc (3p)

Name

strevc - compute some or all of the right and/or left eigenvectors of a real upper quasi-triangular matrix T

Synopsis

SUBROUTINE STREVC(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
LDVR, MM, M, WORK, INFO)

CHARACTER*1 SIDE, HOWMNY
INTEGER N, LDT, LDVL, LDVR, MM, M, INFO
LOGICAL SELECT(*)
REAL T(LDT,*), VL(LDVL,*), VR(LDVR,*), WORK(*)

SUBROUTINE STREVC_64(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
LDVR, MM, M, WORK, INFO)

CHARACTER*1 SIDE, HOWMNY
INTEGER*8 N, LDT, LDVL, LDVR, MM, M, INFO
LOGICAL*8 SELECT(*)
REAL T(LDT,*), VL(LDVL,*), VR(LDVR,*), WORK(*)




F95 INTERFACE
SUBROUTINE TREVC(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
LDVR, MM, M, WORK, INFO)

CHARACTER(LEN=1) :: SIDE, HOWMNY
INTEGER :: N, LDT, LDVL, LDVR, MM, M, INFO
LOGICAL, DIMENSION(:) :: SELECT
REAL, DIMENSION(:) :: WORK
REAL, DIMENSION(:,:) :: T, VL, VR

SUBROUTINE TREVC_64(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
VR, LDVR, MM, M, WORK, INFO)

CHARACTER(LEN=1) :: SIDE, HOWMNY
INTEGER(8) :: N, LDT, LDVL, LDVR, MM, M, INFO
LOGICAL(8), DIMENSION(:) :: SELECT
REAL, DIMENSION(:) :: WORK
REAL, DIMENSION(:,:) :: T, VL, VR




C INTERFACE
#include <sunperf.h>

void strevc(char side, char howmny, int *select, int n, float  *t,  int
ldt,  float  *vl,  int ldvl, float *vr, int ldvr, int mm, int
*m, int *info);

void strevc_64(char side, char howmny, long *select, long n, float  *t,
long  ldt,  float  *vl, long ldvl, float *vr, long ldvr, long
mm, long *m, long *info);

Description

Oracle Solaris Studio Performance Library                           strevc(3P)



NAME
       strevc - compute some or all of the right and/or left eigenvectors of a
       real upper quasi-triangular matrix T


SYNOPSIS
       SUBROUTINE STREVC(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
             LDVR, MM, M, WORK, INFO)

       CHARACTER*1 SIDE, HOWMNY
       INTEGER N, LDT, LDVL, LDVR, MM, M, INFO
       LOGICAL SELECT(*)
       REAL T(LDT,*), VL(LDVL,*), VR(LDVR,*), WORK(*)

       SUBROUTINE STREVC_64(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
             LDVR, MM, M, WORK, INFO)

       CHARACTER*1 SIDE, HOWMNY
       INTEGER*8 N, LDT, LDVL, LDVR, MM, M, INFO
       LOGICAL*8 SELECT(*)
       REAL T(LDT,*), VL(LDVL,*), VR(LDVR,*), WORK(*)




   F95 INTERFACE
       SUBROUTINE TREVC(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
              LDVR, MM, M, WORK, INFO)

       CHARACTER(LEN=1) :: SIDE, HOWMNY
       INTEGER :: N, LDT, LDVL, LDVR, MM, M, INFO
       LOGICAL, DIMENSION(:) :: SELECT
       REAL, DIMENSION(:) :: WORK
       REAL, DIMENSION(:,:) :: T, VL, VR

       SUBROUTINE TREVC_64(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
              VR, LDVR, MM, M, WORK, INFO)

       CHARACTER(LEN=1) :: SIDE, HOWMNY
       INTEGER(8) :: N, LDT, LDVL, LDVR, MM, M, INFO
       LOGICAL(8), DIMENSION(:) :: SELECT
       REAL, DIMENSION(:) :: WORK
       REAL, DIMENSION(:,:) :: T, VL, VR




   C INTERFACE
       #include <sunperf.h>

       void strevc(char side, char howmny, int *select, int n, float  *t,  int
                 ldt,  float  *vl,  int ldvl, float *vr, int ldvr, int mm, int
                 *m, int *info);

       void strevc_64(char side, char howmny, long *select, long n, float  *t,
                 long  ldt,  float  *vl, long ldvl, float *vr, long ldvr, long
                 mm, long *m, long *info);



PURPOSE
       strevc computes some or all of the right and/or left eigenvectors of  a
       real upper quasi-triangular matrix T.

       The  right  eigenvector x and the left eigenvector y of T corresponding
       to an eigenvalue w are defined by:

                    T*x = w*x,     y'*T = w*y'

       where y' denotes the conjugate transpose of the vector y.

       If all eigenvectors are requested, the routine may  either  return  the
       matrices X and/or Y of right or left eigenvectors of T, or the products
       Q*X and/or Q*Y, where Q is an input orthogonal
       matrix. If T was obtained from the real-Schur factorization of an orig-
       inal  matrix  A = Q*T*Q', then Q*X and Q*Y are the matrices of right or
       left eigenvectors of A.

       T must be in Schur canonical form (as returned  by  SHSEQR),  that  is,
       block  upper  triangular  with  1-by-1 and 2-by-2 diagonal blocks; each
       2-by-2 diagonal block has its diagonal elements equal and its off-diag-
       onal  elements of opposite sign.  Corresponding to each 2-by-2 diagonal
       block is a complex conjugate pair of eigenvalues and eigenvectors; only
       one  eigenvector  of the pair is computed, namely the one corresponding
       to the eigenvalue with positive imaginary part.


ARGUMENTS
       SIDE (input)
                 = 'R':  compute right eigenvectors only;
                 = 'L':  compute left eigenvectors only;
                 = 'B':  compute both right and left eigenvectors.


       HOWMNY (input)
                 = 'A':  compute all right and/or left eigenvectors;
                 = 'B':  compute all right and/or left eigenvectors, and back-
                 transform them using the input matrices supplied in VR and/or
                 VL; = 'S':  compute selected right and/or left  eigenvectors,
                 specified by the logical array SELECT.


       SELECT (input/output)
                 If HOWMNY = 'S', SELECT specifies the eigenvectors to be com-
                 puted.  If HOWMNY = 'A' or 'B', SELECT is not referenced.  To
                 select the real eigenvector corresponding to a real eigenval-
                 ue w(j), SELECT(j) must be set to .TRUE..  To select the com-
                 plex  eigenvector  corresponding  to a complex conjugate pair
                 w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be  set
                 to  .TRUE.;  then on exit SELECT(j) is .TRUE. and SELECT(j+1)
                 is .FALSE..


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


       T (input/output)
                 The upper quasi-triangular matrix T in Schur canonical  form.


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


       VL (input/output)
                 On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must con-
                 tain an N-by-N matrix Q (usually the orthogonal matrix  Q  of
                 Schur vectors returned by SHSEQR).  On exit, if SIDE = 'L' or
                 'B', VL contains: if HOWMNY =  'A',  the  matrix  Y  of  left
                 eigenvectors  of  T;  VL  has the same quasi-lower triangular
                 form as T'. If T(i,i) is a real  eigenvalue,  then  the  i-th
                 column  VL(i)  of  VL   is  its corresponding eigenvector. If
                 T(i:i+1,i:i+1) is a 2-by-2 block whose eigenvalues  are  com-
                 plex-conjugate  eigenvalues of T, then VL(i)+sqrt(-1)*VL(i+1)
                 is the complex eigenvector corresponding  to  the  eigenvalue
                 with positive real part.  if HOWMNY = 'B', the matrix Q*Y; if
                 HOWMNY = 'S', the left eigenvectors of T specified by SELECT,
                 stored  consecutively in the columns of VL, in the same order
                 as their eigenvalues.  A complex eigenvector corresponding to
                 a  complex  eigenvalue  is stored in two consecutive columns,
                 the first holding the real part, and the second the imaginary
                 part.  If SIDE = 'R', VL is not referenced.


       LDVL (input)
                 The  leading  dimension of the array VL.  LDVL >= max(1,N) if
                 SIDE = 'L' or 'B'; LDVL >= 1 otherwise.


       VR (input/output)
                 On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must con-
                 tain  an  N-by-N matrix Q (usually the orthogonal matrix Q of
                 Schur vectors returned by SHSEQR).  On exit, if SIDE = 'R' or
                 'B',  VR  contains:  if  HOWMNY  = 'A', the matrix X of right
                 eigenvectors of T; VR has  the  same  quasi-upper  triangular
                 form as T. If T(i,i) is a real eigenvalue, then the i-th col-
                 umn  VR(i)  of  VR   is  its  corresponding  eigenvector.  If
                 T(i:i+1,i:i+1)  is  a 2-by-2 block whose eigenvalues are com-
                 plex-conjugate eigenvalues of T, then  VR(i)+sqrt(-1)*VR(i+1)
                 is  the  complex  eigenvector corresponding to the eigenvalue
                 with positive real part.  if HOWMNY = 'B', the matrix Q*X; if
                 HOWMNY  =  'S',  the  right  eigenvectors  of  T specified by
                 SELECT, stored consecutively in the columns  of  VR,  in  the
                 same  order as their eigenvalues.  A complex eigenvector cor-
                 responding to a complex eigenvalue is stored in two  consecu-
                 tive  columns, the first holding the real part and the second
                 the imaginary part.  If SIDE = 'L', VR is not referenced.


       LDVR (input)
                 The leading dimension of the array VR.  LDVR >=  max(1,N)  if
                 SIDE = 'R' or 'B'; LDVR >= 1 otherwise.


       MM (input)
                 The number of columns in the arrays VL and/or VR. MM >= M.


       M (output)
                 The  number  of  columns  in the arrays VL and/or VR actually
                 used to store the eigenvectors.  If HOWMNY = 'A' or 'B', M is
                 set to N.  Each selected real eigenvector occupies one column
                 and each selected complex eigenvector occupies two columns.


       WORK (workspace)
                 dimension(3*N)

       INFO (output)
                 = 0:  successful exit
                 < 0:  if INFO = -i, the i-th argument had an illegal value

FURTHER DETAILS
       The algorithm used in this program is basically backward (forward) sub-
       stitution,  with  scaling  to make the the code robust against possible
       overflow.

       Each eigenvector is normalized so that the element of largest magnitude
       has  magnitude 1; here the magnitude of a complex number (x,y) is taken
       to be |x| + |y|.




                                  7 Nov 2015                        strevc(3P)