1
1
#:include "common.fypp"
2
-
2
+ #:set WEIGHT_FUNS = ["sin", "cos", "pole"]
3
+ #:set QUAD_OK = False
3
4
module stdlib_experimental_quadrature
4
5
use stdlib_experimental_kinds, only: sp, dp, qp
5
6
@@ -13,6 +14,15 @@ module stdlib_experimental_quadrature
13
14
public :: simps
14
15
public :: simps_weights
15
16
17
+ ! automatic integration of (weighted) functions
18
+ #:if QUAD_OK
19
+ public :: quad
20
+ public :: weight_t
21
+ #:for WFUN in WEIGHT_FUNS
22
+ public :: ${WFUN}$_weight_t
23
+ #:endfor
24
+ #:endif
25
+
16
26
17
27
interface trapz
18
28
#:for KIND in REAL_KINDS
@@ -72,4 +82,57 @@ module stdlib_experimental_quadrature
72
82
#:endfor
73
83
end interface simps_weights
74
84
85
+
86
+ ! Interface for a simple f(x)-style integrand function.
87
+ ! Could become fancier as we learn about the performance
88
+ ! ramifications of different ways to do callbacks.
89
+ abstract interface
90
+ #:for KIND in REAL_KINDS
91
+ pure function integrand_${KIND}$(x) result(f)
92
+ import :: ${KIND}$
93
+ real(${KIND}$), intent(in) :: x
94
+ real(${KIND}$) :: f
95
+ end function integrand_${KIND}$
96
+ #:endfor
97
+ end interface
98
+
99
+ #:if QUAD_OK
100
+ ! Base class to avoid repeating kind parameter declaration.
101
+ type, abstract :: weight_t(kind)
102
+ integer, kind :: kind
103
+ end type weight_t
104
+
105
+ type, extends(weight_t) :: sin_weight_t
106
+ real(kind) :: omega
107
+ end type sin_weight_t
108
+
109
+ type, extends(weight_t) :: cos_weight_t
110
+ real(kind) :: omega
111
+ end type cos_weight_t
112
+
113
+ type, extends(weight_t) :: pole_weight_t
114
+ real(kind) :: c
115
+ end type pole_weight_t
116
+
117
+ ! gfortran 9.2.0 chokes on ICE if I include this ("buffer overflow detected")
118
+ ! Interestingly, though, the ICE happens while trying to build the trapz submodule
119
+ ! PDT bug?
120
+ interface quad
121
+ #:for WFUN in WEIGHT_FUNS
122
+ #:for KIND in REAL_KINDS
123
+ module function quad_${WFUN}$_${KIND}$(f, a, b, weight, points, abstol, reltol, delta) result(integral)
124
+ procedure(integrand_${KIND}$) :: f
125
+ real(${KIND}$), intent(in) :: a
126
+ real(${KIND}$), intent(in) :: b
127
+ type(${WFUN}$_weight_t(${KIND}$)), intent(in) :: weight
128
+ real(${KIND}$), intent(in), dimension(:) :: points
129
+ real(${KIND}$), intent(in) :: abstol
130
+ real(${KIND}$), intent(in) :: reltol
131
+ real(${KIND}$), intent(out), optional :: delta
132
+ real(${KIND}$) :: integral
133
+ end function quad_${WFUN}$_${KIND}$
134
+ #:endfor
135
+ #:endfor
136
+ end interface quad
137
+ #:endif
75
138
end module stdlib_experimental_quadrature
0 commit comments