Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

ctrevc (3p)

Name

ctrevc - compute some or all of the right and/or left eigenvectors of a complex upper triangular matrix T

Synopsis

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

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

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

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




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

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

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

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




C INTERFACE
#include <sunperf.h>

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

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

Description

Oracle Solaris Studio Performance Library                           ctrevc(3P)



NAME
       ctrevc - compute some or all of the right and/or left eigenvectors of a
       complex upper triangular matrix T


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

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

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

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




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

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

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

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




   C INTERFACE
       #include <sunperf.h>

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

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



PURPOSE
       ctrevc computes some or all of the right and/or left eigenvectors of  a
       complex upper 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 unitary
       matrix. If T was obtained from the Schur factorization of  an  original
       matrix  A  = Q*T*Q', then Q*X and Q*Y are the matrices of right or left
       eigenvectors of A.


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 eigenvector corresponding to the j-th eigenvalue,
                 SELECT(j) must be set to .TRUE..


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


       T (input/output)
                 The upper triangular matrix T.  T is modified,  but  restored
                 on exit.


       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  unitary  matrix  Q  of
                 Schur vectors returned by CHSEQR).  On exit, if SIDE = 'L' or
                 'B', VL contains: if HOWMNY =  'A',  the  matrix  Y  of  left
                 eigenvectors  of  T;  VL is lower triangular. The i-th column
                 VL(i) of VL is the eigenvector corresponding to  T(i,i).   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.
                 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  unitary  matrix  Q  of
                 Schur vectors returned by CHSEQR).  On exit, if SIDE = 'R' or
                 'B', VR contains: if HOWMNY = 'A',  the  matrix  X  of  right
                 eigenvectors  of  T;  VR is upper triangular. The i-th column
                 VR(i) of VR is the eigenvector corresponding to  T(i,i).   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.
                 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 eigenvector occupies one column.


       WORK (workspace)
                 dimension(2*N)

       RWORK (workspace)
                 dimension(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                        ctrevc(3P)