Previous: dtbtrs Up: ../lapack-d.html Next: dtgsja
NAME
DTGEVC - compute selected left and/or right generalized
eigenvectors of a pair of real upper triangular matrices
(A,B)
SYNOPSIS
SUBROUTINE DTGEVC( JOB, SIDE, SELECT, N, A, LDA, B, LDB, VL,
LDVL, VR, LDVR, MM, M, WORK, INFO )
CHARACTER JOB, SIDE
INTEGER INFO, LDA, LDB, LDVL, LDVR, M, MM, N
LOGICAL SELECT( * )
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), VL(
LDVL, * ), VR( LDVR, * ), WORK( N, * )
PURPOSE
DTGEVC computes selected left and/or right generalized
eigenvectors of a pair of real upper triangular matrices
(A,B). The j-th generalized left and right eigenvectors are
y and x, resp., such that:
H H
y (A - wB) = 0 or (A - wB) y = 0 and (A - wB)x =
0
H
Note: the left eigenvector is sometimes defined as the row
vector y
but DTGEVC computes the column vector y.
Reminder: the eigenvectors may be real or complex. If com-
plex, the
eigenvector for the eigenvalue w s.t. Im(w) > 0 is
computed.
ARGUMENTS
JOB (input) CHARACTER*1
= 'A': compute All (left/right/left+right) general-
ized eigenvectors of (A,B); = 'S': compute Selected
(left/right/left+right) generalized eigenvectors of
(A,B) -- see the description of the argument SELECT;
= 'B' or 'T': compute all (left/right/left+right)
generalized eigenvectors of (A,B), and Back
Transform them using the initial contents of VL/VR
-- see the descriptions of the arguments VL and VR.
SIDE (input) CHARACTER*1
Specifies for which side eigenvectors are to be com-
puted:
= 'R': compute right eigenvectors only;
= 'L': compute left eigenvectors only;
= 'B': compute both right and left eigenvectors.
SELECT (input) LOGICAL array, dimension (N)
If JOB='S', then SELECT specifies the (generalized)
eigenvectors to be computed. To get the eigenvector
corresponding to the j-th eigenvalue, set SELECT(j)
to .TRUE. If the j-th and (j+1)-st eigenvalues are
conjugates, i.e., A(j+1,j) is nonzero, then only the
eigenvector for the first may be selected (the
second being just the conjugate of the first); this
may be done by setting either SELECT(j) or
SELECT(j+1) to .TRUE.
If JOB='A', 'B', or 'T', SELECT is not referenced,
and all eigenvectors are selected.
N (input) INTEGER
The order of the matrices A and B. N >= 0.
A (input) DOUBLE PRECISION array, dimension (LDA,N)
One of the pair of matrices whose generalized eigen-
vectors are to be computed. It must be block upper
triangular, with 1-by-1 or 2-by-2 blocks on the
diagonal, the 1-by-1 blocks corresponding to real
generalized eigenvalues and the 2-by-2 blocks
corresponding to complex generalized eigenvalues.
The eigenvalues are computed from the diagonal
blocks of A and corresponding entries of B.
LDA (input) INTEGER
The leading dimension of array A. LDA >= max(1, N).
B (input) DOUBLE PRECISION array, dimension (LDB,N)
The other of the pair of matrices whose generalized
eigenvectors are to be computed. It must be upper
triangular, and if A has a 2-by-2 diagonal block in
rows/columns j,j+1, then the corresponding 2-by-2
block of B must be diagonal with positive entries.
LDB (input) INTEGER
The leading dimension of array B. LDB >= max(1, N).
(LDVL,MM)
VL (input/output) DOUBLE PRECISION array, dimension
On exit, the left eigenvectors (column vectors --
see the note in "Purpose".) Real eigenvectors take
one column, complex take two columns, the first for
the real part and the second for the imaginary part.
If JOB='A', then all left eigenvectors of (A,B) will
be computed and stored in VL. If JOB='S', then only
the eigenvectors selected by SELECT will be
computed, and they will be stored one right after
another in VL; the first selected eigenvector will
go in column 1 (and 2, if complex), the second in
the next column(s), etc. If JOB='B' or 'T', then
all left eigenvectors of (A,B) will be computed and
multiplied (on the left) by the matrix found in VL
on entry to DTGEVC. Usually, this will be the Q
matrix computed by DGGHRD and DHGEQZ, so that on
exit, VL will contain the left eigenvectors of the
original matrix pair. In any case, each eigenvector
will be scaled so the largest component of each vec-
tor has abs(real part) + abs(imag. part)=1, *unless*
the diagonal blocks in A and B corresponding to the
eigenvector are both zero (hence, 1-by-1), in which
case the eigenvector will be zero. If SIDE = 'R',
VL is not referenced.
LDVL (input) INTEGER
The leading dimension of array VL. LDVL >= 1; if
SIDE = 'B' or 'L', LDVL >= N.
VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
On exit, the right eigenvectors. Real eigenvectors
take one column, complex take two columns, the first
for the real part and the second for the imaginary
part. If JOB='A', then all right eigenvectors of
(A,B) will be computed and stored in VR. If
JOB='S', then only the eigenvectors selected by
SELECT will be computed, and they will be stored one
right after another in VR; the first selected eigen-
vector will go in column 1 (and 2, if complex), the
second in the next column(s), etc. If JOB='B' or
'T', then all right eigenvectors of (A,B) will be
computed and multiplied (on the left) by the matrix
found in VR on entry to DTGEVC. Usually, this will
be the Z matrix computed by DGGHRD and DHGEQZ, so
that on exit, VR will contain the right eigenvectors
of the original matrix pair. In any case, each
eigenvector will be scaled so the largest component
of each vector has abs(real part) + abs(imag.
part)=1, *unless* the diagonal blocks in A and B
corresponding to the eigenvector are both zero
(hence, 1-by-1), in which case the eigenvector will
be zero. If SIDE = 'L', VR is not referenced.
LDVR (input) INTEGER
The leading dimension of array VR. LDVR >= 1; if
SIDE = 'B' or 'R', LDVR >= N.
MM (input) INTEGER
The number of columns in VL and/or VR. If JOB='A',
'B', or 'T', then MM >= N. If JOB='S', then MM must
be at least the number of columns required, as com-
puted from SELECT. Each .TRUE. value in SELECT
corresponding to a real eigenvalue (i.e., A(j+1,j)
and A(j,j-1) are zero) counts for one column, and
each .TRUE. value corresponding to the first of a
complex conjugate pair (i.e., A(j+1,j) is not zero)
counts for two columns. (.TRUE. values correspond-
ing to the second of a pair -- A(j,j-1) is not zero
-- are ignored.)
M (output) INTEGER
The number of columns in VL and/or VR actually used
to store the eigenvectors.
WORK (workspace) DOUBLE PRECISION array, dimension ( N, 6 )
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal
value.
> 0: the 2-by-2 block (INFO:INFO+1) does not have a
complex eigenvalue.
FURTHER DETAILS
Allocation of workspace:
---------- -- ---------
WORK( j, 1 ) = 1-norm of j-th column of A, above the
diagonal
WORK( j, 2 ) = 1-norm of j-th column of B, above the
diagonal
WORK( *, 3 ) = real part of eigenvector
WORK( *, 4 ) = imaginary part of eigenvector
WORK( *, 5 ) = real part of back-transformed eigenvector
WORK( *, 6 ) = imaginary part of back-transformed eigen-
vector
Rowwise vs. columnwise solution methods:
------- -- ---------- -------- -------
Finding a generalized eigenvector consists basically of
solving the singular triangular system
H
(A - w B) x = 0 (for right) or: (A - w B) y = 0
(for left)
Consider finding the i-th right eigenvector (assume all
eigenvalues are real). The equation to be solved is:
n i
0 = sum C(j,k) v(k) = sum C(j,k) v(k) for j = i,. .
.,1
k=j k=j
where C = (A - w B) (The components v(i+1:n) are 0.)
The "rowwise" method is:
(1) v(i) := 1
for j = i-1,. . .,1:
i
(2) compute s = - sum C(j,k) v(k) and
k=j+1
(3) v(j) := s / C(j,j)
Step 2 is sometimes called the "dot product" step, since it
is an inner product between the j-th row and the portion of
the eigenvector that has been computed so far.
The "columnwise" method consists basically in doing the sums
for all the rows in parallel. As each v(j) is computed, the
contribution of v(j) times the j-th column of C is added to
the partial sums. Since FORTRAN arrays are stored column-
wise, this has the advantage that at each step, the entries
of C that are accessed are adjacent to one another, whereas
with the rowwise method, the entries accessed at a step are
spaced LDA (and LDB) words apart.
When finding left eigenvectors, the matrix in question is
the transpose of the one in storage, so the rowwise method
then actually accesses columns of A and B at each step, and
so is the preferred method.