public static int zchdc(ref Complex[] a, int lda, int p, ref int[] ipvt, int job)
//****************************************************************************80
//
// Purpose:
//
// ZCHDC: Cholesky decomposition of a Hermitian positive definite matrix.
//
// Discussion:
//
// A pivoting option allows the user to estimate the condition of a
// Hermitian positive definite matrix or determine the rank of a
// Hermitian positive semidefinite matrix.
//
// For Hermitian positive definite matrices, INFO = P is the normal return.
//
// For pivoting with Hermitian 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:
//
// 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*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 matrix A as it has been permuted by pivoting.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int P, the order of the matrix.
//
// Input/output, int IPVT[P]. IPVT is not referenced if JOB == 0.
// 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 input
// value of IPVT(K):
// IPVT(K) > 0, X(K) is an initial element.
// IPVT(K) == 0, X(K) is a free element.
// IPVT(K) < 0, 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.
// On output, IPVT(K) contains the index of the diagonal element
// of A that was moved into the J-th position, if pivoting was requested.
//
// Input, int JOB, specifies whether column pivoting is to be done.
// 0, no pivoting is done.
// nonzero, pivoting is done.
//
// Output, int ZCHDC, contains the index of the last positive
// diagonal element of the Cholesky factor.
//
{
int i_temp;
int j;
int k;
Complex temp;
int pl = 1;
int pu = 0;
int info = p;
Complex[] work = new Complex[p];
if (job != 0)
{
//
// Pivoting has been requested. Rearrange the elements according to IPVT.
//
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)
{
BLAS1Z.zswap(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;
a[pl - 1 + (k - 1) * lda] = Complex.Conjugate(a[pl - 1 + (k - 1) * lda]);
int plp1 = pl + 1;
for (j = plp1; j <= p; j++)
{
if (j < k)
{
temp = Complex.Conjugate(a[pl - 1 + (j - 1) * lda]);
a[pl - 1 + (j - 1) * lda] = Complex.Conjugate(a[j - 1 + (k - 1) * lda]);
a[j - 1 + (k - 1) * lda] = temp;
}
else if (j != k)
{
temp = a[pl - 1 + (j - 1) * lda];
a[pl - 1 + (j - 1) * lda] = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = temp;
}
}
ipvt[k - 1] = ipvt[pl - 1];
ipvt[pl - 1] = k;
}
pl += 1;
break;
}
}
}
pu = p;
int kb;
for (kb = pl; kb <= p; kb++)
{
k = p - kb + pl;
switch (ipvt[k - 1])
{
case < 0:
{
ipvt[k - 1] = -ipvt[k - 1];
if (pu != k)
{
BLAS1Z.zswap(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;
a[k - 1 + (pu - 1) * lda] = Complex.Conjugate(a[k - 1 + (pu - 1) * lda]);
for (j = k + 1; j <= p; j++)
{
if (j < pu)
{
temp = Complex.Conjugate(a[k - 1 + (j - 1) * lda]);
a[k - 1 + (j - 1) * lda] = Complex.Conjugate(a[j - 1 + (pu - 1) * lda]);
a[j - 1 + (pu - 1) * lda] = temp;
}
else if (j != pu)
{
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;
}
}
i_temp = ipvt[k - 1];
ipvt[k - 1] = ipvt[pu - 1];
ipvt[pu - 1] = i_temp;
}
pu -= 1;
break;
}
}
}
}
for (k = 1; k <= p; k++)
{
//
// Reduction loop.
//
double maxdia = a[k - 1 + (k - 1) * lda].Real;
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].Real))
{
continue;
}
maxdia = a[l - 1 + (l - 1) * lda].Real;
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)
{
BLAS1Z.zswap(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] = new Complex(maxdia, 0.0);
i_temp = ipvt[maxl - 1];
ipvt[maxl - 1] = ipvt[k - 1];
ipvt[k - 1] = i_temp;
a[k - 1 + (maxl - 1) * lda] = Complex.Conjugate(a[k - 1 + (maxl - 1) * lda]);
}
//
// Reduction step. Pivoting is contained across the rows.
//
work[k - 1] = new Complex(Math.Sqrt(a[k - 1 + (k - 1) * lda].Real), 0.0);
a[k - 1 + (k - 1) * lda] = work[k - 1];
for (j = k + 1; j <= p; j++)
{
if (k != maxl)
{
if (j < maxl)
{
temp = Complex.Conjugate(a[k - 1 + (j - 1) * lda]);
a[k - 1 + (j - 1) * lda] = Complex.Conjugate(a[j - 1 + (maxl - 1) * lda]);
a[j - 1 + (maxl - 1) * lda] = temp;
}
else if (j != maxl)
{
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] = Complex.Conjugate(a[k - 1 + (j - 1) * lda]);
temp = -a[k - 1 + (j - 1) * lda];
BLAS1Z.zaxpy(j - k, temp, work, 1, ref a, 1, xIndex: +k, yIndex: +k + (j - 1) * lda);
}
}
return(info);
}
}
public static void zspdi(ref Complex[] ap, int n, int[] ipvt, ref Complex[] det,
int job)
//****************************************************************************80
//
// Purpose:
//
// ZSPDI sets the determinant and inverse of a complex symmetric packed matrix.
//
// Discussion:
//
// ZSPDI uses the factors from ZSPFA.
//
// The matrix is stored in packed form.
//
// A division by zero will occur if the inverse is requested and ZSPCO has
// set RCOND to 0.0 or ZSPFA has set INFO nonzero.
//
// 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 matrix factors
// from ZSPFA. On output, if the inverse was requested, the upper
// triangle of the inverse of the original matrix, stored in packed
// form. The columns of the upper triangle are stored sequentially
// in a one-dimensional array.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZSPFA.
//
// Output, Complex DET[2], the determinant of the original matrix.
// Determinant = DET(1) * 10.0**DET(2) with 1.0 <= abs ( DET(1) ) < 10.0
// or DET(1) = 0.0. Also, DET(2) is strictly real.
//
// Input, int JOB, has the decimal expansion AB where
// if B != 0, the inverse is computed,
// if A != 0, the determinant is computed,
// For example, JOB = 11 gives both.
//
{
Complex d;
int ik;
int ikp1;
int k;
int kk;
int kkp1 = 0;
Complex t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
switch (nodet)
{
case false:
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
t = new Complex(0.0, 0.0);
ik = 0;
for (k = 1; k <= n; k++)
{
kk = ik + k;
d = ap[kk - 1];
switch (ipvt[k - 1])
{
//
// 2 by 2 block
// Use det (D T) = ( D / T * C - T ) * T
// (T C)
// to avoid underflow/overflow troubles.
// Take two passes through scaling. Use T for flag.
//
case <= 0 when typeMethods.zabs1(t) == 0.0:
ikp1 = ik + k;
kkp1 = ikp1 + k;
t = ap[kkp1 - 1];
d = d / t * ap[kkp1] - t;
break;
case <= 0:
d = t;
t = new Complex(0.0, 0.0);
break;
}
switch (nodet)
{
case false:
{
det[0] *= d;
if (typeMethods.zabs1(det[0]) != 0.0)
{
while (typeMethods.zabs1(det[0]) < 1.0)
{
det[0] *= new Complex(10.0, 0.0);
det[1] -= new Complex(1.0, 0.0);
}
while (10.0 <= typeMethods.zabs1(det[0]))
{
det[0] /= new Complex(10.0, 0.0);
det[1] += new Complex(1.0, 0.0);
}
}
break;
}
}
ik += k;
}
break;
}
}
switch (noinv)
{
//
// Compute inverse ( A ).
//
case false:
{
Complex[] work = new Complex[n];
k = 1;
ik = 0;
while (k <= n)
{
int km1 = k - 1;
kk = ik + k;
ikp1 = ik + k;
int j;
int jk;
int i;
int ij;
int kstep;
switch (ipvt[k - 1])
{
case >= 0:
{
//
// 1 by 1
//
ap[kk - 1] = new Complex(1.0, 0.0) / ap[kk - 1];
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ik + i - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 1;
break;
}
//
default:
{
kkp1 = ikp1 + k;
t = ap[kkp1 - 1];
Complex ak = ap[kk - 1] / t;
Complex akp1 = ap[kkp1] / t;
Complex akkp1 = ap[kkp1 - 1] / t;
d = t * (ak * akp1 - new Complex(1.0, 0.0));
ap[kk - 1] = akp1 / d;
ap[kkp1] = ak / d;
ap[kkp1 - 1] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ikp1 - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
int jkp1 = ikp1 + j;
ap[jkp1 - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ikp1);
ij += j;
}
ap[kkp1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ikp1);
ap[kkp1 - 1] += BLAS1Z.zdotu(km1, ap, 1, ap, 1, xIndex: +ik, yIndex: +ikp1);
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ik + i - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap.
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
int iks = ks * (ks - 1) / 2;
BLAS1Z.zswap(ks, ref ap, 1, ref ap, 1, xIndex: +iks, yIndex: +ik);
int ksj = ik + ks;
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
jk = ik + j;
t = ap[jk - 1];
ap[jk - 1] = ap[ksj - 1];
ap[ksj - 1] = t;
ksj -= j - 1;
}
if (kstep != 1)
{
int kskp1 = ikp1 + ks;
t = ap[kskp1 - 1];
ap[kskp1 - 1] = ap[kkp1 - 1];
ap[kkp1 - 1] = t;
}
}
ik += k;
ik = kstep switch
{
2 => ik + k + 1,
_ => ik
};
k += kstep;
}
break;
}
}
}
}
public static void zqrdc(ref Complex[] x, int ldx, int n, int p,
ref Complex[] qraux, ref int[] ipvt, int job)
//****************************************************************************80
//
// Purpose:
//
// ZQRDC computes the QR factorization of an N by P complex <double> matrix.
//
// Discussion:
//
// ZQRDC uses Householder transformations to compute the QR factorization
// of an N by P matrix X. Column pivoting based on the 2-norms of the
// reduced columns may be performed at the user's option.
//
// 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> X[LDX*P]; on input, the matrix whose decomposition
// is to be computed. On output, the upper triangle contains the upper
// triangular matrix R of the QR factorization. Below its diagonal, X
// contains information from which the unitary part of the decomposition
// can be recovered. If pivoting has been requested, the decomposition is
// not that of the original matrix X, but that of X with its columns
// permuted as described by IPVT.
//
// Input, int LDX, the leading dimension of X. N <= LDX.
//
// Input, int N, the number of rows of the matrix.
//
// Input, int P, the number of columns in the matrix X.
//
// Output, complex <double> QRAUX[P], further information required to recover
// the unitary part of the decomposition.
//
// Input/output, int IPVT[P]; on input, ints that control the
// selection of the pivot columns. The K-th column X(K) of X is placed
// in one of three classes according to the value of IPVT(K):
// IPVT(K) > 0, then X(K) is an initial column.
// IPVT(K) == 0, then X(K) is a free column.
// IPVT(K) < 0, then X(K) is a final column.
// Before the decomposition is computed, initial columns are moved to the
// beginning of the array X and final columns to the end. Both initial
// and final columns are frozen in place during the computation and only
// free columns are moved. At the K-th stage of the reduction, if X(K)
// is occupied by a free column it is interchanged with the free column
// of largest reduced norm.
// On output, IPVT(K) contains the index of the column of the
// original matrix that has been interchanged into
// the K-th column, if pivoting was requested.
// IPVT is not referenced if JOB == 0.
//
// Input, int JOB, initiates column pivoting.
// 0, no pivoting is done.
// nonzero, pivoting is done.
//
{
int itemp;
int j;
int l;
int pl = 1;
int pu = 0;
Complex[] work = new Complex [p];
if (job != 0)
{
//
// Pivoting has been requested. Rearrange the columns according to IPVT.
//
for (j = 1; j <= p; j++)
{
bool swapj = 0 < ipvt[j - 1];
bool negj = ipvt[j - 1] < 0;
ipvt[j - 1] = negj switch
{
true => - j,
_ => j
};
switch (swapj)
{
case true:
{
if (j != pl)
{
BLAS1Z.zswap(n, ref x, 1, ref x, 1, xIndex: +0 + (pl - 1) * ldx, yIndex: +0 + (j - 1) * ldx);
}
ipvt[j - 1] = ipvt[pl - 1];
ipvt[pl - 1] = j;
pl += 1;
break;
}
}
}
pu = p;
int jj;
for (jj = 1; jj <= p; jj++)
{
j = p - jj + 1;
switch (ipvt[j - 1])
{
case < 0:
{
ipvt[j - 1] = -ipvt[j - 1];
if (j != pu)
{
BLAS1Z.zswap(n, ref x, 1, ref x, 1, xIndex: +0 + (pu - 1) * ldx, yIndex: +0 + (j - 1) * ldx);
itemp = ipvt[pu - 1];
ipvt[pu - 1] = ipvt[j - 1];
ipvt[j - 1] = itemp;
}
pu -= 1;
break;
}
}
}
}
//
// Compute the norms of the free columns.
//
for (j = pl; j <= pu; j++)
{
qraux[j - 1] = new Complex(BLAS1Z.dznrm2(n, x, 1, index: +0 + (j - 1) * ldx), 0.0);
work[j - 1] = qraux[j - 1];
}
//
// Perform the Householder reduction of X.
//
int lup = Math.Min(n, p);
for (l = 1; l <= lup; l++)
{
//
// Locate the column of largest norm and bring it
// into the pivot position.
//
if (pl <= l && l < pu)
{
double maxnrm = 0.0;
int maxj = l;
for (j = l; j <= pu; j++)
{
if (!(maxnrm < qraux[j - 1].Real))
{
continue;
}
maxnrm = qraux[j - 1].Real;
maxj = j;
}
if (maxj != l)
{
BLAS1Z.zswap(n, ref x, 1, ref x, 1, xIndex: +0 + (l - 1) * ldx, yIndex: +0 + (maxj - 1) * ldx);
qraux[maxj - 1] = qraux[l - 1];
work[maxj - 1] = work[l - 1];
itemp = ipvt[maxj - 1];
ipvt[maxj - 1] = ipvt[l - 1];
ipvt[l - 1] = itemp;
}
}
qraux[l - 1] = new Complex(0.0, 0.0);
if (l == n)
{
continue;
}
//
// Compute the Householder transformation for column L.
//
Complex nrmxl = new(BLAS1Z.dznrm2(n - l + 1, x, 1, index: +l - 1 + (l - 1) * ldx), 0.0);
if (typeMethods.zabs1(nrmxl) == 0.0)
{
continue;
}
if (typeMethods.zabs1(x[l - 1 + (l - 1) * ldx]) != 0.0)
{
nrmxl = typeMethods.zsign2(nrmxl, x[l - 1 + (l - 1) * ldx]);
}
Complex t = new Complex(1.0, 0.0) / nrmxl;
BLAS1Z.zscal(n - l + 1, t, ref x, 1, index: +l - 1 + (l - 1) * ldx);
x[l - 1 + (l - 1) * ldx] = new Complex(1.0, 0.0) + x[l - 1 + (l - 1) * ldx];
//
// Apply the transformation to the remaining columns,
// updating the norms.
//
for (j = l + 1; j <= p; j++)
{
t = -BLAS1Z.zdotc(n - l + 1, x, 1, x, 1, xIndex: +l - 1 + (l - 1) * ldx, yIndex: +l - 1 + (j - 1) * ldx)
/ x[l - 1 + (l - 1) * ldx];
BLAS1Z.zaxpy(n - l + 1, t, x, 1, ref x, 1, xIndex: +l - 1 + (l - 1) * ldx, yIndex: +l - 1 + (j - 1) * ldx);
if (j < pl || pu < j)
{
continue;
}
if (typeMethods.zabs1(qraux[j - 1]) == 0.0)
{
continue;
}
double tt = 1.0 - Math.Pow(Complex.Abs(x[l - 1 + (j - 1) * ldx]) / qraux[j - 1].Real, 2);
tt = Math.Max(tt, 0.0);
t = new Complex(tt, 0.0);
tt = 1.0 + 0.05 * tt
* Math.Pow(qraux[j - 1].Real / work[j - 1].Real, 2);
if (Math.Abs(tt - 1.0) > double.Epsilon)
{
qraux[j - 1] *= Complex.Sqrt(t);
}
else
{
qraux[j - 1] =
new Complex(BLAS1Z.dznrm2(n - l, x, 1, index: +l + (j - 1) * ldx), 0.0);
work[j - 1] = qraux[j - 1];
}
}
//
// Save the transformation.
//
qraux[l - 1] = x[l - 1 + (l - 1) * ldx];
x[l - 1 + (l - 1) * ldx] = -nrmxl;
}
}
}
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 void zhidi(ref Complex[] a, int lda, int n, int[] ipvt, ref double[] det,
ref int[] inert, int job)
//****************************************************************************80
//
// Purpose:
//
// ZHIDI computes the determinant and inverse of a matrix factored by ZHIFA.
//
// Discussion:
//
// ZHIDI computes the determinant, inertia (number of positive, zero,
// and negative eigenvalues) and inverse of a complex hermitian matrix
// using the factors from ZHIFA.
//
// A division by zero may occur if the inverse is requested
// and ZHICO has set RCOND == 0.0 or ZHIFA has set INFO /= 0.
//
// 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 factored matrix
// from ZHIFA. On output, if the inverse was requested, A contains
// the inverse matrix. The strict lower triangle of A is never
// referenced.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZHIFA.
//
// Output, double DET[2], the determinant of the original matrix.
// Determinant = det[0] * 10.0**det[1] with 1.0 <= Math.Abs ( det[0] ) < 10.0
// or det[0] = 0.0.
//
// Output, int INERT[3], the inertia of the original matrix.
// INERT(1) = number of positive eigenvalues.
// INERT(2) = number of negative eigenvalues.
// INERT(3) = number of zero eigenvalues.
//
// Input, int JOB, has the decimal expansion ABC where:
// if C /= 0, the inverse is computed,
// if B /= 0, the determinant is computed,
// if A /= 0, the inertia is computed.
// For example, JOB = 111 gives all three.
//
{
double d;
int i;
int k;
double t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
bool noert = job % 1000 / 100 == 0;
if (!nodet || !noert)
{
switch (noert)
{
case false:
{
for (i = 0; i < 3; i++)
{
inert[i] = 0;
}
break;
}
}
switch (nodet)
{
case false:
det[0] = 1.0;
det[1] = 0.0;
break;
}
t = 0.0;
for (k = 0; k < n; k++)
{
d = a[k + k * lda].Real;
switch (ipvt[k])
{
//
// Check if 1 by 1.
//
//
// 2 by 2 block
// Use DET = ( D / T * C - T ) * T, T = Math.Abs ( S )
// to avoid underflow/overflow troubles.
// Take two passes through scaling. Use T for flag.
//
case <= 0 when t == 0.0:
t = Complex.Abs(a[k + (k + 1) * lda]);
d = d / t * a[k + 1 + (k + 1) * lda].Real - t;
break;
case <= 0:
d = t;
t = 0.0;
break;
}
switch (noert)
{
case false:
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 (nodet)
{
case false:
{
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;
}
}
}
}
switch (noinv)
{
//
// Compute inverse(A).
//
case false:
{
Complex[] work = new Complex [n];
k = 1;
while (k <= n)
{
int km1 = k - 1;
int kstep;
int j;
switch (ipvt[k - 1])
{
case >= 0:
{
//
// 1 by 1
//
a[k - 1 + (k - 1) * lda] =
new Complex(1.0 / a[k - 1 + (k - 1) * lda].Real, 0.0);
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotc(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += new Complex(
BLAS1Z.zdotc(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda).Real, 0.0);
break;
}
}
kstep = 1;
break;
}
default:
{
//
// 2 by 2
//
t = Complex.Abs(a[k - 1 + k * lda]);
double ak = a[k - 1 + (k - 1) * lda].Real / t;
double akp1 = a[k + k * lda].Real / t;
Complex akkp1 = a[k - 1 + k * lda] / t;
d = t * (ak * akp1 - 1.0);
a[k - 1 + (k - 1) * lda] = new Complex(akp1 / d, 0.0);
a[k + k * lda] = new Complex(ak / d, 0.0);
a[k - 1 + k * lda] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + k * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + k * lda] = BLAS1Z.zdotc(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + k * lda);
}
a[k + k * lda] += new Complex(
BLAS1Z.zdotc(km1, work, 1, a, 1, yIndex: +0 + k * lda).Real, 0.0);
a[k - 1 + k * lda] += BLAS1Z.zdotc(km1, a, 1, a, 1, xIndex: +0 + (k - 1) * lda,
yIndex: +0 + k * lda);
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotc(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += new Complex(
BLAS1Z.zdotc(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda).Real, 0.0);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
BLAS1Z.zswap(ks, ref a, 1, ref a, 1, xIndex: +0 + (ks - 1) * lda, yIndex: +0 + (k - 1) * lda);
Complex t2;
for (j = k; ks <= j; j--)
{
t2 = Complex.Conjugate(a[j - 1 + (k - 1) * lda]);
a[j - 1 + (k - 1) * lda] = Complex.Conjugate(a[ks - 1 + (j - 1) * lda]);
a[ks - 1 + (j - 1) * lda] = t2;
}
if (kstep != 1)
{
t2 = a[ks - 1 + k * lda];
a[ks - 1 + k * lda] = a[k - 1 + k * lda];
a[k - 1 + k * lda] = t2;
}
}
k += kstep;
}
break;
}
}
}
public static void zsidi(ref Complex[] a, int lda, int n, int[] ipvt,
ref Complex[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// ZSIDI computes the determinant and inverse of a matrix factored by ZSIFA.
//
// Discussion:
//
// It is assumed the complex symmetric matrix has already been factored
// by ZSIFA.
//
// A division by zero may occur if the inverse is requested
// and ZSICO set RCOND == 0.0 or ZSIFA set INFO nonzero.
//
// 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 output from ZSIFA.
// If the inverse was requested, then on output, A contains the upper triangle
// of the inverse of the original matrix. The strict lower triangle
// is never referenced.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZSIFA.
//
// Output, Complex DET[2], if requested, the determinant of the matrix.
// Determinant = DET(1) * 10.0**DET(2) with 1.0 <= abs ( DET(1) ) < 10.0
// or DET(1) = 0.0. Also, DET(2) is strictly real.
//
// Input, int JOB, has the decimal expansion AB where
// if B != 0, the inverse is computed,
// if A != 0, the determinant is computed,
// For example, JOB = 11 gives both.
//
{
Complex d;
int k;
Complex t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
switch (nodet)
{
case false:
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
t = new Complex(0.0, 0.0);
for (k = 1; k <= n; k++)
{
d = a[k - 1 + (k - 1) * lda];
switch (ipvt[k - 1])
{
//
// 2 by 2 block.
// Use det ( D T ) = ( D / T * C - T ) * T
// ( T C )
// to avoid underflow/overflow troubles.
// Take two passes through scaling. Use T for flag.
//
case <= 0 when typeMethods.zabs1(t) == 0.0:
t = a[k - 1 + k * lda];
d = d / t * a[k + k * lda] - t;
break;
case <= 0:
d = t;
t = new Complex(0.0, 0.0);
break;
}
det[0] *= d;
if (typeMethods.zabs1(det[0]) == 0.0)
{
continue;
}
while (typeMethods.zabs1(det[0]) < 1.0)
{
det[0] *= new Complex(10.0, 0.0);
det[1] -= new Complex(1.0, 0.0);
}
while (10.0 <= typeMethods.zabs1(det[0]))
{
det[0] /= new Complex(10.0, 0.0);
det[1] += new Complex(1.0, 0.0);
}
}
break;
}
}
switch (noinv)
{
//
// Compute inverse ( A ).
//
case false:
{
Complex[] work = new Complex [n];
k = 1;
while (k <= n)
{
int km1 = k - 1;
int kstep;
int j;
int i;
switch (ipvt[k - 1])
{
//
// 1 by 1
//
case >= 0:
{
a[k - 1 + (k - 1) * lda] = new Complex(1.0, 0.0) / a[k - 1 + (k - 1) * lda];
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
break;
}
}
kstep = 1;
break;
}
//
default:
{
t = a[k - 1 + k * lda];
Complex ak = a[k - 1 + (k - 1) * lda] / t;
Complex akp1 = a[k + k * lda] / t;
Complex akkp1 = a[k - 1 + k * lda] / t;
d = t * (ak * akp1 - new Complex(1.0, 0.0));
a[k - 1 + (k - 1) * lda] = akp1 / d;
a[k + k * lda] = ak / d;
a[k - 1 + k * lda] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + k * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + k * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + k * lda);
}
a[k + k * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + k * lda);
a[k - 1 + k * lda] += BLAS1Z.zdotu(km1, a, 1, a, 1, xIndex: +0 + (k - 1) * lda,
yIndex: +0 + k * lda);
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap.
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
BLAS1Z.zswap(ks, ref a, 1, ref a, 1, xIndex: +0 + (ks - 1) * lda, yIndex: +0 + (k - 1) * lda);
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
t = a[j - 1 + (k - 1) * lda];
a[j - 1 + (k - 1) * lda] = a[ks - 1 + (j - 1) * lda];
a[ks - 1 + (j - 1) * lda] = t;
}
if (kstep != 1)
{
t = a[ks - 1 + k * lda];
a[ks - 1 + k * lda] = a[k - 1 + k * lda];
a[k - 1 + k * lda] = t;
}
}
k += kstep;
}
break;
}
}
}
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);
}
}
public static void zgedi(ref Complex[] a, int lda, int n, int[] ipvt,
ref Complex[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// ZGEDI computes the determinant and inverse of a matrix.
//
// Discussion:
//
// The matrix must have been factored by ZGECO or ZGEFA.
//
// 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 ZGECO has set 0.0 < RCOND or ZGEFA has set
// INFO == 0.
//
// 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 factor information
// from ZGECO or ZGEFA. On output, the inverse matrix, if it
// was requested,
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZGECO or ZGEFA.
//
// Output, Complex DET[2], the determinant of the original matrix,
// if requested. Otherwise not referenced.
// Determinant = DET(1) * 10.0**DET(2) with
// 1.0 <= typeMethods.zabs1 ( DET(1) ) < 10.0 or DET(1) == 0.0.
// Also, DET(2) is strictly real.
//
// Input, int JOB.
// 11, both determinant and inverse.
// 01, inverse only.
// 10, determinant only.
//
{
int i;
//
// Compute the determinant.
//
if (job / 10 != 0)
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
for (i = 1; i <= n; i++)
{
if (ipvt[i - 1] != i)
{
det[0] = -det[0];
}
det[0] = a[i - 1 + (i - 1) * lda] * det[0];
if (typeMethods.zabs1(det[0]) == 0.0)
{
break;
}
while (typeMethods.zabs1(det[0]) < 1.0)
{
det[0] *= new Complex(10.0, 0.0);
det[1] -= new Complex(1.0, 0.0);
}
while (10.0 <= typeMethods.zabs1(det[0]))
{
det[0] /= new Complex(10.0, 0.0);
det[1] += new Complex(1.0, 0.0);
}
}
}
//
// Compute inverse(U).
//
if (job % 10 == 0)
{
return;
}
Complex[] work = new Complex[n];
int j;
Complex t;
int k;
for (k = 1; k <= n; k++)
{
a[k - 1 + (k - 1) * lda] = new Complex(1.0, 0.0) / a[k - 1 + (k - 1) * lda];
t = -a[k - 1 + (k - 1) * lda];
BLAS1Z.zscal(k - 1, t, ref a, 1, index: +0 + (k - 1) * lda);
for (j = k + 1; j <= n; j++)
{
t = a[k - 1 + (j - 1) * lda];
a[k - 1 + (j - 1) * lda] = new Complex(0.0, 0.0);
BLAS1Z.zaxpy(k, t, a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (j - 1) * lda);
}
}
//
// Form inverse(U) * inverse(L).
//
for (k = n - 1; 1 <= k; k--)
{
for (i = k + 1; i <= n; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
a[i - 1 + (k - 1) * lda] = new Complex(0.0, 0.0);
}
for (j = k + 1; j <= n; j++)
{
t = work[j - 1];
BLAS1Z.zaxpy(n, t, a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda, yIndex: +0 + (k - 1) * lda);
}
int l = ipvt[k - 1];
if (l != k)
{
BLAS1Z.zswap(n, ref a, 1, ref a, 1, xIndex: +0 + (k - 1) * lda, yIndex: +0 + (l - 1) * lda);
}
}
}
public static void zhpdi(ref Complex[] ap, int n, int[] ipvt, ref double[] det,
ref int[] inert, int job)
//****************************************************************************80
//
// Purpose:
//
// ZHPDI: determinant, inertia and inverse of a complex hermitian matrix.
//
// Discussion:
//
// The routine uses the factors from ZHPFA.
//
// The matrix is stored in packed form.
//
// A division by zero will occur if the inverse is requested and ZHPCO has
// set RCOND == 0.0 or ZHPFA has set INFO != 0.
//
// 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 factored matrix
// from ZHPFA. If the inverse was requested, then on output, AP contains
// the upper triangle of the inverse of the original matrix, stored in packed
// form. The columns of the upper triangle are stored sequentially in a
// one-dimensional array.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZHPFA.
//
// Output, double DET[2], if requested, the determinant of the original
// matrix. Determinant = DET(1) * 10.0**DET(2) with
// 1.0 <= abs ( DET(1) ) < 10.0 or DET(1) = 0.0.
//
// Output, int INERT[3], if requested, the inertia of the original matrix.
// INERT(1) = number of positive eigenvalues.
// INERT(2) = number of negative eigenvalues.
// INERT(3) = number of zero eigenvalues.
//
// Input, int JOB, has the decimal expansion ABC where:
// if C != 0, the inverse is computed,
// if B != 0, the determinant is computed,
// if A != 0, the inertia is computed.
// For example, JOB = 111 gives all three.
//
{
double d;
int ik;
int ikp1;
int k;
int kk;
int kkp1;
double t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
bool noert = job % 1000 / 100 == 0;
if (!nodet || !noert)
{
switch (noert)
{
case false:
inert[0] = 0;
inert[1] = 0;
inert[2] = 0;
break;
}
switch (nodet)
{
case false:
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].Real;
switch (ipvt[k - 1])
{
//
// Check if 1 by 1
//
//
// 2 by 2 block
// Use DET (D S; S C) = ( D / T * C - T ) * T, T = abs ( S )
// 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 = Complex.Abs(ap[kkp1 - 1]);
d = d / t * ap[kkp1].Real - t;
break;
case <= 0:
d = t;
t = 0.0;
break;
}
switch (noert)
{
case false:
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 (nodet)
{
case false:
{
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 (noinv)
{
//
// Compute inverse(A).
//
case false:
{
Complex[] work = new Complex [n];
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 (ipvt[k - 1])
{
//
// 1 by 1
//
case >= 0:
{
ap[kk - 1] = new Complex(1.0 / ap[kk - 1].Real, 0.0);
switch (km1)
{
case >= 1:
{
for (j = 1; j <= km1; j++)
{
work[j - 1] = ap[ik + j - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotc(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += new Complex
(BLAS1Z.zdotc(km1, work, 1, ap, 1, yIndex: +ik).Real, 0.0);
break;
}
}
kstep = 1;
break;
}
//
default:
{
t = Complex.Abs(ap[kkp1 - 1]);
double ak = ap[kk - 1].Real / t;
double akp1 = ap[kkp1].Real / t;
Complex akkp1 = ap[kkp1 - 1] / t;
d = t * (ak * akp1 - 1.0);
ap[kk - 1] = new Complex(akp1 / d, 0.0);
ap[kkp1] = new Complex(ak / d, 0.0);
ap[kkp1 - 1] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (j = 1; j <= km1; j++)
{
work[j - 1] = ap[ikp1 + j - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
int jkp1 = ikp1 + j;
ap[jkp1 - 1] = BLAS1Z.zdotc(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ikp1);
ij += j;
}
ap[kkp1] += new Complex
(BLAS1Z.zdotc(km1, work, 1, ap, 1, xIndex: +ikp1).Real, 0.0);
ap[kkp1 - 1] += BLAS1Z.zdotc(km1, ap, 1, ap, 1, xIndex: +ik, yIndex: +ikp1);
for (j = 1; j <= km1; j++)
{
work[j - 1] = ap[ik + j - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotc(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += new Complex
(BLAS1Z.zdotc(km1, work, 1, ap, 1, yIndex: +ik).Real, 0.0);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
int iks = ks * (ks - 1) / 2;
BLAS1Z.zswap(ks, ref ap, 1, ref ap, 1, xIndex: +iks, yIndex: +ik);
int ksj = ik + ks;
Complex t2;
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
jk = ik + j;
t2 = Complex.Conjugate(ap[jk - 1]);
ap[jk - 1] = Complex.Conjugate(ap[ksj - 1]);
ap[ksj - 1] = t2;
ksj -= j - 1;
}
if (kstep != 1)
{
int kskp1 = ikp1 + ks;
t2 = ap[kskp1 - 1];
ap[kskp1 - 1] = ap[kkp1 - 1];
ap[kkp1 - 1] = t2;
}
}
ik += k;
ik = kstep switch
{
2 => ik + k + 1,
_ => ik
};
k += kstep;
}
break;
}
}
}
}