aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorWojtek Kosior <kwojtus@protonmail.com>2019-06-21 14:26:57 +0200
committerWojtek Kosior <kwojtus@protonmail.com>2019-06-21 14:26:57 +0200
commite5a89cb63036f343badf1ebbb4ed07b06b4eed0a (patch)
tree95db977cacfcf8d107a877d9abaef03d6a924515 /src
parent6a6f16735de786c41a73f668385ef049accf9e41 (diff)
downloadfortran-assignment3-e5a89cb63036f343badf1ebbb4ed07b06b4eed0a.tar.gz
fortran-assignment3-e5a89cb63036f343badf1ebbb4ed07b06b4eed0a.zip
move threading code and quadtature selection into separate functions
Diffstat (limited to 'src')
-rw-r--r--src/quadratures.f9026
1 files changed, 19 insertions, 7 deletions
diff --git a/src/quadratures.f90 b/src/quadratures.f90
index 2eac963..43e6ac6 100644
--- a/src/quadratures.f90
+++ b/src/quadratures.f90
@@ -45,14 +45,10 @@ CONTAINS
real(kind=8), intent(in) :: iend
procedure(funint) :: fun
integer(kind=4), intent(in) :: p
-
- real(kind=8) :: val, subinterval_width, qbeg, qend
- real(kind=8), allocatable :: partval[:]
+ real(kind=8) :: val
procedure(quadrature), pointer :: quad
- integer(kind=8) :: min_i, max_i, i, subintervals_per_thread
- integer(kind=4) :: im
-
+
SELECT CASE (p)
CASE (:-1)
STOP "negative interpolationg polynomial order passed"
@@ -66,6 +62,22 @@ CONTAINS
STOP "Newton-Cotes quadratures only implemented for order < 3"
END SELECT
+ val = integrate_generic(ibeg, iend, fun, quad)
+ END FUNCTION newton_cotes
+
+ FUNCTION integrate_generic(ibeg, iend, fun, quad) result(val)
+ IMPLICIT none
+ real(kind=8), intent(in) :: ibeg
+ real(kind=8), intent(in) :: iend
+ procedure(funint) :: fun
+ procedure(quadrature) :: quad
+
+ real(kind=8) :: val, subinterval_width, qbeg, qend
+ real(kind=8), allocatable :: partval[:]
+
+ integer(kind=8) :: min_i, max_i, i, subintervals_per_thread
+ integer(kind=4) :: im
+
if (this_image() == 1) allocate(partval[*])
subintervals_per_thread = &
@@ -98,7 +110,7 @@ CONTAINS
val = partval[1]
- END FUNCTION newton_cotes
+ END FUNCTION integrate_generic
FUNCTION rectangle(qbeg, qend, fun) result(val)
IMPLICIT none