LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ctrexc.f
Go to the documentation of this file.
00001 *> \brief \b CTREXC
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CTREXC + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrexc.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrexc.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrexc.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          COMPQ
00025 *       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       COMPLEX            Q( LDQ, * ), T( LDT, * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> CTREXC reorders the Schur factorization of a complex matrix
00038 *> A = Q*T*Q**H, so that the diagonal element of T with row index IFST
00039 *> is moved to row ILST.
00040 *>
00041 *> The Schur form T is reordered by a unitary similarity transformation
00042 *> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
00043 *> postmultplying it with Z.
00044 *> \endverbatim
00045 *
00046 *  Arguments:
00047 *  ==========
00048 *
00049 *> \param[in] COMPQ
00050 *> \verbatim
00051 *>          COMPQ is CHARACTER*1
00052 *>          = 'V':  update the matrix Q of Schur vectors;
00053 *>          = 'N':  do not update Q.
00054 *> \endverbatim
00055 *>
00056 *> \param[in] N
00057 *> \verbatim
00058 *>          N is INTEGER
00059 *>          The order of the matrix T. N >= 0.
00060 *> \endverbatim
00061 *>
00062 *> \param[in,out] T
00063 *> \verbatim
00064 *>          T is COMPLEX array, dimension (LDT,N)
00065 *>          On entry, the upper triangular matrix T.
00066 *>          On exit, the reordered upper triangular matrix.
00067 *> \endverbatim
00068 *>
00069 *> \param[in] LDT
00070 *> \verbatim
00071 *>          LDT is INTEGER
00072 *>          The leading dimension of the array T. LDT >= max(1,N).
00073 *> \endverbatim
00074 *>
00075 *> \param[in,out] Q
00076 *> \verbatim
00077 *>          Q is COMPLEX array, dimension (LDQ,N)
00078 *>          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
00079 *>          On exit, if COMPQ = 'V', Q has been postmultiplied by the
00080 *>          unitary transformation matrix Z which reorders T.
00081 *>          If COMPQ = 'N', Q is not referenced.
00082 *> \endverbatim
00083 *>
00084 *> \param[in] LDQ
00085 *> \verbatim
00086 *>          LDQ is INTEGER
00087 *>          The leading dimension of the array Q.  LDQ >= max(1,N).
00088 *> \endverbatim
00089 *>
00090 *> \param[in] IFST
00091 *> \verbatim
00092 *>          IFST is INTEGER
00093 *> \endverbatim
00094 *>
00095 *> \param[in] ILST
00096 *> \verbatim
00097 *>          ILST is INTEGER
00098 *>
00099 *>          Specify the reordering of the diagonal elements of T:
00100 *>          The element with row index IFST is moved to row ILST by a
00101 *>          sequence of transpositions between adjacent elements.
00102 *>          1 <= IFST <= N; 1 <= ILST <= N.
00103 *> \endverbatim
00104 *>
00105 *> \param[out] INFO
00106 *> \verbatim
00107 *>          INFO is INTEGER
00108 *>          = 0:  successful exit
00109 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00110 *> \endverbatim
00111 *
00112 *  Authors:
00113 *  ========
00114 *
00115 *> \author Univ. of Tennessee 
00116 *> \author Univ. of California Berkeley 
00117 *> \author Univ. of Colorado Denver 
00118 *> \author NAG Ltd. 
00119 *
00120 *> \date November 2011
00121 *
00122 *> \ingroup complexOTHERcomputational
00123 *
00124 *  =====================================================================
00125       SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
00126 *
00127 *  -- LAPACK computational routine (version 3.4.0) --
00128 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00129 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00130 *     November 2011
00131 *
00132 *     .. Scalar Arguments ..
00133       CHARACTER          COMPQ
00134       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
00135 *     ..
00136 *     .. Array Arguments ..
00137       COMPLEX            Q( LDQ, * ), T( LDT, * )
00138 *     ..
00139 *
00140 *  =====================================================================
00141 *
00142 *     .. Local Scalars ..
00143       LOGICAL            WANTQ
00144       INTEGER            K, M1, M2, M3
00145       REAL               CS
00146       COMPLEX            SN, T11, T22, TEMP
00147 *     ..
00148 *     .. External Functions ..
00149       LOGICAL            LSAME
00150       EXTERNAL           LSAME
00151 *     ..
00152 *     .. External Subroutines ..
00153       EXTERNAL           CLARTG, CROT, XERBLA
00154 *     ..
00155 *     .. Intrinsic Functions ..
00156       INTRINSIC          CONJG, MAX
00157 *     ..
00158 *     .. Executable Statements ..
00159 *
00160 *     Decode and test the input parameters.
00161 *
00162       INFO = 0
00163       WANTQ = LSAME( COMPQ, 'V' )
00164       IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
00165          INFO = -1
00166       ELSE IF( N.LT.0 ) THEN
00167          INFO = -2
00168       ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
00169          INFO = -4
00170       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
00171          INFO = -6
00172       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
00173          INFO = -7
00174       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
00175          INFO = -8
00176       END IF
00177       IF( INFO.NE.0 ) THEN
00178          CALL XERBLA( 'CTREXC', -INFO )
00179          RETURN
00180       END IF
00181 *
00182 *     Quick return if possible
00183 *
00184       IF( N.EQ.1 .OR. IFST.EQ.ILST )
00185      $   RETURN
00186 *
00187       IF( IFST.LT.ILST ) THEN
00188 *
00189 *        Move the IFST-th diagonal element forward down the diagonal.
00190 *
00191          M1 = 0
00192          M2 = -1
00193          M3 = 1
00194       ELSE
00195 *
00196 *        Move the IFST-th diagonal element backward up the diagonal.
00197 *
00198          M1 = -1
00199          M2 = 0
00200          M3 = -1
00201       END IF
00202 *
00203       DO 10 K = IFST + M1, ILST + M2, M3
00204 *
00205 *        Interchange the k-th and (k+1)-th diagonal elements.
00206 *
00207          T11 = T( K, K )
00208          T22 = T( K+1, K+1 )
00209 *
00210 *        Determine the transformation to perform the interchange.
00211 *
00212          CALL CLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
00213 *
00214 *        Apply transformation to the matrix T.
00215 *
00216          IF( K+2.LE.N )
00217      $      CALL CROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
00218      $                 SN )
00219          CALL CROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, CONJG( SN ) )
00220 *
00221          T( K, K ) = T22
00222          T( K+1, K+1 ) = T11
00223 *
00224          IF( WANTQ ) THEN
00225 *
00226 *           Accumulate transformation in the matrix Q.
00227 *
00228             CALL CROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
00229      $                 CONJG( SN ) )
00230          END IF
00231 *
00232    10 CONTINUE
00233 *
00234       RETURN
00235 *
00236 *     End of CTREXC
00237 *
00238       END
 All Files Functions