diff options
| author | Wojtek Kosior <kwojtus@protonmail.com> | 2019-06-21 14:26:57 +0200 |
|---|---|---|
| committer | Wojtek Kosior <kwojtus@protonmail.com> | 2019-06-21 14:26:57 +0200 |
| commit | e5a89cb63036f343badf1ebbb4ed07b06b4eed0a (patch) | |
| tree | 95db977cacfcf8d107a877d9abaef03d6a924515 /src | |
| parent | 6a6f16735de786c41a73f668385ef049accf9e41 (diff) | |
| download | fortran-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.f90 | 26 |
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 |