Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

ctrsen (3p)

Name

ctrsen - reorder the Schur factorization of a complex matrix A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in the leading positions on the diagonal of the upper triangular matrix T, and the leading columns of Q form an orthonormal basis of the corresponding right invariant subspace

Synopsis

SUBROUTINE CTRSEN(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
SEP, WORK, LWORK, INFO)

CHARACTER*1 JOB, COMPQ
COMPLEX T(LDT,*), Q(LDQ,*), W(*), WORK(*)
INTEGER N, LDT, LDQ, M, LWORK, INFO
LOGICAL SELECT(*)
REAL S, SEP

SUBROUTINE CTRSEN_64(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
SEP, WORK, LWORK, INFO)

CHARACTER*1 JOB, COMPQ
COMPLEX T(LDT,*), Q(LDQ,*), W(*), WORK(*)
INTEGER*8 N, LDT, LDQ, M, LWORK, INFO
LOGICAL*8 SELECT(*)
REAL S, SEP




F95 INTERFACE
SUBROUTINE TRSEN(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M,
S, SEP, WORK, LWORK, INFO)

CHARACTER(LEN=1) :: JOB, COMPQ
COMPLEX, DIMENSION(:) :: W, WORK
COMPLEX, DIMENSION(:,:) :: T, Q
INTEGER :: N, LDT, LDQ, M, LWORK, INFO
LOGICAL, DIMENSION(:) :: SELECT
REAL :: S, SEP

SUBROUTINE TRSEN_64(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W,
M, S, SEP, WORK, LWORK, INFO)

CHARACTER(LEN=1) :: JOB, COMPQ
COMPLEX, DIMENSION(:) :: W, WORK
COMPLEX, DIMENSION(:,:) :: T, Q
INTEGER(8) :: N, LDT, LDQ, M, LWORK, INFO
LOGICAL(8), DIMENSION(:) :: SELECT
REAL :: S, SEP




C INTERFACE
#include <sunperf.h>

void  ctrsen(char  job, char compq, int *select, int n, complex *t, int
ldt, complex *q, int ldq, complex *w, int *m, float *s, float
*sep, int *info);

void  ctrsen_64(char job, char compq, long *select, long n, complex *t,
long ldt, complex *q, long ldq, complex *w,  long  *m,  float
*s, float *sep, long *info);

Description

Oracle Solaris Studio Performance Library                           ctrsen(3P)



NAME
       ctrsen  -  reorder  the  Schur  factorization  of  a complex matrix A =
       Q*T*Q**H, so that a selected cluster  of  eigenvalues  appears  in  the
       leading positions on the diagonal of the upper triangular matrix T, and
       the leading columns of Q form an orthonormal basis of the corresponding
       right invariant subspace


SYNOPSIS
       SUBROUTINE CTRSEN(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
             SEP, WORK, LWORK, INFO)

       CHARACTER*1 JOB, COMPQ
       COMPLEX T(LDT,*), Q(LDQ,*), W(*), WORK(*)
       INTEGER N, LDT, LDQ, M, LWORK, INFO
       LOGICAL SELECT(*)
       REAL S, SEP

       SUBROUTINE CTRSEN_64(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
             SEP, WORK, LWORK, INFO)

       CHARACTER*1 JOB, COMPQ
       COMPLEX T(LDT,*), Q(LDQ,*), W(*), WORK(*)
       INTEGER*8 N, LDT, LDQ, M, LWORK, INFO
       LOGICAL*8 SELECT(*)
       REAL S, SEP




   F95 INTERFACE
       SUBROUTINE TRSEN(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M,
              S, SEP, WORK, LWORK, INFO)

       CHARACTER(LEN=1) :: JOB, COMPQ
       COMPLEX, DIMENSION(:) :: W, WORK
       COMPLEX, DIMENSION(:,:) :: T, Q
       INTEGER :: N, LDT, LDQ, M, LWORK, INFO
       LOGICAL, DIMENSION(:) :: SELECT
       REAL :: S, SEP

       SUBROUTINE TRSEN_64(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W,
              M, S, SEP, WORK, LWORK, INFO)

       CHARACTER(LEN=1) :: JOB, COMPQ
       COMPLEX, DIMENSION(:) :: W, WORK
       COMPLEX, DIMENSION(:,:) :: T, Q
       INTEGER(8) :: N, LDT, LDQ, M, LWORK, INFO
       LOGICAL(8), DIMENSION(:) :: SELECT
       REAL :: S, SEP




   C INTERFACE
       #include <sunperf.h>

       void  ctrsen(char  job, char compq, int *select, int n, complex *t, int
                 ldt, complex *q, int ldq, complex *w, int *m, float *s, float
                 *sep, int *info);

       void  ctrsen_64(char job, char compq, long *select, long n, complex *t,
                 long ldt, complex *q, long ldq, complex *w,  long  *m,  float
                 *s, float *sep, long *info);



PURPOSE
       ctrsen  reorders  the  Schur  factorization  of  a  complex  matrix A =
       Q*T*Q**H, so that a selected cluster  of  eigenvalues  appears  in  the
       leading positions on the diagonal of the upper triangular matrix T, and
       the leading columns of Q form an orthonormal basis of the corresponding
       right invariant subspace.

       Optionally the routine computes the reciprocal condition numbers of the
       cluster of eigenvalues and/or the invariant subspace.


