#include <../source/TAL/objbase.h>

#define SAFETY (vec_t)0.9
#define PGROW (vec_t)-0.2
#define PSHRNK (vec_t)-0.25
/* (5/SAFETY) ^ (1/PGROW) */
#define ERRCON (vec_t)1.89e-4

typedef struct cash_karp_context_s
{
	libv_object_t base;

	u32_t num_variables;

	/* user-supplied right side */
	void (V_CALL *derivs) (void_p arg,vec_t deriv[], vec_t t, vec_t x[]);
	void_p rh_param; /* user-supplied param for right-side routine */
	/* setting it to true from 'derivs' forces step minification */
	vboolean need_reject_step;
	vboolean need_terminate_integration;
	/* local storage for step (nr_rkck) routine */
	vec_t *ak2, *ak3, *ak4, *ak5, *ak6, *ytemp1;
	/* local storage for stepper (nr_rkqs) routine */
	vec_t *yerr, *last_y;
	vec_t last_x;
	/* local storage for driver (nr_odeint) routine */
	vec_t *yscal, *y, *dydx;
	/*
	 * User - supplied monitor routine. Solver calls it either at approximate
	 * or exact intervals. The former does not affect the performance, while
	 * the necessity to hit the predefined set of x[] values could severely
	 * impact the performance (it interfere with the step-size heuristic).
	 */
	vec_t xsav_last; /* point of the last save */
	vec_t dxsav;
	/* == true if solver must hit next save point exactly */
	vboolean dxsav_exact;
	ode_monitor_t   monitor;
	void *param; /* user-supplied param for monitor routine */

	vboolean verbose;
	vboolean in_progress;

	/* timeout for nr_rkqs() */
	u32_t   timeout;
	
	/* 31.08.2004 */
	vec_t hmax;
}   cash_karp_context_t, *cash_karp_context_p;

#ifdef  CHECKED_BUILD
#define CKCTX_MAGIC 0x434B4354 /* CKCT */
V_LOCAL char_p ckctx_name = "RK5-CK ODE integration object";
#endif  /* CHECKED_BUILD */

/*
 * Destructor
 */
V_LOCAL u32_t V_CALL
destroy_ck_context(vhandle_t handle)
{
	cash_karp_context_p self = (cash_karp_context_p)handle;
	UNREF_EXIT(self);
	memFreeObject(self);
	return 0;
}

/*
 * Constructor
 */ 
V_LOCAL cash_karp_context_p create_ck_context(u32_t num_variables,
	void (V_CALL *derivs) (void_p,vec_t[],vec_t, vec_t[]),vboolean verbose)
{
	cash_karp_context_p ctx;
	ALLOC_OBJECT(ctx,cash_karp_context_t,
		num_variables * 11 * sizeof(vec_t),CKCTX_MAGIC);

	ctx->base.destroy=destroy_ck_context;

	ctx->num_variables = num_variables;
	ctx->derivs = derivs;

	ctx->ak2 = (vec_p)(ctx+1) - 1; /* NR uses unit - based arrays */
	ctx->ak3 = ctx->ak2 + num_variables;
	ctx->ak4 = ctx->ak3 + num_variables;
	ctx->ak5 = ctx->ak4 + num_variables;
	ctx->ak6 = ctx->ak5 + num_variables;
	ctx->ytemp1 = ctx->ak6 + num_variables;

	ctx->yerr = ctx->ytemp1 + num_variables;
	ctx->last_y = ctx->yerr + num_variables;

	ctx->yscal = ctx->last_y + num_variables;
	ctx->y = ctx->yscal + num_variables;
	ctx->dydx = ctx->y + num_variables;

	ctx->in_progress = false;
	ctx->dxsav = 0;
	ctx->monitor = NULL;

	ctx->verbose = verbose;
	ctx->timeout = 5000;
	
	/* 31.08.2004 */
	ctx->hmax = MAXFLOAT;
	return ctx;
}

/*
 * Given values for n variables y[1..n] and their derivatives
 * dydx[1..n] known at x, use the fifth-order Cash-Karp Runge-Kutta
 * method to advance the solution over an interval h and return the
 * incremented variables as yout[1..n]. Also return an estimate of
 * the local truncation error in yout using the embedded fourth-order
 * method. The user supplies the routine derivs(dydx,x,y), which
 * returns derivatives dydx at x.
 */

