public static int zgbfa(ref Complex[] abd, int lda, int n, int ml, int mu, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZGBFA factors a complex band matrix by elimination.
//
// Discussion:
//
// ZGBFA is usually called by ZGBCO, but it can be called
// directly with a saving in time if RCOND is not needed.
//
// 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)
// end do
// end do
//
// 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:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, new Complex ABD[LDA*N], on input, contains the matrix in
// band storage. The columns of the matrix are stored in the columns
// of ABD and the diagonals of the matrix are stored in rows ML+1
// through 2*ML+MU+1 of ABD. On output, an upper triangular matrix
// in band storage and the multipliers which were used to obtain it.
// The factorization can be written A = L*U where L is a product of
// permutation and unit lower triangular matrices and U is upper triangular.
//
// Input, int LDA, the leading dimension of ABD.
// LDA must be at least 2*ML+MU+1.
//
// Input, int N, the order of the matrix.
//
// Input, int ML, the number of diagonals below the main diagonal.
// 0 <= ML < N.
//
// Input, int MU, the number of diagonals above the main diagonal.
// 0 <= MU < N. More efficient if ML <= MU.
//
// Output, int IPVT[N], the pivot indices.
//
// Output, int ZGBFA.
// 0, normal value.
// K, if U(K,K) == 0.0. This is not an error condition for this
// subroutine, but it does indicate that ZGBSL will divide by zero if
// called. Use RCOND in ZGBCO 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] = new Complex(0.0, 0.0);
}
}
jz = j1;
int ju = 0;
//
// Gaussian elimination with partial pivoting.
//
for (k = 1; k <= n - 1; k++)
{
//
// Zero next fill-in column
//
jz += 1;
if (jz <= n)
{
for (i = 1; i <= ml; i++)
{
abd[i - 1 + (jz - 1) * lda] = new Complex(0.0, 0.0);
}
}
//
// Find L = pivot index.
//
int lm = Math.Min(ml, n - k);
int l = BLAS1Z.izamax(lm + 1, abd, 1, index: +m - 1 + (k - 1) * lda) + m - 1;
ipvt[k - 1] = l + k - m;
//
// Zero pivot implies this column already triangularized.
//
if (typeMethods.zabs1(abd[l - 1 + (k - 1) * lda]) == 0.0)
{
info = k;
continue;
}
//
// Interchange if necessary.
//
Complex 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 = -new Complex(1.0, 0.0) / abd[m - 1 + (k - 1) * lda];
BLAS1Z.zscal(lm, t, ref abd, 1, index: +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;
}
BLAS1Z.zaxpy(lm, t, abd, 1, ref abd, 1, xIndex: +m + (k - 1) * lda, yIndex: +mm + (j - 1) * lda);
}
}
ipvt[n - 1] = n;
if (typeMethods.zabs1(abd[m - 1 + (n - 1) * lda]) == 0.0)
{
info = n;
}
return(info);
}
public static int zgefa(ref Complex[] a, int lda, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZGEFA factors a complex matrix by Gaussian elimination.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, Complex A[LDA*N]; on input, the matrix to be factored.
// On output, an upper triangular matrix and the multipliers 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 A.
//
// Input, int N, the order of the matrix.
//
// Output, int IPVT[N], the pivot indices.
//
// Output, int ZGEFA,
// 0, normal value.
// K, if U(K,K) == 0.0. This is not an error condition for this
// subroutine, but it does indicate that ZGESL or ZGEDI will divide by zero
// if called. Use RCOND in ZGECO 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 = BLAS1Z.izamax(n - k + 1, a, 1, index: +(k - 1) + (k - 1) * lda) + k - 1;
ipvt[k - 1] = l;
//
// Zero pivot implies this column already triangularized.
//
if (typeMethods.zabs1(a[l - 1 + (k - 1) * lda]) == 0.0)
{
info = k;
continue;
}
//
// Interchange if necessary.
//
Complex 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 = -new Complex(1.0, 0.0) / a[k - 1 + (k - 1) * lda];
BLAS1Z.zscal(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;
}
BLAS1Z.zaxpy(n - k, t, a, 1, ref a, 1, xIndex: +k + (k - 1) * lda, yIndex: +k + (j - 1) * lda);
}
}
ipvt[n - 1] = n;
if (typeMethods.zabs1(a[n - 1 + (n - 1) * lda]) == 0.0)
{
info = n;
}
return(info);
}
public static int zspfa(ref Complex[] ap, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZSPFA factors a complex symmetric matrix stored in packed form.
//
// Discussion:
//
// The factorization is done by elimination with symmetric pivoting.
//
// To solve A*X = B, follow ZSPFA by ZSPSL.
//
// To compute inverse(A)*C, follow ZSPFA by ZSPSL.
//
// To compute determinant(A), follow ZSPFA by ZSPDI.
//
// To compute inverse(A), follow ZSPFA by ZSPDI.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, Complex AP[N*(N+1)/2]; On input, the packed form of a
// 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 IPVT[N], the pivot indices.
//
// Output, int ZSPFA.
// 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 ZSPSL or ZSPDI may
// divide by zero if called.
//
{
int im = 0;
//
// Initialize.
//
// 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)
{
ipvt[0] = 1;
if (typeMethods.zabs1(ap[0]) == 0.0)
{
info = 1;
}
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 = typeMethods.zabs1(ap[kk - 1]);
//
// Determine the largest off-diagonal element in column K.
//
int imax = BLAS1Z.izamax(k - 1, ap, 1, index: +ik);
int imk = ik + imax;
double colmax = typeMethods.zabs1(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;
im = imax * (imax - 1) / 2;
imj = im + 2 * imax;
for (j = imax + 1; j <= k; j++)
{
rowmax = Math.Max(rowmax, typeMethods.zabs1(ap[imj - 1]));
imj += j;
}
if (imax != 1)
{
int jmax = BLAS1Z.izamax(imax - 1, ap, 1, index: +im);
int jmim = jmax + im;
rowmax = Math.Max(rowmax, typeMethods.zabs1(ap[jmim - 1]));
}
int imim = imax + im;
if (alpha * rowmax <= typeMethods.zabs1(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:
{
ipvt[k - 1] = k;
info = k;
ik -= k - 1;
switch (kstep)
{
case 2:
ik -= k - 2;
break;
}
k -= kstep;
continue;
}
}
Complex mulk;
Complex t;
int jk;
int jj;
int ij;
if (kstep != 2)
{
switch (swap)
{
//
// 1 x 1 pivot block.
//
case true:
{
BLAS1Z.zswap(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;
BLAS1Z.zaxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
ap[jk - 1] = mulk;
ij -= j - 1;
}
ipvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => imax,
_ => k
};
}
//
// 2 x 2 pivot block.
//
else
{
int km1k = ik + k - 1;
int ikm1 = ik - (k - 1);
int jkm1;
switch (swap)
{
case true:
{
BLAS1Z.zswap(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.
//
int km2 = k - 2;
if (km2 != 0)
{
Complex ak = ap[kk - 1] / ap[km1k - 1];
int km1km1 = ikm1 + k - 1;
Complex akm1 = ap[km1km1 - 1] / ap[km1k - 1];
Complex denom = new Complex(1.0, 0.0) - ak * akm1;
ij = ik - (k - 1) - (k - 2);
for (jj = 1; jj <= km2; jj++)
{
j = km1 - jj;
jk = ik + j;
Complex bk = ap[jk - 1] / ap[km1k - 1];
jkm1 = ikm1 + j;
Complex bkm1 = ap[jkm1 - 1] / ap[km1k - 1];
mulk = (akm1 * bk - bkm1) / denom;
Complex mulkm1 = (ak * bkm1 - bk) / denom;
t = mulk;
BLAS1Z.zaxpy(j, t, ap, 1, ref ap, 1, xIndex: +ik, yIndex: +ij);
t = mulkm1;
BLAS1Z.zaxpy(j, t, ap, 1, ref ap, 1, xIndex: +ikm1, yIndex: +ij);
ap[jk - 1] = mulk;
ap[jkm1 - 1] = mulkm1;
ij -= j - 1;
}
}
ipvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => - imax,
_ => 1 - k
};
ipvt[k - 2] = ipvt[k - 1];
}
ik -= k - 1;
switch (kstep)
{
case 2:
ik -= k - 2;
break;
}
k -= kstep;
}
return(info);
}
}
public static int zhifa(ref Complex[] a, int lda, int n, ref int[] ipvt)
//****************************************************************************80
//
// Purpose:
//
// ZHIFA factors a complex hermitian matrix.
//
// Discussion:
//
// ZHIFA performs the factoring by elimination with symmetric pivoting.
//
// To solve A*X = B, follow ZHIFA by ZHISL.
//
// To compute inverse(A)*C, follow ZHIFA by ZHISL.
//
// To compute determinant(A), follow ZHIFA by ZHIDI.
//
// To compute inertia(A), follow ZHIFA by ZHIDI.
//
// To compute inverse(A), follow ZHIFA by ZHIDI.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, complex <double> A[LDA*N]; on input, the hermitian matrix to be
// factored. On output, a block diagonal matrix and the multipliers which
// were used to obtain it. The factorization can be written
// A = U*D*hermitian(U) where U is a product of permutation and unit upper
// triangular matrices, hermitian(U) is the Complex.Conjugateugate transpose of U, and
// D is block diagonal with 1 by 1 and 2 by 2 blocks. Only the diagonal
// and upper triangle are used.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Output, int IPVT[N], the pivot indices.
//
// Output, int ZHIFA.
// 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 ZHISL or ZHIDI may
// divide by zero if called.
//
{
//
// Initialize.
//
// 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;
for (;;)
{
//
// Leave the loop if K = 0 or K = 1.
//
if (k == 0)
{
break;
}
if (k == 1)
{
ipvt[0] = 1;
if (typeMethods.zabs1(a[0 + 0 * lda]) == 0.0)
{
info = 1;
}
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;
double absakk = typeMethods.zabs1(a[k - 1 + (k - 1) * lda]);
//
// Determine the largest off-diagonal element in column K.
//
int imax = BLAS1Z.izamax(k - 1, a, 1, index: +0 + (k - 1) * lda);
double colmax = typeMethods.zabs1(a[imax - 1 + (k - 1) * lda]);
int j;
int kstep;
bool swap;
if (alpha * colmax <= absakk)
{
kstep = 1;
swap = false;
}
else
{
//
// Determine the largest off-diagonal element in row IMAX.
//
double rowmax = 0.0;
for (j = imax + 1; j <= k; j++)
{
rowmax = Math.Max(rowmax, typeMethods.zabs1(a[imax - 1 + (j - 1) * lda]));
}
if (imax != 1)
{
int jmax = BLAS1Z.izamax(imax - 1, a, 1, index: +0 + (imax - 1) * lda);
rowmax = Math.Max(rowmax, typeMethods.zabs1(a[jmax - 1 + (imax - 1) * lda]));
}
if (alpha * rowmax <= typeMethods.zabs1(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 != km1;
}
}
switch (Math.Max(absakk, colmax))
{
//
// Column K is zero. Set INFO and iterate the loop.
//
case 0.0:
ipvt[k - 1] = k;
info = k;
k -= kstep;
continue;
}
int jj;
Complex mulk;
Complex t;
if (kstep != 2)
{
switch (swap)
{
//
// 1 x 1 pivot block.
//
case true:
{
BLAS1Z.zswap(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 = Complex.Conjugate(a[j - 1 + (k - 1) * lda]);
a[j - 1 + (k - 1) * lda] = Complex.Conjugate(a[imax - 1 + (j - 1) * lda]);
a[imax - 1 + (j - 1) * lda] = t;
}
break;
}
}
//
// Perform the elimination.
//
for (jj = 1; jj <= km1; jj++)
{
j = k - jj;
mulk = -a[j - 1 + (k - 1) * lda] / a[k - 1 + (k - 1) * lda];
t = Complex.Conjugate(mulk);
BLAS1Z.zaxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
a[j - 1 + (j - 1) * lda] = new Complex(a[j - 1 + (j - 1) * lda].Real, 0.0);
a[j - 1 + (k - 1) * lda] = mulk;
}
ipvt[k - 1] = swap switch
{
true => imax,
//
// Set the pivot array.
//
_ => k
};
}
else
{
switch (swap)
{
//
// 2 x 2 pivot block.
//
case true:
{
BLAS1Z.zswap(imax, ref a, 1, ref a, 1, xIndex: +0 + (imax - 1) * lda, yIndex: +0 + (k - 2) * lda);
for (jj = imax; jj <= km1; jj++)
{
j = km1 + imax - jj;
t = Complex.Conjugate(a[j - 1 + (k - 2) * lda]);
a[j - 1 + (k - 2) * lda] = Complex.Conjugate(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;
}
}
switch (k - 2)
{
//
// Perform the elimination.
//
case > 0:
{
Complex ak = a[k - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
Complex akm1 = a[k - 2 + (k - 2) * lda] / Complex.Conjugate(a[k - 2 + (k - 1) * lda]);
Complex denom = new Complex(1.0, 0.0) - ak * akm1;
for (jj = 1; jj <= k - 2; jj++)
{
j = km1 - jj;
Complex bk = a[j - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
Complex bkm1 = a[j - 1 + (k - 2) * lda] / Complex.Conjugate(a[k - 2 + (k - 1) * lda]);
mulk = (akm1 * bk - bkm1) / denom;
Complex mulkm1 = (ak * bkm1 - bk) / denom;
t = Complex.Conjugate(mulk);
BLAS1Z.zaxpy(j, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
t = Complex.Conjugate(mulkm1);
BLAS1Z.zaxpy(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;
a[j - 1 + (j - 1) * lda] = new Complex(a[j - 1 + (j - 1) * lda].Real, 0.0);
}
break;
}
}
ipvt[k - 1] = swap switch
{
//
// Set the pivot array.
//
true => - imax,
_ => 1 - k
};
ipvt[k - 2] = ipvt[k - 1];
}
k -= kstep;
}
return(info);
}
}