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 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 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 int dsifa(ref double[] a, int lda, int n, ref int[] kpvt)
//****************************************************************************80
//
// Purpose:
//
// DSIFA factors a real symmetric matrix.
//
// Discussion:
//
// To solve A*X = B, follow DSIFA by DSISL.
//
// To compute inverse(A)*C, follow DSIFA by DSISL.
//
// To compute determinant(A), follow DSIFA by DSIDI.
//
// To compute inertia(A), follow DSIFA by DSIDI.
//
// To compute inverse(A), follow DSIFA by DSIDI.
//
// 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, the symmetric matrix
// to be factored. Only the diagonal and upper triangle are used.
// On output, a block diagonal matrix and the multipliers which
// were used to obtain it. The factorization can be written A = U*D*U'
// where U is a product of permutation and unit upper triangular
// matrices, U' is the transpose of U, and D is block diagonal
// with 1 by 1 and 2 by 2 blocks.
//
// Input, int LDA, the leading dimension of the array A.
//
// Input, int N, the order of the matrix.
//
// Output, int KPVT[N], the pivot indices.
//
// Output, integer DSIFA, 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 DSISL
// or DSIDI may divide by zero if called.
//
{
//
// 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;
while (0 < k)
{
switch (k)
{
case 1:
{
kpvt[0] = 1;
info = a[0 + 0 * lda] switch
{
0.0 => 1,
_ => info
};
return(info);
}
}
//
// 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.
//
double absakk = Math.Abs(a[k - 1 + (k - 1) * lda]);
//
// Determine the largest off-diagonal element in column K.
//
int imax = BLAS1D.idamax(k - 1, a, 1, index: +0 + (k - 1) * lda);
double colmax = Math.Abs(a[imax - 1 + (k - 1) * lda]);
int j;
int kstep;
bool swap;
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;
for (j = imaxp1; j <= k; j++)
{
rowmax = Math.Max(rowmax, Math.Abs(a[imax - 1 + (j - 1) * lda]));
}
if (imax != 1)
{
int jmax = BLAS1D.idamax(imax - 1, a, 1, index: +0 + (imax - 1) * lda);
rowmax = Math.Max(rowmax, Math.Abs(a[jmax - 1 + (imax - 1) * lda]));
}
if (alpha * rowmax <= Math.Abs(a[imax - 1 + (imax - 1) * lda]))
{
kstep = 1;
swap = true;
}
else if (alpha * colmax * (colmax / rowmax) <= absakk)
{
kstep = 1;
swap = false;
}
else
{
kstep = 2;
swap = imax != k - 1;
}
}
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:
{
int jj;
double mulk;
double t;
if (kstep != 2)
{
switch (swap)
{
case true:
{
BLAS1D.dswap(imax, ref a, 1, ref a, 1, xIndex: +0 + (imax - 1) * lda,
yIndex: +0 + (k - 1) * lda);
for (jj = imax; jj <= k; jj++)
{
j = k + imax - jj;
t = a[j - 1 + (k - 1) * lda];
a[j - 1 + (k - 1) * lda] = a[imax - 1 + (j - 1) * lda];
a[imax - 1 + (j - 1) * lda] = t;
}
break;
}
}
//
// Perform the elimination.
//
for (jj = 1; jj <= k - 1; jj++)
{
j = k - jj;
mulk = -a[j - 1 + (k - 1) * lda] / a[k - 1 + (k - 1) * lda];
t = mulk;
BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
a[j - 1 + (k - 1) * lda] = mulk;
}
kpvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => imax,
_ => k
};
}
//
// 2 x 2 pivot block.
//
// Perform an interchange.
//
else
{
switch (swap)
{
case true:
{
BLAS1D.dswap(imax, ref a, 1, ref a, 1, xIndex: +0 + (imax - 1) * lda,
yIndex: +0 + (k - 2) * lda);
for (jj = imax; jj <= k - 1; jj++)
{
j = k - 1 + imax - jj;
t = a[j - 1 + (k - 1) * lda];
a[j - 1 + (k - 1) * lda] = a[imax - 1 + (j - 1) * lda];
a[imax - 1 + (j - 1) * lda] = t;
}
t = a[k - 2 + (k - 1) * lda];
a[k - 2 + (k - 1) * lda] = a[imax - 1 + (k - 1) * lda];
a[imax - 1 + (k - 1) * lda] = t;
break;
}
}
//
// Perform the elimination.
//
if (k - 2 != 0)
{
double ak = a[k - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
double akm1 = a[k - 2 + (k - 2) * lda] / a[k - 2 + (k - 1) * lda];
double denom = 1.0 - ak * akm1;
for (jj = 1; jj <= k - 2; jj++)
{
j = k - 1 - jj;
double bk = a[j - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
double bkm1 = a[j - 1 + (k - 2) * lda] / a[k - 2 + (k - 1) * lda];
mulk = (akm1 * bk - bkm1) / denom;
double mulkm1 = (ak * bkm1 - bk) / denom;
t = mulk;
BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
t = mulkm1;
BLAS1D.daxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 2) * lda, yIndex: +0 + (j - 1) * lda);
a[j - 1 + (k - 1) * lda] = mulk;
a[j - 1 + (k - 2) * lda] = mulkm1;
}
}
kpvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => - imax,
_ => 1 - k
};
kpvt[k - 2] = kpvt[k - 1];
}
break;
}
}
k -= kstep;
}
return(info);
}
}