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 zcdhd(ref Complex[] r, int ldr, int p, Complex[] x,
ref Complex[] z, int ldz, int nz, Complex[] y, ref double[] rho,
ref double[] c, ref Complex[] s)
//****************************************************************************80
//
// Purpose:
//
// ZCHDD downdates an augmented Cholesky decomposition.
//
// Discussion:
//
// zcdhD downdates an augmented Cholesky decomposition or the
// triangular factor of an augmented QR decomposition.
// Specifically, given an upper triangular matrix R of order P, a
// row vector X, a column vector Z, and a scalar Y, ZCHDD
// determines a unitary matrix U and a scalar ZETA such that
//
// ( R Z ) ( RR ZZ )
// U * ( ) = ( ),
// ( 0 ZETA ) ( X Y )
//
// where RR is upper triangular. If R and Z have been obtained
// from the factorization of a least squares problem, then
// RR and ZZ are the factors corresponding to the problem
// with the observation (X,Y) removed. In this case, if RHO
// is the norm of the residual vector, then the norm of
// the residual vector of the downdated problem is
// Math.Sqrt ( RHO**2 - ZETA**2 ).
// zcdhD will simultaneously downdate several triplets (Z,Y,RHO)
// along with R.
//
// For a less terse description of what ZCHDD does and how
// it may be applied, see the LINPACK guide.
//
// The matrix U is determined as the product U(1)*...*U(P)
// where U(I) is a rotation in the (P+1,I)-plane of the
// form
//
// ( C(I) -Complex.Conjugate ( S(I) ) )
// ( ).
// ( S(I) C(I) )
//
// The rotations are chosen so that C(I) is real.
//
// The user is warned that a given downdating problem may
// be impossible to accomplish or may produce
// inaccurate results. For example, this can happen
// if X is near a vector whose removal will reduce the
// rank of R. Beware.
//
// 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 R[LDR*P]; on input, the upper triangular matrix
// that is to be downdated. On output, the downdated matrix. The
// part of R below the diagonal is not referenced.
//
// Input, int LDR, the leading dimension of R. P <= LDR.
//
// Input, int P, the order of the matrix.
//
// Input, Complex X(P), the row vector that is to
// be removed from R.
//
// Input/output, Complex Z[LDZ*NZ]; on input, an array of NZ
// P-vectors which are to be downdated along with R. On output,
// the downdated vectors.
//
// Input, int LDZ, the leading dimension of Z. P <= LDZ.
//
// Input, int NZ, the number of vectors to be downdated.
// NZ may be zero, in which case Z, Y, and R are not referenced.
//
// Input, Complex Y[NZ], the scalars for the downdating
// of the vectors Z.
//
// Input/output, double RHO[NZ]. On input, the norms of the residual
// vectors that are to be downdated. On output, the downdated norms.
//
// Output, double C[P], the cosines of the transforming rotations.
//
// Output, Complex S[P], the sines of the transforming rotations.
//
// Output, int ZCHDD:
// 0, if the entire downdating was successful.
// -1, if R could not be downdated. In this case, all quantities
// are left unaltered.
// 1, if some RHO could not be downdated. The offending RHO's are
// set to -1.
//
{
int i;
int ii;
int j;
//
// Solve the system hermitian(R) * A = X, placing the result in S.
//
int info = 0;
s[0] = Complex.Conjugate(x[0]) / Complex.Conjugate(r[0 + 0 * ldr]);
for (j = 2; j <= p; j++)
{
s[j - 1] = Complex.Conjugate(x[j - 1]) - BLAS1Z.zdotc(j - 1, r, 1, s, 1, xIndex: +0 + (j - 1) * ldr);
s[j - 1] /= Complex.Conjugate(r[j - 1 + (j - 1) * ldr]);
}
double norm = BLAS1Z.dznrm2(p, s, 1);
switch (norm)
{
case >= 1.0:
info = -1;
return(info);
}
double alpha = Math.Sqrt(1.0 - norm * norm);
//
// Determine the transformations.
//
for (ii = 1; ii <= p; ii++)
{
i = p - ii + 1;
double scale = alpha + Complex.Abs(s[i - 1]);
double a = alpha / scale;
Complex b = s[i - 1] / scale;
norm = Math.Sqrt(a * a + b.Real * b.Real + b.Imaginary * b.Imaginary);
c[i - 1] = a / norm;
s[i - 1] = Complex.Conjugate(b) / norm;
alpha = scale * norm;
}
//
// Apply the transformations to R.
//
for (j = 1; j <= p; j++)
{
Complex xx = new(0.0, 0.0);
for (ii = 1; ii <= j; ii++)
{
i = j - ii + 1;
Complex t = c[i - 1] * xx + s[i - 1] * r[i - 1 + (j - 1) * ldr];
r[i - 1 + (j - 1) * ldr] = c[i - 1] * r[i - 1 + (j - 1) * ldr] - Complex.Conjugate(s[i - 1]) * xx;
xx = t;
}
}
//
// If required, downdate Z and RHO.
//
for (j = 1; j <= nz; j++)
{
Complex zeta = y[j - 1];
for (i = 1; i <= p; i++)
{
z[i - 1 + (j - 1) * ldz] = (z[i - 1 + (j - 1) * ldz]
- Complex.Conjugate(s[i - 1]) * zeta) / c[i - 1];
zeta = c[i - 1] * zeta - s[i - 1] * z[i - 1 + (j - 1) * ldz];
}
double azeta = Complex.Abs(zeta);
if (rho[j - 1] < azeta)
{
info = 1;
rho[j - 1] = -1.0;
}
else
{
rho[j - 1] *= Math.Sqrt(1.0 - azeta / rho[j - 1] * (azeta / rho[j - 1]));
}
}
return(info);
}