aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/main.f9073
1 files changed, 73 insertions, 0 deletions
diff --git a/src/main.f90 b/src/main.f90
new file mode 100644
index 0000000..8c7467a
--- /dev/null
+++ b/src/main.f90
@@ -0,0 +1,73 @@
+PROGRAM integrator
+ USE quadratures
+ USE functions
+ IMPLICIT none
+
+ real(kind=8) :: ibeg, iend, val
+ integer(kind=4) :: poly_order
+ procedure(integrate), pointer :: numerical_int
+ procedure(funint), pointer :: fun
+ procedure(analytical_integral), pointer :: analytical_int
+ character(100) :: arg
+
+ IF (command_argument_count() < 4) STOP "4 arguments required"
+
+ call get_command_argument(2, arg)
+
+ IF (arg == "exp") THEN
+ fun => my_exp
+ analytical_int => my_exp_int
+ ELSE IF (arg == "sin") THEN
+ fun => my_sin
+ analytical_int => my_sin_int
+ ELSE IF (arg == "poly") THEN
+ fun => my_poly
+ analytical_int => my_poly_int
+ ELSE
+ STOP "bad second argument (should be 'exp', 'sin' or 'poly')"
+ END IF
+
+
+ call get_command_argument(3, arg)
+
+ read (arg,*) ibeg
+
+ call get_command_argument(4, arg)
+
+ read (arg,*) iend
+
+
+ call get_command_argument(1, arg)
+
+ IF (arg == "gauss") THEN
+ numerical_int => gauss
+ ELSE IF (arg == "newton-cotes") THEN
+ numerical_int => newton_cotes
+ ELSE IF (arg == "analytical") THEN
+ IF (this_image() == 1) write (*,*) analytical_int(ibeg, iend)
+ STOP
+ ELSE
+ STOP "bad first argument (should be 'gauss', 'newton-cotes'" &
+ // " or 'analytical')"
+ END IF
+
+
+ IF (command_argument_count() < 5) &
+ STOP "5th argument (polynomial order) required" &
+ // " for numerical integration"
+
+ call get_command_argument(5, arg)
+ read (arg,*) poly_order
+
+
+ IF (command_argument_count() > 5) THEN
+ call get_command_argument(6, arg)
+ read (arg,*) subintervals
+ IF (subintervals < 1) STOP "subintervals number must be positive"
+ END IF
+
+ val = numerical_int(ibeg, iend, fun, poly_order)
+
+ IF (this_image() == 1) write (*,*) val
+
+END PROGRAM integrator