/*************************************************************************
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+1);
e.setlength(n+1);
for(i = 1; i <= n-1; i++)
{
d(i) = alpha(i-1);
if( beta(i)<=0 )
{
info = -2;
return;
}
e(i) = sqrt(beta(i));
}
d(n) = alpha(n-1);
//
// EVD
//
if( !tridiagonalevd(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);
w(i-1) = mu0*ap::sqr(z(1,i));
}
}
bool symmetricevd(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, "SymmetricEVD: incorrect ZNeeded");
totridiagonal(a, n, isupper, tau, d, e);
if( zneeded==1 )
{
unpackqfromtridiagonal(a, n, isupper, tau, z);
}
result = tridiagonalevd(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+3);
e.setlength(n+2);
for(i = 1; i <= n+1; i++)
{
d(i) = alpha(i-1);
}
for(i = 1; i <= n; i++)
{
if( beta(i)<=0 )
{
info = -2;
return;
}
e(i) = 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( 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( bet<0 )
{
info = -3;
return;
}
d(n+2) = alph;
e(n+1) = sqrt(bet);
//
// EVD
//
if( !tridiagonalevd(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);
w(i-1) = mu0*ap::sqr(z(1,i));
}
}
/*************************************************************************
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.setbounds(1, n+1);
e.setbounds(1, n);
for(i = 1; i <= n; i++)
{
d(i) = alpha(i-1);
if( beta(i)<=0 )
{
info = -2;
return;
}
e(i) = 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+1) = a-beta(n)*polim1/poli;
//
// EVD
//
if( !tridiagonalevd(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);
w(i-1) = mu0*ap::sqr(z(1,i));
}
}
/*************************************************************************
-- ALGLIB --
Copyright 2005, 23 March 2007 by Bochkanov Sergey
*************************************************************************/
bool hermitianevd(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
//
hermitiantotridiagonal(a, n, isupper, tau, d, e);
if( zneeded==1 )
{
unpackqfromhermitiantridiagonal(a, n, isupper, tau, q);
zneeded = 2;
}
//
// TDEVD
//
result = tridiagonalevd(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(1, n);
z.setbounds(1, n, 1, n);
for(i = 1; i <= n; i++)
{
//
// Calculate real part
//
for(k = 1; k <= n; k++)
{
work(k) = 0;
}
for(k = 1; k <= n; k++)
{
v = q(i,k).x;
ap::vadd(&work(1), &t(k, 1), ap::vlen(1,n), v);
}
for(k = 1; k <= n; k++)
{
z(i,k).x = work(k);
}
//
// Calculate imaginary part
//
for(k = 1; k <= n; k++)
{
work(k) = 0;
}
for(k = 1; k <= n; k++)
{
v = q(i,k).y;
ap::vadd(&work(1), &t(k, 1), ap::vlen(1,n), v);
}
for(k = 1; k <= n; k++)
{
z(i,k).y = work(k);
}
}
}
return result;
}