Return to ztgexc.f CVS log

Up to [local] / rpl / lapack / lapack

Patches pour OS/2

    1:       SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
    2:      $                   LDZ, IFST, ILST, INFO )
    3: *
    4: *  -- LAPACK routine (version 3.2) --
    5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    7: *     November 2006
    8: *
    9: *     .. Scalar Arguments ..
   10:       LOGICAL            WANTQ, WANTZ
   11:       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
   12: *     ..
   13: *     .. Array Arguments ..
   14:       COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
   15:      $                   Z( LDZ, * )
   16: *     ..
   17: *
   18: *  Purpose
   19: *  =======
   20: *
   21: *  ZTGEXC reorders the generalized Schur decomposition of a complex
   22: *  matrix pair (A,B), using an unitary equivalence transformation
   23: *  (A, B) := Q * (A, B) * Z', so that the diagonal block of (A, B) with
   24: *  row index IFST is moved to row ILST.
   25: *
   26: *  (A, B) must be in generalized Schur canonical form, that is, A and
   27: *  B are both upper triangular.
   28: *
   29: *  Optionally, the matrices Q and Z of generalized Schur vectors are
   30: *  updated.
   31: *
   32: *         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
   33: *         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
   34: *
   35: *  Arguments
   36: *  =========
   37: *
   38: *  WANTQ   (input) LOGICAL
   39: *          .TRUE. : update the left transformation matrix Q;
   40: *          .FALSE.: do not update Q.
   41: *
   42: *  WANTZ   (input) LOGICAL
   43: *          .TRUE. : update the right transformation matrix Z;
   44: *          .FALSE.: do not update Z.
   45: *
   46: *  N       (input) INTEGER
   47: *          The order of the matrices A and B. N >= 0.
   48: *
   49: *  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
   50: *          On entry, the upper triangular matrix A in the pair (A, B).
   51: *          On exit, the updated matrix A.
   52: *
   53: *  LDA     (input)  INTEGER
   54: *          The leading dimension of the array A. LDA >= max(1,N).
   55: *
   56: *  B       (input/output) COMPLEX*16 array, dimension (LDB,N)
   57: *          On entry, the upper triangular matrix B in the pair (A, B).
   58: *          On exit, the updated matrix B.
   59: *
   60: *  LDB     (input)  INTEGER
   61: *          The leading dimension of the array B. LDB >= max(1,N).
   62: *
   63: *  Q       (input/output) COMPLEX*16 array, dimension (LDZ,N)
   64: *          On entry, if WANTQ = .TRUE., the unitary matrix Q.
   65: *          On exit, the updated matrix Q.
   66: *          If WANTQ = .FALSE., Q is not referenced.
   67: *
   68: *  LDQ     (input) INTEGER
   69: *          The leading dimension of the array Q. LDQ >= 1;
   70: *          If WANTQ = .TRUE., LDQ >= N.
   71: *
   72: *  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
   73: *          On entry, if WANTZ = .TRUE., the unitary matrix Z.
   74: *          On exit, the updated matrix Z.
   75: *          If WANTZ = .FALSE., Z is not referenced.
   76: *
   77: *  LDZ     (input) INTEGER
   78: *          The leading dimension of the array Z. LDZ >= 1;
   79: *          If WANTZ = .TRUE., LDZ >= N.
   80: *
   81: *  IFST    (input) INTEGER
   82: *  ILST    (input/output) INTEGER
   83: *          Specify the reordering of the diagonal blocks of (A, B).
   84: *          The block with row index IFST is moved to row ILST, by a
   85: *          sequence of swapping between adjacent blocks.
   86: *
   87: *  INFO    (output) INTEGER
   88: *           =0:  Successful exit.
   89: *           <0:  if INFO = -i, the i-th argument had an illegal value.
   90: *           =1:  The transformed matrix pair (A, B) would be too far
   91: *                from generalized Schur form; the problem is ill-
   92: *                conditioned. (A, B) may have been partially reordered,
   93: *                and ILST points to the first row of the current
   94: *                position of the block being moved.
   95: *
   96: *
   97: *  Further Details
   98: *  ===============
   99: *
  100: *  Based on contributions by
  101: *     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
  102: *     Umea University, S-901 87 Umea, Sweden.
  103: *
  104: *  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
  105: *      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
  106: *      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
  107: *      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
  108: *
  109: *  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
  110: *      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
  111: *      Estimation: Theory, Algorithms and Software, Report
  112: *      UMINF - 94.04, Department of Computing Science, Umea University,
  113: *      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
  114: *      To appear in Numerical Algorithms, 1996.
  115: *
  116: *  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
  117: *      for Solving the Generalized Sylvester Equation and Estimating the
  118: *      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
  119: *      Department of Computing Science, Umea University, S-901 87 Umea,
  120: *      Sweden, December 1993, Revised April 1994, Also as LAPACK working
  121: *      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
  122: *      1996.
  123: *
  124: *  =====================================================================
  125: *
  126: *     .. Local Scalars ..
  127:       INTEGER            HERE
  128: *     ..
  129: *     .. External Subroutines ..
  130:       EXTERNAL           XERBLA, ZTGEX2
  131: *     ..
  132: *     .. Intrinsic Functions ..
  133:       INTRINSIC          MAX
  134: *     ..
  135: *     .. Executable Statements ..
  136: *
  137: *     Decode and test input arguments.
  138:       INFO = 0
  139:       IF( N.LT.0 ) THEN
  140:          INFO = -3
  141:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  142:          INFO = -5
  143:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  144:          INFO = -7
  145:       ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
  146:          INFO = -9
  147:       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
  148:          INFO = -11
  149:       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
  150:          INFO = -12
  151:       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
  152:          INFO = -13
  153:       END IF
  154:       IF( INFO.NE.0 ) THEN
  155:          CALL XERBLA( 'ZTGEXC', -INFO )
  156:          RETURN
  157:       END IF
  158: *
  159: *     Quick return if possible
  160: *
  161:       IF( N.LE.1 )
  162:      $   RETURN
  163:       IF( IFST.EQ.ILST )
  164:      $   RETURN
  165: *
  166:       IF( IFST.LT.ILST ) THEN
  167: *
  168:          HERE = IFST
  169: *
  170:    10    CONTINUE
  171: *
  172: *        Swap with next one below
  173: *
  174:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
  175:      $                HERE, INFO )
  176:          IF( INFO.NE.0 ) THEN
  177:             ILST = HERE
  178:             RETURN
  179:          END IF
  180:          HERE = HERE + 1
  181:          IF( HERE.LT.ILST )
  182:      $      GO TO 10
  183:          HERE = HERE - 1
  184:       ELSE
  185:          HERE = IFST - 1
  186: *
  187:    20    CONTINUE
  188: *
  189: *        Swap with next one above
  190: *
  191:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
  192:      $                HERE, INFO )
  193:          IF( INFO.NE.0 ) THEN
  194:             ILST = HERE
  195:             RETURN
  196:          END IF
  197:          HERE = HERE - 1
  198:          IF( HERE.GE.ILST )
  199:      $      GO TO 20
  200:          HERE = HERE + 1
  201:       END IF
  202:       ILST = HERE
  203:       RETURN
  204: *
  205: *     End of ZTGEXC
  206: *
  207:       END