module options
  !
  ! Source code copied from:
  ! http://fortranwiki.org/fortran/show/Command-line+arguments
  !
  implicit none

  type option
     !> Long name.
     character(len=100) :: name
     !> Does the option require an argument?
     logical :: has_arg
     !> Corresponding short name.
     character :: chr
     !> Description.
     character(len=500) :: descr
     !> Argument name, if required.
     character(len=20) :: argname
   contains
     procedure :: print => print_opt
  end type option

contains

  !> Parse command line options. Options and their arguments must come before
  !> all non-option arguments. Short options have the form "-X", long options
  !> have the form "--XXXX..." where "X" is any character. Parsing can be
  !> stopped with the option '--'.
  !> The following code snippet illustrates the intended use:
  !> \code
  !> do
  !>   call getopt (..., optchar=c, ...)
  !>   if (stat /= 0) then
  !>     ! optional error handling
  !>     exit
  !>   end if
  !>   select case (c)
  !>     ! process options
  !>   end select
  !> end do
  !> \endcode
  subroutine getopt (options, longopts, optchar, optarg, arglen, stat, &
       offset, remain, err)
    use iso_fortran_env, only: error_unit

    !> String containing the characters that are valid short options. If
    !> present, command line arguments are scanned for those options.
    !> If a character is followed by a colon (:) its corresponding option
    !> requires an argument. E.g. "vn:" defines two options -v and -n with -n
    !> requiring an argument.
    character(len=*), intent(in), optional :: options

    !> Array of long options. If present, options of the form '--XXXX...' are
    !> recognised. Each option has an associated option character. This can be
    !> any character of default kind, it is just an identifier. It can, but
    !> doesn't have to, match any character in the options argument. In fact it
    !> is possible to only pass long options and no short options at all.
    !> Only name, has_arg and chr need to be set.
    type(option), intent(in), optional :: longopts(:)

    !> If stat is not 1, optchar contains the option character that was parsed.
    !> Otherwise its value is undefined.
    character, intent(out), optional :: optchar

    !> If stat is 0 and the parsed option requires an argument, optarg contains
    !> the first len(optarg) (but at most 500) characters of that argument.
    !> Otherwise its value is undefined. If the arguments length exceeds 500
    !> characters and err is .true., a warning is issued.
    character(len=*), intent(out), optional :: optarg

    !> If stat is 0 and the parsed option requires an argument, arglen contains
    !> the actual length of that argument. Otherwise its value is undefined.
    !> This can be used to make sure the argument was not truncated by the
    !> limited length of optarg.
    integer, intent(out), optional :: arglen

    !> Status indicator. Can have the following values:
    !>   -  0: An option was successfully parsed.
    !>   -  1: Parsing stopped successfully because a non-option or '--' was
    !>         encountered.
    !>   - -1: An unrecognised option was encountered.
    !>   - -2: A required argument was missing.
    !>   .
    !> Its value is never undefined.
    integer, intent(out), optional :: stat

    !> If stat is 1, offset contains the number of the argument before the
    !> first non-option argument, i.e. offset+n is the nth non-option argument.
    !> If stat is not 1, offset contains the number of the argument that would
    !> be parsed in the next call to getopt. This number can be greater than
    !> the actual number of arguments.
    integer, intent(out), optional :: offset

    !> If stat is 1, remain contains the number of remaining non-option
    !> arguments, i.e. the non-option arguments are in the range 
    !> (offset+1:offset+remain). If stat is not 1, remain is undefined.
    integer, intent(out), optional :: remain

    !> If err is present and .true., getopt prints messages to the standard
    !> error unit if an error is encountered (i.e. whenever stat would be set
    !> to a negative value).
    logical, intent(in), optional :: err

    integer, save :: pos = 1, cnt = 0
    character(len=500), save :: arg

    integer :: chrpos, length, st, id = 0
    character :: chr
    logical :: long

    if (cnt == 0) cnt = command_argument_count()
    long = .false.

    ! no more arguments left
    if (pos > cnt) then
       pos = pos - 1
       st = 1
       goto 10
    end if

    call get_command_argument (pos, arg, length)

    ! is argument an option?
    if (arg(1:1) == '-') then

       chr = arg(2:2)

       ! too long ('-xxxx...') for one dash?
       if (chr /= '-' .and. len_trim(arg) > 2) then
          st = -1
          goto 10
       end if

       ! forced stop ('--')
       if (chr == '-' .and. arg(3:3) == ' ') then
          st = 1
          goto 10
       end if

       ! long option ('--xxx...')
       if (chr == '-') then

          long = .true.

          ! check if valid
          id = lookup(arg(3:))

          ! option is invalid, stop
          if (id == 0) then
             st = -1
             goto 10
          end if

          chr = longopts(id)%chr

          ! check if option requires an argument
          if (.not. longopts(id)%has_arg) then
             st = 0
             goto 10
          end if

          ! check if there are still arguments left
          if (pos == cnt) then
             st = -2
             goto 10
          end if

          ! go to next position
          pos = pos + 1

          ! get argument
          call get_command_argument (pos, arg, length)

          ! make sure it is not an option
          if (arg(1:1) == '-') then
             st = -2
             pos = pos - 1
             goto 10
          end if

       end if

       ! short option
       ! check if valid
       if (present(options)) then
          chrpos = scan(options, chr)
       else
          chrpos = 0
       end if

       ! option is invalid, stop
       if (chrpos == 0) then
          st = -1
          goto 10
       end if

       ! look for argument requirement
       if (chrpos < len_trim(options)) then
          if (options(chrpos+1:chrpos+1) == ':') then

             ! check if there are still arguments left
             if (pos == cnt) then
                st = -2
                goto 10
             end if

             ! go to next position
             pos = pos + 1

             ! get argument
             call get_command_argument (pos, arg, length)

             ! make sure it is not an option
             if (arg(1:1) == '-') then
                st = -2
                pos = pos - 1
                goto 10
             end if

          end if
       end if

       ! if we get to this point, no error happened
       ! return option and the argument (if there is one)
       st = 0
       goto 10
    end if

    ! not an option, parsing stops
    st = 1
    ! we are already at the first non-option argument
    ! go one step back to the last option or option argument
    pos = pos - 1


    ! error handling and setting of return values
