Esempio n. 1
0
    public static int dspfa(ref double[] ap, int n, ref int[] kpvt)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DSPFA factors a real symmetric matrix stored in packed form.
    //
    //  Discussion:
    //
    //    To solve A*X = B, follow DSPFA by DSPSL.
    //
    //    To compute inverse(A)*C, follow DSPFA by DSPSL.
    //
    //    To compute determinant(A), follow DSPFA by DSPDI.
    //
    //    To compute inertia(A), follow DSPFA by DSPDI.
    //
    //    To compute inverse(A), follow DSPFA by DSPDI.
    //
    //  Packed storage:
    //
    //    The following program segment will pack the upper triangle of a
    //    symmetric matrix.
    //
    //      k = 0
    //      do j = 1, n
    //        do i = 1, j
    //          k = k + 1
    //          ap(k) = a(i,j)
    //        end do
    //      end do
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    25 May 2005
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double AP[(N*(N+1))/2].  On input, the packed form of a
    //    symmetric matrix A.  The columns of the upper triangle are stored
    //    sequentially in a one-dimensional array.  On output, a block diagonal
    //    matrix and the multipliers which were used to obtain it stored in
    //    packed form.  The factorization can be written A = U*D*U' where U
    //    is a product of permutation and unit upper triangular matrices, U'
    //    is the transpose of U, and D is block diagonal with 1 by 1 and 2
    //    by 2 blocks.
    //
    //    Input, int N, the order of the matrix.
    //
    //    Output, int KPVT[N], the pivot indices.
    //
    //    Output, int DSPFA, error flag.
    //    0, normal value.
    //    K, if the K-th pivot block is singular.  This is not an error
    //    condition for this subroutine, but it does indicate that DSPSL or
    //    DSPDI may divide by zero if called.
    //
    {
        int im = 0;
        //
        //  ALPHA is used in choosing pivot block size.
        //
        double alpha = (1.0 + Math.Sqrt(17.0)) / 8.0;

        int info = 0;
        //
        //  Main loop on K, which goes from N to 1.
        //
        int k  = n;
        int ik = n * (n - 1) / 2;

        for (;;)
        {
            //
            //  Leave the loop if K = 0 or K = 1.
            //
            if (k == 0)
            {
                break;
            }

            if (k == 1)
            {
                kpvt[0] = 1;
                info    = ap[0] switch
                {
                    0.0 => 1,
                    _ => info
                };

                break;
            }

            //
            //  This section of code determines the kind of elimination to be performed.
            //  When it is completed, KSTEP will be set to the size of the pivot block,
            //  and SWAP will be set to .true. if an interchange is required.
            //
            int    km1    = k - 1;
            int    kk     = ik + k;
            double absakk = Math.Abs(ap[kk - 1]);
            //
            //  Determine the largest off-diagonal element in column K.
            //
            int    imax   = BLAS1D.idamax(k - 1, ap, 1, index: +ik);
            int    imk    = ik + imax;
            double colmax = Math.Abs(ap[imk - 1]);

            int  kstep;
            bool swap;
            int  j;
            int  imj;
            if (alpha * colmax <= absakk)
            {
                kstep = 1;
                swap  = false;
            }
            //
            //  Determine the largest off-diagonal element in row IMAX.
            //
            else
            {
                double rowmax = 0.0;
                int    imaxp1 = imax + 1;
                im  = imax * (imax - 1) / 2;
                imj = im + 2 * imax;

                for (j = imaxp1; j <= k; j++)
                {
                    rowmax = Math.Max(rowmax, Math.Abs(ap[imj - 1]));
                    imj   += j;
                }

                if (imax != 1)
                {
                    int jmax = BLAS1D.idamax(imax - 1, ap, 1, index: +im);
                    int jmim = jmax + im;
                    rowmax = Math.Max(rowmax, Math.Abs(ap[jmim - 1]));
                }

                int imim = imax + im;

                if (alpha * rowmax <= Math.Abs(ap[imim - 1]))
                {
                    kstep = 1;
                    swap  = true;
                }
                else if (alpha * colmax * (colmax / rowmax) <= absakk)
                {
                    kstep = 1;
                    swap  = false;
                }
                else
                {
                    kstep = 2;
                    swap  = imax != km1;
                }
            }

            switch (Math.Max(absakk, colmax))
            {
            //
            //  Column K is zero.  Set INFO and iterate the loop.
            //
            case 0.0:
                kpvt[k - 1] = k;
                info        = k;
                break;

            default:
            {
                double mulk;
                int    jk;
                int    jj;
                double t;
                int    ij;
                if (kstep != 2)
                {
                    switch (swap)
                    {
                    //
                    //  1 x 1 pivot block.
                    //
                    case true:
                    {
                        //
                        //  Perform an interchange.
                        //
                        BLAS1D.dswap(imax, ref ap, 1, ref ap, 1, xIndex: +im, yIndex: +ik);
                        imj = ik + imax;

                        for (jj = imax; jj <= k; jj++)
                        {
                            j           = k + imax - jj;
                            jk          = ik + j;
                            t           = ap[jk - 1];
                            ap[jk - 1]  = ap[imj - 1];
                            ap[imj - 1] = t;
                            imj        -= j - 1;
                        }

                        break;
                    }
                    }

                    //
                    //  Perform the elimination.
                    //
                    ij = ik - (k - 1);

                    for (jj = 1; jj <= km1; jj++)
                    {
                        j    = k - jj;
                        jk   = ik + j;
                        mulk = -ap[jk - 1] / ap[kk - 1];
                        t    = mulk;
                        BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
                        ap[jk - 1] = mulk;
                        ij        -= j - 1;
                    }

                    kpvt[k - 1] = swap switch
                    {
                        //
                        //  Set the pivot array.
                        //
                        true => imax,
                        _ => k
                    };
                }
                else
                {
                    //
                    //  2 x 2 pivot block.
                    //
                    int km1k = ik + k - 1;
                    int ikm1 = ik - (k - 1);
                    int jkm1;
                    switch (swap)
                    {
                    //
                    //  Perform an interchange.
                    //
                    case true:
                    {
                        BLAS1D.dswap(imax, ref ap, 1, ref ap, 1, xIndex: +im, yIndex: +ikm1);
                        imj = ikm1 + imax;

                        for (jj = imax; jj <= km1; jj++)
                        {
                            j            = km1 + imax - jj;
                            jkm1         = ikm1 + j;
                            t            = ap[jkm1 - 1];
                            ap[jkm1 - 1] = ap[imj - 1];
                            ap[imj - 1]  = t;
                            imj         -= j - 1;
                        }

                        t            = ap[km1k - 1];
                        ap[km1k - 1] = ap[imk - 1];
                        ap[imk - 1]  = t;
                        break;
                    }
                    }

                    //
                    //  Perform the elimination.
                    //
                    if (k - 2 != 0)
                    {
                        double ak     = ap[kk - 1] / ap[km1k - 1];
                        int    km1km1 = ikm1 + k - 1;
                        double akm1   = ap[km1km1 - 1] / ap[km1k - 1];
                        double denom  = 1.0 - ak * akm1;
                        ij = ik - (k - 1) - (k - 2);

                        for (jj = 1; jj <= k - 2; jj++)
                        {
                            j  = km1 - jj;
                            jk = ik + j;
                            double bk = ap[jk - 1] / ap[km1k - 1];
                            jkm1 = ikm1 + j;
                            double bkm1 = ap[jkm1 - 1] / ap[km1k - 1];
                            mulk = (akm1 * bk - bkm1) / denom;
                            double mulkm1 = (ak * bkm1 - bk) / denom;
                            t = mulk;
                            BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
                            t = mulkm1;
                            BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ikm1, yIndex: +ij);
                            ap[jk - 1]   = mulk;
                            ap[jkm1 - 1] = mulkm1;
                            ij          -= j - 1;
                        }
                    }

                    kpvt[k - 1] = swap switch
                    {
                        //
                        //  Set the pivot array.
                        //
                        true => - imax,
                        _ => 1 - k
                    };

                    kpvt[k - 2] = kpvt[k - 1];
                }

                break;
            }
            }

            ik -= k - 1;
            switch (kstep)
            {
            case 2:
                ik -= k - 2;
                break;
            }

            k -= kstep;
        }

        return(info);
    }
}
Esempio n. 2
0
    public static void dspdi(ref double[] ap, int n, int[] kpvt, ref double[] det, ref int[] inert,
                             double[] work, int job)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DSPDI computes the determinant, inertia and inverse of a real symmetric matrix.
    //
    //  Discussion:
    //
    //    DSPDI uses the factors from DSPFA, where the matrix is stored in
    //    packed form.
    //
    //    A division by zero will occur if the inverse is requested
    //    and DSPCO has set RCOND == 0.0D+00 or DSPFA has set INFO /= 0.
    //
    //    Variables not requested by JOB are not used.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    25 May 2005
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double AP[(N*(N+1))/2].  On input, the output from
    //    DSPFA.  On output, the upper triangle of the inverse of the original
    //    matrix, stored in packed form, if requested.  The columns of the upper
    //    triangle are stored sequentially in a one-dimensional array.
    //
    //    Input, int N, the order of the matrix.
    //
    //    Input, int KPVT[N], the pivot vector from DSPFA.
    //
    //    Output, double DET[2], the determinant of the original matrix,
    //    if requested.
    //      determinant = DET[0] * 10.0**DET[1]
    //    with 1.0D+00 <= abs ( DET[0] ) < 10.0D+00 or DET[0] = 0.0.
    //
    //    Output, int INERT[3], the inertia of the original matrix, if requested.
    //    INERT(1) = number of positive eigenvalues.
    //    INERT(2) = number of negative eigenvalues.
    //    INERT(3) = number of zero eigenvalues.
    //
    //    Workspace, double WORK[N].
    //
    //    Input, int JOB, has the decimal expansion ABC where:
    //      if A /= 0, the inertia is computed,
    //      if B /= 0, the determinant is computed,
    //      if C /= 0, the inverse is computed.
    //    For example, JOB = 111  gives all three.
    //
    {
        double d;
        int    ik;
        int    ikp1;
        int    k;
        int    kk;
        int    kkp1;
        double t;

        bool doinv = job % 10 != 0;
        bool dodet = job % 100 / 10 != 0;
        bool doert = job % 1000 / 100 != 0;

        if (dodet || doert)
        {
            switch (doert)
            {
            case true:
                inert[0] = 0;
                inert[1] = 0;
                inert[2] = 0;
                break;
            }

            switch (dodet)
            {
            case true:
                det[0] = 1.0;
                det[1] = 0.0;
                break;
            }

            t  = 0.0;
            ik = 0;

            for (k = 1; k <= n; k++)
            {
                kk = ik + k;
                d  = ap[kk - 1];
                switch (kpvt[k - 1])
                {
                //
                //  2 by 2 block
                //  use det (d  s)  =  (d/t * c - t) * t,  t = abs ( s )
                //          (s  c)
                //  to avoid underflow/overflow troubles.
                //
                //  Take two passes through scaling.  Use T for flag.
                //
                case <= 0 when t == 0.0:
                    ikp1 = ik + k;
                    kkp1 = ikp1 + k;
                    t    = Math.Abs(ap[kkp1 - 1]);
                    d    = d / t * ap[kkp1] - t;
                    break;

                case <= 0:
                    d = t;
                    t = 0.0;
                    break;
                }

                switch (doert)
                {
                case true:
                    switch (d)
                    {
                    case > 0.0:
                        inert[0] += 1;
                        break;

                    case < 0.0:
                        inert[1] += 1;
                        break;

                    case 0.0:
                        inert[2] += 1;
                        break;
                    }

                    break;
                }

                switch (dodet)
                {
                case true:
                {
                    det[0] *= d;

                    if (det[0] != 0.0)
                    {
                        while (Math.Abs(det[0]) < 1.0)
                        {
                            det[0] *= 10.0;
                            det[1] -= 1.0;
                        }

                        while (10.0 <= Math.Abs(det[0]))
                        {
                            det[0] /= 10.0;
                            det[1] += 1.0;
                        }
                    }

                    break;
                }
                }

                ik += k;
            }
        }

        switch (doinv)
        {
        //
        //  Compute inverse(A).
        //
        case true:
        {
            k  = 1;
            ik = 0;

            while (k <= n)
            {
                int km1 = k - 1;
                kk   = ik + k;
                ikp1 = ik + k;
                kkp1 = ikp1 + k;

                int kstep;
                int jk;
                int j;
                int ij;
                switch (kpvt[k - 1])
                {
                case >= 0:
                {
                    //
                    //  1 by 1.
                    //
                    ap[kk - 1] = 1.0 / ap[kk - 1];

                    switch (k)
                    {
                    case >= 2:
                    {
                        BLAS1D.dcopy(k - 1, ap, 1, ref work, 1, xIndex: +ik);
                        ij = 0;

                        for (j = 1; j <= k - 1; j++)
                        {
                            jk         = ik + j;
                            ap[jk - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
                            BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
                            ij += j;
                        }

                        ap[kk - 1] += BLAS1D.ddot(k - 1, work, 1, ap, 1, yIndex: +ik);
                        break;
                    }
                    }

                    kstep = 1;
                    break;
                }

                default:
                {
                    //
                    //  2 by 2.
                    //
                    t = Math.Abs(ap[kkp1 - 1]);
                    double ak    = ap[kk - 1] / t;
                    double akp1  = ap[kkp1] / t;
                    double akkp1 = ap[kkp1 - 1] / t;
                    d            = t * (ak * akp1 - 1.0);
                    ap[kk - 1]   = akp1 / d;
                    ap[kkp1]     = ak / d;
                    ap[kkp1 - 1] = -akkp1 / d;

                    switch (km1)
                    {
                    case >= 1:
                    {
                        BLAS1D.dcopy(km1, ap, 1, ref work, 1, xIndex: +ikp1);
                        ij = 0;

                        for (j = 1; j <= km1; j++)
                        {
                            int jkp1 = ikp1 + j;
                            ap[jkp1 - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
                            BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ikp1);
                            ij += j;
                        }

                        ap[kkp1]     += BLAS1D.ddot(km1, work, 1, ap, 1, yIndex: +ikp1);
                        ap[kkp1 - 1] += BLAS1D.ddot(km1, ap, 1, ap, 1, xIndex: +ik, yIndex: +ikp1);
                        BLAS1D.dcopy(km1, ap, 1, ref work, 1, xIndex: +ik);
                        ij = 0;

                        for (j = 1; j <= km1; j++)
                        {
                            jk         = ik + j;
                            ap[jk - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
                            BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
                            ij += j;
                        }

                        ap[kk - 1] += BLAS1D.ddot(km1, work, 1, ap, 1, yIndex: +ik);
                        break;
                    }
                    }

                    kstep = 2;
                    break;
                }
                }

                //
                //  Swap.
                //
                int ks = Math.Abs(kpvt[k - 1]);

                if (ks != k)
                {
                    int iks = ks * (ks - 1) / 2;
                    BLAS1D.dswap(ks, ref ap, 1, ref ap, 1, xIndex: +iks, yIndex: +ik);
                    int ksj = ik + ks;

                    double temp;
                    int    jb;
                    for (jb = ks; jb <= k; jb++)
                    {
                        j           = k + ks - jb;
                        jk          = ik + j;
                        temp        = ap[jk - 1];
                        ap[jk - 1]  = ap[ksj - 1];
                        ap[ksj - 1] = temp;
                        ksj        -= j - 1;
                    }

                    if (kstep != 1)
                    {
                        int kskp1 = ikp1 + ks;
                        temp          = ap[kskp1 - 1];
                        ap[kskp1 - 1] = ap[kkp1 - 1];
                        ap[kkp1 - 1]  = temp;
                    }
                }

                ik += k;
                ik  = kstep switch
                {
                    2 => ik + k + 1,
                    _ => ik
                };

                k += kstep;
            }

            break;
        }
        }
    }
}
Esempio n. 3
0
    private static void dswap_test()

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DSWAP_TEST tests DSWAP.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    15 May 2006
    //
    //  Author:
    //
    //    John Burkardt
    //
    {
        int N = 6;

        double[] x = new double[N];
        double[] y = new double[N];

        for (int i = 0; i < N; i++)
        {
            x[i] = i + 1;
        }

        for (int i = 0; i < N; i++)
        {
            y[i] = 100 * (i + 1);
        }

        Console.WriteLine("");
        Console.WriteLine("DSWAP_TEST");
        Console.WriteLine("  DSWAP swaps two vectors.");
        Console.WriteLine("");
        Console.WriteLine("  X and Y:");
        Console.WriteLine("");
        for (int i = 0; i < N; i++)
        {
            Console.WriteLine("  "
                              + (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + "  "
                              + x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "  "
                              + y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
        }

        BLAS1D.dswap(N, ref x, 1, ref y, 1);
        Console.WriteLine("");
        Console.WriteLine("  DSWAP ( N, X, 1, Y, 1 )");
        Console.WriteLine("");
        Console.WriteLine("  X and Y:");
        Console.WriteLine("");
        for (int i = 0; i < N; i++)
        {
            Console.WriteLine("  "
                              + (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + "  "
                              + x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "  "
                              + y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
        }

        for (int i = 0; i < N; i++)
        {
            x[i] = i + 1;
        }

        for (int i = 0; i < N; i++)
        {
            y[i] = 100 * (i + 1);
        }

        BLAS1D.dswap(3, ref x, 2, ref y, 1);
        Console.WriteLine("");
        Console.WriteLine("  DSWAP ( 3, X, 2, Y, 1 )");

        Console.WriteLine("");
        Console.WriteLine("  X and Y:");
        Console.WriteLine("");
        for (int i = 0; i < N; i++)
        {
            Console.WriteLine("  "
                              + (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + "  "
                              + x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "  "
                              + y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
        }
    }
Esempio n. 4
0
    public static int dchdc(ref double[] a, int lda, int p, double[] work, ref int[] ipvt, int job)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DCHDC computes the Cholesky decomposition of a positive definite matrix.
    //
    //  Discussion:
    //
    //    A pivoting option allows the user to estimate the condition of a
    //    positive definite matrix or determine the rank of a positive
    //    semidefinite matrix.
    //
    //    For positive definite matrices, INFO = P is the normal return.
    //
    //    For pivoting with positive semidefinite matrices, INFO will
    //    in general be less than P.  However, INFO may be greater than
    //    the rank of A, since rounding error can cause an otherwise zero
    //    element to be positive.  Indefinite systems will always cause
    //    INFO to be less than P.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    23 June 2009
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double A[LDA*P].
    //    On input, A contains the matrix whose decomposition is to
    //    be computed.  Only the upper half of A need be stored.
    //    The lower part of the array a is not referenced.
    //    On output, A contains in its upper half the Cholesky factor
    //    of the input matrix, as it has been permuted by pivoting.
    //
    //    Input, int LDA, the leading dimension of the array A.
    //
    //    Input, int P, the order of the matrix.
    //
    //    Input, double WORK[P] is a work array.
    //
    //    Input/output, int IPVT[P].
    //    On input, IPVT contains integers that control the selection
    //    of the pivot elements, if pivoting has been requested.
    //    Each diagonal element A(K,K) is placed in one of three classes
    //    according to the value of IPVT(K).
    //
    //      > 0, then X(K) is an initial element.
    //      = 0, then X(K) is a free element.
    //      < 0, then X(K) is a final element.
    //
    //    Before the decomposition is computed, initial elements are moved by
    //    symmetric row and column interchanges to the beginning of the array A
    //    and final elements to the end.  Both initial and final elements are
    //    frozen in place during the computation and only free elements are moved.
    //    At the K-th stage of the reduction, if A(K,K) is occupied by a free
    //    element, it is interchanged with the largest free element A(L,L) with
    //    K <= L.  IPVT is not referenced if JOB is 0.
    //
    //    On output, IPVT(J) contains the index of the diagonal element
    //    of A that was moved into the J-th position, if pivoting was requested.
    //
    //    Input, int JOB, initiates column pivoting.
    //    0, no pivoting is done.
    //    nonzero, pivoting is done.
    //
    //    Output, int DCHDC, contains the index of the last positive diagonal
    //    element of the Cholesky factor.
    //
    {
        int    j;
        int    k;
        double temp;

        int pl   = 1;
        int pu   = 0;
        int info = p;

        //
        //  Pivoting has been requested.
        //  Rearrange the the elements according to IPVT.
        //
        if (job != 0)
        {
            for (k = 1; k <= p; k++)
            {
                bool swapk = 0 < ipvt[k - 1];
                bool negk  = ipvt[k - 1] < 0;

                ipvt[k - 1] = negk switch
                {
                    true => - k,
                    _ => k
                };

                switch (swapk)
                {
                case true:
                {
                    if (k != pl)
                    {
                        BLAS1D.dswap(pl - 1, ref a, 1, ref a, 1, xIndex:  +0 + (k - 1) * lda, yIndex:  +0 + (pl - 1) * lda);

                        temp = a[k - 1 + (k - 1) * lda];
                        a[k - 1 + (k - 1) * lda]   = a[pl - 1 + (pl - 1) * lda];
                        a[pl - 1 + (pl - 1) * lda] = temp;

                        for (j = pl + 1; j <= p; j++)
                        {
                            if (j < k)
                            {
                                temp = a[pl - 1 + (j - 1) * lda];
                                a[pl - 1 + (j - 1) * lda] = a[j - 1 + (k - 1) * lda];
                                a[j - 1 + (k - 1) * lda]  = temp;
                            }
                            else if (k < j)
                            {
                                temp = a[k - 1 + (j - 1) * lda];
                                a[k - 1 + (j - 1) * lda]  = a[pl - 1 + (j - 1) * lda];
                                a[pl - 1 + (j - 1) * lda] = temp;
                            }
                        }

                        ipvt[k - 1]  = ipvt[pl - 1];
                        ipvt[pl - 1] = k;
                    }

                    pl += 1;
                    break;
                }
                }
            }

            pu = p;

            for (k = p; pl <= k; k--)
            {
                switch (ipvt[k - 1])
                {
                case < 0:
                {
                    ipvt[k - 1] = -ipvt[k - 1];

                    if (pu != k)
                    {
                        BLAS1D.dswap(k - 1, ref a, 1, ref a, 1, xIndex:  +0 + (k - 1) * lda, yIndex: +0 + (pu - 1) * lda);

                        temp = a[k - 1 + (k - 1) * lda];
                        a[k - 1 + (k - 1) * lda]   = a[pu - 1 + (pu - 1) * lda];
                        a[pu - 1 + (pu - 1) * lda] = temp;

                        for (j = k + 1; j <= p; j++)
                        {
                            if (j < pu)
                            {
                                temp = a[k - 1 + (j - 1) * lda];
                                a[k - 1 + (j - 1) * lda]  = a[j - 1 + (pu - 1) * lda];
                                a[j - 1 + (pu - 1) * lda] = temp;
                            }
                            else if (pu < j)
                            {
                                temp = a[k - 1 + (j - 1) * lda];
                                a[k - 1 + (j - 1) * lda]  = a[pu - 1 + (j - 1) * lda];
                                a[pu - 1 + (j - 1) * lda] = temp;
                            }
                        }

                        (ipvt[k - 1], ipvt[pu - 1]) = (ipvt[pu - 1], ipvt[k - 1]);
                    }

                    pu -= 1;
                    break;
                }
                }
            }
        }

        for (k = 1; k <= p; k++)
        {
            //
            //  Reduction loop.
            //
            double maxdia = a[k - 1 + (k - 1) * lda];
            int    maxl   = k;
            //
            //  Determine the pivot element.
            //
            if (pl <= k && k < pu)
            {
                int l;
                for (l = k + 1; l <= pu; l++)
                {
                    if (!(maxdia < a[l - 1 + (l - 1) * lda]))
                    {
                        continue;
                    }

                    maxdia = a[l - 1 + (l - 1) * lda];
                    maxl   = l;
                }
            }

            switch (maxdia)
            {
            //
            //  Quit if the pivot element is not positive.
            //
            case <= 0.0:
                info = k - 1;
                return(info);
            }

            //
            //  Start the pivoting and update IPVT.
            //
            if (k != maxl)
            {
                BLAS1D.dswap(k - 1, ref a, 1, ref a, 1, xIndex:  +0 + (k - 1) * lda, yIndex:  +0 + (maxl - 1) * lda);
                a[maxl - 1 + (maxl - 1) * lda] = a[k - 1 + (k - 1) * lda];
                a[k - 1 + (k - 1) * lda]       = maxdia;
                (ipvt[maxl - 1], ipvt[k - 1])  = (ipvt[k - 1], ipvt[maxl - 1]);
            }

            //
            //  Reduction step.
            //  Pivoting is contained across the rows.
            //
            work[k - 1] = Math.Sqrt(a[k - 1 + (k - 1) * lda]);
            a[k - 1 + (k - 1) * lda] = work[k - 1];

            for (j = k + 1; j <= p; j++)
            {
                if (k != maxl)
                {
                    if (j < maxl)
                    {
                        temp = a[k - 1 + (j - 1) * lda];
                        a[k - 1 + (j - 1) * lda]    = a[j - 1 + (maxl - 1) * lda];
                        a[j - 1 + (maxl - 1) * lda] = temp;
                    }
                    else if (maxl < j)
                    {
                        temp = a[k - 1 + (j - 1) * lda];
                        a[k - 1 + (j - 1) * lda]    = a[maxl - 1 + (j - 1) * lda];
                        a[maxl - 1 + (j - 1) * lda] = temp;
                    }
                }

                a[k - 1 + (j - 1) * lda] /= work[k - 1];
                work[j - 1] = a[k - 1 + (j - 1) * lda];
                temp        = -a[k - 1 + (j - 1) * lda];
                BLAS1D.daxpy(j - k, temp, work, 1, ref a, 1, xIndex: +k, yIndex:  +k + (j - 1) * lda);
            }
        }

        return(info);
    }
}
Esempio n. 5
0
    public static void dgedi(ref double[] a, int lda, int n, int[] ipvt, ref double[] det,
                             double[] work, int job)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DGEDI computes the determinant and inverse of a matrix factored by DGECO or DGEFA.
    //
    //  Discussion:
    //
    //    A division by zero will occur if the input factor contains
    //    a zero on the diagonal and the inverse is requested.
    //    It will not occur if the subroutines are called correctly
    //    and if DGECO has set 0.0 < RCOND or DGEFA has set INFO == 0.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    17 May 2005
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double A[LDA*N], on input, the LU factor information,
    //    as output by DGECO or DGEFA.  On output, the inverse
    //    matrix if requested.
    //
    //    Input, int LDA, the leading dimension of the array A.
    //
    //    Input, int N, the order of the matrix A.
    //
    //    Input, int IPVT[N], the pivot vector from DGECO or DGEFA.
    //
    //    Workspace, double WORK[N].
    //
    //    Output, double DET[2], the determinant of original matrix if
    //    requested.  The determinant = DET[0] * pow ( 10.0, DET[1] )
    //    with  1.0 <= abs ( DET[0] ) < 10.0 or DET[0] == 0.0.
    //
    //    Input, int JOB, specifies what is to be computed.
    //    11, both determinant and inverse.
    //    01, inverse only.
    //    10, determinant only.
    //
    {
        int i;

        //
        //  Compute the determinant.
        //
        if (job / 10 != 0)
        {
            det[0] = 1.0;
            det[1] = 0.0;

            for (i = 1; i <= n; i++)
            {
                if (ipvt[i - 1] != i)
                {
                    det[0] = -det[0];
                }

                det[0] *= a[i - 1 + (i - 1) * lda];

                if (det[0] == 0.0)
                {
                    break;
                }

                while (Math.Abs(det[0]) < 1.0)
                {
                    det[0] *= 10.0;
                    det[1] -= 1.0;
                }

                while (10.0 <= Math.Abs(det[0]))
                {
                    det[0] /= 10.0;
                    det[1] += 1.0;
                }
            }
        }

        //
        //  Compute inverse(U).
        //
        if (job % 10 == 0)
        {
            return;
        }

        int    j;
        double t;
        int    k;

        for (k = 1; k <= n; k++)
        {
            a[k - 1 + (k - 1) * lda] = 1.0 / a[k - 1 + (k - 1) * lda];
            t = -a[k - 1 + (k - 1) * lda];
            BLAS1D.dscal(k - 1, t, ref a, 1, index:  +0 + (k - 1) * lda);

            for (j = k + 1; j <= n; j++)
            {
                t = a[k - 1 + (j - 1) * lda];
                a[k - 1 + (j - 1) * lda] = 0.0;
                BLAS1D.daxpy(k, t, a, 1, ref a, 1, xIndex:  +0 + (k - 1) * lda, yIndex:  +0 + (j - 1) * lda);
            }
        }

        //
        //  Form inverse(U) * inverse(L).
        //
        for (k = n - 1; 1 <= k; k--)
        {
            for (i = k + 1; i <= n; i++)
            {
                work[i - 1] = a[i - 1 + (k - 1) * lda];
                a[i - 1 + (k - 1) * lda] = 0.0;
            }

            for (j = k + 1; j <= n; j++)
            {
                t = work[j - 1];
                BLAS1D.daxpy(n, t, a, 1, ref a, 1, xIndex:  +0 + (j - 1) * lda, yIndex:  +0 + (k - 1) * lda);
            }

            int l = ipvt[k - 1];
            if (l != k)
            {
                BLAS1D.dswap(n, ref a, 1, ref a, 1, xIndex:  +0 + (k - 1) * lda, yIndex:  +0 + (l - 1) * lda);
            }
        }
    }
Esempio n. 6
0
    public static void dsidi(ref double[] a, int lda, int n, int[] kpvt, ref double[] det,
                             ref int[] inert, double[] work, int job)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DSIDI computes the determinant, inertia and inverse of a real symmetric matrix.
    //
    //  Discussion:
    //
    //    DSIDI uses the factors from DSIFA.
    //
    //    A division by zero may occur if the inverse is requested
    //    and DSICO has set RCOND == 0.0D+00 or DSIFA has set INFO /= 0.
    //
    //    Variables not requested by JOB are not used.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    25 May 2005
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double A(LDA,N).  On input, the output from DSIFA.
    //    On output, the upper triangle of the inverse of the original matrix,
    //    if requested.  The strict lower triangle is never referenced.
    //
    //    Input, int LDA, the leading dimension of the array A.
    //
    //    Input, int N, the order of the matrix.
    //
    //    Input, int KPVT[N], the pivot vector from DSIFA.
    //
    //    Output, double DET[2], the determinant of the original matrix,
    //    if requested.
    //      determinant = DET[0] * 10.0**DET[1]
    //    with 1.0D+00 <= abs ( DET[0] ) < 10.0D+00 or DET[0] = 0.0.
    //
    //    Output, int INERT(3), the inertia of the original matrix,
    //    if requested.
    //    INERT(1) = number of positive eigenvalues.
    //    INERT(2) = number of negative eigenvalues.
    //    INERT(3) = number of zero eigenvalues.
    //
    //    Workspace, double WORK[N].
    //
    //    Input, int JOB, specifies the tasks.
    //    JOB has the decimal expansion ABC where
    //    If C /= 0, the inverse is computed,
    //    If B /= 0, the determinant is computed,
    //    If A /= 0, the inertia is computed.
    //    For example, JOB = 111 gives all three.
    //
    {
        double d;
        int    k;
        double t;

        bool doinv = job % 10 != 0;
        bool dodet = job % 100 / 10 != 0;
        bool doert = job % 1000 / 100 != 0;

        if (dodet || doert)
        {
            switch (doert)
            {
            case true:
                inert[0] = 0;
                inert[1] = 0;
                inert[2] = 0;
                break;
            }

            switch (dodet)
            {
            case true:
                det[0] = 1.0;
                det[1] = 0.0;
                break;
            }

            t = 0.0;

            for (k = 1; k <= n; k++)
            {
                d = a[k - 1 + (k - 1) * lda];
                switch (kpvt[k - 1])
                {
                //
                //  2 by 2 block.
                //
                //  use det (d  s)  =  (d/t * c - t) * t,  t = abs ( s )
                //          (s  c)
                //  to avoid underflow/overflow troubles.
                //
                //  Take two passes through scaling.  Use T for flag.
                //
                case <= 0 when t == 0.0:
                    t = Math.Abs(a[k - 1 + k * lda]);
                    d = d / t * a[k + k * lda] - t;
                    break;

                case <= 0:
                    d = t;
                    t = 0.0;
                    break;
                }

                switch (doert)
                {
                case true:
                    switch (d)
                    {
                    case > 0.0:
                        inert[0] += 1;
                        break;

                    case < 0.0:
                        inert[1] += 1;
                        break;

                    case 0.0:
                        inert[2] += 1;
                        break;
                    }

                    break;
                }

                switch (dodet)
                {
                case true:
                {
                    det[0] *= d;

                    if (det[0] != 0.0)
                    {
                        while (Math.Abs(det[0]) < 1.0)
                        {
                            det[0] *= 10.0;
                            det[1] -= 1.0;
                        }

                        while (10.0 <= Math.Abs(det[0]))
                        {
                            det[0] /= 10.0;
                            det[1] += 1.0;
                        }
                    }

                    break;
                }
                }
            }
        }

        switch (doinv)
        {
        //
        //  Compute inverse(A).
        //
        case true:
        {
            k = 1;

            while (k <= n)
            {
                int j;
                int kstep;
                switch (kpvt[k - 1])
                {
                case >= 0:
                {
                    //
                    //  1 by 1.
                    //
                    a[k - 1 + (k - 1) * lda] = 1.0 / a[k - 1 + (k - 1) * lda];

                    switch (k)
                    {
                    case >= 2:
                    {
                        BLAS1D.dcopy(k - 1, a, 1, ref work, 1, xIndex: +0 + (k - 1) * lda);

                        for (j = 1; j <= k - 1; j++)
                        {
                            a[j - 1 + (k - 1) * lda] = BLAS1D.ddot(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
                            BLAS1D.daxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
                                         yIndex: +0 + (k - 1) * lda);
                        }

                        a[k - 1 + (k - 1) * lda] += BLAS1D.ddot(k - 1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
                        break;
                    }
                    }

                    kstep = 1;
                    break;
                }

                //
                default:
                {
                    t = Math.Abs(a[k - 1 + k * lda]);
                    double ak    = a[k - 1 + (k - 1) * lda] / t;
                    double akp1  = a[k + k * lda] / t;
                    double akkp1 = a[k - 1 + k * lda] / t;
                    d = t * (ak * akp1 - 1.0);
                    a[k - 1 + (k - 1) * lda] = akp1 / d;
                    a[k + k * lda]           = ak / d;
                    a[k - 1 + k * lda]       = -akkp1 / d;

                    switch (k)
                    {
                    case >= 2:
                    {
                        BLAS1D.dcopy(k - 1, a, 1, ref work, 1, xIndex: +0 + k * lda);

                        for (j = 1; j <= k - 1; j++)
                        {
                            a[j - 1 + k * lda] = BLAS1D.ddot(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
                            BLAS1D.daxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
                                         yIndex: +0 + k * lda);
                        }

                        a[k + k * lda]     += BLAS1D.ddot(k - 1, work, 1, a, 1, yIndex: +0 + k * lda);
                        a[k - 1 + k * lda] += BLAS1D.ddot(k - 1, a, 1, a, 1, xIndex: +0 + (k - 1) * lda,
                                                          yIndex: +0 + k * lda);
                        BLAS1D.dcopy(k - 1, a, 1, ref work, 1, xIndex: +0 + (k - 1) * lda);

                        for (j = 1; j <= k - 1; j++)
                        {
                            a[j - 1 + (k - 1) * lda] = BLAS1D.ddot(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
                            BLAS1D.daxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
                                         yIndex: +0 + (k - 1) * lda);
                        }

                        a[k - 1 + (k - 1) * lda] += BLAS1D.ddot(k - 1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
                        break;
                    }
                    }

                    kstep = 2;
                    break;
                }
                }

                //
                //  Swap.
                //
                int ks = Math.Abs(kpvt[k - 1]);

                if (ks != k)
                {
                    BLAS1D.dswap(ks, ref a, 1, ref a, 1, xIndex: +0 + (ks - 1) * lda, yIndex: +0 + (k - 1) * lda);

                    int    jb;
                    double temp;
                    for (jb = ks; jb <= k; jb++)
                    {
                        j    = k + ks - jb;
                        temp = a[j - 1 + (k - 1) * lda];
                        a[j - 1 + (k - 1) * lda]  = a[ks - 1 + (j - 1) * lda];
                        a[ks - 1 + (j - 1) * lda] = temp;
                    }

                    if (kstep != 1)
                    {
                        temp = a[ks - 1 + k * lda];
                        a[ks - 1 + k * lda] = a[k - 1 + k * lda];
                        a[k - 1 + k * lda]  = temp;
                    }
                }

                k += kstep;
            }

            break;
        }
        }
    }
Esempio n. 7
0
    public static int dsifa(ref double[] a, int lda, int n, ref int[] kpvt)

    //****************************************************************************80
    //
    //  Purpose:
    //
    //    DSIFA factors a real symmetric matrix.
    //
    //  Discussion:
    //
    //    To solve A*X = B, follow DSIFA by DSISL.
    //
    //    To compute inverse(A)*C, follow DSIFA by DSISL.
    //
    //    To compute determinant(A), follow DSIFA by DSIDI.
    //
    //    To compute inertia(A), follow DSIFA by DSIDI.
    //
    //    To compute inverse(A), follow DSIFA by DSIDI.
    //
    //  Licensing:
    //
    //    This code is distributed under the GNU LGPL license.
    //
    //  Modified:
    //
    //    25 May 2005
    //
    //  Author:
    //
    //    Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
    //    Pete Stewart.
    //    C++ version by John Burkardt.
    //
    //  Reference:
    //
    //    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
    //    LINPACK User's Guide,
    //    SIAM, (Society for Industrial and Applied Mathematics),
    //    3600 University City Science Center,
    //    Philadelphia, PA, 19104-2688.
    //    ISBN 0-89871-172-X
    //
    //  Parameters:
    //
    //    Input/output, double A[LDA*N].  On input, the symmetric matrix
    //    to be factored.  Only the diagonal and upper triangle are used.
    //    On output, a block diagonal matrix and the multipliers which
    //    were used to obtain it.  The factorization can be written A = U*D*U'
    //    where U is a product of permutation and unit upper triangular
    //    matrices, U' is the transpose of U, and D is block diagonal
    //    with 1 by 1 and 2 by 2 blocks.
    //
    //    Input, int LDA, the leading dimension of the array A.
    //
    //    Input, int N, the order of the matrix.
    //
    //    Output, int KPVT[N], the pivot indices.
    //
    //    Output, integer DSIFA, error flag.
    //    0, normal value.
    //    K, if the K-th pivot block is singular.  This is not an error
    //    condition for this subroutine, but it does indicate that DSISL
    //    or DSIDI may divide by zero if called.
    //
    {
        //
        //  ALPHA is used in choosing pivot block size.
        //
        double alpha = (1.0 + Math.Sqrt(17.0)) / 8.0;

        int info = 0;
        //
        //  Main loop on K, which goes from N to 1.
        //
        int k = n;

        while (0 < k)
        {
            switch (k)
            {
            case 1:
            {
                kpvt[0] = 1;
                info    = a[0 + 0 * lda] switch
                {
                    0.0 => 1,
                    _ => info
                };

                return(info);
            }
            }

            //
            //  This section of code determines the kind of
            //  elimination to be performed.  When it is completed,
            //  KSTEP will be set to the size of the pivot block, and
            //  SWAP will be set to .true. if an interchange is required.
            //
            double absakk = Math.Abs(a[k - 1 + (k - 1) * lda]);
            //
            //  Determine the largest off-diagonal element in column K.
            //
            int    imax   = BLAS1D.idamax(k - 1, a, 1, index: +0 + (k - 1) * lda);
            double colmax = Math.Abs(a[imax - 1 + (k - 1) * lda]);

            int  j;
            int  kstep;
            bool swap;
            if (alpha * colmax <= absakk)
            {
                kstep = 1;
                swap  = false;
            }
            //
            //  Determine the largest off-diagonal element in row IMAX.
            //
            else
            {
                double rowmax = 0.0;
                int    imaxp1 = imax + 1;
                for (j = imaxp1; j <= k; j++)
                {
                    rowmax = Math.Max(rowmax, Math.Abs(a[imax - 1 + (j - 1) * lda]));
                }

                if (imax != 1)
                {
                    int jmax = BLAS1D.idamax(imax - 1, a, 1, index: +0 + (imax - 1) * lda);
                    rowmax = Math.Max(rowmax, Math.Abs(a[jmax - 1 + (imax - 1) * lda]));
                }

                if (alpha * rowmax <= Math.Abs(a[imax - 1 + (imax - 1) * lda]))
                {
                    kstep = 1;
                    swap  = true;
                }
                else if (alpha * colmax * (colmax / rowmax) <= absakk)
                {
                    kstep = 1;
                    swap  = false;
                }
                else
                {
                    kstep = 2;
                    swap  = imax != k - 1;
                }
            }

            switch (Math.Max(absakk, colmax))
            {
            //
            //  Column K is zero.
            //  Set INFO and iterate the loop.
            //
            case 0.0:
                kpvt[k - 1] = k;
                info        = k;
                break;

            //
            default:
            {
                int    jj;
                double mulk;
                double t;
                if (kstep != 2)
                {
                    switch (swap)
                    {
                    case true:
                    {
                        BLAS1D.dswap(imax, ref a, 1, ref a, 1, xIndex: +0 + (imax - 1) * lda,
                                     yIndex: +0 + (k - 1) * lda);

                        for (jj = imax; jj <= k; jj++)
                        {
                            j = k + imax - jj;
                            t = a[j - 1 + (k - 1) * lda];
                            a[j - 1 + (k - 1) * lda]    = a[imax - 1 + (j - 1) * lda];
                            a[imax - 1 + (j - 1) * lda] = t;
                        }

                        break;
                    }
                    }

                    //
                    //  Perform the elimination.
                    //
                    for (jj = 1; jj <= k - 1; jj++)
                    {
                        j    = k - jj;
                        mulk = -a[j - 1 + (k - 1) * lda] / a[k - 1 + (k - 1) * lda];
                        t    = mulk;
                        BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
                        a[j - 1 + (k - 1) * lda] = mulk;
                    }

                    kpvt[k - 1] = swap switch
                    {
                        //
                        //  Set the pivot array.
                        //
                        true => imax,
                        _ => k
                    };
                }
                //
                //  2 x 2 pivot block.
                //
                //  Perform an interchange.
                //
                else
                {
                    switch (swap)
                    {
                    case true:
                    {
                        BLAS1D.dswap(imax, ref a, 1, ref a, 1, xIndex: +0 + (imax - 1) * lda,
                                     yIndex: +0 + (k - 2) * lda);

                        for (jj = imax; jj <= k - 1; jj++)
                        {
                            j = k - 1 + imax - jj;
                            t = a[j - 1 + (k - 1) * lda];
                            a[j - 1 + (k - 1) * lda]    = a[imax - 1 + (j - 1) * lda];
                            a[imax - 1 + (j - 1) * lda] = t;
                        }

                        t = a[k - 2 + (k - 1) * lda];
                        a[k - 2 + (k - 1) * lda]    = a[imax - 1 + (k - 1) * lda];
                        a[imax - 1 + (k - 1) * lda] = t;
                        break;
                    }
                    }

                    //
                    //  Perform the elimination.
                    //
                    if (k - 2 != 0)
                    {
                        double ak    = a[k - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
                        double akm1  = a[k - 2 + (k - 2) * lda] / a[k - 2 + (k - 1) * lda];
                        double denom = 1.0 - ak * akm1;

                        for (jj = 1; jj <= k - 2; jj++)
                        {
                            j = k - 1 - jj;
                            double bk   = a[j - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
                            double bkm1 = a[j - 1 + (k - 2) * lda] / a[k - 2 + (k - 1) * lda];
                            mulk = (akm1 * bk - bkm1) / denom;
                            double mulkm1 = (ak * bkm1 - bk) / denom;
                            t = mulk;
                            BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
                            t = mulkm1;
                            BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 2) * lda, yIndex: +0 + (j - 1) * lda);
                            a[j - 1 + (k - 1) * lda] = mulk;
                            a[j - 1 + (k - 2) * lda] = mulkm1;
                        }
                    }

                    kpvt[k - 1] = swap switch
                    {
                        //
                        //  Set the pivot array.
                        //
                        true => - imax,
                        _ => 1 - k
                    };

                    kpvt[k - 2] = kpvt[k - 1];
                }

                break;
            }
            }

            k -= kstep;
        }

        return(info);
    }
}