/*************************************************************************
Solving a system of linear equations with a system matrix given by its
LU decomposition.
The algorithm solves a system of linear equations whose matrix is given by
its LU decomposition. In case of a singular matrix, the algorithm returns
False.
The algorithm solves systems with a square matrix only.
Input parameters:
A - LU decomposition of a system matrix in compact form (the
result of the RMatrixLU subroutine).
Pivots - row permutation table (the result of a
RMatrixLU subroutine).
B - right side of a system.
Array whose index ranges within [0..N-1].
N - size of matrix A.
Output parameters:
X - solution of a system.
Array whose index ranges within [0..N-1].
Result:
True, if the matrix is not singular.
False, if the matrux is singular. In this case, X doesn't contain a
solution.
-- ALGLIB --
Copyright 2005-2008 by Bochkanov Sergey
*************************************************************************/
bool cmatrixlusolve(const ap::complex_2d_array& a,
const ap::integer_1d_array& pivots,
ap::complex_1d_array b,
int n,
ap::complex_1d_array& x)
{
bool result;
ap::complex_1d_array y;
int i;
int j;
ap::complex v;
int i_;
y.setbounds(0, n-1);
x.setbounds(0, n-1);
result = true;
for(i = 0; i <= n-1; i++)
{
if( a(i,i)==0 )
{
result = false;
return result;
}
}
//
// pivots
//
for(i = 0; i <= n-1; i++)
{
if( pivots(i)!=i )
{
v = b(i);
b(i) = b(pivots(i));
b(pivots(i)) = v;
}
}
//
// Ly = b
//
y(0) = b(0);
for(i = 1; i <= n-1; i++)
{
v = 0.0;
for(i_=0; i_<=i-1; i_++)
{
v += a(i,i_)*y(i_);
}
y(i) = b(i)-v;
}
//
// Ux = y
//
x(n-1) = y(n-1)/a(n-1,n-1);
for(i = n-2; i >= 0; i--)
{
v = 0.0;
for(i_=i+1; i_<=n-1; i_++)
{
v += a(i,i_)*x(i_);
}
x(i) = (y(i)-v)/a(i,i);
}
return result;
}
/*************************************************************************
Reduction of a Hermitian matrix which is given by its higher or lower
triangular part to a real tridiagonal matrix using unitary 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 real symmetric matrix T.
array with elements [0..N-1].
E - secondary diagonal of real 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 complex scalar, and v is a complex 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 complex scalar, and v is a complex 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 hmatrixtd(ap::complex_2d_array& a,
int n,
bool isupper,
ap::complex_1d_array& tau,
ap::real_1d_array& d,
ap::real_1d_array& e)
{
int i;
ap::complex alpha;
ap::complex taui;
ap::complex v;
ap::complex_1d_array t;
ap::complex_1d_array t2;
ap::complex_1d_array t3;
int i_;
int i1_;
if( n<=0 )
{
return;
}
for(i = 0; i <= n-1; i++)
{
ap::ap_error::make_assertion(ap::fp_eq(a(i,i).y,0), "");
}
if( n>1 )
{
tau.setbounds(0, n-2);
e.setbounds(0, n-2);
}
d.setbounds(0, n-1);
t.setbounds(0, n-1);
t2.setbounds(0, n-1);
t3.setbounds(0, n-1);
if( isupper )
{
//
// Reduce the upper triangle of A
//
a(n-1,n-1) = a(n-1,n-1).x;
for(i = n-2; i >= 0; i--)
{
//
// Generate elementary reflector H = I+1 - tau * v * v'
//
alpha = a(i,i+1);
t(1) = alpha;
if( i>=1 )
{
i1_ = (0) - (2);
for(i_=2; i_<=i+1;i_++)
{
t(i_) = a(i_+i1_,i+1);
}
}
complexgeneratereflection(t, i+1, taui);
if( i>=1 )
{
i1_ = (2) - (0);
for(i_=0; i_<=i-1;i_++)
{
a(i_,i+1) = t(i_+i1_);
}
}
alpha = t(1);
e(i) = alpha.x;
if( taui!=0 )
{
//
// Apply H(I+1) from both sides to A
//
a(i,i+1) = 1;
//
// Compute x := tau * A * v storing x in TAU
//
i1_ = (0) - (1);
for(i_=1; i_<=i+1;i_++)
{
t(i_) = a(i_+i1_,i+1);
}
hermitianmatrixvectormultiply(a, isupper, 0, i, t, taui, t2);
i1_ = (1) - (0);
for(i_=0; i_<=i;i_++)
{
tau(i_) = t2(i_+i1_);
}
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
v = 0.0;
for(i_=0; i_<=i;i_++)
{
v += ap::conj(tau(i_))*a(i_,i+1);
}
alpha = -0.5*taui*v;
for(i_=0; i_<=i;i_++)
{
tau(i_) = tau(i_) + alpha*a(i_,i+1);
}
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
i1_ = (0) - (1);
for(i_=1; i_<=i+1;i_++)
{
t(i_) = a(i_+i1_,i+1);
}
i1_ = (0) - (1);
for(i_=1; i_<=i+1;i_++)
{
t3(i_) = tau(i_+i1_);
}
hermitianrank2update(a, isupper, 0, i, t, t3, t2, -1);
}
else
{
a(i,i) = a(i,i).x;
}
a(i,i+1) = e(i);
d(i+1) = a(i+1,i+1).x;
tau(i) = taui;
}
d(0) = a(0,0).x;
}
else
{
//
// Reduce the lower triangle of A
//
a(0,0) = a(0,0).x;
for(i = 0; i <= n-2; i++)
{
//
// Generate elementary reflector H = I - tau * v * v'
//
i1_ = (i+1) - (1);
for(i_=1; i_<=n-i-1;i_++)
{
t(i_) = a(i_+i1_,i);
}
complexgeneratereflection(t, n-i-1, taui);
i1_ = (1) - (i+1);
for(i_=i+1; i_<=n-1;i_++)
{
a(i_,i) = t(i_+i1_);
}
e(i) = a(i+1,i).x;
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
//
i1_ = (i+1) - (1);
for(i_=1; i_<=n-i-1;i_++)
{
t(i_) = a(i_+i1_,i);
}
hermitianmatrixvectormultiply(a, isupper, i+1, n-1, t, taui, t2);
i1_ = (1) - (i);
for(i_=i; i_<=n-2;i_++)
{
tau(i_) = t2(i_+i1_);
}
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
i1_ = (i+1)-(i);
v = 0.0;
for(i_=i; i_<=n-2;i_++)
{
v += ap::conj(tau(i_))*a(i_+i1_,i);
}
alpha = -0.5*taui*v;
i1_ = (i+1) - (i);
for(i_=i; i_<=n-2;i_++)
{
tau(i_) = tau(i_) + alpha*a(i_+i1_,i);
}
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
i1_ = (i+1) - (1);
for(i_=1; i_<=n-i-1;i_++)
{
t(i_) = a(i_+i1_,i);
}
i1_ = (i) - (1);
for(i_=1; i_<=n-i-1;i_++)
{
t2(i_) = tau(i_+i1_);
}
hermitianrank2update(a, isupper, i+1, n-1, t, t2, t3, -1);
}
else
{
a(i+1,i+1) = a(i+1,i+1).x;
}
a(i+1,i) = e(i);
d(i) = a(i,i).x;
tau(i) = taui;
}
d(n-1) = a(n-1,n-1).x;
}
}
/*************************************************************************
Obsolete 1-based subroutine
*************************************************************************/
bool complexsolvesystemlu(const ap::complex_2d_array& a,
const ap::integer_1d_array& pivots,
ap::complex_1d_array b,
int n,
ap::complex_1d_array& x)
{
bool result;
ap::complex_1d_array y;
int i;
ap::complex v;
int ip1;
int im1;
int i_;
y.setbounds(1, n);
x.setbounds(1, n);
result = true;
for(i = 1; i <= n; i++)
{
if( a(i,i)==0 )
{
result = false;
return result;
}
}
//
// pivots
//
for(i = 1; i <= n; i++)
{
if( pivots(i)!=i )
{
v = b(i);
b(i) = b(pivots(i));
b(pivots(i)) = v;
}
}
//
// Ly = b
//
y(1) = b(1);
for(i = 2; i <= n; i++)
{
im1 = i-1;
v = 0.0;
for(i_=1; i_<=im1; i_++)
{
v += a(i,i_)*y(i_);
}
y(i) = b(i)-v;
}
//
// Ux = y
//
x(n) = y(n)/a(n,n);
for(i = n-1; i >= 1; i--)
{
ip1 = i+1;
v = 0.0;
for(i_=ip1; i_<=n; i_++)
{
v += a(i,i_)*x(i_);
}
x(i) = (y(i)-v)/a(i,i);
}
return result;
}
