LAPACK 3.3.0

ctrexc.f

Go to the documentation of this file.
00001       SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
00002 *
00003 *  -- LAPACK routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          COMPQ
00010       INTEGER            IFST, ILST, INFO, LDQ, LDT, N
00011 *     ..
00012 *     .. Array Arguments ..
00013       COMPLEX            Q( LDQ, * ), T( LDT, * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  CTREXC reorders the Schur factorization of a complex matrix
00020 *  A = Q*T*Q**H, so that the diagonal element of T with row index IFST
00021 *  is moved to row ILST.
00022 *
00023 *  The Schur form T is reordered by a unitary similarity transformation
00024 *  Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
00025 *  postmultplying it with Z.
00026 *
00027 *  Arguments
00028 *  =========
00029 *
00030 *  COMPQ   (input) CHARACTER*1
00031 *          = 'V':  update the matrix Q of Schur vectors;
00032 *          = 'N':  do not update Q.
00033 *
00034 *  N       (input) INTEGER
00035 *          The order of the matrix T. N >= 0.
00036 *
00037 *  T       (input/output) COMPLEX array, dimension (LDT,N)
00038 *          On entry, the upper triangular matrix T.
00039 *          On exit, the reordered upper triangular matrix.
00040 *
00041 *  LDT     (input) INTEGER
00042 *          The leading dimension of the array T. LDT >= max(1,N).
00043 *
00044 *  Q       (input/output) COMPLEX array, dimension (LDQ,N)
00045 *          On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
00046 *          On exit, if COMPQ = 'V', Q has been postmultiplied by the
00047 *          unitary transformation matrix Z which reorders T.
00048 *          If COMPQ = 'N', Q is not referenced.
00049 *
00050 *  LDQ     (input) INTEGER
00051 *          The leading dimension of the array Q.  LDQ >= max(1,N).
00052 *
00053 *  IFST    (input) INTEGER
00054 *  ILST    (input) INTEGER
00055 *          Specify the reordering of the diagonal elements of T:
00056 *          The element with row index IFST is moved to row ILST by a
00057 *          sequence of transpositions between adjacent elements.
00058 *          1 <= IFST <= N; 1 <= ILST <= N.
00059 *
00060 *  INFO    (output) INTEGER
00061 *          = 0:  successful exit
00062 *          < 0:  if INFO = -i, the i-th argument had an illegal value
00063 *
00064 *  =====================================================================
00065 *
00066 *     .. Local Scalars ..
00067       LOGICAL            WANTQ
00068       INTEGER            K, M1, M2, M3
00069       REAL               CS
00070       COMPLEX            SN, T11, T22, TEMP
00071 *     ..
00072 *     .. External Functions ..
00073       LOGICAL            LSAME
00074       EXTERNAL           LSAME
00075 *     ..
00076 *     .. External Subroutines ..
00077       EXTERNAL           CLARTG, CROT, XERBLA
00078 *     ..
00079 *     .. Intrinsic Functions ..
00080       INTRINSIC          CONJG, MAX
00081 *     ..
00082 *     .. Executable Statements ..
00083 *
00084 *     Decode and test the input parameters.
00085 *
00086       INFO = 0
00087       WANTQ = LSAME( COMPQ, 'V' )
00088       IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
00089          INFO = -1
00090       ELSE IF( N.LT.0 ) THEN
00091          INFO = -2
00092       ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
00093          INFO = -4
00094       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
00095          INFO = -6
00096       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
00097          INFO = -7
00098       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
00099          INFO = -8
00100       END IF
00101       IF( INFO.NE.0 ) THEN
00102          CALL XERBLA( 'CTREXC', -INFO )
00103          RETURN
00104       END IF
00105 *
00106 *     Quick return if possible
00107 *
00108       IF( N.EQ.1 .OR. IFST.EQ.ILST )
00109      $   RETURN
00110 *
00111       IF( IFST.LT.ILST ) THEN
00112 *
00113 *        Move the IFST-th diagonal element forward down the diagonal.
00114 *
00115          M1 = 0
00116          M2 = -1
00117          M3 = 1
00118       ELSE
00119 *
00120 *        Move the IFST-th diagonal element backward up the diagonal.
00121 *
00122          M1 = -1
00123          M2 = 0
00124          M3 = -1
00125       END IF
00126 *
00127       DO 10 K = IFST + M1, ILST + M2, M3
00128 *
00129 *        Interchange the k-th and (k+1)-th diagonal elements.
00130 *
00131          T11 = T( K, K )
00132          T22 = T( K+1, K+1 )
00133 *
00134 *        Determine the transformation to perform the interchange.
00135 *
00136          CALL CLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
00137 *
00138 *        Apply transformation to the matrix T.
00139 *
00140          IF( K+2.LE.N )
00141      $      CALL CROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
00142      $                 SN )
00143          CALL CROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, CONJG( SN ) )
00144 *
00145          T( K, K ) = T22
00146          T( K+1, K+1 ) = T11
00147 *
00148          IF( WANTQ ) THEN
00149 *
00150 *           Accumulate transformation in the matrix Q.
00151 *
00152             CALL CROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
00153      $                 CONJG( SN ) )
00154          END IF
00155 *
00156    10 CONTINUE
00157 *
00158       RETURN
00159 *
00160 *     End of CTREXC
00161 *
00162       END
 All Files Functions