public static double dgeco(ref double[] a, int lda, int n, ref int[] ipvt, ref double[] z) //****************************************************************************80 // // Purpose: // // DGECO factors a real matrix and estimates its condition number. // // Discussion: // // If RCOND is not needed, DGEFA is slightly faster. // // To solve A * X = B, follow DGECO by DGESL. // // To compute inverse ( A ) * C, follow DGECO by DGESL. // // To compute determinant ( A ), follow DGECO by DGEDI. // // To compute inverse ( A ), follow DGECO by DGEDI. // // For the system A * X = B, relative perturbations in A and B // of size EPSILON may cause relative perturbations in X of size // EPSILON/RCOND. // // If RCOND is so small that the logical expression // 1.0D+00 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate // underflows. // // 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, a matrix to be // factored. On output, the LU factorization of the matrix. // // Input, int LDA, the leading dimension of the array A. // // Input, int N, the order of the matrix A. // // Output, int IPVT[N], the pivot indices. // // Output, double Z[N], a work vector whose contents are usually // unimportant. If A is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm ( A * Z ) = RCOND * norm ( A ) * norm ( Z ). // // Output, double DGECO, the value of RCOND, an estimate // of the reciprocal condition number of A. // { int i; int j; int k; int l; double rcond; double s; double t; // // Compute the L1 norm of A. // double anorm = 0.0; for (j = 1; j <= n; j++) { anorm = Math.Max(anorm, BLAS1D.dasum(n, a, 1, index: +0 + (j - 1) * lda)); } // // Compute the LU factorization. // DGEFA.dgefa(ref a, lda, n, ref ipvt); // // RCOND = 1 / ( norm(A) * (estimate of norm(inverse(A))) ) // // estimate of norm(inverse(A)) = norm(Z) / norm(Y) // // where // A * Z = Y // and // A' * Y = E // // The components of E are chosen to cause maximum local growth in the // elements of W, where U'*W = E. The vectors are frequently rescaled // to avoid overflow. // // Solve U' * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } for (k = 1; k <= n; k++) { if (z[k - 1] != 0.0) { ek *= typeMethods.r8_sign(-z[k - 1]); } if (Math.Abs(a[k - 1 + (k - 1) * lda]) < Math.Abs(ek - z[k - 1])) { s = Math.Abs(a[k - 1 + (k - 1) * lda]) / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); if (a[k - 1 + (k - 1) * lda] != 0.0) { wk /= a[k - 1 + (k - 1) * lda]; wkm /= a[k - 1 + (k - 1) * lda]; } else { wk = 1.0; wkm = 1.0; } if (k + 1 <= n) { for (j = k + 1; j <= n; j++) { sm += Math.Abs(z[j - 1] + wkm * a[k - 1 + (j - 1) * lda]); z[j - 1] += wk * a[k - 1 + (j - 1) * lda]; s += Math.Abs(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; for (i = k + 1; i <= n; i++) { z[i - 1] += t * a[k - 1 + (i - 1) * lda]; } } } z[k - 1] = wk; } t = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= t; } // // Solve L' * Y = W // for (k = n; 1 <= k; k--) { z[k - 1] += BLAS1D.ddot(n - k, a, 1, z, 1, xIndex: +k + (k - 1) * lda, yIndex: +k); switch (Math.Abs(z[k - 1])) { case > 1.0: { t = Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] /= t; } break; } } l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; } t = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= t; } double ynorm = 1.0; // // Solve L * V = Y. // for (k = 1; k <= n; k++) { l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; for (i = k + 1; i <= n; i++) { z[i - 1] += t * a[i - 1 + (k - 1) * lda]; } switch (Math.Abs(z[k - 1])) { case > 1.0: { ynorm /= Math.Abs(z[k - 1]); t = Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] /= t; } break; } } } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } ynorm /= s; // // Solve U * Z = V. // for (k = n; 1 <= k; k--) { if (Math.Abs(a[k - 1 + (k - 1) * lda]) < Math.Abs(z[k - 1])) { s = Math.Abs(a[k - 1 + (k - 1) * lda]) / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } if (a[k - 1 + (k - 1) * lda] != 0.0) { z[k - 1] /= a[k - 1 + (k - 1) * lda]; } else { z[k - 1] = 1.0; } for (i = 1; i <= k - 1; i++) { z[i - 1] -= z[k - 1] * a[i - 1 + (k - 1) * lda]; } } // // Normalize Z in the L1 norm. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double dgbco(ref double[] abd, int lda, int n, int ml, int mu, ref int[] ipvt, double[] z) //****************************************************************************80 // // Purpose: // // DGBCO factors a real band matrix and estimates its condition. // // Discussion: // // If RCOND is not needed, DGBFA is slightly faster. // // To solve A*X = B, follow DGBCO by DGBSL. // // To compute inverse(A)*C, follow DGBCO by DGBSL. // // To compute determinant(A), follow DGBCO by DGBDI. // // Example: // // If the original matrix is // // 11 12 13 0 0 0 // 21 22 23 24 0 0 // 0 32 33 34 35 0 // 0 0 43 44 45 46 // 0 0 0 54 55 56 // 0 0 0 0 65 66 // // then for proper band storage, // // N = 6, ML = 1, MU = 2, 5 <= LDA and ABD should contain // // * * * + + + * = not used // * * 13 24 35 46 + = used for pivoting // * 12 23 34 45 56 // 11 22 33 44 55 66 // 21 32 43 54 65 * // // Band storage: // // If A is a band matrix, the following program segment // will set up the input. // // ml = (band width below the diagonal) // mu = (band width above the diagonal) // m = ml + mu + 1 // // do j = 1, n // i1 = max ( 1, j-mu ) // i2 = min ( n, j+ml ) // do i = i1, i2 // k = i - j + m // abd(k,j) = a(i,j) // } // } // // This uses rows ML+1 through 2*ML+MU+1 of ABD. In addition, the first // ML rows in ABD are used for elements generated during the // triangularization. The total number of rows needed in ABD is // 2*ML+MU+1. The ML+MU by ML+MU upper left triangle and the ML by ML // lower right triangle are not referenced. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 07 June 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. // // Workspace, double Z[N], a work vector whose contents are // usually unimportant. If A is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // // Output, double DGBCO, an estimate of the reciprocal condition number RCOND // of A. For the system A*X = B, relative perturbations in A and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { int i; int j; int k; int lm; double rcond; double s; double t; // // Compute the 1-norm of A. // double anorm = 0.0; int l = ml + 1; int is_ = l + mu; for (j = 1; j <= n; j++) { anorm = Math.Max(anorm, BLAS1D.dasum(l, abd, 1, index: +is_ - 1 + (j - 1) * lda)); if (ml + 1 < is_) { is_ -= 1; } if (j <= mu) { l += 1; } if (n - ml <= j) { l -= 1; } } // // Factor. // DGBFA.dgbfa(ref abd, lda, n, ml, mu, ref ipvt); // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where a*z = y and A'*Y = E. // // A' is the transpose of A. The components of E are // chosen to cause maximum local growth in the elements of W where // U'*W = E. The vectors are frequently rescaled to avoid // overflow. // // Solve U' * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } int m = ml + mu + 1; int ju = 0; for (k = 1; k <= n; k++) { if (z[k - 1] != 0.0) { ek *= typeMethods.r8_sign(-z[k - 1]); } if (Math.Abs(abd[m - 1 + (k - 1) * lda]) < Math.Abs(ek - z[k - 1])) { s = Math.Abs(abd[m - 1 + (k - 1) * lda]) / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); if (abd[m - 1 + (k - 1) * lda] != 0.0) { wk /= abd[m - 1 + (k - 1) * lda]; wkm /= abd[m - 1 + (k - 1) * lda]; } else { wk = 1.0; wkm = 1.0; } ju = Math.Min(Math.Max(ju, mu + ipvt[k - 1]), n); int mm = m; if (k + 1 <= ju) { for (j = k + 1; j <= ju; j++) { mm -= 1; sm += Math.Abs(z[j - 1] + wkm * abd[mm - 1 + (j - 1) * lda]); z[j - 1] += wk * abd[mm - 1 + (j - 1) * lda]; s += Math.Abs(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; mm = m; for (j = k + 1; j <= ju; ju++) { mm -= 1; z[j - 1] += t * abd[mm - 1 + (j - 1) * lda]; } } } z[k - 1] = wk; } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } // // Solve L' * Y = W. // for (k = n; 1 <= k; k--) { lm = Math.Min(ml, n - k); if (k < m) { z[k - 1] += BLAS1D.ddot(lm, abd, 1, z, 1, xIndex: +m + (k - 1) * lda, yIndex: +k); } switch (Math.Abs(z[k - 1])) { case > 1.0: { s = 1.0 / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } break; } } l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } double ynorm = 1.0; // // Solve L * V = Y. // for (k = 1; k <= n; k++) { l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; lm = Math.Min(ml, n - k); if (k < n) { BLAS1D.daxpy(lm, t, abd, 1, ref z, 1, xIndex: +m + (k - 1) * lda, yIndex: +k); } switch (Math.Abs(z[k - 1])) { case > 1.0: { s = 1.0 / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; break; } } } s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; // // Solve U * Z = W. // for (k = n; 1 <= k; k--) { if (Math.Abs(abd[m - 1 + (k - 1) * lda]) < Math.Abs(z[k - 1])) { s = Math.Abs(abd[m - 1 + (k - 1) * lda]) / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } if (abd[m - 1 + (k - 1) * lda] != 0.0) { z[k - 1] /= abd[m - 1 + (k - 1) * lda]; } else { z[k - 1] = 1.0; } lm = Math.Min(k, m) - 1; int la = m - lm; int lz = k - lm; t = -z[k - 1]; BLAS1D.daxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lz - 1); } // // Make ZNORM = 1.0. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
private static void dasum_test() //****************************************************************************80 // // Purpose: // // DASUM_TEST tests DASUM. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 15 May 2006 // // Author: // // John Burkardt // { int LDA = 6; int MA = 5; int NA = 4; int NX = 10; double[] a = new double[LDA * NA]; double[] x = new double[NX]; for (int i = 0; i < NX; i++) { x[i] = Math.Pow(-1.0, i + 1) * (2 * (i + 1)); } Console.WriteLine(""); Console.WriteLine("DASUM_TEST"); Console.WriteLine(" DASUM adds the absolute values of elements of a vector."); Console.WriteLine(""); Console.WriteLine(" X = "); Console.WriteLine(""); for (int i = 0; i < NX; i++) { Console.WriteLine(" " + (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " " + x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + ""); } Console.WriteLine(""); Console.WriteLine(" DASUM ( NX, X, 1 ) = " + BLAS1D.dasum(NX, x, 1) + ""); Console.WriteLine(" DASUM ( NX/2, X, 2 ) = " + BLAS1D.dasum(NX / 2, x, 2) + ""); Console.WriteLine(" DASUM ( 2, X, NX/2 ) = " + BLAS1D.dasum(2, x, NX / 2) + ""); for (int i = 0; i < MA; i++) { for (int j = 0; j < NA; j++) { a[i + j * LDA] = Math.Pow(-1.0, i + 1 + j + 1) * (10 * (i + 1) + j + 1); } } Console.WriteLine(""); Console.WriteLine(" Demonstrate with a matrix A:"); Console.WriteLine(""); for (int i = 0; i < MA; i++) { string cout = ""; for (int j = 0; j < NA; j++) { cout += " " + a[i + j * LDA].ToString(CultureInfo.InvariantCulture).PadLeft(14); } Console.WriteLine(cout); } Console.WriteLine(""); Console.WriteLine(" DASUM(MA,A(1,2),1) = " + BLAS1D.dasum(MA, a, 1, 0 + 1 * LDA) + ""); Console.WriteLine(" DASUM(NA,A(2,1),LDA) = " + BLAS1D.dasum(NA, a, LDA, 1) + ""); }
public static double dpoco(ref double[] a, int lda, int n, ref double[] z) //****************************************************************************80 // // Purpose: // // DPOCO factors a real symmetric positive definite matrix and estimates its condition. // // Discussion: // // If RCOND is not needed, DPOFA is slightly faster. // // To solve A*X = B, follow DPOCO by DPOSL. // // To compute inverse(A)*C, follow DPOCO by DPOSL. // // To compute determinant(A), follow DPOCO by DPODI. // // To compute inverse(A), follow DPOCO by DPODI. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 06 June 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, an upper triangular matrix R so that A = R'*R where R' // is the transpose. The strict lower triangle is unaltered. // If INFO /= 0, the factorization is not complete. // // Input, int LDA, the leading dimension of the array A. // // Input, int N, the order of the matrix. // // Output, double Z[N], a work vector whose contents are usually // unimportant. If A is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // If INFO /= 0, Z is unchanged. // // Output, double DPOCO, an estimate of the reciprocal // condition of A. For the system A*X = B, relative perturbations in // A and B of size EPSILON may cause relative perturbations in X of // size EPSILON/RCOND. If RCOND is so small that the logical expression // 1.0D+00 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { int i; int j; int k; double rcond; double s; double t; // // Find norm of A using only upper half. // for (j = 1; j <= n; j++) { z[j - 1] = BLAS1D.dasum(j, a, 1, index: +0 + (j - 1) * lda); for (i = 1; i <= j - 1; i++) { z[i - 1] += Math.Abs(a[i - 1 + (j - 1) * lda]); } } double anorm = 0.0; for (i = 1; i <= n; i++) { anorm = Math.Max(anorm, z[i - 1]); } // // Factor. // int info = DPOFA.dpofa(ref a, lda, n); if (info != 0) { rcond = 0.0; return(rcond); } // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A*Z = Y and A*Y = E. // // The components of E are chosen to cause maximum local // growth in the elements of W where R'*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve R' * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } for (k = 1; k <= n; k++) { if (z[k - 1] != 0.0) { ek *= typeMethods.r8_sign(-z[k - 1]); } if (a[k - 1 + (k - 1) * lda] < Math.Abs(ek - z[k - 1])) { s = a[k - 1 + (k - 1) * lda] / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); wk /= a[k - 1 + (k - 1) * lda]; wkm /= a[k - 1 + (k - 1) * lda]; if (k + 1 <= n) { for (j = k + 1; j <= n; j++) { sm += Math.Abs(z[j - 1] + wkm * a[k - 1 + (j - 1) * lda]); z[j - 1] += wk * a[k - 1 + (j - 1) * lda]; s += Math.Abs(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; for (j = k + 1; j <= n; j++) { z[j - 1] += t * a[k - 1 + (j - 1) * lda]; } } } z[k - 1] = wk; } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } // // Solve R * Y = W. // for (k = n; 1 <= k; k--) { if (a[k - 1 + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = a[k - 1 + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } } z[k - 1] /= a[k - 1 + (k - 1) * lda]; t = -z[k - 1]; BLAS1D.daxpy(k - 1, t, a, 1, ref z, 1, xIndex: +0 + (k - 1) * lda); } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } double ynorm = 1.0; // // Solve R' * V = Y. // for (k = 1; k <= n; k++) { z[k - 1] -= BLAS1D.ddot(k - 1, a, 1, z, 1, xIndex: +0 + (k - 1) * lda); if (a[k - 1 + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = a[k - 1 + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= a[k - 1 + (k - 1) * lda]; } s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; // // Solve R * Z = V. // for (k = n; 1 <= k; k--) { if (a[k - 1 + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = a[k - 1 + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= a[k - 1 + (k - 1) * lda]; t = -z[k - 1]; BLAS1D.daxpy(k - 1, t, a, 1, ref z, 1, xIndex: +0 + (k - 1) * lda); } // // Make ZNORM = 1.0. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double dppco(ref double[] ap, int n, ref double[] z) //****************************************************************************80 // // Purpose: // // DPPCO factors a real symmetric positive definite matrix in packed form. // // Discussion: // // DPPCO also estimates the condition of the matrix. // // If RCOND is not needed, DPPFA is slightly faster. // // To solve A*X = B, follow DPPCO by DPPSL. // // To compute inverse(A)*C, follow DPPCO by DPPSL. // // To compute determinant(A), follow DPPCO by DPPDI. // // To compute inverse(A), follow DPPCO by DPPDI. // // 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-1] = a(i,j) // } // } // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 07 June 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, an upper // triangular matrix R, stored in packed form, so that A = R'*R. // If INFO /= 0, the factorization is not complete. // // Input, int N, the order of the matrix. // // Output, double Z[N], a work vector whose contents are usually // unimportant. If A is singular to working precision, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // If INFO /= 0, Z is unchanged. // // Output, double DPPCO, an estimate of the reciprocal condition number RCOND // of A. For the system A*X = B, relative perturbations in A and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { int i; int j; int k; double rcond; double s; double t; // // Find the norm of A. // int j1 = 1; for (j = 1; j <= n; j++) { z[j - 1] = BLAS1D.dasum(j, ap, 1, index: +j1 - 1); int ij = j1; j1 += j; for (i = 1; i <= j - 1; i++) { z[i - 1] += Math.Abs(ap[ij - 1]); ij += 1; } } double anorm = 0.0; for (i = 1; i <= n; i++) { anorm = Math.Max(anorm, z[i - 1]); } // // Factor. // int info = DPPFA.dppfa(ref ap, n); if (info != 0) { rcond = 0.0; return(rcond); } // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A * Z = Y and A * Y = E. // // The components of E are chosen to cause maximum local // growth in the elements of W where R'*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve R' * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } int kk = 0; for (k = 1; k <= n; k++) { kk += k; if (z[k - 1] != 0.0) { ek *= typeMethods.r8_sign(-z[k - 1]); } if (ap[kk - 1] < Math.Abs(ek - z[k - 1])) { s = ap[kk - 1] / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); wk /= ap[kk - 1]; wkm /= ap[kk - 1]; int kj = kk + k; if (k + 1 <= n) { for (j = k + 1; j <= n; j++) { sm += Math.Abs(z[j - 1] + wkm * ap[kj - 1]); z[j - 1] += wk * ap[kj - 1]; s += Math.Abs(z[j - 1]); kj += j; } if (s < sm) { t = wkm - wk; wk = wkm; kj = kk + k; for (j = k + 1; j <= n; j++) { z[j - 1] += t * ap[kj - 1]; kj += j; } } } z[k - 1] = wk; } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } // // Solve R * Y = W. // for (k = n; 1 <= k; k--) { if (ap[kk - 1] < Math.Abs(z[k - 1])) { s = ap[kk - 1] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } } z[k - 1] /= ap[kk - 1]; kk -= k; t = -z[k - 1]; BLAS1D.daxpy(k - 1, t, ap, 1, ref z, 1, xIndex: +kk); } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } double ynorm = 1.0; // // Solve R' * V = Y. // for (k = 1; k <= n; k++) { z[k - 1] -= BLAS1D.ddot(k - 1, ap, 1, z, 1, xIndex: +kk); kk += k; if (ap[kk - 1] < Math.Abs(z[k - 1])) { s = ap[kk - 1] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= ap[kk - 1]; } s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; // // Solve R * Z = V. // for (k = n; 1 <= k; k--) { if (ap[kk - 1] < Math.Abs(z[k - 1])) { s = ap[kk - 1] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= ap[kk - 1]; kk -= k; t = -z[k - 1]; BLAS1D.daxpy(k - 1, t, ap, 1, ref z, 1, xIndex: +kk); } // // Make ZNORM = 1.0. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double dspco(ref double[] ap, int n, ref int[] kpvt, ref double[] z) //****************************************************************************80 // // Purpose: // // DSPCO factors a real symmetric matrix stored in packed form. // // Discussion: // // DSPCO uses elimination with symmetric pivoting and estimates // the condition of the matrix. // // If RCOND is not needed, DSPFA is slightly faster. // // To solve A*X = B, follow DSPCO by DSPSL. // // To compute inverse(A)*C, follow DSPCO by DSPSL. // // To compute inverse(A), follow DSPCO by DSPDI. // // To compute determinant(A), follow DSPCO by DSPDI. // // To compute inertia(A), follow DSPCO 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-1] = a(i,j) // } // } // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 07 June 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, double Z[N] a work vector whose contents are usually // unimportant. If A is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // // Output, double DSPCO, an estimate of the reciprocal condition number RCOND // of A. For the system A*X = B, relative perturbations in A and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { double ak; double akm1; double bk; double bkm1; double denom; int i; int ikm1; int ikp1; int j; int kk; int km1k; int km1km1; int kp; int kps; int ks; double rcond; double s; double t; // // Find norm of A using only upper half. // int j1 = 1; for (j = 1; j <= n; j++) { z[j - 1] = BLAS1D.dasum(j, ap, 1, index: +j1 - 1); int ij = j1; j1 += j; for (i = 1; i <= j - 1; i++) { z[i - 1] += Math.Abs(ap[ij - 1]); ij += 1; } } double anorm = 0.0; for (i = 1; i <= n; i++) { anorm = Math.Max(anorm, z[i - 1]); } // // Factor. // DSPFA.dspfa(ref ap, n, ref kpvt); // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A*Z = Y and A*Y = E. // // The components of E are chosen to cause maximum local // growth in the elements of W where U*D*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve U * D * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } int k = n; int ik = n * (n - 1) / 2; while (k != 0) { kk = ik + k; ikm1 = ik - (k - 1); ks = kpvt[k - 1] switch {
public static double dsico(ref double[] a, int lda, int n, ref int[] kpvt, ref double[] z) //****************************************************************************80 // // Purpose: // // DSICO factors a real symmetric matrix and estimates its condition. // // Discussion: // // If RCOND is not needed, DSIFA is slightly faster. // // To solve A * X = B, follow DSICO by DSISL. // // To compute inverse(A)*C, follow DSICO by DSISL. // // To compute inverse(A), follow DSICO by DSIDI. // // To compute determinant(A), follow DSICO by DSIDI. // // To compute inertia(A), follow DSICO by DSIDI. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 07 June 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], pivot indices. // // Output, double Z[N], a work vector whose contents are usually // unimportant. If A is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // // Output, double DSICO, an estimate of the reciprocal condition number RCOND // of A. For the system A*X = B, relative perturbations in A and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { double ak; double akm1; double bk; double bkm1; double denom; int i; int j; int kp; int kps; int ks; double rcond; double s; double t; // // Find the norm of A, using only entries in the upper half of the matrix. // for (j = 1; j <= n; j++) { z[j - 1] = BLAS1D.dasum(j, a, 1, index: +0 + (j - 1) * lda); for (i = 1; i <= j - 1; i++) { z[i - 1] += Math.Abs(a[i - 1 + (j - 1) * lda]); } } double anorm = 0.0; for (i = 1; i <= n; i++) { anorm = Math.Max(anorm, z[i - 1]); } // // Factor. // DSIFA.dsifa(ref a, lda, n, ref kpvt); // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A*Z = Y and A*Y = E. // // The components of E are chosen to cause maximum local // growth in the elements of W where U*D*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve U * D * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } int k = n; while (k != 2) { ks = kpvt[k - 1] switch {
public static double dtrco(double[] t, int ldt, int n, ref double[] z, int job) //****************************************************************************80 // // Purpose: // // DTRCO estimates the condition of a real triangular matrix. // // 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, double T[LDT*N], 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. // // Input, int LDT, the leading dimension of the array T. // // Input, int N, the order of the matrix. // // Output, double Z[N] a work vector whose contents are usually // unimportant. If T is close to a singular matrix, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // // Input, int JOB, indicates the shape of T: // 0, T is lower triangular. // nonzero, T is upper triangular. // // Output, double DTRCO, an estimate of the reciprocal condition RCOND // of T. For the system T*X = B, relative perturbations in T and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0D+00 + RCOND == 1.0D+00 // is true, then T may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { int i; int i1; int j; int k; int kk; double rcond; double s; double w; bool lower = job == 0; // // Compute the 1-norm of T. // double tnorm = 0.0; for (j = 1; j <= n; j++) { int l; switch (lower) { case true: l = n + 1 - j; i1 = j; break; default: l = j; i1 = 1; break; } tnorm = Math.Max(tnorm, BLAS1D.dasum(l, t, 1, index: +i1 - 1 + (j - 1) * ldt)); } // // RCOND = 1/(norm(T)*(estimate of norm(inverse(T)))). // // Estimate = norm(Z)/norm(Y) where T * Z = Y and T' * Y = E. // // T' is the transpose of T. // // The components of E are chosen to cause maximum local // growth in the elements of Y. // // The vectors are frequently rescaled to avoid overflow. // // Solve T' * Y = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } for (kk = 1; kk <= n; kk++) { k = lower switch { true => n + 1 - kk, _ => kk }; if (z[k - 1] != 0.0) { ek = typeMethods.r8_sign(-z[k - 1]) * ek; } if (Math.Abs(t[k - 1 + (k - 1) * ldt]) < Math.Abs(ek - z[k - 1])) { s = Math.Abs(t[k - 1 + (k - 1) * ldt]) / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); if (t[k - 1 + (k - 1) * ldt] != 0.0) { wk /= t[k - 1 + (k - 1) * ldt]; wkm /= t[k - 1 + (k - 1) * ldt]; } else { wk = 1.0; wkm = 1.0; } if (kk != n) { int j2; int j1; switch (lower) { case true: j1 = 1; j2 = k - 1; break; default: j1 = k + 1; j2 = n; break; } for (j = j1; j <= j2; j++) { sm += Math.Abs(z[j - 1] + wkm * t[k - 1 + (j - 1) * ldt]); z[j - 1] += wk * t[k - 1 + (j - 1) * ldt]; s += Math.Abs(z[j - 1]); } if (s < sm) { w = wkm - wk; wk = wkm; for (j = j1; j <= j2; j++) { z[j - 1] += w * t[k - 1 + (j - 1) * ldt]; } } } z[k - 1] = wk; } double temp = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= temp; } double ynorm = 1.0; // // Solve T * Z = Y. // for (kk = 1; kk <= n; kk++) { k = lower switch { true => kk, _ => n + 1 - kk }; if (Math.Abs(t[k - 1 + (k - 1) * ldt]) < Math.Abs(z[k - 1])) { s = Math.Abs(t[k - 1 + (k - 1) * ldt]) / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } if (t[k - 1 + (k - 1) * ldt] != 0.0) { z[k - 1] /= t[k - 1 + (k - 1) * ldt]; } else { z[k - 1] = 1.0; } i1 = lower switch { true => k + 1, _ => 1 }; if (kk >= n) { continue; } w = -z[k - 1]; BLAS1D.daxpy(n - kk, w, t, 1, ref z, 1, xIndex: +i1 - 1 + (k - 1) * ldt, yIndex: +i1 - 1); } // // Make ZNORM = 1.0. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (tnorm != 0.0) { rcond = ynorm / tnorm; } else { rcond = 0.0; } return(rcond); } }
public static double dpbco(ref double[] abd, int lda, int n, int m, ref double[] z) //****************************************************************************80 // // Purpose: // // DPBCO factors a real symmetric positive definite banded matrix. // // Discussion: // // DPBCO also estimates the condition of the matrix. // // If RCOND is not needed, DPBFA is slightly faster. // // To solve A*X = B, follow DPBCO by DPBSL. // // To compute inverse(A)*C, follow DPBCO by DPBSL. // // To compute determinant(A), follow DPBCO by DPBDI. // // Band storage: // // If A is a symmetric positive definite band matrix, the following // program segment will set up the input. // // m = (band width above diagonal) // do j = 1, n // i1 = max (1, j-m) // do i = i1, j // k = i-j+m+1 // abd(k,j) = a(i,j) // } // } // // This uses M + 1 rows of A, except for the M by M upper left triangle, // which is ignored. // // For example, if the original matrix is // // 11 12 13 0 0 0 // 12 22 23 24 0 0 // 13 23 33 34 35 0 // 0 24 34 44 45 46 // 0 0 35 45 55 56 // 0 0 0 46 56 66 // // then N = 6, M = 2 and ABD should contain // // * * 13 24 35 46 // * 12 23 34 45 56 // 11 22 33 44 55 66 // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 07 June 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 to be // factored. The columns of the upper triangle are stored in the columns // of ABD and the diagonals of the upper triangle are stored in the rows // of ABD. On output, an upper triangular matrix R, stored in band form, // so that A = R'*R. If INFO /= 0, the factorization is not complete. // // Input, int LDA, the leading dimension of the array ABD. // M+1 <= LDA is required. // // Input, int N, the order of the matrix. // // Input, int M, the number of diagonals above the main diagonal. // // Output, double Z[N], a work vector whose contents are usually // unimportant. If A is singular to working precision, then Z is an // approximate null vector in the sense that // norm(A*Z) = RCOND * norm(A) * norm(Z). // If INFO /= 0, Z is unchanged. // // Output, double DPBCO, an estimate of the reciprocal condition number // RCOND. For the system A*X = B, relative perturbations in A and B of size // EPSILON may cause relative perturbations in X of size EPSILON/RCOND. // If RCOND is so small that the logical expression // 1.0 + RCOND == 1.0D+00 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // { int i; int j; int k; int la; int lb; int lm; double rcond; double s; double t; // // Find the norm of A. // for (j = 1; j <= n; j++) { int l = Math.Min(j, m + 1); int mu = Math.Max(m + 2 - j, 1); z[j - 1] = BLAS1D.dasum(l, abd, 1, index: +mu - 1 + (j - 1) * lda); k = j - l; for (i = mu; i <= m; i++) { k += 1; z[k - 1] += Math.Abs(abd[i - 1 + (j - 1) * lda]); } } double anorm = 0.0; for (i = 1; i <= n; i++) { anorm = Math.Max(anorm, z[i - 1]); } // // Factor. // int info = DPBFA.dpbfa(ref abd, lda, n, m); if (info != 0) { rcond = 0.0; return(rcond); } // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A*Z = Y and A*Y = E. // // The components of E are chosen to cause maximum local // growth in the elements of W where R'*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve R' * W = E. // double ek = 1.0; for (i = 1; i <= n; i++) { z[i - 1] = 0.0; } for (k = 1; k <= n; k++) { if (z[k - 1] != 0.0) { ek *= typeMethods.r8_sign(-z[k - 1]); } if (abd[m + (k - 1) * lda] < Math.Abs(ek - z[k - 1])) { s = abd[m + (k - 1) * lda] / Math.Abs(ek - z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ek = s * ek; } double wk = ek - z[k - 1]; double wkm = -ek - z[k - 1]; s = Math.Abs(wk); double sm = Math.Abs(wkm); wk /= abd[m + (k - 1) * lda]; wkm /= abd[m + (k - 1) * lda]; int j2 = Math.Min(k + m, n); i = m + 1; if (k + 1 <= j2) { for (j = k + 1; j <= j2; j++) { i -= 1; sm += Math.Abs(z[j - 1] + wkm * abd[i - 1 + (j - 1) * lda]); z[j - 1] += wk * abd[i - 1 + (j - 1) * lda]; s += Math.Abs(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; i = m + 1; for (j = k + 1; j <= j2; j++) { i -= 1; z[j - 1] += t * abd[i - 1 + (j - 1) * lda]; } } } z[k - 1] = wk; } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } // // Solve R * Y = W. // for (k = n; 1 <= k; k--) { if (abd[m + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = abd[m + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } } z[k - 1] /= abd[m + (k - 1) * lda]; lm = Math.Min(k - 1, m); la = m + 1 - lm; lb = k - lm; t = -z[k - 1]; BLAS1D.daxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); } s = BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] /= s; } double ynorm = 1.0; // // Solve R' * V = Y. // for (k = 1; k <= n; k++) { lm = Math.Min(k - 1, m); la = m + 1 - lm; lb = k - lm; z[k - 1] -= BLAS1D.ddot(lm, abd, 1, z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); if (abd[m + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = abd[m + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= abd[m + (k - 1) * lda]; } s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; // // Solve R * Z = W. // for (k = n; 1 <= k; k--) { if (abd[m + (k - 1) * lda] < Math.Abs(z[k - 1])) { s = abd[m + (k - 1) * lda] / Math.Abs(z[k - 1]); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; } z[k - 1] /= abd[m + (k - 1) * lda]; lm = Math.Min(k - 1, m); la = m + 1 - lm; lb = k - lm; t = -z[k - 1]; BLAS1D.daxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); } // // Make ZNORM = 1.0. // s = 1.0 / BLAS1D.dasum(n, z, 1); for (i = 1; i <= n; i++) { z[i - 1] = s * z[i - 1]; } ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }