public static double zhpco(ref Complex[] ap, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZHPCO factors a complex hermitian packed matrix and estimates its condition.
//
// Discussion:
//
// If RCOND is not needed, ZHPFA is slightly faster.
//
// To solve A*X = B, follow ZHPCO by ZHPSL.
//
// To compute inverse(A)*C, follow ZHPCO by ZHPSL.
//
// To compute inverse(A), follow ZHPCO by ZHPDI.
//
// To compute determinant(A), follow ZHPCO by ZHPDI.
//
// To compute inertia(A), follow ZHPCO by ZHPDI.
//
// 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 AP[N*(N+1)/2]; on input, the packed form of a
// hermitian matrix A. The columns of the upper triangle are stored
// sequentially in a one-dimensional array of length N*(N+1)/2. 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*hermitian(U) where U is a product of permutation and unit
// upper triangular matrices, hermitian(U) is the Complex.Conjugateugate 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 IPVT[N], the pivot indices.
//
// Output, double ZHPCO, 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.
//
// 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).
//
{
Complex ak;
Complex akm1;
Complex bk;
Complex bkm1;
Complex 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;
Complex t;
Complex[] z = new Complex [n];
//
// Find norm of A using only upper half.
//
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;
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.
//
ZHPFA.zhpfa(ref ap, n, ref ipvt);
//
// 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.
//
Complex ek = new(1.0, 0.0);
for (i = 0; i < n; i++)
{
z[i] = new Complex(0.0, 0.0);
}
int k = n;
int ik = n * (n - 1) / 2;
while (0 < k)
{
kk = ik + k;
ikm1 = ik - (k - 1);
ks = ipvt[k - 1] switch
{
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 zsico(ref Complex[] a, int lda, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZSICO factors a complex symmetric matrix.
//
// Discussion:
//
// The factorization is done by symmetric pivoting.
//
// The routine also estimates the condition of the matrix.
//
// If RCOND is not needed, ZSIFA is slightly faster.
//
// To solve A*X = B, follow ZSICO by ZSISL.
//
// To compute inverse(A)*C, follow ZSICO by ZSISL.
//
// To compute inverse(A), follow ZSICO by ZSIDI.
//
// To compute determinant(A), follow ZSICO by ZSIDI.
//
// 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 symmetric matrix to be
// factored. 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. Only the diagonal and upper triangle are used.
//
// 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 ZSICO, 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.
//
// 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).
//
{
Complex ak;
Complex akm1;
Complex bk;
Complex bkm1;
Complex denom;
int j;
int kp;
int kps;
int ks;
double rcond;
double s;
Complex t;
Complex[] z = new Complex [n];
//
// Find norm of A using only upper half.
//
for (j = 1; j <= n; j++)
{
z[j - 1] = new Complex(BLAS1Z.dzasum(j, a, 1, index: +0 + (j - 1) * lda), 0.0);
int i;
for (i = 1; i <= j - 1; i++)
{
z[i - 1] =
new Complex(z[i - 1].Real + typeMethods.zabs1(a[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.
//
ZSIFA.zsifa(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 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.
//
Complex ek = new(1.0, 0.0);
for (j = 0; j < n; j++)
{
z[j] = new Complex(0.0, 0.0);
}
int k = n;
while (0 < k)
{
ks = ipvt[k - 1] switch
{
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 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 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);
}
}
