cli_obj_Get Subroutine

private impure subroutine cli_obj_Get(switch, val, found, default)

Gets command line options, by looping over command line arguments and finding pairs of the type "-switch value"

Type Bound

cli_obj

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: switch

Cli switch

class(*), intent(out) :: val

Value of the switch

logical, intent(out), optional :: found

true if switch found

class(*), intent(in), optional :: default

Default value


Called by

proc~~cli_obj_get~~CalledByGraph proc~cli_obj_get cli_obj%cli_obj_Get proc~parser_obj_parsefile parser_obj%parser_obj_ParseFile proc~parser_obj_parsefile->proc~cli_obj_get program~main main program~main->proc~parser_obj_parsefile

Source Code

    impure subroutine cli_obj_Get(switch,val,found,default)
      !> Gets command line options, by looping over
      ! command line arguments and finding pairs of the
      ! type "-switch value"
      implicit none
      character(len=*), intent(in)  :: switch                                  !! Cli switch
      class(*),         intent(out) :: val                                     !! Value of the switch
      logical,          intent(out), &
                           optional :: found                                   !! true if switch found
      class(*),         intent(in),  &
                           optional :: default                                 !! Default value
      ! Work variables
      character(len=str64):: carg
      integer :: narg
      integer :: n,ios

      ! Read program inputs
      narg=command_argument_count()
      if (narg.eq.0.and. .not.present(default)) &
        error stop "CLI: no command line switches found."

      if(present(found)) found=.false.

      n=0
      ! Read inputs
      do while (n<narg)
        n=n+1
        call get_command_argument(n,carg)

        if (trim(adjustl(carg)).eq.'-'//switch)  then
          n=n+1
          call get_command_argument(n,carg,status=ios)
          if (ios.ne.0) error stop "CLI: switch requires a valid value"

          select type (val)
          type is (real(kind=8)   )
            read(carg,*) val
          type is (real(kind=4)   )
            read(carg,*) val
          type is (integer(kind=8))
            read(carg,*) val
          type is (integer(kind=4))
            read(carg,*) val
          type is (logical)
            read(carg,*) val
          type is (character(len=*))
            val=trim(adjustl(carg))
          end select
          if(present(found)) found=.true.
          ! leave
          return
        end if
      end do

      ! Finished looping and didn't find flag
      if (present(default)) then
        select type (val)
        type is (real(kind=8))
          select type(default)
          type is (real(kind=8))
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        type is (real(kind=4))
          select type(default)
          type is (real(kind=4))
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        type is (integer(kind=8))
          select type(default)
          type is (integer(kind=8))
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        type is (integer(kind=4))
          select type(default)
          type is (integer(kind=4))
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        type is (logical)
          select type(default)
          type is (logical)
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        type is (character(len=*))
          select type(default)
          type is (character(len=*))
            val=default
          class default
            error stop "CLI: input and default value have different types"
          end select
        end select
      end if

      return
    end subroutine cli_obj_get