10  continue

    if (present(err)) then
       if (err) then

          select case (st)
          case (-1)
             write (error_unit, *) "error: unrecognised option: " // trim(arg) 
          case (-2)
             if (.not. long) then
                write (error_unit, *) "error: option -" // chr &
                     // " requires an argument"
             else
                write (error_unit, *) "error: option --" &
                     // trim(longopts(id)%name) // " requires an argument"
             end if
          end select

       end if
    end if

    if (present(optchar)) optchar = chr
    if (present(optarg))  optarg  = arg
    if (present(arglen))  arglen  = length
    if (present(stat))    stat    = st
    if (present(offset))  offset  = pos
    if (present(remain))  remain  = cnt-pos

    ! setup pos for next call to getopt
    pos = pos + 1

  contains

    integer function lookup (name)
      character(len=*), intent(in) :: name
      integer :: i

      ! if there are no long options, skip the loop
      if (.not. present(longopts)) goto 10

      do i = 1, size(longopts)
         if (name == longopts(i)%name) then
            lookup = i
            return
         end if
      end do
      ! if we get to this point, the option was not found

10    lookup = 0
    end function lookup

  end subroutine getopt

  !============================================================================

  !> Print an option in the style of a man page. I.e.
  !> \code
  !> -o arg
  !> --option arg
  !>    description.................................................................
  !>    ............................................................................
  !> \endcode
  subroutine print_opt (opt, unit)
    !> the option
    class(option), intent(in) :: opt
    !> logical unit number
    integer, intent(in) :: unit

    integer :: l, c1, c2

    if (opt%has_arg) then
       write (unit, '(1x,"-",a,1x,a)') opt%chr, trim(opt%argname)
       write (unit, '(1x,"--",a,1x,a)') trim(opt%name), trim(opt%argname)
    else
       write (unit, '(1x,"-",a)') opt%chr
       write (unit, '(1x,"--",a)') trim(opt%name)
    end if
    l = len_trim(opt%descr)

    ! c1 is the first character of the line
    ! c2 is one past the last character of the line
    c1 = 1
    do
       if (c1 > l) exit
       ! print at maximum 4+76 = 80 characters
       c2 = min(c1 + 76, 500)
       ! if not at the end of the whole string
       if (c2 /= 500) then
          ! find the end of a word
          do
             if (opt%descr(c2:c2) == ' ') exit
             c2 = c2-1
          end do
       end if
       write (unit, '(4x,a)') opt%descr(c1:c2-1)
       c1 = c2+1
    end do

  end subroutine print_opt

end module options