V_LOCAL vboolean
nr_rkck(cash_karp_context_p context,
	vec_t y[],
	vec_t dydx[],
	vec_t x,
	vec_t h,
	vec_t yout[],
	vec_t yerr[])
{
	const vec_t a2 = (vec_t)0.2, a3 = (vec_t)0.3, a4 = (vec_t)0.6,
		a5 = (vec_t)1.0, a6 = (vec_t)0.875;
	const vec_t b21 = (vec_t)0.2, b31 = (vec_t)(3.0 / 40.0),
		b32 = (vec_t)(9.0 / 40.0), b41 = (vec_t)0.3, b42 = (vec_t)-0.9,
		b43 = (vec_t)1.2, b51 = (vec_t)(-11.0 / 54.0), b52 = (vec_t)2.5,
		b53 = (vec_t)(-70.0 / 27.0), b54 = (vec_t)(35.0 / 27.0),
		b61 = (vec_t)(1631.0 / 55296.0), b62 = (vec_t)(175.0 / 512.0),
		b63 = (vec_t)(575.0 / 13824.0), b64 = (vec_t)(44275.0 / 110592.0),
		b65 = (vec_t)(253.0 / 4096.0);
	const vec_t c1 = (vec_t)(37.0 / 378.0), c3 = (vec_t)(250.0 / 621.0),
		c4 = (vec_t)(125.0 / 594.0), c6 = (vec_t)(512.0 / 1771.0),
		dc5 = (vec_t)(-277.00 / 14336.0);
	const vec_t dc1 = (vec_t)(37.0 / 378.0) - (vec_t)(2825.0 / 27648.0);
	const vec_t dc3 = (vec_t)(250.0 / 621.0) - (vec_t)(18575.0 / 48384.0);
	const vec_t dc4 = (vec_t)(125.0 / 594.0) - (vec_t)(13525.0 / 55296.0);
	const vec_t dc6 = (vec_t)(512.0 / 1771.0) - (vec_t)0.25;

	vec_t *ak2, *ak3, *ak4, *ak5, *ak6, *ytemp;

	void (V_CALL *derivs)(void_p,vec_t[],vec_t,vec_t[]) = context->derivs;
	void_p darg = context->rh_param;

	u32_t i, n = context->num_variables;

	if(context->need_reject_step || context->need_terminate_integration)
		return false;

	ak2 = context->ak2;
	ak3 = context->ak3;
	ak4 = context->ak4;
	ak5 = context->ak5;
	ak6 = context->ak6;
	ytemp = context->ytemp1;

	for (i = 1; i <= n; i++)	/* First step. */
		ytemp[i] = y[i] + b21 * h * dydx[i];
	(*derivs)(darg, ak2+1, x + a2 * h, ytemp+1); /* Second step. */
	if(context->need_reject_step || context->need_terminate_integration)
		return false;
	for (i = 1; i <= n; i++)
		ytemp[i] = y[i] + h * (b31 * dydx[i] + b32 * ak2[i]);
	(*derivs)(darg,ak3+1, x + a3 * h, ytemp+1); /* Third step. */
	if(context->need_reject_step || context->need_terminate_integration)
		return false;
	for (i = 1; i <= n; i++)
		ytemp[i] = y[i] + h * (b41 * dydx[i] + b42 * ak2[i] + b43 * ak3[i]);
	(*derivs)(darg,ak4+1, x + a4 * h, ytemp+1); /* Fourth step. */
	if(context->need_reject_step || context->need_terminate_integration)
		return false;
	for (i = 1; i <= n; i++)
		ytemp[i] = y[i] + h * (b51 * dydx[i] + b52 * ak2[i] + b53 * ak3[i] +
			b54 * ak4[i]);
	(*derivs)(darg,ak5+1, x + a5 * h, ytemp+1); /* Fifth step. */
	if(context->need_reject_step || context->need_terminate_integration)
		return false;
	for (i = 1; i <= n; i++)
		ytemp[i] = y[i] + h * (b61 * dydx[i] + b62 * ak2[i] + b63 * ak3[i] +
			b64 * ak4[i] + b65 * ak5[i]);
	(*derivs)(darg,ak6+1, x + a6 * h, ytemp+1); /* Sixth step. */
	if(context->need_reject_step || context->need_terminate_integration)
		return false;
	for (i = 1; i <= n; i++) /* Accumulate increments with proper weights. */
		yout[i] = y[i] + h * (c1 * dydx[i] + c3 * ak3[i] + c4 * ak4[i] +
			c6 * ak6[i]);
	/* Estimate error as difference between fourth and fifth order methods */
	for (i = 1; i <= n; i++)
		yerr[i] = h * (dc1 * dydx[i] + dc3 * ak3[i] + dc4 * ak4[i] +
			dc5 * ak5[i] + dc6 * ak6[i]);
	return true;
}

