diff options
Diffstat (limited to 'src/quadratures.f90')
| -rw-r--r-- | src/quadratures.f90 | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/src/quadratures.f90 b/src/quadratures.f90 index 06d4c6c..6fbb5cb 100644 --- a/src/quadratures.f90 +++ b/src/quadratures.f90 @@ -131,6 +131,8 @@ CONTAINS END FUNCTION integrate_generic FUNCTION newton_cotes(ibeg, iend, fun, p) result(val) + USE, intrinsic :: ieee_arithmetic + IMPLICIT none real(kind=8), intent(in) :: ibeg real(kind=8), intent(in) :: iend @@ -141,8 +143,6 @@ CONTAINS procedure(quadrature), pointer :: quad SELECT CASE (p) - CASE (:-1) - STOP "negative interpolationg polynomial order passed" CASE (0) quad => rectangle CASE (1) @@ -150,7 +150,8 @@ CONTAINS CASE (2) quad => simpson_1_third CASE default - STOP "Newton-Cotes quadratures only implemented for order < 3" + val = ieee_value(val, ieee_quiet_nan) + RETURN END SELECT val = integrate_generic(ibeg, iend, fun, quad) @@ -185,6 +186,8 @@ CONTAINS END FUNCTION simpson_1_third FUNCTION gauss(ibeg, iend, fun, p) result(val) + USE, intrinsic :: ieee_arithmetic + IMPLICIT none real(kind=8), intent(in) :: ibeg real(kind=8), intent(in) :: iend @@ -195,8 +198,6 @@ CONTAINS procedure(quadrature), pointer :: quad SELECT CASE (p) - CASE (:0) - STOP "non-positive Legendre polynomial order passed" CASE (1) quad => gauss_n1 CASE (2) @@ -204,8 +205,8 @@ CONTAINS CASE (3) quad => gauss_n3 CASE default - STOP "Gauss quadratures only implemented with roots of" & - // " Legendgre polynomial of order <= 3" + val = ieee_value(val, ieee_quiet_nan) + RETURN END SELECT val = integrate_generic(ibeg, iend, fun, quad) |