@@ -186,3 +186,87 @@ program demo_simps_weights
186186! 64.0
187187end program demo_simps_weights
188188```
189+
190+ ## ` gauss_legendre ` - Gauss-Legendre quadrature (a.k.a. Gaussian quadrature) nodes and weights
191+
192+ ### Status
193+
194+ Experimental
195+
196+ ### Description
197+
198+ Computes Gauss-Legendre quadrature (also known as simply Gaussian quadrature) nodes and weights,
199+ for any ` N ` (number of nodes).
200+ Using the nodes ` x ` and weights ` w ` , you can compute the integral of some function ` f ` as follows:
201+ ` integral = sum(f(x) * w) ` .
202+
203+ Only double precision is supported - if lower precision is required, you must do the appropriate conversion yourself.
204+ Accuracy has been validated up to N=64 by comparing computed results to tablulated values known to be accurate to machine precision
205+ (maximum difference from those values is 2 epsilon).
206+
207+ ### Syntax
208+
209+ ` subroutine [[stdlib_quadrature(module):gauss_legendre(interface)]](x, w [, interval]) `
210+
211+ ### Arguments
212+
213+ ` x ` : Shall be a rank-one array of type ` real(real64) ` . It is an * output* argument, representing the quadrature nodes.
214+
215+ ` w ` : Shall be a rank-one array of type ` real(real64) ` , with the same dimension as ` x ` .
216+ It is an * output* argument, representing the quadrature weights.
217+
218+ ` interval ` : (Optional) Shall be a two-element array of type ` real(real64) ` .
219+ If present, the nodes and weigts are calculated for integration from ` interval(1) ` to ` interval(2) ` .
220+ If not specified, the default integral is -1 to 1.
221+
222+ ### Example
223+
224+ ``` fortran
225+ integer, parameter :: N = 6
226+ real(dp), dimension(N) :: x,w
227+ call gauss_legendre(x,w)
228+ integral = sum(x**2 * w)
229+ ```
230+
231+ ## ` gauss_legendre_lobatto ` - Gauss-Legendre-Lobatto quadrature nodes and weights
232+
233+ ### Status
234+
235+ Experimental
236+
237+ ### Description
238+
239+ Computes Gauss-Legendre-Lobatto quadrature nodes and weights,
240+ for any ` N ` (number of nodes).
241+ Using the nodes ` x ` and weights ` w ` , you can compute the integral of some function ` f ` as follows:
242+ ` integral = sum(f(x) * w) ` .
243+
244+ Only double precision is supported - if lower precision is required, you must do the appropriate conversion yourself.
245+ Accuracy has been validated up to N=64 by comparing computed results to tablulated values known to be accurate to machine precision
246+ (maximum difference from those values is 2 epsilon).
247+
248+ ### Syntax
249+
250+ ` subroutine [[stdlib_quadrature(module):gauss_legendre_lobatto(interface)]](x, w [, interval]) `
251+
252+ ### Arguments
253+
254+ ` x ` : Shall be a rank-one array of type ` real(real64) ` . It is an * output* argument, representing the quadrature nodes.
255+
256+ ` w ` : Shall be a rank-one array of type ` real(real64) ` , with the same dimension as ` x ` .
257+ It is an * output* argument, representing the quadrature weights.
258+
259+ ` interval ` : (Optional) Shall be a two-element array of type ` real(real64) ` .
260+ If present, the nodes and weigts are calculated for integration from ` interval(1) ` to ` interval(2) ` .
261+ If not specified, the default integral is -1 to 1.
262+
263+ ### Example
264+
265+ ``` fortran
266+ integer, parameter :: N = 6
267+ real(dp), dimension(N) :: x,w
268+ call gauss_legendre_lobatto(x,w)
269+ integral = sum(x**2 * w)
270+ ```
271+
272+
0 commit comments