Return to ztrexc.f CVS log

Up to [local] / rpl / lapack / lapack

Initial revision

    1:       SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
    2: *
    3: *  -- LAPACK routine (version 3.2) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *     November 2006
    7: *
    8: *     .. Scalar Arguments ..
    9:       CHARACTER          COMPQ
   10:       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
   11: *     ..
   12: *     .. Array Arguments ..
   13:       COMPLEX*16         Q( LDQ, * ), T( LDT, * )
   14: *     ..
   15: *
   16: *  Purpose
   17: *  =======
   18: *
   19: *  ZTREXC reorders the Schur factorization of a complex matrix
   20: *  A = Q*T*Q**H, so that the diagonal element of T with row index IFST
   21: *  is moved to row ILST.
   22: *
   23: *  The Schur form T is reordered by a unitary similarity transformation
   24: *  Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
   25: *  postmultplying it with Z.
   26: *
   27: *  Arguments
   28: *  =========
   29: *
   30: *  COMPQ   (input) CHARACTER*1
   31: *          = 'V':  update the matrix Q of Schur vectors;
   32: *          = 'N':  do not update Q.
   33: *
   34: *  N       (input) INTEGER
   35: *          The order of the matrix T. N >= 0.
   36: *
   37: *  T       (input/output) COMPLEX*16 array, dimension (LDT,N)
   38: *          On entry, the upper triangular matrix T.
   39: *          On exit, the reordered upper triangular matrix.
   40: *
   41: *  LDT     (input) INTEGER
   42: *          The leading dimension of the array T. LDT >= max(1,N).
   43: *
   44: *  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N)
   45: *          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
   46: *          On exit, if COMPQ = 'V', Q has been postmultiplied by the
   47: *          unitary transformation matrix Z which reorders T.
   48: *          If COMPQ = 'N', Q is not referenced.
   49: *
   50: *  LDQ     (input) INTEGER
   51: *          The leading dimension of the array Q.  LDQ >= max(1,N).
   52: *
   53: *  IFST    (input) INTEGER
   54: *  ILST    (input) INTEGER
   55: *          Specify the reordering of the diagonal elements of T:
   56: *          The element with row index IFST is moved to row ILST by a
   57: *          sequence of transpositions between adjacent elements.
   58: *          1 <= IFST <= N; 1 <= ILST <= N.
   59: *
   60: *  INFO    (output) INTEGER
   61: *          = 0:  successful exit
   62: *          < 0:  if INFO = -i, the i-th argument had an illegal value
   63: *
   64: *  =====================================================================
   65: *
   66: *     .. Local Scalars ..
   67:       LOGICAL            WANTQ
   68:       INTEGER            K, M1, M2, M3
   69:       DOUBLE PRECISION   CS
   70:       COMPLEX*16         SN, T11, T22, TEMP
   71: *     ..
   72: *     .. External Functions ..
   73:       LOGICAL            LSAME
   74:       EXTERNAL           LSAME
   75: *     ..
   76: *     .. External Subroutines ..
   77:       EXTERNAL           XERBLA, ZLARTG, ZROT
   78: *     ..
   79: *     .. Intrinsic Functions ..
   80:       INTRINSIC          DCONJG, MAX
   81: *     ..
   82: *     .. Executable Statements ..
   83: *
   84: *     Decode and test the input parameters.
   85: *
   86:       INFO = 0
   87:       WANTQ = LSAME( COMPQ, 'V' )
   88:       IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
   89:          INFO = -1
   90:       ELSE IF( N.LT.0 ) THEN
   91:          INFO = -2
   92:       ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
   93:          INFO = -4
   94:       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
   95:          INFO = -6
   96:       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
   97:          INFO = -7
   98:       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
   99:          INFO = -8
  100:       END IF
  101:       IF( INFO.NE.0 ) THEN
  102:          CALL XERBLA( 'ZTREXC', -INFO )
  103:          RETURN
  104:       END IF
  105: *
  106: *     Quick return if possible
  107: *
  108:       IF( N.EQ.1 .OR. IFST.EQ.ILST )
  109:      $   RETURN
  110: *
  111:       IF( IFST.LT.ILST ) THEN
  112: *
  113: *        Move the IFST-th diagonal element forward down the diagonal.
  114: *
  115:          M1 = 0
  116:          M2 = -1
  117:          M3 = 1
  118:       ELSE
  119: *
  120: *        Move the IFST-th diagonal element backward up the diagonal.
  121: *
  122:          M1 = -1
  123:          M2 = 0
  124:          M3 = -1
  125:       END IF
  126: *
  127:       DO 10 K = IFST + M1, ILST + M2, M3
  128: *
  129: *        Interchange the k-th and (k+1)-th diagonal elements.
  130: *
  131:          T11 = T( K, K )
  132:          T22 = T( K+1, K+1 )
  133: *
  134: *        Determine the transformation to perform the interchange.
  135: *
  136:          CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
  137: *
  138: *        Apply transformation to the matrix T.
  139: *
  140:          IF( K+2.LE.N )
  141:      $      CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
  142:      $                 SN )
  143:          CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS,
  144:      $              DCONJG( SN ) )
  145: *
  146:          T( K, K ) = T22
  147:          T( K+1, K+1 ) = T11
  148: *
  149:          IF( WANTQ ) THEN
  150: *
  151: *           Accumulate transformation in the matrix Q.
  152: *
  153:             CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
  154:      $                 DCONJG( SN ) )
  155:          END IF
  156: *
  157:    10 CONTINUE
  158: *
  159:       RETURN
  160: *
  161: *     End of ZTREXC
  162: *
  163:       END