35 #ifndef TEMPLATE_LAPACK_TGEVC_HEADER 36 #define TEMPLATE_LAPACK_TGEVC_HEADER 260 integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1,
261 vr_offset, i__1, i__2, i__3, i__4, i__5;
262 Treal d__1, d__2, d__3, d__4, d__5, d__6;
265 Treal dmin__, temp, suma[4] , sumb[4]
267 Treal cim2a, cim2b, cre2a, cre2b, temp2, bdiag[2];
284 Treal acoefa, bcoefa, cimaga, cimagb;
287 Treal bcoefi, ascale, bscale, creala;
292 Treal salfar, safmin;
293 Treal xscale, bignum;
299 #define suma_ref(a_1,a_2) suma[(a_2)*2 + a_1 - 3] 300 #define sumb_ref(a_1,a_2) sumb[(a_2)*2 + a_1 - 3] 301 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1] 302 #define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1] 303 #define vl_ref(a_1,a_2) vl[(a_2)*vl_dim1 + a_1] 304 #define vr_ref(a_1,a_2) vr[(a_2)*vr_dim1 + a_1] 305 #define sum_ref(a_1,a_2) sum[(a_2)*2 + a_1 - 3] 310 a_offset = 1 + a_dim1 * 1;
313 b_offset = 1 + b_dim1 * 1;
316 vl_offset = 1 + vl_dim1 * 1;
319 vr_offset = 1 + vr_dim1 * 1;
363 }
else if (ihwmny < 0) {
384 for (j = 1; j <= i__1; ++j) {
390 if (
a_ref(j + 1, j) != 0.) {
395 if (select[j] || select[j + 1]) {
415 for (j = 1; j <= i__1; ++j) {
416 if (
a_ref(j + 1, j) != 0.) {
422 if (
a_ref(j + 2, j + 1) != 0.) {
434 }
else if ( ( compl_AAAA && *ldvl < *n ) || *ldvl < 1) {
436 }
else if ( ( compr && *ldvr < *n ) || *ldvr < 1) {
438 }
else if (*mm < im) {
460 small = safmin * *n / ulp;
462 bignum = 1. / (safmin * *n);
478 for (j = 2; j <= i__1; ++j) {
481 if (
a_ref(j, j - 1) == 0.) {
487 for (i__ = 1; i__ <= i__2; ++i__) {
493 work[*n + j] = temp2;
497 for (i__ = iend + 1; i__ <= i__2; ++i__) {
507 ascale = 1. /
maxMACRO(anorm,safmin);
508 bscale = 1. /
maxMACRO(bnorm,safmin);
519 for (je = 1; je <= i__1; ++je) {
532 if (
a_ref(je + 1, je) != 0.) {
540 ilcomp = select[je] || select[je + 1];
552 if ((d__1 =
a_ref(je, je),
absMACRO(d__1)) <= safmin && (d__2 =
559 for (jr = 1; jr <= i__2; ++jr) {
571 for (jr = 1; jr <= i__2; ++jr) {
572 work[(*n << 1) + jr] = 0.;
585 d__3 = (d__1 =
a_ref(je, je),
absMACRO(d__1)) * ascale, d__4 = (
589 salfar = temp *
a_ref(je, je) * ascale;
590 sbeta = temp *
b_ref(je, je) * bscale;
591 acoef = sbeta * ascale;
592 bcoefr = salfar * bscale;
613 d__1 = scale, d__2 = 1. / (safmin *
maxMACRO(d__3,d__4));
616 acoef = ascale * (scale * sbeta);
618 acoef = scale * acoef;
621 bcoefr = bscale * (scale * salfar);
623 bcoefr = scale * bcoefr;
631 work[(*n << 1) + je] = 1.;
637 d__1 = safmin * 100.;
639 acoef, &temp, &bcoefr, &temp2, &bcoefi);
651 if (acoefa * ulp < safmin && acoefa >= safmin) {
652 scale = safmin / ulp / acoefa;
654 if (bcoefa * ulp < safmin && bcoefa >= safmin) {
656 d__1 = scale, d__2 = safmin / ulp / bcoefa;
659 if (safmin * acoefa > ascale) {
660 scale = ascale / (safmin * acoefa);
662 if (safmin * bcoefa > bscale) {
664 d__1 = scale, d__2 = bscale / (safmin * bcoefa);
668 acoef = scale * acoef;
670 bcoefr = scale * bcoefr;
671 bcoefi = scale * bcoefi;
677 temp = acoef *
a_ref(je + 1, je);
678 temp2r = acoef *
a_ref(je, je) - bcoefr *
b_ref(je, je);
679 temp2i = -bcoefi *
b_ref(je, je);
681 work[(*n << 1) + je] = 1.;
682 work[*n * 3 + je] = 0.;
683 work[(*n << 1) + je + 1] = -temp2r / temp;
684 work[*n * 3 + je + 1] = -temp2i / temp;
686 work[(*n << 1) + je + 1] = 1.;
687 work[*n * 3 + je + 1] = 0.;
688 temp = acoef *
a_ref(je, je + 1);
689 work[(*n << 1) + je] = (bcoefr *
b_ref(je + 1, je + 1) -
690 acoef *
a_ref(je + 1, je + 1)) / temp;
691 work[*n * 3 + je] = bcoefi *
b_ref(je + 1, je + 1) / temp;
694 d__5 = (d__1 = work[(*n << 1) + je],
absMACRO(d__1)) + (d__2 =
695 work[*n * 3 + je],
absMACRO(d__2)), d__6 = (d__3 = work[(*
696 n << 1) + je + 1],
absMACRO(d__3)) + (d__4 = work[*n * 3 +
702 d__1 = ulp * acoefa * anorm, d__2 = ulp * bcoefa * bnorm, d__1 =
715 for (j = je + nw; j <= i__2; ++j) {
722 bdiag[0] =
b_ref(j, j);
724 if (
a_ref(j + 1, j) != 0.) {
726 bdiag[1] =
b_ref(j + 1, j + 1);
735 d__1 = work[j], d__2 = work[*n + j], d__1 =
maxMACRO(d__1,d__2),
736 d__2 = acoefa * work[j] + bcoefa * work[*n + j];
740 d__1 = temp, d__2 = work[j + 1], d__1 =
maxMACRO(d__1,d__2),
741 d__2 = work[*n + j + 1], d__1 =
maxMACRO(d__1,d__2),
742 d__2 = acoefa * work[j + 1] + bcoefa * work[*n +
746 if (temp > bignum * xscale) {
748 for (jw = 0; jw <= i__3; ++jw) {
750 for (jr = je; jr <= i__4; ++jr) {
751 work[(jw + 2) * *n + jr] = xscale * work[(jw + 2)
792 for (jw = 1; jw <= i__3; ++jw) {
807 for (ja = 1; ja <= i__4; ++ja) {
812 for (jr = je; jr <= i__5; ++jr) {
814 + ja - 1) * work[(jw + 1) * *n + jr];
816 + ja - 1) * work[(jw + 1) * *n + jr];
837 for (ja = 1; ja <= i__3; ++ja) {
855 bdiag, &bdiag[1], sum, &c__2, &bcoefr, &bcoefi, &
856 work[(*n << 1) + j], n, &scale, &temp, &iinfo);
859 for (jw = 0; jw <= i__3; ++jw) {
861 for (jr = je; jr <= i__4; ++jr) {
862 work[(jw + 2) * *n + jr] = scale * work[(jw + 2) *
881 for (jw = 0; jw <= i__2; ++jw) {
884 (jw + 2) * *n + je], &c__1, &c_b37, &work[(jw + 4)
902 for (j = ibeg; j <= i__2; ++j) {
911 for (j = ibeg; j <= i__2; ++j) {
923 for (jw = 0; jw <= i__2; ++jw) {
925 for (jr = ibeg; jr <= i__3; ++jr) {
933 ieig = ieig + nw - 1;
948 for (je = *n; je >= 1; --je) {
964 if (
a_ref(je, je - 1) != 0.) {
972 ilcomp = select[je] || select[je - 1];
984 if ((d__1 =
a_ref(je, je),
absMACRO(d__1)) <= safmin && (d__2 =
991 for (jr = 1; jr <= i__1; ++jr) {
1003 for (jw = 0; jw <= i__1; ++jw) {
1005 for (jr = 1; jr <= i__2; ++jr) {
1006 work[(jw + 2) * *n + jr] = 0.;
1021 d__3 = (d__1 =
a_ref(je, je),
absMACRO(d__1)) * ascale, d__4 = (
1025 salfar = temp *
a_ref(je, je) * ascale;
1026 sbeta = temp *
b_ref(je, je) * bscale;
1027 acoef = sbeta * ascale;
1028 bcoefr = salfar * bscale;
1049 d__1 = scale, d__2 = 1. / (safmin *
maxMACRO(d__3,d__4));
1052 acoef = ascale * (scale * sbeta);
1054 acoef = scale * acoef;
1057 bcoefr = bscale * (scale * salfar);
1059 bcoefr = scale * bcoefr;
1067 work[(*n << 1) + je] = 1.;
1074 for (jr = 1; jr <= i__1; ++jr) {
1075 work[(*n << 1) + jr] = bcoefr *
b_ref(jr, je) - acoef *
1083 d__1 = safmin * 100.;
1085 ldb, &d__1, &acoef, &temp, &bcoefr, &temp2, &bcoefi);
1096 if (acoefa * ulp < safmin && acoefa >= safmin) {
1097 scale = safmin / ulp / acoefa;
1099 if (bcoefa * ulp < safmin && bcoefa >= safmin) {
1101 d__1 = scale, d__2 = safmin / ulp / bcoefa;
1104 if (safmin * acoefa > ascale) {
1105 scale = ascale / (safmin * acoefa);
1107 if (safmin * bcoefa > bscale) {
1109 d__1 = scale, d__2 = bscale / (safmin * bcoefa);
1113 acoef = scale * acoef;
1115 bcoefr = scale * bcoefr;
1116 bcoefi = scale * bcoefi;
1123 temp = acoef *
a_ref(je, je - 1);
1124 temp2r = acoef *
a_ref(je, je) - bcoefr *
b_ref(je, je);
1125 temp2i = -bcoefi *
b_ref(je, je);
1127 work[(*n << 1) + je] = 1.;
1128 work[*n * 3 + je] = 0.;
1129 work[(*n << 1) + je - 1] = -temp2r / temp;
1130 work[*n * 3 + je - 1] = -temp2i / temp;
1132 work[(*n << 1) + je - 1] = 1.;
1133 work[*n * 3 + je - 1] = 0.;
1134 temp = acoef *
a_ref(je - 1, je);
1135 work[(*n << 1) + je] = (bcoefr *
b_ref(je - 1, je - 1) -
1136 acoef *
a_ref(je - 1, je - 1)) / temp;
1137 work[*n * 3 + je] = bcoefi *
b_ref(je - 1, je - 1) / temp;
1141 d__5 = (d__1 = work[(*n << 1) + je],
absMACRO(d__1)) + (d__2 =
1142 work[*n * 3 + je],
absMACRO(d__2)), d__6 = (d__3 = work[(*
1143 n << 1) + je - 1],
absMACRO(d__3)) + (d__4 = work[*n * 3 +
1150 creala = acoef * work[(*n << 1) + je - 1];
1151 cimaga = acoef * work[*n * 3 + je - 1];
1152 crealb = bcoefr * work[(*n << 1) + je - 1] - bcoefi * work[*n
1154 cimagb = bcoefi * work[(*n << 1) + je - 1] + bcoefr * work[*n
1156 cre2a = acoef * work[(*n << 1) + je];
1157 cim2a = acoef * work[*n * 3 + je];
1158 cre2b = bcoefr * work[(*n << 1) + je] - bcoefi * work[*n * 3
1160 cim2b = bcoefi * work[(*n << 1) + je] + bcoefr * work[*n * 3
1163 for (jr = 1; jr <= i__1; ++jr) {
1164 work[(*n << 1) + jr] = -creala *
a_ref(jr, je - 1) +
1165 crealb *
b_ref(jr, je - 1) - cre2a *
a_ref(jr, je)
1166 + cre2b *
b_ref(jr, je);
1167 work[*n * 3 + jr] = -cimaga *
a_ref(jr, je - 1) + cimagb *
1169 cim2b *
b_ref(jr, je);
1175 d__1 = ulp * acoefa * anorm, d__2 = ulp * bcoefa * bnorm, d__1 =
1182 for (j = je - nw; j >= 1; --j) {
1187 if (! il2by2 && j > 1) {
1188 if (
a_ref(j, j - 1) != 0.) {
1193 bdiag[0] =
b_ref(j, j);
1196 bdiag[1] =
b_ref(j + 1, j + 1);
1204 lda, bdiag, &bdiag[1], &work[(*n << 1) + j], n, &
1205 bcoefr, &bcoefi, sum, &c__2, &scale, &temp, &iinfo);
1209 for (jw = 0; jw <= i__1; ++jw) {
1211 for (jr = 1; jr <= i__2; ++jr) {
1212 work[(jw + 2) * *n + jr] = scale * work[(jw + 2) *
1220 d__1 = scale * xmax;
1224 for (jw = 1; jw <= i__1; ++jw) {
1226 for (ja = 1; ja <= i__2; ++ja) {
1227 work[(jw + 1) * *n + j + ja - 1] =
sum_ref(ja, jw);
1240 temp = acoefa * work[j] + bcoefa * work[*n + j];
1243 d__1 = temp, d__2 = acoefa * work[j + 1] + bcoefa *
1250 if (temp > bignum * xscale) {
1253 for (jw = 0; jw <= i__1; ++jw) {
1255 for (jr = 1; jr <= i__2; ++jr) {
1256 work[(jw + 2) * *n + jr] = xscale * work[(jw
1271 for (ja = 1; ja <= i__1; ++ja) {
1273 creala = acoef * work[(*n << 1) + j + ja - 1];
1274 cimaga = acoef * work[*n * 3 + j + ja - 1];
1275 crealb = bcoefr * work[(*n << 1) + j + ja - 1] -
1276 bcoefi * work[*n * 3 + j + ja - 1];
1277 cimagb = bcoefi * work[(*n << 1) + j + ja - 1] +
1278 bcoefr * work[*n * 3 + j + ja - 1];
1280 for (jr = 1; jr <= i__2; ++jr) {
1281 work[(*n << 1) + jr] = work[(*n << 1) + jr] -
1282 creala *
a_ref(jr, j + ja - 1) +
1283 crealb *
b_ref(jr, j + ja - 1);
1284 work[*n * 3 + jr] = work[*n * 3 + jr] -
1285 cimaga *
a_ref(jr, j + ja - 1) +
1286 cimagb *
b_ref(jr, j + ja - 1);
1290 creala = acoef * work[(*n << 1) + j + ja - 1];
1291 crealb = bcoefr * work[(*n << 1) + j + ja - 1];
1293 for (jr = 1; jr <= i__2; ++jr) {
1294 work[(*n << 1) + jr] = work[(*n << 1) + jr] -
1295 creala *
a_ref(jr, j + ja - 1) +
1296 crealb *
b_ref(jr, j + ja - 1);
1316 for (jw = 0; jw <= i__1; ++jw) {
1318 for (jr = 1; jr <= i__2; ++jr) {
1319 work[(jw + 4) * *n + jr] = work[(jw + 2) * *n + 1] *
1329 for (jc = 2; jc <= i__2; ++jc) {
1331 for (jr = 1; jr <= i__3; ++jr) {
1332 work[(jw + 4) * *n + jr] += work[(jw + 2) * *n +
1342 for (jw = 0; jw <= i__1; ++jw) {
1344 for (jr = 1; jr <= i__2; ++jr) {
1345 vr_ref(jr, ieig + jw) = work[(jw + 4) * *n + jr];
1354 for (jw = 0; jw <= i__1; ++jw) {
1356 for (jr = 1; jr <= i__2; ++jr) {
1357 vr_ref(jr, ieig + jw) = work[(jw + 2) * *n + jr];
1371 for (j = 1; j <= i__1; ++j) {
1380 for (j = 1; j <= i__1; ++j) {
1388 if (xmax > safmin) {
1391 for (jw = 0; jw <= i__1; ++jw) {
1393 for (jr = 1; jr <= i__2; ++jr) {
#define absMACRO(x)
Definition: template_blas_common.h:45
int template_lapack_lacpy(const char *uplo, const integer *m, const integer *n, const Treal *a, const integer *lda, Treal *b, const integer *ldb)
Definition: template_lapack_lacpy.h:40
int integer
Definition: template_blas_common.h:38
#define maxMACRO(a, b)
Definition: template_blas_common.h:43
int template_lapack_labad(Treal *small, Treal *large)
Definition: template_lapack_labad.h:40
#define sum_ref(a_1, a_2)
#define minMACRO(a, b)
Definition: template_blas_common.h:44
int template_lapack_lag2(const Treal *a, const integer *lda, const Treal *b, const integer *ldb, const Treal *safmin, Treal *scale1, Treal *scale2, Treal *wr1, Treal *wr2, Treal *wi)
Definition: template_lapack_lag2.h:40
int template_blas_erbla(const char *srname, integer *info)
Definition: template_blas_common.cc:144
#define suma_ref(a_1, a_2)
Treal template_lapack_lamch(const char *cmach, Treal dummyReal)
Definition: template_lapack_lamch.h:199
int template_blas_gemv(const char *trans, const integer *m, const integer *n, const Treal *alpha, const Treal *a, const integer *lda, const Treal *x, const integer *incx, const Treal *beta, Treal *y, const integer *incy)
Definition: template_blas_gemv.h:41
#define sumb_ref(a_1, a_2)
bool logical
Definition: template_blas_common.h:39
side
Definition: Matrix.h:73
#define TRUE_
Definition: template_lapack_common.h:40
int template_lapack_laln2(const logical *ltrans, const integer *na, const integer *nw, const Treal *smin, const Treal *ca, const Treal *a, const integer *lda, const Treal *d1, const Treal *d2, const Treal *b, const integer *ldb, const Treal *wr, const Treal *wi, Treal *x, const integer *ldx, Treal *scale, Treal *xnorm, integer *info)
Definition: template_lapack_laln2.h:40
#define FALSE_
Definition: template_lapack_common.h:41
logical template_blas_lsame(const char *ca, const char *cb)
Definition: template_blas_common.cc:44
int template_lapack_tgevc(const char *side, const char *howmny, const logical *select, const integer *n, const Treal *a, const integer *lda, const Treal *b, const integer *ldb, Treal *vl, const integer *ldvl, Treal *vr, const integer *ldvr, const integer *mm, integer *m, Treal *work, integer *info)
Definition: template_lapack_tgevc.h:44