command_line.f90

Go to the documentation of this file.

 
module command_line
 
  use kinds
 
  implicit none
 
  private
  public :: get_arg, get_arg_value, arg_present ! main accessors
  public :: arg_count, dump_names, str_wrapper  ! helpers
 
  logical :: initial_parse_done = .false.
 
  ! init. to default values
  type cmd_arg
    character(len=:), allocatable :: name
    character(len=:), allocatable :: value
    logical :: has_value = .true. !whether a value was supplied (c.f. empty)
  end type
 
  type str_wrapper
    character(len=:), allocatable :: str
  end type
 
  interface get_arg
    module procedure get_arg_num_logical, get_arg_name_logical
    module procedure get_arg_num_int, get_arg_name_int
    module procedure get_arg_num_long, get_arg_name_long
    module procedure get_arg_num_float, get_arg_name_float
    module procedure get_arg_num_dbl, get_arg_name_dbl
    module procedure get_arg_num_str, get_arg_name_str
  end interface
 
  type(cmd_arg), dimension(:), allocatable :: all_args
  integer :: num_args = 0
  integer, parameter :: max_string_len = 200
  private :: all_args, num_args
 
  contains
 
  subroutine parse_args()
 
    ! strictly we can't be sure any max_string_len is enough
    ! but for command-line args it's enough if we're sensible
    ! we wont overflow, but our strings may get truncated
    ! we'll print an warning, since this is probably unintended input
 
    ! note: some codes have reason to disable implicit re-allocation so we
    ! take the extra effort to allocate all our strings manually
 
    integer :: i_arg, i_tok, indx
    type(cmd_arg), dimension(:), allocatable :: all_args_tmp
    character(len=max_string_len) :: arg, tmp, tmp_name, tmp_val
    integer :: arg_in_length, tmp_len
    logical :: truncated
 
    truncated = .false.
 
    num_args = command_argument_count()
    if(num_args > 0) then
 
      ! if this is not the first call, all_args may be already allocated
      ! deallocate if needed, and allocate to sufficient size
      ! will be trimmed to actual size after parsing
      if(allocated(all_args)) deallocate(all_args)
      allocate(all_args(num_args))
 
      i_arg = 1 !index of current arg
      i_tok = 1 ! index of current input token
      ! loop over all arguments and extract
      do while (i_tok <= num_args)
        ! first extract name and value parts in all cases
        ! this consumes 1, 2 or 3 tokens depending on spaces
 
        call get_command_argument(i_tok, arg, length=arg_in_length)
        i_tok = i_tok + 1
 
        if(arg_in_length > max_string_len) truncated = .true.
 
        ! location of the '=' sign
        ! if not found, return value of this is 0
        indx = index(arg, '=')
 
        !look at next chars - remove all whitespace
        tmp = adjustl(arg(indx+1:))
        tmp_len = len_trim(tmp)
        if(indx > 1 .and. tmp_len > 0) then
          ! all characters after '='
          tmp_val = tmp
          ! all characters up to '=', not including it
          ! but with any leading spaces removed
          tmp_name = adjustl(arg(1:indx-1))
        else if(indx > 1) then
          ! have an '=' but no following value
          ! consume next token
          call get_command_argument(i_tok, tmp, length=arg_in_length)
          i_tok = i_tok + 1
          if(arg_in_length > max_string_len) truncated = .true.
 
          tmp_val = adjustl(tmp)
          tmp_name = adjustl(arg(1:indx-1))
        else   ! have not yet found the equals!
          ! set name, then hunt value...
          tmp_name = adjustl(arg)
 
          !peek next token - will need either 0, 1 or 2 more
          call get_command_argument(i_tok, tmp, length=arg_in_length)
          if(arg_in_length > max_string_len) truncated = .true.
 
          indx = index(adjustl(tmp), '=')
          if(indx /= 1) then
            ! next token does not lead with '=', assume this is a flag and
            ! do not consume next. set value for clarity, and mark
            tmp_val = ""
            all_args(i_arg)%has_value = .false.
          else
            ! consume this one and possibly one more
            i_tok = i_tok + 1
            if(len_trim(adjustl(tmp)) > 1) then
              !this token has content following the '='
              tmp_val = adjustl(tmp(2:))
            else
              ! consume another
              call get_command_argument(i_tok, tmp, length=arg_in_length)
              i_tok = i_tok + 1
              if(arg_in_length > max_string_len) truncated = .true.
 
              tmp_val = adjustl(tmp)
            end if
          end if
        end if
 
        ! explicitly allocate and set the values
        allocate(character(len=len_trim(tmp_name)) :: all_args(i_arg)%name)
        all_args(i_arg)%name = trim(tmp_name)
        allocate(character(len=len_trim(tmp_val)) :: all_args(i_arg)%value)
        all_args(i_arg)%value = trim(tmp_val)
 
        i_arg = i_arg + 1
      end do
      !i_arg is now the actual parsed count
      !shrink array to get rid of excess unfilled space
      num_args = i_arg-1
      call move_alloc(all_args, all_args_tmp)
      allocate(all_args(num_args))
      all_args = all_args_tmp(1:num_args)
      deallocate(all_args_tmp)
    endif
 
    if(truncated) print'(a,i0, a)', "warning: very long argument truncated. to support arguments&
   & longer than ", max_string_len, " increase the max_string_len parameter"
 
 
  end subroutine parse_args
 
  subroutine initial_parse
 
    if(.not. initial_parse_done) then
      call parse_args
      initial_parse_done = .true.
    end if
 
  end subroutine initial_parse
 
  function arg_count()
    integer :: arg_count
 
    call initial_parse
    arg_count = num_args
  end function
 
