File:  [local] / rpl / lapack / lapack / ztgexc.f
Revision 1.19: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:40 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b ZTGEXC
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZTGEXC + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztgexc.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztgexc.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztgexc.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZTGEXC( 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*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
   30: *      $                   Z( LDZ, * )
   31: *       ..
   32: *
   33: *
   34: *> \par Purpose:
   35: *  =============
   36: *>
   37: *> \verbatim
   38: *>
   39: *> ZTGEXC 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*16 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*16 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*16 array, dimension (LDQ,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*16 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: *> \ingroup complex16GEcomputational
  167: *
  168: *> \par Contributors:
  169: *  ==================
  170: *>
  171: *>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
  172: *>     Umea University, S-901 87 Umea, Sweden.
  173: *
  174: *> \par References:
  175: *  ================
  176: *>
  177: *>  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
  178: *>      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
  179: *>      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
  180: *>      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
  181: *> \n
  182: *>  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
  183: *>      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
  184: *>      Estimation: Theory, Algorithms and Software, Report
  185: *>      UMINF - 94.04, Department of Computing Science, Umea University,
  186: *>      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
  187: *>      To appear in Numerical Algorithms, 1996.
  188: *> \n
  189: *>  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
  190: *>      for Solving the Generalized Sylvester Equation and Estimating the
  191: *>      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
  192: *>      Department of Computing Science, Umea University, S-901 87 Umea,
  193: *>      Sweden, December 1993, Revised April 1994, Also as LAPACK working
  194: *>      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
  195: *>      1996.
  196: *>
  197: *  =====================================================================
  198:       SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
  199:      $                   LDZ, IFST, ILST, INFO )
  200: *
  201: *  -- LAPACK computational routine --
  202: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  203: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  204: *
  205: *     .. Scalar Arguments ..
  206:       LOGICAL            WANTQ, WANTZ
  207:       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
  208: *     ..
  209: *     .. Array Arguments ..
  210:       COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
  211:      $                   Z( LDZ, * )
  212: *     ..
  213: *
  214: *  =====================================================================
  215: *
  216: *     .. Local Scalars ..
  217:       INTEGER            HERE
  218: *     ..
  219: *     .. External Subroutines ..
  220:       EXTERNAL           XERBLA, ZTGEX2
  221: *     ..
  222: *     .. Intrinsic Functions ..
  223:       INTRINSIC          MAX
  224: *     ..
  225: *     .. Executable Statements ..
  226: *
  227: *     Decode and test input arguments.
  228:       INFO = 0
  229:       IF( N.LT.0 ) THEN
  230:          INFO = -3
  231:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  232:          INFO = -5
  233:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  234:          INFO = -7
  235:       ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
  236:          INFO = -9
  237:       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
  238:          INFO = -11
  239:       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
  240:          INFO = -12
  241:       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
  242:          INFO = -13
  243:       END IF
  244:       IF( INFO.NE.0 ) THEN
  245:          CALL XERBLA( 'ZTGEXC', -INFO )
  246:          RETURN
  247:       END IF
  248: *
  249: *     Quick return if possible
  250: *
  251:       IF( N.LE.1 )
  252:      $   RETURN
  253:       IF( IFST.EQ.ILST )
  254:      $   RETURN
  255: *
  256:       IF( IFST.LT.ILST ) THEN
  257: *
  258:          HERE = IFST
  259: *
  260:    10    CONTINUE
  261: *
  262: *        Swap with next one below
  263: *
  264:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
  265:      $                HERE, INFO )
  266:          IF( INFO.NE.0 ) THEN
  267:             ILST = HERE
  268:             RETURN
  269:          END IF
  270:          HERE = HERE + 1
  271:          IF( HERE.LT.ILST )
  272:      $      GO TO 10
  273:          HERE = HERE - 1
  274:       ELSE
  275:          HERE = IFST - 1
  276: *
  277:    20    CONTINUE
  278: *
  279: *        Swap with next one above
  280: *
  281:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
  282:      $                HERE, INFO )
  283:          IF( INFO.NE.0 ) THEN
  284:             ILST = HERE
  285:             RETURN
  286:          END IF
  287:          HERE = HERE - 1
  288:          IF( HERE.GE.ILST )
  289:      $      GO TO 20
  290:          HERE = HERE + 1
  291:       END IF
  292:       ILST = HERE
  293:       RETURN
  294: *
  295: *     End of ZTGEXC
  296: *
  297:       END

CVSweb interface <joel.bertrand@systella.fr>