bool generalizedsymmetricdefiniteevdreduce(ap::real_2d_array& a,
int n,
bool isuppera,
const ap::real_2d_array& b,
bool isupperb,
int problemtype,
ap::real_2d_array& r,
bool& isupperr)
{
bool result;
ap::real_2d_array t;
ap::real_1d_array w1;
ap::real_1d_array w2;
ap::real_1d_array w3;
int i;
int j;
double v;
ap::ap_error::make_assertion(n>0, "GeneralizedSymmetricDefiniteEVDReduce: N<=0!");
ap::ap_error::make_assertion(problemtype==1||problemtype==2||problemtype==3, "GeneralizedSymmetricDefiniteEVDReduce: incorrect ProblemType!");
result = true;
//
// Problem 1: A*x = lambda*B*x
//
// Reducing to:
// C*y = lambda*y
// C = L^(-1) * A * L^(-T)
// x = L^(-T) * y
//
if( problemtype==1 )
{
//
// Factorize B in T: B = LL'
//
t.setbounds(1, n, 1, n);
if( isupperb )
{
for(i = 1; i <= n; i++)
{
ap::vmove(t.getcolumn(i, i, n), b.getrow(i, i, n));
}
}
else
{
for(i = 1; i <= n; i++)
{
ap::vmove(&t(i, 1), &b(i, 1), ap::vlen(1,i));
}
}
if( !choleskydecomposition(t, n, false) )
{
result = false;
return result;
}
//
// Invert L in T
//
if( !invtriangular(t, n, false, false) )
{
result = false;
return result;
}
//
// Build L^(-1) * A * L^(-T) in R
//
w1.setbounds(1, n);
w2.setbounds(1, n);
r.setbounds(1, n, 1, n);
for(j = 1; j <= n; j++)
{
//
// Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T))
//
ap::vmove(&w1(1), &t(j, 1), ap::vlen(1,j));
symmetricmatrixvectormultiply(a, isuppera, 1, j, w1, 1.0, w2);
if( isuppera )
{
matrixvectormultiply(a, 1, j, j+1, n, true, w1, 1, j, 1.0, w2, j+1, n, 0.0);
}
else
{
matrixvectormultiply(a, j+1, n, 1, j, false, w1, 1, j, 1.0, w2, j+1, n, 0.0);
}
//
// Form l(i)*w2 (here l(i) is i-th row of L^(-1))
//
for(i = 1; i <= n; i++)
{
v = ap::vdotproduct(&t(i, 1), &w2(1), ap::vlen(1,i));
r(i,j) = v;
}
}
//
// Copy R to A
//
for(i = 1; i <= n; i++)
{
ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n));
}
//
// Copy L^(-1) from T to R and transpose
//
isupperr = true;
for(i = 1; i <= n; i++)
{
for(j = 1; j <= i-1; j++)
{
r(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
ap::vmove(r.getrow(i, i, n), t.getcolumn(i, i, n));
}
return result;
}
//
// Problem 2: A*B*x = lambda*x
// or
// problem 3: B*A*x = lambda*x
//
// Reducing to:
// C*y = lambda*y
// C = U * A * U'
// B = U'* U
//
if( problemtype==2||problemtype==3 )
{
//
// Factorize B in T: B = U'*U
//
t.setbounds(1, n, 1, n);
if( isupperb )
{
for(i = 1; i <= n; i++)
{
ap::vmove(&t(i, i), &b(i, i), ap::vlen(i,n));
}
}
else
{
for(i = 1; i <= n; i++)
{
ap::vmove(t.getrow(i, i, n), b.getcolumn(i, i, n));
}
}
if( !choleskydecomposition(t, n, true) )
{
result = false;
return result;
}
//
// Build U * A * U' in R
//
w1.setbounds(1, n);
w2.setbounds(1, n);
w3.setbounds(1, n);
r.setbounds(1, n, 1, n);
for(j = 1; j <= n; j++)
{
//
// Form w2 = A * u'(j) (here u'(j) is j-th column of U')
//
ap::vmove(&w1(1), &t(j, j), ap::vlen(1,n-j+1));
symmetricmatrixvectormultiply(a, isuppera, j, n, w1, 1.0, w3);
ap::vmove(&w2(j), &w3(1), ap::vlen(j,n));
ap::vmove(&w1(j), &t(j, j), ap::vlen(j,n));
if( isuppera )
{
matrixvectormultiply(a, 1, j-1, j, n, false, w1, j, n, 1.0, w2, 1, j-1, 0.0);
}
else
{
matrixvectormultiply(a, j, n, 1, j-1, true, w1, j, n, 1.0, w2, 1, j-1, 0.0);
}
//
// Form u(i)*w2 (here u(i) is i-th row of U)
//
for(i = 1; i <= n; i++)
{
v = ap::vdotproduct(&t(i, i), &w2(i), ap::vlen(i,n));
r(i,j) = v;
}
}
//
// Copy R to A
//
for(i = 1; i <= n; i++)
{
ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n));
}
if( problemtype==2 )
{
//
// Invert U in T
//
if( !invtriangular(t, n, true, false) )
{
result = false;
return result;
}
//
// Copy U^-1 from T to R
//
isupperr = true;
for(i = 1; i <= n; i++)
{
for(j = 1; j <= i-1; j++)
{
r(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
ap::vmove(&r(i, i), &t(i, i), ap::vlen(i,n));
}
}
else
{
//
// Copy U from T to R and transpose
//
isupperr = false;
for(i = 1; i <= n; i++)
{
for(j = i+1; j <= n; j++)
{
r(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
ap::vmove(r.getcolumn(i, i, n), t.getrow(i, i, n));
}
}
}
return result;
}
/*************************************************************************
Reduction of a symmetric matrix which is given by its higher or lower
triangular part to a tridiagonal matrix using orthogonal similarity
transformation: Q'*A*Q=T.
Input parameters:
A - matrix to be transformed
array with elements [0..N-1, 0..N-1].
N - size of matrix A.
IsUpper - storage format. If IsUpper = True, then matrix A is given
by its upper triangle, and the lower triangle is not used
and not modified by the algorithm, and vice versa
if IsUpper = False.
Output parameters:
A - matrices T and Q in compact form (see lower)
Tau - array of factors which are forming matrices H(i)
array with elements [0..N-2].
D - main diagonal of symmetric matrix T.
array with elements [0..N-1].
E - secondary diagonal of symmetric matrix T.
array with elements [0..N-2].
If IsUpper=True, the matrix Q is represented as a product of elementary
reflectors
Q = H(n-2) . . . H(2) H(0).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a real scalar, and v is a real vector with
v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
A(0:i-1,i+1), and tau in TAU(i).
If IsUpper=False, the matrix Q is represented as a product of elementary
reflectors
Q = H(0) H(2) . . . H(n-2).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a real scalar, and v is a real vector with
v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
and tau in TAU(i).
The contents of A on exit are illustrated by the following examples
with n = 5:
if UPLO = 'U': if UPLO = 'L':
( d e v1 v2 v3 ) ( d )
( d e v2 v3 ) ( e d )
( d e v3 ) ( v0 e d )
( d e ) ( v0 v1 e d )
( d ) ( v0 v1 v2 e d )
where d and e denote diagonal and off-diagonal elements of T, and vi
denotes an element of the vector defining H(i).
-- LAPACK routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
October 31, 1992
*************************************************************************/
void smatrixtd(ap::real_2d_array& a,
int n,
bool isupper,
ap::real_1d_array& tau,
ap::real_1d_array& d,
ap::real_1d_array& e)
{
int i;
double alpha;
double taui;
double v;
ap::real_1d_array t;
ap::real_1d_array t2;
ap::real_1d_array t3;
if( n<=0 )
{
return;
}
t.setbounds(1, n);
t2.setbounds(1, n);
t3.setbounds(1, n);
if( n>1 )
{
tau.setbounds(0, n-2);
}
d.setbounds(0, n-1);
if( n>1 )
{
e.setbounds(0, n-2);
}
if( isupper )
{
//
// Reduce the upper triangle of A
//
for(i = n-2; i >= 0; i--)
{
//
// Generate elementary reflector H() = E - tau * v * v'
//
if( i>=1 )
{
ap::vmove(t.getvector(2, i+1), a.getcolumn(i+1, 0, i-1));
}
t(1) = a(i,i+1);
generatereflection(t, i+1, taui);
if( i>=1 )
{
ap::vmove(a.getcolumn(i+1, 0, i-1), t.getvector(2, i+1));
}
a(i,i+1) = t(1);
e(i) = a(i,i+1);
if( taui!=0 )
{
//
// Apply H from both sides to A
//
a(i,i+1) = 1;
//
// Compute x := tau * A * v storing x in TAU
//
ap::vmove(t.getvector(1, i+1), a.getcolumn(i+1, 0, i));
symmetricmatrixvectormultiply(a, isupper, 0, i, t, taui, t3);
ap::vmove(&tau(0), &t3(1), ap::vlen(0,i));
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
v = ap::vdotproduct(tau.getvector(0, i), a.getcolumn(i+1, 0, i));
alpha = -0.5*taui*v;
ap::vadd(tau.getvector(0, i), a.getcolumn(i+1, 0, i), alpha);
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
ap::vmove(t.getvector(1, i+1), a.getcolumn(i+1, 0, i));
ap::vmove(&t3(1), &tau(0), ap::vlen(1,i+1));
symmetricrank2update(a, isupper, 0, i, t, t3, t2, double(-1));
a(i,i+1) = e(i);
}
d(i+1) = a(i+1,i+1);
tau(i) = taui;
}
d(0) = a(0,0);
}
else
{
//
// Reduce the lower triangle of A
//
for(i = 0; i <= n-2; i++)
{
//
// Generate elementary reflector H = E - tau * v * v'
//
ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1));
generatereflection(t, n-i-1, taui);
ap::vmove(a.getcolumn(i, i+1, n-1), t.getvector(1, n-i-1));
e(i) = a(i+1,i);
if( taui!=0 )
{
//
// Apply H from both sides to A
//
a(i+1,i) = 1;
//
// Compute x := tau * A * v storing y in TAU
//
ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1));
symmetricmatrixvectormultiply(a, isupper, i+1, n-1, t, taui, t2);
ap::vmove(&tau(i), &t2(1), ap::vlen(i,n-2));
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
v = ap::vdotproduct(tau.getvector(i, n-2), a.getcolumn(i, i+1, n-1));
alpha = -0.5*taui*v;
ap::vadd(tau.getvector(i, n-2), a.getcolumn(i, i+1, n-1), alpha);
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
//
ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1));
ap::vmove(&t2(1), &tau(i), ap::vlen(1,n-i-1));
symmetricrank2update(a, isupper, i+1, n-1, t, t2, t3, double(-1));
a(i+1,i) = e(i);
}
d(i) = a(i,i);
tau(i) = taui;
}
d(n-1) = a(n-1,n-1);
}
}
/*************************************************************************
Obsolete 1-based subroutine
*************************************************************************/
void totridiagonal(ap::real_2d_array& a,
int n,
bool isupper,
ap::real_1d_array& tau,
ap::real_1d_array& d,
ap::real_1d_array& e)
{
int i;
int ip1;
int im1;
int nmi;
int nm1;
double alpha;
double taui;
double v;
ap::real_1d_array t;
ap::real_1d_array t2;
ap::real_1d_array t3;
if( n<=0 )
{
return;
}
t.setbounds(1, n);
t2.setbounds(1, n);
t3.setbounds(1, n);
tau.setbounds(1, ap::maxint(1, n-1));
d.setbounds(1, n);
e.setbounds(1, ap::maxint(1, n-1));
if( isupper )
{
//
// Reduce the upper triangle of A
//
for(i = n-1; i >= 1; i--)
{
//
// Generate elementary reflector H(i) = I - tau * v * v'
// to annihilate A(1:i-1,i+1)
//
// DLARFG( I, A( I, I+1 ), A( 1, I+1 ), 1, TAUI );
//
ip1 = i+1;
im1 = i-1;
if( i>=2 )
{
ap::vmove(t.getvector(2, i), a.getcolumn(ip1, 1, im1));
}
t(1) = a(i,ip1);
generatereflection(t, i, taui);
if( i>=2 )
{
ap::vmove(a.getcolumn(ip1, 1, im1), t.getvector(2, i));
}
a(i,ip1) = t(1);
e(i) = a(i,i+1);
if( taui!=0 )
{
//
// Apply H(i) from both sides to A(1:i,1:i)
//
a(i,i+1) = 1;
//
// Compute x := tau * A * v storing x in TAU(1:i)
//
// DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, TAU, 1 );
//
ip1 = i+1;
ap::vmove(t.getvector(1, i), a.getcolumn(ip1, 1, i));
symmetricmatrixvectormultiply(a, isupper, 1, i, t, taui, tau);
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
ip1 = i+1;
v = ap::vdotproduct(tau.getvector(1, i), a.getcolumn(ip1, 1, i));
alpha = -0.5*taui*v;
ap::vadd(tau.getvector(1, i), a.getcolumn(ip1, 1, i), alpha);
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
// DSYR2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A, LDA );
//
ap::vmove(t.getvector(1, i), a.getcolumn(ip1, 1, i));
symmetricrank2update(a, isupper, 1, i, t, tau, t2, double(-1));
a(i,i+1) = e(i);
}
d(i+1) = a(i+1,i+1);
tau(i) = taui;
}
d(1) = a(1,1);
}
else
{
//
// Reduce the lower triangle of A
//
for(i = 1; i <= n-1; i++)
{
//
// Generate elementary reflector H(i) = I - tau * v * v'
// to annihilate A(i+2:n,i)
//
//DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, TAUI );
//
nmi = n-i;
ip1 = i+1;
ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n));
generatereflection(t, nmi, taui);
ap::vmove(a.getcolumn(i, ip1, n), t.getvector(1, nmi));
e(i) = a(i+1,i);
if( taui!=0 )
{
//
// Apply H(i) from both sides to A(i+1:n,i+1:n)
//
a(i+1,i) = 1;
//
// Compute x := tau * A * v storing y in TAU(i:n-1)
//
//DSYMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA, A( I+1, I ), 1, ZERO, TAU( I ), 1 );
//
ip1 = i+1;
nmi = n-i;
nm1 = n-1;
ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n));
symmetricmatrixvectormultiply(a, isupper, i+1, n, t, taui, t2);
ap::vmove(&tau(i), &t2(1), ap::vlen(i,nm1));
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
nm1 = n-1;
ip1 = i+1;
v = ap::vdotproduct(tau.getvector(i, nm1), a.getcolumn(i, ip1, n));
alpha = -0.5*taui*v;
ap::vadd(tau.getvector(i, nm1), a.getcolumn(i, ip1, n), alpha);
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
//DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, A( I+1, I+1 ), LDA );
//
nm1 = n-1;
nmi = n-i;
ip1 = i+1;
ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n));
ap::vmove(&t2(1), &tau(i), ap::vlen(1,nmi));
symmetricrank2update(a, isupper, i+1, n, t, t2, t3, double(-1));
a(i+1,i) = e(i);
}
d(i) = a(i,i);
tau(i) = taui;
}
d(n) = a(n,n);
}
}
bool testsblas(bool silent)
{
bool result;
ap::real_2d_array a;
ap::real_2d_array ua;
ap::real_2d_array la;
ap::real_1d_array x;
ap::real_1d_array y1;
ap::real_1d_array y2;
ap::real_1d_array y3;
int n;
int maxn;
int i;
int j;
int i1;
int i2;
int gpass;
bool waserrors;
double mverr;
double threshold;
double alpha;
double v;
mverr = 0;
waserrors = false;
maxn = 10;
threshold = 1000*ap::machineepsilon;
//
// Test MV
//
for(n = 2; n <= maxn; n++)
{
a.setbounds(1, n, 1, n);
ua.setbounds(1, n, 1, n);
la.setbounds(1, n, 1, n);
x.setbounds(1, n);
y1.setbounds(1, n);
y2.setbounds(1, n);
y3.setbounds(1, n);
//
// fill A, UA, LA
//
for(i = 1; i <= n; i++)
{
a(i,i) = 2*ap::randomreal()-1;
for(j = i+1; j <= n; j++)
{
a(i,j) = 2*ap::randomreal()-1;
a(j,i) = a(i,j);
}
}
for(i = 1; i <= n; i++)
{
for(j = 1; j <= n; j++)
{
ua(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
for(j = i; j <= n; j++)
{
ua(i,j) = a(i,j);
}
}
for(i = 1; i <= n; i++)
{
for(j = 1; j <= n; j++)
{
la(i,j) = 0;
}
}
for(i = 1; i <= n; i++)
{
for(j = 1; j <= i; j++)
{
la(i,j) = a(i,j);
}
}
//
// test on different I1, I2
//
for(i1 = 1; i1 <= n; i1++)
{
for(i2 = i1; i2 <= n; i2++)
{
//
// Fill X, choose Alpha
//
for(i = 1; i <= i2-i1+1; i++)
{
x(i) = 2*ap::randomreal()-1;
}
alpha = 2*ap::randomreal()-1;
//
// calculate A*x, UA*x, LA*x
//
for(i = i1; i <= i2; i++)
{
v = ap::vdotproduct(&a(i, i1), 1, &x(1), 1, ap::vlen(i1,i2));
y1(i-i1+1) = alpha*v;
}
symmetricmatrixvectormultiply(ua, true, i1, i2, x, alpha, y2);
symmetricmatrixvectormultiply(la, false, i1, i2, x, alpha, y3);
//
// Calculate error
//
ap::vsub(&y2(1), 1, &y1(1), 1, ap::vlen(1,i2-i1+1));
v = ap::vdotproduct(&y2(1), 1, &y2(1), 1, ap::vlen(1,i2-i1+1));
mverr = ap::maxreal(mverr, sqrt(v));
ap::vsub(&y3(1), 1, &y1(1), 1, ap::vlen(1,i2-i1+1));
v = ap::vdotproduct(&y3(1), 1, &y3(1), 1, ap::vlen(1,i2-i1+1));
mverr = ap::maxreal(mverr, sqrt(v));
}
}
}
//
// report
//
waserrors = ap::fp_greater(mverr,threshold);
if( !silent )
{
printf("TESTING SYMMETRIC BLAS\n");
printf("MV error: %5.3le\n",
double(mverr));
printf("Threshold: %5.3le\n",
double(threshold));
if( waserrors )
{
printf("TEST FAILED\n");
}
else
{
printf("TEST PASSED\n");
}
printf("\n\n");
}
result = !waserrors;
return result;
}
