public static void zppdi(ref Complex[] ap, int n, ref double[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// ZPPDI: determinant, inverse of a complex hermitian positive definite matrix.
//
// Discussion:
//
// The matrix is assumed to have been factored by ZPPCO or ZPPFA.
//
// 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 ZPOCO or ZPOFA 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 <double> A[(N*(N+1))/2]; on input, the output from ZPPCO
// or ZPPFA. On output, the upper triangular half of the inverse.
// The strict lower triangle is unaltered.
//
// Input, int N, the order of the matrix.
//
// Output, double DET[2], the determinant of original matrix if requested.
// Otherwise not referenced. Determinant = DET(1) * 10.0**DET(2)
// with 1.0 <= DET(1) < 10.0 or DET(1) == 0.0.
//
// Input, int JOB.
// 11, both determinant and inverse.
// 01, inverse only.
// 10, determinant only.
//
{
//
// Compute determinant.
//
if (job / 10 != 0)
{
det[0] = 1.0;
det[1] = 0.0;
int ii = 0;
int i;
for (i = 1; i <= n; i++)
{
ii += i;
det[0] = det[0] * ap[ii - 1].Real * ap[ii - 1].Real;
if (det[0] == 0.0)
{
break;
}
while (det[0] < 1.0)
{
det[0] *= 10.0;
det[1] -= 1.0;
}
while (10.0 <= det[0])
{
det[0] /= 10.0;
det[1] += 1.0;
}
}
}
//
// Compute inverse ( R ).
//
if (job % 10 == 0)
{
return;
}
int kk = 0;
int k1;
int kj;
int k;
Complex t;
int j;
int j1;
for (k = 1; k <= n; k++)
{
k1 = kk + 1;
kk += k;
ap[kk - 1] = new Complex(1.0, 0.0) / ap[kk - 1];
t = -ap[kk - 1];
BLAS1Z.zscal(k - 1, t, ref ap, 1, index: +k1 - 1);
int kp1 = k + 1;
j1 = kk + 1;
kj = kk + k;
for (j = kp1; j <= n; j++)
{
t = ap[kj - 1];
ap[kj - 1] = new Complex(0.0, 0.0);
BLAS1Z.zaxpy(k, t, ap, 1, ref ap, 1, xIndex: +k1 - 1, yIndex: +j1 - 1);
j1 += j;
kj += j;
}
}
//
// Form inverse ( R ) * hermitian ( 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 = Complex.Conjugate(ap[kj - 1]);
BLAS1Z.zaxpy(k, t, ap, 1, ref ap, 1, xIndex: +j1 - 1, yIndex: k1 - 1);
k1 += k;
kj += 1;
}
t = Complex.Conjugate(ap[jj - 1]);
BLAS1Z.zscal(j, t, ref ap, 1, index: +j1 - 1);
}
}
public static void zpodi(ref Complex[] a, int lda, int n, ref double[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// ZPODI: determinant, inverse of a complex hermitian positive definite matrix.
//
// Discussion:
//
// The matrix is assumed to have been factored by ZPOCO, ZPOFA or ZQRDC.
//
// 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 ZPOCO or ZPOFA 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 output A from ZPOCO or
// ZPOFA, or the output X from ZQRDC. On output, if ZPOCO or ZPOFA was
// used to factor A, then ZPODI produces the upper half of inverse(A).
// If ZQRDC was used to decompose X, then ZPODI produces the upper half
// of inverse(hermitian(X)*X) where hermitian(X) is the conjugate transpose.
// Elements of A below the diagonal are unchanged.
// If the units digit of JOB is zero, A is unchanged.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Output, double DET[2], if requested, the determinant of A or of
// hermitian(X)*X. Determinant = DET(1) * 10.0**DET(2) with
// 1.0 <= abs ( DET(1) ) < 10.0 or DET(1) = 0.0.
//
// Input, int JOB.
// 11, both determinant and inverse.
// 01, inverse only.
// 10, determinant only.
//
{
//
// Compute determinant
//
if (job / 10 != 0)
{
det[0] = 1.0;
det[1] = 0.0;
int i;
for (i = 0; i < n; i++)
{
det[0] = det[0] * a[i + i * lda].Real * a[i + i * lda].Real;
if (det[0] == 0.0)
{
break;
}
while (det[0] < 1.0)
{
det[0] *= 10.0;
det[1] -= 1.0;
}
while (10.0 <= det[0])
{
det[0] /= 10.0;
det[1] += 1.0;
}
}
}
//
// Compute inverse(R).
//
if (job % 10 == 0)
{
return;
}
int j;
int k;
Complex t;
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(R) * hermitian(inverse(R)).
//
for (j = 1; j <= n; j++)
{
for (k = 1; k <= j - 1; k++)
{
t = Complex.Conjugate(a[k - 1 + (j - 1) * lda]);
BLAS1Z.zaxpy(k, t, a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda, yIndex: +0 + (k - 1) * lda);
}
t = Complex.Conjugate(a[j - 1 + (j - 1) * lda]);
BLAS1Z.zscal(j, t, ref a, 1, index: +0 + (j - 1) * lda);
}
}
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 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 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 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 int ztrdi(ref Complex[] t, int ldt, int n, ref Complex[] det,
int job)
//****************************************************************************80
//
// Purpose:
//
// ZTRDI computes the determinant and inverse of a complex triangular matrix.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, Complex T[LDT*N], the triangular matrix. The zero
// elements of the matrix are not referenced, and the corresponding
// elements of the array can be used to store other information.
// On output, if an inverse was requested, then T has been overwritten
// by its inverse.
//
// Input, int LDT, the leading dimension of T.
//
// Input, int N, the order of the matrix.
//
// Input, int JOB.
// 010, no determinant, inverse, matrix is lower triangular.
// 011, no determinant, inverse, matrix is upper triangular.
// 100, determinant, no inverse.
// 110, determinant, inverse, matrix is lower triangular.
// 111, determinant, inverse, matrix is upper triangular.
//
// 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.
//
// Output, int ZTRDI.
// 0, an inverse was requested and the matrix is nonsingular.
// K, an inverse was requested, but the K-th diagonal element
// of T is zero.
//
{
int info = 0;
if (job / 100 != 0)
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
int i;
for (i = 0; i < n; i++)
{
det[0] *= t[i + i * ldt];
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 of upper triangular matrix.
//
if (job / 10 % 10 == 0)
{
return(info);
}
Complex temp;
int j;
int k;
if (job % 10 != 0)
{
info = 0;
for (k = 0; k < n; k++)
{
if (typeMethods.zabs1(t[k + k * ldt]) == 0.0)
{
info = k + 1;
break;
}
t[k + k * ldt] = new Complex(1.0, 0.0) / t[k + k * ldt];
temp = -t[k + k * ldt];
BLAS1Z.zscal(k, temp, ref t, 1, index: +0 + k * ldt);
for (j = k + 1; j < n; j++)
{
temp = t[k + j * ldt];
t[k + j * ldt] = new Complex(0.0, 0.0);
BLAS1Z.zaxpy(k + 1, temp, t, 1, ref t, 1, xIndex: +0 + k * ldt, yIndex: +0 + j * ldt);
}
}
}
//
// Compute inverse of lower triangular matrix.
//
else
{
info = 0;
for (k = n - 1; 0 <= k; k--)
{
if (typeMethods.zabs1(t[k + k * ldt]) == 0.0)
{
info = k + 1;
break;
}
t[k + k * ldt] = new Complex(1.0, 0.0) / t[k + k * ldt];
if (k != n - 1)
{
temp = -t[k + k * ldt];
BLAS1Z.zscal(n - k - 1, temp, ref t, 1, index: +k + 1 + k * ldt);
}
for (j = 0; j < k; j++)
{
temp = t[k + j * ldt];
t[k + j * ldt] = new Complex(0.0, 0.0);
BLAS1Z.zaxpy(n - k, temp, t, 1, ref t, 1, xIndex: +k + k * ldt, yIndex: +k + j * ldt);
}
}
}
return(info);
}