ARGUMENTS
       JOB (input)
                 Specifies whether condition  numbers  are  required  for  the
                 cluster of eigenvalues (S) or the invariant subspace (SEP):
                 = 'N': none;
                 = 'E': for eigenvalues only (S);
                 = 'V': for invariant subspace only (SEP);
                 =  'B':  for  both  eigenvalues and invariant subspace (S and
                 SEP).


       COMPQ (input)
                 = 'V': update the matrix Q of Schur vectors;
                 = 'N': do not update Q.


       SELECT (input)
                 SELECT specifies the eigenvalues in the selected cluster.  To
                 select  the j-th eigenvalue, SELECT(j) must be set to .TRUE..


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


       T (input/output)
                 On entry, the upper triangular matrix T.  On exit, T is over-
                 written  by  the reordered matrix T, with the selected eigen-
                 values as the leading diagonal elements.


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


       Q (input) On entry, if COMPQ = 'V', the matrix Q of Schur vectors.   On
                 exit,  if  COMPQ = 'V', Q has been postmultiplied by the uni-
                 tary transformation matrix which reorders T;  the  leading  M
                 columns  of  Q  form  an  orthonormal basis for the specified
                 invariant subspace.  If COMPQ = 'N', Q is not referenced.


       LDQ (input)
                 The leading dimension of the array Q.  LDQ >= 1; and if COMPQ
                 = 'V', LDQ >= N.


       W (output)
                 The  reordered  eigenvalues  of  T, in the same order as they
                 appear on the diagonal of T.


       M (output)
                 The dimension of the specified invariant subspace.  0 <= M <=
                 N.


       S (output)
                 If  JOB  =  'E'  or 'B', S is a lower bound on the reciprocal
                 condition number for the selected cluster of eigenvalues.   S
                 cannot  underestimate the true reciprocal condition number by
                 more than a factor of sqrt(N). If M = 0 or N, S = 1.  If  JOB
                 = 'N' or 'V', S is not referenced.


       SEP (output)
                 If  JOB  = 'V' or 'B', SEP is the estimated reciprocal condi-
                 tion number of the specified invariant subspace. If M = 0  or
                 N,  SEP  =  norm(T).   If JOB = 'N' or 'E', SEP is not refer-
                 enced.


       WORK (workspace)
                 If JOB = 'N', WORK is not referenced.  Otherwise, on exit, if
                 INFO = 0, WORK(1) returns the optimal LWORK.


       LWORK (input)
                 The  dimension  of the array WORK.  If JOB = 'N', LWORK >= 1;
                 if JOB = 'E', LWORK = M*(N-M); if JOB = 'V' or 'B', LWORK  >=
                 2*M*(N-M).

                 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.


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


FURTHER DETAILS
       CTRSEN first collects the selected eigenvalues by computing  a  unitary
       transformation  Z  to  move  them to the top left corner of T. In other
       words, the selected eigenvalues are the eigenvalues of T11 in:

                     Z**H*T*Z = ( T11 T12 ) n1
                              (  0  T22 ) n2
                                 n1  n2

       where N = n1+n2 and Z**H means the conjugate transpose of Z. The  first
       n1 columns of Z span the specified invariant subspace of T.

       If  T  has  been  obtained from the Schur factorization of a matrix A =
       Q*T*Q**H, then the reordered Schur factorization of A is given by  A  =
       (Q*Z)*(Z**H*T*Z)*(Q*Z)**H,  and  the  first  n1 columns of Q*Z span the
       corresponding invariant subspace of A.

       The reciprocal condition number of the average of  the  eigenvalues  of
       T11 may be returned in S. S lies between 0 (very badly conditioned) and
       1 (very well conditioned). It is computed as follows. First we  compute
       R so that

                              P = ( I  R ) n1
                                  ( 0  0 ) n2
                                    n1 n2

       is  the  projector on the invariant subspace associated with T11.  R is
       the solution of the Sylvester equation:

                             T11*R - R*T22 = T12.

       Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M)  denote  the
       two-norm of M. Then S is computed as the lower bound

                           (1 + F-norm(R)**2)**(-1/2)

       on  the  reciprocal of 2-norm(P), the true reciprocal condition number.
       S cannot underestimate 1 / 2-norm(P) by more than a factor of  sqrt(N).

       An  approximate error bound for the computed average of the eigenvalues
       of T11 is

                              EPS * norm(T) / S

       where EPS is the machine precision.

       The reciprocal condition number of the right invariant subspace spanned
       by  the  first  n1 columns of Z (or of Q*Z) is returned in SEP.  SEP is
       defined as the separation of T11 and T22:

                          sep( T11, T22 ) = sigma-min( C )

       where sigma-min(C) is the smallest singular value of the
       n1*n2-by-n1*n2 matrix

          C  = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) )

       I(m) is an m by m identity matrix,  and  kprod  denotes  the  Kronecker
       product.  We  estimate sigma-min(C) by the reciprocal of an estimate of
       the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C) can-
       not differ from sigma-min(C) by more than a factor of sqrt(n1*n2).

       When  SEP  is  small, small changes in T can cause large changes in the
       invariant subspace. An approximate bound on the maximum  angular  error
       in the computed right invariant subspace is

                           EPS * norm(T) / SEP




                                  7 Nov 2015                        ctrsen(3P)