/*
 * Fifth-order Runge-Kutta step with monitoring of local truncation error
 * to ensure accuracy and adjust stepsize. Input are the dependent
 * variable vector y[1..n] and its derivative dydx[1..n] at the
 * starting value of the independent variable x. Also input are
 * the stepsize to be attempted htry, the required accuracy eps,
 * and the vector yscal[1..n] against which the error is scaled.
 * On output, y and x are replaced by their new values, hdid is
 * the stepsize that was actually accomplished, and hnext is the
 * estimated next stepsize.
 * derivs is the user-supplied routine that computes the right-hand
 * side derivatives.
 */

#define FMAX(op1,op2)   (op1 > op2 ? op1 : op2)
#define FMIN(op1,op2)   (op1 > op2 ? op2 : op1)
#define RKQS_NTRY	   128

/*
#define DEBUG_RKQS
*/

V_LOCAL vboolean
nr_rkqs(cash_karp_context_p context,
	vec_t y[],
	vec_t dydx[],
	vec_t *x,
	vec_t htry,
	vec_t eps,
	vec_t yscal[],
	vec_t *hdid,
	vec_t *hnext,
	vec_t hmin)
{
	CALLER_NAME(nr_rkqs)
	vec_t h01, h05;
	u32_t count, ntry, i, n = context->num_variables;
	vec_t yerr_by_yscal, errmax, h, htemp, /*xnew, WTF */ *yerr, *ytemp;
	u32_t curtime, starttime = timeTickCount();
	yerr = context->yerr;
	ytemp = context->last_y;
	h = htry; /* Set stepsize to the initial trial value. */
	/*
	if(h > context->hmax)
		h = context->hmax;
	*/
	for (count=ntry=0;;ntry++,count++)
	{
#ifdef  DEBUG_RKQS
		conlPrintf(LOG_TRACE,"\n%s(): TIME %g\n",caller_name,*x);
#endif
		if(nr_rkck(context, y, dydx, *x, h, ytemp, yerr)) /* Take a step */
		{
			errmax = (vec_t)0.0; /* Evaluate accuracy */
#ifdef  DEBUG_RKQS
			conlPrintf(LOG_TRACE,"%s(): TRIAL %u\n",caller_name,count);
#endif
			for (i = 1; i <= n; i++)
			{
#ifdef  DEBUG_RKQS_ALL
				conlPrintf(LOG_TRACE,
					"yerr[%u]=%g,yscal[%u]=%g\n",i,yerr[i],i,yscal[i]);
#endif
				yerr_by_yscal = (vec_t)v_abs(yerr[i] / yscal[i]);
				errmax = FMAX(errmax, yerr_by_yscal);
			}
			if (errmax < eps)
				break; /* Step succeeded. Go out of the loop and compute new stepsize */
			/* Truncation error too large, reduce stepsize. */
			htemp = SAFETY * h * (vec_t)pow(errmax, PSHRNK);
			h01 = (vec_t)0.1 * h;
			h05 = (vec_t)0.5 * h;
			h = (h >= 0.0 ? FMAX(htemp, h01) : FMIN(htemp, h01));
			h = FMIN(h, h05);
/*#ifdef  DEBUG_RKQS*/
			conlPrintf(LOG_TRACE,
				"%s(): stepsize reduced to %g (hmin %g) due to high error %g (tolerance %g)\n",caller_name,h,hmin,errmax,eps);
/*#endif*/
		}
		else
		{
			if(context->need_terminate_integration)
				return false;
			h *= (vec_t)0.5;
			context->need_reject_step = false;
#ifdef  DEBUG_RKQS
			conlPrintf(LOG_TRACE,"%s(): step rejection in derivs(), halving step to %g.\n",caller_name,h);
#endif
		}
		if(h < hmin)
		{
			conlPrintf(LOG_ERROR,"%s(): stepsize underflow after %d trials (h %3.4g, hmin %3.4g).\n",
				caller_name,count + 1, h, hmin);
			return false;
		}
		/* xnew = (*x) + h; WTF */
		/* monitor elapsed time after each RKQS_NTRY iterations */
		if(ntry == RKQS_NTRY)
		{
			ntry = 0;
			curtime = timeTickCount() - starttime;
			if(curtime >= context->timeout)
			{
				conlPrintf(LOG_ERROR,
				"nr_rkqs(): timeout (%u) reached after %d trials (step %g).\n", context->timeout, count, h);
				return false;
			}
		}
	}
	h01 = h * (vec_t)1.1; /* No more than a factor of 1.1 increase. */
	if (errmax > ERRCON)
	{
		htemp = SAFETY * h * (vec_t)pow(errmax, PGROW);
		h01 = FMIN(h01, htemp);
	}
	*hnext = FMIN(h01, context->hmax);
#ifdef  DEBUG_RKQS
	conlPrintf(LOG_TRACE,"%s(): stepsize %g succeeded, new stepsize will be %g.\n",caller_name,h,*hnext);
#endif
	*x += h;
	*hdid = h;
	memCopy(&y[1],&ytemp[1],n * sizeof(vec_t));
	context->last_x = *x;
	return true;
}

