src/main.f90

   1 ! Copyright 2019 Wojciech Kosior
   2
   3 ! This is free and unencumbered software released into the public domain.
   4
   5 ! Anyone is free to copy, modify, publish, use, compile, sell, or
   6 ! distribute this software, either in source code form or as a compiled
   7 ! binary, for any purpose, commercial or non-commercial, and by any
   8 ! means.
   9
  10 ! In jurisdictions that recognize copyright laws, the author or authors
  11 ! of this software dedicate any and all copyright interest in the
  12 ! software to the public domain. We make this dedication for the benefit
  13 ! of the public at large and to the detriment of our heirs and
  14 ! successors. We intend this dedication to be an overt act of
  15 ! relinquishment in perpetuity of all present and future rights to this
  16 ! software under copyright law.
  17
  18 ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  21 ! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
  22 ! OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
  23 ! ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  24 ! OTHER DEALINGS IN THE SOFTWARE.
  25
  26 ! For more information, please refer to <http://unlicense.org/>
  27
  28 PROGRAM integrator
  29   USE quadratures
  30   USE functions
  31   USE iso_fortran_env, ONLY: error_unit
  32   USE, intrinsic :: ieee_arithmetic
  33   IMPLICIT none
  34
  35   real(kind=8) :: ibeg, iend, val
  36   integer(kind=4) :: poly_order
  37   procedure(integrate), pointer :: numerical_int
  38   procedure(funint), pointer :: fun
  39   procedure(analytical_integral), pointer :: analytical_int
  40   character(100) :: arg, errmsg
  41   logical :: isok = .true.
  42
  43   IF (command_argument_count() < 4) THEN
  44      errmsg = "at least 4 arguments required"
  45      isok = .false.
  46      GOTO 1
  47   END IF
  48
  49   call get_command_argument(2, arg)
  50
  51   IF      (arg == "exp")  THEN
  52      fun            => my_exp
  53      analytical_int => my_exp_int
  54   ELSE IF (arg == "sin")  THEN
  55      fun            => my_sin
  56      analytical_int => my_sin_int
  57   ELSE IF (arg == "poly") THEN
  58      fun            => my_poly
  59      analytical_int => my_poly_int
  60   ELSE
  61      errmsg =  "bad second argument (should be 'exp', 'sin' or 'poly')"
  62      isok = .false.
  63      GOTO 1
  64   END IF
  65
  66
  67   call get_command_argument(3, arg)
  68
  69   read (arg,*) ibeg
  70
  71   call get_command_argument(4, arg)
  72
  73   read (arg,*) iend
  74
  75
  76   call get_command_argument(1, arg)
  77
  78   IF      (arg == "gauss")        THEN
  79      numerical_int => gauss
  80   ELSE IF (arg == "newton-cotes") THEN
  81      numerical_int => newton_cotes
  82   ELSE IF (arg == "analytical")   THEN
  83      if (this_image() == 1) write (*,*) analytical_int(ibeg, iend)
  84      GOTO 1
  85   ELSE
  86      errmsg = "bad first argument (should be 'gauss',"            &
  87           // " 'newton-cotes' or 'analytical')"
  88      isok = .false.
  89      GOTO 1
  90   END IF
  91
  92
  93   IF (command_argument_count() < 5) THEN
  94      errmsg = "5th argument (polynomial order) required"          &
  95           // " for numerical integration"
  96      isok = .false.
  97      GOTO 1
  98   END IF
  99
 100   call get_command_argument(5, arg)
 101   read (arg,*) poly_order
 102
 103
 104   IF (command_argument_count() > 5) THEN
 105      call get_command_argument(6, arg)
 106      read (arg,*) subintervals
 107      IF (subintervals < 1) THEN
 108         errmsg = "subintervals number must be positive"
 109         isok = .false.
 110         GOTO 1
 111      END IF
 112   END IF
 113
 114   val = numerical_int(ibeg, iend, fun, poly_order)
 115
 116   IF (ieee_is_nan(val)) THEN
 117      errmsg = "invalid 5th argument (polynomial order)"
 118      isok = .false.
 119      GOTO 1
 120   END IF
 121
 122   if (this_image() == 1) write (*,'(es21.14," ",es21.14)')        &
 123        val, abs(val - analytical_int(ibeg, iend))
 124
 125   1 if (this_image() == 1 .and. .not. isok) write(*,*) trim(errmsg)
 126
 127 CONTAINS
 128
 129 END PROGRAM integrator