/*************************************************************************
Computation of nodes and weights for a Gauss quadrature formula
The algorithm generates the N-point Gauss quadrature formula with weight
function given by coefficients alpha and beta of a recurrence relation
which generates a system of orthogonal polynomials:
P-1(x) = 0
P0(x) = 1
Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
and zeroth moment Mu0
Mu0 = integral(W(x)dx,a,b)
INPUT PARAMETERS:
Alpha – array[0..N-1], alpha coefficients
Beta – array[0..N-1], beta coefficients
Zero-indexed element is not used and may be arbitrary.
Beta[I]>0.
Mu0 – zeroth moment of the weight function.
N – number of nodes of the quadrature formula, N>=1
OUTPUT PARAMETERS:
Info - error code:
* -3 internal eigenproblem solver hasn't converged
* -2 Beta[i]<=0
* -1 incorrect N was passed
* 1 OK
X - array[0..N-1] - array of quadrature nodes,
in ascending order.
W - array[0..N-1] - array of quadrature weights.
-- ALGLIB --
Copyright 2005-2009 by Bochkanov Sergey
*************************************************************************/
void gqgeneraterec(const ap::real_1d_array& alpha,
const ap::real_1d_array& beta,
double mu0,
int n,
int& info,
ap::real_1d_array& x,
ap::real_1d_array& w)
{
int i;
ap::real_1d_array d;
ap::real_1d_array e;
ap::real_2d_array z;
if( n<1 )
{
info = -1;
return;
}
info = 1;
//
// Initialize
//
d.setlength(n);
e.setlength(n);
for(i = 1; i <= n-1; i++)
{
d(i-1) = alpha(i-1);
if( ap::fp_less_eq(beta(i),0) )
{
info = -2;
return;
}
e(i-1) = sqrt(beta(i));
}
d(n-1) = alpha(n-1);
//
// EVD
//
if( !smatrixtdevd(d, e, n, 3, z) )
{
info = -3;
return;
}
//
// Generate
//
x.setlength(n);
w.setlength(n);
for(i = 1; i <= n; i++)
{
x(i-1) = d(i-1);
w(i-1) = mu0*ap::sqr(z(0,i-1));
}
}
/*************************************************************************
Finding the eigenvalues and eigenvectors of a symmetric matrix
The algorithm finds eigen pairs of a symmetric matrix by reducing it to
tridiagonal form and using the QL/QR algorithm.
Input parameters:
A - symmetric matrix which is given by its upper or lower
triangular part.
Array whose indexes range within [0..N-1, 0..N-1].
N - size of matrix A.
IsUpper - storage format.
ZNeeded - flag controlling whether the eigenvectors are needed or not.
If ZNeeded is equal to:
* 0, the eigenvectors are not returned;
* 1, the eigenvectors are returned.
Output parameters:
D - eigenvalues in ascending order.
Array whose index ranges within [0..N-1].
Z - if ZNeeded is equal to:
* 0, Z hasn’t changed;
* 1, Z contains the eigenvectors.
Array whose indexes range within [0..N-1, 0..N-1].
The eigenvectors are stored in the matrix columns.
Result:
True, if the algorithm has converged.
False, if the algorithm hasn't converged (rare case).
-- ALGLIB --
Copyright 2005-2008 by Bochkanov Sergey
*************************************************************************/
bool smatrixevd(ap::real_2d_array a,
int n,
int zneeded,
bool isupper,
ap::real_1d_array& d,
ap::real_2d_array& z)
{
bool result;
ap::real_1d_array tau;
ap::real_1d_array e;
ap::ap_error::make_assertion(zneeded==0||zneeded==1, "SMatrixEVD: incorrect ZNeeded");
smatrixtd(a, n, isupper, tau, d, e);
if( zneeded==1 )
{
smatrixtdunpackq(a, n, isupper, tau, z);
}
result = smatrixtdevd(d, e, n, zneeded, z);
return result;
}
/*************************************************************************
Computation of nodes and weights for a Gauss-Lobatto quadrature formula
The algorithm generates the N-point Gauss-Lobatto quadrature formula with
weight function given by coefficients alpha and beta of a recurrence which
generates a system of orthogonal polynomials.
P-1(x) = 0
P0(x) = 1
Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
and zeroth moment Mu0
Mu0 = integral(W(x)dx,a,b)
INPUT PARAMETERS:
Alpha – array[0..N-2], alpha coefficients
Beta – array[0..N-2], beta coefficients.
Zero-indexed element is not used, may be arbitrary.
Beta[I]>0
Mu0 – zeroth moment of the weighting function.
A – left boundary of the integration interval.
B – right boundary of the integration interval.
N – number of nodes of the quadrature formula, N>=3
(including the left and right boundary nodes).
OUTPUT PARAMETERS:
Info - error code:
* -3 internal eigenproblem solver hasn't converged
* -2 Beta[i]<=0
* -1 incorrect N was passed
* 1 OK
X - array[0..N-1] - array of quadrature nodes,
in ascending order.
W - array[0..N-1] - array of quadrature weights.
-- ALGLIB --
Copyright 2005-2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausslobattorec(ap::real_1d_array alpha,
ap::real_1d_array beta,
double mu0,
double a,
double b,
int n,
int& info,
ap::real_1d_array& x,
ap::real_1d_array& w)
{
int i;
ap::real_1d_array d;
ap::real_1d_array e;
ap::real_2d_array z;
double pim1a;
double pia;
double pim1b;
double pib;
double t;
double a11;
double a12;
double a21;
double a22;
double b1;
double b2;
double alph;
double bet;
if( n<=2 )
{
info = -1;
return;
}
info = 1;
//
// Initialize, D[1:N+1], E[1:N]
//
n = n-2;
d.setlength(n+2);
e.setlength(n+1);
for(i = 1; i <= n+1; i++)
{
d(i-1) = alpha(i-1);
}
for(i = 1; i <= n; i++)
{
if( ap::fp_less_eq(beta(i),0) )
{
info = -2;
return;
}
e(i-1) = sqrt(beta(i));
}
//
// Caclulate Pn(a), Pn+1(a), Pn(b), Pn+1(b)
//
beta(0) = 0;
pim1a = 0;
pia = 1;
pim1b = 0;
pib = 1;
for(i = 1; i <= n+1; i++)
{
//
// Pi(a)
//
t = (a-alpha(i-1))*pia-beta(i-1)*pim1a;
pim1a = pia;
pia = t;
//
// Pi(b)
//
t = (b-alpha(i-1))*pib-beta(i-1)*pim1b;
pim1b = pib;
pib = t;
}
//
// Calculate alpha'(n+1), beta'(n+1)
//
a11 = pia;
a12 = pim1a;
a21 = pib;
a22 = pim1b;
b1 = a*pia;
b2 = b*pib;
if( ap::fp_greater(fabs(a11),fabs(a21)) )
{
a22 = a22-a12*a21/a11;
b2 = b2-b1*a21/a11;
bet = b2/a22;
alph = (b1-bet*a12)/a11;
}
else
{
a12 = a12-a22*a11/a21;
b1 = b1-b2*a11/a21;
bet = b1/a12;
alph = (b2-bet*a22)/a21;
}
if( ap::fp_less(bet,0) )
{
info = -3;
return;
}
d(n+1) = alph;
e(n) = sqrt(bet);
//
// EVD
//
if( !smatrixtdevd(d, e, n+2, 3, z) )
{
info = -3;
return;
}
//
// Generate
//
x.setlength(n+2);
w.setlength(n+2);
for(i = 1; i <= n+2; i++)
{
x(i-1) = d(i-1);
w(i-1) = mu0*ap::sqr(z(0,i-1));
}
}
/*************************************************************************
Computation of nodes and weights for a Gauss-Radau quadrature formula
The algorithm generates the N-point Gauss-Radau quadrature formula with
weight function given by the coefficients alpha and beta of a recurrence
which generates a system of orthogonal polynomials.
P-1(x) = 0
P0(x) = 1
Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
and zeroth moment Mu0
Mu0 = integral(W(x)dx,a,b)
INPUT PARAMETERS:
Alpha – array[0..N-2], alpha coefficients.
Beta – array[0..N-1], beta coefficients
Zero-indexed element is not used.
Beta[I]>0
Mu0 – zeroth moment of the weighting function.
A – left boundary of the integration interval.
N – number of nodes of the quadrature formula, N>=2
(including the left boundary node).
OUTPUT PARAMETERS:
Info - error code:
* -3 internal eigenproblem solver hasn't converged
* -2 Beta[i]<=0
* -1 incorrect N was passed
* 1 OK
X - array[0..N-1] - array of quadrature nodes,
in ascending order.
W - array[0..N-1] - array of quadrature weights.
-- ALGLIB --
Copyright 2005-2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategaussradaurec(ap::real_1d_array alpha,
ap::real_1d_array beta,
double mu0,
double a,
int n,
int& info,
ap::real_1d_array& x,
ap::real_1d_array& w)
{
int i;
ap::real_1d_array d;
ap::real_1d_array e;
ap::real_2d_array z;
double polim1;
double poli;
double t;
if( n<2 )
{
info = -1;
return;
}
info = 1;
//
// Initialize, D[1:N], E[1:N]
//
n = n-1;
d.setlength(n+1);
e.setlength(n);
for(i = 1; i <= n; i++)
{
d(i-1) = alpha(i-1);
if( ap::fp_less_eq(beta(i),0) )
{
info = -2;
return;
}
e(i-1) = sqrt(beta(i));
}
//
// Caclulate Pn(a), Pn-1(a), and D[N+1]
//
beta(0) = 0;
polim1 = 0;
poli = 1;
for(i = 1; i <= n; i++)
{
t = (a-alpha(i-1))*poli-beta(i-1)*polim1;
polim1 = poli;
poli = t;
}
d(n) = a-beta(n)*polim1/poli;
//
// EVD
//
if( !smatrixtdevd(d, e, n+1, 3, z) )
{
info = -3;
return;
}
//
// Generate
//
x.setbounds(0, n);
w.setbounds(0, n);
for(i = 1; i <= n+1; i++)
{
x(i-1) = d(i-1);
w(i-1) = mu0*ap::sqr(z(0,i-1));
}
}
/*************************************************************************
Finding the eigenvalues and eigenvectors of a Hermitian matrix
The algorithm finds eigen pairs of a Hermitian matrix by reducing it to
real tridiagonal form and using the QL/QR algorithm.
Input parameters:
A - Hermitian matrix which is given by its upper or lower
triangular part.
Array whose indexes range within [0..N-1, 0..N-1].
N - size of matrix A.
IsUpper - storage format.
ZNeeded - flag controlling whether the eigenvectors are needed or
not. If ZNeeded is equal to:
* 0, the eigenvectors are not returned;
* 1, the eigenvectors are returned.
Output parameters:
D - eigenvalues in ascending order.
Array whose index ranges within [0..N-1].
Z - if ZNeeded is equal to:
* 0, Z hasn’t changed;
* 1, Z contains the eigenvectors.
Array whose indexes range within [0..N-1, 0..N-1].
The eigenvectors are stored in the matrix columns.
Result:
True, if the algorithm has converged.
False, if the algorithm hasn't converged (rare case).
Note:
eigen vectors of Hermitian matrix are defined up to multiplication by
a complex number L, such as |L|=1.
-- ALGLIB --
Copyright 2005, 23 March 2007 by Bochkanov Sergey
*************************************************************************/
bool hmatrixevd(ap::complex_2d_array a,
int n,
int zneeded,
bool isupper,
ap::real_1d_array& d,
ap::complex_2d_array& z)
{
bool result;
ap::complex_1d_array tau;
ap::real_1d_array e;
ap::real_1d_array work;
ap::real_2d_array t;
ap::complex_2d_array q;
int i;
int k;
double v;
ap::ap_error::make_assertion(zneeded==0||zneeded==1, "HermitianEVD: incorrect ZNeeded");
//
// Reduce to tridiagonal form
//
hmatrixtd(a, n, isupper, tau, d, e);
if( zneeded==1 )
{
hmatrixtdunpackq(a, n, isupper, tau, q);
zneeded = 2;
}
//
// TDEVD
//
result = smatrixtdevd(d, e, n, zneeded, t);
//
// Eigenvectors are needed
// Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
//
if( result&&zneeded!=0 )
{
work.setbounds(0, n-1);
z.setbounds(0, n-1, 0, n-1);
for(i = 0; i <= n-1; i++)
{
//
// Calculate real part
//
for(k = 0; k <= n-1; k++)
{
work(k) = 0;
}
for(k = 0; k <= n-1; k++)
{
v = q(i,k).x;
ap::vadd(&work(0), &t(k, 0), ap::vlen(0,n-1), v);
}
for(k = 0; k <= n-1; k++)
{
z(i,k).x = work(k);
}
//
// Calculate imaginary part
//
for(k = 0; k <= n-1; k++)
{
work(k) = 0;
}
for(k = 0; k <= n-1; k++)
{
v = q(i,k).y;
ap::vadd(&work(0), &t(k, 0), ap::vlen(0,n-1), v);
}
for(k = 0; k <= n-1; k++)
{
z(i,k).y = work(k);
}
}
}
return result;
}
