Xmipp  v3.23.11-Nereus
integration.cpp
Go to the documentation of this file.
1 /*************************************************************************
2 Copyright (c) Sergey Bochkanov (ALGLIB project).
3 
4 >>> SOURCE LICENSE >>>
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation (www.fsf.org); either version 2 of the
8 License, or (at your option) any later version.
9 
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14 
15 A copy of the GNU General Public License is available at
16 http://www.fsf.org/licensing/licenses
17 >>> END OF LICENSE >>>
18 *************************************************************************/
19 #include "stdafx.h"
20 #include "integration.h"
21 
22 // disable some irrelevant warnings
23 #if (AE_COMPILER==AE_MSVC)
24 #pragma warning(disable:4100)
25 #pragma warning(disable:4127)
26 #pragma warning(disable:4702)
27 #pragma warning(disable:4996)
28 #endif
29 using namespace std;
30 
32 //
33 // THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE
34 //
36 namespace alglib
37 {
38 
39 
40 /*************************************************************************
41 Computation of nodes and weights for a Gauss quadrature formula
42 
43 The algorithm generates the N-point Gauss quadrature formula with weight
44 function given by coefficients alpha and beta of a recurrence relation
45 which generates a system of orthogonal polynomials:
46 
47 P-1(x) = 0
48 P0(x) = 1
49 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
50 
51 and zeroth moment Mu0
52 
53 Mu0 = integral(W(x)dx,a,b)
54 
55 INPUT PARAMETERS:
56  Alpha – array[0..N-1], alpha coefficients
57  Beta – array[0..N-1], beta coefficients
58  Zero-indexed element is not used and may be arbitrary.
59  Beta[I]>0.
60  Mu0 – zeroth moment of the weight function.
61  N – number of nodes of the quadrature formula, N>=1
62 
63 OUTPUT PARAMETERS:
64  Info - error code:
65  * -3 internal eigenproblem solver hasn't converged
66  * -2 Beta[i]<=0
67  * -1 incorrect N was passed
68  * 1 OK
69  X - array[0..N-1] - array of quadrature nodes,
70  in ascending order.
71  W - array[0..N-1] - array of quadrature weights.
72 
73  -- ALGLIB --
74  Copyright 2005-2009 by Bochkanov Sergey
75 *************************************************************************/
76 void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
77 {
78  alglib_impl::ae_state _alglib_env_state;
79  alglib_impl::ae_state_init(&_alglib_env_state);
80  try
81  {
82  alglib_impl::gqgeneraterec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
83  alglib_impl::ae_state_clear(&_alglib_env_state);
84  return;
85  }
87  {
88  throw ap_error(_alglib_env_state.error_msg);
89  }
90 }
91 
92 /*************************************************************************
93 Computation of nodes and weights for a Gauss-Lobatto quadrature formula
94 
95 The algorithm generates the N-point Gauss-Lobatto quadrature formula with
96 weight function given by coefficients alpha and beta of a recurrence which
97 generates a system of orthogonal polynomials.
98 
99 P-1(x) = 0
100 P0(x) = 1
101 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
102 
103 and zeroth moment Mu0
104 
105 Mu0 = integral(W(x)dx,a,b)
106 
107 INPUT PARAMETERS:
108  Alpha – array[0..N-2], alpha coefficients
109  Beta – array[0..N-2], beta coefficients.
110  Zero-indexed element is not used, may be arbitrary.
111  Beta[I]>0
112  Mu0 – zeroth moment of the weighting function.
113  A – left boundary of the integration interval.
114  B – right boundary of the integration interval.
115  N – number of nodes of the quadrature formula, N>=3
116  (including the left and right boundary nodes).
117 
118 OUTPUT PARAMETERS:
119  Info - error code:
120  * -3 internal eigenproblem solver hasn't converged
121  * -2 Beta[i]<=0
122  * -1 incorrect N was passed
123  * 1 OK
124  X - array[0..N-1] - array of quadrature nodes,
125  in ascending order.
126  W - array[0..N-1] - array of quadrature weights.
127 
128  -- ALGLIB --
129  Copyright 2005-2009 by Bochkanov Sergey
130 *************************************************************************/
131 void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
132 {
133  alglib_impl::ae_state _alglib_env_state;
134  alglib_impl::ae_state_init(&_alglib_env_state);
135  try
136  {
137  alglib_impl::gqgenerategausslobattorec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, a, b, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
138  alglib_impl::ae_state_clear(&_alglib_env_state);
139  return;
140  }
142  {
143  throw ap_error(_alglib_env_state.error_msg);
144  }
145 }
146 
147 /*************************************************************************
148 Computation of nodes and weights for a Gauss-Radau quadrature formula
149 
150 The algorithm generates the N-point Gauss-Radau quadrature formula with
151 weight function given by the coefficients alpha and beta of a recurrence
152 which generates a system of orthogonal polynomials.
153 
154 P-1(x) = 0
155 P0(x) = 1
156 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
157 
158 and zeroth moment Mu0
159 
160 Mu0 = integral(W(x)dx,a,b)
161 
162 INPUT PARAMETERS:
163  Alpha – array[0..N-2], alpha coefficients.
164  Beta – array[0..N-1], beta coefficients
165  Zero-indexed element is not used.
166  Beta[I]>0
167  Mu0 – zeroth moment of the weighting function.
168  A – left boundary of the integration interval.
169  N – number of nodes of the quadrature formula, N>=2
170  (including the left boundary node).
171 
172 OUTPUT PARAMETERS:
173  Info - error code:
174  * -3 internal eigenproblem solver hasn't converged
175  * -2 Beta[i]<=0
176  * -1 incorrect N was passed
177  * 1 OK
178  X - array[0..N-1] - array of quadrature nodes,
179  in ascending order.
180  W - array[0..N-1] - array of quadrature weights.
181 
182 
183  -- ALGLIB --
184  Copyright 2005-2009 by Bochkanov Sergey
185 *************************************************************************/
186 void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
187 {
188  alglib_impl::ae_state _alglib_env_state;
189  alglib_impl::ae_state_init(&_alglib_env_state);
190  try
191  {
192  alglib_impl::gqgenerategaussradaurec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, a, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
193  alglib_impl::ae_state_clear(&_alglib_env_state);
194  return;
195  }
197  {
198  throw ap_error(_alglib_env_state.error_msg);
199  }
200 }
201 
202 /*************************************************************************
203 Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N
204 nodes.
205 
206 INPUT PARAMETERS:
207  N - number of nodes, >=1
208 
209 OUTPUT PARAMETERS:
210  Info - error code:
211  * -4 an error was detected when calculating
212  weights/nodes. N is too large to obtain
213  weights/nodes with high enough accuracy.
214  Try to use multiple precision version.
215  * -3 internal eigenproblem solver hasn't converged
216  * -1 incorrect N was passed
217  * +1 OK
218  X - array[0..N-1] - array of quadrature nodes,
219  in ascending order.
220  W - array[0..N-1] - array of quadrature weights.
221 
222 
223  -- ALGLIB --
224  Copyright 12.05.2009 by Bochkanov Sergey
225 *************************************************************************/
227 {
228  alglib_impl::ae_state _alglib_env_state;
229  alglib_impl::ae_state_init(&_alglib_env_state);
230  try
231  {
232  alglib_impl::gqgenerategausslegendre(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
233  alglib_impl::ae_state_clear(&_alglib_env_state);
234  return;
235  }
237  {
238  throw ap_error(_alglib_env_state.error_msg);
239  }
240 }
241 
242 /*************************************************************************
243 Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight
244 function W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
245 
246 INPUT PARAMETERS:
247  N - number of nodes, >=1
248  Alpha - power-law coefficient, Alpha>-1
249  Beta - power-law coefficient, Beta>-1
250 
251 OUTPUT PARAMETERS:
252  Info - error code:
253  * -4 an error was detected when calculating
254  weights/nodes. Alpha or Beta are too close
255  to -1 to obtain weights/nodes with high enough
256  accuracy, or, may be, N is too large. Try to
257  use multiple precision version.
258  * -3 internal eigenproblem solver hasn't converged
259  * -1 incorrect N/Alpha/Beta was passed
260  * +1 OK
261  X - array[0..N-1] - array of quadrature nodes,
262  in ascending order.
263  W - array[0..N-1] - array of quadrature weights.
264 
265 
266  -- ALGLIB --
267  Copyright 12.05.2009 by Bochkanov Sergey
268 *************************************************************************/
269 void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w)
270 {
271  alglib_impl::ae_state _alglib_env_state;
272  alglib_impl::ae_state_init(&_alglib_env_state);
273  try
274  {
275  alglib_impl::gqgenerategaussjacobi(n, alpha, beta, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
276  alglib_impl::ae_state_clear(&_alglib_env_state);
277  return;
278  }
280  {
281  throw ap_error(_alglib_env_state.error_msg);
282  }
283 }
284 
285 /*************************************************************************
286 Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with
287 weight function W(x)=Power(x,Alpha)*Exp(-x)
288 
289 INPUT PARAMETERS:
290  N - number of nodes, >=1
291  Alpha - power-law coefficient, Alpha>-1
292 
293 OUTPUT PARAMETERS:
294  Info - error code:
295  * -4 an error was detected when calculating
296  weights/nodes. Alpha is too close to -1 to
297  obtain weights/nodes with high enough accuracy
298  or, may be, N is too large. Try to use
299  multiple precision version.
300  * -3 internal eigenproblem solver hasn't converged
301  * -1 incorrect N/Alpha was passed
302  * +1 OK
303  X - array[0..N-1] - array of quadrature nodes,
304  in ascending order.
305  W - array[0..N-1] - array of quadrature weights.
306 
307 
308  -- ALGLIB --
309  Copyright 12.05.2009 by Bochkanov Sergey
310 *************************************************************************/
311 void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w)
312 {
313  alglib_impl::ae_state _alglib_env_state;
314  alglib_impl::ae_state_init(&_alglib_env_state);
315  try
316  {
317  alglib_impl::gqgenerategausslaguerre(n, alpha, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
318  alglib_impl::ae_state_clear(&_alglib_env_state);
319  return;
320  }
322  {
323  throw ap_error(_alglib_env_state.error_msg);
324  }
325 }
326 
327 /*************************************************************************
328 Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with
329 weight function W(x)=Exp(-x*x)
330 
331 INPUT PARAMETERS:
332  N - number of nodes, >=1
333 
334 OUTPUT PARAMETERS:
335  Info - error code:
336  * -4 an error was detected when calculating
337  weights/nodes. May be, N is too large. Try to
338  use multiple precision version.
339  * -3 internal eigenproblem solver hasn't converged
340  * -1 incorrect N/Alpha was passed
341  * +1 OK
342  X - array[0..N-1] - array of quadrature nodes,
343  in ascending order.
344  W - array[0..N-1] - array of quadrature weights.
345 
346 
347  -- ALGLIB --
348  Copyright 12.05.2009 by Bochkanov Sergey
349 *************************************************************************/
351 {
352  alglib_impl::ae_state _alglib_env_state;
353  alglib_impl::ae_state_init(&_alglib_env_state);
354  try
355  {
356  alglib_impl::gqgenerategausshermite(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), &_alglib_env_state);
357  alglib_impl::ae_state_clear(&_alglib_env_state);
358  return;
359  }
361  {
362  throw ap_error(_alglib_env_state.error_msg);
363  }
364 }
365 
366 /*************************************************************************
367 Computation of nodes and weights of a Gauss-Kronrod quadrature formula
368 
369 The algorithm generates the N-point Gauss-Kronrod quadrature formula with
370 weight function given by coefficients alpha and beta of a recurrence
371 relation which generates a system of orthogonal polynomials:
372 
373  P-1(x) = 0
374  P0(x) = 1
375  Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
376 
377 and zero moment Mu0
378 
379  Mu0 = integral(W(x)dx,a,b)
380 
381 
382 INPUT PARAMETERS:
383  Alpha – alpha coefficients, array[0..floor(3*K/2)].
384  Beta – beta coefficients, array[0..ceil(3*K/2)].
385  Beta[0] is not used and may be arbitrary.
386  Beta[I]>0.
387  Mu0 – zeroth moment of the weight function.
388  N – number of nodes of the Gauss-Kronrod quadrature formula,
389  N >= 3,
390  N = 2*K+1.
391 
392 OUTPUT PARAMETERS:
393  Info - error code:
394  * -5 no real and positive Gauss-Kronrod formula can
395  be created for such a weight function with a
396  given number of nodes.
397  * -4 N is too large, task may be ill conditioned -
398  x[i]=x[i+1] found.
399  * -3 internal eigenproblem solver hasn't converged
400  * -2 Beta[i]<=0
401  * -1 incorrect N was passed
402  * +1 OK
403  X - array[0..N-1] - array of quadrature nodes,
404  in ascending order.
405  WKronrod - array[0..N-1] - Kronrod weights
406  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
407  corresponding to extended Kronrod nodes).
408 
409  -- ALGLIB --
410  Copyright 08.05.2009 by Bochkanov Sergey
411 *************************************************************************/
412 void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
413 {
414  alglib_impl::ae_state _alglib_env_state;
415  alglib_impl::ae_state_init(&_alglib_env_state);
416  try
417  {
418  alglib_impl::gkqgeneraterec(const_cast<alglib_impl::ae_vector*>(alpha.c_ptr()), const_cast<alglib_impl::ae_vector*>(beta.c_ptr()), mu0, n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
419  alglib_impl::ae_state_clear(&_alglib_env_state);
420  return;
421  }
423  {
424  throw ap_error(_alglib_env_state.error_msg);
425  }
426 }
427 
428 /*************************************************************************
429 Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre
430 quadrature with N points.
431 
432 GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is
433 used depending on machine precision and number of nodes.
434 
435 INPUT PARAMETERS:
436  N - number of Kronrod nodes, must be odd number, >=3.
437 
438 OUTPUT PARAMETERS:
439  Info - error code:
440  * -4 an error was detected when calculating
441  weights/nodes. N is too large to obtain
442  weights/nodes with high enough accuracy.
443  Try to use multiple precision version.
444  * -3 internal eigenproblem solver hasn't converged
445  * -1 incorrect N was passed
446  * +1 OK
447  X - array[0..N-1] - array of quadrature nodes, ordered in
448  ascending order.
449  WKronrod - array[0..N-1] - Kronrod weights
450  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
451  corresponding to extended Kronrod nodes).
452 
453 
454  -- ALGLIB --
455  Copyright 12.05.2009 by Bochkanov Sergey
456 *************************************************************************/
458 {
459  alglib_impl::ae_state _alglib_env_state;
460  alglib_impl::ae_state_init(&_alglib_env_state);
461  try
462  {
463  alglib_impl::gkqgenerategausslegendre(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
464  alglib_impl::ae_state_clear(&_alglib_env_state);
465  return;
466  }
468  {
469  throw ap_error(_alglib_env_state.error_msg);
470  }
471 }
472 
473 /*************************************************************************
474 Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi
475 quadrature on [-1,1] with weight function
476 
477  W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
478 
479 INPUT PARAMETERS:
480  N - number of Kronrod nodes, must be odd number, >=3.
481  Alpha - power-law coefficient, Alpha>-1
482  Beta - power-law coefficient, Beta>-1
483 
484 OUTPUT PARAMETERS:
485  Info - error code:
486  * -5 no real and positive Gauss-Kronrod formula can
487  be created for such a weight function with a
488  given number of nodes.
489  * -4 an error was detected when calculating
490  weights/nodes. Alpha or Beta are too close
491  to -1 to obtain weights/nodes with high enough
492  accuracy, or, may be, N is too large. Try to
493  use multiple precision version.
494  * -3 internal eigenproblem solver hasn't converged
495  * -1 incorrect N was passed
496  * +1 OK
497  * +2 OK, but quadrature rule have exterior nodes,
498  x[0]<-1 or x[n-1]>+1
499  X - array[0..N-1] - array of quadrature nodes, ordered in
500  ascending order.
501  WKronrod - array[0..N-1] - Kronrod weights
502  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
503  corresponding to extended Kronrod nodes).
504 
505 
506  -- ALGLIB --
507  Copyright 12.05.2009 by Bochkanov Sergey
508 *************************************************************************/
509 void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
510 {
511  alglib_impl::ae_state _alglib_env_state;
512  alglib_impl::ae_state_init(&_alglib_env_state);
513  try
514  {
515  alglib_impl::gkqgenerategaussjacobi(n, alpha, beta, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
516  alglib_impl::ae_state_clear(&_alglib_env_state);
517  return;
518  }
520  {
521  throw ap_error(_alglib_env_state.error_msg);
522  }
523 }
524 
525 /*************************************************************************
526 Returns Gauss and Gauss-Kronrod nodes for quadrature with N points.
527 
528 Reduction to tridiagonal eigenproblem is used.
529 
530 INPUT PARAMETERS:
531  N - number of Kronrod nodes, must be odd number, >=3.
532 
533 OUTPUT PARAMETERS:
534  Info - error code:
535  * -4 an error was detected when calculating
536  weights/nodes. N is too large to obtain
537  weights/nodes with high enough accuracy.
538  Try to use multiple precision version.
539  * -3 internal eigenproblem solver hasn't converged
540  * -1 incorrect N was passed
541  * +1 OK
542  X - array[0..N-1] - array of quadrature nodes, ordered in
543  ascending order.
544  WKronrod - array[0..N-1] - Kronrod weights
545  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
546  corresponding to extended Kronrod nodes).
547 
548  -- ALGLIB --
549  Copyright 12.05.2009 by Bochkanov Sergey
550 *************************************************************************/
552 {
553  alglib_impl::ae_state _alglib_env_state;
554  alglib_impl::ae_state_init(&_alglib_env_state);
555  try
556  {
557  alglib_impl::gkqlegendrecalc(n, &info, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &_alglib_env_state);
558  alglib_impl::ae_state_clear(&_alglib_env_state);
559  return;
560  }
562  {
563  throw ap_error(_alglib_env_state.error_msg);
564  }
565 }
566 
567 /*************************************************************************
568 Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using
569 pre-calculated table. Nodes/weights were computed with accuracy up to
570 1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision
571 accuracy reduces to something about 2.0E-16 (depending on your compiler's
572 handling of long floating point constants).
573 
574 INPUT PARAMETERS:
575  N - number of Kronrod nodes.
576  N can be 15, 21, 31, 41, 51, 61.
577 
578 OUTPUT PARAMETERS:
579  X - array[0..N-1] - array of quadrature nodes, ordered in
580  ascending order.
581  WKronrod - array[0..N-1] - Kronrod weights
582  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
583  corresponding to extended Kronrod nodes).
584 
585 
586  -- ALGLIB --
587  Copyright 12.05.2009 by Bochkanov Sergey
588 *************************************************************************/
589 void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps)
590 {
591  alglib_impl::ae_state _alglib_env_state;
592  alglib_impl::ae_state_init(&_alglib_env_state);
593  try
594  {
595  alglib_impl::gkqlegendretbl(n, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(wkronrod.c_ptr()), const_cast<alglib_impl::ae_vector*>(wgauss.c_ptr()), &eps, &_alglib_env_state);
596  alglib_impl::ae_state_clear(&_alglib_env_state);
597  return;
598  }
600  {
601  throw ap_error(_alglib_env_state.error_msg);
602  }
603 }
604 
605 /*************************************************************************
606 Integration report:
607 * TerminationType = completion code:
608  * -5 non-convergence of Gauss-Kronrod nodes
609  calculation subroutine.
610  * -1 incorrect parameters were specified
611  * 1 OK
612 * Rep.NFEV contains number of function calculations
613 * Rep.NIntervals contains number of intervals [a,b]
614  was partitioned into.
615 *************************************************************************/
616 _autogkreport_owner::_autogkreport_owner()
617 {
619  if( p_struct==NULL )
620  throw ap_error("ALGLIB: malloc error");
621  if( !alglib_impl::_autogkreport_init(p_struct, NULL, ae_false) )
622  throw ap_error("ALGLIB: malloc error");
623 }
624 
625 _autogkreport_owner::_autogkreport_owner(const _autogkreport_owner &rhs)
626 {
628  if( p_struct==NULL )
629  throw ap_error("ALGLIB: malloc error");
630  if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast<alglib_impl::autogkreport*>(rhs.p_struct), NULL, ae_false) )
631  throw ap_error("ALGLIB: malloc error");
632 }
633 
634 _autogkreport_owner& _autogkreport_owner::operator=(const _autogkreport_owner &rhs)
635 {
636  if( this==&rhs )
637  return *this;
639  if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast<alglib_impl::autogkreport*>(rhs.p_struct), NULL, ae_false) )
640  throw ap_error("ALGLIB: malloc error");
641  return *this;
642 }
643 
644 _autogkreport_owner::~_autogkreport_owner()
645 {
647  ae_free(p_struct);
648 }
649 
650 alglib_impl::autogkreport* _autogkreport_owner::c_ptr()
651 {
652  return p_struct;
653 }
654 
655 alglib_impl::autogkreport* _autogkreport_owner::c_ptr() const
656 {
657  return const_cast<alglib_impl::autogkreport*>(p_struct);
658 }
659 autogkreport::autogkreport() : _autogkreport_owner() ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals)
660 {
661 }
662 
664 {
665 }
666 
668 {
669  if( this==&rhs )
670  return *this;
672  return *this;
673 }
674 
676 {
677 }
678 
679 
680 /*************************************************************************
681 This structure stores state of the integration algorithm.
682 
683 Although this class has public fields, they are not intended for external
684 use. You should use ALGLIB functions to work with this class:
685 * autogksmooth()/AutoGKSmoothW()/... to create objects
686 * autogkintegrate() to begin integration
687 * autogkresults() to get results
688 *************************************************************************/
690 {
692  if( p_struct==NULL )
693  throw ap_error("ALGLIB: malloc error");
695  throw ap_error("ALGLIB: malloc error");
696 }
697 
699 {
701  if( p_struct==NULL )
702  throw ap_error("ALGLIB: malloc error");
703  if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast<alglib_impl::autogkstate*>(rhs.p_struct), NULL, ae_false) )
704  throw ap_error("ALGLIB: malloc error");
705 }
706 
708 {
709  if( this==&rhs )
710  return *this;
712  if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast<alglib_impl::autogkstate*>(rhs.p_struct), NULL, ae_false) )
713  throw ap_error("ALGLIB: malloc error");
714  return *this;
715 }
716 
718 {
720  ae_free(p_struct);
721 }
722 
724 {
725  return p_struct;
726 }
727 
729 {
730  return const_cast<alglib_impl::autogkstate*>(p_struct);
731 }
732 autogkstate::autogkstate() : _autogkstate_owner() ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f)
733 {
734 }
735 
737 {
738 }
739 
741 {
742  if( this==&rhs )
743  return *this;
745  return *this;
746 }
747 
749 {
750 }
751 
752 /*************************************************************************
753 Integration of a smooth function F(x) on a finite interval [a,b].
754 
755 Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
756 is calculated with accuracy close to the machine precision.
757 
758 Algorithm works well only with smooth integrands. It may be used with
759 continuous non-smooth integrands, but with less performance.
760 
761 It should never be used with integrands which have integrable singularities
762 at lower or upper limits - algorithm may crash. Use AutoGKSingular in such
763 cases.
764 
765 INPUT PARAMETERS:
766  A, B - interval boundaries (A<B, A=B or A>B)
767 
768 OUTPUT PARAMETERS
769  State - structure which stores algorithm state
770 
771 SEE ALSO
772  AutoGKSmoothW, AutoGKSingular, AutoGKResults.
773 
774 
775  -- ALGLIB --
776  Copyright 06.05.2009 by Bochkanov Sergey
777 *************************************************************************/
778 void autogksmooth(const double a, const double b, autogkstate &state)
779 {
780  alglib_impl::ae_state _alglib_env_state;
781  alglib_impl::ae_state_init(&_alglib_env_state);
782  try
783  {
784  alglib_impl::autogksmooth(a, b, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
785  alglib_impl::ae_state_clear(&_alglib_env_state);
786  return;
787  }
789  {
790  throw ap_error(_alglib_env_state.error_msg);
791  }
792 }
793 
794 /*************************************************************************
795 Integration of a smooth function F(x) on a finite interval [a,b].
796 
797 This subroutine is same as AutoGKSmooth(), but it guarantees that interval
798 [a,b] is partitioned into subintervals which have width at most XWidth.
799 
800 Subroutine can be used when integrating nearly-constant function with
801 narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth
802 subroutine can overlook them.
803 
804 INPUT PARAMETERS:
805  A, B - interval boundaries (A<B, A=B or A>B)
806 
807 OUTPUT PARAMETERS
808  State - structure which stores algorithm state
809 
810 SEE ALSO
811  AutoGKSmooth, AutoGKSingular, AutoGKResults.
812 
813 
814  -- ALGLIB --
815  Copyright 06.05.2009 by Bochkanov Sergey
816 *************************************************************************/
817 void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state)
818 {
819  alglib_impl::ae_state _alglib_env_state;
820  alglib_impl::ae_state_init(&_alglib_env_state);
821  try
822  {
823  alglib_impl::autogksmoothw(a, b, xwidth, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
824  alglib_impl::ae_state_clear(&_alglib_env_state);
825  return;
826  }
828  {
829  throw ap_error(_alglib_env_state.error_msg);
830  }
831 }
832 
833 /*************************************************************************
834 Integration on a finite interval [A,B].
835 Integrand have integrable singularities at A/B.
836 
837 F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known
838 alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates
839 from below can be used (but these estimates should be greater than -1 too).
840 
841 One of alpha/beta variables (or even both alpha/beta) may be equal to 0,
842 which means than function F(x) is non-singular at A/B. Anyway (singular at
843 bounds or not), function F(x) is supposed to be continuous on (A,B).
844 
845 Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
846 is calculated with accuracy close to the machine precision.
847 
848 INPUT PARAMETERS:
849  A, B - interval boundaries (A<B, A=B or A>B)
850  Alpha - power-law coefficient of the F(x) at A,
851  Alpha>-1
852  Beta - power-law coefficient of the F(x) at B,
853  Beta>-1
854 
855 OUTPUT PARAMETERS
856  State - structure which stores algorithm state
857 
858 SEE ALSO
859  AutoGKSmooth, AutoGKSmoothW, AutoGKResults.
860 
861 
862  -- ALGLIB --
863  Copyright 06.05.2009 by Bochkanov Sergey
864 *************************************************************************/
865 void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state)
866 {
867  alglib_impl::ae_state _alglib_env_state;
868  alglib_impl::ae_state_init(&_alglib_env_state);
869  try
870  {
871  alglib_impl::autogksingular(a, b, alpha, beta, const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
872  alglib_impl::ae_state_clear(&_alglib_env_state);
873  return;
874  }
876  {
877  throw ap_error(_alglib_env_state.error_msg);
878  }
879 }
880 
881 /*************************************************************************
882 This function provides reverse communication interface
883 Reverse communication interface is not documented or recommended to use.
884 See below for functions which provide better documented API
885 *************************************************************************/
886 bool autogkiteration(const autogkstate &state)
887 {
888  alglib_impl::ae_state _alglib_env_state;
889  alglib_impl::ae_state_init(&_alglib_env_state);
890  try
891  {
892  ae_bool result = alglib_impl::autogkiteration(const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &_alglib_env_state);
893  alglib_impl::ae_state_clear(&_alglib_env_state);
894  return *(reinterpret_cast<bool*>(&result));
895  }
897  {
898  throw ap_error(_alglib_env_state.error_msg);
899  }
900 }
901 
902 
904  void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr),
905  void *ptr){
906  alglib_impl::ae_state _alglib_env_state;
907  if( func==NULL )
908  throw ap_error("ALGLIB: error in 'autogkintegrate()' (func is NULL)");
909  alglib_impl::ae_state_init(&_alglib_env_state);
910  try
911  {
912  while( alglib_impl::autogkiteration(state.c_ptr(), &_alglib_env_state) )
913  {
914  if( state.needf )
915  {
916  func(state.x, state.xminusa, state.bminusx, state.f, ptr);
917  continue;
918  }
919  throw ap_error("ALGLIB: unexpected error in 'autogkintegrate()'");
920  }
921  alglib_impl::ae_state_clear(&_alglib_env_state);
922  }
924  {
925  throw ap_error(_alglib_env_state.error_msg);
926  }
927 }
928 
929 
930 
931 /*************************************************************************
932 Adaptive integration results
933 
934 Called after AutoGKIteration returned False.
935 
936 Input parameters:
937  State - algorithm state (used by AutoGKIteration).
938 
939 Output parameters:
940  V - integral(f(x)dx,a,b)
941  Rep - optimization report (see AutoGKReport description)
942 
943  -- ALGLIB --
944  Copyright 14.11.2007 by Bochkanov Sergey
945 *************************************************************************/
946 void autogkresults(const autogkstate &state, double &v, autogkreport &rep)
947 {
948  alglib_impl::ae_state _alglib_env_state;
949  alglib_impl::ae_state_init(&_alglib_env_state);
950  try
951  {
952  alglib_impl::autogkresults(const_cast<alglib_impl::autogkstate*>(state.c_ptr()), &v, const_cast<alglib_impl::autogkreport*>(rep.c_ptr()), &_alglib_env_state);
953  alglib_impl::ae_state_clear(&_alglib_env_state);
954  return;
955  }
957  {
958  throw ap_error(_alglib_env_state.error_msg);
959  }
960 }
961 }
962 
964 //
965 // THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE
966 //
968 namespace alglib_impl
969 {
970 
971 
972 
973 
974 static ae_int_t autogk_maxsubintervals = 10000;
975 static void autogk_autogkinternalprepare(double a,
976  double b,
977  double eps,
978  double xwidth,
979  autogkinternalstate* state,
980  ae_state *_state);
981 static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state,
982  ae_state *_state);
983 static void autogk_mheappop(/* Real */ ae_matrix* heap,
984  ae_int_t heapsize,
985  ae_int_t heapwidth,
986  ae_state *_state);
987 static void autogk_mheappush(/* Real */ ae_matrix* heap,
988  ae_int_t heapsize,
989  ae_int_t heapwidth,
990  ae_state *_state);
991 static void autogk_mheapresize(/* Real */ ae_matrix* heap,
992  ae_int_t* heapsize,
993  ae_int_t newheapsize,
994  ae_int_t heapwidth,
995  ae_state *_state);
996 
997 
998 
999 
1000 
1001 /*************************************************************************
1002 Computation of nodes and weights for a Gauss quadrature formula
1003 
1004 The algorithm generates the N-point Gauss quadrature formula with weight
1005 function given by coefficients alpha and beta of a recurrence relation
1006 which generates a system of orthogonal polynomials:
1007 
1008 P-1(x) = 0
1009 P0(x) = 1
1010 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
1011 
1012 and zeroth moment Mu0
1013 
1014 Mu0 = integral(W(x)dx,a,b)
1015 
1016 INPUT PARAMETERS:
1017  Alpha – array[0..N-1], alpha coefficients
1018  Beta – array[0..N-1], beta coefficients
1019  Zero-indexed element is not used and may be arbitrary.
1020  Beta[I]>0.
1021  Mu0 – zeroth moment of the weight function.
1022  N – number of nodes of the quadrature formula, N>=1
1023 
1024 OUTPUT PARAMETERS:
1025  Info - error code:
1026  * -3 internal eigenproblem solver hasn't converged
1027  * -2 Beta[i]<=0
1028  * -1 incorrect N was passed
1029  * 1 OK
1030  X - array[0..N-1] - array of quadrature nodes,
1031  in ascending order.
1032  W - array[0..N-1] - array of quadrature weights.
1033 
1034  -- ALGLIB --
1035  Copyright 2005-2009 by Bochkanov Sergey
1036 *************************************************************************/
1037 void gqgeneraterec(/* Real */ ae_vector* alpha,
1038  /* Real */ ae_vector* beta,
1039  double mu0,
1040  ae_int_t n,
1041  ae_int_t* info,
1042  /* Real */ ae_vector* x,
1043  /* Real */ ae_vector* w,
1044  ae_state *_state)
1045 {
1046  ae_frame _frame_block;
1047  ae_int_t i;
1048  ae_vector d;
1049  ae_vector e;
1050  ae_matrix z;
1051 
1052  ae_frame_make(_state, &_frame_block);
1053  *info = 0;
1054  ae_vector_clear(x);
1055  ae_vector_clear(w);
1056  ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
1057  ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
1058  ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
1059 
1060  if( n<1 )
1061  {
1062  *info = -1;
1063  ae_frame_leave(_state);
1064  return;
1065  }
1066  *info = 1;
1067 
1068  /*
1069  * Initialize
1070  */
1071  ae_vector_set_length(&d, n, _state);
1072  ae_vector_set_length(&e, n, _state);
1073  for(i=1; i<=n-1; i++)
1074  {
1075  d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
1076  if( ae_fp_less_eq(beta->ptr.p_double[i],0) )
1077  {
1078  *info = -2;
1079  ae_frame_leave(_state);
1080  return;
1081  }
1082  e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
1083  }
1084  d.ptr.p_double[n-1] = alpha->ptr.p_double[n-1];
1085 
1086  /*
1087  * EVD
1088  */
1089  if( !smatrixtdevd(&d, &e, n, 3, &z, _state) )
1090  {
1091  *info = -3;
1092  ae_frame_leave(_state);
1093  return;
1094  }
1095 
1096  /*
1097  * Generate
1098  */
1099  ae_vector_set_length(x, n, _state);
1100  ae_vector_set_length(w, n, _state);
1101  for(i=1; i<=n; i++)
1102  {
1103  x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
1104  w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
1105  }
1106  ae_frame_leave(_state);
1107 }
1108 
1109 
1110 /*************************************************************************
1111 Computation of nodes and weights for a Gauss-Lobatto quadrature formula
1112 
1113 The algorithm generates the N-point Gauss-Lobatto quadrature formula with
1114 weight function given by coefficients alpha and beta of a recurrence which
1115 generates a system of orthogonal polynomials.
1116 
1117 P-1(x) = 0
1118 P0(x) = 1
1119 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
1120 
1121 and zeroth moment Mu0
1122 
1123 Mu0 = integral(W(x)dx,a,b)
1124 
1125 INPUT PARAMETERS:
1126  Alpha – array[0..N-2], alpha coefficients
1127  Beta – array[0..N-2], beta coefficients.
1128  Zero-indexed element is not used, may be arbitrary.
1129  Beta[I]>0
1130  Mu0 – zeroth moment of the weighting function.
1131  A – left boundary of the integration interval.
1132  B – right boundary of the integration interval.
1133  N – number of nodes of the quadrature formula, N>=3
1134  (including the left and right boundary nodes).
1135 
1136 OUTPUT PARAMETERS:
1137  Info - error code:
1138  * -3 internal eigenproblem solver hasn't converged
1139  * -2 Beta[i]<=0
1140  * -1 incorrect N was passed
1141  * 1 OK
1142  X - array[0..N-1] - array of quadrature nodes,
1143  in ascending order.
1144  W - array[0..N-1] - array of quadrature weights.
1145 
1146  -- ALGLIB --
1147  Copyright 2005-2009 by Bochkanov Sergey
1148 *************************************************************************/
1149 void gqgenerategausslobattorec(/* Real */ ae_vector* alpha,
1150  /* Real */ ae_vector* beta,
1151  double mu0,
1152  double a,
1153  double b,
1154  ae_int_t n,
1155  ae_int_t* info,
1156  /* Real */ ae_vector* x,
1157  /* Real */ ae_vector* w,
1158  ae_state *_state)
1159 {
1160  ae_frame _frame_block;
1161  ae_vector _alpha;
1162  ae_vector _beta;
1163  ae_int_t i;
1164  ae_vector d;
1165  ae_vector e;
1166  ae_matrix z;
1167  double pim1a;
1168  double pia;
1169  double pim1b;
1170  double pib;
1171  double t;
1172  double a11;
1173  double a12;
1174  double a21;
1175  double a22;
1176  double b1;
1177  double b2;
1178  double alph;
1179  double bet;
1180 
1181  ae_frame_make(_state, &_frame_block);
1182  ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
1183  alpha = &_alpha;
1184  ae_vector_init_copy(&_beta, beta, _state, ae_true);
1185  beta = &_beta;
1186  *info = 0;
1187  ae_vector_clear(x);
1188  ae_vector_clear(w);
1189  ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
1190  ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
1191  ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
1192 
1193  if( n<=2 )
1194  {
1195  *info = -1;
1196  ae_frame_leave(_state);
1197  return;
1198  }
1199  *info = 1;
1200 
1201  /*
1202  * Initialize, D[1:N+1], E[1:N]
1203  */
1204  n = n-2;
1205  ae_vector_set_length(&d, n+2, _state);
1206  ae_vector_set_length(&e, n+1, _state);
1207  for(i=1; i<=n+1; i++)
1208  {
1209  d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
1210  }
1211  for(i=1; i<=n; i++)
1212  {
1213  if( ae_fp_less_eq(beta->ptr.p_double[i],0) )
1214  {
1215  *info = -2;
1216  ae_frame_leave(_state);
1217  return;
1218  }
1219  e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
1220  }
1221 
1222  /*
1223  * Caclulate Pn(a), Pn+1(a), Pn(b), Pn+1(b)
1224  */
1225  beta->ptr.p_double[0] = 0;
1226  pim1a = 0;
1227  pia = 1;
1228  pim1b = 0;
1229  pib = 1;
1230  for(i=1; i<=n+1; i++)
1231  {
1232 
1233  /*
1234  * Pi(a)
1235  */
1236  t = (a-alpha->ptr.p_double[i-1])*pia-beta->ptr.p_double[i-1]*pim1a;
1237  pim1a = pia;
1238  pia = t;
1239 
1240  /*
1241  * Pi(b)
1242  */
1243  t = (b-alpha->ptr.p_double[i-1])*pib-beta->ptr.p_double[i-1]*pim1b;
1244  pim1b = pib;
1245  pib = t;
1246  }
1247 
1248  /*
1249  * Calculate alpha'(n+1), beta'(n+1)
1250  */
1251  a11 = pia;
1252  a12 = pim1a;
1253  a21 = pib;
1254  a22 = pim1b;
1255  b1 = a*pia;
1256  b2 = b*pib;
1257  if( ae_fp_greater(ae_fabs(a11, _state),ae_fabs(a21, _state)) )
1258  {
1259  a22 = a22-a12*a21/a11;
1260  b2 = b2-b1*a21/a11;
1261  bet = b2/a22;
1262  alph = (b1-bet*a12)/a11;
1263  }
1264  else
1265  {
1266  a12 = a12-a22*a11/a21;
1267  b1 = b1-b2*a11/a21;
1268  bet = b1/a12;
1269  alph = (b2-bet*a22)/a21;
1270  }
1271  if( ae_fp_less(bet,0) )
1272  {
1273  *info = -3;
1274  ae_frame_leave(_state);
1275  return;
1276  }
1277  d.ptr.p_double[n+1] = alph;
1278  e.ptr.p_double[n] = ae_sqrt(bet, _state);
1279 
1280  /*
1281  * EVD
1282  */
1283  if( !smatrixtdevd(&d, &e, n+2, 3, &z, _state) )
1284  {
1285  *info = -3;
1286  ae_frame_leave(_state);
1287  return;
1288  }
1289 
1290  /*
1291  * Generate
1292  */
1293  ae_vector_set_length(x, n+2, _state);
1294  ae_vector_set_length(w, n+2, _state);
1295  for(i=1; i<=n+2; i++)
1296  {
1297  x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
1298  w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
1299  }
1300  ae_frame_leave(_state);
1301 }
1302 
1303 
1304 /*************************************************************************
1305 Computation of nodes and weights for a Gauss-Radau quadrature formula
1306 
1307 The algorithm generates the N-point Gauss-Radau quadrature formula with
1308 weight function given by the coefficients alpha and beta of a recurrence
1309 which generates a system of orthogonal polynomials.
1310 
1311 P-1(x) = 0
1312 P0(x) = 1
1313 Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
1314 
1315 and zeroth moment Mu0
1316 
1317 Mu0 = integral(W(x)dx,a,b)
1318 
1319 INPUT PARAMETERS:
1320  Alpha – array[0..N-2], alpha coefficients.
1321  Beta – array[0..N-1], beta coefficients
1322  Zero-indexed element is not used.
1323  Beta[I]>0
1324  Mu0 – zeroth moment of the weighting function.
1325  A – left boundary of the integration interval.
1326  N – number of nodes of the quadrature formula, N>=2
1327  (including the left boundary node).
1328 
1329 OUTPUT PARAMETERS:
1330  Info - error code:
1331  * -3 internal eigenproblem solver hasn't converged
1332  * -2 Beta[i]<=0
1333  * -1 incorrect N was passed
1334  * 1 OK
1335  X - array[0..N-1] - array of quadrature nodes,
1336  in ascending order.
1337  W - array[0..N-1] - array of quadrature weights.
1338 
1339 
1340  -- ALGLIB --
1341  Copyright 2005-2009 by Bochkanov Sergey
1342 *************************************************************************/
1343 void gqgenerategaussradaurec(/* Real */ ae_vector* alpha,
1344  /* Real */ ae_vector* beta,
1345  double mu0,
1346  double a,
1347  ae_int_t n,
1348  ae_int_t* info,
1349  /* Real */ ae_vector* x,
1350  /* Real */ ae_vector* w,
1351  ae_state *_state)
1352 {
1353  ae_frame _frame_block;
1354  ae_vector _alpha;
1355  ae_vector _beta;
1356  ae_int_t i;
1357  ae_vector d;
1358  ae_vector e;
1359  ae_matrix z;
1360  double polim1;
1361  double poli;
1362  double t;
1363 
1364  ae_frame_make(_state, &_frame_block);
1365  ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
1366  alpha = &_alpha;
1367  ae_vector_init_copy(&_beta, beta, _state, ae_true);
1368  beta = &_beta;
1369  *info = 0;
1370  ae_vector_clear(x);
1371  ae_vector_clear(w);
1372  ae_vector_init(&d, 0, DT_REAL, _state, ae_true);
1373  ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
1374  ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true);
1375 
1376  if( n<2 )
1377  {
1378  *info = -1;
1379  ae_frame_leave(_state);
1380  return;
1381  }
1382  *info = 1;
1383 
1384  /*
1385  * Initialize, D[1:N], E[1:N]
1386  */
1387  n = n-1;
1388  ae_vector_set_length(&d, n+1, _state);
1389  ae_vector_set_length(&e, n, _state);
1390  for(i=1; i<=n; i++)
1391  {
1392  d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1];
1393  if( ae_fp_less_eq(beta->ptr.p_double[i],0) )
1394  {
1395  *info = -2;
1396  ae_frame_leave(_state);
1397  return;
1398  }
1399  e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state);
1400  }
1401 
1402  /*
1403  * Caclulate Pn(a), Pn-1(a), and D[N+1]
1404  */
1405  beta->ptr.p_double[0] = 0;
1406  polim1 = 0;
1407  poli = 1;
1408  for(i=1; i<=n; i++)
1409  {
1410  t = (a-alpha->ptr.p_double[i-1])*poli-beta->ptr.p_double[i-1]*polim1;
1411  polim1 = poli;
1412  poli = t;
1413  }
1414  d.ptr.p_double[n] = a-beta->ptr.p_double[n]*polim1/poli;
1415 
1416  /*
1417  * EVD
1418  */
1419  if( !smatrixtdevd(&d, &e, n+1, 3, &z, _state) )
1420  {
1421  *info = -3;
1422  ae_frame_leave(_state);
1423  return;
1424  }
1425 
1426  /*
1427  * Generate
1428  */
1429  ae_vector_set_length(x, n+1, _state);
1430  ae_vector_set_length(w, n+1, _state);
1431  for(i=1; i<=n+1; i++)
1432  {
1433  x->ptr.p_double[i-1] = d.ptr.p_double[i-1];
1434  w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state);
1435  }
1436  ae_frame_leave(_state);
1437 }
1438 
1439 
1440 /*************************************************************************
1441 Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N
1442 nodes.
1443 
1444 INPUT PARAMETERS:
1445  N - number of nodes, >=1
1446 
1447 OUTPUT PARAMETERS:
1448  Info - error code:
1449  * -4 an error was detected when calculating
1450  weights/nodes. N is too large to obtain
1451  weights/nodes with high enough accuracy.
1452  Try to use multiple precision version.
1453  * -3 internal eigenproblem solver hasn't converged
1454  * -1 incorrect N was passed
1455  * +1 OK
1456  X - array[0..N-1] - array of quadrature nodes,
1457  in ascending order.
1458  W - array[0..N-1] - array of quadrature weights.
1459 
1460 
1461  -- ALGLIB --
1462  Copyright 12.05.2009 by Bochkanov Sergey
1463 *************************************************************************/
1465  ae_int_t* info,
1466  /* Real */ ae_vector* x,
1467  /* Real */ ae_vector* w,
1468  ae_state *_state)
1469 {
1470  ae_frame _frame_block;
1471  ae_vector alpha;
1472  ae_vector beta;
1473  ae_int_t i;
1474 
1475  ae_frame_make(_state, &_frame_block);
1476  *info = 0;
1477  ae_vector_clear(x);
1478  ae_vector_clear(w);
1479  ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true);
1480  ae_vector_init(&beta, 0, DT_REAL, _state, ae_true);
1481 
1482  if( n<1 )
1483  {
1484  *info = -1;
1485  ae_frame_leave(_state);
1486  return;
1487  }
1488  ae_vector_set_length(&alpha, n, _state);
1489  ae_vector_set_length(&beta, n, _state);
1490  for(i=0; i<=n-1; i++)
1491  {
1492  alpha.ptr.p_double[i] = 0;
1493  }
1494  beta.ptr.p_double[0] = 2;
1495  for(i=1; i<=n-1; i++)
1496  {
1497  beta.ptr.p_double[i] = 1/(4-1/ae_sqr(i, _state));
1498  }
1499  gqgeneraterec(&alpha, &beta, beta.ptr.p_double[0], n, info, x, w, _state);
1500 
1501  /*
1502  * test basic properties to detect errors
1503  */
1504  if( *info>0 )
1505  {
1506  if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) )
1507  {
1508  *info = -4;
1509  }
1510  for(i=0; i<=n-2; i++)
1511  {
1512  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
1513  {
1514  *info = -4;
1515  }
1516  }
1517  }
1518  ae_frame_leave(_state);
1519 }
1520 
1521 
1522 /*************************************************************************
1523 Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight
1524 function W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
1525 
1526 INPUT PARAMETERS:
1527  N - number of nodes, >=1
1528  Alpha - power-law coefficient, Alpha>-1
1529  Beta - power-law coefficient, Beta>-1
1530 
1531 OUTPUT PARAMETERS:
1532  Info - error code:
1533  * -4 an error was detected when calculating
1534  weights/nodes. Alpha or Beta are too close
1535  to -1 to obtain weights/nodes with high enough
1536  accuracy, or, may be, N is too large. Try to
1537  use multiple precision version.
1538  * -3 internal eigenproblem solver hasn't converged
1539  * -1 incorrect N/Alpha/Beta was passed
1540  * +1 OK
1541  X - array[0..N-1] - array of quadrature nodes,
1542  in ascending order.
1543  W - array[0..N-1] - array of quadrature weights.
1544 
1545 
1546  -- ALGLIB --
1547  Copyright 12.05.2009 by Bochkanov Sergey
1548 *************************************************************************/
1550  double alpha,
1551  double beta,
1552  ae_int_t* info,
1553  /* Real */ ae_vector* x,
1554  /* Real */ ae_vector* w,
1555  ae_state *_state)
1556 {
1557  ae_frame _frame_block;
1558  ae_vector a;
1559  ae_vector b;
1560  double alpha2;
1561  double beta2;
1562  double apb;
1563  double t;
1564  ae_int_t i;
1565  double s;
1566 
1567  ae_frame_make(_state, &_frame_block);
1568  *info = 0;
1569  ae_vector_clear(x);
1570  ae_vector_clear(w);
1571  ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
1572  ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
1573 
1574  if( (n<1||ae_fp_less_eq(alpha,-1))||ae_fp_less_eq(beta,-1) )
1575  {
1576  *info = -1;
1577  ae_frame_leave(_state);
1578  return;
1579  }
1580  ae_vector_set_length(&a, n, _state);
1581  ae_vector_set_length(&b, n, _state);
1582  apb = alpha+beta;
1583  a.ptr.p_double[0] = (beta-alpha)/(apb+2);
1584  t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state);
1585  if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) )
1586  {
1587  *info = -4;
1588  ae_frame_leave(_state);
1589  return;
1590  }
1591  b.ptr.p_double[0] = ae_exp(t, _state);
1592  if( n>1 )
1593  {
1594  alpha2 = ae_sqr(alpha, _state);
1595  beta2 = ae_sqr(beta, _state);
1596  a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4));
1597  b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state));
1598  for(i=2; i<=n-1; i++)
1599  {
1600  a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i));
1601  b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state));
1602  }
1603  }
1604  gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
1605 
1606  /*
1607  * test basic properties to detect errors
1608  */
1609  if( *info>0 )
1610  {
1611  if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) )
1612  {
1613  *info = -4;
1614  }
1615  for(i=0; i<=n-2; i++)
1616  {
1617  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
1618  {
1619  *info = -4;
1620  }
1621  }
1622  }
1623  ae_frame_leave(_state);
1624 }
1625 
1626 
1627 /*************************************************************************
1628 Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with
1629 weight function W(x)=Power(x,Alpha)*Exp(-x)
1630 
1631 INPUT PARAMETERS:
1632  N - number of nodes, >=1
1633  Alpha - power-law coefficient, Alpha>-1
1634 
1635 OUTPUT PARAMETERS:
1636  Info - error code:
1637  * -4 an error was detected when calculating
1638  weights/nodes. Alpha is too close to -1 to
1639  obtain weights/nodes with high enough accuracy
1640  or, may be, N is too large. Try to use
1641  multiple precision version.
1642  * -3 internal eigenproblem solver hasn't converged
1643  * -1 incorrect N/Alpha was passed
1644  * +1 OK
1645  X - array[0..N-1] - array of quadrature nodes,
1646  in ascending order.
1647  W - array[0..N-1] - array of quadrature weights.
1648 
1649 
1650  -- ALGLIB --
1651  Copyright 12.05.2009 by Bochkanov Sergey
1652 *************************************************************************/
1654  double alpha,
1655  ae_int_t* info,
1656  /* Real */ ae_vector* x,
1657  /* Real */ ae_vector* w,
1658  ae_state *_state)
1659 {
1660  ae_frame _frame_block;
1661  ae_vector a;
1662  ae_vector b;
1663  double t;
1664  ae_int_t i;
1665  double s;
1666 
1667  ae_frame_make(_state, &_frame_block);
1668  *info = 0;
1669  ae_vector_clear(x);
1670  ae_vector_clear(w);
1671  ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
1672  ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
1673 
1674  if( n<1||ae_fp_less_eq(alpha,-1) )
1675  {
1676  *info = -1;
1677  ae_frame_leave(_state);
1678  return;
1679  }
1680  ae_vector_set_length(&a, n, _state);
1681  ae_vector_set_length(&b, n, _state);
1682  a.ptr.p_double[0] = alpha+1;
1683  t = lngamma(alpha+1, &s, _state);
1684  if( ae_fp_greater_eq(t,ae_log(ae_maxrealnumber, _state)) )
1685  {
1686  *info = -4;
1687  ae_frame_leave(_state);
1688  return;
1689  }
1690  b.ptr.p_double[0] = ae_exp(t, _state);
1691  if( n>1 )
1692  {
1693  for(i=1; i<=n-1; i++)
1694  {
1695  a.ptr.p_double[i] = 2*i+alpha+1;
1696  b.ptr.p_double[i] = i*(i+alpha);
1697  }
1698  }
1699  gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
1700 
1701  /*
1702  * test basic properties to detect errors
1703  */
1704  if( *info>0 )
1705  {
1706  if( ae_fp_less(x->ptr.p_double[0],0) )
1707  {
1708  *info = -4;
1709  }
1710  for(i=0; i<=n-2; i++)
1711  {
1712  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
1713  {
1714  *info = -4;
1715  }
1716  }
1717  }
1718  ae_frame_leave(_state);
1719 }
1720 
1721 
1722 /*************************************************************************
1723 Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with
1724 weight function W(x)=Exp(-x*x)
1725 
1726 INPUT PARAMETERS:
1727  N - number of nodes, >=1
1728 
1729 OUTPUT PARAMETERS:
1730  Info - error code:
1731  * -4 an error was detected when calculating
1732  weights/nodes. May be, N is too large. Try to
1733  use multiple precision version.
1734  * -3 internal eigenproblem solver hasn't converged
1735  * -1 incorrect N/Alpha was passed
1736  * +1 OK
1737  X - array[0..N-1] - array of quadrature nodes,
1738  in ascending order.
1739  W - array[0..N-1] - array of quadrature weights.
1740 
1741 
1742  -- ALGLIB --
1743  Copyright 12.05.2009 by Bochkanov Sergey
1744 *************************************************************************/
1746  ae_int_t* info,
1747  /* Real */ ae_vector* x,
1748  /* Real */ ae_vector* w,
1749  ae_state *_state)
1750 {
1751  ae_frame _frame_block;
1752  ae_vector a;
1753  ae_vector b;
1754  ae_int_t i;
1755 
1756  ae_frame_make(_state, &_frame_block);
1757  *info = 0;
1758  ae_vector_clear(x);
1759  ae_vector_clear(w);
1760  ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
1761  ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
1762 
1763  if( n<1 )
1764  {
1765  *info = -1;
1766  ae_frame_leave(_state);
1767  return;
1768  }
1769  ae_vector_set_length(&a, n, _state);
1770  ae_vector_set_length(&b, n, _state);
1771  for(i=0; i<=n-1; i++)
1772  {
1773  a.ptr.p_double[i] = 0;
1774  }
1775  b.ptr.p_double[0] = ae_sqrt(4*ae_atan(1, _state), _state);
1776  if( n>1 )
1777  {
1778  for(i=1; i<=n-1; i++)
1779  {
1780  b.ptr.p_double[i] = 0.5*i;
1781  }
1782  }
1783  gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state);
1784 
1785  /*
1786  * test basic properties to detect errors
1787  */
1788  if( *info>0 )
1789  {
1790  for(i=0; i<=n-2; i++)
1791  {
1792  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
1793  {
1794  *info = -4;
1795  }
1796  }
1797  }
1798  ae_frame_leave(_state);
1799 }
1800 
1801 
1802 
1803 
1804 /*************************************************************************
1805 Computation of nodes and weights of a Gauss-Kronrod quadrature formula
1806 
1807 The algorithm generates the N-point Gauss-Kronrod quadrature formula with
1808 weight function given by coefficients alpha and beta of a recurrence
1809 relation which generates a system of orthogonal polynomials:
1810 
1811  P-1(x) = 0
1812  P0(x) = 1
1813  Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x)
1814 
1815 and zero moment Mu0
1816 
1817  Mu0 = integral(W(x)dx,a,b)
1818 
1819 
1820 INPUT PARAMETERS:
1821  Alpha – alpha coefficients, array[0..floor(3*K/2)].
1822  Beta – beta coefficients, array[0..ceil(3*K/2)].
1823  Beta[0] is not used and may be arbitrary.
1824  Beta[I]>0.
1825  Mu0 – zeroth moment of the weight function.
1826  N – number of nodes of the Gauss-Kronrod quadrature formula,
1827  N >= 3,
1828  N = 2*K+1.
1829 
1830 OUTPUT PARAMETERS:
1831  Info - error code:
1832  * -5 no real and positive Gauss-Kronrod formula can
1833  be created for such a weight function with a
1834  given number of nodes.
1835  * -4 N is too large, task may be ill conditioned -
1836  x[i]=x[i+1] found.
1837  * -3 internal eigenproblem solver hasn't converged
1838  * -2 Beta[i]<=0
1839  * -1 incorrect N was passed
1840  * +1 OK
1841  X - array[0..N-1] - array of quadrature nodes,
1842  in ascending order.
1843  WKronrod - array[0..N-1] - Kronrod weights
1844  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
1845  corresponding to extended Kronrod nodes).
1846 
1847  -- ALGLIB --
1848  Copyright 08.05.2009 by Bochkanov Sergey
1849 *************************************************************************/
1850 void gkqgeneraterec(/* Real */ ae_vector* alpha,
1851  /* Real */ ae_vector* beta,
1852  double mu0,
1853  ae_int_t n,
1854  ae_int_t* info,
1855  /* Real */ ae_vector* x,
1856  /* Real */ ae_vector* wkronrod,
1857  /* Real */ ae_vector* wgauss,
1858  ae_state *_state)
1859 {
1860  ae_frame _frame_block;
1861  ae_vector _alpha;
1862  ae_vector _beta;
1863  ae_vector ta;
1864  ae_int_t i;
1865  ae_int_t j;
1866  ae_vector t;
1867  ae_vector s;
1868  ae_int_t wlen;
1869  ae_int_t woffs;
1870  double u;
1871  ae_int_t m;
1872  ae_int_t l;
1873  ae_int_t k;
1874  ae_vector xgtmp;
1875  ae_vector wgtmp;
1876 
1877  ae_frame_make(_state, &_frame_block);
1878  ae_vector_init_copy(&_alpha, alpha, _state, ae_true);
1879  alpha = &_alpha;
1880  ae_vector_init_copy(&_beta, beta, _state, ae_true);
1881  beta = &_beta;
1882  *info = 0;
1883  ae_vector_clear(x);
1884  ae_vector_clear(wkronrod);
1885  ae_vector_clear(wgauss);
1886  ae_vector_init(&ta, 0, DT_REAL, _state, ae_true);
1887  ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
1888  ae_vector_init(&s, 0, DT_REAL, _state, ae_true);
1889  ae_vector_init(&xgtmp, 0, DT_REAL, _state, ae_true);
1890  ae_vector_init(&wgtmp, 0, DT_REAL, _state, ae_true);
1891 
1892  if( n%2!=1||n<3 )
1893  {
1894  *info = -1;
1895  ae_frame_leave(_state);
1896  return;
1897  }
1898  for(i=0; i<=ae_iceil((double)(3*(n/2))/(double)2, _state); i++)
1899  {
1900  if( ae_fp_less_eq(beta->ptr.p_double[i],0) )
1901  {
1902  *info = -2;
1903  ae_frame_leave(_state);
1904  return;
1905  }
1906  }
1907  *info = 1;
1908 
1909  /*
1910  * from external conventions about N/Beta/Mu0 to internal
1911  */
1912  n = n/2;
1913  beta->ptr.p_double[0] = mu0;
1914 
1915  /*
1916  * Calculate Gauss nodes/weights, save them for later processing
1917  */
1918  gqgeneraterec(alpha, beta, mu0, n, info, &xgtmp, &wgtmp, _state);
1919  if( *info<0 )
1920  {
1921  ae_frame_leave(_state);
1922  return;
1923  }
1924 
1925  /*
1926  * Resize:
1927  * * A from 0..floor(3*n/2) to 0..2*n
1928  * * B from 0..ceil(3*n/2) to 0..2*n
1929  */
1930  ae_vector_set_length(&ta, ae_ifloor((double)(3*n)/(double)2, _state)+1, _state);
1931  ae_v_move(&ta.ptr.p_double[0], 1, &alpha->ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state)));
1932  ae_vector_set_length(alpha, 2*n+1, _state);
1933  ae_v_move(&alpha->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state)));
1934  for(i=ae_ifloor((double)(3*n)/(double)2, _state)+1; i<=2*n; i++)
1935  {
1936  alpha->ptr.p_double[i] = 0;
1937  }
1938  ae_vector_set_length(&ta, ae_iceil((double)(3*n)/(double)2, _state)+1, _state);
1939  ae_v_move(&ta.ptr.p_double[0], 1, &beta->ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state)));
1940  ae_vector_set_length(beta, 2*n+1, _state);
1941  ae_v_move(&beta->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state)));
1942  for(i=ae_iceil((double)(3*n)/(double)2, _state)+1; i<=2*n; i++)
1943  {
1944  beta->ptr.p_double[i] = 0;
1945  }
1946 
1947  /*
1948  * Initialize T, S
1949  */
1950  wlen = 2+n/2;
1951  ae_vector_set_length(&t, wlen, _state);
1952  ae_vector_set_length(&s, wlen, _state);
1953  ae_vector_set_length(&ta, wlen, _state);
1954  woffs = 1;
1955  for(i=0; i<=wlen-1; i++)
1956  {
1957  t.ptr.p_double[i] = 0;
1958  s.ptr.p_double[i] = 0;
1959  }
1960 
1961  /*
1962  * Algorithm from Dirk P. Laurie, "Calculation of Gauss-Kronrod quadrature rules", 1997.
1963  */
1964  t.ptr.p_double[woffs+0] = beta->ptr.p_double[n+1];
1965  for(m=0; m<=n-2; m++)
1966  {
1967  u = 0;
1968  for(k=(m+1)/2; k>=0; k--)
1969  {
1970  l = m-k;
1971  u = u+(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+k]+beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+k-1]-beta->ptr.p_double[l]*s.ptr.p_double[woffs+k];
1972  s.ptr.p_double[woffs+k] = u;
1973  }
1974  ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
1975  ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
1976  ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
1977  }
1978  for(j=n/2; j>=0; j--)
1979  {
1980  s.ptr.p_double[woffs+j] = s.ptr.p_double[woffs+j-1];
1981  }
1982  for(m=n-1; m<=2*n-3; m++)
1983  {
1984  u = 0;
1985  for(k=m+1-n; k<=(m-1)/2; k++)
1986  {
1987  l = m-k;
1988  j = n-1-l;
1989  u = u-(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j]+beta->ptr.p_double[l]*s.ptr.p_double[woffs+j+1];
1990  s.ptr.p_double[woffs+j] = u;
1991  }
1992  if( m%2==0 )
1993  {
1994  k = m/2;
1995  alpha->ptr.p_double[k+n+1] = alpha->ptr.p_double[k]+(s.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j+1])/t.ptr.p_double[woffs+j+1];
1996  }
1997  else
1998  {
1999  k = (m+1)/2;
2000  beta->ptr.p_double[k+n+1] = s.ptr.p_double[woffs+j]/s.ptr.p_double[woffs+j+1];
2001  }
2002  ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
2003  ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
2004  ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1));
2005  }
2006  alpha->ptr.p_double[2*n] = alpha->ptr.p_double[n-1]-beta->ptr.p_double[2*n]*s.ptr.p_double[woffs+0]/t.ptr.p_double[woffs+0];
2007 
2008  /*
2009  * calculation of Kronrod nodes and weights, unpacking of Gauss weights
2010  */
2011  gqgeneraterec(alpha, beta, mu0, 2*n+1, info, x, wkronrod, _state);
2012  if( *info==-2 )
2013  {
2014  *info = -5;
2015  }
2016  if( *info<0 )
2017  {
2018  ae_frame_leave(_state);
2019  return;
2020  }
2021  for(i=0; i<=2*n-1; i++)
2022  {
2023  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
2024  {
2025  *info = -4;
2026  }
2027  }
2028  if( *info<0 )
2029  {
2030  ae_frame_leave(_state);
2031  return;
2032  }
2033  ae_vector_set_length(wgauss, 2*n+1, _state);
2034  for(i=0; i<=2*n; i++)
2035  {
2036  wgauss->ptr.p_double[i] = 0;
2037  }
2038  for(i=0; i<=n-1; i++)
2039  {
2040  wgauss->ptr.p_double[2*i+1] = wgtmp.ptr.p_double[i];
2041  }
2042  ae_frame_leave(_state);
2043 }
2044 
2045 
2046 /*************************************************************************
2047 Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre
2048 quadrature with N points.
2049 
2050 GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is
2051 used depending on machine precision and number of nodes.
2052 
2053 INPUT PARAMETERS:
2054  N - number of Kronrod nodes, must be odd number, >=3.
2055 
2056 OUTPUT PARAMETERS:
2057  Info - error code:
2058  * -4 an error was detected when calculating
2059  weights/nodes. N is too large to obtain
2060  weights/nodes with high enough accuracy.
2061  Try to use multiple precision version.
2062  * -3 internal eigenproblem solver hasn't converged
2063  * -1 incorrect N was passed
2064  * +1 OK
2065  X - array[0..N-1] - array of quadrature nodes, ordered in
2066  ascending order.
2067  WKronrod - array[0..N-1] - Kronrod weights
2068  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
2069  corresponding to extended Kronrod nodes).
2070 
2071 
2072  -- ALGLIB --
2073  Copyright 12.05.2009 by Bochkanov Sergey
2074 *************************************************************************/
2076  ae_int_t* info,
2077  /* Real */ ae_vector* x,
2078  /* Real */ ae_vector* wkronrod,
2079  /* Real */ ae_vector* wgauss,
2080  ae_state *_state)
2081 {
2082  double eps;
2083 
2084  *info = 0;
2085  ae_vector_clear(x);
2086  ae_vector_clear(wkronrod);
2087  ae_vector_clear(wgauss);
2088 
2089  if( ae_fp_greater(ae_machineepsilon,1.0E-32)&&(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61) )
2090  {
2091  *info = 1;
2092  gkqlegendretbl(n, x, wkronrod, wgauss, &eps, _state);
2093  }
2094  else
2095  {
2096  gkqlegendrecalc(n, info, x, wkronrod, wgauss, _state);
2097  }
2098 }
2099 
2100 
2101 /*************************************************************************
2102 Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi
2103 quadrature on [-1,1] with weight function
2104 
2105  W(x)=Power(1-x,Alpha)*Power(1+x,Beta).
2106 
2107 INPUT PARAMETERS:
2108  N - number of Kronrod nodes, must be odd number, >=3.
2109  Alpha - power-law coefficient, Alpha>-1
2110  Beta - power-law coefficient, Beta>-1
2111 
2112 OUTPUT PARAMETERS:
2113  Info - error code:
2114  * -5 no real and positive Gauss-Kronrod formula can
2115  be created for such a weight function with a
2116  given number of nodes.
2117  * -4 an error was detected when calculating
2118  weights/nodes. Alpha or Beta are too close
2119  to -1 to obtain weights/nodes with high enough
2120  accuracy, or, may be, N is too large. Try to
2121  use multiple precision version.
2122  * -3 internal eigenproblem solver hasn't converged
2123  * -1 incorrect N was passed
2124  * +1 OK
2125  * +2 OK, but quadrature rule have exterior nodes,
2126  x[0]<-1 or x[n-1]>+1
2127  X - array[0..N-1] - array of quadrature nodes, ordered in
2128  ascending order.
2129  WKronrod - array[0..N-1] - Kronrod weights
2130  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
2131  corresponding to extended Kronrod nodes).
2132 
2133 
2134  -- ALGLIB --
2135  Copyright 12.05.2009 by Bochkanov Sergey
2136 *************************************************************************/
2138  double alpha,
2139  double beta,
2140  ae_int_t* info,
2141  /* Real */ ae_vector* x,
2142  /* Real */ ae_vector* wkronrod,
2143  /* Real */ ae_vector* wgauss,
2144  ae_state *_state)
2145 {
2146  ae_frame _frame_block;
2147  ae_int_t clen;
2148  ae_vector a;
2149  ae_vector b;
2150  double alpha2;
2151  double beta2;
2152  double apb;
2153  double t;
2154  ae_int_t i;
2155  double s;
2156 
2157  ae_frame_make(_state, &_frame_block);
2158  *info = 0;
2159  ae_vector_clear(x);
2160  ae_vector_clear(wkronrod);
2161  ae_vector_clear(wgauss);
2162  ae_vector_init(&a, 0, DT_REAL, _state, ae_true);
2163  ae_vector_init(&b, 0, DT_REAL, _state, ae_true);
2164 
2165  if( n%2!=1||n<3 )
2166  {
2167  *info = -1;
2168  ae_frame_leave(_state);
2169  return;
2170  }
2171  if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) )
2172  {
2173  *info = -1;
2174  ae_frame_leave(_state);
2175  return;
2176  }
2177  clen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1;
2178  ae_vector_set_length(&a, clen, _state);
2179  ae_vector_set_length(&b, clen, _state);
2180  for(i=0; i<=clen-1; i++)
2181  {
2182  a.ptr.p_double[i] = 0;
2183  }
2184  apb = alpha+beta;
2185  a.ptr.p_double[0] = (beta-alpha)/(apb+2);
2186  t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state);
2187  if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) )
2188  {
2189  *info = -4;
2190  ae_frame_leave(_state);
2191  return;
2192  }
2193  b.ptr.p_double[0] = ae_exp(t, _state);
2194  if( clen>1 )
2195  {
2196  alpha2 = ae_sqr(alpha, _state);
2197  beta2 = ae_sqr(beta, _state);
2198  a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4));
2199  b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state));
2200  for(i=2; i<=clen-1; i++)
2201  {
2202  a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i));
2203  b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state));
2204  }
2205  }
2206  gkqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, wkronrod, wgauss, _state);
2207 
2208  /*
2209  * test basic properties to detect errors
2210  */
2211  if( *info>0 )
2212  {
2213  if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) )
2214  {
2215  *info = 2;
2216  }
2217  for(i=0; i<=n-2; i++)
2218  {
2219  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
2220  {
2221  *info = -4;
2222  }
2223  }
2224  }
2225  ae_frame_leave(_state);
2226 }
2227 
2228 
2229 /*************************************************************************
2230 Returns Gauss and Gauss-Kronrod nodes for quadrature with N points.
2231 
2232 Reduction to tridiagonal eigenproblem is used.
2233 
2234 INPUT PARAMETERS:
2235  N - number of Kronrod nodes, must be odd number, >=3.
2236 
2237 OUTPUT PARAMETERS:
2238  Info - error code:
2239  * -4 an error was detected when calculating
2240  weights/nodes. N is too large to obtain
2241  weights/nodes with high enough accuracy.
2242  Try to use multiple precision version.
2243  * -3 internal eigenproblem solver hasn't converged
2244  * -1 incorrect N was passed
2245  * +1 OK
2246  X - array[0..N-1] - array of quadrature nodes, ordered in
2247  ascending order.
2248  WKronrod - array[0..N-1] - Kronrod weights
2249  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
2250  corresponding to extended Kronrod nodes).
2251 
2252  -- ALGLIB --
2253  Copyright 12.05.2009 by Bochkanov Sergey
2254 *************************************************************************/
2256  ae_int_t* info,
2257  /* Real */ ae_vector* x,
2258  /* Real */ ae_vector* wkronrod,
2259  /* Real */ ae_vector* wgauss,
2260  ae_state *_state)
2261 {
2262  ae_frame _frame_block;
2263  ae_vector alpha;
2264  ae_vector beta;
2265  ae_int_t alen;
2266  ae_int_t blen;
2267  double mu0;
2268  ae_int_t k;
2269  ae_int_t i;
2270 
2271  ae_frame_make(_state, &_frame_block);
2272  *info = 0;
2273  ae_vector_clear(x);
2274  ae_vector_clear(wkronrod);
2275  ae_vector_clear(wgauss);
2276  ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true);
2277  ae_vector_init(&beta, 0, DT_REAL, _state, ae_true);
2278 
2279  if( n%2!=1||n<3 )
2280  {
2281  *info = -1;
2282  ae_frame_leave(_state);
2283  return;
2284  }
2285  mu0 = 2;
2286  alen = ae_ifloor((double)(3*(n/2))/(double)2, _state)+1;
2287  blen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1;
2288  ae_vector_set_length(&alpha, alen, _state);
2289  ae_vector_set_length(&beta, blen, _state);
2290  for(k=0; k<=alen-1; k++)
2291  {
2292  alpha.ptr.p_double[k] = 0;
2293  }
2294  beta.ptr.p_double[0] = 2;
2295  for(k=1; k<=blen-1; k++)
2296  {
2297  beta.ptr.p_double[k] = 1/(4-1/ae_sqr(k, _state));
2298  }
2299  gkqgeneraterec(&alpha, &beta, mu0, n, info, x, wkronrod, wgauss, _state);
2300 
2301  /*
2302  * test basic properties to detect errors
2303  */
2304  if( *info>0 )
2305  {
2306  if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) )
2307  {
2308  *info = -4;
2309  }
2310  for(i=0; i<=n-2; i++)
2311  {
2312  if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) )
2313  {
2314  *info = -4;
2315  }
2316  }
2317  }
2318  ae_frame_leave(_state);
2319 }
2320 
2321 
2322 /*************************************************************************
2323 Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using
2324 pre-calculated table. Nodes/weights were computed with accuracy up to
2325 1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision
2326 accuracy reduces to something about 2.0E-16 (depending on your compiler's
2327 handling of long floating point constants).
2328 
2329 INPUT PARAMETERS:
2330  N - number of Kronrod nodes.
2331  N can be 15, 21, 31, 41, 51, 61.
2332 
2333 OUTPUT PARAMETERS:
2334  X - array[0..N-1] - array of quadrature nodes, ordered in
2335  ascending order.
2336  WKronrod - array[0..N-1] - Kronrod weights
2337  WGauss - array[0..N-1] - Gauss weights (interleaved with zeros
2338  corresponding to extended Kronrod nodes).
2339 
2340 
2341  -- ALGLIB --
2342  Copyright 12.05.2009 by Bochkanov Sergey
2343 *************************************************************************/
2345  /* Real */ ae_vector* x,
2346  /* Real */ ae_vector* wkronrod,
2347  /* Real */ ae_vector* wgauss,
2348  double* eps,
2349  ae_state *_state)
2350 {
2351  ae_frame _frame_block;
2352  ae_int_t i;
2353  ae_int_t ng;
2354  ae_vector p1;
2355  ae_vector p2;
2356  double tmp;
2357 
2358  ae_frame_make(_state, &_frame_block);
2359  ae_vector_clear(x);
2360  ae_vector_clear(wkronrod);
2361  ae_vector_clear(wgauss);
2362  *eps = 0;
2363  ae_vector_init(&p1, 0, DT_INT, _state, ae_true);
2364  ae_vector_init(&p2, 0, DT_INT, _state, ae_true);
2365 
2366 
2367  /*
2368  * these initializers are not really necessary,
2369  * but without them compiler complains about uninitialized locals
2370  */
2371  ng = 0;
2372 
2373  /*
2374  * Process
2375  */
2376  ae_assert(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61, "GKQNodesTbl: incorrect N!", _state);
2377  ae_vector_set_length(x, n, _state);
2378  ae_vector_set_length(wkronrod, n, _state);
2379  ae_vector_set_length(wgauss, n, _state);
2380  for(i=0; i<=n-1; i++)
2381  {
2382  x->ptr.p_double[i] = 0;
2383  wkronrod->ptr.p_double[i] = 0;
2384  wgauss->ptr.p_double[i] = 0;
2385  }
2386  *eps = ae_maxreal(ae_machineepsilon, 1.0E-32, _state);
2387  if( n==15 )
2388  {
2389  ng = 4;
2390  wgauss->ptr.p_double[0] = 0.129484966168869693270611432679082;
2391  wgauss->ptr.p_double[1] = 0.279705391489276667901467771423780;
2392  wgauss->ptr.p_double[2] = 0.381830050505118944950369775488975;
2393  wgauss->ptr.p_double[3] = 0.417959183673469387755102040816327;
2394  x->ptr.p_double[0] = 0.991455371120812639206854697526329;
2395  x->ptr.p_double[1] = 0.949107912342758524526189684047851;
2396  x->ptr.p_double[2] = 0.864864423359769072789712788640926;
2397  x->ptr.p_double[3] = 0.741531185599394439863864773280788;
2398  x->ptr.p_double[4] = 0.586087235467691130294144838258730;
2399  x->ptr.p_double[5] = 0.405845151377397166906606412076961;
2400  x->ptr.p_double[6] = 0.207784955007898467600689403773245;
2401  x->ptr.p_double[7] = 0.000000000000000000000000000000000;
2402  wkronrod->ptr.p_double[0] = 0.022935322010529224963732008058970;
2403  wkronrod->ptr.p_double[1] = 0.063092092629978553290700663189204;
2404  wkronrod->ptr.p_double[2] = 0.104790010322250183839876322541518;
2405  wkronrod->ptr.p_double[3] = 0.140653259715525918745189590510238;
2406  wkronrod->ptr.p_double[4] = 0.169004726639267902826583426598550;
2407  wkronrod->ptr.p_double[5] = 0.190350578064785409913256402421014;
2408  wkronrod->ptr.p_double[6] = 0.204432940075298892414161999234649;
2409  wkronrod->ptr.p_double[7] = 0.209482141084727828012999174891714;
2410  }
2411  if( n==21 )
2412  {
2413  ng = 5;
2414  wgauss->ptr.p_double[0] = 0.066671344308688137593568809893332;
2415  wgauss->ptr.p_double[1] = 0.149451349150580593145776339657697;
2416  wgauss->ptr.p_double[2] = 0.219086362515982043995534934228163;
2417  wgauss->ptr.p_double[3] = 0.269266719309996355091226921569469;
2418  wgauss->ptr.p_double[4] = 0.295524224714752870173892994651338;
2419  x->ptr.p_double[0] = 0.995657163025808080735527280689003;
2420  x->ptr.p_double[1] = 0.973906528517171720077964012084452;
2421  x->ptr.p_double[2] = 0.930157491355708226001207180059508;
2422  x->ptr.p_double[3] = 0.865063366688984510732096688423493;
2423  x->ptr.p_double[4] = 0.780817726586416897063717578345042;
2424  x->ptr.p_double[5] = 0.679409568299024406234327365114874;
2425  x->ptr.p_double[6] = 0.562757134668604683339000099272694;
2426  x->ptr.p_double[7] = 0.433395394129247190799265943165784;
2427  x->ptr.p_double[8] = 0.294392862701460198131126603103866;
2428  x->ptr.p_double[9] = 0.148874338981631210884826001129720;
2429  x->ptr.p_double[10] = 0.000000000000000000000000000000000;
2430  wkronrod->ptr.p_double[0] = 0.011694638867371874278064396062192;
2431  wkronrod->ptr.p_double[1] = 0.032558162307964727478818972459390;
2432  wkronrod->ptr.p_double[2] = 0.054755896574351996031381300244580;
2433  wkronrod->ptr.p_double[3] = 0.075039674810919952767043140916190;
2434  wkronrod->ptr.p_double[4] = 0.093125454583697605535065465083366;
2435  wkronrod->ptr.p_double[5] = 0.109387158802297641899210590325805;
2436  wkronrod->ptr.p_double[6] = 0.123491976262065851077958109831074;
2437  wkronrod->ptr.p_double[7] = 0.134709217311473325928054001771707;
2438  wkronrod->ptr.p_double[8] = 0.142775938577060080797094273138717;
2439  wkronrod->ptr.p_double[9] = 0.147739104901338491374841515972068;
2440  wkronrod->ptr.p_double[10] = 0.149445554002916905664936468389821;
2441  }
2442  if( n==31 )
2443  {
2444  ng = 8;
2445  wgauss->ptr.p_double[0] = 0.030753241996117268354628393577204;
2446  wgauss->ptr.p_double[1] = 0.070366047488108124709267416450667;
2447  wgauss->ptr.p_double[2] = 0.107159220467171935011869546685869;
2448  wgauss->ptr.p_double[3] = 0.139570677926154314447804794511028;
2449  wgauss->ptr.p_double[4] = 0.166269205816993933553200860481209;
2450  wgauss->ptr.p_double[5] = 0.186161000015562211026800561866423;
2451  wgauss->ptr.p_double[6] = 0.198431485327111576456118326443839;
2452  wgauss->ptr.p_double[7] = 0.202578241925561272880620199967519;
2453  x->ptr.p_double[0] = 0.998002298693397060285172840152271;
2454  x->ptr.p_double[1] = 0.987992518020485428489565718586613;
2455  x->ptr.p_double[2] = 0.967739075679139134257347978784337;
2456  x->ptr.p_double[3] = 0.937273392400705904307758947710209;
2457  x->ptr.p_double[4] = 0.897264532344081900882509656454496;
2458  x->ptr.p_double[5] = 0.848206583410427216200648320774217;
2459  x->ptr.p_double[6] = 0.790418501442465932967649294817947;
2460  x->ptr.p_double[7] = 0.724417731360170047416186054613938;
2461  x->ptr.p_double[8] = 0.650996741297416970533735895313275;
2462  x->ptr.p_double[9] = 0.570972172608538847537226737253911;
2463  x->ptr.p_double[10] = 0.485081863640239680693655740232351;
2464  x->ptr.p_double[11] = 0.394151347077563369897207370981045;
2465  x->ptr.p_double[12] = 0.299180007153168812166780024266389;
2466  x->ptr.p_double[13] = 0.201194093997434522300628303394596;
2467  x->ptr.p_double[14] = 0.101142066918717499027074231447392;
2468  x->ptr.p_double[15] = 0.000000000000000000000000000000000;
2469  wkronrod->ptr.p_double[0] = 0.005377479872923348987792051430128;
2470  wkronrod->ptr.p_double[1] = 0.015007947329316122538374763075807;
2471  wkronrod->ptr.p_double[2] = 0.025460847326715320186874001019653;
2472  wkronrod->ptr.p_double[3] = 0.035346360791375846222037948478360;
2473  wkronrod->ptr.p_double[4] = 0.044589751324764876608227299373280;
2474  wkronrod->ptr.p_double[5] = 0.053481524690928087265343147239430;
2475  wkronrod->ptr.p_double[6] = 0.062009567800670640285139230960803;
2476  wkronrod->ptr.p_double[7] = 0.069854121318728258709520077099147;
2477  wkronrod->ptr.p_double[8] = 0.076849680757720378894432777482659;
2478  wkronrod->ptr.p_double[9] = 0.083080502823133021038289247286104;
2479  wkronrod->ptr.p_double[10] = 0.088564443056211770647275443693774;
2480  wkronrod->ptr.p_double[11] = 0.093126598170825321225486872747346;
2481  wkronrod->ptr.p_double[12] = 0.096642726983623678505179907627589;
2482  wkronrod->ptr.p_double[13] = 0.099173598721791959332393173484603;
2483  wkronrod->ptr.p_double[14] = 0.100769845523875595044946662617570;
2484  wkronrod->ptr.p_double[15] = 0.101330007014791549017374792767493;
2485  }
2486  if( n==41 )
2487  {
2488  ng = 10;
2489  wgauss->ptr.p_double[0] = 0.017614007139152118311861962351853;
2490  wgauss->ptr.p_double[1] = 0.040601429800386941331039952274932;
2491  wgauss->ptr.p_double[2] = 0.062672048334109063569506535187042;
2492  wgauss->ptr.p_double[3] = 0.083276741576704748724758143222046;
2493  wgauss->ptr.p_double[4] = 0.101930119817240435036750135480350;
2494  wgauss->ptr.p_double[5] = 0.118194531961518417312377377711382;
2495  wgauss->ptr.p_double[6] = 0.131688638449176626898494499748163;
2496  wgauss->ptr.p_double[7] = 0.142096109318382051329298325067165;
2497  wgauss->ptr.p_double[8] = 0.149172986472603746787828737001969;
2498  wgauss->ptr.p_double[9] = 0.152753387130725850698084331955098;
2499  x->ptr.p_double[0] = 0.998859031588277663838315576545863;
2500  x->ptr.p_double[1] = 0.993128599185094924786122388471320;
2501  x->ptr.p_double[2] = 0.981507877450250259193342994720217;
2502  x->ptr.p_double[3] = 0.963971927277913791267666131197277;
2503  x->ptr.p_double[4] = 0.940822633831754753519982722212443;
2504  x->ptr.p_double[5] = 0.912234428251325905867752441203298;
2505  x->ptr.p_double[6] = 0.878276811252281976077442995113078;
2506  x->ptr.p_double[7] = 0.839116971822218823394529061701521;
2507  x->ptr.p_double[8] = 0.795041428837551198350638833272788;
2508  x->ptr.p_double[9] = 0.746331906460150792614305070355642;
2509  x->ptr.p_double[10] = 0.693237656334751384805490711845932;
2510  x->ptr.p_double[11] = 0.636053680726515025452836696226286;
2511  x->ptr.p_double[12] = 0.575140446819710315342946036586425;
2512  x->ptr.p_double[13] = 0.510867001950827098004364050955251;
2513  x->ptr.p_double[14] = 0.443593175238725103199992213492640;
2514  x->ptr.p_double[15] = 0.373706088715419560672548177024927;
2515  x->ptr.p_double[16] = 0.301627868114913004320555356858592;
2516  x->ptr.p_double[17] = 0.227785851141645078080496195368575;
2517  x->ptr.p_double[18] = 0.152605465240922675505220241022678;
2518  x->ptr.p_double[19] = 0.076526521133497333754640409398838;
2519  x->ptr.p_double[20] = 0.000000000000000000000000000000000;
2520  wkronrod->ptr.p_double[0] = 0.003073583718520531501218293246031;
2521  wkronrod->ptr.p_double[1] = 0.008600269855642942198661787950102;
2522  wkronrod->ptr.p_double[2] = 0.014626169256971252983787960308868;
2523  wkronrod->ptr.p_double[3] = 0.020388373461266523598010231432755;
2524  wkronrod->ptr.p_double[4] = 0.025882133604951158834505067096153;
2525  wkronrod->ptr.p_double[5] = 0.031287306777032798958543119323801;
2526  wkronrod->ptr.p_double[6] = 0.036600169758200798030557240707211;
2527  wkronrod->ptr.p_double[7] = 0.041668873327973686263788305936895;
2528  wkronrod->ptr.p_double[8] = 0.046434821867497674720231880926108;
2529  wkronrod->ptr.p_double[9] = 0.050944573923728691932707670050345;
2530  wkronrod->ptr.p_double[10] = 0.055195105348285994744832372419777;
2531  wkronrod->ptr.p_double[11] = 0.059111400880639572374967220648594;
2532  wkronrod->ptr.p_double[12] = 0.062653237554781168025870122174255;
2533  wkronrod->ptr.p_double[13] = 0.065834597133618422111563556969398;
2534  wkronrod->ptr.p_double[14] = 0.068648672928521619345623411885368;
2535  wkronrod->ptr.p_double[15] = 0.071054423553444068305790361723210;
2536  wkronrod->ptr.p_double[16] = 0.073030690332786667495189417658913;
2537  wkronrod->ptr.p_double[17] = 0.074582875400499188986581418362488;
2538  wkronrod->ptr.p_double[18] = 0.075704497684556674659542775376617;
2539  wkronrod->ptr.p_double[19] = 0.076377867672080736705502835038061;
2540  wkronrod->ptr.p_double[20] = 0.076600711917999656445049901530102;
2541  }
2542  if( n==51 )
2543  {
2544  ng = 13;
2545  wgauss->ptr.p_double[0] = 0.011393798501026287947902964113235;
2546  wgauss->ptr.p_double[1] = 0.026354986615032137261901815295299;
2547  wgauss->ptr.p_double[2] = 0.040939156701306312655623487711646;
2548  wgauss->ptr.p_double[3] = 0.054904695975835191925936891540473;
2549  wgauss->ptr.p_double[4] = 0.068038333812356917207187185656708;
2550  wgauss->ptr.p_double[5] = 0.080140700335001018013234959669111;
2551  wgauss->ptr.p_double[6] = 0.091028261982963649811497220702892;
2552  wgauss->ptr.p_double[7] = 0.100535949067050644202206890392686;
2553  wgauss->ptr.p_double[8] = 0.108519624474263653116093957050117;
2554  wgauss->ptr.p_double[9] = 0.114858259145711648339325545869556;
2555  wgauss->ptr.p_double[10] = 0.119455763535784772228178126512901;
2556  wgauss->ptr.p_double[11] = 0.122242442990310041688959518945852;
2557  wgauss->ptr.p_double[12] = 0.123176053726715451203902873079050;
2558  x->ptr.p_double[0] = 0.999262104992609834193457486540341;
2559  x->ptr.p_double[1] = 0.995556969790498097908784946893902;
2560  x->ptr.p_double[2] = 0.988035794534077247637331014577406;
2561  x->ptr.p_double[3] = 0.976663921459517511498315386479594;
2562  x->ptr.p_double[4] = 0.961614986425842512418130033660167;
2563  x->ptr.p_double[5] = 0.942974571228974339414011169658471;
2564  x->ptr.p_double[6] = 0.920747115281701561746346084546331;
2565  x->ptr.p_double[7] = 0.894991997878275368851042006782805;
2566  x->ptr.p_double[8] = 0.865847065293275595448996969588340;
2567  x->ptr.p_double[9] = 0.833442628760834001421021108693570;
2568  x->ptr.p_double[10] = 0.797873797998500059410410904994307;
2569  x->ptr.p_double[11] = 0.759259263037357630577282865204361;
2570  x->ptr.p_double[12] = 0.717766406813084388186654079773298;
2571  x->ptr.p_double[13] = 0.673566368473468364485120633247622;
2572  x->ptr.p_double[14] = 0.626810099010317412788122681624518;
2573  x->ptr.p_double[15] = 0.577662930241222967723689841612654;
2574  x->ptr.p_double[16] = 0.526325284334719182599623778158010;
2575  x->ptr.p_double[17] = 0.473002731445714960522182115009192;
2576  x->ptr.p_double[18] = 0.417885382193037748851814394594572;
2577  x->ptr.p_double[19] = 0.361172305809387837735821730127641;
2578  x->ptr.p_double[20] = 0.303089538931107830167478909980339;
2579  x->ptr.p_double[21] = 0.243866883720988432045190362797452;
2580  x->ptr.p_double[22] = 0.183718939421048892015969888759528;
2581  x->ptr.p_double[23] = 0.122864692610710396387359818808037;
2582  x->ptr.p_double[24] = 0.061544483005685078886546392366797;
2583  x->ptr.p_double[25] = 0.000000000000000000000000000000000;
2584  wkronrod->ptr.p_double[0] = 0.001987383892330315926507851882843;
2585  wkronrod->ptr.p_double[1] = 0.005561932135356713758040236901066;
2586  wkronrod->ptr.p_double[2] = 0.009473973386174151607207710523655;
2587  wkronrod->ptr.p_double[3] = 0.013236229195571674813656405846976;
2588  wkronrod->ptr.p_double[4] = 0.016847817709128298231516667536336;
2589  wkronrod->ptr.p_double[5] = 0.020435371145882835456568292235939;
2590  wkronrod->ptr.p_double[6] = 0.024009945606953216220092489164881;
2591  wkronrod->ptr.p_double[7] = 0.027475317587851737802948455517811;
2592  wkronrod->ptr.p_double[8] = 0.030792300167387488891109020215229;
2593  wkronrod->ptr.p_double[9] = 0.034002130274329337836748795229551;
2594  wkronrod->ptr.p_double[10] = 0.037116271483415543560330625367620;
2595  wkronrod->ptr.p_double[11] = 0.040083825504032382074839284467076;
2596  wkronrod->ptr.p_double[12] = 0.042872845020170049476895792439495;
2597  wkronrod->ptr.p_double[13] = 0.045502913049921788909870584752660;
2598  wkronrod->ptr.p_double[14] = 0.047982537138836713906392255756915;
2599  wkronrod->ptr.p_double[15] = 0.050277679080715671963325259433440;
2600  wkronrod->ptr.p_double[16] = 0.052362885806407475864366712137873;
2601  wkronrod->ptr.p_double[17] = 0.054251129888545490144543370459876;
2602  wkronrod->ptr.p_double[18] = 0.055950811220412317308240686382747;
2603  wkronrod->ptr.p_double[19] = 0.057437116361567832853582693939506;
2604  wkronrod->ptr.p_double[20] = 0.058689680022394207961974175856788;
2605  wkronrod->ptr.p_double[21] = 0.059720340324174059979099291932562;
2606  wkronrod->ptr.p_double[22] = 0.060539455376045862945360267517565;
2607  wkronrod->ptr.p_double[23] = 0.061128509717053048305859030416293;
2608  wkronrod->ptr.p_double[24] = 0.061471189871425316661544131965264;
2609  wkronrod->ptr.p_double[25] = 0.061580818067832935078759824240055;
2610  }
2611  if( n==61 )
2612  {
2613  ng = 15;
2614  wgauss->ptr.p_double[0] = 0.007968192496166605615465883474674;
2615  wgauss->ptr.p_double[1] = 0.018466468311090959142302131912047;
2616  wgauss->ptr.p_double[2] = 0.028784707883323369349719179611292;
2617  wgauss->ptr.p_double[3] = 0.038799192569627049596801936446348;
2618  wgauss->ptr.p_double[4] = 0.048402672830594052902938140422808;
2619  wgauss->ptr.p_double[5] = 0.057493156217619066481721689402056;
2620  wgauss->ptr.p_double[6] = 0.065974229882180495128128515115962;
2621  wgauss->ptr.p_double[7] = 0.073755974737705206268243850022191;
2622  wgauss->ptr.p_double[8] = 0.080755895229420215354694938460530;
2623  wgauss->ptr.p_double[9] = 0.086899787201082979802387530715126;
2624  wgauss->ptr.p_double[10] = 0.092122522237786128717632707087619;
2625  wgauss->ptr.p_double[11] = 0.096368737174644259639468626351810;
2626  wgauss->ptr.p_double[12] = 0.099593420586795267062780282103569;
2627  wgauss->ptr.p_double[13] = 0.101762389748405504596428952168554;
2628  wgauss->ptr.p_double[14] = 0.102852652893558840341285636705415;
2629  x->ptr.p_double[0] = 0.999484410050490637571325895705811;
2630  x->ptr.p_double[1] = 0.996893484074649540271630050918695;
2631  x->ptr.p_double[2] = 0.991630996870404594858628366109486;
2632  x->ptr.p_double[3] = 0.983668123279747209970032581605663;
2633  x->ptr.p_double[4] = 0.973116322501126268374693868423707;
2634  x->ptr.p_double[5] = 0.960021864968307512216871025581798;
2635  x->ptr.p_double[6] = 0.944374444748559979415831324037439;
2636  x->ptr.p_double[7] = 0.926200047429274325879324277080474;
2637  x->ptr.p_double[8] = 0.905573307699907798546522558925958;
2638  x->ptr.p_double[9] = 0.882560535792052681543116462530226;
2639  x->ptr.p_double[10] = 0.857205233546061098958658510658944;
2640  x->ptr.p_double[11] = 0.829565762382768397442898119732502;
2641  x->ptr.p_double[12] = 0.799727835821839083013668942322683;
2642  x->ptr.p_double[13] = 0.767777432104826194917977340974503;
2643  x->ptr.p_double[14] = 0.733790062453226804726171131369528;
2644  x->ptr.p_double[15] = 0.697850494793315796932292388026640;
2645  x->ptr.p_double[16] = 0.660061064126626961370053668149271;
2646  x->ptr.p_double[17] = 0.620526182989242861140477556431189;
2647  x->ptr.p_double[18] = 0.579345235826361691756024932172540;
2648  x->ptr.p_double[19] = 0.536624148142019899264169793311073;
2649  x->ptr.p_double[20] = 0.492480467861778574993693061207709;
2650  x->ptr.p_double[21] = 0.447033769538089176780609900322854;
2651  x->ptr.p_double[22] = 0.400401254830394392535476211542661;
2652  x->ptr.p_double[23] = 0.352704725530878113471037207089374;
2653  x->ptr.p_double[24] = 0.304073202273625077372677107199257;
2654  x->ptr.p_double[25] = 0.254636926167889846439805129817805;
2655  x->ptr.p_double[26] = 0.204525116682309891438957671002025;
2656  x->ptr.p_double[27] = 0.153869913608583546963794672743256;
2657  x->ptr.p_double[28] = 0.102806937966737030147096751318001;
2658  x->ptr.p_double[29] = 0.051471842555317695833025213166723;
2659  x->ptr.p_double[30] = 0.000000000000000000000000000000000;
2660  wkronrod->ptr.p_double[0] = 0.001389013698677007624551591226760;
2661  wkronrod->ptr.p_double[1] = 0.003890461127099884051267201844516;
2662  wkronrod->ptr.p_double[2] = 0.006630703915931292173319826369750;
2663  wkronrod->ptr.p_double[3] = 0.009273279659517763428441146892024;
2664  wkronrod->ptr.p_double[4] = 0.011823015253496341742232898853251;
2665  wkronrod->ptr.p_double[5] = 0.014369729507045804812451432443580;
2666  wkronrod->ptr.p_double[6] = 0.016920889189053272627572289420322;
2667  wkronrod->ptr.p_double[7] = 0.019414141193942381173408951050128;
2668  wkronrod->ptr.p_double[8] = 0.021828035821609192297167485738339;
2669  wkronrod->ptr.p_double[9] = 0.024191162078080601365686370725232;
2670  wkronrod->ptr.p_double[10] = 0.026509954882333101610601709335075;
2671  wkronrod->ptr.p_double[11] = 0.028754048765041292843978785354334;
2672  wkronrod->ptr.p_double[12] = 0.030907257562387762472884252943092;
2673  wkronrod->ptr.p_double[13] = 0.032981447057483726031814191016854;
2674  wkronrod->ptr.p_double[14] = 0.034979338028060024137499670731468;
2675  wkronrod->ptr.p_double[15] = 0.036882364651821229223911065617136;
2676  wkronrod->ptr.p_double[16] = 0.038678945624727592950348651532281;
2677  wkronrod->ptr.p_double[17] = 0.040374538951535959111995279752468;
2678  wkronrod->ptr.p_double[18] = 0.041969810215164246147147541285970;
2679  wkronrod->ptr.p_double[19] = 0.043452539701356069316831728117073;
2680  wkronrod->ptr.p_double[20] = 0.044814800133162663192355551616723;
2681  wkronrod->ptr.p_double[21] = 0.046059238271006988116271735559374;
2682  wkronrod->ptr.p_double[22] = 0.047185546569299153945261478181099;
2683  wkronrod->ptr.p_double[23] = 0.048185861757087129140779492298305;
2684  wkronrod->ptr.p_double[24] = 0.049055434555029778887528165367238;
2685  wkronrod->ptr.p_double[25] = 0.049795683427074206357811569379942;
2686  wkronrod->ptr.p_double[26] = 0.050405921402782346840893085653585;
2687  wkronrod->ptr.p_double[27] = 0.050881795898749606492297473049805;
2688  wkronrod->ptr.p_double[28] = 0.051221547849258772170656282604944;
2689  wkronrod->ptr.p_double[29] = 0.051426128537459025933862879215781;
2690  wkronrod->ptr.p_double[30] = 0.051494729429451567558340433647099;
2691  }
2692 
2693  /*
2694  * copy nodes
2695  */
2696  for(i=n-1; i>=n/2; i--)
2697  {
2698  x->ptr.p_double[i] = -x->ptr.p_double[n-1-i];
2699  }
2700 
2701  /*
2702  * copy Kronrod weights
2703  */
2704  for(i=n-1; i>=n/2; i--)
2705  {
2706  wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[n-1-i];
2707  }
2708 
2709  /*
2710  * copy Gauss weights
2711  */
2712  for(i=ng-1; i>=0; i--)
2713  {
2714  wgauss->ptr.p_double[n-2-2*i] = wgauss->ptr.p_double[i];
2715  wgauss->ptr.p_double[1+2*i] = wgauss->ptr.p_double[i];
2716  }
2717  for(i=0; i<=n/2; i++)
2718  {
2719  wgauss->ptr.p_double[2*i] = 0;
2720  }
2721 
2722  /*
2723  * reorder
2724  */
2725  tagsort(x, n, &p1, &p2, _state);
2726  for(i=0; i<=n-1; i++)
2727  {
2728  tmp = wkronrod->ptr.p_double[i];
2729  wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[p2.ptr.p_int[i]];
2730  wkronrod->ptr.p_double[p2.ptr.p_int[i]] = tmp;
2731  tmp = wgauss->ptr.p_double[i];
2732  wgauss->ptr.p_double[i] = wgauss->ptr.p_double[p2.ptr.p_int[i]];
2733  wgauss->ptr.p_double[p2.ptr.p_int[i]] = tmp;
2734  }
2735  ae_frame_leave(_state);
2736 }
2737 
2738 
2739 
2740 
2741 /*************************************************************************
2742 Integration of a smooth function F(x) on a finite interval [a,b].
2743 
2744 Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
2745 is calculated with accuracy close to the machine precision.
2746 
2747 Algorithm works well only with smooth integrands. It may be used with
2748 continuous non-smooth integrands, but with less performance.
2749 
2750 It should never be used with integrands which have integrable singularities
2751 at lower or upper limits - algorithm may crash. Use AutoGKSingular in such
2752 cases.
2753 
2754 INPUT PARAMETERS:
2755  A, B - interval boundaries (A<B, A=B or A>B)
2756 
2757 OUTPUT PARAMETERS
2758  State - structure which stores algorithm state
2759 
2760 SEE ALSO
2761  AutoGKSmoothW, AutoGKSingular, AutoGKResults.
2762 
2763 
2764  -- ALGLIB --
2765  Copyright 06.05.2009 by Bochkanov Sergey
2766 *************************************************************************/
2767 void autogksmooth(double a,
2768  double b,
2769  autogkstate* state,
2770  ae_state *_state)
2771 {
2772 
2773  _autogkstate_clear(state);
2774 
2775  ae_assert(ae_isfinite(a, _state), "AutoGKSmooth: A is not finite!", _state);
2776  ae_assert(ae_isfinite(b, _state), "AutoGKSmooth: B is not finite!", _state);
2777  autogksmoothw(a, b, 0.0, state, _state);
2778 }
2779 
2780 
2781 /*************************************************************************
2782 Integration of a smooth function F(x) on a finite interval [a,b].
2783 
2784 This subroutine is same as AutoGKSmooth(), but it guarantees that interval
2785 [a,b] is partitioned into subintervals which have width at most XWidth.
2786 
2787 Subroutine can be used when integrating nearly-constant function with
2788 narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth
2789 subroutine can overlook them.
2790 
2791 INPUT PARAMETERS:
2792  A, B - interval boundaries (A<B, A=B or A>B)
2793 
2794 OUTPUT PARAMETERS
2795  State - structure which stores algorithm state
2796 
2797 SEE ALSO
2798  AutoGKSmooth, AutoGKSingular, AutoGKResults.
2799 
2800 
2801  -- ALGLIB --
2802  Copyright 06.05.2009 by Bochkanov Sergey
2803 *************************************************************************/
2804 void autogksmoothw(double a,
2805  double b,
2806  double xwidth,
2807  autogkstate* state,
2808  ae_state *_state)
2809 {
2810 
2811  _autogkstate_clear(state);
2812 
2813  ae_assert(ae_isfinite(a, _state), "AutoGKSmoothW: A is not finite!", _state);
2814  ae_assert(ae_isfinite(b, _state), "AutoGKSmoothW: B is not finite!", _state);
2815  ae_assert(ae_isfinite(xwidth, _state), "AutoGKSmoothW: XWidth is not finite!", _state);
2816  state->wrappermode = 0;
2817  state->a = a;
2818  state->b = b;
2819  state->xwidth = xwidth;
2820  state->needf = ae_false;
2821  ae_vector_set_length(&state->rstate.ra, 10+1, _state);
2822  state->rstate.stage = -1;
2823 }
2824 
2825 
2826 /*************************************************************************
2827 Integration on a finite interval [A,B].
2828 Integrand have integrable singularities at A/B.
2829 
2830 F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known
2831 alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates
2832 from below can be used (but these estimates should be greater than -1 too).
2833 
2834 One of alpha/beta variables (or even both alpha/beta) may be equal to 0,
2835 which means than function F(x) is non-singular at A/B. Anyway (singular at
2836 bounds or not), function F(x) is supposed to be continuous on (A,B).
2837 
2838 Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
2839 is calculated with accuracy close to the machine precision.
2840 
2841 INPUT PARAMETERS:
2842  A, B - interval boundaries (A<B, A=B or A>B)
2843  Alpha - power-law coefficient of the F(x) at A,
2844  Alpha>-1
2845  Beta - power-law coefficient of the F(x) at B,
2846  Beta>-1
2847 
2848 OUTPUT PARAMETERS
2849  State - structure which stores algorithm state
2850 
2851 SEE ALSO
2852  AutoGKSmooth, AutoGKSmoothW, AutoGKResults.
2853 
2854 
2855  -- ALGLIB --
2856  Copyright 06.05.2009 by Bochkanov Sergey
2857 *************************************************************************/
2858 void autogksingular(double a,
2859  double b,
2860  double alpha,
2861  double beta,
2862  autogkstate* state,
2863  ae_state *_state)
2864 {
2865 
2866  _autogkstate_clear(state);
2867 
2868  ae_assert(ae_isfinite(a, _state), "AutoGKSingular: A is not finite!", _state);
2869  ae_assert(ae_isfinite(b, _state), "AutoGKSingular: B is not finite!", _state);
2870  ae_assert(ae_isfinite(alpha, _state), "AutoGKSingular: Alpha is not finite!", _state);
2871  ae_assert(ae_isfinite(beta, _state), "AutoGKSingular: Beta is not finite!", _state);
2872  state->wrappermode = 1;
2873  state->a = a;
2874  state->b = b;
2875  state->alpha = alpha;
2876  state->beta = beta;
2877  state->xwidth = 0.0;
2878  state->needf = ae_false;
2879  ae_vector_set_length(&state->rstate.ra, 10+1, _state);
2880  state->rstate.stage = -1;
2881 }
2882 
2883 
2884 /*************************************************************************
2885 
2886  -- ALGLIB --
2887  Copyright 07.05.2009 by Bochkanov Sergey
2888 *************************************************************************/
2890 {
2891  double s;
2892  double tmp;
2893  double eps;
2894  double a;
2895  double b;
2896  double x;
2897  double t;
2898  double alpha;
2899  double beta;
2900  double v1;
2901  double v2;
2902  ae_bool result;
2903 
2904 
2905 
2906  /*
2907  * Reverse communication preparations
2908  * I know it looks ugly, but it works the same way
2909  * anywhere from C++ to Python.
2910  *
2911  * This code initializes locals by:
2912  * * random values determined during code
2913  * generation - on first subroutine call
2914  * * values from previous call - on subsequent calls
2915  */
2916  if( state->rstate.stage>=0 )
2917  {
2918  s = state->rstate.ra.ptr.p_double[0];
2919  tmp = state->rstate.ra.ptr.p_double[1];
2920  eps = state->rstate.ra.ptr.p_double[2];
2921  a = state->rstate.ra.ptr.p_double[3];
2922  b = state->rstate.ra.ptr.p_double[4];
2923  x = state->rstate.ra.ptr.p_double[5];
2924  t = state->rstate.ra.ptr.p_double[6];
2925  alpha = state->rstate.ra.ptr.p_double[7];
2926  beta = state->rstate.ra.ptr.p_double[8];
2927  v1 = state->rstate.ra.ptr.p_double[9];
2928  v2 = state->rstate.ra.ptr.p_double[10];
2929  }
2930  else
2931  {
2932  s = -983;
2933  tmp = -989;
2934  eps = -834;
2935  a = 900;
2936  b = -287;
2937  x = 364;
2938  t = 214;
2939  alpha = -338;
2940  beta = -686;
2941  v1 = 912;
2942  v2 = 585;
2943  }
2944  if( state->rstate.stage==0 )
2945  {
2946  goto lbl_0;
2947  }
2948  if( state->rstate.stage==1 )
2949  {
2950  goto lbl_1;
2951  }
2952  if( state->rstate.stage==2 )
2953  {
2954  goto lbl_2;
2955  }
2956 
2957  /*
2958  * Routine body
2959  */
2960  eps = 0;
2961  a = state->a;
2962  b = state->b;
2963  alpha = state->alpha;
2964  beta = state->beta;
2965  state->terminationtype = -1;
2966  state->nfev = 0;
2967  state->nintervals = 0;
2968 
2969  /*
2970  * smooth function at a finite interval
2971  */
2972  if( state->wrappermode!=0 )
2973  {
2974  goto lbl_3;
2975  }
2976 
2977  /*
2978  * special case
2979  */
2980  if( ae_fp_eq(a,b) )
2981  {
2982  state->terminationtype = 1;
2983  state->v = 0;
2984  result = ae_false;
2985  return result;
2986  }
2987 
2988  /*
2989  * general case
2990  */
2991  autogk_autogkinternalprepare(a, b, eps, state->xwidth, &state->internalstate, _state);
2992 lbl_5:
2993  if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
2994  {
2995  goto lbl_6;
2996  }
2997  x = state->internalstate.x;
2998  state->x = x;
2999  state->xminusa = x-a;
3000  state->bminusx = b-x;
3001  state->needf = ae_true;
3002  state->rstate.stage = 0;
3003  goto lbl_rcomm;
3004 lbl_0:
3005  state->needf = ae_false;
3006  state->nfev = state->nfev+1;
3007  state->internalstate.f = state->f;
3008  goto lbl_5;
3009 lbl_6:
3010  state->v = state->internalstate.r;
3011  state->terminationtype = state->internalstate.info;
3012  state->nintervals = state->internalstate.heapused;
3013  result = ae_false;
3014  return result;
3015 lbl_3:
3016 
3017  /*
3018  * function with power-law singularities at the ends of a finite interval
3019  */
3020  if( state->wrappermode!=1 )
3021  {
3022  goto lbl_7;
3023  }
3024 
3025  /*
3026  * test coefficients
3027  */
3028  if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) )
3029  {
3030  state->terminationtype = -1;
3031  state->v = 0;
3032  result = ae_false;
3033  return result;
3034  }
3035 
3036  /*
3037  * special cases
3038  */
3039  if( ae_fp_eq(a,b) )
3040  {
3041  state->terminationtype = 1;
3042  state->v = 0;
3043  result = ae_false;
3044  return result;
3045  }
3046 
3047  /*
3048  * reduction to general form
3049  */
3050  if( ae_fp_less(a,b) )
3051  {
3052  s = 1;
3053  }
3054  else
3055  {
3056  s = -1;
3057  tmp = a;
3058  a = b;
3059  b = tmp;
3060  tmp = alpha;
3061  alpha = beta;
3062  beta = tmp;
3063  }
3064  alpha = ae_minreal(alpha, 0, _state);
3065  beta = ae_minreal(beta, 0, _state);
3066 
3067  /*
3068  * first, integrate left half of [a,b]:
3069  * integral(f(x)dx, a, (b+a)/2) =
3070  * = 1/(1+alpha) * integral(t^(-alpha/(1+alpha))*f(a+t^(1/(1+alpha)))dt, 0, (0.5*(b-a))^(1+alpha))
3071  */
3072  autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+alpha, _state), eps, state->xwidth, &state->internalstate, _state);
3073 lbl_9:
3074  if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
3075  {
3076  goto lbl_10;
3077  }
3078 
3079  /*
3080  * Fill State.X, State.XMinusA, State.BMinusX.
3081  * Latter two are filled correctly even if B<A.
3082  */
3083  x = state->internalstate.x;
3084  t = ae_pow(x, 1/(1+alpha), _state);
3085  state->x = a+t;
3086  if( ae_fp_greater(s,0) )
3087  {
3088  state->xminusa = t;
3089  state->bminusx = b-(a+t);
3090  }
3091  else
3092  {
3093  state->xminusa = a+t-b;
3094  state->bminusx = -t;
3095  }
3096  state->needf = ae_true;
3097  state->rstate.stage = 1;
3098  goto lbl_rcomm;
3099 lbl_1:
3100  state->needf = ae_false;
3101  if( ae_fp_neq(alpha,0) )
3102  {
3103  state->internalstate.f = state->f*ae_pow(x, -alpha/(1+alpha), _state)/(1+alpha);
3104  }
3105  else
3106  {
3107  state->internalstate.f = state->f;
3108  }
3109  state->nfev = state->nfev+1;
3110  goto lbl_9;
3111 lbl_10:
3112  v1 = state->internalstate.r;
3113  state->nintervals = state->nintervals+state->internalstate.heapused;
3114 
3115  /*
3116  * then, integrate right half of [a,b]:
3117  * integral(f(x)dx, (b+a)/2, b) =
3118  * = 1/(1+beta) * integral(t^(-beta/(1+beta))*f(b-t^(1/(1+beta)))dt, 0, (0.5*(b-a))^(1+beta))
3119  */
3120  autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+beta, _state), eps, state->xwidth, &state->internalstate, _state);
3121 lbl_11:
3122  if( !autogk_autogkinternaliteration(&state->internalstate, _state) )
3123  {
3124  goto lbl_12;
3125  }
3126 
3127  /*
3128  * Fill State.X, State.XMinusA, State.BMinusX.
3129  * Latter two are filled correctly (X-A, B-X) even if B<A.
3130  */
3131  x = state->internalstate.x;
3132  t = ae_pow(x, 1/(1+beta), _state);
3133  state->x = b-t;
3134  if( ae_fp_greater(s,0) )
3135  {
3136  state->xminusa = b-t-a;
3137  state->bminusx = t;
3138  }
3139  else
3140  {
3141  state->xminusa = -t;
3142  state->bminusx = a-(b-t);
3143  }
3144  state->needf = ae_true;
3145  state->rstate.stage = 2;
3146  goto lbl_rcomm;
3147 lbl_2:
3148  state->needf = ae_false;
3149  if( ae_fp_neq(beta,0) )
3150  {
3151  state->internalstate.f = state->f*ae_pow(x, -beta/(1+beta), _state)/(1+beta);
3152  }
3153  else
3154  {
3155  state->internalstate.f = state->f;
3156  }
3157  state->nfev = state->nfev+1;
3158  goto lbl_11;
3159 lbl_12:
3160  v2 = state->internalstate.r;
3161  state->nintervals = state->nintervals+state->internalstate.heapused;
3162 
3163  /*
3164  * final result
3165  */
3166  state->v = s*(v1+v2);
3167  state->terminationtype = 1;
3168  result = ae_false;
3169  return result;
3170 lbl_7:
3171  result = ae_false;
3172  return result;
3173 
3174  /*
3175  * Saving state
3176  */
3177 lbl_rcomm:
3178  result = ae_true;
3179  state->rstate.ra.ptr.p_double[0] = s;
3180  state->rstate.ra.ptr.p_double[1] = tmp;
3181  state->rstate.ra.ptr.p_double[2] = eps;
3182  state->rstate.ra.ptr.p_double[3] = a;
3183  state->rstate.ra.ptr.p_double[4] = b;
3184  state->rstate.ra.ptr.p_double[5] = x;
3185  state->rstate.ra.ptr.p_double[6] = t;
3186  state->rstate.ra.ptr.p_double[7] = alpha;
3187  state->rstate.ra.ptr.p_double[8] = beta;
3188  state->rstate.ra.ptr.p_double[9] = v1;
3189  state->rstate.ra.ptr.p_double[10] = v2;
3190  return result;
3191 }
3192 
3193 
3194 /*************************************************************************
3195 Adaptive integration results
3196 
3197 Called after AutoGKIteration returned False.
3198 
3199 Input parameters:
3200  State - algorithm state (used by AutoGKIteration).
3201 
3202 Output parameters:
3203  V - integral(f(x)dx,a,b)
3204  Rep - optimization report (see AutoGKReport description)
3205 
3206  -- ALGLIB --
3207  Copyright 14.11.2007 by Bochkanov Sergey
3208 *************************************************************************/
3210  double* v,
3211  autogkreport* rep,
3212  ae_state *_state)
3213 {
3214 
3215  *v = 0;
3216  _autogkreport_clear(rep);
3217 
3218  *v = state->v;
3219  rep->terminationtype = state->terminationtype;
3220  rep->nfev = state->nfev;
3221  rep->nintervals = state->nintervals;
3222 }
3223 
3224 
3225 /*************************************************************************
3226 Internal AutoGK subroutine
3227 eps<0 - error
3228 eps=0 - automatic eps selection
3229 
3230 width<0 - error
3231 width=0 - no width requirements
3232 *************************************************************************/
3233 static void autogk_autogkinternalprepare(double a,
3234  double b,
3235  double eps,
3236  double xwidth,
3237  autogkinternalstate* state,
3238  ae_state *_state)
3239 {
3240 
3241 
3242 
3243  /*
3244  * Save settings
3245  */
3246  state->a = a;
3247  state->b = b;
3248  state->eps = eps;
3249  state->xwidth = xwidth;
3250 
3251  /*
3252  * Prepare RComm structure
3253  */
3254  ae_vector_set_length(&state->rstate.ia, 3+1, _state);
3255  ae_vector_set_length(&state->rstate.ra, 8+1, _state);
3256  state->rstate.stage = -1;
3257 }
3258 
3259 
3260 /*************************************************************************
3261 Internal AutoGK subroutine
3262 *************************************************************************/
3263 static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state,
3264  ae_state *_state)
3265 {
3266  double c1;
3267  double c2;
3268  ae_int_t i;
3269  ae_int_t j;
3270  double intg;
3271  double intk;
3272  double inta;
3273  double v;
3274  double ta;
3275  double tb;
3276  ae_int_t ns;
3277  double qeps;
3278  ae_int_t info;
3279  ae_bool result;
3280 
3281 
3282 
3283  /*
3284  * Reverse communication preparations
3285  * I know it looks ugly, but it works the same way
3286  * anywhere from C++ to Python.
3287  *
3288  * This code initializes locals by:
3289  * * random values determined during code
3290  * generation - on first subroutine call
3291  * * values from previous call - on subsequent calls
3292  */
3293  if( state->rstate.stage>=0 )
3294  {
3295  i = state->rstate.ia.ptr.p_int[0];
3296  j = state->rstate.ia.ptr.p_int[1];
3297  ns = state->rstate.ia.ptr.p_int[2];
3298  info = state->rstate.ia.ptr.p_int[3];
3299  c1 = state->rstate.ra.ptr.p_double[0];
3300  c2 = state->rstate.ra.ptr.p_double[1];
3301  intg = state->rstate.ra.ptr.p_double[2];
3302  intk = state->rstate.ra.ptr.p_double[3];
3303  inta = state->rstate.ra.ptr.p_double[4];
3304  v = state->rstate.ra.ptr.p_double[5];
3305  ta = state->rstate.ra.ptr.p_double[6];
3306  tb = state->rstate.ra.ptr.p_double[7];
3307  qeps = state->rstate.ra.ptr.p_double[8];
3308  }
3309  else
3310  {
3311  i = 497;
3312  j = -271;
3313  ns = -581;
3314  info = 745;
3315  c1 = -533;
3316  c2 = -77;
3317  intg = 678;
3318  intk = -293;
3319  inta = 316;
3320  v = 647;
3321  ta = -756;
3322  tb = 830;
3323  qeps = -871;
3324  }
3325  if( state->rstate.stage==0 )
3326  {
3327  goto lbl_0;
3328  }
3329  if( state->rstate.stage==1 )
3330  {
3331  goto lbl_1;
3332  }
3333  if( state->rstate.stage==2 )
3334  {
3335  goto lbl_2;
3336  }
3337 
3338  /*
3339  * Routine body
3340  */
3341 
3342  /*
3343  * initialize quadratures.
3344  * use 15-point Gauss-Kronrod formula.
3345  */
3346  state->n = 15;
3347  gkqgenerategausslegendre(state->n, &info, &state->qn, &state->wk, &state->wg, _state);
3348  if( info<0 )
3349  {
3350  state->info = -5;
3351  state->r = 0;
3352  result = ae_false;
3353  return result;
3354  }
3355  ae_vector_set_length(&state->wr, state->n, _state);
3356  for(i=0; i<=state->n-1; i++)
3357  {
3358  if( i==0 )
3359  {
3360  state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[1]-state->qn.ptr.p_double[0], _state);
3361  continue;
3362  }
3363  if( i==state->n-1 )
3364  {
3365  state->wr.ptr.p_double[state->n-1] = 0.5*ae_fabs(state->qn.ptr.p_double[state->n-1]-state->qn.ptr.p_double[state->n-2], _state);
3366  continue;
3367  }
3368  state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[i-1]-state->qn.ptr.p_double[i+1], _state);
3369  }
3370 
3371  /*
3372  * special case
3373  */
3374  if( ae_fp_eq(state->a,state->b) )
3375  {
3376  state->info = 1;
3377  state->r = 0;
3378  result = ae_false;
3379  return result;
3380  }
3381 
3382  /*
3383  * test parameters
3384  */
3385  if( ae_fp_less(state->eps,0)||ae_fp_less(state->xwidth,0) )
3386  {
3387  state->info = -1;
3388  state->r = 0;
3389  result = ae_false;
3390  return result;
3391  }
3392  state->info = 1;
3393  if( ae_fp_eq(state->eps,0) )
3394  {
3395  state->eps = 100000*ae_machineepsilon;
3396  }
3397 
3398  /*
3399  * First, prepare heap
3400  * * column 0 - absolute error
3401  * * column 1 - integral of a F(x) (calculated using Kronrod extension nodes)
3402  * * column 2 - integral of a |F(x)| (calculated using modified rect. method)
3403  * * column 3 - left boundary of a subinterval
3404  * * column 4 - right boundary of a subinterval
3405  */
3406  if( ae_fp_neq(state->xwidth,0) )
3407  {
3408  goto lbl_3;
3409  }
3410 
3411  /*
3412  * no maximum width requirements
3413  * start from one big subinterval
3414  */
3415  state->heapwidth = 5;
3416  state->heapsize = 1;
3417  state->heapused = 1;
3418  ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state);
3419  c1 = 0.5*(state->b-state->a);
3420  c2 = 0.5*(state->b+state->a);
3421  intg = 0;
3422  intk = 0;
3423  inta = 0;
3424  i = 0;
3425 lbl_5:
3426  if( i>state->n-1 )
3427  {
3428  goto lbl_7;
3429  }
3430 
3431  /*
3432  * obtain F
3433  */
3434  state->x = c1*state->qn.ptr.p_double[i]+c2;
3435  state->rstate.stage = 0;
3436  goto lbl_rcomm;
3437 lbl_0:
3438  v = state->f;
3439 
3440  /*
3441  * Gauss-Kronrod formula
3442  */
3443  intk = intk+v*state->wk.ptr.p_double[i];
3444  if( i%2==1 )
3445  {
3446  intg = intg+v*state->wg.ptr.p_double[i];
3447  }
3448 
3449  /*
3450  * Integral |F(x)|
3451  * Use rectangles method
3452  */
3453  inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
3454  i = i+1;
3455  goto lbl_5;
3456 lbl_7:
3457  intk = intk*(state->b-state->a)*0.5;
3458  intg = intg*(state->b-state->a)*0.5;
3459  inta = inta*(state->b-state->a)*0.5;
3460  state->heap.ptr.pp_double[0][0] = ae_fabs(intg-intk, _state);
3461  state->heap.ptr.pp_double[0][1] = intk;
3462  state->heap.ptr.pp_double[0][2] = inta;
3463  state->heap.ptr.pp_double[0][3] = state->a;
3464  state->heap.ptr.pp_double[0][4] = state->b;
3465  state->sumerr = state->heap.ptr.pp_double[0][0];
3466  state->sumabs = ae_fabs(inta, _state);
3467  goto lbl_4;
3468 lbl_3:
3469 
3470  /*
3471  * maximum subinterval should be no more than XWidth.
3472  * so we create Ceil((B-A)/XWidth)+1 small subintervals
3473  */
3474  ns = ae_iceil(ae_fabs(state->b-state->a, _state)/state->xwidth, _state)+1;
3475  state->heapsize = ns;
3476  state->heapused = ns;
3477  state->heapwidth = 5;
3478  ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state);
3479  state->sumerr = 0;
3480  state->sumabs = 0;
3481  j = 0;
3482 lbl_8:
3483  if( j>ns-1 )
3484  {
3485  goto lbl_10;
3486  }
3487  ta = state->a+j*(state->b-state->a)/ns;
3488  tb = state->a+(j+1)*(state->b-state->a)/ns;
3489  c1 = 0.5*(tb-ta);
3490  c2 = 0.5*(tb+ta);
3491  intg = 0;
3492  intk = 0;
3493  inta = 0;
3494  i = 0;
3495 lbl_11:
3496  if( i>state->n-1 )
3497  {
3498  goto lbl_13;
3499  }
3500 
3501  /*
3502  * obtain F
3503  */
3504  state->x = c1*state->qn.ptr.p_double[i]+c2;
3505  state->rstate.stage = 1;
3506  goto lbl_rcomm;
3507 lbl_1:
3508  v = state->f;
3509 
3510  /*
3511  * Gauss-Kronrod formula
3512  */
3513  intk = intk+v*state->wk.ptr.p_double[i];
3514  if( i%2==1 )
3515  {
3516  intg = intg+v*state->wg.ptr.p_double[i];
3517  }
3518 
3519  /*
3520  * Integral |F(x)|
3521  * Use rectangles method
3522  */
3523  inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
3524  i = i+1;
3525  goto lbl_11;
3526 lbl_13:
3527  intk = intk*(tb-ta)*0.5;
3528  intg = intg*(tb-ta)*0.5;
3529  inta = inta*(tb-ta)*0.5;
3530  state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state);
3531  state->heap.ptr.pp_double[j][1] = intk;
3532  state->heap.ptr.pp_double[j][2] = inta;
3533  state->heap.ptr.pp_double[j][3] = ta;
3534  state->heap.ptr.pp_double[j][4] = tb;
3535  state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0];
3536  state->sumabs = state->sumabs+ae_fabs(inta, _state);
3537  j = j+1;
3538  goto lbl_8;
3539 lbl_10:
3540 lbl_4:
3541 
3542  /*
3543  * method iterations
3544  */
3545 lbl_14:
3546  if( ae_false )
3547  {
3548  goto lbl_15;
3549  }
3550 
3551  /*
3552  * additional memory if needed
3553  */
3554  if( state->heapused==state->heapsize )
3555  {
3556  autogk_mheapresize(&state->heap, &state->heapsize, 4*state->heapsize, state->heapwidth, _state);
3557  }
3558 
3559  /*
3560  * TODO: every 20 iterations recalculate errors/sums
3561  */
3562  if( ae_fp_less_eq(state->sumerr,state->eps*state->sumabs)||state->heapused>=autogk_maxsubintervals )
3563  {
3564  state->r = 0;
3565  for(j=0; j<=state->heapused-1; j++)
3566  {
3567  state->r = state->r+state->heap.ptr.pp_double[j][1];
3568  }
3569  result = ae_false;
3570  return result;
3571  }
3572 
3573  /*
3574  * Exclude interval with maximum absolute error
3575  */
3576  autogk_mheappop(&state->heap, state->heapused, state->heapwidth, _state);
3577  state->sumerr = state->sumerr-state->heap.ptr.pp_double[state->heapused-1][0];
3578  state->sumabs = state->sumabs-state->heap.ptr.pp_double[state->heapused-1][2];
3579 
3580  /*
3581  * Divide interval, create subintervals
3582  */
3583  ta = state->heap.ptr.pp_double[state->heapused-1][3];
3584  tb = state->heap.ptr.pp_double[state->heapused-1][4];
3585  state->heap.ptr.pp_double[state->heapused-1][3] = ta;
3586  state->heap.ptr.pp_double[state->heapused-1][4] = 0.5*(ta+tb);
3587  state->heap.ptr.pp_double[state->heapused][3] = 0.5*(ta+tb);
3588  state->heap.ptr.pp_double[state->heapused][4] = tb;
3589  j = state->heapused-1;
3590 lbl_16:
3591  if( j>state->heapused )
3592  {
3593  goto lbl_18;
3594  }
3595  c1 = 0.5*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3]);
3596  c2 = 0.5*(state->heap.ptr.pp_double[j][4]+state->heap.ptr.pp_double[j][3]);
3597  intg = 0;
3598  intk = 0;
3599  inta = 0;
3600  i = 0;
3601 lbl_19:
3602  if( i>state->n-1 )
3603  {
3604  goto lbl_21;
3605  }
3606 
3607  /*
3608  * F(x)
3609  */
3610  state->x = c1*state->qn.ptr.p_double[i]+c2;
3611  state->rstate.stage = 2;
3612  goto lbl_rcomm;
3613 lbl_2:
3614  v = state->f;
3615 
3616  /*
3617  * Gauss-Kronrod formula
3618  */
3619  intk = intk+v*state->wk.ptr.p_double[i];
3620  if( i%2==1 )
3621  {
3622  intg = intg+v*state->wg.ptr.p_double[i];
3623  }
3624 
3625  /*
3626  * Integral |F(x)|
3627  * Use rectangles method
3628  */
3629  inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i];
3630  i = i+1;
3631  goto lbl_19;
3632 lbl_21:
3633  intk = intk*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
3634  intg = intg*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
3635  inta = inta*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5;
3636  state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state);
3637  state->heap.ptr.pp_double[j][1] = intk;
3638  state->heap.ptr.pp_double[j][2] = inta;
3639  state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0];
3640  state->sumabs = state->sumabs+state->heap.ptr.pp_double[j][2];
3641  j = j+1;
3642  goto lbl_16;
3643 lbl_18:
3644  autogk_mheappush(&state->heap, state->heapused-1, state->heapwidth, _state);
3645  autogk_mheappush(&state->heap, state->heapused, state->heapwidth, _state);
3646  state->heapused = state->heapused+1;
3647  goto lbl_14;
3648 lbl_15:
3649  result = ae_false;
3650  return result;
3651 
3652  /*
3653  * Saving state
3654  */
3655 lbl_rcomm:
3656  result = ae_true;
3657  state->rstate.ia.ptr.p_int[0] = i;
3658  state->rstate.ia.ptr.p_int[1] = j;
3659  state->rstate.ia.ptr.p_int[2] = ns;
3660  state->rstate.ia.ptr.p_int[3] = info;
3661  state->rstate.ra.ptr.p_double[0] = c1;
3662  state->rstate.ra.ptr.p_double[1] = c2;
3663  state->rstate.ra.ptr.p_double[2] = intg;
3664  state->rstate.ra.ptr.p_double[3] = intk;
3665  state->rstate.ra.ptr.p_double[4] = inta;
3666  state->rstate.ra.ptr.p_double[5] = v;
3667  state->rstate.ra.ptr.p_double[6] = ta;
3668  state->rstate.ra.ptr.p_double[7] = tb;
3669  state->rstate.ra.ptr.p_double[8] = qeps;
3670  return result;
3671 }
3672 
3673 
3674 static void autogk_mheappop(/* Real */ ae_matrix* heap,
3675  ae_int_t heapsize,
3676  ae_int_t heapwidth,
3677  ae_state *_state)
3678 {
3679  ae_int_t i;
3680  ae_int_t p;
3681  double t;
3682  ae_int_t maxcp;
3683 
3684 
3685  if( heapsize==1 )
3686  {
3687  return;
3688  }
3689  for(i=0; i<=heapwidth-1; i++)
3690  {
3691  t = heap->ptr.pp_double[heapsize-1][i];
3692  heap->ptr.pp_double[heapsize-1][i] = heap->ptr.pp_double[0][i];
3693  heap->ptr.pp_double[0][i] = t;
3694  }
3695  p = 0;
3696  while(2*p+1<heapsize-1)
3697  {
3698  maxcp = 2*p+1;
3699  if( 2*p+2<heapsize-1 )
3700  {
3701  if( ae_fp_greater(heap->ptr.pp_double[2*p+2][0],heap->ptr.pp_double[2*p+1][0]) )
3702  {
3703  maxcp = 2*p+2;
3704  }
3705  }
3706  if( ae_fp_less(heap->ptr.pp_double[p][0],heap->ptr.pp_double[maxcp][0]) )
3707  {
3708  for(i=0; i<=heapwidth-1; i++)
3709  {
3710  t = heap->ptr.pp_double[p][i];
3711  heap->ptr.pp_double[p][i] = heap->ptr.pp_double[maxcp][i];
3712  heap->ptr.pp_double[maxcp][i] = t;
3713  }
3714  p = maxcp;
3715  }
3716  else
3717  {
3718  break;
3719  }
3720  }
3721 }
3722 
3723 
3724 static void autogk_mheappush(/* Real */ ae_matrix* heap,
3725  ae_int_t heapsize,
3726  ae_int_t heapwidth,
3727  ae_state *_state)
3728 {
3729  ae_int_t i;
3730  ae_int_t p;
3731  double t;
3732  ae_int_t parent;
3733 
3734 
3735  if( heapsize==0 )
3736  {
3737  return;
3738  }
3739  p = heapsize;
3740  while(p!=0)
3741  {
3742  parent = (p-1)/2;
3743  if( ae_fp_greater(heap->ptr.pp_double[p][0],heap->ptr.pp_double[parent][0]) )
3744  {
3745  for(i=0; i<=heapwidth-1; i++)
3746  {
3747  t = heap->ptr.pp_double[p][i];
3748  heap->ptr.pp_double[p][i] = heap->ptr.pp_double[parent][i];
3749  heap->ptr.pp_double[parent][i] = t;
3750  }
3751  p = parent;
3752  }
3753  else
3754  {
3755  break;
3756  }
3757  }
3758 }
3759 
3760 
3761 static void autogk_mheapresize(/* Real */ ae_matrix* heap,
3762  ae_int_t* heapsize,
3763  ae_int_t newheapsize,
3764  ae_int_t heapwidth,
3765  ae_state *_state)
3766 {
3767  ae_frame _frame_block;
3768  ae_matrix tmp;
3769  ae_int_t i;
3770 
3771  ae_frame_make(_state, &_frame_block);
3772  ae_matrix_init(&tmp, 0, 0, DT_REAL, _state, ae_true);
3773 
3774  ae_matrix_set_length(&tmp, *heapsize, heapwidth, _state);
3775  for(i=0; i<=*heapsize-1; i++)
3776  {
3777  ae_v_move(&tmp.ptr.pp_double[i][0], 1, &heap->ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1));
3778  }
3779  ae_matrix_set_length(heap, newheapsize, heapwidth, _state);
3780  for(i=0; i<=*heapsize-1; i++)
3781  {
3782  ae_v_move(&heap->ptr.pp_double[i][0], 1, &tmp.ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1));
3783  }
3784  *heapsize = newheapsize;
3785  ae_frame_leave(_state);
3786 }
3787 
3788 
3789 ae_bool _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic)
3790 {
3791  autogkreport *p = (autogkreport*)_p;
3792  ae_touch_ptr((void*)p);
3793  return ae_true;
3794 }
3795 
3796 
3797 ae_bool _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
3798 {
3799  autogkreport *dst = (autogkreport*)_dst;
3800  autogkreport *src = (autogkreport*)_src;
3801  dst->terminationtype = src->terminationtype;
3802  dst->nfev = src->nfev;
3803  dst->nintervals = src->nintervals;
3804  return ae_true;
3805 }
3806 
3807 
3808 void _autogkreport_clear(void* _p)
3809 {
3810  autogkreport *p = (autogkreport*)_p;
3811  ae_touch_ptr((void*)p);
3812 }
3813 
3814 
3816 {
3817  autogkreport *p = (autogkreport*)_p;
3818  ae_touch_ptr((void*)p);
3819 }
3820 
3821 
3822 ae_bool _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
3823 {
3825  ae_touch_ptr((void*)p);
3826  if( !ae_matrix_init(&p->heap, 0, 0, DT_REAL, _state, make_automatic) )
3827  return ae_false;
3828  if( !ae_vector_init(&p->qn, 0, DT_REAL, _state, make_automatic) )
3829  return ae_false;
3830  if( !ae_vector_init(&p->wg, 0, DT_REAL, _state, make_automatic) )
3831  return ae_false;
3832  if( !ae_vector_init(&p->wk, 0, DT_REAL, _state, make_automatic) )
3833  return ae_false;
3834  if( !ae_vector_init(&p->wr, 0, DT_REAL, _state, make_automatic) )
3835  return ae_false;
3836  if( !_rcommstate_init(&p->rstate, _state, make_automatic) )
3837  return ae_false;
3838  return ae_true;
3839 }
3840 
3841 
3842 ae_bool _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
3843 {
3846  dst->a = src->a;
3847  dst->b = src->b;
3848  dst->eps = src->eps;
3849  dst->xwidth = src->xwidth;
3850  dst->x = src->x;
3851  dst->f = src->f;
3852  dst->info = src->info;
3853  dst->r = src->r;
3854  if( !ae_matrix_init_copy(&dst->heap, &src->heap, _state, make_automatic) )
3855  return ae_false;
3856  dst->heapsize = src->heapsize;
3857  dst->heapwidth = src->heapwidth;
3858  dst->heapused = src->heapused;
3859  dst->sumerr = src->sumerr;
3860  dst->sumabs = src->sumabs;
3861  if( !ae_vector_init_copy(&dst->qn, &src->qn, _state, make_automatic) )
3862  return ae_false;
3863  if( !ae_vector_init_copy(&dst->wg, &src->wg, _state, make_automatic) )
3864  return ae_false;
3865  if( !ae_vector_init_copy(&dst->wk, &src->wk, _state, make_automatic) )
3866  return ae_false;
3867  if( !ae_vector_init_copy(&dst->wr, &src->wr, _state, make_automatic) )
3868  return ae_false;
3869  dst->n = src->n;
3870  if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) )
3871  return ae_false;
3872  return ae_true;
3873 }
3874 
3875 
3877 {
3879  ae_touch_ptr((void*)p);
3880  ae_matrix_clear(&p->heap);
3881  ae_vector_clear(&p->qn);
3882  ae_vector_clear(&p->wg);
3883  ae_vector_clear(&p->wk);
3884  ae_vector_clear(&p->wr);
3885  _rcommstate_clear(&p->rstate);
3886 }
3887 
3888 
3890 {
3892  ae_touch_ptr((void*)p);
3893  ae_matrix_destroy(&p->heap);
3894  ae_vector_destroy(&p->qn);
3895  ae_vector_destroy(&p->wg);
3896  ae_vector_destroy(&p->wk);
3897  ae_vector_destroy(&p->wr);
3898  _rcommstate_destroy(&p->rstate);
3899 }
3900 
3901 
3902 ae_bool _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
3903 {
3904  autogkstate *p = (autogkstate*)_p;
3905  ae_touch_ptr((void*)p);
3906  if( !_autogkinternalstate_init(&p->internalstate, _state, make_automatic) )
3907  return ae_false;
3908  if( !_rcommstate_init(&p->rstate, _state, make_automatic) )
3909  return ae_false;
3910  return ae_true;
3911 }
3912 
3913 
3914 ae_bool _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
3915 {
3916  autogkstate *dst = (autogkstate*)_dst;
3917  autogkstate *src = (autogkstate*)_src;
3918  dst->a = src->a;
3919  dst->b = src->b;
3920  dst->alpha = src->alpha;
3921  dst->beta = src->beta;
3922  dst->xwidth = src->xwidth;
3923  dst->x = src->x;
3924  dst->xminusa = src->xminusa;
3925  dst->bminusx = src->bminusx;
3926  dst->needf = src->needf;
3927  dst->f = src->f;
3928  dst->wrappermode = src->wrappermode;
3929  if( !_autogkinternalstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic) )
3930  return ae_false;
3931  if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) )
3932  return ae_false;
3933  dst->v = src->v;
3934  dst->terminationtype = src->terminationtype;
3935  dst->nfev = src->nfev;
3936  dst->nintervals = src->nintervals;
3937  return ae_true;
3938 }
3939 
3940 
3941 void _autogkstate_clear(void* _p)
3942 {
3943  autogkstate *p = (autogkstate*)_p;
3944  ae_touch_ptr((void*)p);
3945  _autogkinternalstate_clear(&p->internalstate);
3946  _rcommstate_clear(&p->rstate);
3947 }
3948 
3949 
3950 void _autogkstate_destroy(void* _p)
3951 {
3952  autogkstate *p = (autogkstate*)_p;
3953  ae_touch_ptr((void*)p);
3954  _autogkinternalstate_destroy(&p->internalstate);
3955  _rcommstate_destroy(&p->rstate);
3956 }
3957 
3958 
3959 
3960 }
3961 
void autogksmooth(double a, double b, autogkstate *state, ae_state *_state)
ae_bool _autogkinternalstate_init_copy(void *_dst, void *_src, ae_state *_state, ae_bool make_automatic)
struct alglib_impl::ae_state ae_state
ae_bool ae_fp_greater_eq(double v1, double v2)
Definition: ap.cpp:1351
void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
void gkqgeneraterec(ae_vector *alpha, ae_vector *beta, double mu0, ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *wkronrod, ae_vector *wgauss, ae_state *_state)
ae_bool _autogkreport_init_copy(void *_dst, void *_src, ae_state *_state, ae_bool make_automatic)
alglib_impl::autogkreport * c_ptr()
void autogkintegrate(autogkstate &state, void(*func)(double x, double xminusa, double bminusx, double &y, void *ptr), void *ptr)
void gkqlegendrecalc(ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *wkronrod, ae_vector *wgauss, ae_state *_state)
void gqgenerategausshermite(ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
void gqgeneraterec(ae_vector *alpha, ae_vector *beta, double mu0, ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
double ae_fabs(double x, ae_state *state)
Definition: ap.cpp:1520
double ae_pow(double x, double y, ae_state *state)
Definition: ap.cpp:1684
#define ae_false
Definition: ap.h:196
void * ae_malloc(size_t size, ae_state *state)
Definition: ap.cpp:222
ae_bool autogkiteration(autogkstate *state, ae_state *_state)
double beta(const double a, const double b)
void _autogkinternalstate_destroy(void *_p)
union alglib_impl::ae_matrix::@12 ptr
void ae_frame_make(ae_state *state, ae_frame *tmp)
Definition: ap.cpp:402
static double * y
_autogkreport_owner & operator=(const _autogkreport_owner &rhs)
ae_int_t & terminationtype
Definition: integration.h:127
void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
Definition: integration.cpp:76
double lngamma(const double x, double &sgngam)
_autogkstate_owner & operator=(const _autogkstate_owner &rhs)
ae_vector ia
Definition: ap.h:837
void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
void autogksmoothw(double a, double b, double xwidth, autogkstate *state, ae_state *_state)
alglib_impl::autogkstate * p_struct
Definition: integration.h:153
void gkqgenerategausslegendre(ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *wkronrod, ae_vector *wgauss, ae_state *_state)
doublereal * w
autogkinternalstate internalstate
Definition: integration.h:75
double * p_double
Definition: ap.h:437
void autogkresults(const autogkstate &state, double &v, autogkreport &rep)
void gkqgenerategaussjacobi(ae_int_t n, double alpha, double beta, ae_int_t *info, ae_vector *x, ae_vector *wkronrod, ae_vector *wgauss, ae_state *_state)
void ae_state_clear(ae_state *state)
Definition: ap.cpp:373
void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state)
ae_bool ae_fp_eq(double v1, double v2)
Definition: ap.cpp:1313
cmache_1 eps
autogkreport & operator=(const autogkreport &rhs)
ae_bool ae_matrix_init_copy(ae_matrix *dst, ae_matrix *src, ae_state *state, ae_bool make_automatic)
Definition: ap.cpp:801
void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
ae_bool ae_matrix_init(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_datatype datatype, ae_state *state, ae_bool make_automatic)
Definition: ap.cpp:756
doublereal * x
void ae_matrix_destroy(ae_matrix *dst)
Definition: ap.cpp:909
#define i
ql0001_ & k(htemp+1),(cvec+1),(atemp+1),(bj+1),(bl+1),(bu+1),(x+1),(clamda+1), &iout, infoqp, &zero,(w+1), &lenw,(iw+1), &leniw, &glob_grd.epsmac
doublereal * d
autogkstate & operator=(const autogkstate &rhs)
void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w)
ae_int_t & nintervals
Definition: integration.h:129
void _rcommstate_destroy(rcommstate *p)
Definition: ap.cpp:4605
ae_int_t ae_v_len(ae_int_t a, ae_int_t b)
Definition: ap.cpp:4562
void ae_vector_destroy(ae_vector *dst)
Definition: ap.cpp:707
ae_bool _rcommstate_init(rcommstate *p, ae_state *_state, ae_bool make_automatic)
Definition: ap.cpp:4570
doublereal * b
double v1
bool autogkiteration(const autogkstate &state)
void tagsort(ae_vector *a, ae_int_t n, ae_vector *p1, ae_vector *p2, ae_state *_state)
ae_bool _rcommstate_init_copy(rcommstate *dst, rcommstate *src, ae_state *_state, ae_bool make_automatic)
Definition: ap.cpp:4583
void ae_v_move(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n)
Definition: ap.cpp:4371
double * f
void ae_vector_clear(ae_vector *dst)
Definition: ap.cpp:692
ae_bool ae_fp_less(double v1, double v2)
Definition: ap.cpp:1327
void gqgenerategausslegendre(ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
ae_int_t ae_iceil(double x, ae_state *state)
Definition: ap.cpp:1562
ae_vector ra
Definition: ap.h:839
#define ae_bool
Definition: ap.h:194
ae_bool ae_fp_neq(double v1, double v2)
Definition: ap.cpp:1321
void _autogkinternalstate_clear(void *_p)
void _autogkstate_clear(void *_p)
double z
void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
void ae_touch_ptr(void *p)
Definition: ap.cpp:294
void _autogkreport_clear(void *_p)
alglib_impl::autogkstate * c_ptr()
double ae_maxreal(double m1, double m2, ae_state *state)
Definition: ap.cpp:1577
ae_error_type
Definition: ap.h:201
void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
ae_bool ae_vector_set_length(ae_vector *dst, ae_int_t newsize, ae_state *state)
Definition: ap.cpp:658
void gqgenerategausslaguerre(ae_int_t n, double alpha, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
void _autogkstate_destroy(void *_p)
double ae_log(double x, ae_state *state)
Definition: ap.cpp:1679
const alglib_impl::ae_vector * c_ptr() const
Definition: ap.cpp:5907
void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state)
#define j
double ae_minreal(double m1, double m2, ae_state *state)
Definition: ap.cpp:1582
int m
void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w)
struct alglib_impl::ae_matrix ae_matrix
ae_int_t ae_ifloor(double x, ae_state *state)
Definition: ap.cpp:1557
double ** pp_double
Definition: ap.h:455
void gqgenerategaussjacobi(ae_int_t n, double alpha, double beta, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
void ae_state_init(ae_state *state)
Definition: ap.cpp:309
bool smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z)
Definition: linalg.cpp:2247
void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps)
double ae_sqrt(double x, ae_state *state)
Definition: ap.cpp:1535
void ae_assert(ae_bool cond, const char *msg, ae_state *state)
Definition: ap.cpp:1227
union alglib_impl::ae_vector::@11 ptr
const char *volatile error_msg
Definition: ap.h:389
double ae_atan(double x, ae_state *state)
Definition: ap.cpp:1669
#define ae_machineepsilon
Definition: ap.h:825
double ae_exp(double x, ae_state *state)
Definition: ap.cpp:1689
void autogksmooth(const double a, const double b, autogkstate &state)
void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss)
ae_bool _autogkstate_init(void *_p, ae_state *_state, ae_bool make_automatic)
alglib_impl::autogkreport * p_struct
Definition: integration.h:118
void _rcommstate_clear(rcommstate *p)
Definition: ap.cpp:4597
ptrdiff_t ae_int_t
Definition: ap.h:186
doublereal * u
ae_bool ae_vector_init(ae_vector *dst, ae_int_t size, ae_datatype datatype, ae_state *state, ae_bool make_automatic)
Definition: ap.cpp:580
void autogksingular(double a, double b, double alpha, double beta, autogkstate *state, ae_state *_state)
ae_bool ae_isfinite(double x, ae_state *state)
Definition: ap.cpp:1495
double ae_sqr(double x, ae_state *state)
Definition: ap.cpp:1530
ae_bool _autogkreport_init(void *_p, ae_state *_state, ae_bool make_automatic)
void _autogkreport_destroy(void *_p)
void gqgenerategausslobattorec(ae_vector *alpha, ae_vector *beta, double mu0, double a, double b, ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w)
ae_int_t * p_int
Definition: ap.h:436
ae_bool ae_vector_init_copy(ae_vector *dst, ae_vector *src, ae_state *state, ae_bool make_automatic)
Definition: ap.cpp:614
void gqgenerategaussradaurec(ae_vector *alpha, ae_vector *beta, double mu0, double a, ae_int_t n, ae_int_t *info, ae_vector *x, ae_vector *w, ae_state *_state)
ae_bool ae_fp_less_eq(double v1, double v2)
Definition: ap.cpp:1335
ae_bool _autogkstate_init_copy(void *_dst, void *_src, ae_state *_state, ae_bool make_automatic)
alglib_impl::ae_int_t ae_int_t
Definition: ap.h:889
void ae_frame_leave(ae_state *state)
Definition: ap.cpp:415
void ae_matrix_clear(ae_matrix *dst)
Definition: ap.cpp:891
#define ae_true
Definition: ap.h:195
int * n
ae_bool ae_fp_greater(double v1, double v2)
Definition: ap.cpp:1343
ae_bool ae_matrix_set_length(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_state *state)
Definition: ap.cpp:854
doublereal * a
void autogkresults(autogkstate *state, double *v, autogkreport *rep, ae_state *_state)
ae_bool _autogkinternalstate_init(void *_p, ae_state *_state, ae_bool make_automatic)
void ae_free(void *p)
Definition: ap.cpp:237
void gkqlegendretbl(ae_int_t n, ae_vector *x, ae_vector *wkronrod, ae_vector *wgauss, double *eps, ae_state *_state)
#define ae_maxrealnumber
Definition: ap.h:826