/*
 * Runge-Kutta driver with adaptive stepsize control. Integrate starting
 * values ystart[1..nvar] from x1 to x2 with accuracy eps, storing
 * intermediate results in global variables. h1 should be set as a
 * guessed first stepsize, hmin as the minimum allowed stepsize
 * (can be zero). On output nok and nbad are the number of good and
 * bad (but retried and fixed) steps taken, and ystart is replaced
 * by values at the end of the integration interval. derivs is the
 * user-supplied routine for calculating the right-hand side derivative,
 * while rkqs is the name of the stepper routine to be used.
 */

#define TINY (vec_t)1.0e-10
#define MON_NTRY	128

V_LOCAL vboolean
nr_odeint_nomon(cash_karp_context_p context,
	vec_t ystart[],
	vec_t x1,
	vec_t x2,
	vec_t eps,
	vec_t h1,
	vec_t hmin)
{
	u32_t starttime, curtime, ntry, count;
	u32_t nstp, stp_count, i, nvar = context->num_variables;
	vec_t x, hnext, hdid, h;
	vec_t *yscal, *y, *dydx;
	void (V_CALL *derivs)(void_p,vec_t[], vec_t, vec_t[]) = context->derivs;

	yscal = context->yscal;
	y = context->y;
	dydx = context->dydx;

	x = x1;
	h = x2 > x1 ? h1 : -h1;

	memCopy(&y[1],&ystart[1],nvar * sizeof(vec_t));
	starttime = timeTickCount();

	for(stp_count=nstp=0;;nstp++,stp_count++)
	{
		context->need_reject_step = false;
		for(ntry = count = 0;;ntry++,count++)
		{
			(*derivs)(context->rh_param,dydx+1, x, y+1);
			if(false == context->need_reject_step) /* accept step */
				break;
			if(context->need_terminate_integration)
				return false;
			/* if need_reject_step == true, the dydx[] are invalid */
			if(ntry == MON_NTRY)
			{
				ntry = 0;
				curtime = timeTickCount() - starttime;
				if(curtime >= context->timeout)
				{
					conlPrintf(LOG_ERROR,
						"nr_odeint_nomon(): timeout reached after %d trials.\n",
						count);
					return false;
				}
			}
			h *= (vec_t)0.5; /* FIXME: see above ? */
		}
		/* Scaling used to monitor accuracy. 
		 * This general-purpose choice can be modified if need be. */
		for (i = 1; i <= nvar; i++)
			yscal[i] = v_abs(y[i]) + v_abs(dydx[i] * h) + TINY;
		if ((x + h - x2) * (x + h - x1) > 0.0)
			h = x2 - x;		 /* If stepsize can overshoot, decrease. */
		if(!(*nr_rkqs)(context,y, dydx, &x, h, eps, yscal, &hdid, &hnext, hmin))
			return false;
		if((x - x2) * (x2 - x1) >= 0.0) /* Are we done? */
		{
			memCopy(&ystart[1],&y[1],nvar * sizeof(vec_t));
			break;
		}
		h = hnext;
		if(stp_count == MON_NTRY)
		{
			stp_count = 0;
			curtime = timeTickCount() - starttime;
			if(curtime >= context->timeout)
			{
				conlPrintf(LOG_ERROR,"nr_odeint_nomon(): "
					"timeout reached after %d trials, x=%g.\n",nstp,x);
				return false;
			}
		}
	}
	return true;
}