!------------------------------------------------------------------
 
  function get_arg_num_logical(num, val, exists)
 
    logical :: get_arg_num_logical
    integer, intent(in) :: num
    logical, intent(inout) :: val
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! check requested number is in range
    if(num <= num_args .and. num > 0) then
      ! read it from string into value
      read(all_args(num)%value, *, iostat=ierr) val
      found = .true.
    end if
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_num_logical = (found .and. (ierr == 0))
 
  end function get_arg_num_logical
 
  function get_arg_name_logical(name, val, exists)
 
    logical :: get_arg_name_logical
    character(len=*), intent(in) :: name
    logical, intent(inout) :: val
    integer :: i
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    val = .false.
    ierr = 0
    ! our cmd_arg type is already initialised to the sentinel
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        if(all_args(i)%has_value) then
          read(all_args(i)%value, *, iostat=ierr) val
        else
          val = .true.
        end if
        exit
      end if
    end do
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_name_logical = (found .and. (ierr == 0))
 
  end function get_arg_name_logical
 
 
  function get_arg_num_dbl(num, val, exists)
 
    logical :: get_arg_num_dbl
    integer, intent(in) :: num
    real(kind=real64), intent(inout) :: val
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! check requested number is in range
    if(num <= num_args .and. num > 0) then
      ! read it from string into value
      read(all_args(num)%value, *, iostat=ierr) val
      found = .true.
    end if
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_num_dbl = (found .and. (ierr == 0))
 
  end function get_arg_num_dbl
 
  function get_arg_name_dbl(name, val, exists)
 
    logical :: get_arg_name_dbl
    character(len=*), intent(in) :: name
    real(kind=real64), intent(inout) :: val
    integer :: i
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! our cmd_arg type is already initialised to the sentinel
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        read(all_args(i)%value, *, iostat=ierr) val
        exit
      end if
    end do
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_name_dbl = (found .and. (ierr == 0))
 
  end function get_arg_name_dbl
 
  ! command line parsing should be avoided in performance critical code
  ! so extra overhead from double call and downcast is not a problem
 
  function get_arg_num_float(num, val, exists)
    logical :: get_arg_num_float
    integer, intent(in) :: num
    real(kind=real32), intent(inout) :: val
    real(kind=real64) :: tmp
    logical, intent(out), optional :: exists
 
    get_arg_num_float = get_arg_num_dbl(num, tmp, exists)
    if( abs(tmp) < huge(val)) then
      !value in range. convert. note: there may be precision loss
      val = real(tmp, kind=real32)
    else
      !value out of range, can't be parsed
      get_arg_num_float  = .false.
    end if
 
  end function
 
  function get_arg_name_float(name, val, exists)
    logical :: get_arg_name_float
    character(len=*), intent(in) :: name
    real(kind=real32), intent(inout) :: val
    real(kind=real64) :: tmp
    logical, intent(out), optional :: exists
 
    get_arg_name_float = get_arg_name_dbl(name, tmp, exists)
    if( abs(tmp) < huge(val)) then
      !value in range. convert. note: there may be precision loss
      val = real(tmp, kind=real32)
    else
      !value out of range, can't be parsed
      get_arg_name_float  = .false.
    end if
 
  end function
 
 
  function get_arg_num_int(num, val, exists)
 
    logical :: get_arg_num_int
    integer, intent(in) :: num
    integer(kind=int32), intent(inout) :: val
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! check requested number is in range
    if(num <= num_args .and. num > 0) then
      ! read it from string into value
      ! we don't need to specify the format in general
      read(all_args(num)%value, *, iostat=ierr) val
      found = .true.
    end if
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_num_int = (found .and. (ierr == 0))
 
  end function get_arg_num_int
 
  function get_arg_name_int(name, val, exists)
 
    logical :: get_arg_name_int
    character(len=*), intent(in) :: name
    integer(kind=int32), intent(inout) :: val
    integer :: i
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! our cmd_arg type is already initialised to the sentinel
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        read(all_args(i)%value, *, iostat=ierr) val
        exit
      end if
    end do
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_name_int = (found .and. (ierr == 0))
 
  end function get_arg_name_int
 
  function get_arg_num_long(num, val, exists)
 
    logical :: get_arg_num_long
    integer, intent(in) :: num
    integer(kind=int64), intent(inout) :: val
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
    call initial_parse
 
    found = .false.
    ! check requested number is in range
    if(num <= num_args .and. num > 0) then
      ! read it from string into value
      ! we don't need to specify the format in general
      read(all_args(num)%value, *, iostat=ierr) val
      found = .true.
    end if
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_num_long = (found .and. (ierr == 0))
 
  end function get_arg_num_long
 
  function get_arg_name_long(name, val, exists)
 
    logical :: get_arg_name_long
    character(len=*), intent(in) :: name
    integer(kind=int64), intent(inout) :: val
    integer :: i
    logical, intent(out), optional :: exists
    logical :: found
    integer :: ierr
 
   call initial_parse
 
    found = .false.
    ! our cmd_arg type is already initialised to the sentinel
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        read(all_args(i)%value, *, iostat=ierr) val
        exit
      end if
    end do
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_name_long = (found .and. (ierr == 0))
 
  end function get_arg_name_long
 
  function get_arg_num_str(num, val, exists)
 
    logical :: get_arg_num_str
    integer, intent(in) :: num
    character(len=*), intent(inout) :: val
    logical, intent(out), optional :: exists
    logical :: found
 
    call initial_parse
 
    found = .false.
    ! check requested number is in range
    if(num <= num_args .and. num > 0) then
      ! read it from string into value
      ! we don't need to specify the format in general
      val = all_args(num)%value
      found = .true.
    end if
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_num_str = found
 
  end function get_arg_num_str
 
  function get_arg_name_str(name, val, exists)
 
    logical :: get_arg_name_str
    character(len=*), intent(in) :: name
    character(len=*), intent(inout) :: val
    integer :: i
    logical, intent(out), optional :: exists
    logical :: found
 
    call initial_parse
 
    found = .false.
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        val = all_args(i)%value
        exit
      end if
    end do
 
    if(present(exists)) then
      exists = found
    end if
 
    ! return value is whether value is found and correctly parsed
    get_arg_name_str = found
 
  end function get_arg_name_str
 
