Skip to content

Commit f73beda

Browse files
committed
attempt at quad API
1 parent ccaf548 commit f73beda

File tree

1 file changed

+64
-1
lines changed

1 file changed

+64
-1
lines changed

src/stdlib_experimental_quadrature.fypp

Lines changed: 64 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
#:include "common.fypp"
2-
2+
#:set WEIGHT_FUNS = ["sin", "cos", "pole"]
3+
#:set QUAD_OK = False
34
module stdlib_experimental_quadrature
45
use stdlib_experimental_kinds, only: sp, dp, qp
56

@@ -13,6 +14,15 @@ module stdlib_experimental_quadrature
1314
public :: simps
1415
public :: simps_weights
1516

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+
1626

1727
interface trapz
1828
#:for KIND in REAL_KINDS
@@ -72,4 +82,57 @@ module stdlib_experimental_quadrature
7282
#:endfor
7383
end interface simps_weights
7484

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
75138
end module stdlib_experimental_quadrature

0 commit comments

Comments
 (0)