Accord.Math.Decompositions.JaggedGeneralizedEigenvalueDecomposition.qzvec C# (CSharp) Method

qzvec() private static method

Adaptation of the original Fortran QZVEC routine from EISPACK.
This subroutine is the optional fourth step of the qz algorithm for solving generalized matrix eigenvalue problems, Siam J. Numer. anal. 10, 241-256(1973) by Moler and Stewart. This subroutine accepts a pair of real matrices, one of them in quasi-triangular form (in which each 2-by-2 block corresponds to a pair of complex eigenvalues) and the other in upper triangular form. It computes the eigenvectors of the triangular problem and transforms the results back to the original coordinate system. it is usually preceded by qzhes, qzit, and qzval. For the full documentation, please check the original function.
private static qzvec ( int n, double a, double b, double alfr, double alfi, double beta, double z ) : int
n int
a double
b double
alfr double
alfi double
beta double
z double
return int
        private static int qzvec(int n, double[][] a, double[][] b, double[] alfr, double[] alfi, double[] beta, double[][] z)
        {
            int i, j, k, m;
            int na, ii, en, jj, nn, enm2;
            double d, q;
            double r = 0, s = 0, t, w, x = 0, y, t1, t2, w1, x1 = 0, z1 = 0, di;
            double ra, dr, sa;
            double ti, rr, tr, zz = 0;
            double alfm, almi, betm, almr;

            double epsb = b[n - 1][0];
            int isw = 1;


            // for en=n step -1 until 1 do --
            for (nn = 0; nn < n; ++nn)
            {
                en = n - nn - 1;
                na = en - 1;
                if (isw == 2) goto L795;
                if (alfi[en] != 0.0) goto L710;

                // Real vector
                m = en;
                b[en][en] = 1.0;
                if (na == -1) goto L800;
                alfm = alfr[m];
                betm = beta[m];

                // for i=en-1 step -1 until 1 do --
                for (ii = 0; ii <= na; ++ii)
                {
                    i = en - ii - 1;
                    w = betm * a[i][i] - alfm * b[i][i];
                    r = 0.0;

                    for (j = m; j <= en; ++j)
                        r += (betm * a[i][j] - alfm * b[i][j]) * b[j][en];

                    if (i == 0 || isw == 2)
                        goto L630;

                    if (betm * a[i][i - 1] == 0.0)
                        goto L630;

                    zz = w;
                    s = r;
                    goto L690;

                L630:
                    m = i;
                    if (isw == 2) goto L640;

                    // Real 1-by-1 block
                    t = w;
                    if (w == 0.0)
                        t = epsb;
                    b[i][en] = -r / t;
                    goto L700;

                // Real 2-by-2 block
                L640:
                    x = betm * a[i][i + 1] - alfm * b[i][i + 1];
                    y = betm * a[i + 1][i];
                    q = w * zz - x * y;
                    t = (x * s - zz * r) / q;
                    b[i][en] = t;
                    if (Math.Abs(x) <= Math.Abs(zz)) goto L650;
                    b[i + 1][en] = (-r - w * t) / x;
                    goto L690;

                L650:
                    b[i + 1][en] = (-s - y * t) / zz;

                L690:
                    isw = 3 - isw;

                L700:
                    ;
                }
                // End real vector
                goto L800;

            // Complex vector
            L710:
                m = na;
                almr = alfr[m];
                almi = alfi[m];
                betm = beta[m];

                // last vector component chosen imaginary so that eigenvector matrix is triangular
                y = betm * a[en][na];
                b[na][na] = -almi * b[en][en] / y;
                b[na][en] = (almr * b[en][en] - betm * a[en][en]) / y;
                b[en][na] = 0.0;
                b[en][en] = 1.0;
                enm2 = na;
                if (enm2 == 0) goto L795;

                // for i=en-2 step -1 until 1 do --
                for (ii = 0; ii < enm2; ++ii)
                {
                    i = na - ii - 1;
                    w = betm * a[i][i] - almr * b[i][i];
                    w1 = -almi * b[i][i];
                    ra = 0.0;
                    sa = 0.0;

                    for (j = m; j <= en; ++j)
                    {
                        x = betm * a[i][j] - almr * b[i][j];
                        x1 = -almi * b[i][j];
                        ra = ra + x * b[j][na] - x1 * b[j][en];
                        sa = sa + x * b[j][en] + x1 * b[j][na];
                    }

                    if (i == 0 || isw == 2) goto L770;
                    if (betm * a[i][i - 1] == 0.0) goto L770;

                    zz = w;
                    z1 = w1;
                    r = ra;
                    s = sa;
                    isw = 2;
                    goto L790;

                L770:
                    m = i;
                    if (isw == 2) goto L780;

                    // Complex 1-by-1 block 
                    tr = -ra;
                    ti = -sa;

                L773:
                    dr = w;
                    di = w1;

                    // Complex divide (t1,t2) = (tr,ti) / (dr,di)
                L775:
                    if (Math.Abs(di) > Math.Abs(dr)) goto L777;
                    rr = di / dr;
                    d = dr + di * rr;
                    t1 = (tr + ti * rr) / d;
                    t2 = (ti - tr * rr) / d;

                    switch (isw)
                    {
                        case 1: goto L787;
                        case 2: goto L782;
                    }

                L777:
                    rr = dr / di;
                    d = dr * rr + di;
                    t1 = (tr * rr + ti) / d;
                    t2 = (ti * rr - tr) / d;
                    switch (isw)
                    {
                        case 1: goto L787;
                        case 2: goto L782;
                    }

                   // Complex 2-by-2 block 
                L780:
                    x = betm * a[i][i + 1] - almr * b[i][i + 1];
                    x1 = -almi * b[i][i + 1];
                    y = betm * a[i + 1][i];
                    tr = y * ra - w * r + w1 * s;
                    ti = y * sa - w * s - w1 * r;
                    dr = w * zz - w1 * z1 - x * y;
                    di = w * z1 + w1 * zz - x1 * y;
                    if (dr == 0.0 && di == 0.0)
                        dr = epsb;
                    goto L775;

                L782:
                    b[i + 1][na] = t1;
                    b[i + 1][en] = t2;
                    isw = 1;
                    if (Math.Abs(y) > Math.Abs(w) + Math.Abs(w1))
                        goto L785;
                    tr = -ra - x * b[(i + 1)][na] + x1 * b[(i + 1)][en];
                    ti = -sa - x * b[(i + 1)][en] - x1 * b[(i + 1)][na];
                    goto L773;

                L785:
                    t1 = (-r - zz * b[(i + 1)][na] + z1 * b[(i + 1)][en]) / y;
                    t2 = (-s - zz * b[(i + 1)][en] - z1 * b[(i + 1)][na]) / y;

                L787:
                    b[i][na] = t1;
                    b[i][en] = t2;

                L790:
                    ;
                }

                // End complex vector
            L795:
                isw = 3 - isw;

            L800:
                ;
            }

            // End back substitution. Transform to original coordinate system.
            for (jj = 0; jj < n; ++jj)
            {
                j = n - jj - 1;

                for (i = 0; i < n; ++i)
                {
                    zz = 0.0;
                    for (k = 0; k <= j; ++k)
                        zz += z[i][k] * b[k][j];
                    z[i][j] = zz;
                }
            }

            // Normalize so that modulus of largest component of each vector is 1.
            // (isw is 1 initially from before)
            for (j = 0; j < n; ++j)
            {
                d = 0.0;
                if (isw == 2) goto L920;
                if (alfi[j] != 0.0) goto L945;

                for (i = 0; i < n; ++i)
                {
                    if ((Math.Abs(z[i][j])) > d)
                        d = (Math.Abs(z[i][j]));
                }

                for (i = 0; i < n; ++i)
                    z[i][j] /= d;

                goto L950;

            L920:
                for (i = 0; i < n; ++i)
                {
                    r = System.Math.Abs(z[i][j - 1]) + System.Math.Abs(z[i][j]);
                    if (r != 0.0)
                    {
                        // Computing 2nd power
                        double u1 = z[i][j - 1] / r;
                        double u2 = z[i][j] / r;
                        r *= Math.Sqrt(u1 * u1 + u2 * u2);
                    }
                    if (r > d)
                        d = r;
                }

                for (i = 0; i < n; ++i)
                {
                    z[i][j - 1] /= d;
                    z[i][j] /= d;
                }

            L945:
                isw = 3 - isw;

            L950:
                ;
            }

            return 0;
        }