aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/quadratures.f90106
1 files changed, 53 insertions, 53 deletions
diff --git a/src/quadratures.f90 b/src/quadratures.f90
index cc279ed..a595ce3 100644
--- a/src/quadratures.f90
+++ b/src/quadratures.f90
@@ -39,59 +39,6 @@ MODULE quadratures
CONTAINS
- FUNCTION newton_cotes(ibeg, iend, fun, p) result(val)
- IMPLICIT none
- real(kind=8), intent(in) :: ibeg
- real(kind=8), intent(in) :: iend
- procedure(funint) :: fun
- integer(kind=4), intent(in) :: p
- real(kind=8) :: val
-
- procedure(quadrature), pointer :: quad
-
- SELECT CASE (p)
- CASE (:-1)
- STOP "negative interpolationg polynomial order passed"
- CASE (0)
- quad => rectangle
- CASE (1)
- quad => trapeze
- CASE (2)
- quad => simpson_1_third
- CASE default
- STOP "Newton-Cotes quadratures only implemented for order < 3"
- END SELECT
-
- val = integrate_generic(ibeg, iend, fun, quad)
- END FUNCTION newton_cotes
-
- FUNCTION gauss(ibeg, iend, fun, p) result(val)
- IMPLICIT none
- real(kind=8), intent(in) :: ibeg
- real(kind=8), intent(in) :: iend
- procedure(funint) :: fun
- integer(kind=4), intent(in) :: p
- real(kind=8) :: val
-
- procedure(quadrature), pointer :: quad
-
- SELECT CASE (p)
- CASE (:0)
- STOP "non-positive Legendre polynomial order passed"
- CASE (1)
- quad => gauss_n1
- CASE (2)
- quad => gauss_n2
- CASE (3)
- quad => gauss_n3
- CASE default
- STOP "Gauss quadratures only implemented with roots of" &
- // " Legendgre polynomial of order <= 3"
- END SELECT
-
- val = integrate_generic(ibeg, iend, fun, quad)
- END FUNCTION gauss
-
FUNCTION integrate_generic(ibeg, iend, fun, quad) result(val)
IMPLICIT none
real(kind=8), intent(in) :: ibeg
@@ -139,6 +86,32 @@ CONTAINS
END FUNCTION integrate_generic
+ FUNCTION newton_cotes(ibeg, iend, fun, p) result(val)
+ IMPLICIT none
+ real(kind=8), intent(in) :: ibeg
+ real(kind=8), intent(in) :: iend
+ procedure(funint) :: fun
+ integer(kind=4), intent(in) :: p
+ real(kind=8) :: val
+
+ procedure(quadrature), pointer :: quad
+
+ SELECT CASE (p)
+ CASE (:-1)
+ STOP "negative interpolationg polynomial order passed"
+ CASE (0)
+ quad => rectangle
+ CASE (1)
+ quad => trapeze
+ CASE (2)
+ quad => simpson_1_third
+ CASE default
+ STOP "Newton-Cotes quadratures only implemented for order < 3"
+ END SELECT
+
+ val = integrate_generic(ibeg, iend, fun, quad)
+ END FUNCTION newton_cotes
+
FUNCTION rectangle(qbeg, qend, fun) result(val)
IMPLICIT none
real(kind=8), intent(in) :: qbeg, qend
@@ -167,6 +140,33 @@ CONTAINS
(fun(qbeg) + 4 * fun ((qbeg + qend) * 0.5) + fun(qend))
END FUNCTION simpson_1_third
+ FUNCTION gauss(ibeg, iend, fun, p) result(val)
+ IMPLICIT none
+ real(kind=8), intent(in) :: ibeg
+ real(kind=8), intent(in) :: iend
+ procedure(funint) :: fun
+ integer(kind=4), intent(in) :: p
+ real(kind=8) :: val
+
+ procedure(quadrature), pointer :: quad
+
+ SELECT CASE (p)
+ CASE (:0)
+ STOP "non-positive Legendre polynomial order passed"
+ CASE (1)
+ quad => gauss_n1
+ CASE (2)
+ quad => gauss_n2
+ CASE (3)
+ quad => gauss_n3
+ CASE default
+ STOP "Gauss quadratures only implemented with roots of" &
+ // " Legendgre polynomial of order <= 3"
+ END SELECT
+
+ val = integrate_generic(ibeg, iend, fun, quad)
+ END FUNCTION gauss
+
FUNCTION gauss_generic(mid, halfwidth, fun, points, weights) &
result(val)
IMPLICIT none