diff options
| author | Wojtek Kosior <kwojtus@protonmail.com> | 2019-07-03 21:12:59 +0200 |
|---|---|---|
| committer | Wojtek Kosior <kwojtus@protonmail.com> | 2019-07-03 21:12:59 +0200 |
| commit | 72ca4af0f99fbce82d143b99649669923b4b1161 (patch) | |
| tree | dd2aa7470cca1f2a7c292fa3aaaa0a5594631487 /src/quadratures.f90 | |
| parent | 7b91f51a0de4ce6077e66c37d673e541762476d6 (diff) | |
| download | fortran-assignment3-72ca4af0f99fbce82d143b99649669923b4b1161.tar.gz fortran-assignment3-72ca4af0f99fbce82d143b99649669923b4b1161.zip | |
return NaN for wrong poly order argument and handle this error upper in the call stack
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) |