Loading [MathJax]/extensions/TeX/AMSsymbols.js
LAL 7.7.0.1-5e288d3
All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
LALAdaptiveRungeKuttaIntegrator.c
Go to the documentation of this file.
1/*
2* Copyright (C) 2010 Michele Vallisneri, Will Farr, Evan Ochsner, 2014 A. Klein
3*
4* This program is free software; you can redistribute it and/or modify
5* it under the terms of the GNU General Public License as published by
6* the Free Software Foundation; either version 2 of the License, or
7* (at your option) any later version.
8*
9* This program is distributed in the hope that it will be useful,
10* but WITHOUT ANY WARRANTY; without even the implied warranty of
11* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12* GNU General Public License for more details.
13*
14* You should have received a copy of the GNU General Public License
15* along with with program; see the file COPYING. If not, write to the
16* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
17* MA 02110-1301 USA
18*/
19
20#include <lal/LALAdaptiveRungeKuttaIntegrator.h>
21
22#define XLAL_BEGINGSL \
23 { \
24 gsl_error_handler_t *saveGSLErrorHandler_; \
25 saveGSLErrorHandler_ = gsl_set_error_handler_off();
26
27#define XLAL_ENDGSL \
28 gsl_set_error_handler( saveGSLErrorHandler_ ); \
29 }
30
31LALAdaptiveRungeKuttaIntegrator *XLALAdaptiveRungeKutta4Init(int dim, int (*dydt) (double t, const double y[], double dydt[], void *params), /* These are XLAL functions! */
32 int (*stop) (double t, const double y[], double dydt[], void *params), double eps_abs, double eps_rel)
33{
35
36 /* allocate our custom integrator structure */
39 }
40
41 /* allocate the GSL ODE components */
42 XLAL_CALLGSL(integrator->step = gsl_odeiv_step_alloc(gsl_odeiv_step_rkf45, dim));
43 //XLAL_CALLGSL(integrator->step = gsl_odeiv_step_alloc(gsl_odeiv_step_rk8pd, dim));
44 XLAL_CALLGSL(integrator->control = gsl_odeiv_control_y_new(eps_abs, eps_rel));
45 XLAL_CALLGSL(integrator->evolve = gsl_odeiv_evolve_alloc(dim));
46
47 /* allocate the GSL system (functions, etc.) */
48 integrator->sys = (gsl_odeiv_system *) LALCalloc(1, sizeof(gsl_odeiv_system));
49
50 /* if something failed to be allocated, bail out */
51 if (!(integrator->step) || !(integrator->control) || !(integrator->evolve) || !(integrator->sys)) {
54 }
55
56 integrator->dydt = dydt;
57 integrator->stop = stop;
58
59 integrator->sys->function = dydt;
60 integrator->sys->jacobian = NULL;
61 integrator->sys->dimension = dim;
62 integrator->sys->params = NULL;
63
64 integrator->retries = 6;
65 integrator->stopontestonly = 0;
66
67 return integrator;
68}
69
70LALAdaptiveRungeKuttaIntegrator *XLALAdaptiveRungeKutta4InitEighthOrderInstead(int dim, int (*dydt) (double t, const double y[], double dydt[], void *params), /* These are XLAL functions! */
71 int (*stop) (double t, const double y[], double dydt[], void *params), double eps_abs, double eps_rel)
72{
74
75 /* allocate our custom integrator structure */
78 }
79
80 /* allocate the GSL ODE components */
81 XLAL_CALLGSL(integrator->step = gsl_odeiv_step_alloc(gsl_odeiv_step_rk8pd, dim));
82 XLAL_CALLGSL(integrator->control = gsl_odeiv_control_y_new(eps_abs, eps_rel));
83 XLAL_CALLGSL(integrator->evolve = gsl_odeiv_evolve_alloc(dim));
84
85 /* allocate the GSL system (functions, etc.) */
86 integrator->sys = (gsl_odeiv_system *) LALCalloc(1, sizeof(gsl_odeiv_system));
87
88 /* if something failed to be allocated, bail out */
89 if (!(integrator->step) || !(integrator->control) || !(integrator->evolve) || !(integrator->sys)) {
92 }
93
94 integrator->dydt = dydt;
95 integrator->stop = stop;
96
97 integrator->sys->function = dydt;
98 integrator->sys->jacobian = NULL;
99 integrator->sys->dimension = dim;
100 integrator->sys->params = NULL;
101
102 integrator->retries = 6;
103 integrator->stopontestonly = 0;
104
105 return integrator;
106}
107
109{
110 if (!integrator)
111 return;
112
113 if (integrator->evolve)
114 XLAL_CALLGSL(gsl_odeiv_evolve_free(integrator->evolve));
115 if (integrator->control)
116 XLAL_CALLGSL(gsl_odeiv_control_free(integrator->control));
117 if (integrator->step)
118 XLAL_CALLGSL(gsl_odeiv_step_free(integrator->step));
119
120 LALFree(integrator->sys);
121 LALFree(integrator);
122
123 return;
124}
125
126/* Local function to store interpolated step in output array */
127static int storeStateInOutput(REAL8Array ** output, REAL8 t, REAL8 * y, size_t dim, int *outputlen, int count)
128{
129 REAL8Array *out = *output;
130 int len = *outputlen;
131 size_t i;
132
133 if (count > len) {
134 /* Resize array! Have to make a new array, and copy over. */
135 REAL8Array *new = XLALCreateREAL8ArrayL(2, dim + 1, 2 * len);
136
137 if (!new) {
138 return XLAL_ENOMEM;
139 }
140
141 for (i = 0; i < dim + 1; i++) {
142 memcpy(&(new->data[2 * i * len]), &(out->data[i * len]), len * sizeof(REAL8));
143 }
144
146 out = new;
147 len *= 2;
148 }
149
150 /* Store the current step. */
151 out->data[count - 1] = t;
152 for (i = 1; i < dim + 1; i++) {
153 out->data[i * len + count - 1] = y[i - 1];
154 }
155
156 *output = out;
157 *outputlen = len;
158 return GSL_SUCCESS;
159}
160
161/* Local function to shrink output array to proper size before it's returned */
162static int shrinkOutput(REAL8Array ** output, int *outputlen, int count, size_t dim)
163{
164 REAL8Array *out = *output;
165 int len = *outputlen;
166
167 REAL8Array *new = XLALCreateREAL8ArrayL(2, dim + 1, count);
168
169 if (!new) {
170 return XLAL_ENOMEM;
171 }
172
173 size_t i;
174 for (i = 0; i < dim + 1; i++) {
175 memcpy(&(new->data[i * count]), &(out->data[i * len]), count * sizeof(REAL8));
176 }
177
178 *output = new;
179 *outputlen = count;
180
182
183 return GSL_SUCCESS;
184}
185
186/* Copied from GSL rkf45.c */
187typedef struct {
188 double *k1;
189 double *k2;
190 double *k3;
191 double *k4;
192 double *k5;
193 double *k6;
194 double *y0;
195 double *ytmp;
197
198/**
199 * Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45)
200 * steps with adaptive step size control. Intended for use in various
201 * waveform generation routines such as SpinTaylorT4 and various EOB models.
202 *
203 * The method is described in
204 *
205 * Abramowitz & Stegun, Handbook of Mathematical Functions, Tenth Printing,
206 * National Bureau of Standards, Washington, DC, 1972
207 * (available online at http://people.math.sfu.ca/~cbm/aands/ )
208 *
209 * This function also includes "on-the-fly" interpolation of the
210 * differential equations at regular intervals in-between integration
211 * steps. This "on-the-fly" interpolation method is derived and
212 * described in the Mathematica notebook "RKF_with_interpolation.nb";
213 * see
214 * https://www.lsc-group.phys.uwm.edu/ligovirgo/cbcnote/InspiralPipelineDevelopment/120312111836InspiralPipelineDevelopmentImproved%20Adaptive%20Runge-Kutta%20integrator
215 *
216 * This method is functionally equivalent to XLALAdaptiveRungeKutta4,
217 * but is nearly always faster due to the improved interpolation.
218 */
219int XLALAdaptiveRungeKutta4Hermite(LALAdaptiveRungeKuttaIntegrator * integrator, /**< struct holding dydt, stopping test, stepper, etc. */
220 void *params, /**< params struct used to compute dydt and stopping test */
221 REAL8 * yinit, /**< pass in initial values of all variables - overwritten to final values */
222 REAL8 tinit, /**< integration start time */
223 REAL8 tend_in, /**< maximum integration time */
224 REAL8 deltat, /**< step size for evenly sampled output */
225 REAL8Array ** yout /**< array holding the evenly sampled output */
226 )
227{
228 int errnum = 0;
229 int status;
230 size_t dim, retries, i;
231 int outputlen = 0, count = 0;
232
233 REAL8Array *output = NULL;
234
235 REAL8 t, tintp, h;
236
237 REAL8 *ytemp = NULL;
238
239 REAL8 tend = tend_in;
240
242
243 /* If want to stop only on test, then tend = +/-infinity; otherwise
244 * tend_in */
245 if (integrator->stopontestonly) {
246 if (tend < tinit)
247 tend = -1.0 / 0.0;
248 else
249 tend = 1.0 / 0.0;
250 }
251
252 dim = integrator->sys->dimension;
253
254 outputlen = ((int)(tend_in - tinit) / deltat);
255 //if (outputlen < 0) outputlen = -outputlen;
256 if (outputlen < 0) {
258 ("XLAL Error - %s: (tend_in - tinit) and deltat must have the same sign\ntend_in: %f, tinit: %f, deltat: %f\n",
259 __func__, tend_in, tinit, deltat);
260 errnum = XLAL_EINVAL;
261 goto bail_out;
262 }
263 outputlen += 2;
264
265 output = XLALCreateREAL8ArrayL(2, (dim + 1), outputlen);
266
267 if (!output) {
268 errnum = XLAL_ENOMEM;
269 goto bail_out;
270 }
271
272 ytemp = XLALCalloc(dim, sizeof(REAL8));
273
274 if (!ytemp) {
275 errnum = XLAL_ENOMEM;
276 goto bail_out;
277 }
278
279 /* Setup. */
280 integrator->sys->params = params;
281 integrator->returncode = 0;
282 retries = integrator->retries;
283 t = tinit;
284 tintp = tinit;
285 h = deltat;
286
287 /* Copy over first step. */
288 output->data[0] = tinit;
289 for (i = 1; i <= dim; i++)
290 output->data[i * outputlen] = yinit[i - 1];
291 count = 1;
292
293 /* We are starting a fresh integration; clear GSL step and evolve
294 * objects. */
295 gsl_odeiv_step_reset(integrator->step);
296 gsl_odeiv_evolve_reset(integrator->evolve);
297
298 /* Enter evolution loop. NOTE: we *always* take at least one
299 * step. */
300 while (1) {
301 REAL8 told = t;
302
303 status =
304 gsl_odeiv_evolve_apply(integrator->evolve, integrator->control, integrator->step, integrator->sys, &t, tend, &h,
305 yinit);
306
307 /* Check for failure, retry if haven't retried too many times
308 * already. */
309 if (status != GSL_SUCCESS) {
310 if (retries--) {
311 /* Retries to spare; reduce h, try again. */
312 h /= 10.0;
313 continue;
314 } else {
315 /* Out of retries, bail with status code. */
316 integrator->returncode = status;
317 break;
318 }
319 } else {
320 /* Successful step, reset retry counter. */
321 retries = integrator->retries;
322 }
323
324 /* Now interpolate until we would go past the current integrator time, t.
325 * Note we square to get an absolute value, because we may be
326 * integrating t in the positive or negative direction */
327 while ((tintp + deltat) * (tintp + deltat) < t * t) {
328 tintp += deltat;
329
330 /* tintp = told + (t-told)*theta, 0 <= theta <= 1. We have to
331 * compute h = (t-told) because the integrator returns a
332 * suggested next h, not the actual stepsize taken. */
333 REAL8 hUsed = t - told;
334 REAL8 theta = (tintp - told) / hUsed;
335
336 /* These are the interpolating coefficients for y(t + h*theta) =
337 * ynew + i1*h*k1 + i5*h*k5 + i6*h*k6 + O(h^4). */
338 REAL8 i0 = 1.0 + theta * theta * (3.0 - 4.0 * theta);
339 REAL8 i1 = -theta * (theta - 1.0);
340 REAL8 i6 = -4.0 * theta * theta * (theta - 1.0);
341 REAL8 iend = theta * theta * (4.0 * theta - 3.0);
342
343 /* Grab the k's from the integrator state. */
344 rkf45_state_t *rkfState = integrator->step->state;
345 REAL8 *k1 = rkfState->k1;
346 REAL8 *k6 = rkfState->k6;
347 REAL8 *y0 = rkfState->y0;
348
349 for (i = 0; i < dim; i++) {
350 ytemp[i] = i0 * y0[i] + iend * yinit[i] + hUsed * i1 * k1[i] + hUsed * i6 * k6[i];
351 }
352
353 /* Store the interpolated value in the output array. */
354 count++;
355 if ((status = storeStateInOutput(&output, tintp, ytemp, dim, &outputlen, count)) == XLAL_ENOMEM) {
356 errnum = XLAL_ENOMEM;
357 goto bail_out;
358 }
359 }
360
361 /* Now that we have recorded the last interpolated step that we
362 * could, check for termination criteria. */
363 if (!integrator->stopontestonly && t >= tend)
364 break;
365
366 /* If there is a stopping function in integrator, call it with the
367 * last value of y and dydt from the integrator. */
368 if (integrator->stop) {
369 if ((status = integrator->stop(t, yinit, integrator->evolve->dydt_out, params)) != GSL_SUCCESS) {
370 integrator->returncode = status;
371 break;
372 }
373 }
374 }
375
376 /* Now that the interpolation is done, shrink the output array down
377 * to exactly count samples. */
378 shrinkOutput(&output, &outputlen, count, dim);
379
380 /* Store the final *interpolated* sample in yinit. */
381 for (i = 0; i < dim; i++) {
382 yinit[i] = output->data[(i + 2) * outputlen - 1];
383 }
384
385 bail_out:
386
388
389 /* If we have an error, then we should free allocated memory, and
390 * then return. */
391 XLALFree(ytemp);
392
393 if (errnum) {
394 if (output)
396 *yout = NULL;
397 XLAL_ERROR(errnum);
398 }
399
400 *yout = output;
401 return outputlen;
402}
403
404/**
405 * Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45)
406 * steps with adaptive step size control. Version that only outputs the final
407 * state of the integration, intended for use for spin evolution in
408 * lalsimulation/lib/LALSimInspiralSpinTaylor.c, based on
409 * XLALAdaptiveRungeKutta4Hermite. Specifically, this assumes that the criterion
410 * used to set the end of the evolution (and included in the integrator's stopping
411 * condition) is given by deltat*y[1] < deltat*y1_final, where y is the vector of
412 * variables.
413 *
414 * The method is described in
415 *
416 * Abramowitz & Stegun, Handbook of Mathematical Functions, Tenth Printing,
417 * National Bureau of Standards, Washington, DC, 1972
418 * (available online at http://people.math.sfu.ca/~cbm/aands/ )
419 *
420 * This function also includes "on-the-fly" interpolation of the
421 * differential equations at regular intervals in-between integration
422 * steps. This "on-the-fly" interpolation method is derived and
423 * described in the Mathematica notebook "RKF_with_interpolation.nb";
424 * see
425 * https://www.lsc-group.phys.uwm.edu/ligovirgo/cbcnote/InspiralPipelineDevelopment/120312111836InspiralPipelineDevelopmentImproved%20Adaptive%20Runge-Kutta%20integrator
426 */
427int XLALAdaptiveRungeKutta4HermiteOnlyFinal(LALAdaptiveRungeKuttaIntegrator * integrator, /**< struct holding dydt, stopping test, stepper, etc. */
428 void *params, /**< params struct used to compute dydt and stopping test */
429 REAL8 * yinit, /**< pass in initial values of all variables - overwritten to final values */
430 REAL8 tinit, /**< integration start time */
431 REAL8 tend_in, /**< maximum integration time */
432 REAL8 y1_final, /**< final value of y[1] */
433 REAL8 deltat /**< step size for integration */
434 )
435{
436 int errnum = 0;
437 int status;
438 size_t dim, retries, i;
439
440 REAL8 t, tintp, h;
441
442 REAL8 *ytemp = NULL;
443
444 REAL8 tend = tend_in;
445
447
448 /* If want to stop only on test, then tend = +/-infinity; otherwise
449 * tend_in */
450 if (integrator->stopontestonly) {
451 if (tend < tinit)
452 tend = -1.0 / 0.0;
453 else
454 tend = 1.0 / 0.0;
455 }
456
457 dim = integrator->sys->dimension;
458
459 if ((tend < tinit && deltat > 0) || (tend > tinit && deltat < 0)) {
461 ("XLAL Error - %s: (tend_in - tinit) and deltat must have the same sign\ntend_in: %f, tinit: %f, deltat: %f\n",
462 __func__, tend_in, tinit, deltat);
463 errnum = XLAL_EINVAL;
464 goto bail_out;
465 }
466
467 ytemp = XLALCalloc(dim, sizeof(REAL8));
468
469 if (!ytemp) {
470 errnum = XLAL_ENOMEM;
471 goto bail_out;
472 }
473
474 /* Initialize ytemp[1] with the initial value of yinit[1] so that the initial check below is satisfied even if we are integrating backwards */
475 ytemp[1] = yinit[1];
476
477 /* Setup. */
478 integrator->sys->params = params;
479 integrator->returncode = 0;
480 retries = integrator->retries;
481 t = tinit;
482 tintp = tinit;
483 h = deltat;
484
485 /* We are starting a fresh integration; clear GSL step and evolve
486 * objects. */
487 gsl_odeiv_step_reset(integrator->step);
488 gsl_odeiv_evolve_reset(integrator->evolve);
489
490 /* Enter evolution loop. NOTE: we *always* take at least one
491 * step. */
492 while (1) {
493 REAL8 told = t;
494
495 status =
496 gsl_odeiv_evolve_apply(integrator->evolve, integrator->control, integrator->step, integrator->sys, &t, tend, &h,
497 yinit);
498
499 /* Check for failure, retry if haven't retried too many times
500 * already. */
501 if (status != GSL_SUCCESS) {
502 if (retries--) {
503 /* Retries to spare; reduce h, try again. */
504 h /= 10.0;
505 continue;
506 } else {
507 /* Out of retries, bail with status code. */
508 integrator->returncode = status;
509 break;
510 }
511 } else {
512 /* Successful step, reset retry counter. */
513 retries = integrator->retries;
514 }
515
516 /* If we're at the final timestep, interpolate to get the output at the desired final value, y1_final.
517 * Note we square to get an absolute value, because we may be
518 * integrating t in the positive or negative direction
519 * We multiply yinit, ytemp[1], and y1_final by deltat so that this check works when integrating forward or backward */
520 if (deltat*yinit[1] >= deltat*y1_final) {
521 tintp = told;
522
523 REAL8 hUsed = t - told;
524
525 while (deltat*ytemp[1] < deltat*y1_final) {
526 tintp += deltat;
527
528 /* tintp = told + (t-told)*theta, 0 <= theta <= 1. We have to
529 * compute h = (t-told) because the integrator returns a
530 * suggested next h, not the actual stepsize taken. */
531 REAL8 theta = (tintp - told) / hUsed;
532
533 /* These are the interpolating coefficients for y(t + h*theta) =
534 * ynew + i1*h*k1 + i5*h*k5 + i6*h*k6 + O(h^4). */
535 REAL8 i0 = 1.0 + theta * theta * (3.0 - 4.0 * theta);
536 REAL8 i1 = -theta * (theta - 1.0);
537 REAL8 i6 = -4.0 * theta * theta * (theta - 1.0);
538 REAL8 iend = theta * theta * (4.0 * theta - 3.0);
539
540 /* Grab the k's from the integrator state. */
541 rkf45_state_t *rkfState = integrator->step->state;
542 REAL8 *k1 = rkfState->k1;
543 REAL8 *k6 = rkfState->k6;
544 REAL8 *y0 = rkfState->y0;
545
546 for (i = 0; i < dim; i++) {
547 ytemp[i] = i0 * y0[i] + iend * yinit[i] + hUsed * i1 * k1[i] + hUsed * i6 * k6[i];
548 }
549 }
550 }
551
552 /* Now check for termination criteria. */
553 if (!integrator->stopontestonly && t >= tend)
554 break;
555
556 /* If there is a stopping function in integrator, call it with the
557 * last value of y and dydt from the integrator. */
558 if (integrator->stop) {
559 if ((status = integrator->stop(t, yinit, integrator->evolve->dydt_out, params)) != GSL_SUCCESS) {
560 integrator->returncode = status;
561 break;
562 }
563 }
564 }
565
566 /* Store the final *interpolated* sample before the stopping criterion in yinit. */
567 for (i = 0; i < dim; i++) {
568 yinit[i] = ytemp[i];
569 }
570
571
572 bail_out:
573
575
576 /* If we have an error, then we should free allocated memory, and
577 * then return. */
578 XLALFree(ytemp);
579
580 if (errnum) {
581 XLAL_ERROR(errnum);
582 }
583
584 return 1;
585}
586
588 void * params, REAL8 * yinit, REAL8 tinit, REAL8 tend, REAL8 deltat_or_h0, REAL8 min_deltat_or_h0,
589 REAL8Array ** t_and_y_out, INT4 EOBversion)
590{
591
592 int errnum = 0;
593 int status; /* used throughout */
594
595 /* needed for the integration */
596 size_t dim, outputlength=0, bufferlength, retries;
597 REAL8 t, tnew, h0, h0old;
598 REAL8Array *buffers = NULL;
599 REAL8 *temp = NULL, *y, *y0, *dydt_in, *dydt_in0, *dydt_out, *yerr; /* aliases */
600
601 /* note: for speed, this replaces the single CALLGSL wrapper applied before each GSL call */
603
604 /* allocate the buffers!
605 * note: REAL8Array has a field dimLength (UINT4Vector) with dimensions, and a field data that points to a single memory block;
606 * dimLength itself has fields length and data */
607 dim = integrator->sys->dimension;
608 bufferlength = (int)((tend - tinit) / deltat_or_h0) + 2; /* allow for the initial value and possibly a final semi-step */
609
610 UINT4 dimn;/* Variable for different loop indices below */
611 if(EOBversion==2) dimn = dim + 1;
612 else dimn = dim + 4;//v3opt: Include three derivatives
613
614 buffers = XLALCreateREAL8ArrayL(2, dimn/*dim + 1*/, bufferlength); /* 2-dimensional array, ((dim+1)) x bufferlength */
615
616 temp = LALCalloc(6 * dim, sizeof(REAL8));
617
618 if (!buffers || !temp) {
619 errnum = XLAL_ENOMEM;
620 goto bail_out;
621 }
622
623 y = temp;
624 y0 = temp + dim;
625 dydt_in = temp + 2 * dim;
626 dydt_in0 = temp + 3 * dim;
627 dydt_out = temp + 4 * dim;
628 yerr = temp + 5 * dim; /* aliases */
629
630 /* set up to get started */
631 integrator->sys->params = params;
632
633 integrator->returncode = 0;
634
635 retries = integrator->retries;
636
637 t = tinit;
638 h0 = deltat_or_h0;
639 h0old = h0; /* initialized so that it will not trigger the check h0<h0old at the first step */
640 memcpy(y, yinit, dim * sizeof(REAL8));
641
642 /* store the first data point */
643 buffers->data[0] = t;
644 for (unsigned int i = 1; i <= dim; i++)
645 buffers->data[i * bufferlength] = y[i - 1];
646
647 /* compute derivatives at the initial time (dydt_in), bail out if impossible */
648 if ((status = integrator->dydt(t, y, dydt_in, params)) != GSL_SUCCESS) {
649 integrator->returncode = status;
650 errnum = XLAL_EFAILED;
651 goto bail_out;
652 }
653
654 if(EOBversion==3){
655 for (unsigned int i = 1; i <= 3; i++) //OPTV3: include the initial derivatives
656 buffers->data[(dim+i)*bufferlength] = dydt_in[i-1];
657 }
658
659 UINT4 loop;/*variable for different loop indices below. */
660 if(EOBversion==2) loop = dim;
661 else loop = dim + 3;
662
663 while (1) {
664
665 if (!integrator->stopontestonly && t >= tend) {
666 break;
667 }
668
669 if (integrator->stop) {
670 if ((status = integrator->stop(t, y, dydt_in, params)) != GSL_SUCCESS) {
671 integrator->returncode = status;
672 break;
673 }
674 }
675
676 /* ready to try stepping! */
677 try_step:
678
679 /* if we would be stepping beyond the final time, stop there instead... */
680 if (!integrator->stopontestonly && t + h0 > tend)
681 h0 = tend - t;
682
683 memcpy(y0, y, dim * sizeof(REAL8)); /* save y to y0, dydt_in to dydt_in0 */
684 memcpy(dydt_in0, dydt_in, dim * sizeof(REAL8));
685
686 /* call the GSL stepper function */
687 status = gsl_odeiv_step_apply(integrator->step, t, h0, y, yerr, dydt_in, dydt_out, integrator->sys);
688 /* note: If the user-supplied functions defined in the system dydt return a status other than GSL_SUCCESS,
689 * the step will be aborted. In this case, the elements of y will be restored to their pre-step values,
690 * and the error code from the user-supplied function will be returned. */
691
692 /* did the stepper report a derivative-evaluation error? */
693 if (status != GSL_SUCCESS) {
694 if (retries--) {
695 h0 = h0 / 10.0; /* if we have singularity retries left, reduce the timestep and try again */
696 goto try_step;
697 } else {
698 integrator->returncode = status;
699 break; /* otherwise exit the loop */
700 }
701 } else {
702 retries = integrator->retries; /* we stepped successfully, reset the singularity retries */
703 }
704
705 tnew = t + h0;
706
707 /* call the GSL error-checking function */
708 status = gsl_odeiv_control_hadjust(integrator->control, integrator->step, y, yerr, dydt_out, &h0);
709
710 /* Enforce a minimal allowed time step */
711 /* To ignore this type of constraint, set min_deltat_or_h0 = 0 */
712 if (h0 < min_deltat_or_h0) h0 = min_deltat_or_h0;
713
714 /* did the error-checker reduce the stepsize?
715 * note: previously, was using status == GSL_ODEIV_HADJ_DEC
716 * other possible return codes are GSL_ODEIV_HADJ_INC if it was increased,
717 * GSL_ODEIV_HADJ_NIL if it was unchanged
718 * since we introduced a minimal step size we simply compare to the saved value of h0 */
719 /* if (status == GSL_ODEIV_HADJ_DEC) { */
720 if (h0 < h0old) {
721 h0old = h0;
722 memcpy(y, y0, dim * sizeof(REAL8)); /* if so, undo the step, and try again */
723 memcpy(dydt_in, dydt_in0, dim * sizeof(REAL8));
724 goto try_step;
725 }
726
727 /* update the current time and input derivatives, save the time step */
728 t = tnew;
729 h0old = h0;
730 memcpy(dydt_in, dydt_out, dim * sizeof(REAL8));
731 outputlength++;
732
733 /* check if interpolation buffers need to be extended */
734 if (outputlength >= bufferlength) {
735 REAL8Array *rebuffers;
736
737 /* sadly, we cannot use ResizeREAL8Array, because it would only work if we extended the first array dimension,
738 * so we need to copy everything over and switch the buffers. Oh well. */
739 if (!(rebuffers = XLALCreateREAL8ArrayL(2, dimn, 2 * bufferlength))) {
740 errnum = XLAL_ENOMEM; /* ouch, that hurt */
741 goto bail_out;
742 } else {
743 for (unsigned int i = 0; i <= loop /* dim */; i++)
744 memcpy(&rebuffers->data[i * 2 * bufferlength], &buffers->data[i * bufferlength], outputlength * sizeof(REAL8));
745 XLALDestroyREAL8Array(buffers);
746 buffers = rebuffers;
747 bufferlength *= 2;
748 }
749 }
750
751 /* copy time and state into output buffers */
752 buffers->data[outputlength] = t;
753 for (unsigned int i = 1; i <= loop; i++)
754 buffers->data[i * bufferlength + outputlength] = y[i - 1]; /* y does not have time */
755 if(EOBversion==3){
756 for (unsigned int i = 1; i <= 3; i++)
757 buffers->data[(dim+i) * bufferlength + outputlength] = dydt_out[i - 1]; //OPTV3: Include 3 derivatives
758 }
759 }
760
761 /* copy the final state into yinit */
762
763 memcpy(yinit, y, dim * sizeof(REAL8));
764
765 /* if we have completed at least one step, allocate the GSL interpolation object and the output array */
766 if (outputlength == 0)
767 goto bail_out;
768
769 if(EOBversion==3){
770 outputlength++;
771 (*t_and_y_out) = XLALCreateREAL8ArrayL(2,(dim + 4),outputlength);//OPTV3: Include derivatives
772 }else{
773 (*t_and_y_out) = XLALCreateREAL8ArrayL(2,(dim + 3),outputlength); //OPTV3: Include derivatives
774 }
775
776 if (!(*t_and_y_out)) {
777 errnum = XLAL_ENOMEM; /* ouch again, ran out of memory */
778 if (*t_and_y_out)
779 XLALDestroyREAL8Array(*t_and_y_out);
780 outputlength = 0;
781 goto bail_out;
782 }
783
784 for(UINT8 j=0;j<outputlength;j++) {
785 (*t_and_y_out)->data[j] = buffers->data[j];
786 for(UINT8 i=1;i<=loop;i++) {
787 (*t_and_y_out)->data[i*outputlength + j] = buffers->data[i*bufferlength + j];
788 }
789 }
790 /* deallocate stuff and return */
791 bail_out:
792
794
795 if (buffers)
796 XLALDestroyREAL8Array(buffers); /* let's be careful, although all these checks may not be needed */
797 if (temp)
798 LALFree(temp);
799
800 if (errnum)
801 XLAL_ERROR(errnum);
802
803 return outputlength;
804}
805
807 void * params, REAL8 * yinit, REAL8 tinit, REAL8 tend, REAL8 deltat,
808 REAL8Array ** sparse_output, REAL8Array ** dense_output)
809{
810 /* Error-checking variables used throughout */
811 int errnum = 0;
812 int status;
813
814 /* Integration and interpolation variables */
815 size_t dim = integrator->sys->dimension;
816 UINT4 sparse_outputlength = 0;
817 UINT4 dense_outputlength = 1;
818 size_t sparse_bufferlength, dense_bufferlength, retries;
819 REAL8 t = tinit;
820 REAL8 tnew;
821 REAL8 h0 = deltat;
822 REAL8Array *sparse_buffers = NULL;
823 REAL8Array *dense_buffers = NULL;
824 REAL8 *temp = NULL, *y, *y0, *dydt_in, *dydt_in0, *dydt_out, *yerr;
825 REAL8 interp_t = tinit + h0;
826
827 /* For speed, this replaces the single CALLGSL wrapper applied before each GSL call */
829
830 /* Allocate buffers!
831 * Note: REAL8Array has a field dimLength (UINT4Vector) with dimensions, and a field data that points to a single memory block;
832 * dimLength itself has fields length and data */
833 sparse_bufferlength = (int)((tend - tinit) / h0) + 2; /* allow for the initial value and possibly a final semi-step */
834 dense_bufferlength = (int)((tend - tinit) / h0) + 2;
835
836 const UINT4 dimn = dim + 1;/* Time is not included in input dimesions, but is included in ouput arrays. */
837
838 sparse_buffers = XLALCreateREAL8ArrayL(2, dimn, sparse_bufferlength);
839 dense_buffers = XLALCreateREAL8ArrayL(2, dimn, dense_bufferlength);
840 temp = LALCalloc(6 * dim, sizeof(REAL8));
841
842 if (!sparse_buffers || !dense_buffers || !temp) {
843 errnum = XLAL_ENOMEM;
844 goto bail_out;
845 }
846
847 /* Aliases */
848 y = temp;
849 y0 = temp + dim;
850 dydt_in = temp + 2 * dim;
851 dydt_in0 = temp + 3 * dim;
852 dydt_out = temp + 4 * dim;
853 yerr = temp + 5 * dim;
854
855 /* Integrator set up */
856 integrator->sys->params = params;
857 integrator->returncode = 0;
858 retries = integrator->retries;
859
860 memcpy(y, yinit, dim * sizeof(REAL8));
861
862 /* Store the first data point. */
863 sparse_buffers->data[0] = t;
864 dense_buffers->data[0] = t;
865 for (UINT4 i = 1; i <= dim; i++){
866 UINT4 iminus1 = i - 1;
867 sparse_buffers->data[i * sparse_bufferlength] = y[iminus1];
868 dense_buffers->data[i * dense_bufferlength] = y[iminus1];
869 }
870
871 /* Compute derivatives at the initial time (dydt_in); bail out if impossible. */
872 if ((status = integrator->dydt(t, y, dydt_in, params)) != GSL_SUCCESS) {
873 integrator->returncode = status;
874 errnum = XLAL_EFAILED;
875 goto bail_out;
876 }
877
878 while (1) {
879
880 if (!integrator->stopontestonly && t >= tend) {
881 break;
882 }
883
884 if (integrator->stop) {
885 if ((status = integrator->stop(t, y, dydt_in, params)) != GSL_SUCCESS) {
886 integrator->returncode = status;
887 break;
888 }
889 }
890
891 /* Try stepping! */
892 try_step:
893
894 /* If we would be stepping beyond the final time, stop there instead. */
895 if (!integrator->stopontestonly && t + h0 > tend)
896 h0 = tend - t;
897
898 /* Save y to y0 and dydt_in to dydt_in0. */
899 memcpy(y0, y, dim * sizeof(REAL8));
900 memcpy(dydt_in0, dydt_in, dim * sizeof(REAL8));
901
902 /* Call the GSL stepper function. */
903 status = gsl_odeiv_step_apply(integrator->step, t, h0, y, yerr, dydt_in, dydt_out, integrator->sys);
904 /* Note: If the user-supplied functions defined in the system dydt return a status other than GSL_SUCCESS,
905 * the step will be aborted. In this case, the elements of y will be restored to their pre-step values,
906 * and the error code from the user-supplied function will be returned. */
907
908 /* Did the stepper report a derivative-evaluation error? */
909 if (status != GSL_SUCCESS) {
910 if (retries--) {
911 /* If we have singularity retries left, reduce the timestep and try again... */
912 h0 = h0 / 10.0;
913 goto try_step;
914 } else {
915 integrator->returncode = status;
916 /* ...otherwise exit the loop. */
917 break;
918 }
919 } else {
920 /* We stepped successfully; reset the singularity retries. */
921 retries = integrator->retries;
922 }
923
924 tnew = t + h0;
925
926 /* Call the GSL error-checking function. */
927 status = gsl_odeiv_control_hadjust(integrator->control, integrator->step, y, yerr, dydt_out, &h0);
928
929 /* Did the error-checker reduce the stepsize?
930 * Note: other possible return codes are GSL_ODEIV_HADJ_INC if it was increased;
931 * GSL_ODEIV_HADJ_NIL if it was unchanged. */
932 if (status == GSL_ODEIV_HADJ_DEC) {
933 /* If so, undo the step, and try again */
934 memcpy(y, y0, dim * sizeof(REAL8));
935 memcpy(dydt_in, dydt_in0, dim * sizeof(REAL8));
936 goto try_step;
937 }
938
939 if (2*dense_outputlength >= dense_bufferlength) {
940 REAL8Array *rebuffers;
941
942 /* Sadly, we cannot use ResizeREAL8Array because it would only work if we extended the first array dimension;
943 * thus we copy everything and switch the buffers. */
944 if (!(rebuffers = XLALCreateREAL8ArrayL(2, dimn, 2 * dense_bufferlength))) {
945 errnum = XLAL_ENOMEM;
946 goto bail_out;
947 } else {
948 for (UINT4 k = 0; k <= dim; k++)
949 memcpy(&rebuffers->data[k * 2 * dense_bufferlength], &dense_buffers->data[k * dense_bufferlength], dense_outputlength * sizeof(REAL8));
950 XLALDestroyREAL8Array(dense_buffers);
951 dense_buffers = rebuffers;
952 dense_bufferlength *= 2;
953 }
954 }
955
956 {
957 const REAL8 interp_t_old = interp_t;
958 const UINT4 dense_outputlength_old = dense_outputlength;
959 while (interp_t < tnew) {
960 dense_buffers->data[dense_outputlength] = interp_t;
961 dense_outputlength++;
962 interp_t = tinit + dense_outputlength*deltat;
963 }
964 interp_t = interp_t_old;
965 dense_outputlength = dense_outputlength_old;
966 }
967
968 {
969 const REAL8 h = tnew - t;
970 const REAL8 h_inv = 1.0/h;
971
972 for (UINT4 i = 0; i < dim; i++) {
973 REAL8 interp_t_old = interp_t;
974 UINT4 dense_outputlength_old = dense_outputlength;
975 REAL8 y0i = y0[i];
976 REAL8 yi = y[i];
977
978 while (interp_t < tnew) {
979 const REAL8 theta = (interp_t - t)*h_inv;
980 dense_buffers->data[(i+1)*dense_bufferlength + dense_outputlength] =
981 (1.0 - theta)*y0i + theta*yi + theta*(theta-1.0)*( (1.0 - 2.0*theta)*(yi - y0i) + h*( (theta-1.0)*dydt_in[i] + theta*dydt_out[i]));
982 dense_outputlength++;
983 interp_t = tinit + dense_outputlength*deltat;
984 }
985
986 if(i<(dim-1)){
987 interp_t = interp_t_old;
988 dense_outputlength = dense_outputlength_old;
989 }
990 }
991 }
992
993 /* Update the current time and input derivatives. */
994 t = tnew;
995 memcpy(dydt_in, dydt_out, dim * sizeof(REAL8));
996 sparse_outputlength++;
997
998 /* Check if interpolation buffers need to be extended. */
999 if (sparse_outputlength >= sparse_bufferlength) {
1000 REAL8Array *rebuffers;
1001
1002 /* Sadly, we cannot use ResizeREAL8Array because it would only work if we extended the first array dimension;
1003 * thus we copy everything and switch the buffers. */
1004 if (!(rebuffers = XLALCreateREAL8ArrayL(2, dimn, 2 * sparse_bufferlength))) {
1005 errnum = XLAL_ENOMEM;
1006 goto bail_out;
1007 } else {
1008 for (UINT4 i = 0; i <= dim; i++)
1009 memcpy(&rebuffers->data[i * 2 * sparse_bufferlength], &sparse_buffers->data[i * sparse_bufferlength], sparse_outputlength * sizeof(REAL8));
1010 XLALDestroyREAL8Array(sparse_buffers);
1011 sparse_buffers = rebuffers;
1012 sparse_bufferlength *= 2;
1013 }
1014 }
1015
1016 /* Copy time and state into buffers. */
1017 sparse_buffers->data[sparse_outputlength] = t;
1018 for (UINT4 i = 1; i <= dim; i++)
1019 sparse_buffers->data[i * sparse_bufferlength + sparse_outputlength] = y[i - 1];
1020 }
1021
1022 if (sparse_outputlength == 0 || dense_outputlength == 1)
1023 goto bail_out;
1024
1025 sparse_outputlength++;
1026
1027 (*sparse_output) = XLALCreateREAL8ArrayL(2, dim+1, sparse_outputlength);
1028 (*dense_output) = XLALCreateREAL8ArrayL(2, dim+1, dense_outputlength);
1029
1030 if (!(*sparse_output) || !(*dense_output)) {
1031 errnum = XLAL_ENOMEM; /* ouch again, ran out of memory */
1032 if (*sparse_output){
1033 XLALDestroyREAL8Array(*sparse_output);
1034 sparse_outputlength = 0;
1035 }
1036 if (*dense_output){
1037 XLALDestroyREAL8Array(*dense_output);
1038 dense_outputlength = 0;
1039 }
1040 goto bail_out;
1041 }
1042
1043 for(UINT4 j = 0; j < sparse_outputlength; j++) {
1044 (*sparse_output)->data[j] = sparse_buffers->data[j];
1045 for(UINT4 i = 1; i <= dim; i++) {
1046 (*sparse_output)->data[i * sparse_outputlength + j] = sparse_buffers->data[i * sparse_bufferlength + j];
1047 }
1048 }
1049
1050 for(UINT4 j = 0; j < dense_outputlength; j++) {
1051 (*dense_output)->data[j] = dense_buffers->data[j];
1052 for(UINT4 i = 1; i <= dim; i++) {
1053 (*dense_output)->data[i * dense_outputlength + j] = dense_buffers->data[i * dense_bufferlength + j];
1054 }
1055 }
1056
1057 /* Deallocate memory and return sparse_outputlength. */
1058 bail_out:
1059
1061
1062 if (sparse_buffers)
1063 XLALDestroyREAL8Array(sparse_buffers);
1064 if (dense_buffers)
1065 XLALDestroyREAL8Array(dense_buffers);
1066 if (temp)
1067 LALFree(temp);
1068 if (errnum)
1069 XLAL_ERROR(errnum);
1070
1071 return sparse_outputlength;
1072}
1073
1075 void *params, REAL8 * yinit, REAL8 tinit, REAL8 tend, REAL8 deltat, REAL8Array ** yout)
1076{
1077 int errnum = 0;
1078 int status; /* used throughout */
1079
1080 /* needed for the integration */
1081 size_t dim, bufferlength, cnt, retries;
1082 REAL8 t, tnew, h0;
1083 REAL8Array *buffers = NULL;
1084 REAL8 *temp = NULL, *y, *y0, *dydt_in, *dydt_in0, *dydt_out, *yerr; /* aliases */
1085
1086 /* needed for the final interpolation */
1087 gsl_spline *interp = NULL;
1088 gsl_interp_accel *accel = NULL;
1089 int outputlen = 0;
1090 REAL8Array *output = NULL;
1091 REAL8 *times, *vector; /* aliases */
1092
1093 /* note: for speed, this replaces the single CALLGSL wrapper applied before each GSL call */
1095
1096 /* allocate the buffers!
1097 * note: REAL8Array has a field dimLength (UINT4Vector) with dimensions, and a field data that points to a single memory block;
1098 * dimLength itself has fields length and data */
1099 dim = integrator->sys->dimension;
1100 bufferlength = (int)((tend - tinit) / deltat) + 2; /* allow for the initial value and possibly a final semi-step */
1101 buffers = XLALCreateREAL8ArrayL(2, dim + 1, bufferlength); /* 2-dimensional array, (dim+1) x bufferlength */
1102 temp = LALCalloc(6 * dim, sizeof(REAL8));
1103
1104 if (!buffers || !temp) {
1105 errnum = XLAL_ENOMEM;
1106 goto bail_out;
1107 }
1108
1109 y = temp;
1110 y0 = temp + dim;
1111 dydt_in = temp + 2 * dim;
1112 dydt_in0 = temp + 3 * dim;
1113 dydt_out = temp + 4 * dim;
1114 yerr = temp + 5 * dim; /* aliases */
1115
1116 /* set up to get started */
1117 integrator->sys->params = params;
1118
1119 integrator->returncode = 0;
1120
1121 cnt = 0;
1122 retries = integrator->retries;
1123
1124 t = tinit;
1125 h0 = deltat;
1126 memcpy(y, yinit, dim * sizeof(REAL8));
1127
1128 /* store the first data point */
1129 buffers->data[0] = t;
1130 for (unsigned int i = 1; i <= dim; i++)
1131 buffers->data[i * bufferlength] = y[i - 1];
1132
1133 /* compute derivatives at the initial time (dydt_in), bail out if impossible */
1134 if ((status = integrator->dydt(t, y, dydt_in, params)) != GSL_SUCCESS) {
1135 integrator->returncode = status;
1136 errnum = XLAL_EFAILED;
1137 goto bail_out;
1138 }
1139
1140 while (1) {
1141
1142 if (!integrator->stopontestonly && t >= tend) {
1143 break;
1144 }
1145
1146 if (integrator->stop) {
1147 if ((status = integrator->stop(t, y, dydt_in, params)) != GSL_SUCCESS) {
1148 integrator->returncode = status;
1149 break;
1150 }
1151 }
1152
1153 /* ready to try stepping! */
1154 try_step:
1155
1156 /* if we would be stepping beyond the final time, stop there instead... */
1157 if (!integrator->stopontestonly && t + h0 > tend)
1158 h0 = tend - t;
1159
1160 memcpy(y0, y, dim * sizeof(REAL8)); /* save y to y0, dydt_in to dydt_in0 */
1161 memcpy(dydt_in0, dydt_in, dim * sizeof(REAL8));
1162
1163 /* call the GSL stepper function */
1164 status = gsl_odeiv_step_apply(integrator->step, t, h0, y, yerr, dydt_in, dydt_out, integrator->sys);
1165 /* note: If the user-supplied functions defined in the system dydt return a status other than GSL_SUCCESS,
1166 * the step will be aborted. In this case, the elements of y will be restored to their pre-step values,
1167 * and the error code from the user-supplied function will be returned. */
1168
1169 /* did the stepper report a derivative-evaluation error? */
1170 if (status != GSL_SUCCESS) {
1171 if (retries--) {
1172 h0 = h0 / 10.0; /* if we have singularity retries left, reduce the timestep and try again */
1173 goto try_step;
1174 } else {
1175 integrator->returncode = status;
1176 break; /* otherwise exit the loop */
1177 }
1178 } else {
1179 retries = integrator->retries; /* we stepped successfully, reset the singularity retries */
1180 }
1181
1182 tnew = t + h0;
1183
1184 /* call the GSL error-checking function */
1185 status = gsl_odeiv_control_hadjust(integrator->control, integrator->step, y, yerr, dydt_out, &h0);
1186
1187 /* did the error-checker reduce the stepsize?
1188 * note: other possible return codes are GSL_ODEIV_HADJ_INC if it was increased,
1189 * GSL_ODEIV_HADJ_NIL if it was unchanged */
1190 if (status == GSL_ODEIV_HADJ_DEC) {
1191 memcpy(y, y0, dim * sizeof(REAL8)); /* if so, undo the step, and try again */
1192 memcpy(dydt_in, dydt_in0, dim * sizeof(REAL8));
1193 goto try_step;
1194 }
1195
1196 /* update the current time and input derivatives */
1197 t = tnew;
1198 memcpy(dydt_in, dydt_out, dim * sizeof(REAL8));
1199 cnt++;
1200
1201 /* check if interpolation buffers need to be extended */
1202 if (cnt >= bufferlength) {
1203 REAL8Array *rebuffers;
1204
1205 /* sadly, we cannot use ResizeREAL8Array, because it would only work if we extended the first array dimension,
1206 * so we need to copy everything over and switch the buffers. Oh well. */
1207 if (!(rebuffers = XLALCreateREAL8ArrayL(2, dim + 1, 2 * bufferlength))) {
1208 errnum = XLAL_ENOMEM; /* ouch, that hurt */
1209 goto bail_out;
1210 } else {
1211 for (unsigned int i = 0; i <= dim; i++)
1212 memcpy(&rebuffers->data[i * 2 * bufferlength], &buffers->data[i * bufferlength], cnt * sizeof(REAL8));
1213 XLALDestroyREAL8Array(buffers);
1214 buffers = rebuffers;
1215 bufferlength *= 2;
1216 }
1217 }
1218
1219 /* copy time and state into interpolation buffers */
1220 buffers->data[cnt] = t;
1221 for (unsigned int i = 1; i <= dim; i++)
1222 buffers->data[i * bufferlength + cnt] = y[i - 1]; /* y does not have time */
1223 }
1224
1225 /* copy the final state into yinit */
1226
1227 memcpy(yinit, y, dim * sizeof(REAL8));
1228
1229 /* if we have completed at least one step, allocate the GSL interpolation object and the output array */
1230 if (cnt == 0)
1231 goto bail_out;
1232
1233 interp = gsl_spline_alloc(gsl_interp_cspline, cnt + 1);
1234 accel = gsl_interp_accel_alloc();
1235
1236 outputlen = (int)(t / deltat) + 1;
1237 output = XLALCreateREAL8ArrayL(2, dim + 1, outputlen);
1238
1239 if (!interp || !accel || !output) {
1240 errnum = XLAL_ENOMEM; /* ouch again, ran out of memory */
1241 if (output)
1243 outputlen = 0;
1244 goto bail_out;
1245 }
1246
1247 /* make an array of times */
1248 times = output->data;
1249 for (int j = 0; j < outputlen; j++)
1250 times[j] = tinit + deltat * j;
1251
1252 /* interpolate! */
1253 for (unsigned int i = 1; i <= dim; i++) {
1254 gsl_spline_init(interp, &buffers->data[0], &buffers->data[bufferlength * i], cnt + 1);
1255
1256 vector = output->data + outputlen * i;
1257 for (int j = 0; j < outputlen; j++) {
1258 gsl_spline_eval_e(interp, times[j], accel, &(vector[j]));
1259 }
1260 }
1261
1262 /* deallocate stuff and return */
1263 bail_out:
1264
1266
1267 if (buffers)
1268 XLALDestroyREAL8Array(buffers); /* let's be careful, although all these checks may not be needed */
1269 if (temp)
1270 LALFree(temp);
1271
1272 if (interp)
1273 XLAL_CALLGSL(gsl_spline_free(interp));
1274 if (accel)
1275 XLAL_CALLGSL(gsl_interp_accel_free(accel));
1276
1277 if (errnum)
1278 XLAL_ERROR(errnum);
1279
1280 *yout = output;
1281 return outputlen;
1282}
1283
1284/**
1285 * Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45)
1286 * steps with adaptive step size control. Intended for use in Fourier domain
1287 * waveform generation routines based on SpinTaylorTN models.
1288 *
1289 * The method is described in
1290 *
1291 * Abramowitz & Stegun, Handbook of Mathematical Functions, Tenth Printing,
1292 * National Bureau of Standards, Washington, DC, 1972
1293 * (available online at http://people.math.sfu.ca/~cbm/aands/ )
1294 *
1295 * This method is equivalent to XLALAdaptiveRungeKutta4 and
1296 * XLALAdaptiveRungeKutta4Hermite, but does not includes any interpolation.
1297 *
1298 */
1299int XLALAdaptiveRungeKutta4IrregularIntervals(LALAdaptiveRungeKuttaIntegrator * integrator, /**< struct holding dydt, stopping test, stepper, etc. */
1300 void *params, /**< params struct used to compute dydt and stopping test */
1301 REAL8 * yinit, /**< pass in initial values of all variables - overwritten to final values */
1302 REAL8 tinit, /**< integration start time */
1303 REAL8 tend_in, /**< maximum integration time */
1304 REAL8Array ** yout /**< array holding the unevenly sampled output */
1305 )
1306{
1307 UINT4 MaxRK4Steps = 1000000;
1308 int errnum = 0;
1309 int status; /* used throughout */
1310 unsigned int i;
1311
1312 // if we integrate forward in time, we start at i=0, and if we integrate backwards, we start at i=MaxRK4Steps-1
1313 unsigned int iStart, iCurrent;
1314 int di;
1315
1316 REAL8 tend = tend_in;
1317
1318 /* needed for the integration */
1319 size_t dim, bufferlength, cnt, retries;
1320 REAL8 t, tnew, h0;
1321 REAL8Array *buffers = NULL;
1322 REAL8 *temp = NULL, *y, *y0, *dydt_in, *dydt_in0, *dydt_out, *yerr; /* aliases */
1323
1324 int outputlen = 0;
1325 REAL8Array *output = NULL;
1326
1327 /* note: for speed, this replaces the single CALLGSL wrapper applied before each GSL call */
1329
1330 /* allocate the buffers!
1331 * note: REAL8Array has a field dimLength (UINT4Vector) with dimensions, and a field data that points to a single memory block;
1332 * dimLength itself has fields length and data */
1333 dim = integrator->sys->dimension;
1334 bufferlength = MaxRK4Steps;
1335 buffers = XLALCreateREAL8ArrayL(2, dim + 2, bufferlength); /* 2-dimensional array, (dim+2) x bufferlength */
1336 temp = LALCalloc(6 * dim, sizeof(REAL8));
1337
1338 if (!buffers || !temp) {
1339 errnum = XLAL_ENOMEM;
1340 goto bail_out;
1341 }
1342
1343 y = temp;
1344 y0 = temp + dim;
1345 dydt_in = temp + 2 * dim;
1346 dydt_in0 = temp + 3 * dim;
1347 dydt_out = temp + 4 * dim;
1348 yerr = temp + 5 * dim; /* aliases */
1349
1350 /* set up to get started */
1351 integrator->sys->params = params;
1352
1353 integrator->returncode = 0;
1354
1355 cnt = 0;
1356 retries = integrator->retries;
1357
1358 t = tinit;
1359 if (tend > tinit) {
1360 h0 = 1.;
1361 } else {
1362 h0 = -1.;
1363 }
1364 memcpy(y, yinit, dim * sizeof(REAL8));
1365
1366 // current index starts at iStart, and increases in steps of di. We've reached the memory limit if cnt == bufferlength.
1367 if (h0 > 0.) {
1368 iStart = 0;
1369 di = 1;
1370 } else {
1371 iStart = MaxRK4Steps - 1;
1372 di = -1;
1373 }
1374
1375 iCurrent = iStart;
1376
1377 /* store the first data point */
1378 buffers->data[iCurrent] = t;
1379 for (i = 1; i <= dim; i++)
1380 buffers->data[i * bufferlength + iCurrent] = y[i - 1];
1381
1382 /* compute derivatives at the initial time (dydt_in), bail out if impossible */
1383 if ((status = integrator->dydt(t, y, dydt_in, params)) != GSL_SUCCESS) {
1384 integrator->returncode = status;
1385 errnum = XLAL_EFAILED;
1386 goto bail_out;
1387 }
1388
1389 buffers->data[i * bufferlength + iCurrent] = dydt_in[1]; /* add domega/dt. here i=dim+1 */
1390
1391 while (1) {
1392
1393 if (!integrator->stopontestonly && t >= tend) {
1394 break;
1395 }
1396
1397 if (integrator->stop) {
1398 if ((status = integrator->stop(t, y, dydt_in, params)) != GSL_SUCCESS) {
1399 integrator->returncode = status;
1400 break;
1401 }
1402 }
1403
1404 /* ready to try stepping! */
1405 try_step:
1406
1407 /* if we would be stepping beyond the final time, stop there instead... */
1408 if (!integrator->stopontestonly && t + h0 > tend)
1409 h0 = tend - t;
1410
1411 memcpy(y0, y, dim * sizeof(REAL8)); /* save y to y0, dydt_in to dydt_in0 */
1412 memcpy(dydt_in0, dydt_in, dim * sizeof(REAL8));
1413
1414 /* call the GSL stepper function */
1415 status = gsl_odeiv_step_apply(integrator->step, t, h0, y, yerr, dydt_in, dydt_out, integrator->sys);
1416 /* note: If the user-supplied functions defined in the system dydt return a status other than GSL_SUCCESS,
1417 * the step will be aborted. In this case, the elements of y will be restored to their pre-step values,
1418 * and the error code from the user-supplied function will be returned. */
1419
1420 /* did the stepper report a derivative-evaluation error? */
1421 if (status != GSL_SUCCESS) {
1422 if (retries--) {
1423 h0 = h0 / 10.0; /* if we have singularity retries left, reduce the timestep and try again */
1424 goto try_step;
1425 } else {
1426 integrator->returncode = status;
1427 break; /* otherwise exit the loop */
1428 }
1429 } else {
1430 retries = integrator->retries; /* we stepped successfully, reset the singularity retries */
1431 }
1432
1433 tnew = t + h0;
1434
1435 /* call the GSL error-checking function */
1436 status = gsl_odeiv_control_hadjust(integrator->control, integrator->step, y, yerr, dydt_out, &h0);
1437
1438 /* did the error-checker reduce the stepsize?
1439 * note: other possible return codes are GSL_ODEIV_HADJ_INC if it was increased, GSL_ODEIV_HADJ_NIL if it was unchanged */
1440 if (status == GSL_ODEIV_HADJ_DEC) {
1441 memcpy(y, y0, dim * sizeof(REAL8)); /* if so, undo the step, and try again */
1442 memcpy(dydt_in, dydt_in0, dim * sizeof(REAL8));
1443 goto try_step;
1444 }
1445
1446 /* update the current time and input derivatives */
1447 t = tnew;
1448 memcpy(dydt_in, dydt_out, dim * sizeof(REAL8));
1449 cnt++;
1450 iCurrent += di;
1451
1452 /* check if interpolation buffers need to be extended */
1453 if (cnt >= bufferlength) {
1454 REAL8Array *rebuffers;
1455
1456 /* sadly, we cannot use ResizeREAL8Array, because it would only work if we extended the first array dimension,
1457 * so we need to copy everything over and switch the buffers. Oh well. */
1458 if (!(rebuffers = XLALCreateREAL8ArrayL(2, dim + 1, 2 * bufferlength))) {
1459 errnum = XLAL_ENOMEM; /* ouch, that hurt */
1460 goto bail_out;
1461 } else {
1462 for (i = 0; i <= dim; i++)
1463 memcpy(&rebuffers->data[i * 2 * bufferlength], &buffers->data[i * bufferlength], cnt * sizeof(REAL8));
1464 XLALDestroyREAL8Array(buffers);
1465 buffers = rebuffers;
1466 bufferlength *= 2;
1467 if (di < 0) {
1468 iCurrent += bufferlength;
1469 }
1470 }
1471 }
1472
1473 /* copy time and state into interpolation buffers */
1474 buffers->data[iCurrent] = t;
1475 for (i = 1; i <= dim; i++)
1476 buffers->data[i * bufferlength + iCurrent] = y[i - 1]; /* y does not have time */
1477
1478 buffers->data[i * bufferlength + iCurrent] = dydt_in[1]; /* add domega/dt. here i=dim+1 */
1479 }
1480
1481 /* copy the final state into yinit */
1482
1483 memcpy(yinit, y, dim * sizeof(REAL8));
1484
1485 /* if we have completed at least one step, allocate the output array */
1486 if (cnt == 0)
1487 goto bail_out;
1488
1489 outputlen = cnt + 1;
1490 output = XLALCreateREAL8ArrayL(2, dim + 2, outputlen);
1491
1492 // depending on the direction of integration, we copy starting from 0 or from the current index
1493 if (di > 0) {
1494 iStart = 0;
1495 } else {
1496 iStart = iCurrent;
1497 }
1498
1499 if (!output) {
1500 errnum = XLAL_ENOMEM; /* ouch again, ran out of memory */
1501 if (output)
1503 outputlen = 0;
1504 goto bail_out;
1505 }
1506
1507 for (i = 0; i <= dim + 1; i++) {
1508 memcpy(&(output->data[i * outputlen]), &(buffers->data[i * bufferlength + iStart]), outputlen * sizeof(REAL8));
1509 }
1510
1511 /* deallocate stuff and return */
1512 bail_out:
1513
1515
1516 if (buffers)
1517 XLALDestroyREAL8Array(buffers); /* let's be careful, although all these checks may not be needed */
1518 if (temp)
1519 LALFree(temp);
1520
1521 if (errnum)
1522 XLAL_ERROR(errnum);
1523
1524 *yout = output;
1525 return outputlen;
1526}
static int storeStateInOutput(REAL8Array **output, REAL8 t, REAL8 *y, size_t dim, int *outputlen, int count)
static int shrinkOutput(REAL8Array **output, int *outputlen, int count, size_t dim)
#define XLAL_BEGINGSL
static const UINT8 k1
Definition: LALCityHash.c:142
#define LALCalloc(m, n)
Definition: LALMalloc.h:94
#define LALFree(p)
Definition: LALMalloc.h:96
int XLALPrintError(const char *fmt,...)
Definition: XLALError.c:68
#define XLAL_CALLGSL(statement)
Definition: XLALGSL.h:33
void XLALDestroyREAL8Array(REAL8Array *)
REAL8Array * XLALCreateREAL8ArrayL(UINT4,...)
int XLALAdaptiveRungeKutta4(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend, REAL8 deltat, REAL8Array **yout)
void XLALAdaptiveRungeKuttaFree(LALAdaptiveRungeKuttaIntegrator *integrator)
int XLALAdaptiveRungeKutta4IrregularIntervals(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend_in, REAL8Array **yout)
Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45) steps with adaptive step s...
int XLALAdaptiveRungeKutta4NoInterpolate(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend, REAL8 deltat_or_h0, REAL8 min_deltat_or_h0, REAL8Array **t_and_y_out, INT4 EOBversion)
Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg steps with adaptive step size cont...
int XLALAdaptiveRungeKuttaDenseandSparseOutput(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend, REAL8 deltat, REAL8Array **sparse_output, REAL8Array **dense_output)
LALAdaptiveRungeKuttaIntegrator * XLALAdaptiveRungeKutta4InitEighthOrderInstead(int dim, int(*dydt)(double t, const double y[], double dydt[], void *params), int(*stop)(double t, const double y[], double dydt[], void *params), double eps_abs, double eps_rel)
Eighth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg steps with adaptive step size cont...
LALAdaptiveRungeKuttaIntegrator * XLALAdaptiveRungeKutta4Init(int dim, int(*dydt)(double t, const double y[], double dydt[], void *params), int(*stop)(double t, const double y[], double dydt[], void *params), double eps_abs, double eps_rel)
int XLALAdaptiveRungeKutta4HermiteOnlyFinal(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend_in, REAL8 y1_final, REAL8 deltat)
Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45) steps with adaptive step s...
int XLALAdaptiveRungeKutta4Hermite(LALAdaptiveRungeKuttaIntegrator *integrator, void *params, REAL8 *yinit, REAL8 tinit, REAL8 tend_in, REAL8 deltat, REAL8Array **yout)
Fourth-order Runge-Kutta ODE integrator using Runge-Kutta-Fehlberg (RKF45) steps with adaptive step s...
uint64_t UINT8
Eight-byte unsigned integer; on some platforms this is equivalent to unsigned long int instead.
double REAL8
Double precision real floating-point number (8 bytes).
uint32_t UINT4
Four-byte unsigned integer.
int32_t INT4
Four-byte signed integer.
#define XLALCalloc(m, n)
Definition: LALMalloc.h:45
#define XLALFree(p)
Definition: LALMalloc.h:47
#define XLAL_ERROR_NULL(...)
Macro to invoke a failure from a XLAL routine returning a pointer.
Definition: XLALError.h:713
#define XLAL_ERROR(...)
Macro to invoke a failure from a XLAL routine returning an integer.
Definition: XLALError.h:700
@ XLAL_ENOMEM
Memory allocation error.
Definition: XLALError.h:407
@ XLAL_EINVAL
Invalid argument.
Definition: XLALError.h:409
@ XLAL_EFAILED
Generic failure.
Definition: XLALError.h:418
int(* stop)(double t, const double y[], double dydt[], void *params)
int(* dydt)(double t, const double y[], double dydt[], void *params)
Multidimentional array of REAL8, see DATATYPE-Array types for more details.
Definition: LALDatatypes.h:226
REAL8 * data
Pointer to the data array.
Definition: LALDatatypes.h:228
void output(int gps_sec, int output_type)
Definition: tconvert.c:440