📄 dtgexc.c
字号:
/* Current block either 1-by-1 or 2-by-2. */
/*< NBNEXT = 1 >*/
nbnext = 1;
/*< IF( HERE+NBF+1.LE.N ) THEN >*/
if (here + nbf + 1 <= *n) {
/*< >*/
if (a[here + nbf + 1 + (here + nbf) * a_dim1] != 0.) {
nbnext = 2;
}
/*< END IF >*/
}
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
q_offset], ldq, &z__[z_offset], ldz, &here, &nbf, &nbnext,
&work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE + NBNEXT >*/
here += nbnext;
/* Test if 2-by-2 block breaks into two 1-by-1 blocks. */
/*< IF( NBF.EQ.2 ) THEN >*/
if (nbf == 2) {
/*< >*/
if (a[here + 1 + here * a_dim1] == 0.) {
nbf = 3;
}
/*< END IF >*/
}
/*< ELSE >*/
} else {
/* Current block consists of two 1-by-1 blocks, each of which */
/* must be swapped individually. */
/*< NBNEXT = 1 >*/
nbnext = 1;
/*< IF( HERE+3.LE.N ) THEN >*/
if (here + 3 <= *n) {
/*< >*/
if (a[here + 3 + (here + 2) * a_dim1] != 0.) {
nbnext = 2;
}
/*< END IF >*/
}
/*< >*/
i__1 = here + 1;
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
q_offset], ldq, &z__[z_offset], ldz, &i__1, &c__1, &
nbnext, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< IF( NBNEXT.EQ.1 ) THEN >*/
if (nbnext == 1) {
/* Swap two 1-by-1 blocks. */
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb,
&q[q_offset], ldq, &z__[z_offset], ldz, &here, &c__1,
&c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE + 1 >*/
++here;
/*< ELSE >*/
} else {
/* Recompute NBNEXT in case of 2-by-2 split. */
/*< >*/
if (a[here + 2 + (here + 1) * a_dim1] == 0.) {
nbnext = 1;
}
/*< IF( NBNEXT.EQ.2 ) THEN >*/
if (nbnext == 2) {
/* 2-by-2 block did not split. */
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
here, &c__1, &nbnext, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE + 2 >*/
here += 2;
/*< ELSE >*/
} else {
/* 2-by-2 block did split. */
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
here, &c__1, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE + 1 >*/
++here;
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
here, &c__1, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE + 1 >*/
++here;
/*< END IF >*/
}
/*< END IF >*/
}
/*< END IF >*/
}
/*< >*/
if (here < *ilst) {
goto L10;
}
/*< ELSE >*/
} else {
/*< HERE = IFST >*/
here = *ifst;
/*< 20 CONTINUE >*/
L20:
/* Swap with next one below. */
/*< IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN >*/
if (nbf == 1 || nbf == 2) {
/* Current block either 1-by-1 or 2-by-2. */
/*< NBNEXT = 1 >*/
nbnext = 1;
/*< IF( HERE.GE.3 ) THEN >*/
if (here >= 3) {
/*< >*/
if (a[here - 1 + (here - 2) * a_dim1] != 0.) {
nbnext = 2;
}
/*< END IF >*/
}
/*< >*/
i__1 = here - nbnext;
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
q_offset], ldq, &z__[z_offset], ldz, &i__1, &nbnext, &nbf,
&work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE - NBNEXT >*/
here -= nbnext;
/* Test if 2-by-2 block breaks into two 1-by-1 blocks. */
/*< IF( NBF.EQ.2 ) THEN >*/
if (nbf == 2) {
/*< >*/
if (a[here + 1 + here * a_dim1] == 0.) {
nbf = 3;
}
/*< END IF >*/
}
/*< ELSE >*/
} else {
/* Current block consists of two 1-by-1 blocks, each of which */
/* must be swapped individually. */
/*< NBNEXT = 1 >*/
nbnext = 1;
/*< IF( HERE.GE.3 ) THEN >*/
if (here >= 3) {
/*< >*/
if (a[here - 1 + (here - 2) * a_dim1] != 0.) {
nbnext = 2;
}
/*< END IF >*/
}
/*< >*/
i__1 = here - nbnext;
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[
q_offset], ldq, &z__[z_offset], ldz, &i__1, &nbnext, &
c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< IF( NBNEXT.EQ.1 ) THEN >*/
if (nbnext == 1) {
/* Swap two 1-by-1 blocks. */
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb,
&q[q_offset], ldq, &z__[z_offset], ldz, &here, &
nbnext, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE - 1 >*/
--here;
/*< ELSE >*/
} else {
/* Recompute NBNEXT in case of 2-by-2 split. */
/*< >*/
if (a[here + (here - 1) * a_dim1] == 0.) {
nbnext = 1;
}
/*< IF( NBNEXT.EQ.2 ) THEN >*/
if (nbnext == 2) {
/* 2-by-2 block did not split. */
/*< >*/
i__1 = here - 1;
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
i__1, &c__2, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE - 2 >*/
here += -2;
/*< ELSE >*/
} else {
/* 2-by-2 block did split. */
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
here, &c__1, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE - 1 >*/
--here;
/*< >*/
dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
ldb, &q[q_offset], ldq, &z__[z_offset], ldz, &
here, &c__1, &c__1, &work[1], lwork, info);
/*< IF( INFO.NE.0 ) THEN >*/
if (*info != 0) {
/*< ILST = HERE >*/
*ilst = here;
/*< RETURN >*/
return 0;
/*< END IF >*/
}
/*< HERE = HERE - 1 >*/
--here;
/*< END IF >*/
}
/*< END IF >*/
}
/*< END IF >*/
}
/*< >*/
if (here > *ilst) {
goto L20;
}
/*< END IF >*/
}
/*< ILST = HERE >*/
*ilst = here;
/*< WORK( 1 ) = LWMIN >*/
work[1] = (doublereal) lwmin;
/*< RETURN >*/
return 0;
/* End of DTGEXC */
/*< END >*/
} /* dtgexc_ */
#ifdef __cplusplus
}
#endif
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -