SRC/ctgexc.f

   1 *> \brief \b CTGEXC
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CTGEXC + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctgexc.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctgexc.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctgexc.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
  22 *                          LDZ, IFST, ILST, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       LOGICAL            WANTQ, WANTZ
  26 *       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX            A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
  30 *      $                   Z( LDZ, * )
  31 *       ..
  32 *
  33 *
  34 *> \par Purpose:
  35 *  =============
  36 *>
  37 *> \verbatim
  38 *>
  39 *> CTGEXC reorders the generalized Schur decomposition of a complex
  40 *> matrix pair (A,B), using an unitary equivalence transformation
  41 *> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with
  42 *> row index IFST is moved to row ILST.
  43 *>
  44 *> (A, B) must be in generalized Schur canonical form, that is, A and
  45 *> B are both upper triangular.
  46 *>
  47 *> Optionally, the matrices Q and Z of generalized Schur vectors are
  48 *> updated.
  49 *>
  50 *>        Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H
  51 *>        Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H
  52 *> \endverbatim
  53 *
  54 *  Arguments:
  55 *  ==========
  56 *
  57 *> \param[in] WANTQ
  58 *> \verbatim
  59 *>          WANTQ is LOGICAL
  60 *>          .TRUE. : update the left transformation matrix Q;
  61 *>          .FALSE.: do not update Q.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] WANTZ
  65 *> \verbatim
  66 *>          WANTZ is LOGICAL
  67 *>          .TRUE. : update the right transformation matrix Z;
  68 *>          .FALSE.: do not update Z.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] N
  72 *> \verbatim
  73 *>          N is INTEGER
  74 *>          The order of the matrices A and B. N >= 0.
  75 *> \endverbatim
  76 *>
  77 *> \param[in,out] A
  78 *> \verbatim
  79 *>          A is COMPLEX array, dimension (LDA,N)
  80 *>          On entry, the upper triangular matrix A in the pair (A, B).
  81 *>          On exit, the updated matrix A.
  82 *> \endverbatim
  83 *>
  84 *> \param[in] LDA
  85 *> \verbatim
  86 *>          LDA is INTEGER
  87 *>          The leading dimension of the array A. LDA >= max(1,N).
  88 *> \endverbatim
  89 *>
  90 *> \param[in,out] B
  91 *> \verbatim
  92 *>          B is COMPLEX array, dimension (LDB,N)
  93 *>          On entry, the upper triangular matrix B in the pair (A, B).
  94 *>          On exit, the updated matrix B.
  95 *> \endverbatim
  96 *>
  97 *> \param[in] LDB
  98 *> \verbatim
  99 *>          LDB is INTEGER
 100 *>          The leading dimension of the array B. LDB >= max(1,N).
 101 *> \endverbatim
 102 *>
 103 *> \param[in,out] Q
 104 *> \verbatim
 105 *>          Q is COMPLEX array, dimension (LDZ,N)
 106 *>          On entry, if WANTQ = .TRUE., the unitary matrix Q.
 107 *>          On exit, the updated matrix Q.
 108 *>          If WANTQ = .FALSE., Q is not referenced.
 109 *> \endverbatim
 110 *>
 111 *> \param[in] LDQ
 112 *> \verbatim
 113 *>          LDQ is INTEGER
 114 *>          The leading dimension of the array Q. LDQ >= 1;
 115 *>          If WANTQ = .TRUE., LDQ >= N.
 116 *> \endverbatim
 117 *>
 118 *> \param[in,out] Z
 119 *> \verbatim
 120 *>          Z is COMPLEX array, dimension (LDZ,N)
 121 *>          On entry, if WANTZ = .TRUE., the unitary matrix Z.
 122 *>          On exit, the updated matrix Z.
 123 *>          If WANTZ = .FALSE., Z is not referenced.
 124 *> \endverbatim
 125 *>
 126 *> \param[in] LDZ
 127 *> \verbatim
 128 *>          LDZ is INTEGER
 129 *>          The leading dimension of the array Z. LDZ >= 1;
 130 *>          If WANTZ = .TRUE., LDZ >= N.
 131 *> \endverbatim
 132 *>
 133 *> \param[in] IFST
 134 *> \verbatim
 135 *>          IFST is INTEGER
 136 *> \endverbatim
 137 *>
 138 *> \param[in,out] ILST
 139 *> \verbatim
 140 *>          ILST is INTEGER
 141 *>          Specify the reordering of the diagonal blocks of (A, B).
 142 *>          The block with row index IFST is moved to row ILST, by a
 143 *>          sequence of swapping between adjacent blocks.
 144 *> \endverbatim
 145 *>
 146 *> \param[out] INFO
 147 *> \verbatim
 148 *>          INFO is INTEGER
 149 *>           =0:  Successful exit.
 150 *>           <0:  if INFO = -i, the i-th argument had an illegal value.
 151 *>           =1:  The transformed matrix pair (A, B) would be too far
 152 *>                from generalized Schur form; the problem is ill-
 153 *>                conditioned. (A, B) may have been partially reordered,
 154 *>                and ILST points to the first row of the current
 155 *>                position of the block being moved.
 156 *> \endverbatim
 157 *
 158 *  Authors:
 159 *  ========
 160 *
 161 *> \author Univ. of Tennessee
 162 *> \author Univ. of California Berkeley
 163 *> \author Univ. of Colorado Denver
 164 *> \author NAG Ltd.
 165 *
 166 *> \date November 2011
 167 *
 168 *> \ingroup complexGEcomputational
 169 *
 170 *> \par Contributors:
 171 *  ==================
 172 *>
 173 *>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
 174 *>     Umea University, S-901 87 Umea, Sweden.
 175 *
 176 *> \par References:
 177 *  ================
 178 *>
 179 *>  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
 180 *>      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
 181 *>      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
 182 *>      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
 183 *> \n
 184 *>  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
 185 *>      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
 186 *>      Estimation: Theory, Algorithms and Software, Report
 187 *>      UMINF - 94.04, Department of Computing Science, Umea University,
 188 *>      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
 189 *>      To appear in Numerical Algorithms, 1996.
 190 *> \n
 191 *>  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
 192 *>      for Solving the Generalized Sylvester Equation and Estimating the
 193 *>      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
 194 *>      Department of Computing Science, Umea University, S-901 87 Umea,
 195 *>      Sweden, December 1993, Revised April 1994, Also as LAPACK working
 196 *>      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
 197 *>      1996.
 198 *>
 199 *  =====================================================================
 200       SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
 201      $                   LDZ, IFST, ILST, INFO )
 202 *
 203 *  -- LAPACK computational routine (version 3.4.0) --
 204 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 205 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 206 *     November 2011
 207 *
 208 *     .. Scalar Arguments ..
 209       LOGICAL            WANTQ, WANTZ
 210       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
 211 *     ..
 212 *     .. Array Arguments ..
 213       COMPLEX            A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
 214      $                   Z( LDZ, * )
 215 *     ..
 216 *
 217 *  =====================================================================
 218 *
 219 *     .. Local Scalars ..
 220       INTEGER            HERE
 221 *     ..
 222 *     .. External Subroutines ..
 223       EXTERNAL           CTGEX2, XERBLA
 224 *     ..
 225 *     .. Intrinsic Functions ..
 226       INTRINSIC          MAX
 227 *     ..
 228 *     .. Executable Statements ..
 229 *
 230 *     Decode and test input arguments.
 231       INFO = 0
 232       IF( N.LT.0 ) THEN
 233          INFO = -3
 234       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 235          INFO = -5
 236       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
 237          INFO = -7
 238       ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
 239          INFO = -9
 240       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
 241          INFO = -11
 242       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
 243          INFO = -12
 244       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
 245          INFO = -13
 246       END IF
 247       IF( INFO.NE.0 ) THEN
 248          CALL XERBLA( 'CTGEXC', -INFO )
 249          RETURN
 250       END IF
 251 *
 252 *     Quick return if possible
 253 *
 254       IF( N.LE.1 )
 255      $   RETURN
 256       IF( IFST.EQ.ILST )
 257      $   RETURN
 258 *
 259       IF( IFST.LT.ILST ) THEN
 260 *
 261          HERE = IFST
 262 *
 263    10    CONTINUE
 264 *
 265 *        Swap with next one below
 266 *
 267          CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
 268      $                HERE, INFO )
 269          IF( INFO.NE.0 ) THEN
 270             ILST = HERE
 271             RETURN
 272          END IF
 273          HERE = HERE + 1
 274          IF( HERE.LT.ILST )
 275      $      GO TO 10
 276          HERE = HERE - 1
 277       ELSE
 278          HERE = IFST - 1
 279 *
 280    20    CONTINUE
 281 *
 282 *        Swap with next one above
 283 *
 284          CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
 285      $                HERE, INFO )
 286          IF( INFO.NE.0 ) THEN
 287             ILST = HERE
 288             RETURN
 289          END IF
 290          HERE = HERE - 1
 291          IF( HERE.GE.ILST )
 292      $      GO TO 20
 293          HERE = HERE + 1
 294       END IF
 295       ILST = HERE
 296       RETURN
 297 *
 298 *     End of CTGEXC
 299 *
 300       END