src/main.f90

   1 PROGRAM integrator
   2   USE quadratures
   3   USE functions
   4   USE iso_fortran_env, ONLY: error_unit
   5   IMPLICIT none
   6
   7   real(kind=8) :: ibeg, iend, val
   8   integer(kind=4) :: poly_order
   9   procedure(integrate), pointer :: numerical_int
  10   procedure(funint), pointer :: fun
  11   procedure(analytical_integral), pointer :: analytical_int
  12   character(100) :: arg, errmsg
  13   logical :: isok = .true.
  14
  15   IF (command_argument_count() < 4) THEN
  16      errmsg = "at least 4 arguments required"
  17      isok = .false.
  18      GOTO 1
  19   END IF
  20
  21   call get_command_argument(2, arg)
  22
  23   IF      (arg == "exp")  THEN
  24      fun            => my_exp
  25      analytical_int => my_exp_int
  26   ELSE IF (arg == "sin")  THEN
  27      fun            => my_sin
  28      analytical_int => my_sin_int
  29   ELSE IF (arg == "poly") THEN
  30      fun            => my_poly
  31      analytical_int => my_poly_int
  32   ELSE
  33      errmsg =  "bad second argument (should be 'exp', 'sin' or 'poly')"
  34      isok = .false.
  35      GOTO 1
  36   END IF
  37
  38
  39   call get_command_argument(3, arg)
  40
  41   read (arg,*) ibeg
  42
  43   call get_command_argument(4, arg)
  44
  45   read (arg,*) iend
  46
  47
  48   call get_command_argument(1, arg)
  49
  50   IF      (arg == "gauss")        THEN
  51      numerical_int => gauss
  52   ELSE IF (arg == "newton-cotes") THEN
  53      numerical_int => newton_cotes
  54   ELSE IF (arg == "analytical")   THEN
  55      if (this_image() == 1) write (*,*) analytical_int(ibeg, iend)
  56      GOTO 1
  57   ELSE
  58      errmsg = "bad first argument (should be 'gauss',"            &
  59           // " 'newton-cotes' or 'analytical')"
  60      isok = .false.
  61      GOTO 1
  62   END IF
  63
  64
  65   IF (command_argument_count() < 5) THEN
  66      errmsg = "5th argument (polynomial order) required"          &
  67           // " for numerical integration"
  68      isok = .false.
  69      GOTO 1
  70   END IF
  71
  72   call get_command_argument(5, arg)
  73   read (arg,*) poly_order
  74
  75
  76   IF (command_argument_count() > 5) THEN
  77      call get_command_argument(6, arg)
  78      read (arg,*) subintervals
  79      IF (subintervals < 1) THEN
  80         errmsg = "subintervals number must be positive"
  81         isok = .false.
  82         GOTO 1
  83      END IF
  84   END IF
  85
  86   val = numerical_int(ibeg, iend, fun, poly_order)
  87
  88   if (this_image() == 1) write (*,*) val
  89
  90   1 if (this_image() == 1 .and. .not. isok) write(*,*) trim(errmsg)
  91
  92 CONTAINS
  93
  94 END PROGRAM integrator