V_LOCAL void
ode_print_status(cash_karp_context_p context,u32_t starttime,
	char *caller)
{
	u32_t time_usage;
	char *status;
	static char *all_status[] = {
		"stable",
		"slow/unstable (stiff equations ?)",
		"very slow, will be broken soon !"
	};
	starttime = timeTickCount() - starttime;
	time_usage = 100 * starttime / context->timeout;
	status = (time_usage < 10) ? all_status[0] :
		((time_usage < 50) ? all_status[1] : all_status[2]);
	conlPrintf(LOG_INFO,"%s: used %u%% of timeout; integration %s.\n",
		caller,time_usage,status);
}

V_LOCAL vboolean
nr_odeint_and_monitor_noexact(cash_karp_context_p context,
	vec_t ystart[],
	vec_t x1,
	vec_t x2,
	vec_t eps,
	vec_t h1,
	vec_t hmin)
{
	u32_t starttime, curtime, ntry, count;
	u32_t nstp, stp_count, i, nvar = context->num_variables;
	vec_t x, hnext, hdid, h;
	vec_t *yscal, *y, *dydx;

	void (V_CALL *derivs) (void_p,vec_t[], vec_t, vec_t[]) = context->derivs;

	yscal = context->yscal;
	y = context->y;
	dydx = context->dydx;

	x = x1;
	h = x2 > x1 ? h1 : -h1;

	V_ASSERT(!IsZero(context->dxsav));
	V_ASSERT(context->monitor);

	memCopy(&y[1],&ystart[1],nvar * sizeof(vec_t));
	starttime = timeTickCount();

	context->xsav_last = x - context->dxsav * (vec_t)2.0; /* Assures storage of first step. */
	for(stp_count=nstp=0;;nstp++,stp_count++)
	{
		context->need_reject_step = false;
		for(ntry = count = 0;;ntry++,count++)
		{
			(*derivs)(context->rh_param,dydx+1, x, y+1);
			if(!context->need_reject_step)
				break;
			if(context->need_terminate_integration)
				return false;
			/* if need_reject_step == true, the dydx[] are invalid */
			if(ntry == MON_NTRY)
			{
				ntry = 0;
				curtime = timeTickCount() - starttime;
				if(curtime >= context->timeout)
				{
					conlPrintf(LOG_ERROR,
						"nr_odeint_and_monitor_noexect(): "
						"timeout reached after %d trials.\n",count);
					return false;
				}
			}
			h *= (vec_t)0.5;
		}
		/* Scaling used to monitor accuracy. 
		 * This general-purpose choice can be modified if need be. */
		for (i = 1; i <= nvar; i++)
			yscal[i] = v_abs(y[i]) + v_abs(dydx[i] * h) + TINY;
		if (v_abs(x - context->xsav_last) >= v_abs(context->dxsav))
		{
			if(!(*context->monitor)(context->param,x,y+1))
			{
				if(context->verbose)
					conlPrintf(LOG_INFO,"nr_odeint_and_monitor_noexact():"
						" solution terminated at x=%g by the monitor "
						"routine.\n",x);
				return false;
			}
			if(context->verbose)
				ode_print_status(context,starttime,
					"nr_odeint_and_monitor_noexact");
			starttime = timeTickCount();
			context->xsav_last = x;
		}
		/* If stepsize can overshoot the endpoint, decrease. */
		if ((x + h - x2) * (x + h - x1) > 0.0)
			h = x2 - x; 
		if(!(*nr_rkqs)(context,y, dydx, &x, h, eps, yscal, &hdid, &hnext, hmin))
			return false;
		if ((x - x2) * (x2 - x1) >= 0.0)
		{	  /* Are we done? */
			memCopy(&ystart[1],&y[1],nvar * sizeof(vec_t));
			/* Call monitor after the final step. */
			context->monitor(context->param,x,y+1);
			break;
		}
		if (v_abs(hnext) <= hmin)
		{
			conlPuts(LOG_ERROR,"nr_odeint(): Step size too small.\n");
			return false;
		}
		h = hnext;
		if(stp_count == MON_NTRY)
		{
			stp_count = 0;
			curtime = timeTickCount() - starttime;
			if(curtime >= context->timeout)
			{
				conlPrintf(LOG_ERROR,"nr_odeint_and_monitor_noexact(): "
					"timeout reached after %d trials, x=%g.\n",nstp,x);
				return false;
			}
		}
	}
	return true;
}

