timo.menzel
/
test_pie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
test_pie/external/alglib-3.16.0/integration.cpp

4241 lines
146 KiB
C++
Executable File
Raw Permalink Blame History

/*************************************************************************
ALGLIB 3.16.0 (source code generated 2019-12-19)
Copyright (c) Sergey Bochkanov (ALGLIB project).
>>> SOURCE LICENSE >>>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation (www.fsf.org); either version 2 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
A copy of the GNU General Public License is available at
http://www.fsf.org/licensing/licenses
>>> END OF LICENSE >>>
*************************************************************************/
#ifdef _MSC_VER
#define _CRT_SECURE_NO_WARNINGS
#endif
#include "stdafx.h"
#include "integration.h"
// disable some irrelevant warnings
#if (AE_COMPILER==AE_MSVC) && !defined(AE_ALL_WARNINGS)
#pragma warning(disable:4100)
#pragma warning(disable:4127)
#pragma warning(disable:4611)
#pragma warning(disable:4702)
#pragma warning(disable:4996)
#endif
/////////////////////////////////////////////////////////////////////////
//
// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE
//
/////////////////////////////////////////////////////////////////////////
namespace alglib
{
#if defined(AE_COMPILE_GQ) || !defined(AE_PARTIAL_BUILD)
#endif
#if defined(AE_COMPILE_GKQ) || !defined(AE_PARTIAL_BUILD)
#endif
#if defined(AE_COMPILE_AUTOGK) || !defined(AE_PARTIAL_BUILD)
#endif
#if defined(AE_COMPILE_GQ) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
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 real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgeneraterec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
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(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategausslobattorec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, a, b, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
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(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategaussradaurec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, a, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N
nodes.
INPUT PARAMETERS:
N - number of nodes, >=1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategausslegendre(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight
function W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
INPUT PARAMETERS:
N - number of nodes, >=1
Alpha - power-law coefficient, Alpha>-1
Beta - power-law coefficient, Beta>-1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. Alpha or Beta are too close
to -1 to obtain weights/nodes with high enough
accuracy, or, may be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha/Beta 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategaussjacobi(n, alpha, beta, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with
weight function W(x)=Power(x,Alpha)*Exp(-x)
INPUT PARAMETERS:
N - number of nodes, >=1
Alpha - power-law coefficient, Alpha>-1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. Alpha is too close to -1 to
obtain weights/nodes with high enough accuracy
or, may be, N is too large. Try to use
multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategausslaguerre(n, alpha, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with
weight function W(x)=Exp(-x*x)
INPUT PARAMETERS:
N - number of nodes, >=1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. May be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gqgenerategausshermite(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
#endif
#if defined(AE_COMPILE_GKQ) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
Computation of nodes and weights of a Gauss-Kronrod quadrature formula
The algorithm generates the N-point Gauss-Kronrod 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 zero moment Mu0
Mu0 = integral(W(x)dx,a,b)
INPUT PARAMETERS:
Alpha - alpha coefficients, array[0..floor(3*K/2)].
Beta - beta coefficients, array[0..ceil(3*K/2)].
Beta[0] is not used and may be arbitrary.
Beta[I]>0.
Mu0 - zeroth moment of the weight function.
N - number of nodes of the Gauss-Kronrod quadrature formula,
N >= 3,
N = 2*K+1.
OUTPUT PARAMETERS:
Info - error code:
* -5 no real and positive Gauss-Kronrod formula can
be created for such a weight function with a
given number of nodes.
* -4 N is too large, task may be ill conditioned -
x[i]=x[i+1] found.
* -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.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 08.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gkqgeneraterec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre
quadrature with N points.
GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is
used depending on machine precision and number of nodes.
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gkqgenerategausslegendre(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi
quadrature on [-1,1] with weight function
W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
Alpha - power-law coefficient, Alpha>-1
Beta - power-law coefficient, Beta>-1
OUTPUT PARAMETERS:
Info - error code:
* -5 no real and positive Gauss-Kronrod formula can
be created for such a weight function with a
given number of nodes.
* -4 an error was detected when calculating
weights/nodes. Alpha or Beta are too close
to -1 to obtain weights/nodes with high enough
accuracy, or, may be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
* +2 OK, but quadrature rule have exterior nodes,
x[0]<-1 or x[n-1]>+1
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gkqgenerategaussjacobi(n, alpha, beta, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes for quadrature with N points.
Reduction to tridiagonal eigenproblem is used.
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gkqlegendrecalc(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using
pre-calculated table. Nodes/weights were computed with accuracy up to
1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision
accuracy reduces to something about 2.0E-16 (depending on your compiler's
handling of long floating point constants).
INPUT PARAMETERS:
N - number of Kronrod nodes.
N can be 15, 21, 31, 41, 51, 61.
OUTPUT PARAMETERS:
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::gkqlegendretbl(n, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &eps, &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
#endif
#if defined(AE_COMPILE_AUTOGK) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
Integration report:
* TerminationType = completetion code:
* -5 non-convergence of Gauss-Kronrod nodes
calculation subroutine.
* -1 incorrect parameters were specified
* 1 OK
* Rep.NFEV countains number of function calculations
* Rep.NIntervals contains number of intervals [a,b]
was partitioned into.
*************************************************************************/
_autogkreport_owner::_autogkreport_owner()
{
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
if( p_struct!=NULL )
{
alglib_impl::_autogkreport_destroy(p_struct);
alglib_impl::ae_free(p_struct);
}
p_struct = NULL;
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
p_struct = NULL;
p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), &_state);
memset(p_struct, 0, sizeof(alglib_impl::autogkreport));
alglib_impl::_autogkreport_init(p_struct, &_state, ae_false);
ae_state_clear(&_state);
}
_autogkreport_owner::_autogkreport_owner(const _autogkreport_owner &rhs)
{
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
if( p_struct!=NULL )
{
alglib_impl::_autogkreport_destroy(p_struct);
alglib_impl::ae_free(p_struct);
}
p_struct = NULL;
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
p_struct = NULL;
alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: autogkreport copy constructor failure (source is not initialized)", &_state);
p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), &_state);
memset(p_struct, 0, sizeof(alglib_impl::autogkreport));
alglib_impl::_autogkreport_init_copy(p_struct, const_cast<alglib_impl::autogkreport*>(rhs.p_struct), &_state, ae_false);
ae_state_clear(&_state);
}
_autogkreport_owner& _autogkreport_owner::operator=(const _autogkreport_owner &rhs)
{
if( this==&rhs )
return *this;
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return *this;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: autogkreport assignment constructor failure (destination is not initialized)", &_state);
alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: autogkreport assignment constructor failure (source is not initialized)", &_state);
alglib_impl::_autogkreport_destroy(p_struct);
memset(p_struct, 0, sizeof(alglib_impl::autogkreport));
alglib_impl::_autogkreport_init_copy(p_struct, const_cast<alglib_impl::autogkreport*>(rhs.p_struct), &_state, ae_false);
ae_state_clear(&_state);
return *this;
}
_autogkreport_owner::~_autogkreport_owner()
{
if( p_struct!=NULL )
{
alglib_impl::_autogkreport_destroy(p_struct);
ae_free(p_struct);
}
}
alglib_impl::autogkreport* _autogkreport_owner::c_ptr()
{
return p_struct;
}
alglib_impl::autogkreport* _autogkreport_owner::c_ptr() const
{
return const_cast<alglib_impl::autogkreport*>(p_struct);
}
autogkreport::autogkreport() : _autogkreport_owner() ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals)
{
}
autogkreport::autogkreport(const autogkreport &rhs):_autogkreport_owner(rhs) ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals)
{
}
autogkreport& autogkreport::operator=(const autogkreport &rhs)
{
if( this==&rhs )
return *this;
_autogkreport_owner::operator=(rhs);
return *this;
}
autogkreport::~autogkreport()
{
}
/*************************************************************************
This structure stores state of the integration algorithm.
Although this class has public fields, they are not intended for external
use. You should use ALGLIB functions to work with this class:
* autogksmooth()/AutoGKSmoothW()/... to create objects
* autogkintegrate() to begin integration
* autogkresults() to get results
*************************************************************************/
_autogkstate_owner::_autogkstate_owner()
{
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
if( p_struct!=NULL )
{
alglib_impl::_autogkstate_destroy(p_struct);
alglib_impl::ae_free(p_struct);
}
p_struct = NULL;
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
p_struct = NULL;
p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), &_state);
memset(p_struct, 0, sizeof(alglib_impl::autogkstate));
alglib_impl::_autogkstate_init(p_struct, &_state, ae_false);
ae_state_clear(&_state);
}
_autogkstate_owner::_autogkstate_owner(const _autogkstate_owner &rhs)
{
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
if( p_struct!=NULL )
{
alglib_impl::_autogkstate_destroy(p_struct);
alglib_impl::ae_free(p_struct);
}
p_struct = NULL;
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
p_struct = NULL;
alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: autogkstate copy constructor failure (source is not initialized)", &_state);
p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), &_state);
memset(p_struct, 0, sizeof(alglib_impl::autogkstate));
alglib_impl::_autogkstate_init_copy(p_struct, const_cast<alglib_impl::autogkstate*>(rhs.p_struct), &_state, ae_false);
ae_state_clear(&_state);
}
_autogkstate_owner& _autogkstate_owner::operator=(const _autogkstate_owner &rhs)
{
if( this==&rhs )
return *this;
jmp_buf _break_jump;
alglib_impl::ae_state _state;
alglib_impl::ae_state_init(&_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_state.error_msg);
return *this;
#endif
}
alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: autogkstate assignment constructor failure (destination is not initialized)", &_state);
alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: autogkstate assignment constructor failure (source is not initialized)", &_state);
alglib_impl::_autogkstate_destroy(p_struct);
memset(p_struct, 0, sizeof(alglib_impl::autogkstate));
alglib_impl::_autogkstate_init_copy(p_struct, const_cast<alglib_impl::autogkstate*>(rhs.p_struct), &_state, ae_false);
ae_state_clear(&_state);
return *this;
}
_autogkstate_owner::~_autogkstate_owner()
{
if( p_struct!=NULL )
{
alglib_impl::_autogkstate_destroy(p_struct);
ae_free(p_struct);
}
}
alglib_impl::autogkstate* _autogkstate_owner::c_ptr()
{
return p_struct;
}
alglib_impl::autogkstate* _autogkstate_owner::c_ptr() const
{
return const_cast<alglib_impl::autogkstate*>(p_struct);
}
autogkstate::autogkstate() : _autogkstate_owner() ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f)
{
}
autogkstate::autogkstate(const autogkstate &rhs):_autogkstate_owner(rhs) ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f)
{
}
autogkstate& autogkstate::operator=(const autogkstate &rhs)
{
if( this==&rhs )
return *this;
_autogkstate_owner::operator=(rhs);
return *this;
}
autogkstate::~autogkstate()
{
}
/*************************************************************************
Integration of a smooth function F(x) on a finite interval [a,b].
Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
is calculated with accuracy close to the machine precision.
Algorithm works well only with smooth integrands. It may be used with
continuous non-smooth integrands, but with less performance.
It should never be used with integrands which have integrable singularities
at lower or upper limits - algorithm may crash. Use AutoGKSingular in such
cases.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmoothW, AutoGKSingular, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksmooth(const double a, const double b, autogkstate &state, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::autogksmooth(a, b, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Integration of a smooth function F(x) on a finite interval [a,b].
This subroutine is same as AutoGKSmooth(), but it guarantees that interval
[a,b] is partitioned into subintervals which have width at most XWidth.
Subroutine can be used when integrating nearly-constant function with
narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth
subroutine can overlook them.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmooth, AutoGKSingular, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::autogksmoothw(a, b, xwidth, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
Integration on a finite interval [A,B].
Integrand have integrable singularities at A/B.
F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known
alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates
from below can be used (but these estimates should be greater than -1 too).
One of alpha/beta variables (or even both alpha/beta) may be equal to 0,
which means than function F(x) is non-singular at A/B. Anyway (singular at
bounds or not), function F(x) is supposed to be continuous on (A,B).
Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
is calculated with accuracy close to the machine precision.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
Alpha - power-law coefficient of the F(x) at A,
Alpha>-1
Beta - power-law coefficient of the F(x) at B,
Beta>-1
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmooth, AutoGKSmoothW, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::autogksingular(a, b, alpha, beta, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
/*************************************************************************
This function provides reverse communication interface
Reverse communication interface is not documented or recommended to use.
See below for functions which provide better documented API
*************************************************************************/
bool autogkiteration(const autogkstate &state, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return 0;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
ae_bool result = alglib_impl::autogkiteration(const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return *(reinterpret_cast<bool*>(&result));
}
void autogkintegrate(autogkstate &state,
void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr),
void *ptr, const xparams _xparams){
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::ae_assert(func!=NULL, "ALGLIB: error in 'autogkintegrate()' (func is NULL)", &_alglib_env_state);
while( alglib_impl::autogkiteration(state.c_ptr(), &_alglib_env_state) )
{
_ALGLIB_CALLBACK_EXCEPTION_GUARD_BEGIN
if( state.needf )
{
func(state.x, state.xminusa, state.bminusx, state.f, ptr);
continue;
}
goto lbl_no_callback;
_ALGLIB_CALLBACK_EXCEPTION_GUARD_END
lbl_no_callback:
alglib_impl::ae_assert(ae_false, "ALGLIB: unexpected error in 'autogkintegrate()'", &_alglib_env_state);
}
alglib_impl::ae_state_clear(&_alglib_env_state);
}
/*************************************************************************
Adaptive integration results
Called after AutoGKIteration returned False.
Input parameters:
State - algorithm state (used by AutoGKIteration).
Output parameters:
V - integral(f(x)dx,a,b)
Rep - optimization report (see AutoGKReport description)
-- ALGLIB --
Copyright 14.11.2007 by Bochkanov Sergey
*************************************************************************/
void autogkresults(const autogkstate &state, double &v, autogkreport &rep, const xparams _xparams)
{
jmp_buf _break_jump;
alglib_impl::ae_state _alglib_env_state;
alglib_impl::ae_state_init(&_alglib_env_state);
if( setjmp(_break_jump) )
{
#if !defined(AE_NO_EXCEPTIONS)
_ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
#else
_ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
return;
#endif
}
ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
if( _xparams.flags!=0x0 )
ae_state_set_flags(&_alglib_env_state, _xparams.flags);
alglib_impl::autogkresults(const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &v, const_cast<alglib_impl::autogkreport*>(rep.c_ptr()), &_alglib_env_state);
alglib_impl::ae_state_clear(&_alglib_env_state);
return;
}
#endif
}
/////////////////////////////////////////////////////////////////////////
//
// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE
//
/////////////////////////////////////////////////////////////////////////
namespace alglib_impl
{
#if defined(AE_COMPILE_GQ) || !defined(AE_PARTIAL_BUILD)
#endif
#if defined(AE_COMPILE_GKQ) || !defined(AE_PARTIAL_BUILD)
#endif
#if defined(AE_COMPILE_AUTOGK) || !defined(AE_PARTIAL_BUILD)
static ae_int_t autogk_maxsubintervals = 10000;
static void autogk_autogkinternalprepare(double a,
double b,
double eps,
double xwidth,
autogkinternalstate* state,
ae_state *_state);
static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state,
ae_state *_state);
static void autogk_mheappop(/* Real */ ae_matrix* heap,
ae_int_t heapsize,
ae_int_t heapwidth,
ae_state *_state);
static void autogk_mheappush(/* Real */ ae_matrix* heap,
ae_int_t heapsize,
ae_int_t heapwidth,
ae_state *_state);
static void autogk_mheapresize(/* Real */ ae_matrix* heap,
ae_int_t* heapsize,
ae_int_t newheapsize,
ae_int_t heapwidth,
ae_state *_state);
#endif
#if defined(AE_COMPILE_GQ) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
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(/* Real */ ae_vector* alpha,
/* Real */ ae_vector* beta,
double mu0,
ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_int_t i;
ae_vector d;
ae_vector e;
ae_matrix z;
ae_frame_make(_state, &_frame_block);
memset(&d, 0, sizeof(d));
memset(&e, 0, sizeof(e));
memset(&z, 0, sizeof(z));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
if( n<1 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
*info = 1;
/*
* Initialize
*/
ae_vector_set_length(&d, n, _state);
ae_vector_set_length(&e, n, _state);
for(i=1; i<=n-1; i++)
{
d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
if( ae_fp_less_eq(beta->ptr.p_double[i],(double)(0)) )
{
*info = -2;
ae_frame_leave(_state);
return;
}
e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
}
d.ptr.p_double[n-1] = alpha->ptr.p_double[n-1];
/*
* EVD
*/
if( !smatrixtdevd(&d, &e, n, 3, &z, _state) )
{
*info = -3;
ae_frame_leave(_state);
return;
}
/*
* Generate
*/
ae_vector_set_length(x, n, _state);
ae_vector_set_length(w, n, _state);
for(i=1; i<=n; i++)
{
x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
}
ae_frame_leave(_state);
}
/*************************************************************************
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(/* Real */ ae_vector* alpha,
/* Real */ ae_vector* beta,
double mu0,
double a,
double b,
ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector _alpha;
ae_vector _beta;
ae_int_t i;
ae_vector d;
ae_vector e;
ae_matrix 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;
ae_frame_make(_state, &_frame_block);
memset(&_alpha, 0, sizeof(_alpha));
memset(&_beta, 0, sizeof(_beta));
memset(&d, 0, sizeof(d));
memset(&e, 0, sizeof(e));
memset(&z, 0, sizeof(z));
ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
alpha = &_alpha;
ae_vector_init_copy(&_beta, beta, _state, ae_true);
beta = &_beta;
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
if( n<=2 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
*info = 1;
/*
* Initialize, D[1:N+1], E[1:N]
*/
n = n-2;
ae_vector_set_length(&d, n+2, _state);
ae_vector_set_length(&e, n+1, _state);
for(i=1; i<=n+1; i++)
{
d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
}
for(i=1; i<=n; i++)
{
if( ae_fp_less_eq(beta->ptr.p_double[i],(double)(0)) )
{
*info = -2;
ae_frame_leave(_state);
return;
}
e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
}
/*
* Caclulate Pn(a), Pn+1(a), Pn(b), Pn+1(b)
*/
beta->ptr.p_double[0] = (double)(0);
pim1a = (double)(0);
pia = (double)(1);
pim1b = (double)(0);
pib = (double)(1);
for(i=1; i<=n+1; i++)
{
/*
* Pi(a)
*/
t = (a-alpha->ptr.p_double[i-1])*pia-beta->ptr.p_double[i-1]*pim1a;
pim1a = pia;
pia = t;
/*
* Pi(b)
*/
t = (b-alpha->ptr.p_double[i-1])*pib-beta->ptr.p_double[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( ae_fp_greater(ae_fabs(a11, _state),ae_fabs(a21, _state)) )
{
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( ae_fp_less(bet,(double)(0)) )
{
*info = -3;
ae_frame_leave(_state);
return;
}
d.ptr.p_double[n+1] = alph;
e.ptr.p_double[n] = ae_sqrt(bet, _state);
/*
* EVD
*/
if( !smatrixtdevd(&d, &e, n+2, 3, &z, _state) )
{
*info = -3;
ae_frame_leave(_state);
return;
}
/*
* Generate
*/
ae_vector_set_length(x, n+2, _state);
ae_vector_set_length(w, n+2, _state);
for(i=1; i<=n+2; i++)
{
x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
}
ae_frame_leave(_state);
}
/*************************************************************************
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(/* Real */ ae_vector* alpha,
/* Real */ ae_vector* beta,
double mu0,
double a,
ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector _alpha;
ae_vector _beta;
ae_int_t i;
ae_vector d;
ae_vector e;
ae_matrix z;
double polim1;
double poli;
double t;
ae_frame_make(_state, &_frame_block);
memset(&_alpha, 0, sizeof(_alpha));
memset(&_beta, 0, sizeof(_beta));
memset(&d, 0, sizeof(d));
memset(&e, 0, sizeof(e));
memset(&z, 0, sizeof(z));
ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
alpha = &_alpha;
ae_vector_init_copy(&_beta, beta, _state, ae_true);
beta = &_beta;
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
if( n<2 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
*info = 1;
/*
* Initialize, D[1:N], E[1:N]
*/
n = n-1;
ae_vector_set_length(&d, n+1, _state);
ae_vector_set_length(&e, n, _state);
for(i=1; i<=n; i++)
{
d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
if( ae_fp_less_eq(beta->ptr.p_double[i],(double)(0)) )
{
*info = -2;
ae_frame_leave(_state);
return;
}
e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
}
/*
* Caclulate Pn(a), Pn-1(a), and D[N+1]
*/
beta->ptr.p_double[0] = (double)(0);
polim1 = (double)(0);
poli = (double)(1);
for(i=1; i<=n; i++)
{
t = (a-alpha->ptr.p_double[i-1])*poli-beta->ptr.p_double[i-1]*polim1;
polim1 = poli;
poli = t;
}
d.ptr.p_double[n] = a-beta->ptr.p_double[n]*polim1/poli;
/*
* EVD
*/
if( !smatrixtdevd(&d, &e, n+1, 3, &z, _state) )
{
*info = -3;
ae_frame_leave(_state);
return;
}
/*
* Generate
*/
ae_vector_set_length(x, n+1, _state);
ae_vector_set_length(w, n+1, _state);
for(i=1; i<=n+1; i++)
{
x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N
nodes.
INPUT PARAMETERS:
N - number of nodes, >=1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausslegendre(ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector alpha;
ae_vector beta;
ae_int_t i;
ae_frame_make(_state, &_frame_block);
memset(&alpha, 0, sizeof(alpha));
memset(&beta, 0, sizeof(beta));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true);
ae_vector_init(&beta, 0, DT_REAL, _state, ae_true);
if( n<1 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
ae_vector_set_length(&alpha, n, _state);
ae_vector_set_length(&beta, n, _state);
for(i=0; i<=n-1; i++)
{
alpha.ptr.p_double[i] = (double)(0);
}
beta.ptr.p_double[0] = (double)(2);
for(i=1; i<=n-1; i++)
{
beta.ptr.p_double[i] = 1/(4-1/ae_sqr((double)(i), _state));
}
gqgeneraterec(&alpha, &beta, beta.ptr.p_double[0], n, info, x, w, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
if( ae_fp_less(x->ptr.p_double[0],(double)(-1))||ae_fp_greater(x->ptr.p_double[n-1],(double)(1)) )
{
*info = -4;
}
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight
function W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
INPUT PARAMETERS:
N - number of nodes, >=1
Alpha - power-law coefficient, Alpha>-1
Beta - power-law coefficient, Beta>-1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. Alpha or Beta are too close
to -1 to obtain weights/nodes with high enough
accuracy, or, may be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha/Beta 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategaussjacobi(ae_int_t n,
double alpha,
double beta,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector a;
ae_vector b;
double alpha2;
double beta2;
double apb;
double t;
ae_int_t i;
double s;
ae_frame_make(_state, &_frame_block);
memset(&a, 0, sizeof(a));
memset(&b, 0, sizeof(b));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
if( (n<1||ae_fp_less_eq(alpha,(double)(-1)))||ae_fp_less_eq(beta,(double)(-1)) )
{
*info = -1;
ae_frame_leave(_state);
return;
}
ae_vector_set_length(&a, n, _state);
ae_vector_set_length(&b, n, _state);
apb = alpha+beta;
a.ptr.p_double[0] = (beta-alpha)/(apb+2);
t = (apb+1)*ae_log((double)(2), _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state);
if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) )
{
*info = -4;
ae_frame_leave(_state);
return;
}
b.ptr.p_double[0] = ae_exp(t, _state);
if( n>1 )
{
alpha2 = ae_sqr(alpha, _state);
beta2 = ae_sqr(beta, _state);
a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4));
b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state));
for(i=2; i<=n-1; i++)
{
a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i));
b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state));
}
}
gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
if( ae_fp_less(x->ptr.p_double[0],(double)(-1))||ae_fp_greater(x->ptr.p_double[n-1],(double)(1)) )
{
*info = -4;
}
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with
weight function W(x)=Power(x,Alpha)*Exp(-x)
INPUT PARAMETERS:
N - number of nodes, >=1
Alpha - power-law coefficient, Alpha>-1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. Alpha is too close to -1 to
obtain weights/nodes with high enough accuracy
or, may be, N is too large. Try to use
multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausslaguerre(ae_int_t n,
double alpha,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector a;
ae_vector b;
double t;
ae_int_t i;
double s;
ae_frame_make(_state, &_frame_block);
memset(&a, 0, sizeof(a));
memset(&b, 0, sizeof(b));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
if( n<1||ae_fp_less_eq(alpha,(double)(-1)) )
{
*info = -1;
ae_frame_leave(_state);
return;
}
ae_vector_set_length(&a, n, _state);
ae_vector_set_length(&b, n, _state);
a.ptr.p_double[0] = alpha+1;
t = lngamma(alpha+1, &s, _state);
if( ae_fp_greater_eq(t,ae_log(ae_maxrealnumber, _state)) )
{
*info = -4;
ae_frame_leave(_state);
return;
}
b.ptr.p_double[0] = ae_exp(t, _state);
if( n>1 )
{
for(i=1; i<=n-1; i++)
{
a.ptr.p_double[i] = 2*i+alpha+1;
b.ptr.p_double[i] = i*(i+alpha);
}
}
gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
if( ae_fp_less(x->ptr.p_double[0],(double)(0)) )
{
*info = -4;
}
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with
weight function W(x)=Exp(-x*x)
INPUT PARAMETERS:
N - number of nodes, >=1
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. May be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N/Alpha 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 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gqgenerategausshermite(ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* w,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector a;
ae_vector b;
ae_int_t i;
ae_frame_make(_state, &_frame_block);
memset(&a, 0, sizeof(a));
memset(&b, 0, sizeof(b));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(w);
ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
if( n<1 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
ae_vector_set_length(&a, n, _state);
ae_vector_set_length(&b, n, _state);
for(i=0; i<=n-1; i++)
{
a.ptr.p_double[i] = (double)(0);
}
b.ptr.p_double[0] = ae_sqrt(4*ae_atan((double)(1), _state), _state);
if( n>1 )
{
for(i=1; i<=n-1; i++)
{
b.ptr.p_double[i] = 0.5*i;
}
}
gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
#endif
#if defined(AE_COMPILE_GKQ) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
Computation of nodes and weights of a Gauss-Kronrod quadrature formula
The algorithm generates the N-point Gauss-Kronrod 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 zero moment Mu0
Mu0 = integral(W(x)dx,a,b)
INPUT PARAMETERS:
Alpha - alpha coefficients, array[0..floor(3*K/2)].
Beta - beta coefficients, array[0..ceil(3*K/2)].
Beta[0] is not used and may be arbitrary.
Beta[I]>0.
Mu0 - zeroth moment of the weight function.
N - number of nodes of the Gauss-Kronrod quadrature formula,
N >= 3,
N = 2*K+1.
OUTPUT PARAMETERS:
Info - error code:
* -5 no real and positive Gauss-Kronrod formula can
be created for such a weight function with a
given number of nodes.
* -4 N is too large, task may be ill conditioned -
x[i]=x[i+1] found.
* -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.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 08.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgeneraterec(/* Real */ ae_vector* alpha,
/* Real */ ae_vector* beta,
double mu0,
ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* wkronrod,
/* Real */ ae_vector* wgauss,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector _alpha;
ae_vector _beta;
ae_vector ta;
ae_int_t i;
ae_int_t j;
ae_vector t;
ae_vector s;
ae_int_t wlen;
ae_int_t woffs;
double u;
ae_int_t m;
ae_int_t l;
ae_int_t k;
ae_vector xgtmp;
ae_vector wgtmp;
ae_frame_make(_state, &_frame_block);
memset(&_alpha, 0, sizeof(_alpha));
memset(&_beta, 0, sizeof(_beta));
memset(&ta, 0, sizeof(ta));
memset(&t, 0, sizeof(t));
memset(&s, 0, sizeof(s));
memset(&xgtmp, 0, sizeof(xgtmp));
memset(&wgtmp, 0, sizeof(wgtmp));
ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
alpha = &_alpha;
ae_vector_init_copy(&_beta, beta, _state, ae_true);
beta = &_beta;
*info = 0;
ae_vector_clear(x);
ae_vector_clear(wkronrod);
ae_vector_clear(wgauss);
ae_vector_init(&ta, 0, DT_REAL, _state, ae_true);
ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
ae_vector_init(&s, 0, DT_REAL, _state, ae_true);
ae_vector_init(&xgtmp, 0, DT_REAL, _state, ae_true);
ae_vector_init(&wgtmp, 0, DT_REAL, _state, ae_true);
if( n%2!=1||n<3 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
for(i=0; i<=ae_iceil((double)(3*(n/2))/(double)2, _state); i++)
{
if( ae_fp_less_eq(beta->ptr.p_double[i],(double)(0)) )
{
*info = -2;
ae_frame_leave(_state);
return;
}
}
*info = 1;
/*
* from external conventions about N/Beta/Mu0 to internal
*/
n = n/2;
beta->ptr.p_double[0] = mu0;
/*
* Calculate Gauss nodes/weights, save them for later processing
*/
gqgeneraterec(alpha, beta, mu0, n, info, &xgtmp, &wgtmp, _state);
if( *info<0 )
{
ae_frame_leave(_state);
return;
}
/*
* Resize:
* * A from 0..floor(3*n/2) to 0..2*n
* * B from 0..ceil(3*n/2) to 0..2*n
*/
ae_vector_set_length(&ta, ae_ifloor((double)(3*n)/(double)2, _state)+1, _state);
ae_v_move(&ta.ptr.p_double[0], 1, &alpha->ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state)));
ae_vector_set_length(alpha, 2*n+1, _state);
ae_v_move(&alpha->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state)));
for(i=ae_ifloor((double)(3*n)/(double)2, _state)+1; i<=2*n; i++)
{
alpha->ptr.p_double[i] = (double)(0);
}
ae_vector_set_length(&ta, ae_iceil((double)(3*n)/(double)2, _state)+1, _state);
ae_v_move(&ta.ptr.p_double[0], 1, &beta->ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state)));
ae_vector_set_length(beta, 2*n+1, _state);
ae_v_move(&beta->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state)));
for(i=ae_iceil((double)(3*n)/(double)2, _state)+1; i<=2*n; i++)
{
beta->ptr.p_double[i] = (double)(0);
}
/*
* Initialize T, S
*/
wlen = 2+n/2;
ae_vector_set_length(&t, wlen, _state);
ae_vector_set_length(&s, wlen, _state);
ae_vector_set_length(&ta, wlen, _state);
woffs = 1;
for(i=0; i<=wlen-1; i++)
{
t.ptr.p_double[i] = (double)(0);
s.ptr.p_double[i] = (double)(0);
}
/*
* Algorithm from Dirk P. Laurie, "Calculation of Gauss-Kronrod quadrature rules", 1997.
*/
t.ptr.p_double[woffs+0] = beta->ptr.p_double[n+1];
for(m=0; m<=n-2; m++)
{
u = (double)(0);
for(k=(m+1)/2; k>=0; k--)
{
l = m-k;
u = u+(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+k]+beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+k-1]-beta->ptr.p_double[l]*s.ptr.p_double[woffs+k];
s.ptr.p_double[woffs+k] = u;
}
ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
}
for(j=n/2; j>=0; j--)
{
s.ptr.p_double[woffs+j] = s.ptr.p_double[woffs+j-1];
}
for(m=n-1; m<=2*n-3; m++)
{
u = (double)(0);
for(k=m+1-n; k<=(m-1)/2; k++)
{
l = m-k;
j = n-1-l;
u = u-(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j]+beta->ptr.p_double[l]*s.ptr.p_double[woffs+j+1];
s.ptr.p_double[woffs+j] = u;
}
if( m%2==0 )
{
k = m/2;
alpha->ptr.p_double[k+n+1] = alpha->ptr.p_double[k]+(s.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j+1])/t.ptr.p_double[woffs+j+1];
}
else
{
k = (m+1)/2;
beta->ptr.p_double[k+n+1] = s.ptr.p_double[woffs+j]/s.ptr.p_double[woffs+j+1];
}
ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
}
alpha->ptr.p_double[2*n] = alpha->ptr.p_double[n-1]-beta->ptr.p_double[2*n]*s.ptr.p_double[woffs+0]/t.ptr.p_double[woffs+0];
/*
* calculation of Kronrod nodes and weights, unpacking of Gauss weights
*/
gqgeneraterec(alpha, beta, mu0, 2*n+1, info, x, wkronrod, _state);
if( *info==-2 )
{
*info = -5;
}
if( *info<0 )
{
ae_frame_leave(_state);
return;
}
for(i=0; i<=2*n-1; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
if( *info<0 )
{
ae_frame_leave(_state);
return;
}
ae_vector_set_length(wgauss, 2*n+1, _state);
for(i=0; i<=2*n; i++)
{
wgauss->ptr.p_double[i] = (double)(0);
}
for(i=0; i<=n-1; i++)
{
wgauss->ptr.p_double[2*i+1] = wgtmp.ptr.p_double[i];
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre
quadrature with N points.
GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is
used depending on machine precision and number of nodes.
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgenerategausslegendre(ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* wkronrod,
/* Real */ ae_vector* wgauss,
ae_state *_state)
{
double eps;
*info = 0;
ae_vector_clear(x);
ae_vector_clear(wkronrod);
ae_vector_clear(wgauss);
if( ae_fp_greater(ae_machineepsilon,1.0E-32)&&(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61) )
{
*info = 1;
gkqlegendretbl(n, x, wkronrod, wgauss, &eps, _state);
}
else
{
gkqlegendrecalc(n, info, x, wkronrod, wgauss, _state);
}
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi
quadrature on [-1,1] with weight function
W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
Alpha - power-law coefficient, Alpha>-1
Beta - power-law coefficient, Beta>-1
OUTPUT PARAMETERS:
Info - error code:
* -5 no real and positive Gauss-Kronrod formula can
be created for such a weight function with a
given number of nodes.
* -4 an error was detected when calculating
weights/nodes. Alpha or Beta are too close
to -1 to obtain weights/nodes with high enough
accuracy, or, may be, N is too large. Try to
use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
* +2 OK, but quadrature rule have exterior nodes,
x[0]<-1 or x[n-1]>+1
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqgenerategaussjacobi(ae_int_t n,
double alpha,
double beta,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* wkronrod,
/* Real */ ae_vector* wgauss,
ae_state *_state)
{
ae_frame _frame_block;
ae_int_t clen;
ae_vector a;
ae_vector b;
double alpha2;
double beta2;
double apb;
double t;
ae_int_t i;
double s;
ae_frame_make(_state, &_frame_block);
memset(&a, 0, sizeof(a));
memset(&b, 0, sizeof(b));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(wkronrod);
ae_vector_clear(wgauss);
ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
if( n%2!=1||n<3 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
if( ae_fp_less_eq(alpha,(double)(-1))||ae_fp_less_eq(beta,(double)(-1)) )
{
*info = -1;
ae_frame_leave(_state);
return;
}
clen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1;
ae_vector_set_length(&a, clen, _state);
ae_vector_set_length(&b, clen, _state);
for(i=0; i<=clen-1; i++)
{
a.ptr.p_double[i] = (double)(0);
}
apb = alpha+beta;
a.ptr.p_double[0] = (beta-alpha)/(apb+2);
t = (apb+1)*ae_log((double)(2), _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state);
if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) )
{
*info = -4;
ae_frame_leave(_state);
return;
}
b.ptr.p_double[0] = ae_exp(t, _state);
if( clen>1 )
{
alpha2 = ae_sqr(alpha, _state);
beta2 = ae_sqr(beta, _state);
a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4));
b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state));
for(i=2; i<=clen-1; i++)
{
a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i));
b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state));
}
}
gkqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, wkronrod, wgauss, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
if( ae_fp_less(x->ptr.p_double[0],(double)(-1))||ae_fp_greater(x->ptr.p_double[n-1],(double)(1)) )
{
*info = 2;
}
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes for quadrature with N points.
Reduction to tridiagonal eigenproblem is used.
INPUT PARAMETERS:
N - number of Kronrod nodes, must be odd number, >=3.
OUTPUT PARAMETERS:
Info - error code:
* -4 an error was detected when calculating
weights/nodes. N is too large to obtain
weights/nodes with high enough accuracy.
Try to use multiple precision version.
* -3 internal eigenproblem solver hasn't converged
* -1 incorrect N was passed
* +1 OK
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqlegendrecalc(ae_int_t n,
ae_int_t* info,
/* Real */ ae_vector* x,
/* Real */ ae_vector* wkronrod,
/* Real */ ae_vector* wgauss,
ae_state *_state)
{
ae_frame _frame_block;
ae_vector alpha;
ae_vector beta;
ae_int_t alen;
ae_int_t blen;
double mu0;
ae_int_t k;
ae_int_t i;
ae_frame_make(_state, &_frame_block);
memset(&alpha, 0, sizeof(alpha));
memset(&beta, 0, sizeof(beta));
*info = 0;
ae_vector_clear(x);
ae_vector_clear(wkronrod);
ae_vector_clear(wgauss);
ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true);
ae_vector_init(&beta, 0, DT_REAL, _state, ae_true);
if( n%2!=1||n<3 )
{
*info = -1;
ae_frame_leave(_state);
return;
}
mu0 = (double)(2);
alen = ae_ifloor((double)(3*(n/2))/(double)2, _state)+1;
blen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1;
ae_vector_set_length(&alpha, alen, _state);
ae_vector_set_length(&beta, blen, _state);
for(k=0; k<=alen-1; k++)
{
alpha.ptr.p_double[k] = (double)(0);
}
beta.ptr.p_double[0] = (double)(2);
for(k=1; k<=blen-1; k++)
{
beta.ptr.p_double[k] = 1/(4-1/ae_sqr((double)(k), _state));
}
gkqgeneraterec(&alpha, &beta, mu0, n, info, x, wkronrod, wgauss, _state);
/*
* test basic properties to detect errors
*/
if( *info>0 )
{
if( ae_fp_less(x->ptr.p_double[0],(double)(-1))||ae_fp_greater(x->ptr.p_double[n-1],(double)(1)) )
{
*info = -4;
}
for(i=0; i<=n-2; i++)
{
if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
{
*info = -4;
}
}
}
ae_frame_leave(_state);
}
/*************************************************************************
Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using
pre-calculated table. Nodes/weights were computed with accuracy up to
1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision
accuracy reduces to something about 2.0E-16 (depending on your compiler's
handling of long floating point constants).
INPUT PARAMETERS:
N - number of Kronrod nodes.
N can be 15, 21, 31, 41, 51, 61.
OUTPUT PARAMETERS:
X - array[0..N-1] - array of quadrature nodes, ordered in
ascending order.
WKronrod - array[0..N-1] - Kronrod weights
WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
corresponding to extended Kronrod nodes).
-- ALGLIB --
Copyright 12.05.2009 by Bochkanov Sergey
*************************************************************************/
void gkqlegendretbl(ae_int_t n,
/* Real */ ae_vector* x,
/* Real */ ae_vector* wkronrod,
/* Real */ ae_vector* wgauss,
double* eps,
ae_state *_state)
{
ae_frame _frame_block;
ae_int_t i;
ae_int_t ng;
ae_vector p1;
ae_vector p2;
double tmp;
ae_frame_make(_state, &_frame_block);
memset(&p1, 0, sizeof(p1));
memset(&p2, 0, sizeof(p2));
ae_vector_clear(x);
ae_vector_clear(wkronrod);
ae_vector_clear(wgauss);
*eps = 0;
ae_vector_init(&p1, 0, DT_INT, _state, ae_true);
ae_vector_init(&p2, 0, DT_INT, _state, ae_true);
/*
* these initializers are not really necessary,
* but without them compiler complains about uninitialized locals
*/
ng = 0;
/*
* Process
*/
ae_assert(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61, "GKQNodesTbl: incorrect N!", _state);
ae_vector_set_length(x, n, _state);
ae_vector_set_length(wkronrod, n, _state);
ae_vector_set_length(wgauss, n, _state);
for(i=0; i<=n-1; i++)
{
x->ptr.p_double[i] = (double)(0);
wkronrod->ptr.p_double[i] = (double)(0);
wgauss->ptr.p_double[i] = (double)(0);
}
*eps = ae_maxreal(ae_machineepsilon, 1.0E-32, _state);
if( n==15 )
{
ng = 4;
wgauss->ptr.p_double[0] = 0.129484966168869693270611432679082;
wgauss->ptr.p_double[1] = 0.279705391489276667901467771423780;
wgauss->ptr.p_double[2] = 0.381830050505118944950369775488975;
wgauss->ptr.p_double[3] = 0.417959183673469387755102040816327;
x->ptr.p_double[0] = 0.991455371120812639206854697526329;
x->ptr.p_double[1] = 0.949107912342758524526189684047851;
x->ptr.p_double[2] = 0.864864423359769072789712788640926;
x->ptr.p_double[3] = 0.741531185599394439863864773280788;
x->ptr.p_double[4] = 0.586087235467691130294144838258730;
x->ptr.p_double[5] = 0.405845151377397166906606412076961;
x->ptr.p_double[6] = 0.207784955007898467600689403773245;
x->ptr.p_double[7] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.022935322010529224963732008058970;
wkronrod->ptr.p_double[1] = 0.063092092629978553290700663189204;
wkronrod->ptr.p_double[2] = 0.104790010322250183839876322541518;
wkronrod->ptr.p_double[3] = 0.140653259715525918745189590510238;
wkronrod->ptr.p_double[4] = 0.169004726639267902826583426598550;
wkronrod->ptr.p_double[5] = 0.190350578064785409913256402421014;
wkronrod->ptr.p_double[6] = 0.204432940075298892414161999234649;
wkronrod->ptr.p_double[7] = 0.209482141084727828012999174891714;
}
if( n==21 )
{
ng = 5;
wgauss->ptr.p_double[0] = 0.066671344308688137593568809893332;
wgauss->ptr.p_double[1] = 0.149451349150580593145776339657697;
wgauss->ptr.p_double[2] = 0.219086362515982043995534934228163;
wgauss->ptr.p_double[3] = 0.269266719309996355091226921569469;
wgauss->ptr.p_double[4] = 0.295524224714752870173892994651338;
x->ptr.p_double[0] = 0.995657163025808080735527280689003;
x->ptr.p_double[1] = 0.973906528517171720077964012084452;
x->ptr.p_double[2] = 0.930157491355708226001207180059508;
x->ptr.p_double[3] = 0.865063366688984510732096688423493;
x->ptr.p_double[4] = 0.780817726586416897063717578345042;
x->ptr.p_double[5] = 0.679409568299024406234327365114874;
x->ptr.p_double[6] = 0.562757134668604683339000099272694;
x->ptr.p_double[7] = 0.433395394129247190799265943165784;
x->ptr.p_double[8] = 0.294392862701460198131126603103866;
x->ptr.p_double[9] = 0.148874338981631210884826001129720;
x->ptr.p_double[10] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.011694638867371874278064396062192;
wkronrod->ptr.p_double[1] = 0.032558162307964727478818972459390;
wkronrod->ptr.p_double[2] = 0.054755896574351996031381300244580;
wkronrod->ptr.p_double[3] = 0.075039674810919952767043140916190;
wkronrod->ptr.p_double[4] = 0.093125454583697605535065465083366;
wkronrod->ptr.p_double[5] = 0.109387158802297641899210590325805;
wkronrod->ptr.p_double[6] = 0.123491976262065851077958109831074;
wkronrod->ptr.p_double[7] = 0.134709217311473325928054001771707;
wkronrod->ptr.p_double[8] = 0.142775938577060080797094273138717;
wkronrod->ptr.p_double[9] = 0.147739104901338491374841515972068;
wkronrod->ptr.p_double[10] = 0.149445554002916905664936468389821;
}
if( n==31 )
{
ng = 8;
wgauss->ptr.p_double[0] = 0.030753241996117268354628393577204;
wgauss->ptr.p_double[1] = 0.070366047488108124709267416450667;
wgauss->ptr.p_double[2] = 0.107159220467171935011869546685869;
wgauss->ptr.p_double[3] = 0.139570677926154314447804794511028;
wgauss->ptr.p_double[4] = 0.166269205816993933553200860481209;
wgauss->ptr.p_double[5] = 0.186161000015562211026800561866423;
wgauss->ptr.p_double[6] = 0.198431485327111576456118326443839;
wgauss->ptr.p_double[7] = 0.202578241925561272880620199967519;
x->ptr.p_double[0] = 0.998002298693397060285172840152271;
x->ptr.p_double[1] = 0.987992518020485428489565718586613;
x->ptr.p_double[2] = 0.967739075679139134257347978784337;
x->ptr.p_double[3] = 0.937273392400705904307758947710209;
x->ptr.p_double[4] = 0.897264532344081900882509656454496;
x->ptr.p_double[5] = 0.848206583410427216200648320774217;
x->ptr.p_double[6] = 0.790418501442465932967649294817947;
x->ptr.p_double[7] = 0.724417731360170047416186054613938;
x->ptr.p_double[8] = 0.650996741297416970533735895313275;
x->ptr.p_double[9] = 0.570972172608538847537226737253911;
x->ptr.p_double[10] = 0.485081863640239680693655740232351;
x->ptr.p_double[11] = 0.394151347077563369897207370981045;
x->ptr.p_double[12] = 0.299180007153168812166780024266389;
x->ptr.p_double[13] = 0.201194093997434522300628303394596;
x->ptr.p_double[14] = 0.101142066918717499027074231447392;
x->ptr.p_double[15] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.005377479872923348987792051430128;
wkronrod->ptr.p_double[1] = 0.015007947329316122538374763075807;
wkronrod->ptr.p_double[2] = 0.025460847326715320186874001019653;
wkronrod->ptr.p_double[3] = 0.035346360791375846222037948478360;
wkronrod->ptr.p_double[4] = 0.044589751324764876608227299373280;
wkronrod->ptr.p_double[5] = 0.053481524690928087265343147239430;
wkronrod->ptr.p_double[6] = 0.062009567800670640285139230960803;
wkronrod->ptr.p_double[7] = 0.069854121318728258709520077099147;
wkronrod->ptr.p_double[8] = 0.076849680757720378894432777482659;
wkronrod->ptr.p_double[9] = 0.083080502823133021038289247286104;
wkronrod->ptr.p_double[10] = 0.088564443056211770647275443693774;
wkronrod->ptr.p_double[11] = 0.093126598170825321225486872747346;
wkronrod->ptr.p_double[12] = 0.096642726983623678505179907627589;
wkronrod->ptr.p_double[13] = 0.099173598721791959332393173484603;
wkronrod->ptr.p_double[14] = 0.100769845523875595044946662617570;
wkronrod->ptr.p_double[15] = 0.101330007014791549017374792767493;
}
if( n==41 )
{
ng = 10;
wgauss->ptr.p_double[0] = 0.017614007139152118311861962351853;
wgauss->ptr.p_double[1] = 0.040601429800386941331039952274932;
wgauss->ptr.p_double[2] = 0.062672048334109063569506535187042;
wgauss->ptr.p_double[3] = 0.083276741576704748724758143222046;
wgauss->ptr.p_double[4] = 0.101930119817240435036750135480350;
wgauss->ptr.p_double[5] = 0.118194531961518417312377377711382;
wgauss->ptr.p_double[6] = 0.131688638449176626898494499748163;
wgauss->ptr.p_double[7] = 0.142096109318382051329298325067165;
wgauss->ptr.p_double[8] = 0.149172986472603746787828737001969;
wgauss->ptr.p_double[9] = 0.152753387130725850698084331955098;
x->ptr.p_double[0] = 0.998859031588277663838315576545863;
x->ptr.p_double[1] = 0.993128599185094924786122388471320;
x->ptr.p_double[2] = 0.981507877450250259193342994720217;
x->ptr.p_double[3] = 0.963971927277913791267666131197277;
x->ptr.p_double[4] = 0.940822633831754753519982722212443;
x->ptr.p_double[5] = 0.912234428251325905867752441203298;
x->ptr.p_double[6] = 0.878276811252281976077442995113078;
x->ptr.p_double[7] = 0.839116971822218823394529061701521;
x->ptr.p_double[8] = 0.795041428837551198350638833272788;
x->ptr.p_double[9] = 0.746331906460150792614305070355642;
x->ptr.p_double[10] = 0.693237656334751384805490711845932;
x->ptr.p_double[11] = 0.636053680726515025452836696226286;
x->ptr.p_double[12] = 0.575140446819710315342946036586425;
x->ptr.p_double[13] = 0.510867001950827098004364050955251;
x->ptr.p_double[14] = 0.443593175238725103199992213492640;
x->ptr.p_double[15] = 0.373706088715419560672548177024927;
x->ptr.p_double[16] = 0.301627868114913004320555356858592;
x->ptr.p_double[17] = 0.227785851141645078080496195368575;
x->ptr.p_double[18] = 0.152605465240922675505220241022678;
x->ptr.p_double[19] = 0.076526521133497333754640409398838;
x->ptr.p_double[20] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.003073583718520531501218293246031;
wkronrod->ptr.p_double[1] = 0.008600269855642942198661787950102;
wkronrod->ptr.p_double[2] = 0.014626169256971252983787960308868;
wkronrod->ptr.p_double[3] = 0.020388373461266523598010231432755;
wkronrod->ptr.p_double[4] = 0.025882133604951158834505067096153;
wkronrod->ptr.p_double[5] = 0.031287306777032798958543119323801;
wkronrod->ptr.p_double[6] = 0.036600169758200798030557240707211;
wkronrod->ptr.p_double[7] = 0.041668873327973686263788305936895;
wkronrod->ptr.p_double[8] = 0.046434821867497674720231880926108;
wkronrod->ptr.p_double[9] = 0.050944573923728691932707670050345;
wkronrod->ptr.p_double[10] = 0.055195105348285994744832372419777;
wkronrod->ptr.p_double[11] = 0.059111400880639572374967220648594;
wkronrod->ptr.p_double[12] = 0.062653237554781168025870122174255;
wkronrod->ptr.p_double[13] = 0.065834597133618422111563556969398;
wkronrod->ptr.p_double[14] = 0.068648672928521619345623411885368;
wkronrod->ptr.p_double[15] = 0.071054423553444068305790361723210;
wkronrod->ptr.p_double[16] = 0.073030690332786667495189417658913;
wkronrod->ptr.p_double[17] = 0.074582875400499188986581418362488;
wkronrod->ptr.p_double[18] = 0.075704497684556674659542775376617;
wkronrod->ptr.p_double[19] = 0.076377867672080736705502835038061;
wkronrod->ptr.p_double[20] = 0.076600711917999656445049901530102;
}
if( n==51 )
{
ng = 13;
wgauss->ptr.p_double[0] = 0.011393798501026287947902964113235;
wgauss->ptr.p_double[1] = 0.026354986615032137261901815295299;
wgauss->ptr.p_double[2] = 0.040939156701306312655623487711646;
wgauss->ptr.p_double[3] = 0.054904695975835191925936891540473;
wgauss->ptr.p_double[4] = 0.068038333812356917207187185656708;
wgauss->ptr.p_double[5] = 0.080140700335001018013234959669111;
wgauss->ptr.p_double[6] = 0.091028261982963649811497220702892;
wgauss->ptr.p_double[7] = 0.100535949067050644202206890392686;
wgauss->ptr.p_double[8] = 0.108519624474263653116093957050117;
wgauss->ptr.p_double[9] = 0.114858259145711648339325545869556;
wgauss->ptr.p_double[10] = 0.119455763535784772228178126512901;
wgauss->ptr.p_double[11] = 0.122242442990310041688959518945852;
wgauss->ptr.p_double[12] = 0.123176053726715451203902873079050;
x->ptr.p_double[0] = 0.999262104992609834193457486540341;
x->ptr.p_double[1] = 0.995556969790498097908784946893902;
x->ptr.p_double[2] = 0.988035794534077247637331014577406;
x->ptr.p_double[3] = 0.976663921459517511498315386479594;
x->ptr.p_double[4] = 0.961614986425842512418130033660167;
x->ptr.p_double[5] = 0.942974571228974339414011169658471;
x->ptr.p_double[6] = 0.920747115281701561746346084546331;
x->ptr.p_double[7] = 0.894991997878275368851042006782805;
x->ptr.p_double[8] = 0.865847065293275595448996969588340;
x->ptr.p_double[9] = 0.833442628760834001421021108693570;
x->ptr.p_double[10] = 0.797873797998500059410410904994307;
x->ptr.p_double[11] = 0.759259263037357630577282865204361;
x->ptr.p_double[12] = 0.717766406813084388186654079773298;
x->ptr.p_double[13] = 0.673566368473468364485120633247622;
x->ptr.p_double[14] = 0.626810099010317412788122681624518;
x->ptr.p_double[15] = 0.577662930241222967723689841612654;
x->ptr.p_double[16] = 0.526325284334719182599623778158010;
x->ptr.p_double[17] = 0.473002731445714960522182115009192;
x->ptr.p_double[18] = 0.417885382193037748851814394594572;
x->ptr.p_double[19] = 0.361172305809387837735821730127641;
x->ptr.p_double[20] = 0.303089538931107830167478909980339;
x->ptr.p_double[21] = 0.243866883720988432045190362797452;
x->ptr.p_double[22] = 0.183718939421048892015969888759528;
x->ptr.p_double[23] = 0.122864692610710396387359818808037;
x->ptr.p_double[24] = 0.061544483005685078886546392366797;
x->ptr.p_double[25] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.001987383892330315926507851882843;
wkronrod->ptr.p_double[1] = 0.005561932135356713758040236901066;
wkronrod->ptr.p_double[2] = 0.009473973386174151607207710523655;
wkronrod->ptr.p_double[3] = 0.013236229195571674813656405846976;
wkronrod->ptr.p_double[4] = 0.016847817709128298231516667536336;
wkronrod->ptr.p_double[5] = 0.020435371145882835456568292235939;
wkronrod->ptr.p_double[6] = 0.024009945606953216220092489164881;
wkronrod->ptr.p_double[7] = 0.027475317587851737802948455517811;
wkronrod->ptr.p_double[8] = 0.030792300167387488891109020215229;
wkronrod->ptr.p_double[9] = 0.034002130274329337836748795229551;
wkronrod->ptr.p_double[10] = 0.037116271483415543560330625367620;
wkronrod->ptr.p_double[11] = 0.040083825504032382074839284467076;
wkronrod->ptr.p_double[12] = 0.042872845020170049476895792439495;
wkronrod->ptr.p_double[13] = 0.045502913049921788909870584752660;
wkronrod->ptr.p_double[14] = 0.047982537138836713906392255756915;
wkronrod->ptr.p_double[15] = 0.050277679080715671963325259433440;
wkronrod->ptr.p_double[16] = 0.052362885806407475864366712137873;
wkronrod->ptr.p_double[17] = 0.054251129888545490144543370459876;
wkronrod->ptr.p_double[18] = 0.055950811220412317308240686382747;
wkronrod->ptr.p_double[19] = 0.057437116361567832853582693939506;
wkronrod->ptr.p_double[20] = 0.058689680022394207961974175856788;
wkronrod->ptr.p_double[21] = 0.059720340324174059979099291932562;
wkronrod->ptr.p_double[22] = 0.060539455376045862945360267517565;
wkronrod->ptr.p_double[23] = 0.061128509717053048305859030416293;
wkronrod->ptr.p_double[24] = 0.061471189871425316661544131965264;
wkronrod->ptr.p_double[25] = 0.061580818067832935078759824240055;
}
if( n==61 )
{
ng = 15;
wgauss->ptr.p_double[0] = 0.007968192496166605615465883474674;
wgauss->ptr.p_double[1] = 0.018466468311090959142302131912047;
wgauss->ptr.p_double[2] = 0.028784707883323369349719179611292;
wgauss->ptr.p_double[3] = 0.038799192569627049596801936446348;
wgauss->ptr.p_double[4] = 0.048402672830594052902938140422808;
wgauss->ptr.p_double[5] = 0.057493156217619066481721689402056;
wgauss->ptr.p_double[6] = 0.065974229882180495128128515115962;
wgauss->ptr.p_double[7] = 0.073755974737705206268243850022191;
wgauss->ptr.p_double[8] = 0.080755895229420215354694938460530;
wgauss->ptr.p_double[9] = 0.086899787201082979802387530715126;
wgauss->ptr.p_double[10] = 0.092122522237786128717632707087619;
wgauss->ptr.p_double[11] = 0.096368737174644259639468626351810;
wgauss->ptr.p_double[12] = 0.099593420586795267062780282103569;
wgauss->ptr.p_double[13] = 0.101762389748405504596428952168554;
wgauss->ptr.p_double[14] = 0.102852652893558840341285636705415;
x->ptr.p_double[0] = 0.999484410050490637571325895705811;
x->ptr.p_double[1] = 0.996893484074649540271630050918695;
x->ptr.p_double[2] = 0.991630996870404594858628366109486;
x->ptr.p_double[3] = 0.983668123279747209970032581605663;
x->ptr.p_double[4] = 0.973116322501126268374693868423707;
x->ptr.p_double[5] = 0.960021864968307512216871025581798;
x->ptr.p_double[6] = 0.944374444748559979415831324037439;
x->ptr.p_double[7] = 0.926200047429274325879324277080474;
x->ptr.p_double[8] = 0.905573307699907798546522558925958;
x->ptr.p_double[9] = 0.882560535792052681543116462530226;
x->ptr.p_double[10] = 0.857205233546061098958658510658944;
x->ptr.p_double[11] = 0.829565762382768397442898119732502;
x->ptr.p_double[12] = 0.799727835821839083013668942322683;
x->ptr.p_double[13] = 0.767777432104826194917977340974503;
x->ptr.p_double[14] = 0.733790062453226804726171131369528;
x->ptr.p_double[15] = 0.697850494793315796932292388026640;
x->ptr.p_double[16] = 0.660061064126626961370053668149271;
x->ptr.p_double[17] = 0.620526182989242861140477556431189;
x->ptr.p_double[18] = 0.579345235826361691756024932172540;
x->ptr.p_double[19] = 0.536624148142019899264169793311073;
x->ptr.p_double[20] = 0.492480467861778574993693061207709;
x->ptr.p_double[21] = 0.447033769538089176780609900322854;
x->ptr.p_double[22] = 0.400401254830394392535476211542661;
x->ptr.p_double[23] = 0.352704725530878113471037207089374;
x->ptr.p_double[24] = 0.304073202273625077372677107199257;
x->ptr.p_double[25] = 0.254636926167889846439805129817805;
x->ptr.p_double[26] = 0.204525116682309891438957671002025;
x->ptr.p_double[27] = 0.153869913608583546963794672743256;
x->ptr.p_double[28] = 0.102806937966737030147096751318001;
x->ptr.p_double[29] = 0.051471842555317695833025213166723;
x->ptr.p_double[30] = 0.000000000000000000000000000000000;
wkronrod->ptr.p_double[0] = 0.001389013698677007624551591226760;
wkronrod->ptr.p_double[1] = 0.003890461127099884051267201844516;
wkronrod->ptr.p_double[2] = 0.006630703915931292173319826369750;
wkronrod->ptr.p_double[3] = 0.009273279659517763428441146892024;
wkronrod->ptr.p_double[4] = 0.011823015253496341742232898853251;
wkronrod->ptr.p_double[5] = 0.014369729507045804812451432443580;
wkronrod->ptr.p_double[6] = 0.016920889189053272627572289420322;
wkronrod->ptr.p_double[7] = 0.019414141193942381173408951050128;
wkronrod->ptr.p_double[8] = 0.021828035821609192297167485738339;
wkronrod->ptr.p_double[9] = 0.024191162078080601365686370725232;
wkronrod->ptr.p_double[10] = 0.026509954882333101610601709335075;
wkronrod->ptr.p_double[11] = 0.028754048765041292843978785354334;
wkronrod->ptr.p_double[12] = 0.030907257562387762472884252943092;
wkronrod->ptr.p_double[13] = 0.032981447057483726031814191016854;
wkronrod->ptr.p_double[14] = 0.034979338028060024137499670731468;
wkronrod->ptr.p_double[15] = 0.036882364651821229223911065617136;
wkronrod->ptr.p_double[16] = 0.038678945624727592950348651532281;
wkronrod->ptr.p_double[17] = 0.040374538951535959111995279752468;
wkronrod->ptr.p_double[18] = 0.041969810215164246147147541285970;
wkronrod->ptr.p_double[19] = 0.043452539701356069316831728117073;
wkronrod->ptr.p_double[20] = 0.044814800133162663192355551616723;
wkronrod->ptr.p_double[21] = 0.046059238271006988116271735559374;
wkronrod->ptr.p_double[22] = 0.047185546569299153945261478181099;
wkronrod->ptr.p_double[23] = 0.048185861757087129140779492298305;
wkronrod->ptr.p_double[24] = 0.049055434555029778887528165367238;
wkronrod->ptr.p_double[25] = 0.049795683427074206357811569379942;
wkronrod->ptr.p_double[26] = 0.050405921402782346840893085653585;
wkronrod->ptr.p_double[27] = 0.050881795898749606492297473049805;
wkronrod->ptr.p_double[28] = 0.051221547849258772170656282604944;
wkronrod->ptr.p_double[29] = 0.051426128537459025933862879215781;
wkronrod->ptr.p_double[30] = 0.051494729429451567558340433647099;
}
/*
* copy nodes
*/
for(i=n-1; i>=n/2; i--)
{
x->ptr.p_double[i] = -x->ptr.p_double[n-1-i];
}
/*
* copy Kronrod weights
*/
for(i=n-1; i>=n/2; i--)
{
wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[n-1-i];
}
/*
* copy Gauss weights
*/
for(i=ng-1; i>=0; i--)
{
wgauss->ptr.p_double[n-2-2*i] = wgauss->ptr.p_double[i];
wgauss->ptr.p_double[1+2*i] = wgauss->ptr.p_double[i];
}
for(i=0; i<=n/2; i++)
{
wgauss->ptr.p_double[2*i] = (double)(0);
}
/*
* reorder
*/
tagsort(x, n, &p1, &p2, _state);
for(i=0; i<=n-1; i++)
{
tmp = wkronrod->ptr.p_double[i];
wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[p2.ptr.p_int[i]];
wkronrod->ptr.p_double[p2.ptr.p_int[i]] = tmp;
tmp = wgauss->ptr.p_double[i];
wgauss->ptr.p_double[i] = wgauss->ptr.p_double[p2.ptr.p_int[i]];
wgauss->ptr.p_double[p2.ptr.p_int[i]] = tmp;
}
ae_frame_leave(_state);
}
#endif
#if defined(AE_COMPILE_AUTOGK) || !defined(AE_PARTIAL_BUILD)
/*************************************************************************
Integration of a smooth function F(x) on a finite interval [a,b].
Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
is calculated with accuracy close to the machine precision.
Algorithm works well only with smooth integrands. It may be used with
continuous non-smooth integrands, but with less performance.
It should never be used with integrands which have integrable singularities
at lower or upper limits - algorithm may crash. Use AutoGKSingular in such
cases.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmoothW, AutoGKSingular, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksmooth(double a,
double b,
autogkstate* state,
ae_state *_state)
{
_autogkstate_clear(state);
ae_assert(ae_isfinite(a, _state), "AutoGKSmooth: A is not finite!", _state);
ae_assert(ae_isfinite(b, _state), "AutoGKSmooth: B is not finite!", _state);
autogksmoothw(a, b, 0.0, state, _state);
}
/*************************************************************************
Integration of a smooth function F(x) on a finite interval [a,b].
This subroutine is same as AutoGKSmooth(), but it guarantees that interval
[a,b] is partitioned into subintervals which have width at most XWidth.
Subroutine can be used when integrating nearly-constant function with
narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth
subroutine can overlook them.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmooth, AutoGKSingular, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksmoothw(double a,
double b,
double xwidth,
autogkstate* state,
ae_state *_state)
{
_autogkstate_clear(state);
ae_assert(ae_isfinite(a, _state), "AutoGKSmoothW: A is not finite!", _state);
ae_assert(ae_isfinite(b, _state), "AutoGKSmoothW: B is not finite!", _state);
ae_assert(ae_isfinite(xwidth, _state), "AutoGKSmoothW: XWidth is not finite!", _state);
state->wrappermode = 0;
state->a = a;
state->b = b;
state->xwidth = xwidth;
state->needf = ae_false;
ae_vector_set_length(&state->rstate.ra, 10+1, _state);
state->rstate.stage = -1;
}
/*************************************************************************
Integration on a finite interval [A,B].
Integrand have integrable singularities at A/B.
F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known
alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates
from below can be used (but these estimates should be greater than -1 too).
One of alpha/beta variables (or even both alpha/beta) may be equal to 0,
which means than function F(x) is non-singular at A/B. Anyway (singular at
bounds or not), function F(x) is supposed to be continuous on (A,B).
Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
is calculated with accuracy close to the machine precision.
INPUT PARAMETERS:
A, B - interval boundaries (A<B, A=B or A>B)
Alpha - power-law coefficient of the F(x) at A,
Alpha>-1
Beta - power-law coefficient of the F(x) at B,
Beta>-1
OUTPUT PARAMETERS
State - structure which stores algorithm state
SEE ALSO
AutoGKSmooth, AutoGKSmoothW, AutoGKResults.
-- ALGLIB --
Copyright 06.05.2009 by Bochkanov Sergey
*************************************************************************/
void autogksingular(double a,
double b,
double alpha,
double beta,
autogkstate* state,
ae_state *_state)
{
_autogkstate_clear(state);
ae_assert(ae_isfinite(a, _state), "AutoGKSingular: A is not finite!", _state);
ae_assert(ae_isfinite(b, _state), "AutoGKSingular: B is not finite!", _state);
ae_assert(ae_isfinite(alpha, _state), "AutoGKSingular: Alpha is not finite!", _state);
ae_assert(ae_isfinite(beta, _state), "AutoGKSingular: Beta is not finite!", _state);
state->wrappermode = 1;
state->a = a;
state->b = b;
state->alpha = alpha;
state->beta = beta;
state->xwidth = 0.0;
state->needf = ae_false;
ae_vector_set_length(&state->rstate.ra, 10+1, _state);
state->rstate.stage = -1;
}
/*************************************************************************
-- ALGLIB --
Copyright 07.05.2009 by Bochkanov Sergey
*************************************************************************/
ae_bool autogkiteration(autogkstate* state, ae_state *_state)
{
double s;
double tmp;
double eps;
double a;
double b;
double x;
double t;
double alpha;
double beta;
double v1;
double v2;
ae_bool result;
/*
* Reverse communication preparations
* I know it looks ugly, but it works the same way
* anywhere from C++ to Python.
*
* This code initializes locals by:
* * random values determined during code
* generation - on first subroutine call
* * values from previous call - on subsequent calls
*/
if( state->rstate.stage>=0 )
{
s = state->rstate.ra.ptr.p_double[0];
tmp = state->rstate.ra.ptr.p_double[1];
eps = state->rstate.ra.ptr.p_double[2];
a = state->rstate.ra.ptr.p_double[3];
b = state->rstate.ra.ptr.p_double[4];
x = state->rstate.ra.ptr.p_double[5];
t = state->rstate.ra.ptr.p_double[6];
alpha = state->rstate.ra.ptr.p_double[7];
beta = state->rstate.ra.ptr.p_double[8];
v1 = state->rstate.ra.ptr.p_double[9];
v2 = state->rstate.ra.ptr.p_double[10];
}
else
{
s = 359;
tmp = -58;
eps = -919;
a = -909;
b = 81;
x = 255;
t = 74;
alpha = -788;
beta = 809;
v1 = 205;
v2 = -838;
}
if( state->rstate.stage==0 )
{
goto lbl_0;
}
if( state->rstate.stage==1 )
{
goto lbl_1;
}
if( state->rstate.stage==2 )
{
goto lbl_2;
}
/*
* Routine body
*/
eps = (double)(0);
a = state->a;
b = state->b;
alpha = state->alpha;
beta = state->beta;
state->terminationtype = -1;
state->nfev = 0;
state->nintervals = 0;
/*
* smooth function at a finite interval
*/
if( state->wrappermode!=0 )
{
goto lbl_3;
}
/*
* special case
*/
if( ae_fp_eq(a,b) )
{
state->terminationtype = 1;
state->v = (double)(0);
result = ae_false;
return result;
}
/*
* general case
*/
autogk_autogkinternalprepare(a, b, eps, state->xwidth, &state->internalstate, _state);
lbl_5:
if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
{
goto lbl_6;
}
x = state->internalstate.x;
state->x = x;
state->xminusa = x-a;
state->bminusx = b-x;
state->needf = ae_true;
state->rstate.stage = 0;
goto lbl_rcomm;
lbl_0:
state->needf = ae_false;
state->nfev = state->nfev+1;
state->internalstate.f = state->f;
goto lbl_5;
lbl_6:
state->v = state->internalstate.r;
state->terminationtype = state->internalstate.info;
state->nintervals = state->internalstate.heapused;
result = ae_false;
return result;
lbl_3:
/*
* function with power-law singularities at the ends of a finite interval
*/
if( state->wrappermode!=1 )
{
goto lbl_7;
}
/*
* test coefficients
*/
if( ae_fp_less_eq(alpha,(double)(-1))||ae_fp_less_eq(beta,(double)(-1)) )
{
state->terminationtype = -1;
state->v = (double)(0);
result = ae_false;
return result;
}
/*
* special cases
*/
if( ae_fp_eq(a,b) )
{
state->terminationtype = 1;
state->v = (double)(0);
result = ae_false;
return result;
}
/*
* reduction to general form
*/
if( ae_fp_less(a,b) )
{
s = (double)(1);
}
else
{
s = (double)(-1);
tmp = a;
a = b;
b = tmp;
tmp = alpha;
alpha = beta;
beta = tmp;
}
alpha = ae_minreal(alpha, (double)(0), _state);
beta = ae_minreal(beta, (double)(0), _state);
/*
* first, integrate left half of [a,b]:
* integral(f(x)dx, a, (b+a)/2) =
* = 1/(1+alpha) * integral(t^(-alpha/(1+alpha))*f(a+t^(1/(1+alpha)))dt, 0, (0.5*(b-a))^(1+alpha))
*/
autogk_autogkinternalprepare((double)(0), ae_pow(0.5*(b-a), 1+alpha, _state), eps, state->xwidth, &state->internalstate, _state);
lbl_9:
if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
{
goto lbl_10;
}
/*
* Fill State.X, State.XMinusA, State.BMinusX.
* Latter two are filled correctly even if B<A.
*/
x = state->internalstate.x;
t = ae_pow(x, 1/(1+alpha), _state);
state->x = a+t;
if( ae_fp_greater(s,(double)(0)) )
{
state->xminusa = t;
state->bminusx = b-(a+t);
}
else
{
state->xminusa = a+t-b;
state->bminusx = -t;
}
state->needf = ae_true;
state->rstate.stage = 1;
goto lbl_rcomm;
lbl_1:
state->needf = ae_false;
if( ae_fp_neq(alpha,(double)(0)) )
{
state->internalstate.f = state->f*ae_pow(x, -alpha/(1+alpha), _state)/(1+alpha);
}
else
{
state->internalstate.f = state->f;
}
state->nfev = state->nfev+1;
goto lbl_9;
lbl_10:
v1 = state->internalstate.r;
state->nintervals = state->nintervals+state->internalstate.heapused;
/*
* then, integrate right half of [a,b]:
* integral(f(x)dx, (b+a)/2, b) =
* = 1/(1+beta) * integral(t^(-beta/(1+beta))*f(b-t^(1/(1+beta)))dt, 0, (0.5*(b-a))^(1+beta))
*/
autogk_autogkinternalprepare((double)(0), ae_pow(0.5*(b-a), 1+beta, _state), eps, state->xwidth, &state->internalstate, _state);
lbl_11:
if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
{
goto lbl_12;
}
/*
* Fill State.X, State.XMinusA, State.BMinusX.
* Latter two are filled correctly (X-A, B-X) even if B<A.
*/
x = state->internalstate.x;
t = ae_pow(x, 1/(1+beta), _state);
state->x = b-t;
if( ae_fp_greater(s,(double)(0)) )
{
state->xminusa = b-t-a;
state->bminusx = t;
}
else
{
state->xminusa = -t;
state->bminusx = a-(b-t);
}
state->needf = ae_true;
state->rstate.stage = 2;
goto lbl_rcomm;
lbl_2:
state->needf = ae_false;
if( ae_fp_neq(beta,(double)(0)) )
{
state->internalstate.f = state->f*ae_pow(x, -beta/(1+beta), _state)/(1+beta);
}
else
{
state->internalstate.f = state->f;
}
state->nfev = state->nfev+1;
goto lbl_11;
lbl_12:
v2 = state->internalstate.r;
state->nintervals = state->nintervals+state->internalstate.heapused;
/*
* final result
*/
state->v = s*(v1+v2);
state->terminationtype = 1;
result = ae_false;
return result;
lbl_7:
result = ae_false;
return result;
/*
* Saving state
*/
lbl_rcomm:
result = ae_true;
state->rstate.ra.ptr.p_double[0] = s;
state->rstate.ra.ptr.p_double[1] = tmp;
state->rstate.ra.ptr.p_double[2] = eps;
state->rstate.ra.ptr.p_double[3] = a;
state->rstate.ra.ptr.p_double[4] = b;
state->rstate.ra.ptr.p_double[5] = x;
state->rstate.ra.ptr.p_double[6] = t;
state->rstate.ra.ptr.p_double[7] = alpha;
state->rstate.ra.ptr.p_double[8] = beta;
state->rstate.ra.ptr.p_double[9] = v1;
state->rstate.ra.ptr.p_double[10] = v2;
return result;
}
/*************************************************************************
Adaptive integration results
Called after AutoGKIteration returned False.
Input parameters:
State - algorithm state (used by AutoGKIteration).
Output parameters:
V - integral(f(x)dx,a,b)
Rep - optimization report (see AutoGKReport description)
-- ALGLIB --
Copyright 14.11.2007 by Bochkanov Sergey
*************************************************************************/
void autogkresults(autogkstate* state,
double* v,
autogkreport* rep,
ae_state *_state)
{
*v = 0;
_autogkreport_clear(rep);
*v = state->v;
rep->terminationtype = state->terminationtype;
rep->nfev = state->nfev;
rep->nintervals = state->nintervals;
}
/*************************************************************************
Internal AutoGK subroutine
eps<0 - error
eps=0 - automatic eps selection
width<0 - error
width=0 - no width requirements
*************************************************************************/
static void autogk_autogkinternalprepare(double a,
double b,
double eps,
double xwidth,
autogkinternalstate* state,
ae_state *_state)
{
/*
* Save settings
*/
state->a = a;
state->b = b;
state->eps = eps;
state->xwidth = xwidth;
/*
* Prepare RComm structure
*/
ae_vector_set_length(&state->rstate.ia, 3+1, _state);
ae_vector_set_length(&state->rstate.ra, 8+1, _state);
state->rstate.stage = -1;
}
/*************************************************************************
Internal AutoGK subroutine
*************************************************************************/
static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state,
ae_state *_state)
{
double c1;
double c2;
ae_int_t i;
ae_int_t j;
double intg;
double intk;
double inta;
double v;
double ta;
double tb;
ae_int_t ns;
double qeps;
ae_int_t info;
ae_bool result;
/*
* Reverse communication preparations
* I know it looks ugly, but it works the same way
* anywhere from C++ to Python.
*
* This code initializes locals by:
* * random values determined during code
* generation - on first subroutine call
* * values from previous call - on subsequent calls
*/
if( state->rstate.stage>=0 )
{
i = state->rstate.ia.ptr.p_int[0];
j = state->rstate.ia.ptr.p_int[1];
ns = state->rstate.ia.ptr.p_int[2];
info = state->rstate.ia.ptr.p_int[3];
c1 = state->rstate.ra.ptr.p_double[0];
c2 = state->rstate.ra.ptr.p_double[1];
intg = state->rstate.ra.ptr.p_double[2];
intk = state->rstate.ra.ptr.p_double[3];
inta = state->rstate.ra.ptr.p_double[4];
v = state->rstate.ra.ptr.p_double[5];
ta = state->rstate.ra.ptr.p_double[6];
tb = state->rstate.ra.ptr.p_double[7];
qeps = state->rstate.ra.ptr.p_double[8];
}
else
{
i = 939;
j = -526;
ns = 763;
info = -541;
c1 = -698;
c2 = -900;
intg = -318;
intk = -940;
inta = 1016;
v = -229;
ta = -536;
tb = 487;
qeps = -115;
}
if( state->rstate.stage==0 )
{
goto lbl_0;
}
if( state->rstate.stage==1 )
{
goto lbl_1;
}
if( state->rstate.stage==2 )
{
goto lbl_2;
}
/*
* Routine body
*/
/*
* initialize quadratures.
* use 15-point Gauss-Kronrod formula.
*/
state->n = 15;
gkqgenerategausslegendre(state->n, &info, &state->qn, &state->wk, &state->wg, _state);
if( info<0 )
{
state->info = -5;
state->r = (double)(0);
result = ae_false;
return result;
}
ae_vector_set_length(&state->wr, state->n, _state);
for(i=0; i<=state->n-1; i++)
{
if( i==0 )
{
state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[1]-state->qn.ptr.p_double[0], _state);
continue;
}
if( i==state->n-1 )
{
state->wr.ptr.p_double[state->n-1] = 0.5*ae_fabs(state->qn.ptr.p_double[state->n-1]-state->qn.ptr.p_double[state->n-2], _state);
continue;
}
state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[i-1]-state->qn.ptr.p_double[i+1], _state);
}
/*
* special case
*/
if( ae_fp_eq(state->a,state->b) )
{
state->info = 1;
state->r = (double)(0);
result = ae_false;
return result;
}
/*
* test parameters
*/
if( ae_fp_less(state->eps,(double)(0))||ae_fp_less(state->xwidth,(double)(0)) )
{
state->info = -1;
state->r = (double)(0);
result = ae_false;
return result;
}
state->info = 1;
if( ae_fp_eq(state->eps,(double)(0)) )
{
state->eps = 100000*ae_machineepsilon;
}
/*
* First, prepare heap
* * column 0 - absolute error
* * column 1 - integral of a F(x) (calculated using Kronrod extension nodes)
* * column 2 - integral of a |F(x)| (calculated using modified rect. method)
* * column 3 - left boundary of a subinterval
* * column 4 - right boundary of a subinterval
*/
if( ae_fp_neq(state->xwidth,(double)(0)) )
{
goto lbl_3;
}
/*
* no maximum width requirements
* start from one big subinterval
*/
state->heapwidth = 5;
state->heapsize = 1;
state->heapused = 1;
ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state);
c1 = 0.5*(state->b-state->a);
c2 = 0.5*(state->b+state->a);
intg = (double)(0);
intk = (double)(0);
inta = (double)(0);
i = 0;
lbl_5:
if( i>state->n-1 )
{
goto lbl_7;
}
/*
* obtain F
*/
state->x = c1*state->qn.ptr.p_double[i]+c2;
state->rstate.stage = 0;
goto lbl_rcomm;
lbl_0:
v = state->f;
/*
* Gauss-Kronrod formula
*/
intk = intk+v*state->wk.ptr.p_double[i];
if( i%2==1 )
{
intg = intg+v*state->wg.ptr.p_double[i];
}
/*
* Integral |F(x)|
* Use rectangles method
*/
inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
i = i+1;
goto lbl_5;
lbl_7:
intk = intk*(state->b-state->a)*0.5;
intg = intg*(state->b-state->a)*0.5;
inta = inta*(state->b-state->a)*0.5;
state->heap.ptr.pp_double[0][0] = ae_fabs(intg-intk, _state);
state->heap.ptr.pp_double[0][1] = intk;
state->heap.ptr.pp_double[0][2] = inta;
state->heap.ptr.pp_double[0][3] = state->a;
state->heap.ptr.pp_double[0][4] = state->b;
state->sumerr = state->heap.ptr.pp_double[0][0];
state->sumabs = ae_fabs(inta, _state);
goto lbl_4;
lbl_3:
/*
* maximum subinterval should be no more than XWidth.
* so we create Ceil((B-A)/XWidth)+1 small subintervals
*/
ns = ae_iceil(ae_fabs(state->b-state->a, _state)/state->xwidth, _state)+1;
state->heapsize = ns;
state->heapused = ns;
state->heapwidth = 5;
ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state);
state->sumerr = (double)(0);
state->sumabs = (double)(0);
j = 0;
lbl_8:
if( j>ns-1 )
{
goto lbl_10;
}
ta = state->a+j*(state->b-state->a)/ns;
tb = state->a+(j+1)*(state->b-state->a)/ns;
c1 = 0.5*(tb-ta);
c2 = 0.5*(tb+ta);
intg = (double)(0);
intk = (double)(0);
inta = (double)(0);
i = 0;
lbl_11:
if( i>state->n-1 )
{
goto lbl_13;
}
/*
* obtain F
*/
state->x = c1*state->qn.ptr.p_double[i]+c2;
state->rstate.stage = 1;
goto lbl_rcomm;
lbl_1:
v = state->f;
/*
* Gauss-Kronrod formula
*/
intk = intk+v*state->wk.ptr.p_double[i];
if( i%2==1 )
{
intg = intg+v*state->wg.ptr.p_double[i];
}
/*
* Integral |F(x)|
* Use rectangles method
*/
inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
i = i+1;
goto lbl_11;
lbl_13:
intk = intk*(tb-ta)*0.5;
intg = intg*(tb-ta)*0.5;
inta = inta*(tb-ta)*0.5;
state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state);
state->heap.ptr.pp_double[j][1] = intk;
state->heap.ptr.pp_double[j][2] = inta;
state->heap.ptr.pp_double[j][3] = ta;
state->heap.ptr.pp_double[j][4] = tb;
state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0];
state->sumabs = state->sumabs+ae_fabs(inta, _state);
j = j+1;
goto lbl_8;
lbl_10:
lbl_4:
/*
* method iterations
*/
lbl_14:
if( ae_false )
{
goto lbl_15;
}
/*
* additional memory if needed
*/
if( state->heapused==state->heapsize )
{
autogk_mheapresize(&state->heap, &state->heapsize, 4*state->heapsize, state->heapwidth, _state);
}
/*
* TODO: every 20 iterations recalculate errors/sums
*/
if( ae_fp_less_eq(state->sumerr,state->eps*state->sumabs)||state->heapused>=autogk_maxsubintervals )
{
state->r = (double)(0);
for(j=0; j<=state->heapused-1; j++)
{
state->r = state->r+state->heap.ptr.pp_double[j][1];
}
result = ae_false;
return result;
}
/*
* Exclude interval with maximum absolute error
*/
autogk_mheappop(&state->heap, state->heapused, state->heapwidth, _state);
state->sumerr = state->sumerr-state->heap.ptr.pp_double[state->heapused-1][0];
state->sumabs = state->sumabs-state->heap.ptr.pp_double[state->heapused-1][2];
/*
* Divide interval, create subintervals
*/
ta = state->heap.ptr.pp_double[state->heapused-1][3];
tb = state->heap.ptr.pp_double[state->heapused-1][4];
state->heap.ptr.pp_double[state->heapused-1][3] = ta;
state->heap.ptr.pp_double[state->heapused-1][4] = 0.5*(ta+tb);
state->heap.ptr.pp_double[state->heapused][3] = 0.5*(ta+tb);
state->heap.ptr.pp_double[state->heapused][4] = tb;
j = state->heapused-1;
lbl_16:
if( j>state->heapused )
{
goto lbl_18;
}
c1 = 0.5*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3]);
c2 = 0.5*(state->heap.ptr.pp_double[j][4]+state->heap.ptr.pp_double[j][3]);
intg = (double)(0);
intk = (double)(0);
inta = (double)(0);
i = 0;
lbl_19:
if( i>state->n-1 )
{
goto lbl_21;
}
/*
* F(x)
*/
state->x = c1*state->qn.ptr.p_double[i]+c2;
state->rstate.stage = 2;
goto lbl_rcomm;
lbl_2:
v = state->f;
/*
* Gauss-Kronrod formula
*/
intk = intk+v*state->wk.ptr.p_double[i];
if( i%2==1 )
{
intg = intg+v*state->wg.ptr.p_double[i];
}
/*
* Integral |F(x)|
* Use rectangles method
*/
inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
i = i+1;
goto lbl_19;
lbl_21:
intk = intk*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
intg = intg*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
inta = inta*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state);
state->heap.ptr.pp_double[j][1] = intk;
state->heap.ptr.pp_double[j][2] = inta;
state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0];
state->sumabs = state->sumabs+state->heap.ptr.pp_double[j][2];
j = j+1;
goto lbl_16;
lbl_18:
autogk_mheappush(&state->heap, state->heapused-1, state->heapwidth, _state);
autogk_mheappush(&state->heap, state->heapused, state->heapwidth, _state);
state->heapused = state->heapused+1;
goto lbl_14;
lbl_15:
result = ae_false;
return result;
/*
* Saving state
*/
lbl_rcomm:
result = ae_true;
state->rstate.ia.ptr.p_int[0] = i;
state->rstate.ia.ptr.p_int[1] = j;
state->rstate.ia.ptr.p_int[2] = ns;
state->rstate.ia.ptr.p_int[3] = info;
state->rstate.ra.ptr.p_double[0] = c1;
state->rstate.ra.ptr.p_double[1] = c2;
state->rstate.ra.ptr.p_double[2] = intg;
state->rstate.ra.ptr.p_double[3] = intk;
state->rstate.ra.ptr.p_double[4] = inta;
state->rstate.ra.ptr.p_double[5] = v;
state->rstate.ra.ptr.p_double[6] = ta;
state->rstate.ra.ptr.p_double[7] = tb;
state->rstate.ra.ptr.p_double[8] = qeps;
return result;
}
static void autogk_mheappop(/* Real */ ae_matrix* heap,
ae_int_t heapsize,
ae_int_t heapwidth,
ae_state *_state)
{
ae_int_t i;
ae_int_t p;
double t;
ae_int_t maxcp;
if( heapsize==1 )
{
return;
}
for(i=0; i<=heapwidth-1; i++)
{
t = heap->ptr.pp_double[heapsize-1][i];
heap->ptr.pp_double[heapsize-1][i] = heap->ptr.pp_double[0][i];
heap->ptr.pp_double[0][i] = t;
}
p = 0;
while(2*p+1<heapsize-1)
{
maxcp = 2*p+1;
if( 2*p+2<heapsize-1 )
{
if( ae_fp_greater(heap->ptr.pp_double[2*p+2][0],heap->ptr.pp_double[2*p+1][0]) )
{
maxcp = 2*p+2;
}
}
if( ae_fp_less(heap->ptr.pp_double[p][0],heap->ptr.pp_double[maxcp][0]) )
{
for(i=0; i<=heapwidth-1; i++)
{
t = heap->ptr.pp_double[p][i];
heap->ptr.pp_double[p][i] = heap->ptr.pp_double[maxcp][i];
heap->ptr.pp_double[maxcp][i] = t;
}
p = maxcp;
}
else
{
break;
}
}
}
static void autogk_mheappush(/* Real */ ae_matrix* heap,
ae_int_t heapsize,
ae_int_t heapwidth,
ae_state *_state)
{
ae_int_t i;
ae_int_t p;
double t;
ae_int_t parent;
if( heapsize==0 )
{
return;
}
p = heapsize;
while(p!=0)
{
parent = (p-1)/2;
if( ae_fp_greater(heap->ptr.pp_double[p][0],heap->ptr.pp_double[parent][0]) )
{
for(i=0; i<=heapwidth-1; i++)
{
t = heap->ptr.pp_double[p][i];
heap->ptr.pp_double[p][i] = heap->ptr.pp_double[parent][i];
heap->ptr.pp_double[parent][i] = t;
}
p = parent;
}
else
{
break;
}
}
}
static void autogk_mheapresize(/* Real */ ae_matrix* heap,
ae_int_t* heapsize,
ae_int_t newheapsize,
ae_int_t heapwidth,
ae_state *_state)
{
ae_frame _frame_block;
ae_matrix tmp;
ae_int_t i;
ae_frame_make(_state, &_frame_block);
memset(&tmp, 0, sizeof(tmp));
ae_matrix_init(&tmp, 0, 0, DT_REAL, _state, ae_true);
ae_matrix_set_length(&tmp, *heapsize, heapwidth, _state);
for(i=0; i<=*heapsize-1; i++)
{
ae_v_move(&tmp.ptr.pp_double[i][0], 1, &heap->ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1));
}
ae_matrix_set_length(heap, newheapsize, heapwidth, _state);
for(i=0; i<=*heapsize-1; i++)
{
ae_v_move(&heap->ptr.pp_double[i][0], 1, &tmp.ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1));
}
*heapsize = newheapsize;
ae_frame_leave(_state);
}
void _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic)
{
autogkreport *p = (autogkreport*)_p;
ae_touch_ptr((void*)p);
}
void _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
{
autogkreport *dst = (autogkreport*)_dst;
autogkreport *src = (autogkreport*)_src;
dst->terminationtype = src->terminationtype;
dst->nfev = src->nfev;
dst->nintervals = src->nintervals;
}
void _autogkreport_clear(void* _p)
{
autogkreport *p = (autogkreport*)_p;
ae_touch_ptr((void*)p);
}
void _autogkreport_destroy(void* _p)
{
autogkreport *p = (autogkreport*)_p;
ae_touch_ptr((void*)p);
}
void _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
{
autogkinternalstate *p = (autogkinternalstate*)_p;
ae_touch_ptr((void*)p);
ae_matrix_init(&p->heap, 0, 0, DT_REAL, _state, make_automatic);
ae_vector_init(&p->qn, 0, DT_REAL, _state, make_automatic);
ae_vector_init(&p->wg, 0, DT_REAL, _state, make_automatic);
ae_vector_init(&p->wk, 0, DT_REAL, _state, make_automatic);
ae_vector_init(&p->wr, 0, DT_REAL, _state, make_automatic);
_rcommstate_init(&p->rstate, _state, make_automatic);
}
void _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
{
autogkinternalstate *dst = (autogkinternalstate*)_dst;
autogkinternalstate *src = (autogkinternalstate*)_src;
dst->a = src->a;
dst->b = src->b;
dst->eps = src->eps;
dst->xwidth = src->xwidth;
dst->x = src->x;
dst->f = src->f;
dst->info = src->info;
dst->r = src->r;
ae_matrix_init_copy(&dst->heap, &src->heap, _state, make_automatic);
dst->heapsize = src->heapsize;
dst->heapwidth = src->heapwidth;
dst->heapused = src->heapused;
dst->sumerr = src->sumerr;
dst->sumabs = src->sumabs;
ae_vector_init_copy(&dst->qn, &src->qn, _state, make_automatic);
ae_vector_init_copy(&dst->wg, &src->wg, _state, make_automatic);
ae_vector_init_copy(&dst->wk, &src->wk, _state, make_automatic);
ae_vector_init_copy(&dst->wr, &src->wr, _state, make_automatic);
dst->n = src->n;
_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
}
void _autogkinternalstate_clear(void* _p)
{
autogkinternalstate *p = (autogkinternalstate*)_p;
ae_touch_ptr((void*)p);
ae_matrix_clear(&p->heap);
ae_vector_clear(&p->qn);
ae_vector_clear(&p->wg);
ae_vector_clear(&p->wk);
ae_vector_clear(&p->wr);
_rcommstate_clear(&p->rstate);
}
void _autogkinternalstate_destroy(void* _p)
{
autogkinternalstate *p = (autogkinternalstate*)_p;
ae_touch_ptr((void*)p);
ae_matrix_destroy(&p->heap);
ae_vector_destroy(&p->qn);
ae_vector_destroy(&p->wg);
ae_vector_destroy(&p->wk);
ae_vector_destroy(&p->wr);
_rcommstate_destroy(&p->rstate);
}
void _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
{
autogkstate *p = (autogkstate*)_p;
ae_touch_ptr((void*)p);
_autogkinternalstate_init(&p->internalstate, _state, make_automatic);
_rcommstate_init(&p->rstate, _state, make_automatic);
}
void _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
{
autogkstate *dst = (autogkstate*)_dst;
autogkstate *src = (autogkstate*)_src;
dst->a = src->a;
dst->b = src->b;
dst->alpha = src->alpha;
dst->beta = src->beta;
dst->xwidth = src->xwidth;
dst->x = src->x;
dst->xminusa = src->xminusa;
dst->bminusx = src->bminusx;
dst->needf = src->needf;
dst->f = src->f;
dst->wrappermode = src->wrappermode;
_autogkinternalstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic);
_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
dst->v = src->v;
dst->terminationtype = src->terminationtype;
dst->nfev = src->nfev;
dst->nintervals = src->nintervals;
}
void _autogkstate_clear(void* _p)
{
autogkstate *p = (autogkstate*)_p;
ae_touch_ptr((void*)p);
_autogkinternalstate_clear(&p->internalstate);
_rcommstate_clear(&p->rstate);
}
void _autogkstate_destroy(void* _p)
{
autogkstate *p = (autogkstate*)_p;
ae_touch_ptr((void*)p);
_autogkinternalstate_destroy(&p->internalstate);
_rcommstate_destroy(&p->rstate);
}
#endif
}
Reference in New Issue View Git Blame Copy Permalink