diff options
| -rw-r--r-- | src/main.f90 | 73 |
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 |