public static double zgeco(ref Complex[] a, int lda, int n, ref int[] ipvt) //****************************************************************************80 // // Purpose: // // ZGECO factors a complex matrix and estimates its condition. // // Discussion: // // If RCOND is not needed, ZGEFA is slightly faster. // // To solve A*X = B, follow ZGECO by ZGESL. // // To compute inverse(A)*C, follow ZGECO by ZGESL. // // To compute determinant(A), follow ZGECO by ZGEDI. // // To compute inverse(A), follow ZGECO by ZGEDI. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 21 May 2006 // // Author: // // 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. // // Parameters: // // Input/output, Complex A[LDA*N], on input, 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. // // Output, int IPVT[N], the pivot indices. // // Output, double SGECO, 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.0 + RCOND == 1.0 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate // underflows. // // Local Parameters: // // Workspace, Complex 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 ). // { int i; int j; int k; int l; double rcond; double s; Complex t; Complex[] z = new Complex [n]; // // Compute the 1-norm of A. // double anorm = 0.0; for (j = 0; j < n; j++) { anorm = Math.Max(anorm, BLAS1Z.dzasum(n, a, 1, index: +0 + j * lda)); } // // Factor. // ZGEFA.zgefa(ref a, lda, n, ref ipvt); // // RCOND = 1/(norm(A)*(estimate of norm(inverse(A)))). // // Estimate = norm(Z)/norm(Y) where A*Z = Y and hermitian(A)*Y = E. // // Hermitian(A) is the Complex.Conjugateugate transpose of A. // // The components of E are chosen to cause maximum local // growth in the elements of W where hermitian(U)*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve hermitian(U)*W = E. // Complex ek = new(1.0, 0.0); for (i = 0; i < n; i++) { z[i] = new Complex(0.0, 0.0); } for (k = 1; k <= n; k++) { if (typeMethods.zabs1(z[k - 1]) != 0.0) { ek = typeMethods.zsign1(ek, -z[k - 1]); } if (typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) < typeMethods.zabs1(ek - z[k - 1])) { s = typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) / typeMethods.zabs1(ek - z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ek = new Complex(s, 0.0) * ek; } Complex wk = ek - z[k - 1]; Complex wkm = -ek - z[k - 1]; s = typeMethods.zabs1(wk); double sm = typeMethods.zabs1(wkm); if (typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) != 0.0) { wk /= Complex.Conjugate(a[k - 1 + (k - 1) * lda]); wkm /= Complex.Conjugate(a[k - 1 + (k - 1) * lda]); } else { wk = new Complex(1.0, 0.0); wkm = new Complex(1.0, 0.0); } for (j = k + 1; j <= n; j++) { sm += typeMethods.zabs1(z[j - 1] + wkm * Complex.Conjugate(a[k - 1 + (j - 1) * lda])); z[j - 1] += wk * Complex.Conjugate(a[k - 1 + (j - 1) * lda]); s += typeMethods.zabs1(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; for (j = k + 1; j <= n; j++) { z[j - 1] += t * Complex.Conjugate(a[k - 1 + (j - 1) * lda]); } } z[k - 1] = wk; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); // // Solve hermitian(L) * Y = W. // for (k = n; 1 <= k; k--) { if (k < n) { z[k - 1] += BLAS1Z.zdotc(n - k, a, 1, z, 1, xIndex: +k + (k - 1) * lda, yIndex: +k); } if (1.0 < typeMethods.zabs1(z[k - 1])) { s = 1.0 / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); } l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); 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; if (k < n) { BLAS1Z.zaxpy(n - k, t, a, 1, ref z, 1, xIndex: +k + (k - 1) * lda, yIndex: +k); } if (!(1.0 < typeMethods.zabs1(z[k - 1]))) { continue; } s = 1.0 / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; // // Solve U * Z = V. // for (k = n; 1 <= k; k--) { if (typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) < typeMethods.zabs1(z[k - 1])) { s = typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } if (typeMethods.zabs1(a[k - 1 + (k - 1) * lda]) != 0.0) { z[k - 1] /= a[k - 1 + (k - 1) * lda]; } else { z[k - 1] = new Complex(1.0, 0.0); } t = -z[k - 1]; BLAS1Z.zaxpy(k - 1, t, a, 1, ref z, 1, xIndex: +0 + (k - 1) * lda); } // // Make ZNORM = 1. // s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double zppco(ref Complex[] ap, int n, ref int info) //****************************************************************************80 // // Purpose: // // ZPPCO factors a complex <double> hermitian positive definite matrix. // // Discussion: // // The routine also estimates the condition of the matrix. // // The matrix is stored in packed form. // // If RCOND is not needed, ZPPFA is slightly faster. // // To solve A*X = B, follow ZPPCO by ZPPSL. // // To compute inverse(A)*C, follow ZPPCO by ZPPSL. // // To compute determinant(A), follow ZPPCO by ZPPDI. // // To compute inverse(A), follow ZPPCO by ZPPDI. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 21 May 2006 // // Author: // // 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. // // Parameters: // // Input/output, complex <double> AP[N*(N+1)/2]; on input, the packed form of a // hermitian matrix. 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 = hermitian(R) * R. // If INFO != 0 , the factorization is not complete. // // Input, int N, the order of the matrix. // // Output, double ZPPCO, an estimate of RCOND, the reciprocal condition of // the matrix. 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.0 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // // Output, int *INFO. // 0, for normal return. // K, signals an error condition. The leading minor of order K is not // positive definite. // // Local Parameters: // // Local, complex <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). // { int j; int k; double rcond; double s; Complex t; // // Find norm of A. // Complex[] z = new Complex [n]; int j1 = 1; for (j = 1; j <= n; j++) { z[j - 1] = new Complex(BLAS1Z.dzasum(j, ap, 1, index: +j1 - 1), 0.0); int ij = j1; j1 += j; int i; for (i = 1; i <= j - 1; i++) { z[i - 1] = new Complex(z[i - 1].Real + typeMethods.zabs1(ap[ij - 1]), 0.0); ij += 1; } } double anorm = 0.0; for (j = 0; j < n; j++) { anorm = Math.Max(anorm, z[j].Real); } // // Factor. // info = ZPPFA.zppfa(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 hermitian(R)*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve hermitian(R)*W = E. // Complex ek = new(1.0, 0.0); for (j = 0; j < n; j++) { z[j] = new Complex(0.0, 0.0); } int kk = 0; for (k = 1; k <= n; k++) { kk += k; if (typeMethods.zabs1(z[k - 1]) != 0.0) { ek = typeMethods.zsign1(ek, -z[k - 1]); } if (ap[kk - 1].Real < typeMethods.zabs1(ek - z[k - 1])) { s = ap[kk - 1].Real / typeMethods.zabs1(ek - z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ek = new Complex(s, 0.0) * ek; } Complex wk = ek - z[k - 1]; Complex wkm = -ek - z[k - 1]; s = typeMethods.zabs1(wk); double sm = typeMethods.zabs1(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 += typeMethods.zabs1(z[j - 1] + wkm * Complex.Conjugate(ap[kj - 1])); z[j - 1] += wk * Complex.Conjugate(ap[kj - 1]); s += typeMethods.zabs1(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 * Complex.Conjugate(ap[kj - 1]); kj += j; } } } z[k - 1] = wk; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); // // Solve R * Y = W. // for (k = n; 1 <= k; k--) { if (ap[kk - 1].Real < typeMethods.zabs1(z[k - 1])) { s = ap[kk - 1].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); } z[k - 1] /= ap[kk - 1]; kk -= k; t = -z[k - 1]; BLAS1Z.zaxpy(k - 1, t, ap, 1, ref z, 1, xIndex: +kk); } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); double ynorm = 1.0; // // Solve hermitian(R) * V = Y. // for (k = 1; k <= n; k++) { z[k - 1] -= BLAS1Z.zdotc(k - 1, ap, 1, z, 1, xIndex: +kk); kk += k; if (ap[kk - 1].Real < typeMethods.zabs1(z[k - 1])) { s = ap[kk - 1].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } z[k - 1] /= ap[kk - 1]; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; // // Solve R * Z = V. // for (k = n; 1 <= k; k--) { if (ap[kk - 1].Real < typeMethods.zabs1(z[k - 1])) { s = ap[kk - 1].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } z[k - 1] /= ap[kk - 1]; kk -= k; t = -z[k - 1]; BLAS1Z.zaxpy(k - 1, t, ap, 1, ref z, 1, xIndex: +kk); } // // Make ZNORM = 1. // s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double zgbco(ref Complex[] abd, int lda, int n, int ml, int mu, ref int[] ipvt) //****************************************************************************80 // // Purpose: // // ZGBCO factors a complex band matrix and estimates its condition. // // Discussion: // // If RCOND is not needed, ZGBFA is slightly faster. // // To solve A*X = B, follow ZGBCO by ZGBSL. // // To compute inverse(A)*C, follow ZGBCO by ZGBSL. // // To compute determinant(A), follow ZGBCO by ZGBDI. // // 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. // // Example: // // If the original matrix A 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 N = 6, ML = 1, MU = 2, 5 <= LDA and ABD should contain // // * * * + + + // * * 13 24 35 46 // * 12 23 34 45 56 // 11 22 33 44 55 66 // 21 32 43 54 65 * // // * = not used, // + = used for pivoting. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 21 May 2006 // // Author: // // 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. // // Parameters: // // Input/output, Complex ABD[LDA*N], on input, contains 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 ABD. // LDA must be at least 2*ML+MU+1. // // Input, int N, the order of the matrix. // // Input, int ML, the number of diagonals below the main diagonal. // 0 <= ML < N. // // Input, int MU, the number of diagonals above the main diagonal. // 0 <= MU < N. // More efficient if ML <= MU. // // Output, int IPVT[N], the pivot indices. // // Output, double ZGBCO, an estimate of the reciprocal condition 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.0 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate // underflows. // // Local Parameters: // // Workspace, Complex 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 ). // { int j; int k; int lm; double rcond; double s; Complex t; Complex[] z = new Complex [n]; // // Compute 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, BLAS1Z.dzasum(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 // ZGBFA.zgbfa(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 hermitian(A)*Y = E. // // Hermitian(A) is the Complex.Conjugateugate transpose of A. // // The components of E are chosen to cause maximum local // growth in the elements of W where hermitian(U)*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve hermitian(U) * W = E. // Complex ek = new(1.0, 0.0); for (j = 1; j <= n; j++) { z[j - 1] = new Complex(0.0, 0.0); } int m = ml + mu + 1; int ju = 0; for (k = 1; k <= n; k++) { if (typeMethods.zabs1(z[k - 1]) != 0.0) { ek = typeMethods.zsign1(ek, -z[k - 1]); } if (typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) < typeMethods.zabs1(ek - z[k - 1])) { s = typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) / typeMethods.zabs1(ek - z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ek = new Complex(s, 0.0) * ek; } Complex wk = ek - z[k - 1]; Complex wkm = -ek - z[k - 1]; s = typeMethods.zabs1(wk); double sm = typeMethods.zabs1(wkm); if (typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) != 0.0) { wk /= Complex.Conjugate(abd[m - 1 + (k - 1) * lda]); wkm /= Complex.Conjugate(abd[m - 1 + (k - 1) * lda]); } else { wk = new Complex(1.0, 0.0); wkm = new Complex(1.0, 0.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 += typeMethods.zabs1(z[j - 1] + wkm * Complex.Conjugate(abd[mm - 1 + (j - 1) * lda])); z[j - 1] += wk * Complex.Conjugate(abd[mm - 1 + (j - 1) * lda]); s += typeMethods.zabs1(z[j - 1]); } if (s < sm) { t = wkm - wk; wk = wkm; mm = m; for (j = k + 1; j <= ju; j++) { mm -= 1; z[j - 1] += t * Complex.Conjugate(abd[mm - 1 + (j - 1) * lda]); } } } z[k - 1] = wk; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); // // Solve hermitian(L) * Y = W. // for (k = n; 1 <= k; k--) { lm = Math.Min(ml, n - k); if (k < n) { z[k - 1] += BLAS1Z.zdotc(lm, abd, 1, z, 1, xIndex: +m + (k - 1) * lda, yIndex: +k); } if (1.0 < typeMethods.zabs1(z[k - 1])) { s = 1.0 / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); } l = ipvt[k - 1]; t = z[l - 1]; z[l - 1] = z[k - 1]; z[k - 1] = t; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); 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) { BLAS1Z.zaxpy(lm, t, abd, 1, ref z, 1, xIndex: +m + (k - 1) * lda, yIndex: +k); } if (!(1.0 < typeMethods.zabs1(z[k - 1]))) { continue; } s = 1.0 / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; // // Solve U * Z = W. // for (k = n; 1 <= k; k--) { if (typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) < typeMethods.zabs1(z[k - 1])) { s = typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } if (typeMethods.zabs1(abd[m - 1 + (k - 1) * lda]) != 0.0) { z[k - 1] /= abd[m - 1 + (k - 1) * lda]; } else { z[k - 1] = new Complex(1.0, 0.0); } lm = Math.Min(k, m) - 1; int la = m - lm; int lz = k - lm; t = -z[k - 1]; BLAS1Z.zaxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lz - 1); } // // Make ZNORM = 1. // s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double zpbco(ref Complex[] abd, int lda, int n, int m, ref int info) //****************************************************************************80 // // Purpose: // // ZPBCO factors a Complex hermitian positive definite band matrix. // // Discussion: // // The routine also estimates the condition number of the matrix. // // If RCOND is not needed, ZPBFA is slightly faster. // // To solve A*X = B, follow ZPBCO by ZPBSL. // // To compute inverse(A)*C, follow ZPBCO by ZPBSL. // // To compute determinant(A), follow ZPBCO by ZPBDI. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 21 May 2006 // // Author: // // 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. // // Parameters: // // Input/output, Complex 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 = hermitian(R) * R. If INFO != 0, the factorization is not complete. // // Input, int LDA, the leading dimension of ABD. // LDA must be at least M+1. // // Input, int N, the order of the matrix. // // Input, int M, the number of diagonals above the main diagonal. // 0 <= M < N. // // Output, double ZPBCO, an estimate of RCOND, the reciprocal condition of // the matrix. 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.0 // is true, then A may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate underflows. // // Output, int *INFO. // 0, for normal return. // K, signals an error condition. The leading minor of order K is not // positive definite. // // Local Parameter: // // Workspace, Complex 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. // { int i; int j; int k; int la; int lb; int lm; double rcond; double s; Complex t; // // Find the norm of A. // Complex[] z = new Complex [n]; for (j = 1; j <= n; j++) { int l = Math.Min(j, m + 1); int mu = Math.Max(m + 2 - j, 1); z[j - 1] = new Complex(BLAS1Z.dzasum(l, abd, 1, index: +mu - 1 + (j - 1) * lda), 0.0); k = j - l; for (i = mu; i <= m; i++) { k += 1; z[k - 1] = new Complex(z[k - 1].Real + typeMethods.zabs1(abd[i - 1 + (j - 1) * lda]), 0.0); } } double anorm = 0.0; for (j = 0; j < n; j++) { anorm = Math.Max(anorm, z[j].Real); } // // Factor. // info = ZPBFA.zpbfa(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 hermitian(R)*W = E. // // The vectors are frequently rescaled to avoid overflow. // // Solve hermitian(R)*W = E. // Complex ek = new(1.0, 0.0); for (i = 0; i < n; i++) { z[i] = new Complex(0.0, 0.0); } for (k = 1; k <= n; k++) { if (typeMethods.zabs1(z[k - 1]) != 0.0) { ek = typeMethods.zsign1(ek, -z[k - 1]); } if (abd[m + (k - 1) * lda].Real < typeMethods.zabs1(ek - z[k - 1])) { s = abd[m + (k - 1) * lda].Real / typeMethods.zabs1(ek - z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ek = new Complex(s, 0.0) * ek; } Complex wk = ek - z[k - 1]; Complex wkm = -ek - z[k - 1]; s = typeMethods.zabs1(wk); double sm = typeMethods.zabs1(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 += typeMethods.zabs1(z[j - 1] + wkm * Complex.Conjugate(abd[i - 1 + (j - 1) * lda])); z[j - 1] += wk * Complex.Conjugate(abd[i - 1 + (j - 1) * lda]); s += typeMethods.zabs1(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 * Complex.Conjugate(abd[i - 1 + (j - 1) * lda]); } } } z[k - 1] = wk; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); // // Solve R * Y = W. // for (k = n; 1 <= k; k--) { if (abd[m + (k - 1) * lda].Real < typeMethods.zabs1(z[k - 1])) { s = abd[m + (k - 1) * lda].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 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]; BLAS1Z.zaxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); double ynorm = 1.0; // // Solve hermitian(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] -= BLAS1Z.zdotc(lm, abd, 1, z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); if (abd[m + (k - 1) * lda].Real < typeMethods.zabs1(z[k - 1])) { s = abd[m + (k - 1) * lda].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } z[k - 1] /= abd[m + (k - 1) * lda]; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; // // Solve R * Z = W. // for (k = n; 1 <= k; k--) { if (abd[m + (k - 1) * lda].Real < typeMethods.zabs1(z[k - 1])) { s = abd[m + (k - 1) * lda].Real / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 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]; BLAS1Z.zaxpy(lm, t, abd, 1, ref z, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1); } // // Make ZNORM = 1. // s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; if (anorm != 0.0) { rcond = ynorm / anorm; } else { rcond = 0.0; } return(rcond); }
public static double ztrco(Complex[] t, int ldt, int n, int job) //****************************************************************************80 // // Purpose: // // ZTRCO estimates the condition of a complex triangular matrix. // // Licensing: // // This code is distributed under the GNU LGPL license. // // Modified: // // 21 May 2006 // // Author: // // 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. // // Parameters: // // Input, Complex 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 T. // // Input, int N, the order of the matrix. // // Input, int JOB, indicates if matrix is upper or lower triangular. // 0, lower triangular. // nonzero, upper triangular. // // Output, double ZTRCO, an estimate of RCOND, the reciprocal condition 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.0 + RCOND == 1.0 // is true, then T may be singular to working precision. In particular, // RCOND is zero if exact singularity is detected or the estimate // underflows. // // Local Parameters: // // Workspace, Complex 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). // { int i; int i1; int j; int k; int kk; double rcond; double s; Complex w; bool lower = job == 0; // // Compute 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, BLAS1Z.dzasum(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 hermitian(T)*Y = E. // // Hermitian(T) is the Complex.Conjugateugate 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 hermitian(T)*Y = E. // Complex ek = new(1.0, 0.0); Complex[] z = new Complex[n]; for (i = 0; i < n; i++) { z[i] = new Complex(0.0, 0.0); } for (kk = 1; kk <= n; kk++) { k = lower switch { true => n + 1 - kk, _ => kk }; if (typeMethods.zabs1(z[k - 1]) != 0.0) { ek = typeMethods.zsign1(ek, -z[k - 1]); } if (typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) < typeMethods.zabs1(ek - z[k - 1])) { s = typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) / typeMethods.zabs1(ek - z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ek = new Complex(s, 0.0) * ek; } Complex wk = ek - z[k - 1]; Complex wkm = -ek - z[k - 1]; s = typeMethods.zabs1(wk); double sm = typeMethods.zabs1(wkm); if (typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) != 0.0) { wk /= Complex.Conjugate(t[k - 1 + (k - 1) * ldt]); wkm /= Complex.Conjugate(t[k - 1 + (k - 1) * ldt]); } else { wk = new Complex(1.0, 0.0); wkm = new Complex(1.0, 0.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 += typeMethods.zabs1(z[j - 1] + wkm * Complex.Conjugate(t[k - 1 + (j - 1) * ldt])); z[j - 1] += wk * Complex.Conjugate(t[k - 1 + (j - 1) * ldt]); s += typeMethods.zabs1(z[j - 1]); } if (s < sm) { w = wkm - wk; wk = wkm; for (j = j1; j <= j2; j++) { z[j - 1] += w * Complex.Conjugate(t[k - 1 + (j - 1) * ldt]); } } } z[k - 1] = wk; } s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); double ynorm = 1.0; // // Solve T*Z = Y. // for (kk = 1; kk <= n; kk++) { k = lower switch { true => kk, _ => n + 1 - kk }; if (typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) < typeMethods.zabs1(z[k - 1])) { s = typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) / typeMethods.zabs1(z[k - 1]); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; } if (typeMethods.zabs1(t[k - 1 + (k - 1) * ldt]) != 0.0) { z[k - 1] /= t[k - 1 + (k - 1) * ldt]; } else { z[k - 1] = new Complex(1.0, 0.0); } i1 = lower switch { true => k + 1, _ => 1 }; if (kk >= n) { continue; } w = -z[k - 1]; BLAS1Z.zaxpy(n - kk, w, t, 1, ref z, 1, xIndex: +i1 - 1 + (k - 1) * ldt, yIndex: +i1 - 1); } // // Make ZNORM = 1. // s = 1.0 / BLAS1Z.dzasum(n, z, 1); BLAS1Z.zdscal(n, s, ref z, 1); ynorm = s * ynorm; if (tnorm != 0.0) { rcond = ynorm / tnorm; } else { rcond = 0.0; } return(rcond); } }