!--------------------------------------------------------------------
 
  function arg_present(name, has_value) result(found)
 
   logical :: found
   character(len=*), intent(in) :: name
   logical, intent(out), optional :: has_value
   integer :: i
 
    call initial_parse
 
    found = .false.
    if(present(has_value)) has_value = .false.
    do i = 1, num_args
      if(all_args(i)%name == trim(adjustl(name))) then
        found = .true.
        if(present(has_value)) has_value = all_args(i)%has_value
        exit
      endif
    end do
 
  end function arg_present
 
  function dump_names()
    type(str_wrapper), dimension(:), allocatable :: dump_names
    integer :: i
 
    ! do this the long way again to support non implicit allocations
    allocate(dump_names(num_args))
    do i = 1, num_args
      allocate(dump_names(i)%str, source =all_args(i)%name)
    end do
 
  end function dump_names
 
  function get_arg_value(name, exists)
 
    character(len=:), allocatable :: get_arg_value
    character(len=*), intent(in) :: name
    logical, intent(out), optional :: exists
    integer :: i
    logical :: found
 
    call initial_parse
 
    found = .false.
 
    do i = 1, num_args
      if(all_args(i)%name .eq. trim(adjustl(name))) then
        allocate(get_arg_value, source=all_args(i)%value)
        found = .true.
        exit
      end if
    end do
 
    ! return empty string, not unallocated one.
    if(.not. allocated(get_arg_value)) allocate(character(len=0) :: get_arg_value)
    if(present(exists)) then
      exists = found
    end if
 
  end function get_arg_value
 
end module command_line