/*
 * Same as above, but calls monitor exectly at points x + k * dxsav.
 */

V_LOCAL vboolean
nr_odeint_and_monitor_exact(cash_karp_context_p context,
	vec_t ystart[],
	vec_t x1,
	vec_t x2,
	vec_t eps,
	vec_t h1,
	vec_t hmin)
{
	u32_t starttime, curtime, ntry, count;
	u32_t stp_count, nstp, i, nvar = context->num_variables;
	vec_t x, hnext, hdid, h, xsav_next;
	vec_t *yscal, *y, *dydx;

	void (V_CALL *derivs) (void_p,vec_t[], vec_t, vec_t[]) = context->derivs;

	yscal = context->yscal;
	y = context->y;
	dydx = context->dydx;

	x = x1;
	h = x2 > x1 ? h1 : -h1;

	V_ASSERT(!IsZero(context->dxsav));
	V_ASSERT(context->monitor);

	memCopy(&y[1],&ystart[1],nvar * sizeof(vec_t));
	starttime = timeTickCount();

	xsav_next = x;

	for(stp_count=nstp=0;;nstp++,stp_count++)
	{
		context->need_reject_step = false;
		for(ntry = count = 0;;ntry++,count++)
		{
			(*derivs)(context->rh_param,dydx+1, x, y+1);
			if(!context->need_reject_step)
				break;
			if(context->need_terminate_integration)
				return false;
			/* if need_reject_step == true, the dydx[] are invalid */
			if(ntry == MON_NTRY)
			{
				ntry = 0;
				curtime = timeTickCount() - starttime;
				if(curtime >= context->timeout)
				{
					conlPrintf(LOG_ERROR,
						"nr_odeint_and_monitor_exact(): "
						"timeout reached after %d trials.\n",
						count);
					return false;
				}
			}
			h *= (vec_t)0.5;
		}
		/* Scaling used to monitor accuracy. 
		 * This general-purpose choice can be modified if need be. */
		for (i = 1; i <= nvar; i++)
			yscal[i] = v_abs(y[i]) + v_abs(dydx[i] * h) + TINY;

		if (IsZero(xsav_next - x)) {
			if(!(*context->monitor)(context->param,x,y+1))
			{
				if(context->verbose)
					conlPrintf(LOG_INFO,"nr_odeint_and_monitor_exact(): "
						"solution terminated at x=%g by the monitor "
						"routine.\n",x);
				return false;
			}
			if(context->verbose)
				ode_print_status(context,starttime,
					"nr_odeint_and_monitor_exact");
			starttime = timeTickCount();
			xsav_next = x + context->dxsav;
		}

		/* If stepsize can overshoot the endpoint, decrease. */
		if ((x + h - x2) * (x + h - x1) > 0.0)
			h = x2 - x;

		/* If stepsize can overshoot the next save point, decrease. */
		if ((x + h - xsav_next) * (x + h - x1) > 0.0)
			h = xsav_next - x;

		if(!(*nr_rkqs)(context,y, dydx, &x, h, eps, yscal, &hdid, &hnext, hmin))
			return false;

		if ((x - x2) * (x2 - x1) >= 0.0) {	  /* Are we done? */
			memCopy(&ystart[1],&y[1],nvar * sizeof(vec_t));
			/* Call monitor after the final step. */
			if(xsav_next <= (x + 0.01 * context->dxsav))
				context->monitor(context->param,x,y+1);
			break;
		}
		h = hnext;
		if(stp_count == MON_NTRY)
		{
			stp_count = 0;
			curtime = timeTickCount() - starttime;
			if(curtime >= context->timeout)
			{
				conlPrintf(LOG_ERROR,"nr_odeint_and_monitor_exact(): "
					"timeout reached after %d trials, x=%g.\n",nstp,x);
				return false;
			}
		}
	}
	return true;
}

/*
 * Member functions
 */

