ctrexc.f

Go to the documentation of this file.

*> \brief \b CTREXC
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*> \htmlonly
*> Download CTREXC + dependencies 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrexc.f"> 
*> [TGZ]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrexc.f"> 
*> [ZIP]</a> 
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrexc.f"> 
*> [TXT]</a>
*> \endhtmlonly 
*
*  Definition:
*  ===========
*
*       SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
* 
*       .. Scalar Arguments ..
*       CHARACTER          COMPQ
*       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
*       ..
*       .. Array Arguments ..
*       COMPLEX            Q( LDQ, * ), T( LDT, * )
*       ..
*  
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> CTREXC reorders the Schur factorization of a complex matrix
*> A = Q*T*Q**H, so that the diagonal element of T with row index IFST
*> is moved to row ILST.
*>
*> The Schur form T is reordered by a unitary similarity transformation
*> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
*> postmultplying it with Z.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] COMPQ
*> \verbatim
*>          COMPQ is CHARACTER*1
*>          = 'V':  update the matrix Q of Schur vectors;
*>          = 'N':  do not update Q.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The order of the matrix T. N >= 0.
*> \endverbatim
*>
*> \param[in,out] T
*> \verbatim
*>          T is COMPLEX array, dimension (LDT,N)
*>          On entry, the upper triangular matrix T.
*>          On exit, the reordered upper triangular matrix.
*> \endverbatim
*>
*> \param[in] LDT
*> \verbatim
*>          LDT is INTEGER
*>          The leading dimension of the array T. LDT >= max(1,N).
*> \endverbatim
*>
*> \param[in,out] Q
*> \verbatim
*>          Q is COMPLEX array, dimension (LDQ,N)
*>          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
*>          On exit, if COMPQ = 'V', Q has been postmultiplied by the
*>          unitary transformation matrix Z which reorders T.
*>          If COMPQ = 'N', Q is not referenced.
*> \endverbatim
*>
*> \param[in] LDQ
*> \verbatim
*>          LDQ is INTEGER
*>          The leading dimension of the array Q.  LDQ >= max(1,N).
*> \endverbatim
*>
*> \param[in] IFST
*> \verbatim
*>          IFST is INTEGER
*> \endverbatim
*>
*> \param[in] ILST
*> \verbatim
*>          ILST is INTEGER
*>
*>          Specify the reordering of the diagonal elements of T:
*>          The element with row index IFST is moved to row ILST by a
*>          sequence of transpositions between adjacent elements.
*>          1 <= IFST <= N; 1 <= ILST <= N.
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          = 0:  successful exit
*>          < 0:  if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee 
*> \author Univ. of California Berkeley 
*> \author Univ. of Colorado Denver 
*> \author NAG Ltd. 
*
*> \date November 2011
*
*> \ingroup complexOTHERcomputational
*
*  =====================================================================
      SUBROUTINE ctrexc( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
*
*  -- LAPACK computational routine (version 3.4.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2011
*
*     .. Scalar Arguments ..
      CHARACTER          COMPQ
      INTEGER            IFST, ILST, INFO, LDQ, LDT, N
*     ..
*     .. Array Arguments ..
      COMPLEX            Q( ldq, * ), T( ldt, * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            WANTQ
      INTEGER            K, M1, M2, M3
      REAL               CS
      COMPLEX            SN, T11, T22, TEMP
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           lsame
*     ..
*     .. External Subroutines ..
      EXTERNAL           clartg, crot, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          conjg, max
*     ..
*     .. Executable Statements ..
*
*     Decode and test the input parameters.
*
      info = 0
      wantq = lsame( compq, 'V' )
      IF( .NOT.lsame( compq, 'N' ) .AND. .NOT.wantq ) THEN
         info = -1
      ELSE IF( n.LT.0 ) THEN
         info = -2
      ELSE IF( ldt.LT.max( 1, n ) ) THEN
         info = -4
      ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.max( 1, n ) ) ) THEN
         info = -6
      ELSE IF( ifst.LT.1 .OR. ifst.GT.n ) THEN
         info = -7
      ELSE IF( ilst.LT.1 .OR. ilst.GT.n ) THEN
         info = -8
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'CTREXC', -info )
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( n.EQ.1 .OR. ifst.EQ.ilst )
     $   RETURN
*
      IF( ifst.LT.ilst ) THEN
*
*        Move the IFST-th diagonal element forward down the diagonal.
*
         m1 = 0
         m2 = -1
         m3 = 1
      ELSE
*
*        Move the IFST-th diagonal element backward up the diagonal.
*
         m1 = -1
         m2 = 0
         m3 = -1
      END IF
*
      DO 10 k = ifst + m1, ilst + m2, m3
*
*        Interchange the k-th and (k+1)-th diagonal elements.
*
         t11 = t( k, k )
         t22 = t( k+1, k+1 )
*
*        Determine the transformation to perform the interchange.
*
         CALL clartg( t( k, k+1 ), t22-t11, cs, sn, temp )
*
*        Apply transformation to the matrix T.
*
         IF( k+2.LE.n )
     $      CALL crot( n-k-1, t( k, k+2 ), ldt, t( k+1, k+2 ), ldt, cs,
     $                 sn )
         CALL crot( k-1, t( 1, k ), 1, t( 1, k+1 ), 1, cs, conjg( sn ) )
*
         t( k, k ) = t22
         t( k+1, k+1 ) = t11
*
         IF( wantq ) THEN
*
*           Accumulate transformation in the matrix Q.
*
            CALL crot( n, q( 1, k ), 1, q( 1, k+1 ), 1, cs,
     $                 conjg( sn ) )
         END IF
*
   10 CONTINUE
*
      RETURN
*
*     End of CTREXC
*
      END