Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This module contains classes and procedures to perform numerical integrations.
19 : !>
20 : !> \test
21 : !> [test_pm_distExp](@ref test_pm_distExp)
22 : !>
23 : !> \finmain
24 : !>
25 : !> \author
26 : !> \AmirShahmoradi, Oct 16, 2009, 4:41 AM, Michigan<br>
27 : !> \JoshuaOsborne, May 28, 2020, 9:06 PM, Arlington, TX<br>
28 :
29 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
30 :
31 : module pm_quadRomb
32 :
33 : use pm_kind, only: IK, RK, SK
34 :
35 : implicit none
36 :
37 : character(*, SK), parameter :: MODULE_NAME = "@pm_quadRomb"
38 :
39 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
40 :
41 : !> \brief
42 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open.
43 : !>
44 : !> \details
45 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
46 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).
47 : !>
48 : !> \interface
49 : !> \code{.F90}
50 : !>
51 : !> use pm_quadRomb, only: open_type
52 : !> type(open_type) :: Open
53 : !>
54 : !> \endcode
55 : !>
56 : !> \see
57 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
58 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
59 : !> [open_type](@ref pm_quadRomb::open_type)<br>
60 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
61 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
62 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
63 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
64 : !>
65 : !> \example
66 : !> \include{lineno} example/pm_quadRomb/open_type/main.F90
67 : !> \compilef
68 : !> \output
69 : !> \include{lineno} example/pm_quadRomb/open_type/main.out.F90
70 : !>
71 : !> \test
72 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
73 : !>
74 : !> \finmain
75 : !>
76 : !> \author
77 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
78 : type :: open_type
79 : end type
80 :
81 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
82 :
83 : !> \brief
84 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open \f$(a, b)\f$ and,
85 : !> the intervals should be spaced assuming an integrand that behaves like,
86 : !> <ol>
87 : !> <li> a decreasing Power-Law (PWL) on a positive support \f$(a > 0, b > 0)\f$, such that the upper limit of integration is allowed to be \f$b = +\infty\f$, or
88 : !> <li> an increasing Power-Law (PWL) on a negative support \f$(a < 0, b < 0)\f$, such that the lower limit of integration is allowed to be \f$a = -\infty\f$.
89 : !> </ol>
90 : !>
91 : !> \details
92 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
93 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).<br>
94 : !>
95 : !> \interface
96 : !> \code{.F90}
97 : !>
98 : !> use pm_quadRomb, only: pwrl_type
99 : !> type(pwrl_type) :: PWRL
100 : !>
101 : !> \endcode
102 : !>
103 : !> \see
104 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
105 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
106 : !> [open_type](@ref pm_quadRomb::open_type)<br>
107 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
108 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
109 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
110 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
111 : !>
112 : !> \example
113 : !> \include{lineno} example/pm_quadRomb/pwrl_type/main.F90
114 : !> \compilef
115 : !> \output
116 : !> \include{lineno} example/pm_quadRomb/pwrl_type/main.out.F90
117 : !>
118 : !> \test
119 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
120 : !>
121 : !> \finmain
122 : !>
123 : !> \author
124 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
125 : type :: pwrl_type
126 : end type
127 :
128 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
129 :
130 : !> \brief
131 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open and,
132 : !> the intervals should be spaced assuming an integrand that behaves like a Negative-Exponent Exponential (NEXP),
133 : !> such that the upper limit of integration is allowed to be \f$b = +\infty\f$.
134 : !>
135 : !> \details
136 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
137 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).<br>
138 : !>
139 : !> \interface
140 : !> \code{.F90}
141 : !>
142 : !> use pm_quadRomb, only: nexp_type
143 : !> type(nexp_type) :: NEXP
144 : !>
145 : !> \endcode
146 : !>
147 : !> \see
148 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
149 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
150 : !> [open_type](@ref pm_quadRomb::open_type)<br>
151 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
152 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
153 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
154 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
155 : !>
156 : !> \example
157 : !> \include{lineno} example/pm_quadRomb/nexp_type/main.F90
158 : !> \compilef
159 : !> \output
160 : !> \include{lineno} example/pm_quadRomb/nexp_type/main.out.F90
161 : !>
162 : !> \test
163 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
164 : !>
165 : !> \finmain
166 : !>
167 : !> \author
168 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
169 : type :: nexp_type
170 : end type
171 :
172 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
173 :
174 : !> \brief
175 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open and,
176 : !> the intervals should be spaced assuming an integrand that behaves like a Positive-Exponent Exponential (PEXP),
177 : !> such that the lower limit of integration is allowed to be \f$a = -\infty\f$.
178 : !>
179 : !> \details
180 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
181 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).<br>
182 : !>
183 : !> \interface
184 : !> \code{.F90}
185 : !>
186 : !> use pm_quadRomb, only: pexp_type
187 : !> type(pexp_type) :: PEXP
188 : !>
189 : !> \endcode
190 : !>
191 : !> \see
192 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
193 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
194 : !> [open_type](@ref pm_quadRomb::open_type)<br>
195 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
196 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
197 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
198 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
199 : !>
200 : !> \example
201 : !> \include{lineno} example/pm_quadRomb/pexp_type/main.F90
202 : !> \compilef
203 : !> \output
204 : !> \include{lineno} example/pm_quadRomb/pexp_type/main.out.F90
205 : !>
206 : !> \test
207 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
208 : !>
209 : !> \finmain
210 : !>
211 : !> \author
212 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
213 : type :: pexp_type
214 : end type
215 :
216 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
217 :
218 : !> \brief
219 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open and,
220 : !> the integrand has an Integrable square-root type of Singularity at the finite Lower Bound of integration (LBIS).
221 : !>
222 : !> \details
223 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
224 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).<br>
225 : !>
226 : !> \interface
227 : !> \code{.F90}
228 : !>
229 : !> use pm_quadRomb, only: lbis_type
230 : !> type(lbis_type) :: LBIS
231 : !>
232 : !> \endcode
233 : !>
234 : !> \see
235 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
236 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
237 : !> [open_type](@ref pm_quadRomb::open_type)<br>
238 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
239 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
240 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
241 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
242 : !>
243 : !> \example
244 : !> \include{lineno} example/pm_quadRomb/lbis_type/main.F90
245 : !> \compilef
246 : !> \output
247 : !> \include{lineno} example/pm_quadRomb/lbis_type/main.out.F90
248 : !>
249 : !> \test
250 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
251 : !>
252 : !> \finmain
253 : !>
254 : !> \author
255 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
256 : type :: lbis_type
257 : real :: exponent = 0.5
258 : end type
259 :
260 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
261 :
262 : !> \brief
263 : !> This is the indicator type for generating instances of objects that indicate the integration interval is open and,
264 : !> the integrand has an Integrable square-root type of Singularity at the finite Lower Bound of integration (LBIS).
265 : !>
266 : !> \details
267 : !> This is an empty derived type that exists solely for generating unique objects that are distinguishable
268 : !> as input arguments to procedures under the generic interface [getQuadRomb](@ref pm_quadRomb::getQuadRomb).<br>
269 : !>
270 : !> \interface
271 : !> \code{.F90}
272 : !>
273 : !> use pm_quadRomb, only: ubis_type
274 : !> type(ubis_type) :: UBIS
275 : !>
276 : !> \endcode
277 : !>
278 : !> \see
279 : !> [lbis_type](@ref pm_quadRomb::lbis_type)<br>
280 : !> [nexp_type](@ref pm_quadRomb::nexp_type)<br>
281 : !> [open_type](@ref pm_quadRomb::open_type)<br>
282 : !> [pexp_type](@ref pm_quadRomb::pexp_type)<br>
283 : !> [pwrl_type](@ref pm_quadRomb::pwrl_type)<br>
284 : !> [ubis_type](@ref pm_quadRomb::ubis_type)<br>
285 : !> [getQuadRomb](@ref pm_quadRomb::getQuadRomb)<br>
286 : !>
287 : !> \example
288 : !> \include{lineno} example/pm_quadRomb/ubis_type/main.F90
289 : !> \compilef
290 : !> \output
291 : !> \include{lineno} example/pm_quadRomb/ubis_type/main.out.F90
292 : !>
293 : !> \test
294 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
295 : !>
296 : !> \finmain
297 : !>
298 : !> \author
299 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
300 : type :: ubis_type
301 : real :: exponent = 0.5
302 : end type
303 :
304 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
305 :
306 : !> \brief
307 : !> Generate and return the integral of the input function `getFunc()` in the closed range `[lb, ub]` using the **Adaptive Romberg extrapolation method**.
308 : !>
309 : !> \details
310 : !> This Romberg integration method is quite powerful for sufficiently smooth (e.g., analytic) integrands `getFunc()`,
311 : !> integrated over bounded intervals which contain no singularities, and where the end points are also nonsingular.
312 : !>
313 : !> \param getFunc : The input function to be integrated (i.e., the integrand).
314 : !> -# On entry, it must take an input scalar of the same type and kind as `quadRomb`.<br>
315 : !> -# On exit, it must generate an input scalar of the same type and kind as `quadRomb`, representing the corresponding function value.<br>
316 : !> The following illustrates the general interface of `getFunc`:
317 : !> \code{.F90}
318 : !>
319 : !> function getFunc(x) result(func)
320 : !> use pm_kind, only: RK => RKC
321 : !> real(RK) , intent(in) :: x
322 : !> real(RK) :: func
323 : !> end function
324 : !>
325 : !> \endcode
326 : !> where `RKC` refers to any desired `real` kind supported by the processor.<br>
327 : !> \param[in] lb : The input scalar of the same type and kind as the output `quadRomb`, containing the lower bound of the integration.
328 : !> \param[in] ub : The input scalar of the same type and kind as the output `quadRomb`, containing the upper bound of the integration.
329 : !> \param[in] tol : The input scalar of the same type and kind as the output `quadRomb`, containing the *relative* error the integration.<br>
330 : !> The algorithm converges if \f$\ms{relerr} ~(~\equiv |\Delta\ms{quadRomb}|~) ~\leq~ \ms{tol} \times | \ms{quadRomb} |\f$.<br>
331 : !> Note that `tol > epsilon(0._RKC)` must hold at all times for integration to converge. Here `RKC` is the desired `real` kind of the output.<br>
332 : !> Ideally, set `tol` to a value such that `tol < epsilon(0._RKC) * 100` holds to ensure convergence.<br>
333 : !> \param[in] nref : The input scalar `integer` of default kind \IK, representing the number of refinements to be used in the Romberg method.<br>
334 : !> Think of `nref` as the maximum possible degree of the polynomial extrapolation used for approximating the integral at any stage.
335 : !> <ul>
336 : !> <li> The smaller values of `nref` can delay an accurate estimation of the integral via the Romberg method.
337 : !> <li> The larger values of `nref` can delay the first estimation of the integral by requiring more function evaluations.
338 : !> <li> The computational precision of the `real` kind used in this procedure imposes an upper limit on the value of `nref`.<br>
339 : !> The maximum value for `nref` is roughly equal to `int(log(epsilon(1._RKC)) / log(0.25))`
340 : !> with `RKC` representing the `real` kind used for the integration.
341 : !> <li> The maximum `nref` for `real32`, `real64`, `real128` are respectively `12`, `26`, `56`.<br>
342 : !> <li> If the specified `nref` is larger than the maximum possible value, the integration will fail to converge.<br>
343 : !> <li> The number `nref = 2` corresponds to the famous Simpson integration rule.
344 : !> <li> A number between 4-6 is frequently a reasonable choice.
345 : !> </ul>
346 : !> \param[out] relerr : The output scalar of the same type and kind as the output `quadRomb` containing the final estimated relative error in the result.<br>
347 : !> By definition, this is **always a positive** value **if the integration converges**.<br>
348 : !> **Specify the `relerr` optional output argument to monitor convergence**.<br>
349 : !> If `relerr < 0.`, then the integration has failed to converge.<br>
350 : !> (**optional**. If missing and the integration fails to converge, the program will halt by calling `error stop`.)<br>
351 : !> \param[out] neval : The output scalar `integer` of default kind \IK, representing the number of function evaluations made within the integrator.<br>
352 : !> (**optional**. It can be present <b>if and only if</b> `relerr` argument is also present.)
353 : !>
354 : !> \return
355 : !> `quadRomb` : The output scalar `real` of kind \RKALL, containing the integration result.
356 : !>
357 : !> \interface
358 : !> \code{.F90}
359 : !>
360 : !> use pm_quadRomb, only: getQuadRomb
361 : !>
362 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref)
363 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref, relerr)
364 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref, relerr, neval)
365 : !>
366 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref, interval)
367 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref, interval, relerr)
368 : !> quadRomb = getQuadRomb(getFunc, lb, ub, tol, nref, interval, relerr, neval)
369 : !>
370 : !> \endcode
371 : !>
372 : !> \warning
373 : !> The procedures of this generic interface will behave differently if the integration fails to converge:
374 : !> <ul>
375 : !> <li> If the optional `relerr` output argument is missing, the program will halt by calling `error stop` upon integration convergence failure.
376 : !> <li> If the optional `relerr` output argument is present, the program will return `relerr < 0.` to indicate integration convergence failure.
377 : !> </ul>
378 : !>
379 : !> \see
380 : !> [getQuadErr](@ref pm_quadPack::getQuadErr)<br>
381 : !>
382 : !> \example
383 : !> \include{lineno} example/pm_quadRomb/getQuadRomb/main.F90
384 : !> \compilef
385 : !> \output
386 : !> \include{lineno} example/pm_quadRomb/getQuadRomb/main.out.F90
387 : !>
388 : !> \test
389 : !> [test_pm_quadRomb](@ref test_pm_quadRomb)
390 : !>
391 : !> \finmain
392 : !>
393 : !> \author
394 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
395 : !> \JoshuaOsborne, May 28, 2020, 8:58 PM, Arlington, TX
396 : interface getQuadRomb
397 :
398 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
399 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
400 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
401 :
402 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
403 :
404 : #if RK5_ENABLED
405 : recursive impure module function getQR_Clos_EM_NM_RK5(getFunc, lb, ub, tol, nref) result(quadRomb)
406 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
407 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EM_NM_RK5
408 : #endif
409 : use pm_kind, only: RKC => RK5
410 : procedure(real(RKC)) :: getFunc
411 : real(RKC) , intent(in) :: lb, ub, tol
412 : integer(IK) , intent(in) :: nref
413 : real(RKC) :: quadRomb
414 : end function
415 : #endif
416 :
417 : #if RK4_ENABLED
418 : recursive impure module function getQR_Clos_EM_NM_RK4(getFunc, lb, ub, tol, nref) result(quadRomb)
419 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
420 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EM_NM_RK4
421 : #endif
422 : use pm_kind, only: RKC => RK4
423 : procedure(real(RKC)) :: getFunc
424 : real(RKC) , intent(in) :: lb, ub, tol
425 : integer(IK) , intent(in) :: nref
426 : real(RKC) :: quadRomb
427 : end function
428 : #endif
429 :
430 : #if RK3_ENABLED
431 : recursive impure module function getQR_Clos_EM_NM_RK3(getFunc, lb, ub, tol, nref) result(quadRomb)
432 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
433 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EM_NM_RK3
434 : #endif
435 : use pm_kind, only: RKC => RK3
436 : procedure(real(RKC)) :: getFunc
437 : real(RKC) , intent(in) :: lb, ub, tol
438 : integer(IK) , intent(in) :: nref
439 : real(RKC) :: quadRomb
440 : end function
441 : #endif
442 :
443 : #if RK2_ENABLED
444 : recursive impure module function getQR_Clos_EM_NM_RK2(getFunc, lb, ub, tol, nref) result(quadRomb)
445 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
446 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EM_NM_RK2
447 : #endif
448 : use pm_kind, only: RKC => RK2
449 : procedure(real(RKC)) :: getFunc
450 : real(RKC) , intent(in) :: lb, ub, tol
451 : integer(IK) , intent(in) :: nref
452 : real(RKC) :: quadRomb
453 : end function
454 : #endif
455 :
456 : #if RK1_ENABLED
457 : recursive impure module function getQR_Clos_EM_NM_RK1(getFunc, lb, ub, tol, nref) result(quadRomb)
458 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
459 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EM_NM_RK1
460 : #endif
461 : use pm_kind, only: RKC => RK1
462 : procedure(real(RKC)) :: getFunc
463 : real(RKC) , intent(in) :: lb, ub, tol
464 : integer(IK) , intent(in) :: nref
465 : real(RKC) :: quadRomb
466 : end function
467 : #endif
468 :
469 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
470 :
471 : #if RK5_ENABLED
472 : recursive impure module function getQR_Clos_EP_NM_RK5(getFunc, lb, ub, tol, nref, relerr) result(quadRomb)
473 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
474 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NM_RK5
475 : #endif
476 : use pm_kind, only: RKC => RK5
477 : procedure(real(RKC)) :: getFunc
478 : real(RKC) , intent(in) :: lb, ub, tol
479 : integer(IK) , intent(in) :: nref
480 : real(RKC) , intent(out) :: relerr
481 : real(RKC) :: quadRomb
482 : end function
483 : #endif
484 :
485 : #if RK4_ENABLED
486 : recursive impure module function getQR_Clos_EP_NM_RK4(getFunc, lb, ub, tol, nref, relerr) result(quadRomb)
487 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
488 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NM_RK4
489 : #endif
490 : use pm_kind, only: RKC => RK4
491 : procedure(real(RKC)) :: getFunc
492 : real(RKC) , intent(in) :: lb, ub, tol
493 : integer(IK) , intent(in) :: nref
494 : real(RKC) , intent(out) :: relerr
495 : real(RKC) :: quadRomb
496 : end function
497 : #endif
498 :
499 : #if RK3_ENABLED
500 : recursive impure module function getQR_Clos_EP_NM_RK3(getFunc, lb, ub, tol, nref, relerr) result(quadRomb)
501 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
502 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NM_RK3
503 : #endif
504 : use pm_kind, only: RKC => RK3
505 : procedure(real(RKC)) :: getFunc
506 : real(RKC) , intent(in) :: lb, ub, tol
507 : integer(IK) , intent(in) :: nref
508 : real(RKC) , intent(out) :: relerr
509 : real(RKC) :: quadRomb
510 : end function
511 : #endif
512 :
513 : #if RK2_ENABLED
514 : recursive impure module function getQR_Clos_EP_NM_RK2(getFunc, lb, ub, tol, nref, relerr) result(quadRomb)
515 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
516 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NM_RK2
517 : #endif
518 : use pm_kind, only: RKC => RK2
519 : procedure(real(RKC)) :: getFunc
520 : real(RKC) , intent(in) :: lb, ub, tol
521 : integer(IK) , intent(in) :: nref
522 : real(RKC) , intent(out) :: relerr
523 : real(RKC) :: quadRomb
524 : end function
525 : #endif
526 :
527 : #if RK1_ENABLED
528 : recursive impure module function getQR_Clos_EP_NM_RK1(getFunc, lb, ub, tol, nref, relerr) result(quadRomb)
529 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
530 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NM_RK1
531 : #endif
532 : use pm_kind, only: RKC => RK1
533 : procedure(real(RKC)) :: getFunc
534 : real(RKC) , intent(in) :: lb, ub, tol
535 : integer(IK) , intent(in) :: nref
536 : real(RKC) , intent(out) :: relerr
537 : real(RKC) :: quadRomb
538 : end function
539 : #endif
540 :
541 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
542 :
543 : #if RK5_ENABLED
544 : recursive impure module function getQR_Clos_EP_NP_RK5(getFunc, lb, ub, tol, nref, relerr, neval) result(quadRomb)
545 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
546 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NP_RK5
547 : #endif
548 : use pm_kind, only: RKC => RK5
549 : procedure(real(RKC)) :: getFunc
550 : real(RKC) , intent(in) :: lb, ub, tol
551 : integer(IK) , intent(in) :: nref
552 : integer(IK) , intent(out) :: neval
553 : real(RKC) , intent(out) :: relerr
554 : real(RKC) :: quadRomb
555 : end function
556 : #endif
557 :
558 : #if RK4_ENABLED
559 : recursive impure module function getQR_Clos_EP_NP_RK4(getFunc, lb, ub, tol, nref, relerr, neval) result(quadRomb)
560 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
561 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NP_RK4
562 : #endif
563 : use pm_kind, only: RKC => RK4
564 : procedure(real(RKC)) :: getFunc
565 : real(RKC) , intent(in) :: lb, ub, tol
566 : integer(IK) , intent(in) :: nref
567 : integer(IK) , intent(out) :: neval
568 : real(RKC) , intent(out) :: relerr
569 : real(RKC) :: quadRomb
570 : end function
571 : #endif
572 :
573 : #if RK3_ENABLED
574 : recursive impure module function getQR_Clos_EP_NP_RK3(getFunc, lb, ub, tol, nref, relerr, neval) result(quadRomb)
575 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
576 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NP_RK3
577 : #endif
578 : use pm_kind, only: RKC => RK3
579 : procedure(real(RKC)) :: getFunc
580 : real(RKC) , intent(in) :: lb, ub, tol
581 : integer(IK) , intent(in) :: nref
582 : integer(IK) , intent(out) :: neval
583 : real(RKC) , intent(out) :: relerr
584 : real(RKC) :: quadRomb
585 : end function
586 : #endif
587 :
588 : #if RK2_ENABLED
589 : recursive impure module function getQR_Clos_EP_NP_RK2(getFunc, lb, ub, tol, nref, relerr, neval) result(quadRomb)
590 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
591 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NP_RK2
592 : #endif
593 : use pm_kind, only: RKC => RK2
594 : procedure(real(RKC)) :: getFunc
595 : real(RKC) , intent(in) :: lb, ub, tol
596 : integer(IK) , intent(in) :: nref
597 : integer(IK) , intent(out) :: neval
598 : real(RKC) , intent(out) :: relerr
599 : real(RKC) :: quadRomb
600 : end function
601 : #endif
602 :
603 : #if RK1_ENABLED
604 : recursive impure module function getQR_Clos_EP_NP_RK1(getFunc, lb, ub, tol, nref, relerr, neval) result(quadRomb)
605 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
606 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Clos_EP_NP_RK1
607 : #endif
608 : use pm_kind, only: RKC => RK1
609 : procedure(real(RKC)) :: getFunc
610 : real(RKC) , intent(in) :: lb, ub, tol
611 : integer(IK) , intent(in) :: nref
612 : integer(IK) , intent(out) :: neval
613 : real(RKC) , intent(out) :: relerr
614 : real(RKC) :: quadRomb
615 : end function
616 : #endif
617 :
618 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
619 :
620 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
621 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
622 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
623 :
624 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
625 :
626 : #if RK5_ENABLED
627 : recursive impure module function getQR_Open_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
628 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
629 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EM_NM_RK5
630 : #endif
631 : use pm_kind, only: RKC => RK5
632 : procedure(real(RKC)) :: getFunc
633 : real(RKC) , intent(in) :: lb, ub, tol
634 : integer(IK) , intent(in) :: nref
635 : type(open_type) :: interval
636 : real(RKC) :: quadRomb
637 : end function
638 : #endif
639 :
640 : #if RK4_ENABLED
641 : recursive impure module function getQR_Open_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
642 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
643 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EM_NM_RK4
644 : #endif
645 : use pm_kind, only: RKC => RK4
646 : procedure(real(RKC)) :: getFunc
647 : real(RKC) , intent(in) :: lb, ub, tol
648 : integer(IK) , intent(in) :: nref
649 : type(open_type) :: interval
650 : real(RKC) :: quadRomb
651 : end function
652 : #endif
653 :
654 : #if RK3_ENABLED
655 : recursive impure module function getQR_Open_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
656 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
657 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EM_NM_RK3
658 : #endif
659 : use pm_kind, only: RKC => RK3
660 : procedure(real(RKC)) :: getFunc
661 : real(RKC) , intent(in) :: lb, ub, tol
662 : integer(IK) , intent(in) :: nref
663 : type(open_type) :: interval
664 : real(RKC) :: quadRomb
665 : end function
666 : #endif
667 :
668 : #if RK2_ENABLED
669 : recursive impure module function getQR_Open_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
670 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
671 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EM_NM_RK2
672 : #endif
673 : use pm_kind, only: RKC => RK2
674 : procedure(real(RKC)) :: getFunc
675 : real(RKC) , intent(in) :: lb, ub, tol
676 : integer(IK) , intent(in) :: nref
677 : type(open_type) :: interval
678 : real(RKC) :: quadRomb
679 : end function
680 : #endif
681 :
682 : #if RK1_ENABLED
683 : recursive impure module function getQR_Open_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
684 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
685 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EM_NM_RK1
686 : #endif
687 : use pm_kind, only: RKC => RK1
688 : procedure(real(RKC)) :: getFunc
689 : real(RKC) , intent(in) :: lb, ub, tol
690 : integer(IK) , intent(in) :: nref
691 : type(open_type) :: interval
692 : real(RKC) :: quadRomb
693 : end function
694 : #endif
695 :
696 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
697 :
698 : #if RK5_ENABLED
699 : recursive impure module function getQR_Open_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
700 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
701 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NM_RK5
702 : #endif
703 : use pm_kind, only: RKC => RK5
704 : procedure(real(RKC)) :: getFunc
705 : real(RKC) , intent(in) :: lb, ub, tol
706 : integer(IK) , intent(in) :: nref
707 : type(open_type) :: interval
708 : real(RKC) , intent(out) :: relerr
709 : real(RKC) :: quadRomb
710 : end function
711 : #endif
712 :
713 : #if RK4_ENABLED
714 : recursive impure module function getQR_Open_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
715 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
716 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NM_RK4
717 : #endif
718 : use pm_kind, only: RKC => RK4
719 : procedure(real(RKC)) :: getFunc
720 : real(RKC) , intent(in) :: lb, ub, tol
721 : integer(IK) , intent(in) :: nref
722 : type(open_type) :: interval
723 : real(RKC) , intent(out) :: relerr
724 : real(RKC) :: quadRomb
725 : end function
726 : #endif
727 :
728 : #if RK3_ENABLED
729 : recursive impure module function getQR_Open_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
730 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
731 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NM_RK3
732 : #endif
733 : use pm_kind, only: RKC => RK3
734 : procedure(real(RKC)) :: getFunc
735 : real(RKC) , intent(in) :: lb, ub, tol
736 : integer(IK) , intent(in) :: nref
737 : type(open_type) :: interval
738 : real(RKC) , intent(out) :: relerr
739 : real(RKC) :: quadRomb
740 : end function
741 : #endif
742 :
743 : #if RK2_ENABLED
744 : recursive impure module function getQR_Open_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
745 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
746 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NM_RK2
747 : #endif
748 : use pm_kind, only: RKC => RK2
749 : procedure(real(RKC)) :: getFunc
750 : real(RKC) , intent(in) :: lb, ub, tol
751 : integer(IK) , intent(in) :: nref
752 : type(open_type) :: interval
753 : real(RKC) , intent(out) :: relerr
754 : real(RKC) :: quadRomb
755 : end function
756 : #endif
757 :
758 : #if RK1_ENABLED
759 : recursive impure module function getQR_Open_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
760 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
761 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NM_RK1
762 : #endif
763 : use pm_kind, only: RKC => RK1
764 : procedure(real(RKC)) :: getFunc
765 : real(RKC) , intent(in) :: lb, ub, tol
766 : integer(IK) , intent(in) :: nref
767 : type(open_type) :: interval
768 : real(RKC) , intent(out) :: relerr
769 : real(RKC) :: quadRomb
770 : end function
771 : #endif
772 :
773 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
774 :
775 : #if RK5_ENABLED
776 : recursive impure module function getQR_Open_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
777 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
778 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NP_RK5
779 : #endif
780 : use pm_kind, only: RKC => RK5
781 : procedure(real(RKC)) :: getFunc
782 : real(RKC) , intent(in) :: lb, ub, tol
783 : integer(IK) , intent(in) :: nref
784 : type(open_type) :: interval
785 : integer(IK) , intent(out) :: neval
786 : real(RKC) , intent(out) :: relerr
787 : real(RKC) :: quadRomb
788 : end function
789 : #endif
790 :
791 : #if RK4_ENABLED
792 : recursive impure module function getQR_Open_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
793 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
794 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NP_RK4
795 : #endif
796 : use pm_kind, only: RKC => RK4
797 : procedure(real(RKC)) :: getFunc
798 : real(RKC) , intent(in) :: lb, ub, tol
799 : integer(IK) , intent(in) :: nref
800 : type(open_type) :: interval
801 : integer(IK) , intent(out) :: neval
802 : real(RKC) , intent(out) :: relerr
803 : real(RKC) :: quadRomb
804 : end function
805 : #endif
806 :
807 : #if RK3_ENABLED
808 : recursive impure module function getQR_Open_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
809 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
810 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NP_RK3
811 : #endif
812 : use pm_kind, only: RKC => RK3
813 : procedure(real(RKC)) :: getFunc
814 : real(RKC) , intent(in) :: lb, ub, tol
815 : integer(IK) , intent(in) :: nref
816 : type(open_type) :: interval
817 : integer(IK) , intent(out) :: neval
818 : real(RKC) , intent(out) :: relerr
819 : real(RKC) :: quadRomb
820 : end function
821 : #endif
822 :
823 : #if RK2_ENABLED
824 : recursive impure module function getQR_Open_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
825 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
826 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NP_RK2
827 : #endif
828 : use pm_kind, only: RKC => RK2
829 : procedure(real(RKC)) :: getFunc
830 : real(RKC) , intent(in) :: lb, ub, tol
831 : integer(IK) , intent(in) :: nref
832 : type(open_type) :: interval
833 : integer(IK) , intent(out) :: neval
834 : real(RKC) , intent(out) :: relerr
835 : real(RKC) :: quadRomb
836 : end function
837 : #endif
838 :
839 : #if RK1_ENABLED
840 : recursive impure module function getQR_Open_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
841 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
842 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_Open_EP_NP_RK1
843 : #endif
844 : use pm_kind, only: RKC => RK1
845 : procedure(real(RKC)) :: getFunc
846 : real(RKC) , intent(in) :: lb, ub, tol
847 : integer(IK) , intent(in) :: nref
848 : type(open_type) :: interval
849 : integer(IK) , intent(out) :: neval
850 : real(RKC) , intent(out) :: relerr
851 : real(RKC) :: quadRomb
852 : end function
853 : #endif
854 :
855 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
856 :
857 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
858 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
859 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
860 :
861 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
862 :
863 : #if RK5_ENABLED
864 : recursive impure module function getQR_PWRL_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
865 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
866 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EM_NM_RK5
867 : #endif
868 : use pm_kind, only: RKC => RK5
869 : procedure(real(RKC)) :: getFunc
870 : real(RKC) , intent(in) :: lb, ub, tol
871 : integer(IK) , intent(in) :: nref
872 : type(pwrl_type) :: interval
873 : real(RKC) :: quadRomb
874 : end function
875 : #endif
876 :
877 : #if RK4_ENABLED
878 : recursive impure module function getQR_PWRL_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
879 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
880 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EM_NM_RK4
881 : #endif
882 : use pm_kind, only: RKC => RK4
883 : procedure(real(RKC)) :: getFunc
884 : real(RKC) , intent(in) :: lb, ub, tol
885 : integer(IK) , intent(in) :: nref
886 : type(pwrl_type) :: interval
887 : real(RKC) :: quadRomb
888 : end function
889 : #endif
890 :
891 : #if RK3_ENABLED
892 : recursive impure module function getQR_PWRL_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
893 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
894 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EM_NM_RK3
895 : #endif
896 : use pm_kind, only: RKC => RK3
897 : procedure(real(RKC)) :: getFunc
898 : real(RKC) , intent(in) :: lb, ub, tol
899 : integer(IK) , intent(in) :: nref
900 : type(pwrl_type) :: interval
901 : real(RKC) :: quadRomb
902 : end function
903 : #endif
904 :
905 : #if RK2_ENABLED
906 : recursive impure module function getQR_PWRL_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
907 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
908 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EM_NM_RK2
909 : #endif
910 : use pm_kind, only: RKC => RK2
911 : procedure(real(RKC)) :: getFunc
912 : real(RKC) , intent(in) :: lb, ub, tol
913 : integer(IK) , intent(in) :: nref
914 : type(pwrl_type) :: interval
915 : real(RKC) :: quadRomb
916 : end function
917 : #endif
918 :
919 : #if RK1_ENABLED
920 : recursive impure module function getQR_PWRL_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
921 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
922 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EM_NM_RK1
923 : #endif
924 : use pm_kind, only: RKC => RK1
925 : procedure(real(RKC)) :: getFunc
926 : real(RKC) , intent(in) :: lb, ub, tol
927 : integer(IK) , intent(in) :: nref
928 : type(pwrl_type) :: interval
929 : real(RKC) :: quadRomb
930 : end function
931 : #endif
932 :
933 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
934 :
935 : #if RK5_ENABLED
936 : recursive impure module function getQR_PWRL_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
937 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
938 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NM_RK5
939 : #endif
940 : use pm_kind, only: RKC => RK5
941 : procedure(real(RKC)) :: getFunc
942 : real(RKC) , intent(in) :: lb, ub, tol
943 : integer(IK) , intent(in) :: nref
944 : type(pwrl_type) :: interval
945 : real(RKC) , intent(out) :: relerr
946 : real(RKC) :: quadRomb
947 : end function
948 : #endif
949 :
950 : #if RK4_ENABLED
951 : recursive impure module function getQR_PWRL_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
952 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
953 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NM_RK4
954 : #endif
955 : use pm_kind, only: RKC => RK4
956 : procedure(real(RKC)) :: getFunc
957 : real(RKC) , intent(in) :: lb, ub, tol
958 : integer(IK) , intent(in) :: nref
959 : type(pwrl_type) :: interval
960 : real(RKC) , intent(out) :: relerr
961 : real(RKC) :: quadRomb
962 : end function
963 : #endif
964 :
965 : #if RK3_ENABLED
966 : recursive impure module function getQR_PWRL_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
967 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
968 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NM_RK3
969 : #endif
970 : use pm_kind, only: RKC => RK3
971 : procedure(real(RKC)) :: getFunc
972 : real(RKC) , intent(in) :: lb, ub, tol
973 : integer(IK) , intent(in) :: nref
974 : type(pwrl_type) :: interval
975 : real(RKC) , intent(out) :: relerr
976 : real(RKC) :: quadRomb
977 : end function
978 : #endif
979 :
980 : #if RK2_ENABLED
981 : recursive impure module function getQR_PWRL_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
982 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
983 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NM_RK2
984 : #endif
985 : use pm_kind, only: RKC => RK2
986 : procedure(real(RKC)) :: getFunc
987 : real(RKC) , intent(in) :: lb, ub, tol
988 : integer(IK) , intent(in) :: nref
989 : type(pwrl_type) :: interval
990 : real(RKC) , intent(out) :: relerr
991 : real(RKC) :: quadRomb
992 : end function
993 : #endif
994 :
995 : #if RK1_ENABLED
996 : recursive impure module function getQR_PWRL_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
997 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
998 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NM_RK1
999 : #endif
1000 : use pm_kind, only: RKC => RK1
1001 : procedure(real(RKC)) :: getFunc
1002 : real(RKC) , intent(in) :: lb, ub, tol
1003 : integer(IK) , intent(in) :: nref
1004 : type(pwrl_type) :: interval
1005 : real(RKC) , intent(out) :: relerr
1006 : real(RKC) :: quadRomb
1007 : end function
1008 : #endif
1009 :
1010 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1011 :
1012 : #if RK5_ENABLED
1013 : recursive impure module function getQR_PWRL_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1014 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1015 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NP_RK5
1016 : #endif
1017 : use pm_kind, only: RKC => RK5
1018 : procedure(real(RKC)) :: getFunc
1019 : real(RKC) , intent(in) :: lb, ub, tol
1020 : integer(IK) , intent(in) :: nref
1021 : type(pwrl_type) :: interval
1022 : integer(IK) , intent(out) :: neval
1023 : real(RKC) , intent(out) :: relerr
1024 : real(RKC) :: quadRomb
1025 : end function
1026 : #endif
1027 :
1028 : #if RK4_ENABLED
1029 : recursive impure module function getQR_PWRL_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1030 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1031 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NP_RK4
1032 : #endif
1033 : use pm_kind, only: RKC => RK4
1034 : procedure(real(RKC)) :: getFunc
1035 : real(RKC) , intent(in) :: lb, ub, tol
1036 : integer(IK) , intent(in) :: nref
1037 : type(pwrl_type) :: interval
1038 : integer(IK) , intent(out) :: neval
1039 : real(RKC) , intent(out) :: relerr
1040 : real(RKC) :: quadRomb
1041 : end function
1042 : #endif
1043 :
1044 : #if RK3_ENABLED
1045 : recursive impure module function getQR_PWRL_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1046 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1047 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NP_RK3
1048 : #endif
1049 : use pm_kind, only: RKC => RK3
1050 : procedure(real(RKC)) :: getFunc
1051 : real(RKC) , intent(in) :: lb, ub, tol
1052 : integer(IK) , intent(in) :: nref
1053 : type(pwrl_type) :: interval
1054 : integer(IK) , intent(out) :: neval
1055 : real(RKC) , intent(out) :: relerr
1056 : real(RKC) :: quadRomb
1057 : end function
1058 : #endif
1059 :
1060 : #if RK2_ENABLED
1061 : recursive impure module function getQR_PWRL_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1062 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1063 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NP_RK2
1064 : #endif
1065 : use pm_kind, only: RKC => RK2
1066 : procedure(real(RKC)) :: getFunc
1067 : real(RKC) , intent(in) :: lb, ub, tol
1068 : integer(IK) , intent(in) :: nref
1069 : type(pwrl_type) :: interval
1070 : integer(IK) , intent(out) :: neval
1071 : real(RKC) , intent(out) :: relerr
1072 : real(RKC) :: quadRomb
1073 : end function
1074 : #endif
1075 :
1076 : #if RK1_ENABLED
1077 : recursive impure module function getQR_PWRL_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1078 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1079 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PWRL_EP_NP_RK1
1080 : #endif
1081 : use pm_kind, only: RKC => RK1
1082 : procedure(real(RKC)) :: getFunc
1083 : real(RKC) , intent(in) :: lb, ub, tol
1084 : integer(IK) , intent(in) :: nref
1085 : type(pwrl_type) :: interval
1086 : integer(IK) , intent(out) :: neval
1087 : real(RKC) , intent(out) :: relerr
1088 : real(RKC) :: quadRomb
1089 : end function
1090 : #endif
1091 :
1092 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1093 :
1094 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1095 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1096 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1097 :
1098 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1099 :
1100 : #if RK5_ENABLED
1101 : recursive impure module function getQR_NEXP_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1102 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1103 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EM_NM_RK5
1104 : #endif
1105 : use pm_kind, only: RKC => RK5
1106 : procedure(real(RKC)) :: getFunc
1107 : real(RKC) , intent(in) :: lb, ub, tol
1108 : integer(IK) , intent(in) :: nref
1109 : type(nexp_type) :: interval
1110 : real(RKC) :: quadRomb
1111 : end function
1112 : #endif
1113 :
1114 : #if RK4_ENABLED
1115 : recursive impure module function getQR_NEXP_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1116 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1117 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EM_NM_RK4
1118 : #endif
1119 : use pm_kind, only: RKC => RK4
1120 : procedure(real(RKC)) :: getFunc
1121 : real(RKC) , intent(in) :: lb, ub, tol
1122 : integer(IK) , intent(in) :: nref
1123 : type(nexp_type) :: interval
1124 : real(RKC) :: quadRomb
1125 : end function
1126 : #endif
1127 :
1128 : #if RK3_ENABLED
1129 : recursive impure module function getQR_NEXP_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1130 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1131 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EM_NM_RK3
1132 : #endif
1133 : use pm_kind, only: RKC => RK3
1134 : procedure(real(RKC)) :: getFunc
1135 : real(RKC) , intent(in) :: lb, ub, tol
1136 : integer(IK) , intent(in) :: nref
1137 : type(nexp_type) :: interval
1138 : real(RKC) :: quadRomb
1139 : end function
1140 : #endif
1141 :
1142 : #if RK2_ENABLED
1143 : recursive impure module function getQR_NEXP_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1144 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1145 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EM_NM_RK2
1146 : #endif
1147 : use pm_kind, only: RKC => RK2
1148 : procedure(real(RKC)) :: getFunc
1149 : real(RKC) , intent(in) :: lb, ub, tol
1150 : integer(IK) , intent(in) :: nref
1151 : type(nexp_type) :: interval
1152 : real(RKC) :: quadRomb
1153 : end function
1154 : #endif
1155 :
1156 : #if RK1_ENABLED
1157 : recursive impure module function getQR_NEXP_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1158 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1159 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EM_NM_RK1
1160 : #endif
1161 : use pm_kind, only: RKC => RK1
1162 : procedure(real(RKC)) :: getFunc
1163 : real(RKC) , intent(in) :: lb, ub, tol
1164 : integer(IK) , intent(in) :: nref
1165 : type(nexp_type) :: interval
1166 : real(RKC) :: quadRomb
1167 : end function
1168 : #endif
1169 :
1170 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1171 :
1172 : #if RK5_ENABLED
1173 : recursive impure module function getQR_NEXP_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1174 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1175 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NM_RK5
1176 : #endif
1177 : use pm_kind, only: RKC => RK5
1178 : procedure(real(RKC)) :: getFunc
1179 : real(RKC) , intent(in) :: lb, ub, tol
1180 : integer(IK) , intent(in) :: nref
1181 : type(nexp_type) :: interval
1182 : real(RKC) , intent(out) :: relerr
1183 : real(RKC) :: quadRomb
1184 : end function
1185 : #endif
1186 :
1187 : #if RK4_ENABLED
1188 : recursive impure module function getQR_NEXP_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1189 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1190 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NM_RK4
1191 : #endif
1192 : use pm_kind, only: RKC => RK4
1193 : procedure(real(RKC)) :: getFunc
1194 : real(RKC) , intent(in) :: lb, ub, tol
1195 : integer(IK) , intent(in) :: nref
1196 : type(nexp_type) :: interval
1197 : real(RKC) , intent(out) :: relerr
1198 : real(RKC) :: quadRomb
1199 : end function
1200 : #endif
1201 :
1202 : #if RK3_ENABLED
1203 : recursive impure module function getQR_NEXP_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1204 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1205 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NM_RK3
1206 : #endif
1207 : use pm_kind, only: RKC => RK3
1208 : procedure(real(RKC)) :: getFunc
1209 : real(RKC) , intent(in) :: lb, ub, tol
1210 : integer(IK) , intent(in) :: nref
1211 : type(nexp_type) :: interval
1212 : real(RKC) , intent(out) :: relerr
1213 : real(RKC) :: quadRomb
1214 : end function
1215 : #endif
1216 :
1217 : #if RK2_ENABLED
1218 : recursive impure module function getQR_NEXP_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1219 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1220 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NM_RK2
1221 : #endif
1222 : use pm_kind, only: RKC => RK2
1223 : procedure(real(RKC)) :: getFunc
1224 : real(RKC) , intent(in) :: lb, ub, tol
1225 : integer(IK) , intent(in) :: nref
1226 : type(nexp_type) :: interval
1227 : real(RKC) , intent(out) :: relerr
1228 : real(RKC) :: quadRomb
1229 : end function
1230 : #endif
1231 :
1232 : #if RK1_ENABLED
1233 : recursive impure module function getQR_NEXP_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1234 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1235 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NM_RK1
1236 : #endif
1237 : use pm_kind, only: RKC => RK1
1238 : procedure(real(RKC)) :: getFunc
1239 : real(RKC) , intent(in) :: lb, ub, tol
1240 : integer(IK) , intent(in) :: nref
1241 : type(nexp_type) :: interval
1242 : real(RKC) , intent(out) :: relerr
1243 : real(RKC) :: quadRomb
1244 : end function
1245 : #endif
1246 :
1247 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1248 :
1249 : #if RK5_ENABLED
1250 : recursive impure module function getQR_NEXP_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1251 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1252 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NP_RK5
1253 : #endif
1254 : use pm_kind, only: RKC => RK5
1255 : procedure(real(RKC)) :: getFunc
1256 : real(RKC) , intent(in) :: lb, ub, tol
1257 : integer(IK) , intent(in) :: nref
1258 : type(nexp_type) :: interval
1259 : integer(IK) , intent(out) :: neval
1260 : real(RKC) , intent(out) :: relerr
1261 : real(RKC) :: quadRomb
1262 : end function
1263 : #endif
1264 :
1265 : #if RK4_ENABLED
1266 : recursive impure module function getQR_NEXP_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1267 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1268 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NP_RK4
1269 : #endif
1270 : use pm_kind, only: RKC => RK4
1271 : procedure(real(RKC)) :: getFunc
1272 : real(RKC) , intent(in) :: lb, ub, tol
1273 : integer(IK) , intent(in) :: nref
1274 : type(nexp_type) :: interval
1275 : integer(IK) , intent(out) :: neval
1276 : real(RKC) , intent(out) :: relerr
1277 : real(RKC) :: quadRomb
1278 : end function
1279 : #endif
1280 :
1281 : #if RK3_ENABLED
1282 : recursive impure module function getQR_NEXP_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1283 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1284 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NP_RK3
1285 : #endif
1286 : use pm_kind, only: RKC => RK3
1287 : procedure(real(RKC)) :: getFunc
1288 : real(RKC) , intent(in) :: lb, ub, tol
1289 : integer(IK) , intent(in) :: nref
1290 : type(nexp_type) :: interval
1291 : integer(IK) , intent(out) :: neval
1292 : real(RKC) , intent(out) :: relerr
1293 : real(RKC) :: quadRomb
1294 : end function
1295 : #endif
1296 :
1297 : #if RK2_ENABLED
1298 : recursive impure module function getQR_NEXP_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1299 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1300 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NP_RK2
1301 : #endif
1302 : use pm_kind, only: RKC => RK2
1303 : procedure(real(RKC)) :: getFunc
1304 : real(RKC) , intent(in) :: lb, ub, tol
1305 : integer(IK) , intent(in) :: nref
1306 : type(nexp_type) :: interval
1307 : integer(IK) , intent(out) :: neval
1308 : real(RKC) , intent(out) :: relerr
1309 : real(RKC) :: quadRomb
1310 : end function
1311 : #endif
1312 :
1313 : #if RK1_ENABLED
1314 : recursive impure module function getQR_NEXP_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1315 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1316 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_NEXP_EP_NP_RK1
1317 : #endif
1318 : use pm_kind, only: RKC => RK1
1319 : procedure(real(RKC)) :: getFunc
1320 : real(RKC) , intent(in) :: lb, ub, tol
1321 : integer(IK) , intent(in) :: nref
1322 : type(nexp_type) :: interval
1323 : integer(IK) , intent(out) :: neval
1324 : real(RKC) , intent(out) :: relerr
1325 : real(RKC) :: quadRomb
1326 : end function
1327 : #endif
1328 :
1329 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1330 :
1331 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1332 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1333 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1334 :
1335 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1336 :
1337 : #if RK5_ENABLED
1338 : recursive impure module function getQR_PEXP_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1339 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1340 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EM_NM_RK5
1341 : #endif
1342 : use pm_kind, only: RKC => RK5
1343 : procedure(real(RKC)) :: getFunc
1344 : real(RKC) , intent(in) :: lb, ub, tol
1345 : integer(IK) , intent(in) :: nref
1346 : type(pexp_type) :: interval
1347 : real(RKC) :: quadRomb
1348 : end function
1349 : #endif
1350 :
1351 : #if RK4_ENABLED
1352 : recursive impure module function getQR_PEXP_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1353 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1354 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EM_NM_RK4
1355 : #endif
1356 : use pm_kind, only: RKC => RK4
1357 : procedure(real(RKC)) :: getFunc
1358 : real(RKC) , intent(in) :: lb, ub, tol
1359 : integer(IK) , intent(in) :: nref
1360 : type(pexp_type) :: interval
1361 : real(RKC) :: quadRomb
1362 : end function
1363 : #endif
1364 :
1365 : #if RK3_ENABLED
1366 : recursive impure module function getQR_PEXP_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1367 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1368 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EM_NM_RK3
1369 : #endif
1370 : use pm_kind, only: RKC => RK3
1371 : procedure(real(RKC)) :: getFunc
1372 : real(RKC) , intent(in) :: lb, ub, tol
1373 : integer(IK) , intent(in) :: nref
1374 : type(pexp_type) :: interval
1375 : real(RKC) :: quadRomb
1376 : end function
1377 : #endif
1378 :
1379 : #if RK2_ENABLED
1380 : recursive impure module function getQR_PEXP_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1381 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1382 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EM_NM_RK2
1383 : #endif
1384 : use pm_kind, only: RKC => RK2
1385 : procedure(real(RKC)) :: getFunc
1386 : real(RKC) , intent(in) :: lb, ub, tol
1387 : integer(IK) , intent(in) :: nref
1388 : type(pexp_type) :: interval
1389 : real(RKC) :: quadRomb
1390 : end function
1391 : #endif
1392 :
1393 : #if RK1_ENABLED
1394 : recursive impure module function getQR_PEXP_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1395 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1396 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EM_NM_RK1
1397 : #endif
1398 : use pm_kind, only: RKC => RK1
1399 : procedure(real(RKC)) :: getFunc
1400 : real(RKC) , intent(in) :: lb, ub, tol
1401 : integer(IK) , intent(in) :: nref
1402 : type(pexp_type) :: interval
1403 : real(RKC) :: quadRomb
1404 : end function
1405 : #endif
1406 :
1407 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1408 :
1409 : #if RK5_ENABLED
1410 : recursive impure module function getQR_PEXP_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1411 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1412 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NM_RK5
1413 : #endif
1414 : use pm_kind, only: RKC => RK5
1415 : procedure(real(RKC)) :: getFunc
1416 : real(RKC) , intent(in) :: lb, ub, tol
1417 : integer(IK) , intent(in) :: nref
1418 : type(pexp_type) :: interval
1419 : real(RKC) , intent(out) :: relerr
1420 : real(RKC) :: quadRomb
1421 : end function
1422 : #endif
1423 :
1424 : #if RK4_ENABLED
1425 : recursive impure module function getQR_PEXP_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1426 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1427 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NM_RK4
1428 : #endif
1429 : use pm_kind, only: RKC => RK4
1430 : procedure(real(RKC)) :: getFunc
1431 : real(RKC) , intent(in) :: lb, ub, tol
1432 : integer(IK) , intent(in) :: nref
1433 : type(pexp_type) :: interval
1434 : real(RKC) , intent(out) :: relerr
1435 : real(RKC) :: quadRomb
1436 : end function
1437 : #endif
1438 :
1439 : #if RK3_ENABLED
1440 : recursive impure module function getQR_PEXP_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1441 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1442 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NM_RK3
1443 : #endif
1444 : use pm_kind, only: RKC => RK3
1445 : procedure(real(RKC)) :: getFunc
1446 : real(RKC) , intent(in) :: lb, ub, tol
1447 : integer(IK) , intent(in) :: nref
1448 : type(pexp_type) :: interval
1449 : real(RKC) , intent(out) :: relerr
1450 : real(RKC) :: quadRomb
1451 : end function
1452 : #endif
1453 :
1454 : #if RK2_ENABLED
1455 : recursive impure module function getQR_PEXP_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1456 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1457 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NM_RK2
1458 : #endif
1459 : use pm_kind, only: RKC => RK2
1460 : procedure(real(RKC)) :: getFunc
1461 : real(RKC) , intent(in) :: lb, ub, tol
1462 : integer(IK) , intent(in) :: nref
1463 : type(pexp_type) :: interval
1464 : real(RKC) , intent(out) :: relerr
1465 : real(RKC) :: quadRomb
1466 : end function
1467 : #endif
1468 :
1469 : #if RK1_ENABLED
1470 : recursive impure module function getQR_PEXP_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1471 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1472 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NM_RK1
1473 : #endif
1474 : use pm_kind, only: RKC => RK1
1475 : procedure(real(RKC)) :: getFunc
1476 : real(RKC) , intent(in) :: lb, ub, tol
1477 : integer(IK) , intent(in) :: nref
1478 : type(pexp_type) :: interval
1479 : real(RKC) , intent(out) :: relerr
1480 : real(RKC) :: quadRomb
1481 : end function
1482 : #endif
1483 :
1484 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1485 :
1486 : #if RK5_ENABLED
1487 : recursive impure module function getQR_PEXP_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1488 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1489 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NP_RK5
1490 : #endif
1491 : use pm_kind, only: RKC => RK5
1492 : procedure(real(RKC)) :: getFunc
1493 : real(RKC) , intent(in) :: lb, ub, tol
1494 : integer(IK) , intent(in) :: nref
1495 : type(pexp_type) :: interval
1496 : integer(IK) , intent(out) :: neval
1497 : real(RKC) , intent(out) :: relerr
1498 : real(RKC) :: quadRomb
1499 : end function
1500 : #endif
1501 :
1502 : #if RK4_ENABLED
1503 : recursive impure module function getQR_PEXP_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1504 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1505 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NP_RK4
1506 : #endif
1507 : use pm_kind, only: RKC => RK4
1508 : procedure(real(RKC)) :: getFunc
1509 : real(RKC) , intent(in) :: lb, ub, tol
1510 : integer(IK) , intent(in) :: nref
1511 : type(pexp_type) :: interval
1512 : integer(IK) , intent(out) :: neval
1513 : real(RKC) , intent(out) :: relerr
1514 : real(RKC) :: quadRomb
1515 : end function
1516 : #endif
1517 :
1518 : #if RK3_ENABLED
1519 : recursive impure module function getQR_PEXP_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1520 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1521 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NP_RK3
1522 : #endif
1523 : use pm_kind, only: RKC => RK3
1524 : procedure(real(RKC)) :: getFunc
1525 : real(RKC) , intent(in) :: lb, ub, tol
1526 : integer(IK) , intent(in) :: nref
1527 : type(pexp_type) :: interval
1528 : integer(IK) , intent(out) :: neval
1529 : real(RKC) , intent(out) :: relerr
1530 : real(RKC) :: quadRomb
1531 : end function
1532 : #endif
1533 :
1534 : #if RK2_ENABLED
1535 : recursive impure module function getQR_PEXP_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1536 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1537 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NP_RK2
1538 : #endif
1539 : use pm_kind, only: RKC => RK2
1540 : procedure(real(RKC)) :: getFunc
1541 : real(RKC) , intent(in) :: lb, ub, tol
1542 : integer(IK) , intent(in) :: nref
1543 : type(pexp_type) :: interval
1544 : integer(IK) , intent(out) :: neval
1545 : real(RKC) , intent(out) :: relerr
1546 : real(RKC) :: quadRomb
1547 : end function
1548 : #endif
1549 :
1550 : #if RK1_ENABLED
1551 : recursive impure module function getQR_PEXP_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1552 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1553 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_PEXP_EP_NP_RK1
1554 : #endif
1555 : use pm_kind, only: RKC => RK1
1556 : procedure(real(RKC)) :: getFunc
1557 : real(RKC) , intent(in) :: lb, ub, tol
1558 : integer(IK) , intent(in) :: nref
1559 : type(pexp_type) :: interval
1560 : integer(IK) , intent(out) :: neval
1561 : real(RKC) , intent(out) :: relerr
1562 : real(RKC) :: quadRomb
1563 : end function
1564 : #endif
1565 :
1566 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1567 :
1568 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1569 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1570 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1571 :
1572 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1573 :
1574 : #if RK5_ENABLED
1575 : recursive impure module function getQR_LBIS_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1576 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1577 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EM_NM_RK5
1578 : #endif
1579 : use pm_kind, only: RKC => RK5
1580 : procedure(real(RKC)) :: getFunc
1581 : real(RKC) , intent(in) :: lb, ub, tol
1582 : integer(IK) , intent(in) :: nref
1583 : type(lbis_type) :: interval
1584 : real(RKC) :: quadRomb
1585 : end function
1586 : #endif
1587 :
1588 : #if RK4_ENABLED
1589 : recursive impure module function getQR_LBIS_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1590 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1591 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EM_NM_RK4
1592 : #endif
1593 : use pm_kind, only: RKC => RK4
1594 : procedure(real(RKC)) :: getFunc
1595 : real(RKC) , intent(in) :: lb, ub, tol
1596 : integer(IK) , intent(in) :: nref
1597 : type(lbis_type) :: interval
1598 : real(RKC) :: quadRomb
1599 : end function
1600 : #endif
1601 :
1602 : #if RK3_ENABLED
1603 : recursive impure module function getQR_LBIS_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1604 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1605 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EM_NM_RK3
1606 : #endif
1607 : use pm_kind, only: RKC => RK3
1608 : procedure(real(RKC)) :: getFunc
1609 : real(RKC) , intent(in) :: lb, ub, tol
1610 : integer(IK) , intent(in) :: nref
1611 : type(lbis_type) :: interval
1612 : real(RKC) :: quadRomb
1613 : end function
1614 : #endif
1615 :
1616 : #if RK2_ENABLED
1617 : recursive impure module function getQR_LBIS_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1618 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1619 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EM_NM_RK2
1620 : #endif
1621 : use pm_kind, only: RKC => RK2
1622 : procedure(real(RKC)) :: getFunc
1623 : real(RKC) , intent(in) :: lb, ub, tol
1624 : integer(IK) , intent(in) :: nref
1625 : type(lbis_type) :: interval
1626 : real(RKC) :: quadRomb
1627 : end function
1628 : #endif
1629 :
1630 : #if RK1_ENABLED
1631 : recursive impure module function getQR_LBIS_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1632 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1633 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EM_NM_RK1
1634 : #endif
1635 : use pm_kind, only: RKC => RK1
1636 : procedure(real(RKC)) :: getFunc
1637 : real(RKC) , intent(in) :: lb, ub, tol
1638 : integer(IK) , intent(in) :: nref
1639 : type(lbis_type) :: interval
1640 : real(RKC) :: quadRomb
1641 : end function
1642 : #endif
1643 :
1644 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1645 :
1646 : #if RK5_ENABLED
1647 : recursive impure module function getQR_LBIS_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1648 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1649 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NM_RK5
1650 : #endif
1651 : use pm_kind, only: RKC => RK5
1652 : procedure(real(RKC)) :: getFunc
1653 : real(RKC) , intent(in) :: lb, ub, tol
1654 : integer(IK) , intent(in) :: nref
1655 : type(lbis_type) :: interval
1656 : real(RKC) , intent(out) :: relerr
1657 : real(RKC) :: quadRomb
1658 : end function
1659 : #endif
1660 :
1661 : #if RK4_ENABLED
1662 : recursive impure module function getQR_LBIS_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1663 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1664 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NM_RK4
1665 : #endif
1666 : use pm_kind, only: RKC => RK4
1667 : procedure(real(RKC)) :: getFunc
1668 : real(RKC) , intent(in) :: lb, ub, tol
1669 : integer(IK) , intent(in) :: nref
1670 : type(lbis_type) :: interval
1671 : real(RKC) , intent(out) :: relerr
1672 : real(RKC) :: quadRomb
1673 : end function
1674 : #endif
1675 :
1676 : #if RK3_ENABLED
1677 : recursive impure module function getQR_LBIS_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1678 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1679 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NM_RK3
1680 : #endif
1681 : use pm_kind, only: RKC => RK3
1682 : procedure(real(RKC)) :: getFunc
1683 : real(RKC) , intent(in) :: lb, ub, tol
1684 : integer(IK) , intent(in) :: nref
1685 : type(lbis_type) :: interval
1686 : real(RKC) , intent(out) :: relerr
1687 : real(RKC) :: quadRomb
1688 : end function
1689 : #endif
1690 :
1691 : #if RK2_ENABLED
1692 : recursive impure module function getQR_LBIS_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1693 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1694 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NM_RK2
1695 : #endif
1696 : use pm_kind, only: RKC => RK2
1697 : procedure(real(RKC)) :: getFunc
1698 : real(RKC) , intent(in) :: lb, ub, tol
1699 : integer(IK) , intent(in) :: nref
1700 : type(lbis_type) :: interval
1701 : real(RKC) , intent(out) :: relerr
1702 : real(RKC) :: quadRomb
1703 : end function
1704 : #endif
1705 :
1706 : #if RK1_ENABLED
1707 : recursive impure module function getQR_LBIS_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1708 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1709 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NM_RK1
1710 : #endif
1711 : use pm_kind, only: RKC => RK1
1712 : procedure(real(RKC)) :: getFunc
1713 : real(RKC) , intent(in) :: lb, ub, tol
1714 : integer(IK) , intent(in) :: nref
1715 : type(lbis_type) :: interval
1716 : real(RKC) , intent(out) :: relerr
1717 : real(RKC) :: quadRomb
1718 : end function
1719 : #endif
1720 :
1721 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1722 :
1723 : #if RK5_ENABLED
1724 : recursive impure module function getQR_LBIS_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1725 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1726 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NP_RK5
1727 : #endif
1728 : use pm_kind, only: RKC => RK5
1729 : procedure(real(RKC)) :: getFunc
1730 : real(RKC) , intent(in) :: lb, ub, tol
1731 : integer(IK) , intent(in) :: nref
1732 : type(lbis_type) :: interval
1733 : integer(IK) , intent(out) :: neval
1734 : real(RKC) , intent(out) :: relerr
1735 : real(RKC) :: quadRomb
1736 : end function
1737 : #endif
1738 :
1739 : #if RK4_ENABLED
1740 : recursive impure module function getQR_LBIS_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1741 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1742 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NP_RK4
1743 : #endif
1744 : use pm_kind, only: RKC => RK4
1745 : procedure(real(RKC)) :: getFunc
1746 : real(RKC) , intent(in) :: lb, ub, tol
1747 : integer(IK) , intent(in) :: nref
1748 : type(lbis_type) :: interval
1749 : integer(IK) , intent(out) :: neval
1750 : real(RKC) , intent(out) :: relerr
1751 : real(RKC) :: quadRomb
1752 : end function
1753 : #endif
1754 :
1755 : #if RK3_ENABLED
1756 : recursive impure module function getQR_LBIS_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1757 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1758 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NP_RK3
1759 : #endif
1760 : use pm_kind, only: RKC => RK3
1761 : procedure(real(RKC)) :: getFunc
1762 : real(RKC) , intent(in) :: lb, ub, tol
1763 : integer(IK) , intent(in) :: nref
1764 : type(lbis_type) :: interval
1765 : integer(IK) , intent(out) :: neval
1766 : real(RKC) , intent(out) :: relerr
1767 : real(RKC) :: quadRomb
1768 : end function
1769 : #endif
1770 :
1771 : #if RK2_ENABLED
1772 : recursive impure module function getQR_LBIS_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1773 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1774 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NP_RK2
1775 : #endif
1776 : use pm_kind, only: RKC => RK2
1777 : procedure(real(RKC)) :: getFunc
1778 : real(RKC) , intent(in) :: lb, ub, tol
1779 : integer(IK) , intent(in) :: nref
1780 : type(lbis_type) :: interval
1781 : integer(IK) , intent(out) :: neval
1782 : real(RKC) , intent(out) :: relerr
1783 : real(RKC) :: quadRomb
1784 : end function
1785 : #endif
1786 :
1787 : #if RK1_ENABLED
1788 : recursive impure module function getQR_LBIS_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1789 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1790 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_LBIS_EP_NP_RK1
1791 : #endif
1792 : use pm_kind, only: RKC => RK1
1793 : procedure(real(RKC)) :: getFunc
1794 : real(RKC) , intent(in) :: lb, ub, tol
1795 : integer(IK) , intent(in) :: nref
1796 : type(lbis_type) :: interval
1797 : integer(IK) , intent(out) :: neval
1798 : real(RKC) , intent(out) :: relerr
1799 : real(RKC) :: quadRomb
1800 : end function
1801 : #endif
1802 :
1803 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1804 :
1805 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1806 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1807 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1808 :
1809 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1810 :
1811 : #if RK5_ENABLED
1812 : recursive impure module function getQR_UBIS_EM_NM_RK5(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1813 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1814 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EM_NM_RK5
1815 : #endif
1816 : use pm_kind, only: RKC => RK5
1817 : procedure(real(RKC)) :: getFunc
1818 : real(RKC) , intent(in) :: lb, ub, tol
1819 : integer(IK) , intent(in) :: nref
1820 : type(ubis_type) :: interval
1821 : real(RKC) :: quadRomb
1822 : end function
1823 : #endif
1824 :
1825 : #if RK4_ENABLED
1826 : recursive impure module function getQR_UBIS_EM_NM_RK4(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1827 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1828 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EM_NM_RK4
1829 : #endif
1830 : use pm_kind, only: RKC => RK4
1831 : procedure(real(RKC)) :: getFunc
1832 : real(RKC) , intent(in) :: lb, ub, tol
1833 : integer(IK) , intent(in) :: nref
1834 : type(ubis_type) :: interval
1835 : real(RKC) :: quadRomb
1836 : end function
1837 : #endif
1838 :
1839 : #if RK3_ENABLED
1840 : recursive impure module function getQR_UBIS_EM_NM_RK3(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1841 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1842 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EM_NM_RK3
1843 : #endif
1844 : use pm_kind, only: RKC => RK3
1845 : procedure(real(RKC)) :: getFunc
1846 : real(RKC) , intent(in) :: lb, ub, tol
1847 : integer(IK) , intent(in) :: nref
1848 : type(ubis_type) :: interval
1849 : real(RKC) :: quadRomb
1850 : end function
1851 : #endif
1852 :
1853 : #if RK2_ENABLED
1854 : recursive impure module function getQR_UBIS_EM_NM_RK2(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1855 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1856 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EM_NM_RK2
1857 : #endif
1858 : use pm_kind, only: RKC => RK2
1859 : procedure(real(RKC)) :: getFunc
1860 : real(RKC) , intent(in) :: lb, ub, tol
1861 : integer(IK) , intent(in) :: nref
1862 : type(ubis_type) :: interval
1863 : real(RKC) :: quadRomb
1864 : end function
1865 : #endif
1866 :
1867 : #if RK1_ENABLED
1868 : recursive impure module function getQR_UBIS_EM_NM_RK1(getFunc, lb, ub, tol, nref, interval) result(quadRomb)
1869 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1870 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EM_NM_RK1
1871 : #endif
1872 : use pm_kind, only: RKC => RK1
1873 : procedure(real(RKC)) :: getFunc
1874 : real(RKC) , intent(in) :: lb, ub, tol
1875 : integer(IK) , intent(in) :: nref
1876 : type(ubis_type) :: interval
1877 : real(RKC) :: quadRomb
1878 : end function
1879 : #endif
1880 :
1881 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1882 :
1883 : #if RK5_ENABLED
1884 : recursive impure module function getQR_UBIS_EP_NM_RK5(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1885 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1886 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NM_RK5
1887 : #endif
1888 : use pm_kind, only: RKC => RK5
1889 : procedure(real(RKC)) :: getFunc
1890 : real(RKC) , intent(in) :: lb, ub, tol
1891 : integer(IK) , intent(in) :: nref
1892 : type(ubis_type) :: interval
1893 : real(RKC) , intent(out) :: relerr
1894 : real(RKC) :: quadRomb
1895 : end function
1896 : #endif
1897 :
1898 : #if RK4_ENABLED
1899 : recursive impure module function getQR_UBIS_EP_NM_RK4(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1900 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1901 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NM_RK4
1902 : #endif
1903 : use pm_kind, only: RKC => RK4
1904 : procedure(real(RKC)) :: getFunc
1905 : real(RKC) , intent(in) :: lb, ub, tol
1906 : integer(IK) , intent(in) :: nref
1907 : type(ubis_type) :: interval
1908 : real(RKC) , intent(out) :: relerr
1909 : real(RKC) :: quadRomb
1910 : end function
1911 : #endif
1912 :
1913 : #if RK3_ENABLED
1914 : recursive impure module function getQR_UBIS_EP_NM_RK3(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1915 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1916 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NM_RK3
1917 : #endif
1918 : use pm_kind, only: RKC => RK3
1919 : procedure(real(RKC)) :: getFunc
1920 : real(RKC) , intent(in) :: lb, ub, tol
1921 : integer(IK) , intent(in) :: nref
1922 : type(ubis_type) :: interval
1923 : real(RKC) , intent(out) :: relerr
1924 : real(RKC) :: quadRomb
1925 : end function
1926 : #endif
1927 :
1928 : #if RK2_ENABLED
1929 : recursive impure module function getQR_UBIS_EP_NM_RK2(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1930 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1931 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NM_RK2
1932 : #endif
1933 : use pm_kind, only: RKC => RK2
1934 : procedure(real(RKC)) :: getFunc
1935 : real(RKC) , intent(in) :: lb, ub, tol
1936 : integer(IK) , intent(in) :: nref
1937 : type(ubis_type) :: interval
1938 : real(RKC) , intent(out) :: relerr
1939 : real(RKC) :: quadRomb
1940 : end function
1941 : #endif
1942 :
1943 : #if RK1_ENABLED
1944 : recursive impure module function getQR_UBIS_EP_NM_RK1(getFunc, lb, ub, tol, nref, interval, relerr) result(quadRomb)
1945 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1946 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NM_RK1
1947 : #endif
1948 : use pm_kind, only: RKC => RK1
1949 : procedure(real(RKC)) :: getFunc
1950 : real(RKC) , intent(in) :: lb, ub, tol
1951 : integer(IK) , intent(in) :: nref
1952 : type(ubis_type) :: interval
1953 : real(RKC) , intent(out) :: relerr
1954 : real(RKC) :: quadRomb
1955 : end function
1956 : #endif
1957 :
1958 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1959 :
1960 : #if RK5_ENABLED
1961 : recursive impure module function getQR_UBIS_EP_NP_RK5(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1962 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1963 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NP_RK5
1964 : #endif
1965 : use pm_kind, only: RKC => RK5
1966 : procedure(real(RKC)) :: getFunc
1967 : real(RKC) , intent(in) :: lb, ub, tol
1968 : integer(IK) , intent(in) :: nref
1969 : type(ubis_type) :: interval
1970 : integer(IK) , intent(out) :: neval
1971 : real(RKC) , intent(out) :: relerr
1972 : real(RKC) :: quadRomb
1973 : end function
1974 : #endif
1975 :
1976 : #if RK4_ENABLED
1977 : recursive impure module function getQR_UBIS_EP_NP_RK4(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1978 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1979 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NP_RK4
1980 : #endif
1981 : use pm_kind, only: RKC => RK4
1982 : procedure(real(RKC)) :: getFunc
1983 : real(RKC) , intent(in) :: lb, ub, tol
1984 : integer(IK) , intent(in) :: nref
1985 : type(ubis_type) :: interval
1986 : integer(IK) , intent(out) :: neval
1987 : real(RKC) , intent(out) :: relerr
1988 : real(RKC) :: quadRomb
1989 : end function
1990 : #endif
1991 :
1992 : #if RK3_ENABLED
1993 : recursive impure module function getQR_UBIS_EP_NP_RK3(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
1994 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
1995 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NP_RK3
1996 : #endif
1997 : use pm_kind, only: RKC => RK3
1998 : procedure(real(RKC)) :: getFunc
1999 : real(RKC) , intent(in) :: lb, ub, tol
2000 : integer(IK) , intent(in) :: nref
2001 : type(ubis_type) :: interval
2002 : integer(IK) , intent(out) :: neval
2003 : real(RKC) , intent(out) :: relerr
2004 : real(RKC) :: quadRomb
2005 : end function
2006 : #endif
2007 :
2008 : #if RK2_ENABLED
2009 : recursive impure module function getQR_UBIS_EP_NP_RK2(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
2010 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2011 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NP_RK2
2012 : #endif
2013 : use pm_kind, only: RKC => RK2
2014 : procedure(real(RKC)) :: getFunc
2015 : real(RKC) , intent(in) :: lb, ub, tol
2016 : integer(IK) , intent(in) :: nref
2017 : type(ubis_type) :: interval
2018 : integer(IK) , intent(out) :: neval
2019 : real(RKC) , intent(out) :: relerr
2020 : real(RKC) :: quadRomb
2021 : end function
2022 : #endif
2023 :
2024 : #if RK1_ENABLED
2025 : recursive impure module function getQR_UBIS_EP_NP_RK1(getFunc, lb, ub, tol, nref, interval, relerr, neval) result(quadRomb)
2026 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2027 : !DEC$ ATTRIBUTES DLLEXPORT :: getQR_UBIS_EP_NP_RK1
2028 : #endif
2029 : use pm_kind, only: RKC => RK1
2030 : procedure(real(RKC)) :: getFunc
2031 : real(RKC) , intent(in) :: lb, ub, tol
2032 : integer(IK) , intent(in) :: nref
2033 : type(ubis_type) :: interval
2034 : integer(IK) , intent(out) :: neval
2035 : real(RKC) , intent(out) :: relerr
2036 : real(RKC) :: quadRomb
2037 : end function
2038 : #endif
2039 :
2040 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2041 :
2042 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2043 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2044 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2045 :
2046 : end interface
2047 :
2048 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2049 :
2050 : ! !> \brief
2051 : ! !> Generate and return the \f$n\f$th stage refinement of the integral of the input function `getFunc()` in the closed range `[lb, ub]`
2052 : ! !> using the **Extended Trapezoidal Rule**.
2053 : ! !>
2054 : ! !> \details
2055 : ! !> The coarsest implementation of the trapezoidal rule is to average the function at its endpoints `lb` and `ub`.<br>
2056 : ! !> The first stage of the refinement is to add to this average the value of the function at the halfway point.<br>
2057 : ! !> The second stage of refinement is to add the values at the `1/4` and `3/4` points.<br>
2058 : ! !> This procedure continues until the user is satisfied with the achieved accuracy of the integral.<br>
2059 : ! !> With each new sequential call to `setQuadTrap()`, the accuracy of the output integral will be improved
2060 : ! !> by adding \f42^{\ms{nref} - 2} extra function evaluation points between the integration bounds.<br>
2061 : ! !>
2062 : ! !> \param[in] getFunc : The input function to be integrated (i.e., the integrand).
2063 : ! !> -# On entry, it must take an input scalar of the same type and kind as `quadTrap`.<br>
2064 : ! !> -# On exit, it must generate an input scalar of the same type and kind as `quadTrap`, representing the corresponding function value.<br>
2065 : ! !> \param[in] lb : The input scalar of the same type and kind as the output `quadTrap`, containing the lower bound of the integration.
2066 : ! !> \param[in] ub : The input scalar of the same type and kind as the output `quadTrap`, containing the upper bound of the integration.
2067 : ! !> \param[in] nref : The input scalar `integer` of default kind \IK, representing the integration refinement stage.<br>
2068 : ! !> The value of `nref` is supposed to be `1` in the first call to `setQuadTrap()` and subsequently increase by one in each subsequent call.<br>
2069 : ! !> \param[inout] quadTrap : The input/output scalar `real` of kind \RKALL, representing the integration result.<br>
2070 : ! !> On input, it must contain the integration result at previous refinements.<br>
2071 : ! !> On output, it is overwritten with the most recent integral estimate via the most recent function evaluations.<br>
2072 : ! !> On the first call to `setQuadTrap()`, it must be set to `0`.<br>
2073 : ! !> \param[out] neval : The output scalar `integer` of default kind \IK, representing the number of function evaluations made within the integrator.<br>
2074 : ! !> (**optional**. It can be present <b>if and only if</b> `relerr` is also present.)
2075 : ! !> \param[out] relerr : The output scalar of the same type and kind as the output `quadTrap` containing the final estimated relative error in the result.<br>
2076 : ! !> By definition, this is always smaller than the specified input `tol`.<br>
2077 : ! !> (**optional**. It can be present <b>if and only if</b> `neval` is also present.)
2078 : ! !>
2079 : ! !> \interface
2080 : ! !> \code{.F90}
2081 : ! !>
2082 : ! !> use pm_quadRomb, only: setQuadTrap
2083 : ! !>
2084 : ! !> call setQuadTrap(getFunc, lb, ub, nref, quadTrap)
2085 : ! !> call setQuadTrap(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2086 : ! !>
2087 : ! !> \endcode
2088 : ! !>
2089 : ! !> \see
2090 : ! !> [getQuadRombOpen](@ref pm_quadRomb::getQuadRombOpen)<br>
2091 : ! !>
2092 : ! !> \example
2093 : ! !> \include{lineno} example/pm_quadRomb/setQuadTrap/main.F90
2094 : ! !> \compilef
2095 : ! !> \output
2096 : ! !> \include{lineno} example/pm_quadRomb/setQuadTrap/main.out.F90
2097 : ! !> \postproc
2098 : ! !> \include{lineno} example/pm_quadRomb/setQuadTrap/main.py
2099 : ! !> \vis
2100 : ! !> \image html pm_quadRomb/setQuadTrap/setQuadTrap.png width=700
2101 : ! !>
2102 : ! !> \test
2103 : ! !> [test_pm_quadRomb](@ref test_pm_quadRomb)
2104 : ! !>
2105 : ! !> \finmain
2106 : ! !>
2107 : ! !> \author
2108 : ! !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
2109 : ! interface setQuadTrap
2110 : !
2111 : ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2112 : !
2113 : !#if RK5_ENABLED
2114 : ! recursive impure module subroutine setQuadTrap_RK5(getFunc, lb, ub, nref, quadTrap)
2115 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2116 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_RK5
2117 : !#endif
2118 : ! use pm_kind, only: RKC => RK5
2119 : ! procedure(real(RKC)) :: getFunc
2120 : ! real(RKC) , intent(in) :: lb, ub
2121 : ! integer(IK) , intent(in) :: nref
2122 : ! real(RKC) :: quadTrap
2123 : ! end subroutine
2124 : !#endif
2125 : !
2126 : !#if RK4_ENABLED
2127 : ! recursive impure module subroutine setQuadTrap_RK4(getFunc, lb, ub, nref, quadTrap)
2128 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2129 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_RK4
2130 : !#endif
2131 : ! use pm_kind, only: RKC => RK4
2132 : ! procedure(real(RKC)) :: getFunc
2133 : ! real(RKC) , intent(in) :: lb, ub
2134 : ! integer(IK) , intent(in) :: nref
2135 : ! real(RKC) :: quadTrap
2136 : ! end subroutine
2137 : !#endif
2138 : !
2139 : !#if RK3_ENABLED
2140 : ! recursive impure module subroutine setQuadTrap_RK3(getFunc, lb, ub, nref, quadTrap)
2141 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2142 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_RK3
2143 : !#endif
2144 : ! use pm_kind, only: RKC => RK3
2145 : ! procedure(real(RKC)) :: getFunc
2146 : ! real(RKC) , intent(in) :: lb, ub
2147 : ! integer(IK) , intent(in) :: nref
2148 : ! real(RKC) :: quadTrap
2149 : ! end subroutine
2150 : !#endif
2151 : !
2152 : !#if RK2_ENABLED
2153 : ! recursive impure module subroutine setQuadTrap_RK2(getFunc, lb, ub, nref, quadTrap)
2154 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2155 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_RK2
2156 : !#endif
2157 : ! use pm_kind, only: RKC => RK2
2158 : ! procedure(real(RKC)) :: getFunc
2159 : ! real(RKC) , intent(in) :: lb, ub
2160 : ! integer(IK) , intent(in) :: nref
2161 : ! real(RKC) :: quadTrap
2162 : ! end subroutine
2163 : !#endif
2164 : !
2165 : !#if RK1_ENABLED
2166 : ! recursive impure module subroutine setQuadTrap_RK1(getFunc, lb, ub, nref, quadTrap)
2167 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2168 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_RK1
2169 : !#endif
2170 : ! use pm_kind, only: RKC => RK1
2171 : ! procedure(real(RKC)) :: getFunc
2172 : ! real(RKC) , intent(in) :: lb, ub
2173 : ! integer(IK) , intent(in) :: nref
2174 : ! real(RKC) :: quadTrap
2175 : ! end subroutine
2176 : !#endif
2177 : !
2178 : ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2179 : !
2180 : !#if RK5_ENABLED
2181 : ! recursive impure module subroutine setQuadTrap_EP_NM_RK5(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2182 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2183 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_EP_NM_RK5
2184 : !#endif
2185 : ! use pm_kind, only: RKC => RK5
2186 : ! procedure(real(RKC)) :: getFunc
2187 : ! real(RKC) , intent(in) :: lb, ub
2188 : ! integer(IK) , intent(in) :: nref
2189 : ! integer(IK) , intent(out) :: neval
2190 : ! real(RKC) , intent(out) :: relerr
2191 : ! real(RKC) :: quadTrap
2192 : ! end subroutine
2193 : !#endif
2194 : !
2195 : !#if RK4_ENABLED
2196 : ! recursive impure module subroutine setQuadTrap_EP_NM_RK4(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2197 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2198 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_EP_NM_RK4
2199 : !#endif
2200 : ! use pm_kind, only: RKC => RK4
2201 : ! procedure(real(RKC)) :: getFunc
2202 : ! real(RKC) , intent(in) :: lb, ub
2203 : ! integer(IK) , intent(in) :: nref
2204 : ! integer(IK) , intent(out) :: neval
2205 : ! real(RKC) , intent(out) :: relerr
2206 : ! real(RKC) :: quadTrap
2207 : ! end subroutine
2208 : !#endif
2209 : !
2210 : !#if RK3_ENABLED
2211 : ! recursive impure module subroutine setQuadTrap_EP_NM_RK3(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2212 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2213 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_EP_NM_RK3
2214 : !#endif
2215 : ! use pm_kind, only: RKC => RK3
2216 : ! procedure(real(RKC)) :: getFunc
2217 : ! real(RKC) , intent(in) :: lb, ub
2218 : ! integer(IK) , intent(in) :: nref
2219 : ! integer(IK) , intent(out) :: neval
2220 : ! real(RKC) , intent(out) :: relerr
2221 : ! real(RKC) :: quadTrap
2222 : ! end subroutine
2223 : !#endif
2224 : !
2225 : !#if RK2_ENABLED
2226 : ! recursive impure module subroutine setQuadTrap_EP_NM_RK2(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2227 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2228 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_EP_NM_RK2
2229 : !#endif
2230 : ! use pm_kind, only: RKC => RK2
2231 : ! procedure(real(RKC)) :: getFunc
2232 : ! real(RKC) , intent(in) :: lb, ub
2233 : ! integer(IK) , intent(in) :: nref
2234 : ! integer(IK) , intent(out) :: neval
2235 : ! real(RKC) , intent(out) :: relerr
2236 : ! real(RKC) , intent(inout) :: quadTrap
2237 : ! end subroutine
2238 : !#endif
2239 : !
2240 : !#if RK1_ENABLED
2241 : ! recursive impure module subroutine setQuadTrap_EP_NM_RK1(getFunc, lb, ub, nref, quadTrap, relerr, neval)
2242 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2243 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap_EP_NM_RK1
2244 : !#endif
2245 : ! use pm_kind, only: RKC => RK1
2246 : ! procedure(real(RKC)) :: getFunc
2247 : ! real(RKC) , intent(in) :: lb, ub
2248 : ! integer(IK) , intent(in) :: nref
2249 : ! integer(IK) , intent(out) :: neval
2250 : ! real(RKC) , intent(out) :: relerr
2251 : ! real(RKC) :: quadTrap
2252 : ! end subroutine
2253 : !#endif
2254 : !
2255 : ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2256 : !
2257 : ! end interface
2258 :
2259 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2260 :
2261 : ! recursive impure setQuadTrap(getFunc, lb, ub, quadTrap, refinementStage, neval)
2262 : !#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2263 : ! !DEC$ ATTRIBUTES DLLEXPORT :: setQuadTrap
2264 : !#endif
2265 : ! implicit none
2266 : ! integer(IK), intent(in) :: refinementStage
2267 : ! real(RK), intent(in) :: lb,ub
2268 : ! real(RK), intent(inout) :: quadTrap
2269 : ! integer(IK), intent(out) :: neval
2270 : ! integer(IK) :: iFuncEval
2271 : ! real(RK) :: del,sum,tnm,x
2272 : ! procedure(integrand_proc) :: getFunc
2273 : ! if (refinementStage == 1_IK) then
2274 : ! neval = 2_IK
2275 : ! quadTrap = 0.5_RK * (ub - lb) * (getFunc(lb) + getFunc(ub))
2276 : ! else
2277 : ! neval = 2**(refinementStage - 2_IK)
2278 : ! tnm = real(neval, RK)
2279 : ! del = (ub - lb) / tnm
2280 : ! x = lb + 0.5_RK * del
2281 : ! sum = 0._RK
2282 : ! do iFuncEval = 1_IK, neval
2283 : ! sum = sum + getFunc(x)
2284 : ! x = x + del
2285 : ! end do
2286 : ! quadTrap = 0.5_RK * (quadTrap + (ub-lb) * sum / tnm)
2287 : ! endif
2288 : ! end subroutine setQuadTrap
2289 :
2290 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2291 :
2292 : !> \cond excluded
2293 : #if 0
2294 : contains
2295 :
2296 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2297 :
2298 : !> \brief
2299 : !> Return the refinement of the integration of an exponentially-decaying function on a semi-infinite.
2300 : !> This function is an integrator driver to be passed to [doQuadRombOpen](@ref doQuadRombOpen).
2301 : !>
2302 : !> \param[in] getFunc : The input function to be integrated. It must have the interface specified by
2303 : !! [integrand_proc](@ref integrand_proc).
2304 : !> \param[in] lb : The lower limit of integration.
2305 : !> \param[in] ub : The upper limit of integration (typically set to `huge(1._RK)` to represent \f$+\infty\f$).
2306 : !> \param[inout] integral : The result of integration.
2307 : !> \param[in] refinementStage : The number of refinements since the first call to the integrator.
2308 : !> \param[out] neval : The number of function evaluations made.
2309 : !>
2310 : !> \remark
2311 : !> It is expected that `ub > lb > 0.0` must hold for this integrator to function properly.
2312 : !>
2313 : !> \remark
2314 : !> Tested by Joshua Osborne on 5/28/2020 at 8:58 pm.
2315 : recursive subroutine midexp(getFunc, lb, ub, integral, refinementStage, neval)
2316 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2317 : !DEC$ ATTRIBUTES DLLEXPORT :: midexp
2318 : #endif
2319 : use pm_except, only: LOGHUGE_RK
2320 : implicit none
2321 : integer(IK) , intent(in) :: refinementStage
2322 : real(RK) , intent(in) :: lb,ub
2323 : integer(IK) , intent(out) :: neval
2324 : real(RK) , intent(inout) :: integral
2325 : procedure(integrand_proc) :: getFunc
2326 : real(RK) :: ddel,del,summ,x,lbTrans,ubTrans
2327 : real(RK) :: inverseThreeNumFuncEval
2328 : integer(IK) :: iFuncEval
2329 : ubTrans = exp(-lb)
2330 : lbTrans = 0._RK; if (ub<LOGHUGE_RK) lbTrans = exp(-ub)
2331 : if (refinementStage==1_IK) then
2332 : neval = 1_IK
2333 : integral = (ubTrans-lbTrans)*getTransFunc(0.5_RK*(lbTrans+ubTrans))
2334 : else
2335 : neval = 3**(refinementStage-2)
2336 : inverseThreeNumFuncEval = ONE_THIRD / neval
2337 : del = (ubTrans-lbTrans) * inverseThreeNumFuncEval
2338 : ddel = del + del
2339 : x = lbTrans + 0.5_RK*del
2340 : summ = 0._RK
2341 : do iFuncEval = 1,neval
2342 : summ = summ + getTransFunc(x)
2343 : x = x + ddel
2344 : summ = summ + getTransFunc(x)
2345 : x = x + del
2346 : end do
2347 : integral = ONE_THIRD * integral + (ubTrans-lbTrans) * summ * inverseThreeNumFuncEval
2348 : neval = 2_IK * neval
2349 : end if
2350 : contains
2351 : !!> \cond excluded
2352 : function getTransFunc(x)
2353 : real(RK), intent(in) :: x
2354 : real(RK) :: getTransFunc
2355 : getTransFunc = getFunc(-log(x)) / x
2356 : end function getTransFunc
2357 : !!> \endcond excluded
2358 : end subroutine midexp
2359 :
2360 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2361 :
2362 : !> \brief
2363 : !> This routine is an exact replacement for [midpnt](@ref midpnt), i.e., returns as `integral` the nth stage of refinement
2364 : !> of the integral of funk from `lb` to `ub`, except that the function is evaluated at evenly spaced
2365 : !> points in `1/x` rather than in `x`. This allows the upper limit `ub` to be as large and positive
2366 : !> as the computer allows, or the lower limit `lb` to be as large and negative, but not both.
2367 : !>
2368 : !> \param[in] getFunc : The input function to be integrated. It must have the interface specified by
2369 : !! [integrand_proc](@ref integrand_proc).
2370 : !> \param[in] lb : The lower limit of integration.
2371 : !> \param[in] ub : The upper limit of integration.
2372 : !> \param[inout] integral : The result of integration.
2373 : !> \param[in] refinementStage : The number of refinements since the first call to the integrator.
2374 : !> \param[out] neval : The number of function evaluations made.
2375 : !>
2376 : !> \warning
2377 : !> `lb * ub > 0.0` must hold for this integrator to function properly.
2378 : !>
2379 : !> \remark
2380 : !> Tested by Joshua Osborne on 5/28/2020 at 8:58 pm.
2381 : subroutine midinf(getFunc,lb,ub,integral,refinementStage,neval)
2382 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2383 : !DEC$ ATTRIBUTES DLLEXPORT :: midinf
2384 : #endif
2385 : implicit none
2386 : real(RK) , intent(in) :: lb,ub
2387 : integer(IK) , intent(in) :: refinementStage
2388 : integer(IK) , intent(out) :: neval
2389 : real(RK) , intent(inout) :: integral
2390 : procedure(integrand_proc) :: getFunc
2391 : real(RK) :: lbTrans, ubTrans, del, ddel, summ, x
2392 : real(RK) :: inverseThreeNumFuncEval
2393 : integer(IK) :: iFuncEval
2394 : ubTrans = 1.0_RK / lb
2395 : lbTrans = 1.0_RK / ub
2396 : if (refinementStage == 1_IK) then
2397 : neval = 1_IK
2398 : integral = (ubTrans-lbTrans) * getTransFunc(0.5_RK * (lbTrans+ubTrans))
2399 : else
2400 : neval = 3**(refinementStage-2)
2401 : inverseThreeNumFuncEval = ONE_THIRD / neval
2402 : del = (ubTrans-lbTrans) * inverseThreeNumFuncEval
2403 : ddel = del + del
2404 : x = lbTrans + 0.5_RK * del
2405 : summ = 0._RK
2406 : do iFuncEval = 1, neval
2407 : summ = summ + getTransFunc(x)
2408 : x = x + ddel
2409 : summ = summ + getTransFunc(x)
2410 : x = x + del
2411 : end do
2412 : integral = ONE_THIRD * integral + (ubTrans-lbTrans) * summ * inverseThreeNumFuncEval
2413 : neval = 2_IK * neval
2414 : end if
2415 : contains
2416 : !!> \cond excluded
2417 : function getTransFunc(x) result(transFunc)
2418 : implicit none
2419 : real(RK), intent(in) :: x
2420 : real(RK) :: transFunc
2421 : transFunc = getFunc(1._RK/x) / x**2
2422 : end function getTransFunc
2423 : !!> \endcond excluded
2424 : end subroutine midinf
2425 :
2426 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2427 :
2428 : !> \brief
2429 : !> This routine computes the nth stage of refinement of an extended midpoint rule.
2430 : !> When called with `n = 1`, the routine returns as `integral` the crudest estimate of \f$\int_a^b f(x) ~ dx\f$.
2431 : !> Subsequent calls with `n = 2, 3, ...` (in that sequential order) will improve the accuracy of `integral` by adding
2432 : !> `(2/3) * 3n-1` additional interior points.
2433 : !>
2434 : !> \param[in] getFunc : The input function to be integrated. It must have the interface specified by
2435 : !! [integrand_proc](@ref integrand_proc).
2436 : !> \param[in] lb : The lower limit of integration.
2437 : !> \param[in] ub : The upper limit of integration.
2438 : !> \param[inout] integral : The result of integration.
2439 : !> \param[in] refinementStage : The number of refinements since the first call to the integrator.
2440 : !> \param[out] neval : The number of function evaluations made.
2441 : !>
2442 : !> \warning
2443 : !> The argument `integral` should not be modified between sequential calls.
2444 : !>
2445 : !> \remark
2446 : !> Tested by Joshua Osborne on 5/28/2020 at 8:55 pm.
2447 : subroutine midpnt(getFunc,lb,ub,integral,refinementStage,neval)
2448 : #if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
2449 : !DEC$ ATTRIBUTES DLLEXPORT :: midpnt
2450 : #endif
2451 : implicit none
2452 : integer(IK) , intent(in) :: refinementStage
2453 : real(RK) , intent(in) :: lb, ub
2454 : real(RK) , intent(inout) :: integral
2455 : integer(IK) , intent(out) :: neval
2456 : procedure(integrand_proc) :: getFunc
2457 : integer(IK) :: iFuncEval
2458 : real(RK) :: ddel,del,summ,x
2459 : real(RK) :: inverseThreeNumFuncEval
2460 : if (refinementStage==1) then
2461 : neval = 1_IK
2462 : integral = (ub-lb) * getFunc( 0.5_RK * (lb+ub) )
2463 : else
2464 : neval = 3_IK**(refinementStage-2)
2465 : inverseThreeNumFuncEval = ONE_THIRD / neval
2466 : del = (ub-lb) * inverseThreeNumFuncEval
2467 : ddel = del+del
2468 : x = lb + 0.5_RK * del
2469 : summ = 0._RK
2470 : do iFuncEval = 1, neval
2471 : summ = summ + getFunc(x)
2472 : x = x + ddel
2473 : summ = summ + getFunc(x)
2474 : x = x + del
2475 : end do
2476 : integral = ONE_THIRD * integral + (ub-lb) * summ * inverseThreeNumFuncEval
2477 : neval = 2_IK * neval
2478 : end if
2479 : end subroutine midpnt
2480 :
2481 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2482 : #endif
2483 : !> \endcond excluded
2484 :
2485 0 : end module pm_quadRomb
|
