aboutsummaryrefslogtreecommitdiff
! Copyright 2019 Wojciech Kosior
  
! This is free and unencumbered software released into the public domain.

! Anyone is free to copy, modify, publish, use, compile, sell, or
! distribute this software, either in source code form or as a compiled
! binary, for any purpose, commercial or non-commercial, and by any
! means.

! In jurisdictions that recognize copyright laws, the author or authors
! of this software dedicate any and all copyright interest in the
! software to the public domain. We make this dedication for the benefit
! of the public at large and to the detriment of our heirs and
! successors. We intend this dedication to be an overt act of
! relinquishment in perpetuity of all present and future rights to this
! software under copyright law.

! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
! OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
! ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
! OTHER DEALINGS IN THE SOFTWARE.

! For more information, please refer to <http://unlicense.org/>

PROGRAM integrator
  USE quadratures
  USE functions
  USE iso_fortran_env, ONLY: error_unit
  USE, intrinsic :: ieee_arithmetic
  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, errmsg
  logical :: isok = .true.

  IF (command_argument_count() < 4) THEN
     errmsg = "at least 4 arguments required"
     isok = .false.
     GOTO 1
  END IF

  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
     errmsg =  "bad second argument (should be 'exp', 'sin' or 'poly')"
     isok = .false.
     GOTO 1
  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)
     GOTO 1
  ELSE
     errmsg = "bad first argument (should be 'gauss',"            &
          // " 'newton-cotes' or 'analytical')"
     isok = .false.
     GOTO 1
  END IF

  
  IF (command_argument_count() < 5) THEN
     errmsg = "5th argument (polynomial order) required"          &
          // " for numerical integration"
     isok = .false.
     GOTO 1
  END IF
  
  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) THEN
        errmsg = "subintervals number must be positive"
        isok = .false.
        GOTO 1
     END IF
  END IF

  val = numerical_int(ibeg, iend, fun, poly_order)

  IF (ieee_is_nan(val)) THEN
     errmsg = "invalid 5th argument (polynomial order)"
     isok = .false.
     GOTO 1
  END IF
  
  if (this_image() == 1) write (*,'(es21.14," ",es21.14)')        &
       val, abs(val - analytical_int(ibeg, iend))

  1 if (this_image() == 1 .and. .not. isok) write(*,*) trim(errmsg)
  
CONTAINS

END PROGRAM integrator