private static void drotg_test()
//****************************************************************************80
//
// Purpose:
//
// DROTG_TEST tests DROTG.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
double c = 0;
double s = 0;
int test_num = 5;
Console.WriteLine("");
Console.WriteLine("DROTG_TEST");
Console.WriteLine(" DROTG generates a real Givens rotation");
Console.WriteLine(" ( C S ) * ( A ) = ( R )");
Console.WriteLine(" ( -S C ) ( B ) ( 0 )");
Console.WriteLine("");
int seed = 123456789;
for (int test = 1; test <= test_num; test++)
{
double a = UniformRNG.r8_uniform_01(ref seed);
double b = UniformRNG.r8_uniform_01(ref seed);
double sa = a;
double sb = b;
BLAS1D.drotg(ref sa, ref sb, ref c, ref s);
double r = sa;
double z = sb;
Console.WriteLine("");
Console.WriteLine(" A = " + a + " B = " + b + "");
Console.WriteLine(" C = " + c + " S = " + s + "");
Console.WriteLine(" R = " + r + " Z = " + z + "");
Console.WriteLine(" C*A+S*B = " + (c * a + s * b) + "");
Console.WriteLine(" -S*A+C*B = " + (-s * a + c * b) + "");
}
}
private static void idamax_test()
//****************************************************************************80
//
// Purpose:
//
// IDAMAX_TEST demonstrates IDAMAX.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 February 2006
//
// Author:
//
// John Burkardt
//
{
int N = 11;
double[] x = new double[N];
Console.WriteLine("");
Console.WriteLine("IDAMAX_TEST");
Console.WriteLine(" IDAMAX returns the index of maximum magnitude;");
for (int i = 1; i <= N; i++)
{
x[i - 1] = 7 * i % 11 - (double)(N / 2);
}
Console.WriteLine("");
Console.WriteLine(" The vector X:");
Console.WriteLine("");
for (int i = 1; i <= N; i++)
{
Console.WriteLine(" " + i.ToString(CultureInfo.InvariantCulture).PadLeft(6)
+ " " + x[i - 1].ToString(CultureInfo.InvariantCulture).PadLeft(8) + "");
}
int incx = 1;
int i1 = BLAS1D.idamax(N, x, incx);
Console.WriteLine("");
Console.WriteLine(" The index of maximum magnitude = " + i1 + "");
}
public static void dchex(ref double[] r, int ldr, int p, int k, int l, ref double[] z, int ldz,
int nz, ref double[] c, ref double[] s, int job)
//****************************************************************************80
//
// Purpose:
//
// DCHEX updates the Cholesky factorization of a positive definite matrix.
//
// Discussion:
//
// The factorization has the form
//
// A = R' * R
//
// where A is a positive definite matrix of order P.
//
// The updating involves diagonal permutations of the form
//
// E' * A * E
//
// where E is a permutation matrix. Specifically, given
// an upper triangular matrix R and a permutation matrix
// E (which is specified by K, L, and JOB), DCHEX determines
// an orthogonal matrix U such that
//
// U * R * E = RR,
//
// where RR is upper triangular. At the user's option, the
// transformation U will be multiplied into the array Z.
// If A = X'*X, so that R is the triangular part of the
// QR factorization of X, then RR is the triangular part of the
// QR factorization of X*E, that is, X with its columns permuted.
//
// For a less terse description of what DCHEX does and how
// it may be applied, see the LINPACK guide.
//
// The matrix Q is determined as the product U(L-K)*...*U(1)
// of plane rotations of the form
//
// ( C(I) S(I) )
// ( ),
// ( -S(I) C(I) )
//
// where C(I) is real, the rows these rotations operate on
// are described below.
//
// There are two types of permutations, which are determined
// by the value of JOB.
//
// 1, right circular shift. The columns are rearranged in the order:
//
// 1,...,K-1,L,K,K+1,...,L-1,L+1,...,P.
//
// U is the product of L-K rotations U(I), where U(I)
// acts in the (L-I,L-I+1)-plane.
//
// 2, left circular shift: the columns are rearranged in the order
//
// 1,...,K-1,K+1,K+2,...,L,K,L+1,...,P.
//
// U is the product of L-K rotations U(I), where U(I)
// acts in the (K+I-1,K+I)-plane.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 June 2009
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double R[LDR*P]. On input, the upper
// triangular factor that is to be updated. Elements of R below the
// diagonal are not referenced. On output, R has been updated.
//
// Input, int LDR, the leading dimension of the array R.
// LDR must be at least P.
//
// Input, int P, the order of the matrix R.
//
// Input, int K, the first column to be permuted.
//
// Input, int L, the last column to be permuted.
// L must be strictly greater than K.
//
// Input/output double Z[LDZ*NZ], an array of NZ P-vectors into
// which the transformation U is multiplied. Z is not referenced if NZ = 0.
// On output, Z has been updated.
//
// Input, int LDZ, the leading dimension of the array Z.
// LDZ must be at least P.
//
// Input, int NZ, the number of columns of the matrix Z.
//
// Output, double C[P], S[P], the cosines and sines of the
// transforming rotations.
//
// Input, int JOB, determines the type of permutation.
// 1, right circular shift.
// 2, left circular shift.
//
{
int i;
int ii;
int j;
int jj;
double t;
//
// Initialize
//
int lmk = l - k;
int lm1 = l - 1;
switch (job)
{
//
// Right circular shift.
//
case 1:
{
//
// Reorder the columns.
//
for (i = 1; i <= l; i++)
{
ii = l - i + 1;
s[i - 1] = r[ii - 1 + (l - 1) * ldr];
}
for (jj = k; jj <= lm1; jj++)
{
j = lm1 - jj + k;
for (i = 1; i <= j; i++)
{
r[i - 1 + j * ldr] = r[i - 1 + (j - 1) * ldr];
}
r[j + j * ldr] = 0.0;
}
for (i = 1; i <= k - 1; i++)
{
ii = l - i + 1;
r[i - 1 + (k - 1) * ldr] = s[ii - 1];
}
//
// Calculate the rotations.
//
t = s[0];
for (i = 1; i <= lmk; i++)
{
BLAS1D.drotg(ref s[i], ref t, ref c[i - 1], ref s[i - 1]);
t = s[i];
}
r[k - 1 + (k - 1) * ldr] = t;
for (j = k + 1; j <= p; j++)
{
int il = Math.Max(1, l - j + 1);
for (ii = il; ii <= lmk; ii++)
{
i = l - ii;
t = c[ii - 1] * r[i - 1 + (j - 1) * ldr] + s[ii - 1] * r[i + (j - 1) * ldr];
r[i + (j - 1) * ldr] = c[ii - 1] * r[i + (j - 1) * ldr] - s[ii - 1] * r[i - 1 + (j - 1) * ldr];
r[i - 1 + (j - 1) * ldr] = t;
}
}
//
// If required, apply the transformations to Z.
//
for (j = 1; j <= nz; j++)
{
for (ii = 1; ii <= lmk; ii++)
{
i = l - ii;
t = c[ii - 1] * z[i - 1 + (j - 1) * ldr] + s[ii - 1] * z[i + (j - 1) * ldr];
z[i + (j - 1) * ldr] = c[ii - 1] * z[i + (j - 1) * ldr] - s[ii - 1] * z[i - 1 + (j - 1) * ldr];
z[i - 1 + (j - 1) * ldr] = t;
}
}
break;
}
//
default:
{
//
// Reorder the columns.
//
for (i = 1; i <= k; i++)
{
ii = lmk + i;
s[ii - 1] = r[i - 1 + (k - 1) * ldr];
}
for (j = k; j <= lm1; j++)
{
for (i = 1; i <= j; i++)
{
r[i - 1 + (j - 1) * ldr] = r[i - 1 + j * ldr];
}
jj = j - k + 1;
s[jj - 1] = r[j + j * ldr];
}
for (i = 1; i <= k; i++)
{
ii = lmk + i;
r[i - 1 + (l - 1) * ldr] = s[ii - 1];
}
for (i = k + 1; i <= l; i++)
{
r[i - 1 + (l - 1) * ldr] = 0.0;
}
//
// Reduction loop.
//
for (j = k; j <= p; j++)
{
//
// Apply the rotations.
//
if (j != k)
{
int iu = Math.Min(j - 1, l - 1);
for (i = k; i <= iu; i++)
{
ii = i - k + 1;
t = c[ii - 1] * r[i - 1 + (j - 1) * ldr] + s[ii - 1] * r[i + (j - 1) * ldr];
r[i + (j - 1) * ldr] = c[ii - 1] * r[i + (j - 1) * ldr]
- s[ii - 1] * r[i - 1 + (j - 1) * ldr];
r[i - 1 + (j - 1) * ldr] = t;
}
}
if (j >= l)
{
continue;
}
jj = j - k + 1;
t = s[jj - 1];
BLAS1D.drotg(ref r[j - 1 + (j - 1) * ldr], ref t, ref c[jj - 1], ref s[jj - 1]);
}
//
// Apply the rotations to Z.
//
for (j = 1; j <= nz; j++)
{
for (i = k; i <= lm1; i++)
{
ii = i - k + 1;
t = c[ii - 1] * z[i - 1 + (j - 1) * ldr] + s[ii - 1] * z[i + (j - 1) * ldr];
z[i + (j - 1) * ldr] = c[ii - 1] * z[i + (j - 1) * ldr] - s[ii - 1] * z[i - 1 + (j - 1) * ldr];
z[i - 1 + (j - 1) * ldr] = t;
}
}
break;
}
}
}
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 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 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);
}
public static int dgefa(ref double[] a, int lda, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// DGEFA factors a real general matrix.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 16 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double A[LDA*N].
// On intput, the matrix to be factored.
// On output, an upper triangular matrix and the multipliers used to obtain
// it. The factorization can be written A=L*U, where L is a product of
// permutation and unit lower triangular matrices, and U is upper triangular.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix A.
//
// Output, int IPVT[N], the pivot indices.
//
// Output, int DGEFA, singularity indicator.
// 0, normal value.
// K, if U(K,K) == 0. This is not an error condition for this subroutine,
// but it does indicate that DGESL or DGEDI will divide by zero if called.
// Use RCOND in DGECO for a reliable indication of singularity.
//
{
int k;
//
// Gaussian elimination with partial pivoting.
//
int info = 0;
for (k = 1; k <= n - 1; k++)
{
//
// Find L = pivot index.
//
int l = BLAS1D.idamax(n - k + 1, a, 1, index: +(k - 1) + (k - 1) * lda) + k - 1;
ipvt[k - 1] = l;
switch (a[l - 1 + (k - 1) * lda])
{
//
// Zero pivot implies this column already triangularized.
//
case 0.0:
info = k;
continue;
}
//
// Interchange if necessary.
//
double t;
if (l != k)
{
t = a[l - 1 + (k - 1) * lda];
a[l - 1 + (k - 1) * lda] = a[k - 1 + (k - 1) * lda];
a[k - 1 + (k - 1) * lda] = t;
}
//
// Compute multipliers.
//
t = -1.0 / a[k - 1 + (k - 1) * lda];
BLAS1D.dscal(n - k, t, ref a, 1, index: +k + (k - 1) * lda);
//
// Row elimination with column indexing.
//
int j;
for (j = k + 1; j <= n; j++)
{
t = a[l - 1 + (j - 1) * lda];
if (l != k)
{
a[l - 1 + (j - 1) * lda] = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = t;
}
BLAS1D.daxpy(n - k, t, a, 1, ref a, 1, xIndex: +k + (k - 1) * lda, yIndex: +k + (j - 1) * lda);
}
}
ipvt[n - 1] = n;
info = a[n - 1 + (n - 1) * lda] switch
{
0.0 => n,
_ => info
};
return(info);
}
}
public static int r8po_fa(ref double[] a, int lda, int n)
//****************************************************************************80
//
// Purpose:
//
// R8PO_FA factors a real symmetric positive definite matrix.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// FORTRAN77 original version by Dongarra, Moler, Bunch, Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Dongarra, Moler, Bunch and 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, int R8PO_FA, error flag.
// 0, for normal return.
// K, signals an error condition. The leading minor of order K is not
// positive definite.
//
{
int info;
int j;
for (j = 1; j <= n; j++)
{
double s = 0.0;
int k;
for (k = 1; k <= j - 1; k++)
{
double t = a[k - 1 + (j - 1) * lda] -
BLAS1D.ddot(k - 1, a, 1, a, 1, +0 + (k - 1) * lda, +0 + (j - 1) * lda);
t /= a[k - 1 + (k - 1) * lda];
a[k - 1 + (j - 1) * lda] = t;
s += t * t;
}
s = a[j - 1 + (j - 1) * lda] - s;
switch (s)
{
case <= 0.0:
info = j;
return(info);
default:
a[j - 1 + (j - 1) * lda] = Math.Sqrt(s);
break;
}
}
info = 0;
return(info);
}
public static void dposl(double[] a, int lda, int n, ref double[] b)
//****************************************************************************80
//
// Purpose:
//
// DPOSL solves a linear system factored by DPOCO or DPOFA.
//
// Discussion:
//
// To compute inverse(A) * C where C is a matrix with P columns:
//
// call dpoco ( a, lda, n, rcond, z, info )
//
// if ( rcond is not too small .and. info == 0 ) then
// do j = 1, p
// call dposl ( a, lda, n, c(1,j) )
// end do
// end if
//
// A division by zero will occur if the input factor contains
// a zero on the diagonal. Technically this indicates
// singularity but it is usually caused by improper subroutine
// arguments. It will not occur if the subroutines are called
// correctly and INFO == 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input, double A[LDA*N], the output from DPOCO or DPOFA.
//
// Input, int LDA, the leading dimension of the array A.
//
// Input, int N, the order of the matrix.
//
// Input/output, double B[N]. On input, the right hand side.
// On output, the solution.
//
{
int k;
double t;
//
// Solve R' * Y = B.
//
for (k = 1; k <= n; k++)
{
t = BLAS1D.ddot(k - 1, a, 1, b, 1, xIndex: +0 + (k - 1) * lda);
b[k - 1] = (b[k - 1] - t) / a[k - 1 + (k - 1) * lda];
}
//
// Solve R * X = Y.
//
for (k = n; 1 <= k; k--)
{
b[k - 1] /= a[k - 1 + (k - 1) * lda];
t = -b[k - 1];
BLAS1D.daxpy(k - 1, t, a, 1, ref b, 1, xIndex: +0 + (k - 1) * lda);
}
}
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) + "");
}
private static void drot_test()
//****************************************************************************80
//
// Purpose:
//
// DROT_TEST tests DROT.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
const int N = 6;
double[] x = new double[N];
double[] y = new double[N];
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = (i + 1) * (i + 1) - 12;
}
Console.WriteLine("");
Console.WriteLine("DROT_TEST");
Console.WriteLine(" DROT carries out a Givens rotation.");
Console.WriteLine("");
Console.WriteLine(" X and Y");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
double c = 0.5;
double s = Math.Sqrt(1.0 - c * c);
BLAS1D.drot(N, ref x, 1, ref y, 1, c, s);
Console.WriteLine("");
Console.WriteLine(" DROT ( N, X, 1, Y, 1, " + c + "," + s + " )");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = (i + 1) * (i + 1) - 12;
}
c = x[0] / Math.Sqrt(x[0] * x[0] + y[0] * y[0]);
s = y[0] / Math.Sqrt(x[0] * x[0] + y[0] * y[0]);
BLAS1D.drot(N, ref x, 1, ref y, 1, c, s);
Console.WriteLine("");
Console.WriteLine(" DROT ( N, X, 1, Y, 1, " + c + "," + s + " )");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
}
private static void ddot_test()
//****************************************************************************80
//
// Purpose:
//
// DDOT_TEST demonstrates DDOT.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
const int N = 5;
const int LDA = 10;
const int LDB = 7;
const int LDC = 6;
double[] a = new double[LDA * LDA];
double[] b = new double[LDB * LDB];
double[] c = new double[LDC * LDC];
double[] x = new double[N];
double[] y = new double[N];
Console.WriteLine("");
Console.WriteLine("DDOT_TEST");
Console.WriteLine(" DDOT computes the dot product of vectors.");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = -(double)(i + 1);
}
for (int i = 0; i < N; i++)
{
for (int j = 0; j < N; j++)
{
a[i + j * LDA] = i + 1 + j + 1;
}
}
for (int i = 0; i < N; i++)
{
for (int j = 0; j < N; j++)
{
b[i + j * LDB] = i + 1 - (j + 1);
}
}
double sum1 = BLAS1D.ddot(N, x, 1, y, 1);
Console.WriteLine("");
Console.WriteLine(" Dot product of X and Y is " + sum1 + "");
//
// To multiply a ROW of a matrix A times a vector X, we need to
// specify the increment between successive entries of the row of A:
//
sum1 = BLAS1D.ddot(N, a, LDA, x, 1, 1);
Console.WriteLine("");
Console.WriteLine(" Product of row 2 of A and X is " + sum1 + "");
//
// Product of a column of A and a vector is simpler:
//
sum1 = BLAS1D.ddot(N, a, 1, x, 1, +0 + 1 * LDA);
Console.WriteLine("");
Console.WriteLine(" Product of column 2 of A and X is " + sum1 + "");
//
// Here's how matrix multiplication, c = a*b, could be done
// with DDOT:
//
for (int i = 0; i < N; i++)
{
for (int j = 0; j < N; j++)
{
c[i + j * LDC] = BLAS1D.ddot(N, a, LDA, b, 1, +i, +0 + j * LDB);
}
}
Console.WriteLine("");
Console.WriteLine(" Matrix product computed with DDOT:");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
string cout = "";
for (int j = 0; j < N; j++)
{
cout += " " + c[i + j * LDC].ToString(CultureInfo.InvariantCulture).PadLeft(14);
}
Console.WriteLine(cout);
}
}
private static void dnrm2_test()
//****************************************************************************80
//
// Purpose:
//
// DNRM2_TEST demonstrates DNRM2.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
int N = 5;
int LDA = 10;
//
// These parameters illustrate the fact that matrices are typically
// dimensioned with more space than the user requires.
//
double[] a = new double[LDA * LDA];
double[] x = new double[N];
Console.WriteLine("");
Console.WriteLine("DNRM2_TEST");
Console.WriteLine(" DNRM2 computes the Euclidean norm of a vector.");
Console.WriteLine("");
//
// Compute the euclidean norm of a vector:
//
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
Console.WriteLine("");
Console.WriteLine(" X =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
Console.WriteLine("");
Console.WriteLine(" The 2-norm of X is " + BLAS1D.dnrm2(N, x, 1) + "");
//
// Compute the euclidean norm of a row or column of a matrix:
//
for (int i = 0; i < N; i++)
{
for (int j = 0; j < N; j++)
{
a[i + j * LDA] = i + 1 + j + 1;
}
}
Console.WriteLine("");
Console.WriteLine(" The 2-norm of row 2 of A is "
+ BLAS1D.dnrm2(N, a, LDA, +1) + "");
Console.WriteLine("");
Console.WriteLine(" The 2-norm of column 2 of A is "
+ BLAS1D.dnrm2(N, a, 1, +0 + 1 * LDA) + "");
}
private static void dcopy_test()
//****************************************************************************80
//
// Purpose:
//
// DCOPY_TEST demonstrates DCOPY.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
double[] a = new double[5 * 5];
double[] x = new double[10];
double[] y = new double[10];
Console.WriteLine("");
Console.WriteLine("DCOPY_TEST");
Console.WriteLine(" DCOPY copies one vector into another.");
Console.WriteLine("");
for (int i = 0; i < 10; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < 10; i++)
{
y[i] = 10 * (i + 1);
}
for (int i = 0; i < 5; i++)
{
for (int j = 0; j < 5; j++)
{
a[i + j * 5] = 10 * (i + 1) + j + 1;
}
}
Console.WriteLine("");
Console.WriteLine(" X =");
Console.WriteLine("");
for (int i = 0; i < 10; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < 10; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
Console.WriteLine("");
Console.WriteLine(" A =");
Console.WriteLine("");
for (int i = 0; i < 5; i++)
{
string cout = "";
for (int j = 0; j < 5; j++)
{
cout += " " + a[i + j * 5].ToString(CultureInfo.InvariantCulture).PadLeft(14);
}
Console.WriteLine(cout);
}
BLAS1D.dcopy(5, x, 1, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DCOPY ( 5, X, 1, Y, 1 )");
Console.WriteLine("");
for (int i = 0; i < 10; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < 10; i++)
{
y[i] = 10 * (i + 1);
}
BLAS1D.dcopy(3, x, 2, ref y, 3);
Console.WriteLine("");
Console.WriteLine(" DCOPY ( 3, X, 2, Y, 3 )");
Console.WriteLine("");
for (int i = 0; i < 10; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
BLAS1D.dcopy(5, x, 1, ref a, 1);
Console.WriteLine("");
Console.WriteLine(" DCOPY ( 5, X, 1, A, 1 )");
Console.WriteLine("");
Console.WriteLine(" A =");
Console.WriteLine("");
for (int i = 0; i < 5; i++)
{
string cout = "";
for (int j = 0; j < 5; j++)
{
cout += " " + a[i + j * 5].ToString(CultureInfo.InvariantCulture).PadLeft(14);
}
Console.WriteLine(cout);
}
for (int i = 0; i < 5; i++)
{
for (int j = 0; j < 5; j++)
{
a[i + j * 5] = 10 * (i + 1) + j + 1;
}
}
BLAS1D.dcopy(5, x, 2, ref a, 5);
Console.WriteLine("");
Console.WriteLine(" DCOPY ( 5, X, 2, A, 5 )");
Console.WriteLine("");
Console.WriteLine(" A =");
Console.WriteLine("");
for (int i = 0; i < 5; i++)
{
string cout = "";
for (int j = 0; j < 5; j++)
{
cout += " " + a[i + j * 5].ToString(CultureInfo.InvariantCulture).PadLeft(14);
}
Console.WriteLine(cout);
}
}
private static void daxpy_test()
//****************************************************************************80
//
// Purpose:
//
// DAXPY_TEST tests DAXPY.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
const int N = 6;
double[] x = new double[N];
double[] y = new double[N];
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
Console.WriteLine("");
Console.WriteLine("DAXPY_TEST");
Console.WriteLine(" DAXPY adds a multiple of vector X to vector Y.");
Console.WriteLine("");
Console.WriteLine(" X =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
double da = 1.0;
BLAS1D.daxpy(N, da, x, 1, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DAXPY ( N, " + da + ", X, 1, Y, 1 )");
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
da = -2.0;
BLAS1D.daxpy(N, da, x, 1, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DAXPY ( N, " + da + ", X, 1, Y, 1 )");
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
da = 3.0;
BLAS1D.daxpy(3, da, x, 2, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DAXPY ( 3, " + da + ", X, 2, Y, 1 )");
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
da = -4.0;
BLAS1D.daxpy(3, da, x, 1, ref y, 2);
Console.WriteLine("");
Console.WriteLine(" DAXPY ( 3, " + da + ", X, 1, Y, 2 )");
Console.WriteLine("");
Console.WriteLine(" Y =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
}
public static int dppfa(ref double[] ap, int n)
//****************************************************************************80
//
// Purpose:
//
// DPPFA factors a real symmetric positive definite matrix in packed form.
//
// Discussion:
//
// DPPFA is usually called by DPPCO, but it can be called
// directly with a saving in time if RCOND is not needed.
//
// Packed storage:
//
// The following program segment will pack the upper
// triangle of a symmetric matrix.
//
// k = 0
// do j = 1, n
// do i = 1, j
// k = k + 1
// ap(k) = a(i,j)
// end do
// end do
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 24 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double AP[N*(N+1)/2]. On input, the 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.
//
// Input, int N, the order of the matrix.
//
// Output, int DPPFA, error flag.
// 0, for normal return.
// K, if the leading minor of order K is not positive definite.
//
{
int j;
int info = 0;
int jj = 0;
for (j = 1; j <= n; j++)
{
double s = 0.0;
int kj = jj;
int kk = 0;
int k;
for (k = 1; k <= j - 1; k++)
{
kj += 1;
double t = ap[kj - 1] - BLAS1D.ddot(k - 1, ap, 1, ap, 1, xIndex: +kk, yIndex: +jj);
kk += k;
t /= ap[kk - 1];
ap[kj - 1] = t;
s += t * t;
}
jj += j;
s = ap[jj - 1] - s;
switch (s)
{
case <= 0.0:
info = j;
return(info);
default:
ap[jj - 1] = Math.Sqrt(s);
break;
}
}
return(info);
}
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 void dspdi(ref double[] ap, int n, int[] kpvt, ref double[] det, ref int[] inert,
double[] work, int job)
//****************************************************************************80
//
// Purpose:
//
// DSPDI computes the determinant, inertia and inverse of a real symmetric matrix.
//
// Discussion:
//
// DSPDI uses the factors from DSPFA, where the matrix is stored in
// packed form.
//
// A division by zero will occur if the inverse is requested
// and DSPCO has set RCOND == 0.0D+00 or DSPFA has set INFO /= 0.
//
// Variables not requested by JOB are not used.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 25 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double AP[(N*(N+1))/2]. On input, the output from
// DSPFA. On output, the upper triangle of the inverse of the original
// matrix, stored in packed form, if requested. The columns of the upper
// triangle are stored sequentially in a one-dimensional array.
//
// Input, int N, the order of the matrix.
//
// Input, int KPVT[N], the pivot vector from DSPFA.
//
// Output, double DET[2], the determinant of the original matrix,
// if requested.
// determinant = DET[0] * 10.0**DET[1]
// with 1.0D+00 <= abs ( DET[0] ) < 10.0D+00 or DET[0] = 0.0.
//
// Output, int INERT[3], the inertia of the original matrix, if requested.
// INERT(1) = number of positive eigenvalues.
// INERT(2) = number of negative eigenvalues.
// INERT(3) = number of zero eigenvalues.
//
// Workspace, double WORK[N].
//
// Input, int JOB, has the decimal expansion ABC where:
// if A /= 0, the inertia is computed,
// if B /= 0, the determinant is computed,
// if C /= 0, the inverse is computed.
// For example, JOB = 111 gives all three.
//
{
double d;
int ik;
int ikp1;
int k;
int kk;
int kkp1;
double t;
bool doinv = job % 10 != 0;
bool dodet = job % 100 / 10 != 0;
bool doert = job % 1000 / 100 != 0;
if (dodet || doert)
{
switch (doert)
{
case true:
inert[0] = 0;
inert[1] = 0;
inert[2] = 0;
break;
}
switch (dodet)
{
case true:
det[0] = 1.0;
det[1] = 0.0;
break;
}
t = 0.0;
ik = 0;
for (k = 1; k <= n; k++)
{
kk = ik + k;
d = ap[kk - 1];
switch (kpvt[k - 1])
{
//
// 2 by 2 block
// use det (d s) = (d/t * c - t) * t, t = abs ( s )
// (s c)
// to avoid underflow/overflow troubles.
//
// Take two passes through scaling. Use T for flag.
//
case <= 0 when t == 0.0:
ikp1 = ik + k;
kkp1 = ikp1 + k;
t = Math.Abs(ap[kkp1 - 1]);
d = d / t * ap[kkp1] - t;
break;
case <= 0:
d = t;
t = 0.0;
break;
}
switch (doert)
{
case true:
switch (d)
{
case > 0.0:
inert[0] += 1;
break;
case < 0.0:
inert[1] += 1;
break;
case 0.0:
inert[2] += 1;
break;
}
break;
}
switch (dodet)
{
case true:
{
det[0] *= d;
if (det[0] != 0.0)
{
while (Math.Abs(det[0]) < 1.0)
{
det[0] *= 10.0;
det[1] -= 1.0;
}
while (10.0 <= Math.Abs(det[0]))
{
det[0] /= 10.0;
det[1] += 1.0;
}
}
break;
}
}
ik += k;
}
}
switch (doinv)
{
//
// Compute inverse(A).
//
case true:
{
k = 1;
ik = 0;
while (k <= n)
{
int km1 = k - 1;
kk = ik + k;
ikp1 = ik + k;
kkp1 = ikp1 + k;
int kstep;
int jk;
int j;
int ij;
switch (kpvt[k - 1])
{
case >= 0:
{
//
// 1 by 1.
//
ap[kk - 1] = 1.0 / ap[kk - 1];
switch (k)
{
case >= 2:
{
BLAS1D.dcopy(k - 1, ap, 1, ref work, 1, xIndex: +ik);
ij = 0;
for (j = 1; j <= k - 1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1D.ddot(k - 1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 1;
break;
}
default:
{
//
// 2 by 2.
//
t = Math.Abs(ap[kkp1 - 1]);
double ak = ap[kk - 1] / t;
double akp1 = ap[kkp1] / t;
double akkp1 = ap[kkp1 - 1] / t;
d = t * (ak * akp1 - 1.0);
ap[kk - 1] = akp1 / d;
ap[kkp1] = ak / d;
ap[kkp1 - 1] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
BLAS1D.dcopy(km1, ap, 1, ref work, 1, xIndex: +ikp1);
ij = 0;
for (j = 1; j <= km1; j++)
{
int jkp1 = ikp1 + j;
ap[jkp1 - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ikp1);
ij += j;
}
ap[kkp1] += BLAS1D.ddot(km1, work, 1, ap, 1, yIndex: +ikp1);
ap[kkp1 - 1] += BLAS1D.ddot(km1, ap, 1, ap, 1, xIndex: +ik, yIndex: +ikp1);
BLAS1D.dcopy(km1, ap, 1, ref work, 1, xIndex: +ik);
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1D.ddot(j, ap, 1, work, 1, xIndex: +ij);
BLAS1D.daxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1D.ddot(km1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap.
//
int ks = Math.Abs(kpvt[k - 1]);
if (ks != k)
{
int iks = ks * (ks - 1) / 2;
BLAS1D.dswap(ks, ref ap, 1, ref ap, 1, xIndex: +iks, yIndex: +ik);
int ksj = ik + ks;
double temp;
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
jk = ik + j;
temp = ap[jk - 1];
ap[jk - 1] = ap[ksj - 1];
ap[ksj - 1] = temp;
ksj -= j - 1;
}
if (kstep != 1)
{
int kskp1 = ikp1 + ks;
temp = ap[kskp1 - 1];
ap[kskp1 - 1] = ap[kkp1 - 1];
ap[kkp1 - 1] = temp;
}
}
ik += k;
ik = kstep switch
{
2 => ik + k + 1,
_ => ik
};
k += kstep;
}
break;
}
}
}
}
public static void r8po_sl(double[] a, int lda, int n, ref double[] b, int aIndex = 0, int bIndex = 0)
//****************************************************************************80
//
// Purpose:
//
// R8PO_SL solves a linear system factored by R8PO_FA.
//
// Discussion:
//
// A division by zero will occur if the input factor contains
// a zero on the diagonal. Technically this indicates
// singularity but it is usually caused by improper subroutine
// arguments. It will not occur if the subroutines are called
// correctly and INFO == 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// FORTRAN77 original version by Dongarra, Moler, Bunch, Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Dongarra, Moler, Bunch and 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 A[LDA*N], the output from R8PO_FA.
//
// Input, int LDA, the leading dimension of the array A.
//
// Input, int N, the order of the matrix.
//
// Input/output, double B[N]. On input, the right hand side.
// On output, the solution.
//
{
int k;
double t;
//
// Solve R' * Y = B.
//
for (k = 1; k <= n; k++)
{
t = BLAS1D.ddot(k - 1, a, 1, b, 1, aIndex + 0 + (k - 1) * lda, bIndex);
b[bIndex + k - 1] = (b[bIndex + k - 1] - t) / a[aIndex + k - 1 + (k - 1) * lda];
}
//
// Solve R * X = Y.
//
for (k = n; 1 <= k; k--)
{
b[bIndex + k - 1] /= a[aIndex + k - 1 + (k - 1) * lda];
t = -b[bIndex + k - 1];
BLAS1D.daxpy(k - 1, t, a, 1, ref b, 1, aIndex + 0 + (k - 1) * lda, bIndex);
}
}
public static int dgbfa(ref double[] abd, int lda, int n, int ml, int mu, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// DGBFA factors a real band matrix by elimination.
//
// Discussion:
//
// DGBFA is usually called by DGBCO, but it can be called
// directly with a saving in time if RCOND is not needed.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double ABD[LDA*N]. On input, the matrix in band
// storage. The columns of the matrix are stored in the columns of ABD
// and the diagonals of the matrix are stored in rows ML+1 through
// 2*ML+MU+1 of ABD. On output, an upper triangular matrix in band storage
// and the multipliers which were used to obtain it. The factorization
// can be written A = L*U where L is a product of permutation and unit lower
// triangular matrices and U is upper triangular.
//
// Input, int LDA, the leading dimension of the array ABD.
// 2*ML + MU + 1 <= LDA is required.
//
// Input, int N, the order of the matrix.
//
// Input, int ML, MU, the number of diagonals below and above the
// main diagonal. 0 <= ML < N, 0 <= MU < N.
//
// Output, int IPVT[N], the pivot indices.
//
// Output, integer DGBFA, error flag.
// 0, normal value.
// K, if U(K,K) == 0.0D+00. This is not an error condition for this
// subroutine, but it does indicate that DGBSL will divide by zero if
// called. Use RCOND in DGBCO for a reliable indication of singularity.
//
{
int i;
int jz;
int k;
int m = ml + mu + 1;
int info = 0;
//
// Zero initial fill-in columns.
//
int j0 = mu + 2;
int j1 = Math.Min(n, m) - 1;
for (jz = j0; jz <= j1; jz++)
{
int i0 = m + 1 - jz;
for (i = i0; i <= ml; i++)
{
abd[i - 1 + (jz - 1) * lda] = 0.0;
}
}
jz = j1;
int ju = 0;
//
// Gaussian elimination with partial pivoting.
//
for (k = 1; k <= n - 1; k++)
{
//
// Zero out the next fill-in column.
//
jz += 1;
if (jz <= n)
{
for (i = 1; i <= ml; i++)
{
abd[i - 1 + (jz - 1) * lda] = 0.0;
}
}
//
// Find L = pivot index.
//
int lm = Math.Min(ml, n - k);
int l = BLAS1D.idamax(lm + 1, abd, 1, +m - 1 + (k - 1) * lda) + m - 1;
ipvt[k - 1] = l + k - m;
switch (abd[l - 1 + (k - 1) * lda])
{
//
// Zero pivot implies this column already triangularized.
//
case 0.0:
info = k;
break;
//
default:
{
double t;
if (l != m)
{
t = abd[l - 1 + (k - 1) * lda];
abd[l - 1 + (k - 1) * lda] = abd[m - 1 + (k - 1) * lda];
abd[m - 1 + (k - 1) * lda] = t;
}
//
// Compute multipliers.
//
t = -1.0 / abd[m - 1 + (k - 1) * lda];
BLAS1D.dscal(lm, t, ref abd, 1, +m + (k - 1) * lda);
//
// Row elimination with column indexing.
//
ju = Math.Min(Math.Max(ju, mu + ipvt[k - 1]), n);
int mm = m;
int j;
for (j = k + 1; j <= ju; j++)
{
l -= 1;
mm -= 1;
t = abd[l - 1 + (j - 1) * lda];
if (l != mm)
{
abd[l - 1 + (j - 1) * lda] = abd[mm - 1 + (j - 1) * lda];
abd[mm - 1 + (j - 1) * lda] = t;
}
BLAS1D.daxpy(lm, t, abd, 1, ref abd, 1, +m + (k - 1) * lda, +mm + (j - 1) * lda);
}
break;
}
}
}
ipvt[n - 1] = n;
info = abd[m - 1 + (n - 1) * lda] switch
{
0.0 => n,
_ => info
};
return(info);
}
}
public static int dspfa(ref double[] ap, int n, ref int[] kpvt)
//****************************************************************************80
//
// Purpose:
//
// DSPFA factors a real symmetric matrix stored in packed form.
//
// Discussion:
//
// To solve A*X = B, follow DSPFA by DSPSL.
//
// To compute inverse(A)*C, follow DSPFA by DSPSL.
//
// To compute determinant(A), follow DSPFA by DSPDI.
//
// To compute inertia(A), follow DSPFA by DSPDI.
//
// To compute inverse(A), follow DSPFA by DSPDI.
//
// Packed storage:
//
// The following program segment will pack the upper triangle of a
// symmetric matrix.
//
// k = 0
// do j = 1, n
// do i = 1, j
// k = k + 1
// ap(k) = a(i,j)
// end do
// end do
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 25 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double AP[(N*(N+1))/2]. On input, the packed form of a
// symmetric matrix A. The columns of the upper triangle are stored
// sequentially in a one-dimensional array. On output, a block diagonal
// matrix and the multipliers which were used to obtain it stored in
// packed form. The factorization can be written A = U*D*U' where U
// is a product of permutation and unit upper triangular matrices, U'
// is the transpose of U, and D is block diagonal with 1 by 1 and 2
// by 2 blocks.
//
// Input, int N, the order of the matrix.
//
// Output, int KPVT[N], the pivot indices.
//
// Output, int DSPFA, error flag.
// 0, normal value.
// K, if the K-th pivot block is singular. This is not an error
// condition for this subroutine, but it does indicate that DSPSL or
// DSPDI may divide by zero if called.
//
{
int im = 0;
//
// ALPHA is used in choosing pivot block size.
//
double alpha = (1.0 + Math.Sqrt(17.0)) / 8.0;
int info = 0;
//
// Main loop on K, which goes from N to 1.
//
int k = n;
int ik = n * (n - 1) / 2;
for (;;)
{
//
// Leave the loop if K = 0 or K = 1.
//
if (k == 0)
{
break;
}
if (k == 1)
{
kpvt[0] = 1;
info = ap[0] switch
{
0.0 => 1,
_ => info
};
break;
}
//
// This section of code determines the kind of elimination to be performed.
// When it is completed, KSTEP will be set to the size of the pivot block,
// and SWAP will be set to .true. if an interchange is required.
//
int km1 = k - 1;
int kk = ik + k;
double absakk = Math.Abs(ap[kk - 1]);
//
// Determine the largest off-diagonal element in column K.
//
int imax = BLAS1D.idamax(k - 1, ap, 1, index: +ik);
int imk = ik + imax;
double colmax = Math.Abs(ap[imk - 1]);
int kstep;
bool swap;
int j;
int imj;
if (alpha * colmax <= absakk)
{
kstep = 1;
swap = false;
}
//
// Determine the largest off-diagonal element in row IMAX.
//
else
{
double rowmax = 0.0;
int imaxp1 = imax + 1;
im = imax * (imax - 1) / 2;
imj = im + 2 * imax;
for (j = imaxp1; j <= k; j++)
{
rowmax = Math.Max(rowmax, Math.Abs(ap[imj - 1]));
imj += j;
}
if (imax != 1)
{
int jmax = BLAS1D.idamax(imax - 1, ap, 1, index: +im);
int jmim = jmax + im;
rowmax = Math.Max(rowmax, Math.Abs(ap[jmim - 1]));
}
int imim = imax + im;
if (alpha * rowmax <= Math.Abs(ap[imim - 1]))
{
kstep = 1;
swap = true;
}
else if (alpha * colmax * (colmax / rowmax) <= absakk)
{
kstep = 1;
swap = false;
}
else
{
kstep = 2;
swap = imax != km1;
}
}
switch (Math.Max(absakk, colmax))
{
//
// Column K is zero. Set INFO and iterate the loop.
//
case 0.0:
kpvt[k - 1] = k;
info = k;
break;
default:
{
double mulk;
int jk;
int jj;
double t;
int ij;
if (kstep != 2)
{
switch (swap)
{
//
// 1 x 1 pivot block.
//
case true:
{
//
// Perform an interchange.
//
BLAS1D.dswap(imax, ref ap, 1, ref ap, 1, xIndex: +im, yIndex: +ik);
imj = ik + imax;
for (jj = imax; jj <= k; jj++)
{
j = k + imax - jj;
jk = ik + j;
t = ap[jk - 1];
ap[jk - 1] = ap[imj - 1];
ap[imj - 1] = t;
imj -= j - 1;
}
break;
}
}
//
// Perform the elimination.
//
ij = ik - (k - 1);
for (jj = 1; jj <= km1; jj++)
{
j = k - jj;
jk = ik + j;
mulk = -ap[jk - 1] / ap[kk - 1];
t = mulk;
BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
ap[jk - 1] = mulk;
ij -= j - 1;
}
kpvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => imax,
_ => k
};
}
else
{
//
// 2 x 2 pivot block.
//
int km1k = ik + k - 1;
int ikm1 = ik - (k - 1);
int jkm1;
switch (swap)
{
//
// Perform an interchange.
//
case true:
{
BLAS1D.dswap(imax, ref ap, 1, ref ap, 1, xIndex: +im, yIndex: +ikm1);
imj = ikm1 + imax;
for (jj = imax; jj <= km1; jj++)
{
j = km1 + imax - jj;
jkm1 = ikm1 + j;
t = ap[jkm1 - 1];
ap[jkm1 - 1] = ap[imj - 1];
ap[imj - 1] = t;
imj -= j - 1;
}
t = ap[km1k - 1];
ap[km1k - 1] = ap[imk - 1];
ap[imk - 1] = t;
break;
}
}
//
// Perform the elimination.
//
if (k - 2 != 0)
{
double ak = ap[kk - 1] / ap[km1k - 1];
int km1km1 = ikm1 + k - 1;
double akm1 = ap[km1km1 - 1] / ap[km1k - 1];
double denom = 1.0 - ak * akm1;
ij = ik - (k - 1) - (k - 2);
for (jj = 1; jj <= k - 2; jj++)
{
j = km1 - jj;
jk = ik + j;
double bk = ap[jk - 1] / ap[km1k - 1];
jkm1 = ikm1 + j;
double bkm1 = ap[jkm1 - 1] / ap[km1k - 1];
mulk = (akm1 * bk - bkm1) / denom;
double mulkm1 = (ak * bkm1 - bk) / denom;
t = mulk;
BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
t = mulkm1;
BLAS1D.daxpy(j, t, ap, 1, ref ap, 1, xIndex: +ikm1, yIndex: +ij);
ap[jk - 1] = mulk;
ap[jkm1 - 1] = mulkm1;
ij -= j - 1;
}
}
kpvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => - imax,
_ => 1 - k
};
kpvt[k - 2] = kpvt[k - 1];
}
break;
}
}
ik -= k - 1;
switch (kstep)
{
case 2:
ik -= k - 2;
break;
}
k -= kstep;
}
return(info);
}
}
public static void dgesl(double[] a, int lda, int n, int[] ipvt, ref double[] b, int job)
//****************************************************************************80
//
// Purpose:
//
// DGESL solves a real general linear system A * X = B.
//
// Discussion:
//
// DGESL can solve either of the systems A * X = B or A' * X = B.
//
// The system matrix must have been factored by DGECO or DGEFA.
//
// A division by zero will occur if the input factor contains a
// zero on the diagonal. Technically this indicates singularity
// but it is often caused by improper arguments or improper
// setting of LDA. It will not occur if the subroutines are
// called correctly and if DGECO has set 0.0 < RCOND
// or DGEFA has set INFO == 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 16 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input, double A[LDA*N], the output from DGECO or DGEFA.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix A.
//
// Input, int IPVT[N], the pivot vector from DGECO or DGEFA.
//
// Input/output, double B[N].
// On input, the right hand side vector.
// On output, the solution vector.
//
// Input, int JOB.
// 0, solve A * X = B;
// nonzero, solve A' * X = B.
//
{
int k;
int l;
double t;
switch (job)
{
//
// Solve A * X = B.
//
case 0:
{
for (k = 1; k <= n - 1; k++)
{
l = ipvt[k - 1];
t = b[l - 1];
if (l != k)
{
b[l - 1] = b[k - 1];
b[k - 1] = t;
}
BLAS1D.daxpy(n - k, t, a, 1, ref b, 1, +k + (k - 1) * lda, +k);
}
for (k = n; 1 <= k; k--)
{
b[k - 1] /= a[k - 1 + (k - 1) * lda];
t = -b[k - 1];
BLAS1D.daxpy(k - 1, t, a, 1, ref b, 1, +0 + (k - 1) * lda);
}
break;
}
//
default:
{
for (k = 1; k <= n; k++)
{
t = BLAS1D.ddot(k - 1, a, 1, b, 1, +0 + (k - 1) * lda);
b[k - 1] = (b[k - 1] - t) / a[k - 1 + (k - 1) * lda];
}
for (k = n - 1; 1 <= k; k--)
{
b[k - 1] += BLAS1D.ddot(n - k, a, 1, b, 1, +k + (k - 1) * lda, +k);
l = ipvt[k - 1];
if (l == k)
{
continue;
}
t = b[l - 1];
b[l - 1] = b[k - 1];
b[k - 1] = t;
}
break;
}
}
}
public static void dppdi(ref double[] ap, int n, ref double[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// DPPDI computes the determinant and inverse of a matrix factored by DPPCO or DPPFA.
//
// Discussion:
//
// A division by zero will occur if the input factor contains
// a zero on the diagonal and the inverse is requested.
// It will not occur if the subroutines are called correctly
// and if DPOCO or DPOFA has set INFO == 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 24 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double AP[N*(N+1)/2]. On input, the output from
// DPPCO or DPPFA. On output, the upper triangular half of the
// inverse, if requested.
//
// Input, int N, the order of the matrix.
//
// Output, double DET[2], the determinant of the original matrix
// if requested.
// determinant = DET[0] * 10.0**DET[1]
// with 1.0D+00 <= DET[0] < 10.0D+00 or DET[0] == 0.0D+00.
//
// Input, int JOB, job request.
// 11, both determinant and inverse.
// 01, inverse only.
// 10, determinant only.
//
{
//
// Compute the determinant.
//
if (job / 10 != 0)
{
det[0] = 1.0;
det[1] = 0.0;
const double s = 10.0;
int ii = 0;
int i;
for (i = 1; i <= n; i++)
{
ii += i;
det[0] = det[0] * ap[ii - 1] * ap[ii - 1];
if (det[0] == 0.0)
{
break;
}
while (det[0] < 1.0)
{
det[0] *= s;
det[1] -= 1.0;
}
while (s <= det[0])
{
det[0] /= s;
det[1] += 1.0;
}
}
}
//
// Compute inverse(R).
//
if (job % 10 == 0)
{
return;
}
int kk = 0;
int k;
int k1;
int kj;
int j1;
double t;
int j;
for (k = 1; k <= n; k++)
{
k1 = kk + 1;
kk += k;
ap[kk - 1] = 1.0 / ap[kk - 1];
t = -ap[kk - 1];
BLAS1D.dscal(k - 1, t, ref ap, 1, index: +k1 - 1);
j1 = kk + 1;
kj = kk + k;
for (j = k + 1; j <= n; j++)
{
t = ap[kj - 1];
ap[kj - 1] = 0.0;
BLAS1D.daxpy(k, t, ap, 1, ref ap, 1, xIndex: +k1 - 1, yIndex: +j1 - 1);
j1 += j;
kj += j;
}
}
//
// Form inverse(R) * (inverse(R))'.
//
int jj = 0;
for (j = 1; j <= n; j++)
{
j1 = jj + 1;
jj += j;
k1 = 1;
kj = j1;
for (k = 1; k <= j - 1; k++)
{
t = ap[kj - 1];
BLAS1D.daxpy(k, t, ap, 1, ref ap, 1, xIndex: +j1 - 1, yIndex: +k1 - 1);
k1 += k;
kj += 1;
}
t = ap[jj - 1];
BLAS1D.dscal(j, t, ref ap, 1, index: +j1 - 1);
}
}
private static void dscal_test()
//****************************************************************************80
//
// Purpose:
//
// DSCAL_TEST tests DSCAL.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
int N = 6;
double[] x = new double[N];
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
Console.WriteLine("");
Console.WriteLine("DSCAL_TEST");
Console.WriteLine(" DSCAL multiplies a vector by a scalar.");
Console.WriteLine("");
Console.WriteLine(" X =");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
double da = 5.0;
BLAS1D.dscal(N, da, ref x, 1);
Console.WriteLine("");
Console.WriteLine(" DSCAL ( N, " + da + ", X, 1 )");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
da = -2.0;
BLAS1D.dscal(3, da, ref x, 2);
Console.WriteLine("");
Console.WriteLine(" DSCAL ( 3, " + da + ", X, 2 )");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
}
public static void dgbsl(double[] abd, int lda, int n, int ml, int mu, int[] ipvt,
ref double[] b, int job)
//****************************************************************************80
//
// Purpose:
//
// DGBSL solves a real banded system factored by DGBCO or DGBFA.
//
// Discussion:
//
// DGBSL can solve either A * X = B or A' * X = B.
//
// A division by zero will occur if the input factor contains a
// zero on the diagonal. Technically this indicates singularity
// but it is often caused by improper arguments or improper
// setting of LDA. It will not occur if the subroutines are
// called correctly and if DGBCO has set 0.0 < RCOND
// or DGBFA has set INFO == 0.
//
// To compute inverse(A) * C where C is a matrix with P columns:
//
// call dgbco ( abd, lda, n, ml, mu, ipvt, rcond, z )
//
// if ( rcond is too small ) then
// exit
// end if
//
// do j = 1, p
// call dgbsl ( abd, lda, n, ml, mu, ipvt, c(1,j), 0 )
// end do
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input, double ABD[LDA*N], the output from DGBCO or DGBFA.
//
// Input, integer LDA, the leading dimension of the array ABD.
//
// 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.
//
// Input, int IPVT[N], the pivot vector from DGBCO or DGBFA.
//
// Input/output, double B[N]. On input, the right hand side.
// On output, the solution.
//
// Input, int JOB, job choice.
// 0, solve A*X=B.
// nonzero, solve A'*X=B.
//
{
int k;
int l;
int la;
int lb;
int lm;
double t;
int m = mu + ml + 1;
switch (job)
{
//
// JOB = 0, Solve A * x = b.
//
// First solve L * y = b.
//
case 0:
{
switch (ml)
{
case > 0:
{
for (k = 1; k <= n - 1; k++)
{
lm = Math.Min(ml, n - k);
l = ipvt[k - 1];
t = b[l - 1];
if (l != k)
{
b[l - 1] = b[k - 1];
b[k - 1] = t;
}
BLAS1D.daxpy(lm, t, abd, 1, ref b, 1, +m + (k - 1) * lda, k);
}
break;
}
}
//
// Now solve U * x = y.
//
for (k = n; 1 <= k; k--)
{
b[k - 1] /= abd[m - 1 + (k - 1) * lda];
lm = Math.Min(k, m) - 1;
la = m - lm;
lb = k - lm;
t = -b[k - 1];
BLAS1D.daxpy(lm, t, abd, 1, ref b, 1, +la - 1 + (k - 1) * lda, +lb - 1);
}
break;
}
//
default:
{
for (k = 1; k <= n; k++)
{
lm = Math.Min(k, m) - 1;
la = m - lm;
lb = k - lm;
t = BLAS1D.ddot(lm, abd, 1, b, 1, +la - 1 + (k - 1) * lda, +lb - 1);
b[k - 1] = (b[k - 1] - t) / abd[m - 1 + (k - 1) * lda];
}
switch (ml)
{
//
// Now solve L' * x = y.
//
case > 0:
{
for (k = n - 1; 1 <= k; k--)
{
lm = Math.Min(ml, n - k);
b[k - 1] += BLAS1D.ddot(lm, abd, 1, b, 1, +m + (k - 1) * lda, +k);
l = ipvt[k - 1];
if (l == k)
{
continue;
}
t = b[l - 1];
b[l - 1] = b[k - 1];
b[k - 1] = t;
}
break;
}
}
break;
}
}
}
private static void dswap_test()
//****************************************************************************80
//
// Purpose:
//
// DSWAP_TEST tests DSWAP.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
int N = 6;
double[] x = new double[N];
double[] y = new double[N];
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
Console.WriteLine("");
Console.WriteLine("DSWAP_TEST");
Console.WriteLine(" DSWAP swaps two vectors.");
Console.WriteLine("");
Console.WriteLine(" X and Y:");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
BLAS1D.dswap(N, ref x, 1, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DSWAP ( N, X, 1, Y, 1 )");
Console.WriteLine("");
Console.WriteLine(" X and Y:");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
for (int i = 0; i < N; i++)
{
x[i] = i + 1;
}
for (int i = 0; i < N; i++)
{
y[i] = 100 * (i + 1);
}
BLAS1D.dswap(3, ref x, 2, ref y, 1);
Console.WriteLine("");
Console.WriteLine(" DSWAP ( 3, X, 2, Y, 1 )");
Console.WriteLine("");
Console.WriteLine(" X and Y:");
Console.WriteLine("");
for (int i = 0; i < N; i++)
{
Console.WriteLine(" "
+ (i + 1).ToString(CultureInfo.InvariantCulture).PadLeft(6) + " "
+ x[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + " "
+ y[i].ToString(CultureInfo.InvariantCulture).PadLeft(14) + "");
}
}
public static void dchud(ref double[] r, int ldr, int p, double[] x, ref double[] z, int ldz,
int nz, double[] y, ref double[] rho, ref double[] c, ref double[] s)
//****************************************************************************80
//
// Purpose:
//
// DCHUD updates an augmented Cholesky decomposition.
//
// Discussion:
//
// DCHUD can also update the triangular part of an augmented QR
// decomposition.
//
// Specifically, given an upper triangular matrix R of order P, a row vector
// X, a column vector Z, and a scalar Y, DCHUD determines a unitary matrix
// U and a scalar ZETA such that
//
// (R Z) (RR ZZ )
// U * ( ) = ( ),
// (X Y) ( 0 ZETA)
//
// where RR is upper triangular.
//
// If R and Z have been obtained from the factorization of a least squares
// problem, then RR and ZZ are the factors corresponding to the problem
// with the observation (X,Y) appended. In this case, if RHO is the
// norm of the residual vector, then the norm of the residual vector of
// the updated problem is sqrt ( RHO * RHO + ZETA * ZETA ). DCHUD will
// simultaneously update several triplets (Z, Y, RHO).
//
// For a less terse description of what DCHUD does and how
// it may be applied, see the LINPACK guide.
//
// The matrix U is determined as the product U(P)*...*U(1),
// where U(I) is a rotation in the (I,P+1) plane of the form
//
// ( C(I) S(I) )
// ( ).
// ( -S(I) C(I) )
//
// The rotations are chosen so that C(I) is real.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 08 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 R[LDR*P], the upper triangular matrix to be
// updated. The part of R below the diagonal is not referenced.
// On output, the matrix has been updated.
//
// Input, int LDR, the leading dimension of the array R.
// LDR must be at least equal to P.
//
// Input, int P, the order of the matrix R.
//
// Input, double X[P], the row to be added to R.
//
// Input/output, double Z[LDZ*NZ], contains NZ P-vectors
// to be updated with R.
//
// Input, int LDZ, the leading dimension of the array Z.
// LDZ must be at least P.
//
// Input, int NZ, the number of vectors to be updated. NZ may be
// zero, in which case Z, Y, and RHO are not referenced.
//
// Input, double Y[NZ], the scalars for updating the vectors Z.
//
// Input/output, double RHO[NZ]. On input, the norms of the
// residual vectors to be updated. If RHO(J) is negative, it is left
// unaltered.
//
// Output, double C[P], S[P], the cosines and sines of the
// transforming rotations.
//
{
int i;
int j;
double t;
//
// Update R.
//
for (j = 1; j <= p; j++)
{
double xj = x[j - 1];
//
// Apply the previous rotations.
//
for (i = 1; i <= j - 1; i++)
{
t = c[i - 1] * r[i - 1 + (j - 1) * ldz] + s[i - 1] * xj;
xj = c[i - 1] * xj - s[i - 1] * r[i - 1 + (j - 1) * ldz];
r[i - 1 + (j - 1) * ldz] = t;
}
//
// Compute the next rotation.
//
BLAS1D.drotg(ref r[j - 1 + (j - 1) * ldr], ref xj, ref c[j - 1], ref s[j - 1]);
}
//
// If required, update Z and RHO.
//
for (j = 1; j <= nz; j++)
{
double zeta = y[j - 1];
for (i = 1; i <= p; i++)
{
t = c[i - 1] * z[i - 1 + (j - 1) * ldz] + s[i - 1] * zeta;
zeta = c[i - 1] * zeta - s[i - 1] * z[i - 1 + (j - 1) * ldz];
z[i - 1 + (j - 1) * ldz] = t;
}
double azeta = Math.Abs(zeta);
if (azeta == 0.0 || !(0.0 <= rho[j - 1]))
{
continue;
}
double scale = azeta + rho[j - 1];
rho[j - 1] = scale * Math.Sqrt(
Math.Pow(azeta / scale, 2) + Math.Pow(rho[j - 1] / scale, 2));
}
}
public static int dtrdi(ref double[] t, int ldt, int n, ref double[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// DTRDI computes the determinant and inverse of a real triangular matrix.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 March 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double T[LDT*N].
// On input, T contains the triangular matrix. The zero elements of the
// matrix are not referenced, and the corresponding elements of the array
// can be used to store other information.
// On output, T contains the inverse matrix, if it was requested.
//
// Input, int LDT, the leading dimension of T.
//
// Input, int N, the order of the matrix.
//
// Output, double DET[2], the determinant of the matrix, if
// requested. The determinant = DET[0] * 10.0**DET[1], with
// 1.0 <= abs ( DET[0] ) < 10.0, or DET[0] == 0.
//
// Input, int JOB, specifies the shape of T, and the task.
// 010, inverse of lower triangular matrix.
// 011, inverse of upper triangular matrix.
// 100, determinant only.
// 110, determinant and inverse of lower triangular.
// 111, determinant and inverse of upper triangular.
//
// Output, int DTRDI.
// If the inverse was requested, then
// 0, if the system was nonsingular;
// nonzero, if the system was singular.
//
{
int j;
int k;
double temp;
//
// Determinant.
//
int info = 0;
if (job / 100 != 0)
{
det[0] = 1.0;
det[1] = 0.0;
int i;
for (i = 1; i <= n; i++)
{
det[0] *= t[i - 1 + (i - 1) * ldt];
if (det[0] == 0.0)
{
break;
}
while (Math.Abs(det[0]) < 1.0)
{
det[0] *= 10.0;
det[1] -= 1.0;
}
while (10.0 <= Math.Abs(det[0]))
{
det[0] /= 10.0;
det[1] += 1.0;
}
}
}
switch (job / 10 % 10)
{
case 0:
return(info);
}
//
// Inverse of an upper triangular matrix.
//
if (job % 10 != 0)
{
info = 0;
for (k = 1; k <= n; k++)
{
if (t[k - 1 + (k - 1) * ldt] == 0.0)
{
info = k;
break;
}
t[k - 1 + (k - 1) * ldt] = 1.0 / t[k - 1 + (k - 1) * ldt];
temp = -t[k - 1 + (k - 1) * ldt];
BLAS1D.dscal(k - 1, temp, ref t, 1, index: +0 + (k - 1) * ldt);
for (j = k + 1; j <= n; j++)
{
temp = t[k - 1 + (j - 1) * ldt];
t[k - 1 + (j - 1) * ldt] = 0.0;
BLAS1D.daxpy(k, temp, t, 1, ref t, 1, xIndex: +0 + (k - 1) * ldt, yIndex: +0 + (j - 1) * ldt);
}
}
}
//
// Inverse of a lower triangular matrix.
//
else
{
info = 0;
for (k = n; 1 <= k; k--)
{
if (t[k - 1 + (k - 1) * ldt] == 0.0)
{
info = k;
break;
}
t[k - 1 + (k - 1) * ldt] = 1.0 / t[k - 1 + (k - 1) * ldt];
temp = -t[k - 1 + (k - 1) * ldt];
if (k != n)
{
BLAS1D.dscal(n - k, temp, ref t, 1, index: +k + (k - 1) * ldt);
}
for (j = 1; j <= k - 1; j++)
{
temp = t[k - 1 + (j - 1) * ldt];
t[k - 1 + (j - 1) * ldt] = 0.0;
BLAS1D.daxpy(n - k + 1, temp, t, 1, ref t, 1, xIndex: +k - 1 + (k - 1) * ldt,
yIndex: +k - 1 + (j - 1) * ldt);
}
}
}
return(info);
}
public static void dpbsl(double[] abd, int lda, int n, int m, ref double[] b)
//****************************************************************************80
//
// Purpose:
//
// DPBSL solves a real SPD band system factored by DPBCO or DPBFA.
//
// Discussion:
//
// The matrix is assumed to be a symmetric positive definite (SPD)
// band matrix.
//
// To compute inverse(A) * C where C is a matrix with P columns:
//
// call dpbco ( abd, lda, n, rcond, z, info )
//
// if ( rcond is too small .or. info /= 0) go to ...
//
// do j = 1, p
// call dpbsl ( abd, lda, n, c(1,j) )
// end do
//
// A division by zero will occur if the input factor contains
// a zero on the diagonal. Technically this indicates
// singularity but it is usually caused by improper subroutine
// arguments. It will not occur if the subroutines are called
// correctly and INFO == 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 May 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input, double ABD[LDA*N], the output from DPBCO or DPBFA.
//
// Input, int LDA, the leading dimension of the array ABD.
//
// Input, int N, the order of the matrix.
//
// Input, int M, the number of diagonals above the main diagonal.
//
// Input/output, double B[N]. On input, the right hand side.
// On output, the solution.
//
{
int k;
int la;
int lb;
int lm;
double t;
//
// Solve R'*Y = B.
//
for (k = 1; k <= n; k++)
{
lm = Math.Min(k - 1, m);
la = m + 1 - lm;
lb = k - lm;
t = BLAS1D.ddot(lm, abd, 1, b, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1);
b[k - 1] = (b[k - 1] - t) / abd[m + (k - 1) * lda];
}
//
// Solve R*X = Y.
//
for (k = n; 1 <= k; k--)
{
lm = Math.Min(k - 1, m);
la = m + 1 - lm;
lb = k - lm;
b[k - 1] /= abd[m + (k - 1) * lda];
t = -b[k - 1];
BLAS1D.daxpy(lm, t, abd, 1, ref b, 1, xIndex: +la - 1 + (k - 1) * lda, yIndex: +lb - 1);
}
}
public static int dchdc(ref double[] a, int lda, int p, double[] work, ref int[] ipvt, int job)
//****************************************************************************80
//
// Purpose:
//
// DCHDC computes the Cholesky decomposition of a positive definite matrix.
//
// Discussion:
//
// A pivoting option allows the user to estimate the condition of a
// positive definite matrix or determine the rank of a positive
// semidefinite matrix.
//
// For positive definite matrices, INFO = P is the normal return.
//
// For pivoting with positive semidefinite matrices, INFO will
// in general be less than P. However, INFO may be greater than
// the rank of A, since rounding error can cause an otherwise zero
// element to be positive. Indefinite systems will always cause
// INFO to be less than P.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 June 2009
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// C++ version by John Burkardt.
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double A[LDA*P].
// On input, A contains the matrix whose decomposition is to
// be computed. Only the upper half of A need be stored.
// The lower part of the array a is not referenced.
// On output, A contains in its upper half the Cholesky factor
// of the input matrix, as it has been permuted by pivoting.
//
// Input, int LDA, the leading dimension of the array A.
//
// Input, int P, the order of the matrix.
//
// Input, double WORK[P] is a work array.
//
// Input/output, int IPVT[P].
// On input, IPVT contains integers that control the selection
// of the pivot elements, if pivoting has been requested.
// Each diagonal element A(K,K) is placed in one of three classes
// according to the value of IPVT(K).
//
// > 0, then X(K) is an initial element.
// = 0, then X(K) is a free element.
// < 0, then X(K) is a final element.
//
// Before the decomposition is computed, initial elements are moved by
// symmetric row and column interchanges to the beginning of the array A
// and final elements to the end. Both initial and final elements are
// frozen in place during the computation and only free elements are moved.
// At the K-th stage of the reduction, if A(K,K) is occupied by a free
// element, it is interchanged with the largest free element A(L,L) with
// K <= L. IPVT is not referenced if JOB is 0.
//
// On output, IPVT(J) contains the index of the diagonal element
// of A that was moved into the J-th position, if pivoting was requested.
//
// Input, int JOB, initiates column pivoting.
// 0, no pivoting is done.
// nonzero, pivoting is done.
//
// Output, int DCHDC, contains the index of the last positive diagonal
// element of the Cholesky factor.
//
{
int j;
int k;
double temp;
int pl = 1;
int pu = 0;
int info = p;
//
// Pivoting has been requested.
// Rearrange the the elements according to IPVT.
//
if (job != 0)
{
for (k = 1; k <= p; k++)
{
bool swapk = 0 < ipvt[k - 1];
bool negk = ipvt[k - 1] < 0;
ipvt[k - 1] = negk switch
{
true => - k,
_ => k
};
switch (swapk)
{
case true:
{
if (k != pl)
{
BLAS1D.dswap(pl - 1, ref a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (pl - 1) * lda);
temp = a[k - 1 + (k - 1) * lda];
a[k - 1 + (k - 1) * lda] = a[pl - 1 + (pl - 1) * lda];
a[pl - 1 + (pl - 1) * lda] = temp;
for (j = pl + 1; j <= p; j++)
{
if (j < k)
{
temp = a[pl - 1 + (j - 1) * lda];
a[pl - 1 + (j - 1) * lda] = a[j - 1 + (k - 1) * lda];
a[j - 1 + (k - 1) * lda] = temp;
}
else if (k < j)
{
temp = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = a[pl - 1 + (j - 1) * lda];
a[pl - 1 + (j - 1) * lda] = temp;
}
}
ipvt[k - 1] = ipvt[pl - 1];
ipvt[pl - 1] = k;
}
pl += 1;
break;
}
}
}
pu = p;
for (k = p; pl <= k; k--)
{
switch (ipvt[k - 1])
{
case < 0:
{
ipvt[k - 1] = -ipvt[k - 1];
if (pu != k)
{
BLAS1D.dswap(k - 1, ref a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (pu - 1) * lda);
temp = a[k - 1 + (k - 1) * lda];
a[k - 1 + (k - 1) * lda] = a[pu - 1 + (pu - 1) * lda];
a[pu - 1 + (pu - 1) * lda] = temp;
for (j = k + 1; j <= p; j++)
{
if (j < pu)
{
temp = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = a[j - 1 + (pu - 1) * lda];
a[j - 1 + (pu - 1) * lda] = temp;
}
else if (pu < j)
{
temp = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = a[pu - 1 + (j - 1) * lda];
a[pu - 1 + (j - 1) * lda] = temp;
}
}
(ipvt[k - 1], ipvt[pu - 1]) = (ipvt[pu - 1], ipvt[k - 1]);
}
pu -= 1;
break;
}
}
}
}
for (k = 1; k <= p; k++)
{
//
// Reduction loop.
//
double maxdia = a[k - 1 + (k - 1) * lda];
int maxl = k;
//
// Determine the pivot element.
//
if (pl <= k && k < pu)
{
int l;
for (l = k + 1; l <= pu; l++)
{
if (!(maxdia < a[l - 1 + (l - 1) * lda]))
{
continue;
}
maxdia = a[l - 1 + (l - 1) * lda];
maxl = l;
}
}
switch (maxdia)
{
//
// Quit if the pivot element is not positive.
//
case <= 0.0:
info = k - 1;
return(info);
}
//
// Start the pivoting and update IPVT.
//
if (k != maxl)
{
BLAS1D.dswap(k - 1, ref a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (maxl - 1) * lda);
a[maxl - 1 + (maxl - 1) * lda] = a[k - 1 + (k - 1) * lda];
a[k - 1 + (k - 1) * lda] = maxdia;
(ipvt[maxl - 1], ipvt[k - 1]) = (ipvt[k - 1], ipvt[maxl - 1]);
}
//
// Reduction step.
// Pivoting is contained across the rows.
//
work[k - 1] = Math.Sqrt(a[k - 1 + (k - 1) * lda]);
a[k - 1 + (k - 1) * lda] = work[k - 1];
for (j = k + 1; j <= p; j++)
{
if (k != maxl)
{
if (j < maxl)
{
temp = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = a[j - 1 + (maxl - 1) * lda];
a[j - 1 + (maxl - 1) * lda] = temp;
}
else if (maxl < j)
{
temp = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = a[maxl - 1 + (j - 1) * lda];
a[maxl - 1 + (j - 1) * lda] = temp;
}
}
a[k - 1 + (j - 1) * lda] /= work[k - 1];
work[j - 1] = a[k - 1 + (j - 1) * lda];
temp = -a[k - 1 + (j - 1) * lda];
BLAS1D.daxpy(j - k, temp, work, 1, ref a, 1, xIndex: +k, yIndex: +k + (j - 1) * lda);
}
}
return(info);
}
}
