/* ************************************************************
PROCEDURE prpiqxqt - computes tril(Qb * X * Qb')
Here, Qb = Q_1*Q_2*..*Q_{m-1}*diag(q(:,m)), where each Q_i is a
Householder reflection, and q(:,m) is a complex sign-vector.
(Qb is from a Qb * R decomposition.)
INPUT
beta - length m vector (real)
c,cpi - m x m matrix, lower triangular gives Householder reflections
m - order
UPDATED
x,xpi - m x m. On output, Xnew = Qb * X * Qb'
This means: start with order 2 reflection, up to order m reflection.
WORK
fwork - length 2*m working vector.
************************************************************ */
void prpiqxqt(double *x, double *xpi, const double *beta, const double *c,
const double *cpi, const mwIndex m, double *fwork)
{
mwIndex i,k, inz;
const double *qsgn, *qsgnpi;
double qk, qkim, qij,qijim, xij;
/* ------------------------------------------------------------
START BY COMPLEX SIGNING.
Let qsgn = c(:,m) be the sign vector. Then let
X_new = diag(qsgn) * X * diag(qsgn)' = qsign(i) * conj(qsign(j)) * x_ij
for i > j. The diagonal is not affected, since |qsign(i)| = 1.
------------------------------------------------------------ */
qsgn = c + m * (m-1);
qsgnpi = cpi + m * (m-1);
inz = 0;
for(k = 0; k < m-1; k++) {
inz += k+1; /* point below diagonal */
qk = qsgn[k];
qkim = qsgnpi[k];
for(i = k+1; i < m; i++) {
/* qij = conj(qsign(i)) * qsign(k) */
qij = qsgn[i]*qk + qsgnpi[i] * qkim;
qijim = qsgn[i]*qkim - qsgnpi[i] * qk;
/* xij *= conj(qij) */
xij = x[inz] * qij + xpi[inz] * qijim;
xpi[inz] = xpi[inz] * qij - x[inz] * qijim; /* conj qij */
x[inz] = xij; /* WRITE signed x-values */
inz++;
}
}
/* ------------------------------------------------------------
FINISH by Householder transformations:
For each k, c[inz] = c(k,k), the top of the lower-right block,
x[k] is start of k-th row in k.
------------------------------------------------------------ */
inz = SQR(m) - (m+2);
for(k = m-1; k > 0; k--, inz -= m+1)
prpielqxq(x + k-1,xpi + k-1, -beta[k-1], c + inz,cpi+inz, k-1, m, fwork);
}
/* ************************************************************
PROCEDURE prpiqtxq - computes tril(Qb' * X * Qb)
Here, Qb = Q_1*Q_2*..*Q_{m-1}*diag(q(:,m)), where each Q_i is a
Householder reflection, and q(:,m) is a complex sign-vector.
(Qb is from a Qb * R decomposition.)
INPUT
beta - length m vector (real)
c,cpi - m x m matrix, lower triangular gives Householder reflections
m - order
UPDATED
x,xpi - m x m. On output, Xnew = Qb' * X * Qb
This means: start with order m reflection, up to order 2 reflection.
WORK
fwork - length 2*m working vector.
************************************************************ */
void prpiqtxq(double *x, double *xpi, const double *beta, const double *c,
const double *cpi, const int m, double *fwork)
{
int i,k, inz;
const double *qsgn, *qsgnpi;
double qk, qkim, qij,qijim, xij;
/* ------------------------------------------------------------
START by Householder transformations:
For each k, c[inz] = c(k,k), the top of the lower-right block,
x[k] is start of k-th row in k.
------------------------------------------------------------ */
inz = 0;
for(k = 0; k < m-1; k++, inz += m+1)
prpielqxq(x + k,xpi + k, -beta[k], c + inz,cpi + inz, k, m, fwork);
/* ------------------------------------------------------------
FINISH BY COMPLEX SIGNING.
Let qsgn = c(:,m) be the sign vector. Then let
X_new = diag(qsgn)' * X * diag(qsgn) = conj(qsign(i)) * qsign(j) * x_ij
for i > j. The diagonal is not affected, since |qsign(i)| = 1.
------------------------------------------------------------ */
qsgn = c + m * (m-1);
qsgnpi = cpi + m * (m-1);
inz = 0;
for(k = 0; k < m-1; k++){
qk = qsgn[k]; qkim = qsgnpi[k];
inz += k+1; /* point below diagonal */
for(i = k+1; i < m; i++){
/* qij = conj(qsign(i)) * qsign(k) */
qij = qsgn[i]*qk + qsgnpi[i] * qkim;
qijim = qsgn[i]*qkim - qsgnpi[i] * qk;
/* xij *= qij */
xij = x[inz] * qij - xpi[inz] * qijim;
xpi[inz] = x[inz] * qijim + xpi[inz] * qij;
x[inz] = xij;
inz++;
}
}
}
