public static int dgbfa(ref double[] abd, int lda, int n, int ml, int mu, ref int[] ipvt) //****************************************************************************80 // // Purpose: // // DGBFA factors a real band matrix by elimination. // // Discussion: // // DGBFA is usually called by DGBCO, but it can be called // directly with a saving in time if RCOND is not needed. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 23 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 ABD[LDA*N]. On input, the matrix in band // storage. The columns of the matrix are stored in the columns of ABD // and the diagonals of the matrix are stored in rows ML+1 through // 2*ML+MU+1 of ABD. On output, an upper triangular matrix in band storage // and the multipliers which were used to obtain it. The factorization // can be written A = L*U where L is a product of permutation and unit lower // triangular matrices and U is upper triangular. // // Input, int LDA, the leading dimension of the array ABD. // 2*ML + MU + 1 <= LDA is required. // // Input, int N, the order of the matrix. // // Input, int ML, MU, the number of diagonals below and above the // main diagonal. 0 <= ML < N, 0 <= MU < N. // // Output, int IPVT[N], the pivot indices. // // Output, integer DGBFA, error flag. // 0, normal value. // K, if U(K,K) == 0.0D+00. This is not an error condition for this // subroutine, but it does indicate that DGBSL will divide by zero if // called. Use RCOND in DGBCO for a reliable indication of singularity. // { int i; int jz; int k; int m = ml + mu + 1; int info = 0; // // Zero initial fill-in columns. // int j0 = mu + 2; int j1 = Math.Min(n, m) - 1; for (jz = j0; jz <= j1; jz++) { int i0 = m + 1 - jz; for (i = i0; i <= ml; i++) { abd[i - 1 + (jz - 1) * lda] = 0.0; } } jz = j1; int ju = 0; // // Gaussian elimination with partial pivoting. // for (k = 1; k <= n - 1; k++) { // // Zero out the next fill-in column. // jz += 1; if (jz <= n) { for (i = 1; i <= ml; i++) { abd[i - 1 + (jz - 1) * lda] = 0.0; } } // // Find L = pivot index. // int lm = Math.Min(ml, n - k); int l = BLAS1D.idamax(lm + 1, abd, 1, +m - 1 + (k - 1) * lda) + m - 1; ipvt[k - 1] = l + k - m; switch (abd[l - 1 + (k - 1) * lda]) { // // Zero pivot implies this column already triangularized. // case 0.0: info = k; break; // default: { double t; if (l != m) { t = abd[l - 1 + (k - 1) * lda]; abd[l - 1 + (k - 1) * lda] = abd[m - 1 + (k - 1) * lda]; abd[m - 1 + (k - 1) * lda] = t; } // // Compute multipliers. // t = -1.0 / abd[m - 1 + (k - 1) * lda]; BLAS1D.dscal(lm, t, ref abd, 1, +m + (k - 1) * lda); // // Row elimination with column indexing. // ju = Math.Min(Math.Max(ju, mu + ipvt[k - 1]), n); int mm = m; int j; for (j = k + 1; j <= ju; j++) { l -= 1; mm -= 1; t = abd[l - 1 + (j - 1) * lda]; if (l != mm) { abd[l - 1 + (j - 1) * lda] = abd[mm - 1 + (j - 1) * lda]; abd[mm - 1 + (j - 1) * lda] = t; } BLAS1D.daxpy(lm, t, abd, 1, ref abd, 1, +m + (k - 1) * lda, +mm + (j - 1) * lda); } break; } } } ipvt[n - 1] = n; info = abd[m - 1 + (n - 1) * lda] switch { 0.0 => n, _ => info }; return(info); } }
public static int dgefa(ref double[] a, int lda, int n, ref int[] ipvt) //****************************************************************************80 // // Purpose: // // DGEFA factors a real general matrix. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 16 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 intput, the matrix to be factored. // On output, an upper triangular matrix and the multipliers used to obtain // it. The factorization can be written A=L*U, where L is a product of // permutation and unit lower triangular matrices, and U is upper triangular. // // Input, int LDA, the leading dimension of A. // // Input, int N, the order of the matrix A. // // Output, int IPVT[N], the pivot indices. // // Output, int DGEFA, singularity indicator. // 0, normal value. // K, if U(K,K) == 0. This is not an error condition for this subroutine, // but it does indicate that DGESL or DGEDI will divide by zero if called. // Use RCOND in DGECO for a reliable indication of singularity. // { int k; // // Gaussian elimination with partial pivoting. // int info = 0; for (k = 1; k <= n - 1; k++) { // // Find L = pivot index. // int l = BLAS1D.idamax(n - k + 1, a, 1, index: +(k - 1) + (k - 1) * lda) + k - 1; ipvt[k - 1] = l; switch (a[l - 1 + (k - 1) * lda]) { // // Zero pivot implies this column already triangularized. // case 0.0: info = k; continue; } // // Interchange if necessary. // double t; if (l != k) { t = a[l - 1 + (k - 1) * lda]; a[l - 1 + (k - 1) * lda] = a[k - 1 + (k - 1) * lda]; a[k - 1 + (k - 1) * lda] = t; } // // Compute multipliers. // t = -1.0 / a[k - 1 + (k - 1) * lda]; BLAS1D.dscal(n - k, t, ref a, 1, index: +k + (k - 1) * lda); // // Row elimination with column indexing. // int j; for (j = k + 1; j <= n; j++) { t = a[l - 1 + (j - 1) * lda]; if (l != k) { a[l - 1 + (j - 1) * lda] = a[k - 1 + (j - 1) * lda]; a[k - 1 + (j - 1) * lda] = t; } BLAS1D.daxpy(n - k, t, a, 1, ref a, 1, xIndex: +k + (k - 1) * lda, yIndex: +k + (j - 1) * lda); } } ipvt[n - 1] = n; info = a[n - 1 + (n - 1) * lda] switch { 0.0 => n, _ => info }; return(info); } }
public static void dppdi(ref double[] ap, int n, ref double[] det, int job) //****************************************************************************80 // // Purpose: // // DPPDI computes the determinant and inverse of a matrix factored by DPPCO or DPPFA. // // 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 DPOCO or DPOFA has set INFO == 0. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 24 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 // DPPCO or DPPFA. On output, the upper triangular half of the // inverse, if requested. // // Input, int N, the order of the matrix. // // Output, double DET[2], the determinant of the original matrix // if requested. // determinant = DET[0] * 10.0**DET[1] // with 1.0D+00 <= DET[0] < 10.0D+00 or DET[0] == 0.0D+00. // // Input, int JOB, job request. // 11, both determinant and inverse. // 01, inverse only. // 10, determinant only. // { // // Compute the determinant. // if (job / 10 != 0) { det[0] = 1.0; det[1] = 0.0; const double s = 10.0; int ii = 0; int i; for (i = 1; i <= n; i++) { ii += i; det[0] = det[0] * ap[ii - 1] * ap[ii - 1]; if (det[0] == 0.0) { break; } while (det[0] < 1.0) { det[0] *= s; det[1] -= 1.0; } while (s <= det[0]) { det[0] /= s; det[1] += 1.0; } } } // // Compute inverse(R). // if (job % 10 == 0) { return; } int kk = 0; int k; int k1; int kj; int j1; double t; int j; for (k = 1; k <= n; k++) { k1 = kk + 1; kk += k; ap[kk - 1] = 1.0 / ap[kk - 1]; t = -ap[kk - 1]; BLAS1D.dscal(k - 1, t, ref ap, 1, index: +k1 - 1); j1 = kk + 1; kj = kk + k; for (j = k + 1; j <= n; j++) { t = ap[kj - 1]; ap[kj - 1] = 0.0; BLAS1D.daxpy(k, t, ap, 1, ref ap, 1, xIndex: +k1 - 1, yIndex: +j1 - 1); j1 += j; kj += j; } } // // Form inverse(R) * (inverse(R))'. // int jj = 0; for (j = 1; j <= n; j++) { j1 = jj + 1; jj += j; k1 = 1; kj = j1; for (k = 1; k <= j - 1; k++) { t = ap[kj - 1]; BLAS1D.daxpy(k, t, ap, 1, ref ap, 1, xIndex: +j1 - 1, yIndex: +k1 - 1); k1 += k; kj += 1; } t = ap[jj - 1]; BLAS1D.dscal(j, t, ref ap, 1, index: +j1 - 1); } }
public static int dtrdi(ref double[] t, int ldt, int n, ref double[] det, int job) //****************************************************************************80 // // Purpose: // // DTRDI computes the determinant and inverse of a real triangular matrix. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 23 March 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 T[LDT*N]. // On input, T contains the triangular matrix. The zero elements of the // matrix are not referenced, and the corresponding elements of the array // can be used to store other information. // On output, T contains the inverse matrix, if it was requested. // // Input, int LDT, the leading dimension of T. // // Input, int N, the order of the matrix. // // Output, double DET[2], the determinant of the matrix, if // requested. The determinant = DET[0] * 10.0**DET[1], with // 1.0 <= abs ( DET[0] ) < 10.0, or DET[0] == 0. // // Input, int JOB, specifies the shape of T, and the task. // 010, inverse of lower triangular matrix. // 011, inverse of upper triangular matrix. // 100, determinant only. // 110, determinant and inverse of lower triangular. // 111, determinant and inverse of upper triangular. // // Output, int DTRDI. // If the inverse was requested, then // 0, if the system was nonsingular; // nonzero, if the system was singular. // { int j; int k; double temp; // // Determinant. // int info = 0; if (job / 100 != 0) { det[0] = 1.0; det[1] = 0.0; int i; for (i = 1; i <= n; i++) { det[0] *= t[i - 1 + (i - 1) * ldt]; 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; } } } switch (job / 10 % 10) { case 0: return(info); } // // Inverse of an upper triangular matrix. // if (job % 10 != 0) { info = 0; for (k = 1; k <= n; k++) { if (t[k - 1 + (k - 1) * ldt] == 0.0) { info = k; break; } t[k - 1 + (k - 1) * ldt] = 1.0 / t[k - 1 + (k - 1) * ldt]; temp = -t[k - 1 + (k - 1) * ldt]; BLAS1D.dscal(k - 1, temp, ref t, 1, index: +0 + (k - 1) * ldt); for (j = k + 1; j <= n; j++) { temp = t[k - 1 + (j - 1) * ldt]; t[k - 1 + (j - 1) * ldt] = 0.0; BLAS1D.daxpy(k, temp, t, 1, ref t, 1, xIndex: +0 + (k - 1) * ldt, yIndex: +0 + (j - 1) * ldt); } } } // // Inverse of a lower triangular matrix. // else { info = 0; for (k = n; 1 <= k; k--) { if (t[k - 1 + (k - 1) * ldt] == 0.0) { info = k; break; } t[k - 1 + (k - 1) * ldt] = 1.0 / t[k - 1 + (k - 1) * ldt]; temp = -t[k - 1 + (k - 1) * ldt]; if (k != n) { BLAS1D.dscal(n - k, temp, ref t, 1, index: +k + (k - 1) * ldt); } for (j = 1; j <= k - 1; j++) { temp = t[k - 1 + (j - 1) * ldt]; t[k - 1 + (j - 1) * ldt] = 0.0; BLAS1D.daxpy(n - k + 1, temp, t, 1, ref t, 1, xIndex: +k - 1 + (k - 1) * ldt, yIndex: +k - 1 + (j - 1) * ldt); } } } return(info); }
private static void dscal_test() //****************************************************************************80 // // Purpose: // // DSCAL_TEST tests DSCAL. // // 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]; for (int i = 0; i < N; i++) { x[i] = i + 1; } Console.WriteLine(""); Console.WriteLine("DSCAL_TEST"); Console.WriteLine(" DSCAL multiplies a vector by a scalar."); Console.WriteLine(""); Console.WriteLine(" X ="); 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) + ""); } double da = 5.0; BLAS1D.dscal(N, da, ref x, 1); Console.WriteLine(""); Console.WriteLine(" DSCAL ( N, " + da + ", X, 1 )"); 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) + ""); } for (int i = 0; i < N; i++) { x[i] = i + 1; } da = -2.0; BLAS1D.dscal(3, da, ref x, 2); Console.WriteLine(""); Console.WriteLine(" DSCAL ( 3, " + da + ", X, 2 )"); 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) + ""); } }
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); } } }
public static void dpodi(ref double[] a, int lda, int n, ref double[] det, int job) //****************************************************************************80 // // Purpose: // // DPODI computes the determinant and inverse of a certain matrix. // // Discussion: // // The matrix is real symmetric positive definite. // DPODI uses the factors computed by DPOCO, DPOFA or DQRDC. // // 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 DPOCO or DPOFA has set INFO == 0. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 23 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 A from // DPOCO or DPOFA, or the output X from DQRDC. On output, if DPOCO or // DPOFA was used to factor A then DPODI produces the upper half of // inverse(A). If DQRDC was used to decompose X then DPODI produces // the upper half of inverse(X'*X) where X' is the transpose. // Elements of A below the diagonal are unchanged. If the units digit // of JOB is zero, A is unchanged. // // Input, int LDA, the leading dimension of the array A. // // Input, int N, the order of the matrix A. // // Input, int JOB, specifies the task. // 11, both determinant and inverse. // 01, inverse only. // 10, determinant only. // // Output, double DET[2], the determinant of A or of X'*X // if requested. // determinant = DET[0] * 10.0**DET[1] // with 1.0D+00 <= DET[0] < 10.0D+00 or DET[0] == 0.0D+00. // { // // Compute the determinant. // if (job / 10 != 0) { det[0] = 1.0; det[1] = 0.0; const double s = 10.0; int i; for (i = 1; i <= n; i++) { det[0] = det[0] * a[i - 1 + (i - 1) * lda] * a[i - 1 + (i - 1) * lda]; if (det[0] == 0.0) { break; } while (det[0] < 1.0) { det[0] *= s; det[1] -= 1.0; } while (s <= det[0]) { det[0] /= s; det[1] += 1.0; } } } // // Compute inverse(R). // if (job % 10 == 0) { return; } double t; int k; int j; 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(R) * (inverse(R))'. // for (j = 1; j <= n; j++) { for (k = 1; k <= j - 1; k++) { t = a[k - 1 + (j - 1) * lda]; BLAS1D.daxpy(k, t, a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda, yIndex: +0 + (k - 1) * lda); } t = a[j - 1 + (j - 1) * lda]; BLAS1D.dscal(j, t, ref a, 1, index: +0 + (j - 1) * lda); } }