vhandle_t V_GLOBAL
odeCreateSolver(u32_t num_variables,
	void (V_CALL *derivs)(void_p,vec_t dest_dxdy[],vec_t x,vec_t y[]),vboolean verbose)
{
	cash_karp_context_p ctx = create_ck_context(num_variables,derivs,verbose);
	return (vhandle_t)ctx;
}

void	V_GLOBAL
odeDestroySolver(vhandle_t handle)
{
	libvCloseHandle(handle,"odeDestroySolver",ckctx_name,CKCTX_MAGIC);
}

vboolean V_GLOBAL
odeIntegrate(vhandle_t handle,
	vec_t ystart[],
	vec_t x1,
	vec_t x2,
	vec_t eps,
	vec_t h1,
	vec_t hmin,
	void_p rh_arg)
{
	vboolean result = false;
	cash_karp_context_p ctx = (cash_karp_context_p)libvIsHandle(handle,
		"odeIntegrate",ckctx_name,CKCTX_MAGIC);
	if(ctx)
	{
		ctx->need_terminate_integration = false;
		ctx->in_progress = true;
		ctx->rh_param = rh_arg;
		if(ctx->monitor)
		{
			if(ctx->dxsav_exact)
				result = nr_odeint_and_monitor_exact(ctx,ystart-1,x1,x2,eps,h1,hmin);
			else
				result = nr_odeint_and_monitor_noexact(ctx,ystart-1,x1,x2,eps,h1,hmin);
		}
		else
			result = nr_odeint_nomon(ctx,ystart-1,x1,x2,eps,h1,hmin);
		ctx->in_progress = false;
	} 
	if(ctx->need_terminate_integration)
	{
		if(ctx->verbose)
			conlPrintf(LOG_INFO,"odeSolve(): solution terminated "
				"at x=%g by the right-side routine.\n",ctx->last_x);
	}
	return result;
}

void V_GLOBAL
odeSetMonitor(vhandle_t handle,ode_monitor_t monitor,void *param,vec_t delta_x,vboolean exact)
{
	cash_karp_context_p ctx = (cash_karp_context_p)libvIsHandle(handle,
		"odeSetMonitor",ckctx_name,CKCTX_MAGIC);
	if(ctx)
	{
		if(ctx->in_progress)
		{
#ifdef  CHECKED_BUILD
			conlPuts(LOG_ERROR,"odeSetMonitor(): solution in "
				"progress, couldn't set monitoring parameters.\n");
#endif  /* CHECKED_BUILD */
			return;
		}
		ctx->monitor = monitor;
		ctx->param = param;
		ctx->dxsav = delta_x;
		ctx->dxsav_exact = exact;
	}
}

void V_GLOBAL
odeRejectStep(vhandle_t handle)
{
	cash_karp_context_p ctx = (cash_karp_context_p)libvIsHandle(handle,
		"odeRejectStep",ckctx_name,CKCTX_MAGIC);
	if(ctx)
		ctx->need_reject_step = true;
}

void V_GLOBAL
odeTerminateIntegration(vhandle_t handle)
{
	cash_karp_context_p ctx = (cash_karp_context_p)libvIsHandle(handle,
		"odeTerminateIntegration",ckctx_name,CKCTX_MAGIC);
	if(ctx)
		ctx->need_terminate_integration = true;
}

vboolean V_GLOBAL
odeSetReal(vhandle_t handle,u32_t pname,vec_t param)
{
	u32_t t_ms;
	cash_karp_context_p ctx = (cash_karp_context_p)libvIsHandle(handle,
		"odeSetReal",ckctx_name,CKCTX_MAGIC);
	if(!ctx)
		return false;
	switch(pname)
	{
		case ODE_TIMEOUT:
			t_ms = (u32_t)(1000 * param);
			if(!t_ms)
			{
#ifdef  CHECKED_BUILD
				conlPuts(LOG_ERROR,"odeSetReal(): timeout must be > 0.\n");
#endif  /* CHECKED_BUILD */
				return false;
			}
			ctx->timeout = t_ms;
			break;
		case ODE_MAXIMAL_STEP:
			if(param <= 0)
			{
#ifdef  CHECKED_BUILD
				conlPuts(LOG_ERROR,"odeSetReal(): hmax must be > 0.\n");
#endif  /* CHECKED_BUILD */
				return false;
			}
			ctx->hmax = param;
			break;
		default:
			return false;
	}
	return true;
}
