ztgexc.c
Go to the documentation of this file.
00001 /* ztgexc.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Subroutine */ int ztgexc_(logical *wantq, logical *wantz, integer *n, 
00017         doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, 
00018         doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz, 
00019         integer *ifst, integer *ilst, integer *info)
00020 {
00021     /* System generated locals */
00022     integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, z_dim1, 
00023             z_offset, i__1;
00024 
00025     /* Local variables */
00026     integer here;
00027     extern /* Subroutine */ int ztgex2_(logical *, logical *, integer *, 
00028             doublecomplex *, integer *, doublecomplex *, integer *, 
00029             doublecomplex *, integer *, doublecomplex *, integer *, integer *, 
00030              integer *), xerbla_(char *, integer *);
00031 
00032 
00033 /*  -- LAPACK routine (version 3.2) -- */
00034 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00035 /*     November 2006 */
00036 
00037 /*     .. Scalar Arguments .. */
00038 /*     .. */
00039 /*     .. Array Arguments .. */
00040 /*     .. */
00041 
00042 /*  Purpose */
00043 /*  ======= */
00044 
00045 /*  ZTGEXC reorders the generalized Schur decomposition of a complex */
00046 /*  matrix pair (A,B), using an unitary equivalence transformation */
00047 /*  (A, B) := Q * (A, B) * Z', so that the diagonal block of (A, B) with */
00048 /*  row index IFST is moved to row ILST. */
00049 
00050 /*  (A, B) must be in generalized Schur canonical form, that is, A and */
00051 /*  B are both upper triangular. */
00052 
00053 /*  Optionally, the matrices Q and Z of generalized Schur vectors are */
00054 /*  updated. */
00055 
00056 /*         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)' */
00057 /*         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)' */
00058 
00059 /*  Arguments */
00060 /*  ========= */
00061 
00062 /*  WANTQ   (input) LOGICAL */
00063 /*          .TRUE. : update the left transformation matrix Q; */
00064 /*          .FALSE.: do not update Q. */
00065 
00066 /*  WANTZ   (input) LOGICAL */
00067 /*          .TRUE. : update the right transformation matrix Z; */
00068 /*          .FALSE.: do not update Z. */
00069 
00070 /*  N       (input) INTEGER */
00071 /*          The order of the matrices A and B. N >= 0. */
00072 
00073 /*  A       (input/output) COMPLEX*16 array, dimension (LDA,N) */
00074 /*          On entry, the upper triangular matrix A in the pair (A, B). */
00075 /*          On exit, the updated matrix A. */
00076 
00077 /*  LDA     (input)  INTEGER */
00078 /*          The leading dimension of the array A. LDA >= max(1,N). */
00079 
00080 /*  B       (input/output) COMPLEX*16 array, dimension (LDB,N) */
00081 /*          On entry, the upper triangular matrix B in the pair (A, B). */
00082 /*          On exit, the updated matrix B. */
00083 
00084 /*  LDB     (input)  INTEGER */
00085 /*          The leading dimension of the array B. LDB >= max(1,N). */
00086 
00087 /*  Q       (input/output) COMPLEX*16 array, dimension (LDZ,N) */
00088 /*          On entry, if WANTQ = .TRUE., the unitary matrix Q. */
00089 /*          On exit, the updated matrix Q. */
00090 /*          If WANTQ = .FALSE., Q is not referenced. */
00091 
00092 /*  LDQ     (input) INTEGER */
00093 /*          The leading dimension of the array Q. LDQ >= 1; */
00094 /*          If WANTQ = .TRUE., LDQ >= N. */
00095 
00096 /*  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N) */
00097 /*          On entry, if WANTZ = .TRUE., the unitary matrix Z. */
00098 /*          On exit, the updated matrix Z. */
00099 /*          If WANTZ = .FALSE., Z is not referenced. */
00100 
00101 /*  LDZ     (input) INTEGER */
00102 /*          The leading dimension of the array Z. LDZ >= 1; */
00103 /*          If WANTZ = .TRUE., LDZ >= N. */
00104 
00105 /*  IFST    (input) INTEGER */
00106 /*  ILST    (input/output) INTEGER */
00107 /*          Specify the reordering of the diagonal blocks of (A, B). */
00108 /*          The block with row index IFST is moved to row ILST, by a */
00109 /*          sequence of swapping between adjacent blocks. */
00110 
00111 /*  INFO    (output) INTEGER */
00112 /*           =0:  Successful exit. */
00113 /*           <0:  if INFO = -i, the i-th argument had an illegal value. */
00114 /*           =1:  The transformed matrix pair (A, B) would be too far */
00115 /*                from generalized Schur form; the problem is ill- */
00116 /*                conditioned. (A, B) may have been partially reordered, */
00117 /*                and ILST points to the first row of the current */
00118 /*                position of the block being moved. */
00119 
00120 
00121 /*  Further Details */
00122 /*  =============== */
00123 
00124 /*  Based on contributions by */
00125 /*     Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
00126 /*     Umea University, S-901 87 Umea, Sweden. */
00127 
00128 /*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the */
00129 /*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in */
00130 /*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and */
00131 /*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. */
00132 
00133 /*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified */
00134 /*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition */
00135 /*      Estimation: Theory, Algorithms and Software, Report */
00136 /*      UMINF - 94.04, Department of Computing Science, Umea University, */
00137 /*      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87. */
00138 /*      To appear in Numerical Algorithms, 1996. */
00139 
00140 /*  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software */
00141 /*      for Solving the Generalized Sylvester Equation and Estimating the */
00142 /*      Separation between Regular Matrix Pairs, Report UMINF - 93.23, */
00143 /*      Department of Computing Science, Umea University, S-901 87 Umea, */
00144 /*      Sweden, December 1993, Revised April 1994, Also as LAPACK working */
00145 /*      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1, */
00146 /*      1996. */
00147 
00148 /*  ===================================================================== */
00149 
00150 /*     .. Local Scalars .. */
00151 /*     .. */
00152 /*     .. External Subroutines .. */
00153 /*     .. */
00154 /*     .. Intrinsic Functions .. */
00155 /*     .. */
00156 /*     .. Executable Statements .. */
00157 
00158 /*     Decode and test input arguments. */
00159     /* Parameter adjustments */
00160     a_dim1 = *lda;
00161     a_offset = 1 + a_dim1;
00162     a -= a_offset;
00163     b_dim1 = *ldb;
00164     b_offset = 1 + b_dim1;
00165     b -= b_offset;
00166     q_dim1 = *ldq;
00167     q_offset = 1 + q_dim1;
00168     q -= q_offset;
00169     z_dim1 = *ldz;
00170     z_offset = 1 + z_dim1;
00171     z__ -= z_offset;
00172 
00173     /* Function Body */
00174     *info = 0;
00175     if (*n < 0) {
00176         *info = -3;
00177     } else if (*lda < max(1,*n)) {
00178         *info = -5;
00179     } else if (*ldb < max(1,*n)) {
00180         *info = -7;
00181     } else if (*ldq < 1 || *wantq && *ldq < max(1,*n)) {
00182         *info = -9;
00183     } else if (*ldz < 1 || *wantz && *ldz < max(1,*n)) {
00184         *info = -11;
00185     } else if (*ifst < 1 || *ifst > *n) {
00186         *info = -12;
00187     } else if (*ilst < 1 || *ilst > *n) {
00188         *info = -13;
00189     }
00190     if (*info != 0) {
00191         i__1 = -(*info);
00192         xerbla_("ZTGEXC", &i__1);
00193         return 0;
00194     }
00195 
00196 /*     Quick return if possible */
00197 
00198     if (*n <= 1) {
00199         return 0;
00200     }
00201     if (*ifst == *ilst) {
00202         return 0;
00203     }
00204 
00205     if (*ifst < *ilst) {
00206 
00207         here = *ifst;
00208 
00209 L10:
00210 
00211 /*        Swap with next one below */
00212 
00213         ztgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
00214                 q_offset], ldq, &z__[z_offset], ldz, &here, info);
00215         if (*info != 0) {
00216             *ilst = here;
00217             return 0;
00218         }
00219         ++here;
00220         if (here < *ilst) {
00221             goto L10;
00222         }
00223         --here;
00224     } else {
00225         here = *ifst - 1;
00226 
00227 L20:
00228 
00229 /*        Swap with next one above */
00230 
00231         ztgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
00232                 q_offset], ldq, &z__[z_offset], ldz, &here, info);
00233         if (*info != 0) {
00234             *ilst = here;
00235             return 0;
00236         }
00237         --here;
00238         if (here >= *ilst) {
00239             goto L20;
00240         }
00241         ++here;
00242     }
00243     *ilst = here;
00244     return 0;
00245 
00246 /*     End of ZTGEXC */
00247 
00248 } /* ztgexc_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:43