private static void drotg_test()
//****************************************************************************80
//
// Purpose:
//
// DROTG_TEST tests DROTG.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 15 May 2006
//
// Author:
//
// John Burkardt
//
{
double c = 0;
double s = 0;
int test_num = 5;
Console.WriteLine("");
Console.WriteLine("DROTG_TEST");
Console.WriteLine(" DROTG generates a real Givens rotation");
Console.WriteLine(" ( C S ) * ( A ) = ( R )");
Console.WriteLine(" ( -S C ) ( B ) ( 0 )");
Console.WriteLine("");
int seed = 123456789;
for (int test = 1; test <= test_num; test++)
{
double a = UniformRNG.r8_uniform_01(ref seed);
double b = UniformRNG.r8_uniform_01(ref seed);
double sa = a;
double sb = b;
BLAS1D.drotg(ref sa, ref sb, ref c, ref s);
double r = sa;
double z = sb;
Console.WriteLine("");
Console.WriteLine(" A = " + a + " B = " + b + "");
Console.WriteLine(" C = " + c + " S = " + s + "");
Console.WriteLine(" R = " + r + " Z = " + z + "");
Console.WriteLine(" C*A+S*B = " + (c * a + s * b) + "");
Console.WriteLine(" -S*A+C*B = " + (-s * a + c * b) + "");
}
}
public static void dchud(ref double[] r, int ldr, int p, double[] x, ref double[] z, int ldz,
int nz, double[] y, ref double[] rho, ref double[] c, ref double[] s)
//****************************************************************************80
//
// Purpose:
//
// DCHUD updates an augmented Cholesky decomposition.
//
// Discussion:
//
// DCHUD can also update the triangular part 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, DCHUD determines a unitary matrix
// U and a scalar ZETA such that
//
// (R Z) (RR ZZ )
// U * ( ) = ( ),
// (X Y) ( 0 ZETA)
//
// 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) appended. In this case, if RHO is the
// norm of the residual vector, then the norm of the residual vector of
// the updated problem is sqrt ( RHO * RHO + ZETA * ZETA ). DCHUD will
// simultaneously update several triplets (Z, Y, RHO).
//
// For a less terse description of what DCHUD does and how
// it may be applied, see the LINPACK guide.
//
// The matrix U is determined as the product U(P)*...*U(1),
// where U(I) is a rotation in the (I,P+1) plane of the form
//
// ( C(I) S(I) )
// ( ).
// ( -S(I) C(I) )
//
// The rotations are chosen so that C(I) is real.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 08 June 2005
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// 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.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double R[LDR*P], the upper triangular matrix to be
// updated. The part of R below the diagonal is not referenced.
// On output, the matrix has been updated.
//
// Input, int LDR, the leading dimension of the array R.
// LDR must be at least equal to P.
//
// Input, int P, the order of the matrix R.
//
// Input, double X[P], the row to be added to R.
//
// Input/output, double Z[LDZ*NZ], contains NZ P-vectors
// to be updated with R.
//
// Input, int LDZ, the leading dimension of the array Z.
// LDZ must be at least P.
//
// Input, int NZ, the number of vectors to be updated. NZ may be
// zero, in which case Z, Y, and RHO are not referenced.
//
// Input, double Y[NZ], the scalars for updating the vectors Z.
//
// Input/output, double RHO[NZ]. On input, the norms of the
// residual vectors to be updated. If RHO(J) is negative, it is left
// unaltered.
//
// Output, double C[P], S[P], the cosines and sines of the
// transforming rotations.
//
{
int i;
int j;
double t;
//
// Update R.
//
for (j = 1; j <= p; j++)
{
double xj = x[j - 1];
//
// Apply the previous rotations.
//
for (i = 1; i <= j - 1; i++)
{
t = c[i - 1] * r[i - 1 + (j - 1) * ldz] + s[i - 1] * xj;
xj = c[i - 1] * xj - s[i - 1] * r[i - 1 + (j - 1) * ldz];
r[i - 1 + (j - 1) * ldz] = t;
}
//
// Compute the next rotation.
//
BLAS1D.drotg(ref r[j - 1 + (j - 1) * ldr], ref xj, ref c[j - 1], ref s[j - 1]);
}
//
// If required, update Z and RHO.
//
for (j = 1; j <= nz; j++)
{
double zeta = y[j - 1];
for (i = 1; i <= p; i++)
{
t = c[i - 1] * z[i - 1 + (j - 1) * ldz] + s[i - 1] * zeta;
zeta = c[i - 1] * zeta - s[i - 1] * z[i - 1 + (j - 1) * ldz];
z[i - 1 + (j - 1) * ldz] = t;
}
double azeta = Math.Abs(zeta);
if (azeta == 0.0 || !(0.0 <= rho[j - 1]))
{
continue;
}
double scale = azeta + rho[j - 1];
rho[j - 1] = scale * Math.Sqrt(
Math.Pow(azeta / scale, 2) + Math.Pow(rho[j - 1] / scale, 2));
}
}
public static void dchex(ref double[] r, int ldr, int p, int k, int l, ref double[] z, int ldz,
int nz, ref double[] c, ref double[] s, int job)
//****************************************************************************80
//
// Purpose:
//
// DCHEX updates the Cholesky factorization of a positive definite matrix.
//
// Discussion:
//
// The factorization has the form
//
// A = R' * R
//
// where A is a positive definite matrix of order P.
//
// The updating involves diagonal permutations of the form
//
// E' * A * E
//
// where E is a permutation matrix. Specifically, given
// an upper triangular matrix R and a permutation matrix
// E (which is specified by K, L, and JOB), DCHEX determines
// an orthogonal matrix U such that
//
// U * R * E = RR,
//
// where RR is upper triangular. At the user's option, the
// transformation U will be multiplied into the array Z.
// If A = X'*X, so that R is the triangular part of the
// QR factorization of X, then RR is the triangular part of the
// QR factorization of X*E, that is, X with its columns permuted.
//
// For a less terse description of what DCHEX does and how
// it may be applied, see the LINPACK guide.
//
// The matrix Q is determined as the product U(L-K)*...*U(1)
// of plane rotations of the form
//
// ( C(I) S(I) )
// ( ),
// ( -S(I) C(I) )
//
// where C(I) is real, the rows these rotations operate on
// are described below.
//
// There are two types of permutations, which are determined
// by the value of JOB.
//
// 1, right circular shift. The columns are rearranged in the order:
//
// 1,...,K-1,L,K,K+1,...,L-1,L+1,...,P.
//
// U is the product of L-K rotations U(I), where U(I)
// acts in the (L-I,L-I+1)-plane.
//
// 2, left circular shift: the columns are rearranged in the order
//
// 1,...,K-1,K+1,K+2,...,L,K,L+1,...,P.
//
// U is the product of L-K rotations U(I), where U(I)
// acts in the (K+I-1,K+I)-plane.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 23 June 2009
//
// Author:
//
// Original FORTRAN77 version by Jack Dongarra, Cleve Moler, Jim Bunch,
// Pete Stewart.
// 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.
// ISBN 0-89871-172-X
//
// Parameters:
//
// Input/output, double R[LDR*P]. On input, the upper
// triangular factor that is to be updated. Elements of R below the
// diagonal are not referenced. On output, R has been updated.
//
// Input, int LDR, the leading dimension of the array R.
// LDR must be at least P.
//
// Input, int P, the order of the matrix R.
//
// Input, int K, the first column to be permuted.
//
// Input, int L, the last column to be permuted.
// L must be strictly greater than K.
//
// Input/output double Z[LDZ*NZ], an array of NZ P-vectors into
// which the transformation U is multiplied. Z is not referenced if NZ = 0.
// On output, Z has been updated.
//
// Input, int LDZ, the leading dimension of the array Z.
// LDZ must be at least P.
//
// Input, int NZ, the number of columns of the matrix Z.
//
// Output, double C[P], S[P], the cosines and sines of the
// transforming rotations.
//
// Input, int JOB, determines the type of permutation.
// 1, right circular shift.
// 2, left circular shift.
//
{
int i;
int ii;
int j;
int jj;
double t;
//
// Initialize
//
int lmk = l - k;
int lm1 = l - 1;
switch (job)
{
//
// Right circular shift.
//
case 1:
{
//
// Reorder the columns.
//
for (i = 1; i <= l; i++)
{
ii = l - i + 1;
s[i - 1] = r[ii - 1 + (l - 1) * ldr];
}
for (jj = k; jj <= lm1; jj++)
{
j = lm1 - jj + k;
for (i = 1; i <= j; i++)
{
r[i - 1 + j * ldr] = r[i - 1 + (j - 1) * ldr];
}
r[j + j * ldr] = 0.0;
}
for (i = 1; i <= k - 1; i++)
{
ii = l - i + 1;
r[i - 1 + (k - 1) * ldr] = s[ii - 1];
}
//
// Calculate the rotations.
//
t = s[0];
for (i = 1; i <= lmk; i++)
{
BLAS1D.drotg(ref s[i], ref t, ref c[i - 1], ref s[i - 1]);
t = s[i];
}
r[k - 1 + (k - 1) * ldr] = t;
for (j = k + 1; j <= p; j++)
{
int il = Math.Max(1, l - j + 1);
for (ii = il; ii <= lmk; ii++)
{
i = l - ii;
t = c[ii - 1] * r[i - 1 + (j - 1) * ldr] + s[ii - 1] * r[i + (j - 1) * ldr];
r[i + (j - 1) * ldr] = c[ii - 1] * r[i + (j - 1) * ldr] - s[ii - 1] * r[i - 1 + (j - 1) * ldr];
r[i - 1 + (j - 1) * ldr] = t;
}
}
//
// If required, apply the transformations to Z.
//
for (j = 1; j <= nz; j++)
{
for (ii = 1; ii <= lmk; ii++)
{
i = l - ii;
t = c[ii - 1] * z[i - 1 + (j - 1) * ldr] + s[ii - 1] * z[i + (j - 1) * ldr];
z[i + (j - 1) * ldr] = c[ii - 1] * z[i + (j - 1) * ldr] - s[ii - 1] * z[i - 1 + (j - 1) * ldr];
z[i - 1 + (j - 1) * ldr] = t;
}
}
break;
}
//
default:
{
//
// Reorder the columns.
//
for (i = 1; i <= k; i++)
{
ii = lmk + i;
s[ii - 1] = r[i - 1 + (k - 1) * ldr];
}
for (j = k; j <= lm1; j++)
{
for (i = 1; i <= j; i++)
{
r[i - 1 + (j - 1) * ldr] = r[i - 1 + j * ldr];
}
jj = j - k + 1;
s[jj - 1] = r[j + j * ldr];
}
for (i = 1; i <= k; i++)
{
ii = lmk + i;
r[i - 1 + (l - 1) * ldr] = s[ii - 1];
}
for (i = k + 1; i <= l; i++)
{
r[i - 1 + (l - 1) * ldr] = 0.0;
}
//
// Reduction loop.
//
for (j = k; j <= p; j++)
{
//
// Apply the rotations.
//
if (j != k)
{
int iu = Math.Min(j - 1, l - 1);
for (i = k; i <= iu; i++)
{
ii = i - k + 1;
t = c[ii - 1] * r[i - 1 + (j - 1) * ldr] + s[ii - 1] * r[i + (j - 1) * ldr];
r[i + (j - 1) * ldr] = c[ii - 1] * r[i + (j - 1) * ldr]
- s[ii - 1] * r[i - 1 + (j - 1) * ldr];
r[i - 1 + (j - 1) * ldr] = t;
}
}
if (j >= l)
{
continue;
}
jj = j - k + 1;
t = s[jj - 1];
BLAS1D.drotg(ref r[j - 1 + (j - 1) * ldr], ref t, ref c[jj - 1], ref s[jj - 1]);
}
//
// Apply the rotations to Z.
//
for (j = 1; j <= nz; j++)
{
for (i = k; i <= lm1; i++)
{
ii = i - k + 1;
t = c[ii - 1] * z[i - 1 + (j - 1) * ldr] + s[ii - 1] * z[i + (j - 1) * ldr];
z[i + (j - 1) * ldr] = c[ii - 1] * z[i + (j - 1) * ldr] - s[ii - 1] * z[i - 1 + (j - 1) * ldr];
z[i - 1 + (j - 1) * ldr] = t;
}
}
break;
}
}
}
