double MLFitterGSL::iteration(){
//do one itteration
//lock the model so user can not add or remove components during itteration
modelptr->setlocked(true);
//if the model has changed (a new or removed component eg.) create a new solver
if (modelptr->has_changed()){
createmodelinfo(); //this automaticaly calls initfitter() via created_modelinfo()
}
//do an itteration step
try{
const int status=gsl_multifit_fdfsolver_iterate(solver);
#ifdef FITTER_DEBUG
std::cout <<"solver status: "<<gsl_strerror(status)<<"\n";
std::cout <<"chi square/dof: "<<gsl_blas_dnrm2(solver->f)<<"\n";
#endif
this->setstatus(gsl_strerror(status)); //update status info of fitter
convertxtoparam(solver->x);
}
catch(...){
Saysomething mysay(0,"Error","Problem with call to gsl_multifit_fdfsolver_iterate, exit MLFitterGSL",true);
delete(this);
}
//unlock the model so user can add or remove components
modelptr->setlocked(false);
//put the goodness in the goodnessqueue to check for convergence
const double newgoodness= goodness_of_fit();
addgoodness(newgoodness);
return newgoodness;
}
scalar df_giddings(scalar x, sasfit_param *param)
{
scalar bckgr, amplitude, center, width;
gsl_sf_result besselI1, besselI0;
int status;
sasfit_get_param(param, 4, &litude, ¢er, &width, &bckgr);
gsl_set_error_handler_off();
status = gsl_sf_bessel_In_e(1, 0.2e1 * sqrt(center * x) / width,&besselI1);
if (status) {
SASFIT_CHECK_COND1((status != 0), param, "%s",gsl_strerror(status));
return 0;
}
status = gsl_sf_bessel_In_e(0, 0.2e1 * sqrt(center * x) / width,&besselI0);
if (status) {
SASFIT_CHECK_COND1((status != 0), param, "%s",gsl_strerror(status));
return 0;
}
return -exp(-(x + center) / width) * center * pow(x, -0.2e1) *
(- besselI0.val * sqrt(center * x)
+ width * besselI1.val
+ besselI1.val * x)
* pow(width, -0.2e1) * pow(center / x, -0.1e1 / 0.2e1);
}
/**
* Do one iteration.
* @return :: true if iterations to be continued, false if they can stop
*/
bool SimplexMinimizer::iterate(size_t) {
int status = gsl_multimin_fminimizer_iterate(m_gslSolver);
if (status) {
m_errorString = gsl_strerror(status);
return false;
}
double size = gsl_multimin_fminimizer_size(m_gslSolver);
status = gsl_multimin_test_size(size, m_epsabs);
if (status != GSL_CONTINUE) {
m_errorString = gsl_strerror(status);
return false;
}
return true;
}
void sled(double k, double q, double p, const QString& fileName)
{
QFile f(fileName);
f.open(QIODevice::WriteOnly);
QTextStream stream(&f);
auto i = new GslIntegrator();
double y[] = {q, p};
gsl_odeiv2_system sys = {fun_zoga, 0, 2, &k};
gsl_odeiv2_driver* driver = gsl_odeiv2_driver_alloc_y_new(&sys, gsl_odeiv2_step_rk4, 1e-4, 1e-3, 1e-3);
double t = 0.0;
while (t < 20.0)
{
int c = fmod(t, 2) > 1 ? 1 : 0;
double q = y[0], p = y[1];
omeji(&q, &p);
stream << t << " " << q << " " << p << " " << c << endl;
int status = gsl_odeiv2_driver_apply_fixed_step(driver, &t, 1e-4, 1, y);
if (status != GSL_SUCCESS)
{
qDebug() << t << gsl_strerror(status);
break;
}
}
f.close();
}
/**
* @brief Performs a check on GSL library function return status
*
* This covenience method performs a validity check on the return status of a
* GSL function. It will throw an ISIS exception should the status be anything
* other than GSL_SUCCESS.
*
* @param gsl_status Return value of GSL function
* @param src Name of the source file where the function was called.
* @param line Line number in the source where the call/error occurs
*/
void GSLUtility::check(int gsl_status, const char *src, int line) const {
if(gsl_status != GSL_SUCCESS) {
string msg = "GSL error occured: " + string(gsl_strerror(gsl_status));
throw IException(IException::Programmer, msg.c_str(), src, line);
}
return;
}
/**
* Perform one iteration.
* @return :: true to continue, false to stop.
*/
bool DerivMinimizer::iterate(size_t) {
if (m_gslSolver == nullptr) {
throw std::runtime_error("Minimizer " + this->name() +
" was not initialized.");
}
int status = gsl_multimin_fdfminimizer_iterate(m_gslSolver);
if (status) {
m_errorString = gsl_strerror(status);
return false;
}
status = gsl_multimin_test_gradient(m_gslSolver->gradient, m_stopGradient);
if (status != GSL_CONTINUE) {
m_errorString = gsl_strerror(status);
return false;
}
return true;
}
void rb_gsl_error_handler(const char *reason, const char *file,
int line, int gsl_errno)
{
const char *emessage = gsl_strerror(gsl_errno);
rb_raise(pgsl_error[gsl_errno],
"Ruby/GSL error code %d, %s (file %s, line %d), %s",
gsl_errno, reason, file, line, emessage);
}
void FC_FUNC_(oct_strerror, OCT_STRERROR)
(const int *err, STR_F_TYPE res STR_ARG1)
{
const char *c;
c = gsl_strerror(*err);
TO_F_STR1(c, res);
}
int binom_solver(const double* fq, double* rs, const double* ival, double epsabs, double epsrel, int max_iter)
{
#ifdef USE_R
gsl_set_error_handler_off ();
#endif
double params[2]; memmove(params, fq, 2 * sizeof(double));
// fq[0] = prior[0]; fq[1] = prior[1];
const gsl_multiroot_fdfsolver_type *T;
gsl_multiroot_fdfsolver *s;
const size_t n = 2;
// Set up F.
gsl_multiroot_function_fdf F = {&binom_transform_gsl,
&binom_transform_df,
&binom_transform_fdf,
n, (void *)params};
// Set up initial vector.
gsl_vector* x = gsl_vector_alloc(2);
memcpy(x->data, ival, 2 * sizeof(double));
T = gsl_multiroot_fdfsolver_gnewton;
s = gsl_multiroot_fdfsolver_alloc (T, n);
gsl_multiroot_fdfsolver_set (s, &F, x);
// Rprintf("x: %g, %g \t f: %g, %g\n", s->x->data[0], s->x->data[1], s->f->data[0], s->f->data[0]);
int i = 0;
int msg = GSL_CONTINUE;
for(i = 0; i < max_iter && msg != GSL_SUCCESS; i++) {
msg = gsl_multiroot_fdfsolver_iterate(s);
if (msg == GSL_EBADFUNC || msg == GSL_ENOPROG) break;
// Rprintf("x: %g, %g \t f: %g, %g \t dx: %g, %g\n", s->x->data[0], s->x->data[1],
// s->f->data[0], s->f->data[0], s->dx->data[0], s->dx->data[1]);
// check |dx| < epsabs + epsrel * |x|
msg = gsl_multiroot_test_delta(s->dx, s->x, epsabs, epsrel);
}
// You can turn off GSL error handling so it doesn't crash things.
if (msg != GSL_SUCCESS) {
Rprintf( "CUBS_udpate.cpp::solver Error %i. Break on %i.\n", msg, i);
Rprintf( "error: %s\n", gsl_strerror (msg));
Rprintf( "Init: r=%g, s=%g, f=%g, q=%g\n", ival[0], ival[1], fq[0], fq[1]);
Rprintf( "Exit: r=%g, s=%g, ", s->x->data[0], s->x->data[1]);
Rprintf( "F0=%g, F1=%g, ", s->f->data[0], s->f->data[1]);
Rprintf( "D0=%g, D1=%g\n", s->dx->data[0], s->dx->data[1]);
}
memmove(rs, s->x->data, 2 * sizeof(double));
// Free mem.
gsl_multiroot_fdfsolver_free (s);
gsl_vector_free (x);
return msg;
}
static void errhandler(const char * reason,
const char * file,
int line,
int gsl_errno) {
ERROR("GSL error: \"%s\" in %s:%i (gsl errno %i = %s)",
reason, file, line,
gsl_errno,
gsl_strerror(gsl_errno));
}
int Integration::integrate(gsl_function F) {
gsl_set_error_handler_off();
// https://www.gnu.org/software/gsl/manual/html_node/QAGI-adaptive-integration-on-infinite-intervals.html#QAGI-adaptive-integration-on-infinite-intervals
int ret = gsl_integration_qagi(&F, epsabs, epsrel, limit, workspace, &result,
&abserr);
if (ret) {
fprintf(stderr, "Integration failed with a error [ %s ]\n", gsl_strerror(ret));
}
gsl_set_error_handler(gsl_error);
return ret;
}
/** Checks if a call to a GSL function produced a given error or not
* and throw an appropriate message
*
* @param status :: The status returned for the GSL function call
* @param errorType :: The type of GSL error to check for
*/
void CubicSpline::checkGSLError(const int status, const int errorType) const {
// check GSL functions didn't return an error
if (status == errorType) {
m_recalculateSpline = true;
std::string message("CubicSpline: ");
message.append(gsl_strerror(errorType));
throw std::runtime_error(message);
}
}
static void snd_gsl_error(const char *reason, const char *file, int line, int gsl_errno)
{
XEN_ERROR(XEN_ERROR_TYPE("gsl-error"),
XEN_LIST_3(C_TO_XEN_STRING("GSL"),
C_TO_XEN_STRING("~A, ~A in ~A line ~A, gsl err: ~A"),
XEN_LIST_5(C_TO_XEN_STRING(gsl_strerror(gsl_errno)),
C_TO_XEN_STRING(reason),
C_TO_XEN_STRING(file),
C_TO_XEN_INT(line),
C_TO_XEN_INT(gsl_errno))));
}
SteamState freesteam_solver2_region4(FREESTEAM_CHAR A, FREESTEAM_CHAR B, double atarget, double btarget, SteamState guess, int *retstatus){
const gsl_multiroot_fdfsolver_type *T;
gsl_multiroot_fdfsolver *s;
int status;
size_t iter = 0;
const size_t n = 2;
Solver2Data D = {A,B,solver2_region4_propfn(A), solver2_region4_propfn(B), atarget,btarget};
gsl_multiroot_function_fdf f = {®ion4_f, ®ion4_df, ®ion4_fdf, n, &D};
gsl_vector *x = gsl_vector_alloc(n);
assert(guess.region==4);
gsl_vector_set(x, 0, guess.R4.T);
gsl_vector_set(x, 1, guess.R4.x);
T = gsl_multiroot_fdfsolver_gnewton;
s = gsl_multiroot_fdfsolver_alloc(T, n);
gsl_multiroot_fdfsolver_set(s, &f, x);
//region4_print_state(iter, s);
do{
iter++;
status = gsl_multiroot_fdfsolver_iterate(s);
//region4_print_state(iter, s);
if(status){
/* check if solver is stuck */
break;
}
status = gsl_multiroot_test_residual(s->f, 1e-7);
} while(status == GSL_CONTINUE && iter < 20);
fprintf(stderr,"status = %s\n", gsl_strerror (status));
SteamState S = freesteam_region4_set_Tx(gsl_vector_get(s->x,0), gsl_vector_get(s->x,1));
gsl_multiroot_fdfsolver_free(s);
gsl_vector_free(x);
*retstatus = status;
if(status)fprintf(stderr,"%s (%s:%d): %s: ",__func__,__FILE__,__LINE__,gsl_strerror(status));
//freesteam_fprint(stderr,S);
return S;
}
int Minimizer<dimension>::minimize(const double start[dimension])
{
assert(function && "Minimizer<dimension>::minimize: function pointer"
" must not be zero!");
gsl_multimin_fminimizer *minimizer;
gsl_multimin_function minex_func;
// Set starting point
for (std::size_t i = 0; i < dimension; i++)
gsl_vector_set(minimum_point, i, start[i]);
// Set initial step sizes
gsl_vector_set_all(step_size, initial_step_size);
// Initialize method and iterate
minex_func.n = dimension;
minex_func.f = function;
minex_func.params = parameters;
minimizer = gsl_multimin_fminimizer_alloc(solver_type, dimension);
gsl_multimin_fminimizer_set(minimizer, &minex_func, minimum_point, step_size);
size_t iter = 0;
int status;
do {
iter++;
status = gsl_multimin_fminimizer_iterate(minimizer);
if (status)
break;
const double size = gsl_multimin_fminimizer_size(minimizer);
status = gsl_multimin_test_size(size, precision);
#ifdef ENABLE_VERBOSE
print_state(minimizer, iter);
#endif
} while (status == GSL_CONTINUE && iter < max_iterations);
#ifdef ENABLE_VERBOSE
printf("\tMinimization status = %s\n", gsl_strerror(status));
#endif
// save minimum point and function value
gsl_vector_memcpy(minimum_point, minimizer->x);
minimum_value = minimizer->fval;
gsl_multimin_fminimizer_free(minimizer);
return status;
}
local void hqmforces(bodyptr btab, int nbody, real M, real a, real b,
real tol)
{
bodyptr bp;
double r, mr3i, params[4], phi0, aR0, az0, abserr[3];
static gsl_integration_workspace *wksp = NULL;
gsl_function FPhi, F_aR, F_az;
static double maxerr = 0.0;
int stat[3];
if (a == b) { // spherical case is easy!
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
r = absv(Pos(bp));
Phi(bp) = - M / (a + r);
mr3i = M * rsqr(r / (a + r)) / rqbe(r);
MULVS(Acc(bp), Pos(bp), - mr3i);
}
} else { // flattened case is harder
if (wksp == NULL) { // on first call, initialze
wksp = gsl_integration_workspace_alloc(1000);
gsl_set_error_handler_off(); // handle errors below
}
FPhi.function = &intPhi;
F_aR.function = &int_aR;
F_az.function = &int_az;
FPhi.params = F_aR.params = F_az.params = params;
a2(params) = rsqr(a);
b2(params) = rsqr(b);
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
R(params) = rsqrt(rsqr(Pos(bp)[0]) + rsqr(Pos(bp)[1]));
z(params) = Pos(bp)[2];
stat[0] = gsl_integration_qagiu(&FPhi, 0.0, tol, 0.0,
1000, wksp, &phi0, &abserr[0]);
stat[1] = gsl_integration_qagiu(&F_aR, 0.0, tol, 0.0,
1000, wksp, &aR0, &abserr[1]);
stat[2] = gsl_integration_qagiu(&F_az, 0.0, tol, 0.0,
1000, wksp, &az0, &abserr[2]);
if (stat[0] || stat[1] || stat[2]) // any errors reported?
for (int i = 0; i < 3; i++)
if (stat[i] != 0 && abserr[i] > maxerr) {
eprintf("[%s.hqmforces: warning: %s abserr[%d] = %g]\n",
getprog(), gsl_strerror(stat[i]), i+1, abserr[i]);
maxerr = abserr[i]; // adjust reporting threshold
}
Phi(bp) = - M * phi0;
Acc(bp)[0] = - M * (Pos(bp)[0] / R(params)) * aR0;
Acc(bp)[1] = - M * (Pos(bp)[1] / R(params)) * aR0;
Acc(bp)[2] = - M * az0;
}
}
}
/// global gsl error handler
static void gslErrorHandler (
const char * reason,
const char * file,
int line,
int gsl_errno)
{
dbg(-1) << "GSL-ERROR:\n";
dbg(-1) << " reason: " << reason << "\n"
<< " loc: " << file << ":" << line << "\n"
<< " errno: " << gsl_errno << "\n"
<< " strerr: " << gsl_strerror( gsl_errno) << "\n";
throw gsl_exception( reason, file, line, gsl_errno);
// throw std::runtime_error( "GSL-error");
}
void portret(double k, const QString& fileName)
{
// TODO: Direktro uporabi GSL, da ne porablja toliko RAMa.
Interval i = qMakePair(0.0, 10.0);
Integrator* integrator = new GslIntegrator;
QImage image(QSize(800,800), QImage::Format_Indexed8);
for (int j = 0; j < 256; ++j)
{
image.setColor(j, qRgb(j, j, j));
}
image.fill(255);
gsl_odeiv2_system sys = {fun_zoga, 0, 2, &k};
gsl_odeiv2_driver* driver = gsl_odeiv2_driver_alloc_y_new(&sys, gsl_odeiv2_step_rk4, 1e-3, 1, 1);
double y[2];
double t;
for (double q = 0; q < 1; q += 0.02)
{
qDebug() << "q = " << q;
for (double p = -5; p < 5; p += 0.05)
{
y[0] = q;
y[1] = p;
t = 0.0;
double y[] = {q, p};
while (t < 100.0)
{
int status = gsl_odeiv2_driver_apply_fixed_step(driver, &t, 1e-3, 1000, y);
if (status != GSL_SUCCESS)
{
qDebug() << t << gsl_strerror(status);
break;
}
double qq = y[0];
double pp = y[1];
omeji(&qq, &pp);
uchar& pix = image.scanLine( qBound<int>(0, (5+pp) * 80.0, 799) )[ qBound<int>(0, qq * 800.0, 799) ];
if (pix > 100)
{
pix -= 100;
}
}
}
}
image.save(fileName);
}
void
fastSI_GSL_MULTIROOT_wrap (struct BD_imp *b,
const double *q0,
double *q)
{
int np3 = 3 * b->BD->sys->np;
// set the initial connector in b->x0[]
fastSI_set_Q0 (b, q0);
/**
* set the initial guess
*/
int i;
for (i = 0; i < np3; i ++)
{
gsl_vector_set (b->guess, i, q0[i]);
}
gsl_multiroot_fsolver_set (b->S, b->F, b->guess);
int status;
int iter = 0;
do
{
iter++;
status = gsl_multiroot_fsolver_iterate (b->S);
if (status) /* check if solver is stuck */
break;
status = gsl_multiroot_test_residual (b->S->f, b->eps);
}
while (status == GSL_CONTINUE && iter < b->itmax);
if (status != GSL_SUCCESS)
{
fprintf (stdout, "status = %s\n", gsl_strerror (status));
}
/**
* retreive the solution
*/
gsl_vector *root = gsl_multiroot_fsolver_root (b->S);
for (i = 0; i < np3; i ++)
{
q[i] = gsl_vector_get (root, i);
}
}
/// Matrix by vector multiplication
/// @param v :: A vector to multiply by. Must have the same size as size2().
/// @returns A vector - the result of the multiplication. Size of the returned
/// vector equals size1().
/// @throws std::invalid_argument if the input vector has a wrong size.
/// @throws std::runtime_error if the underlying GSL routine fails.
GSLVector GSLMatrix::operator*(const GSLVector &v) const {
if (v.size() != size2()) {
throw std::invalid_argument(
"Matrix by vector multiplication: wrong size of vector.");
}
GSLVector res(size1());
auto status =
gsl_blas_dgemv(CblasNoTrans, 1.0, gsl(), v.gsl(), 0.0, res.gsl());
if (status != GSL_SUCCESS) {
std::string message = "Failed to multiply matrix by a vector.\n"
"Error message returned by the GSL:\n" +
std::string(gsl_strerror(status));
throw std::runtime_error(message);
}
return res;
}
void CUBSSolver::solve(const double* fq, double* rs, double epsabs, double epsrel, int max_iter)
{
#ifdef USE_R
gsl_set_error_handler_off ();
#endif
double params[2]; memmove(params, fq, 2 * sizeof(double));
// fq[0] = prior[0]; fq[1] = prior[1];
gsl_multiroot_function F;
// Set up F.
F.f = gsl_transform;
F.n = 2;
F.params = (void *)params;
// Set up initial vector.
gsl_vector* x = gsl_vector_alloc(2);
gsl_vector_set_all(x, 0.01);
gsl_multiroot_fsolver_set(s, &F, x);
// Rprintf("x: %g, %g \t f: %g, %g\n", s->x->data[0], s->x->data[1], s->f->data[0], s->f->data[0]);
int i = 0;
int msg = GSL_CONTINUE;
for(i = 0; i < max_iter && msg != GSL_SUCCESS; i++) {
msg = gsl_multiroot_fsolver_iterate(s);
if (msg == GSL_EBADFUNC || msg == GSL_ENOPROG) break;
// Rprintf("x: %g, %g \t f: %g, %g\n", s->x->data[0], s->x->data[1], s->f->data[0], s->f->data[0]);
// check |dx| < epsabs + epsrel * |x|
msg = gsl_multiroot_test_delta(s->dx, s->x, epsabs, epsrel);
}
// You can turn off GSL error handling so it doesn't crash things.
if (msg != GSL_SUCCESS) {
Rprintf( "CUBSSolver::solve: Error %i. Break on %i.\n", msg, i);
Rprintf( "error: %s\n", gsl_strerror (msg));
Rprintf( "r=%g, s=%g\n", s->x->data[0], s->x->data[1]);
Rprintf( "f=%g, q=%g\n", s->f->data[0], s->f->data[1]);
}
memmove(rs, s->x->data, 2 * sizeof(double));
// Free mem.
gsl_vector_free (x);
}
int main(void) {
const gsl_multiroot_fdfsolver_type *T;
gsl_multiroot_fdfsolver *s;
int status;
size_t i, iter = 0;
const size_t n = 2;
struct rparams p = {1.0, 10.0};
gsl_multiroot_function_fdf f = {&rosenbrock_f,
&rosenbrock_df,
&rosenbrock_fdf,
n, &p};
double x_init[2] = {-10.0, -5.0};
gsl_vector *x = gsl_vector_alloc (n);
gsl_vector_set (x, 0, x_init[0]);
gsl_vector_set (x, 1, x_init[1]);
T = gsl_multiroot_fdfsolver_gnewton;
s = gsl_multiroot_fdfsolver_alloc (T, n);
gsl_multiroot_fdfsolver_set (s, &f, x);
print_state (iter, s);
do {
iter++;
status = gsl_multiroot_fdfsolver_iterate (s);
print_state (iter, s);
if (status)
break;
status = gsl_multiroot_test_residual (s->f, 1e-7);
} while (status == GSL_CONTINUE && iter < 1000);
printf ("status = %s\n", gsl_strerror (status));
gsl_multiroot_fdfsolver_free (s);
gsl_vector_free (x);
return EXIT_SUCCESS;
}
void CalcTEDialog::OnBnClickedButton11()
{
CString T; LogMessage *log=new LogMessage(); FilmParams *outTX=NULL; FilmFuncParams *in_TX=NULL;
double lambda, k, n1, n3; DoubleArray bettaexp_TX;
lambda = 632.8; k = 2.*M_PI/lambda; n1 = 1.; n3 = 1.45705;
for(int i=0;i<modes_num;i++) bettaexp_TX << beta[i];
outTX=new FilmParams();
if(IsTM)
{
in_TX=new FilmFuncTMParams(bettaexp_TX, n1,n3,k);
CalclFilmParamsTM(*((FilmFuncTMParams*)in_TX),*outTX);
T.Format("--FilmParamsTM---"); log->CreateEntry("*",T);
}
else
{
in_TX=new FilmFuncTEParams(bettaexp_TX, n1,n3,k);
CalclFilmParamsTE(*((FilmFuncTEParams*)in_TX),*outTX);
T.Format("--FilmParamsTE---"); log->CreateEntry("*",T);
}
T.Format("status = %s", gsl_strerror (outTX->status));
if(outTX->status==GSL_SUCCESS)
{
nf=outTX->n;
hf=outTX->H;
UpdateData(0);
log->CreateEntry(CString('*'),T);
}
else log->CreateEntry(CString('*'),T,LogMessage::high_pr);
T.Format("n=%.10f H=%.10f nm",outTX->n, outTX->H, outTX->epsabs, outTX->epsrel ); log->CreateEntry("*",T);
T.Format("errabs=%g errrel=%g fval=%.10f, step=%.10f",outTX->epsabs, outTX->epsrel, outTX->fval, outTX->size ); log->CreateEntry("*",T);
T.Format("dt=%.3f ms func_calls=%d",outTX->dt.val(), outTX->func_call_cntr); log->CreateEntry("*",T);
for(int i=0;i<in_TX->betta_teor.GetSize();i++)
{
T.Format("betta_teor[%d]=%.5f betta_exp=%.5f",in_TX->betta_teor[i].n,in_TX->betta_teor[i].val,bettaexp_TX[i]); log->CreateEntry("*",T);
}
log->Dispatch();
if(outTX!=NULL) delete outTX;
if(in_TX!=NULL) delete in_TX;
}
int ggen_rng_load(gsl_rng **r,const char *file)
{
FILE *f;
int e1,e2;
f = fopen(file,"rb");
if(!f) return 1;
e1 = gsl_rng_fread(f,*r);
if(e1) error("GSL error: %s\n",gsl_strerror(e1));
e2 = fclose(f);
if(e2) error("I/O error: %s\n",strerror(e2));
if(e1 || e2)
return 2;
else
return 0;
}
/**
* Generate 4 random-noise draws n_mu = {n_1, n_2, n_3, n_4} with correlations according to
* the matrix M = L L^T, which is passed in as input.
*
* Note: you need to pass a pre-allocated 4-vector n_mu.
* Note2: this function is meant as a lower-level noise-generation utility, called
* from a higher-level function to translate the antenna-pattern functions into pre-factorized Lcor
*/
int
XLALDrawCorrelatedNoise ( PulsarAmplitudeVect n_mu, /**< [out] 4d vector of noise-components {n_mu}, with correlation L * L^T */
const gsl_matrix *L, /**< [in] correlator matrix to get n_mu = L_mu_nu * norm_nu from 4 uncorr. unit variates norm_nu */
gsl_rng * rng /**< gsl random-number generator */
)
{
int gslstat;
/* ----- check input arguments ----- */
if ( !L || (L->size1 != 4) || (L->size2 != 4) ) {
XLALPrintError ( "%s: Invalid correlator matrix, n_mu must be pre-allocate 4x4 matrix", __func__ );
XLAL_ERROR ( XLAL_EINVAL );
}
if ( !rng ) {
XLALPrintError ("%s: invalid NULL input as gsl random-number generator!\n", __func__ );
XLAL_ERROR ( XLAL_EINVAL );
}
/* ----- generate 4 normal-distributed, uncorrelated random numbers ----- */
PulsarAmplitudeVect n;
n[0] = gsl_ran_gaussian ( rng, 1.0 );
n[1] = gsl_ran_gaussian ( rng, 1.0 );
n[2] = gsl_ran_gaussian ( rng, 1.0 );
n[3] = gsl_ran_gaussian ( rng, 1.0 );
/* use four normal-variates {norm_nu} with correlator matrix L to get: n_mu = L_{mu nu} norm_nu
* which gives {n_\mu} satisfying cov(n_mu,n_nu) = (L L^T)_{mu nu} = M_{mu nu}
*/
gsl_vector_view n_view = gsl_vector_view_array ( n, 4 );
gsl_vector_view n_mu_view = gsl_vector_view_array ( n_mu, 4 );
/* int gsl_blas_dgemv (CBLAS_TRANSPOSE_t TransA, double alpha, const gsl_matrix * A, const gsl_vector * x, double beta, gsl_vector * y)
* compute the matrix-vector product and sum y = \alpha op(A) x + \beta y, where op(A) = A, A^T, A^H
* for TransA = CblasNoTrans, CblasTrans, CblasConjTrans.
*/
if ( (gslstat = gsl_blas_dgemv (CblasNoTrans, 1.0, L, &n_view.vector, 0.0, &n_mu_view.vector)) != 0 ) {
XLALPrintError ( "%s: gsl_blas_dgemv(L * norm) failed: %s\n", __func__, gsl_strerror (gslstat) );
XLAL_ERROR ( XLAL_EFAILED );
}
return XLAL_SUCCESS;
} /* XLALDrawCorrelatedNoise() */
/**
* form factor of a mass fractal consisting of spheres with a radius R, a
* fractal dimesnion of D, a cut-off length of xi and a scattering length
* density eta
*/
scalar sasfit_sq_MassFractalGaussianCutOff(scalar q, sasfit_param * param)
{
scalar P16, r0, xi, D;
int status;
gsl_sf_result pFq_1F1;
SASFIT_ASSERT_PTR( param );
sasfit_get_param(param, 3, &r0, &xi, &D);
gsl_set_error_handler_off();
SASFIT_CHECK_COND1((q < 0.0), param, "q(%lg) < 0",q);
SASFIT_CHECK_COND1((r0 <= 0.0), param, "r0(%lg) <= 0",r0);
SASFIT_CHECK_COND2((xi < r0), param, "xi(%lg) < r0(%lg)",xi,r0);
SASFIT_CHECK_COND1((D <= 1.0), param, "D(%lg) <= 1",D);
if ((xi == 0) || (r0 == 0))
{
return 1.0;
}
P16 = gsl_sf_gamma(D/2.)*D/2.;
P16 = P16*pow(xi/r0,D);
status = gsl_sf_hyperg_1F1_e(D/2.,1.5,-0.25*pow(q*xi,2.),&pFq_1F1);
if (status && (q*xi >= 10))
{
pFq_1F1.val = (sqrt(M_PI)*(pow(2.,D)/(pow(q,D)*pow(pow(xi,2),D/2.)*gsl_sf_gamma(1.5 - D/2.)) +
(pow(4,1.5 - D/2.)*pow(q,-3 + D)*pow(-pow(xi,2),-1.5 + D/2.))/
(exp((pow(q,2)*pow(xi,2))/4.)*gsl_sf_gamma(D/2.))))/2. ;
// gsl_sf_gamma(1.5)/gsl_sf_gamma(1.5-D/2.0)*pow(0.25*pow(q*xi,2.),D/2.);
}
else if (status && (q*xi < 10))
{
sasfit_param_set_err(param, DBGINFO("%s,q=%lf"), gsl_strerror(status), q);
return SASFIT_RETURNVAL_ON_ERROR;
} else {
return 1.0+P16*pFq_1F1.val;
}
return P16;
}
/**
* \ingroup LALGSL_h
* \brief LAL GSL error handler.
*
* ### Synopsis ###
*
* \code
* extern LALStatus *lalGSLGlobalStatusPtr;
* #include <lal/LALConfig.h>
* #ifdef LAL_PTHREAD_LOCK
* #include <pthread.h>
* extern pthread_mutex_t lalGSLPthreadMutex;
* #endif
* \endcode
*
* ### Description ###
*
* The function \c LALGSLErrorHandler() is the standard GSL error handler
* for GSL functions called within LAL. Its function is to take the GSL
* error code and information and translate them into equivalent aspects of
* the LAL status structure. The status structure that is currently identified
* by \c lalGSLGlobalStatusPtr is populated. This global variable is to
* be set to the current status pointer prior to invocation of the GSL function.
* In addition, the GSL error handler must be set to the LAL GSL error handler
* prior to the invocation of the GSL function. Both of these tasks can be
* done with the macros provided in the header \ref LALGSL_h.
* However, doing so is not thread-safe. Thus the macros use the mutex
* \c lalGSLPthreadMutex to block other threads from making GSL calls
* <em>from within LAL functions</em> while one thread has set the GSL error
* handler and global status pointer. This mutex must also be used to block
* any non-LAL GSL function calls from other threads or else they may be called
* with the LAL GSL error handler in effect.
*/
void
LALGSLErrorHandler(const char *reason,
const char *file, int line, int my_gsl_error)
{
if (!lalGSLGlobalStatusPtr) {
lalAbortHook
("Abort: function LALGSLErrorHandler, file %s, line %d, %s\n"
" Null global status pointer\n", __FILE__, __LINE__,
"$Id$");
}
lalGSLGlobalStatusPtr->statusPtr = NULL;
INITSTATUS(lalGSLGlobalStatusPtr);
lalGSLGlobalStatusPtr->statusDescription = gsl_strerror(my_gsl_error);
lalGSLGlobalStatusPtr->statusCode = my_gsl_error;
lalGSLGlobalStatusPtr->file = file;
lalGSLGlobalStatusPtr->line = line;
LALError(lalGSLGlobalStatusPtr, reason);
LALTrace(lalGSLGlobalStatusPtr, 1);
return;
}
static int
odesys_odegsl_step (odegsl_t * odegsl, const double t1, const double t2,
double *coef)
{
double t = t1;
while (t < t2)
{
int ode_status =
gsl_odeiv_evolve_apply (odegsl->evolve, odegsl->control, odegsl->step,
&(odegsl->system), &t, t2, &(odegsl->hstep),
coef);
if (ode_status)
{
fprintf (stderr, "%s %d: gsl_odeiv_evolve_apply error: %s\n",
__func__, __LINE__, gsl_strerror (ode_status));
return -1;
}
}
return 0;
}
double getDecay(int nnod, double x1, double x2, double y1, double y2) {
const gsl_multiroot_fsolver_type *T;
gsl_multiroot_fsolver *s;
int status;
size_t i, iter = 0;
const size_t n = 2;
struct pair p = {x1, y1, x2, y2};
gsl_multiroot_function f = {&ExponentialRootF, n, &p};
double x_init[2] = {y2, sqrt(nnod)};
gsl_vector *x = gsl_vector_alloc(n);
double result;
for (i=0; i<n; i++)
gsl_vector_set(x, i, x_init[i]);
T = gsl_multiroot_fsolver_hybrids;
s = gsl_multiroot_fsolver_alloc (T, n);
gsl_multiroot_fsolver_set (s, &f, x);
do {
iter++;
status = gsl_multiroot_fsolver_iterate (s);
if (status) /* check if solver is stuck */
break;
status =gsl_multiroot_test_residual(s->f, 1e-7);
} while (status == GSL_CONTINUE && iter < 1000);
if (strcmp(gsl_strerror(status), "success") != 0)
result = -1;
else
result = gsl_vector_get(s->x, 1);
gsl_multiroot_fsolver_free(s);
gsl_vector_free(x);
return result;
}
void integ_mass(bool update)
{
double *dmdr_tab = (double *) allocate(ntab * sizeof(double));
gsl_spline *spl_dmdr = gsl_spline_alloc(gsl_interp_cspline, ntab);
gsl_interp_accel *acc_dmdr = gsl_interp_accel_alloc();
int i, stat;
double alpha, mass_int, del_mass, mass_end = mass_tab[ntab - 1];
for (i = 0; i < ntab; i++)
dmdr_tab[i] = 4 * M_PI * gsl_pow_2(radius_tab[i]) * density_tab[i];
gsl_spline_init(spl_dmdr, radius_tab, dmdr_tab, ntab);
if (radius_tab[0] > 0.0) {
alpha = rlog10(density_tab[1] / density_tab[0]) /
rlog10(radius_tab[1] / radius_tab[0]);
mass_int = (4 * M_PI / (alpha + 3)) *
gsl_pow_3(radius_tab[0]) * density_tab[0];
} else
mass_int = 0.0;
if (update)
mass_tab[0] = mass_int;
for (i = 1; i < ntab; i++) {
stat = gsl_spline_eval_integ_e(spl_dmdr, radius_tab[i-1], radius_tab[i],
acc_dmdr, &del_mass);
if (stat != 0)
error("%s: spline error: %s\n", getprog(), gsl_strerror(stat));
mass_int = mass_int + del_mass;
if (update)
mass_tab[i] = mass_int;
}
gsl_interp_accel_free(acc_dmdr);
gsl_spline_free(spl_dmdr);
free(dmdr_tab);
eprintf("[%s: mass[] = %e:%e]\n",
getprog(), mass_tab[0], mass_tab[ntab - 1]);
if (mass_int < 0.99 * mass_end || mass_int > 1.01 * mass_end)
eprintf("[%s: WARNING: final mass = %e integ mass = %e]\n",
getprog(), mass_end, mass_int);
}
