cla_validate_info Subroutine

public subroutine cla_validate_info(cmd_name, info)

Arguments

Type IntentOptional Attributes Name
character(len=*) :: cmd_name
logical :: info

Calls

proc~~cla_validate_info~~CallsGraph proc~cla_validate_info cla_validate_info proc~cla_command_argument_count cla_command_argument_count proc~cla_validate_info->proc~cla_command_argument_count proc~cla_get_command_argument cla_get_command_argument proc~cla_validate_info->proc~cla_get_command_argument proc~cla_help cla_help proc~cla_validate_info->proc~cla_help proc~cla_key_arg_match cla_key_arg_match proc~cla_validate_info->proc~cla_key_arg_match proc~cla_str_eq cla_str_eq proc~cla_validate_info->proc~cla_str_eq proc~cla_key_arg_match->proc~cla_str_eq

Called by

proc~~cla_validate_info~~CalledByGraph proc~cla_validate_info cla_validate_info proc~cla_validate cla_validate proc~cla_validate->proc~cla_validate_info proc~get_cla_gvec_to_jorek get_CLA_gvec_to_jorek proc~get_cla_gvec_to_jorek->proc~cla_validate program~gvec GVEC program~gvec->proc~cla_validate

Source Code

    subroutine cla_validate_info(cmd_name,info)
      implicit none
      character(len=*)      :: cmd_name
      character(len=STRLEN) :: arg
      character(len=STRLEN)  :: value, key
      integer(kind=int_kind) :: ncla, k, kk, iequal, kcla, kkv
      logical :: info

      if (info) write(stdout,*) "Validating the command line arguments:"
      ncla = cla_command_argument_count()
      if (ncla == 0) then
         if (info) write(stdout,*) "    ... none found. Returning."
         return
      end if

      ! First check for -?, -h, -H, -help, or --help flags.
      call cla_get_command_argument(1,arg)
      key = trim(arg)
      if (cla_str_eq(trim(key),'-h')      .or. &
          cla_str_eq(trim(key),'-?')      .or. &
          cla_str_eq(trim(key),'/?')      .or. &
          cla_str_eq(trim(key),'-H')      .or. &
          cla_str_eq(trim(key),'-help')   .or. &
          cla_str_eq(trim(key),'--help')  .or. &
          cla_str_eq(trim(key),'--usage')      &
          ) then
         call cla_help(cmd_name)
         stop " "
      endif

      if (info) write(stdout,*) "    cla_command_argument_count = ",ncla
      do k=1,ncla
         call cla_get_command_argument(k,arg)
         if (info) write(stdout,*) "    cla_command_argument #",k,": ",arg
      end do
      ! Positional arguments must all occur either before or after all the key/value arguments.
      kcla = 0
      do while (kcla < ncla)
         call cla_get_command_argument(kcla+1,arg)
         ! Search the arguments until we find one that begins with "-", which we know is the marker
         ! for the key,value pairs or flags.
         if (index(arg,"-") /= 1) then
            if (info .and.(kcla == 0)) write(stdout,*) "    Positional arguments appear to occur prior to key/value arguments."
            kcla = kcla + 1
            if (kcla > cla_posarg_num) then
               write(stderr,*)"     ERROR: Too many positional arguments found!"
               stop 5
            endif
         else
            exit
         end if
         if (info) write(stdout,*) "          positional arg #",kcla,"= ",trim(arg), &
              " is expected to be of type ",trim(cla_kindstr(cla_posarg_registry(kcla)%kind))
      end do
      ! Look for key value pairs:
      do while (kcla < ncla)
         call cla_get_command_argument(kcla+1,key)
         if (info) then
            if ( (index(key,"-") == 1) .and. (kcla == 0) .and. (cla_posarg_num > 0)) then
               write(stdout,*) "    Positional arguments appear to occur after to key/value arguments."
            endif
         endif
         kkv = kcla
         do kk=1,cla_num
            ! must test for exact match, not just substring
            if (cla_key_arg_match(cla_registry(kk)%key, &
                 cla_registry(kk)%longkey, &
                 key))then
               if (cla_registry(kk)%kind == cla_flag) then
                  if (info) write(stdout,*)"          key = ",trim(key)," is a flag"
                  kcla = kcla + 1
                  exit
               else
                  call cla_get_command_argument(kcla+2,value)
                  kcla = kcla + 2
                  if (info) write(stdout,*)"          key, value ?= ",trim(key)," ",trim(value), &
                       " is expected to be of type ",trim(cla_kindstr(cla_registry(kk)%kind))
               end if
            end if
         end do
         if (kcla == kkv) then
            if (index(key,"-") == 1) then
               write(stderr,*)"      ERROR: "//trim(key)//" could not be matched to any known key!"
               stop 5
            else
               ! We have reached the end of the key/value,flags and now check again for posarg.
               exit
            endif
         end if
      end do
      kkv = kcla
      do while (kcla < ncla)
         call cla_get_command_argument(kcla+1,arg)
         if (index(arg,"-") /= 1) then
            kcla = kcla + 1
            if ((kcla - kkv) > cla_posarg_num) then
               write(stderr,*)"     ERROR: Too many positional arguments found!"
               stop 5
            endif
         else
            write(stderr,*) "    ERROR: Positional arguments appear to be mixed in with -key value arguments."
            write(stderr,*) "    Move position arguments to the end of the list."
            stop 5
         end if
         if (info) write(stdout,*)"    positional arg ?= ",arg
      end do
      if (info) write(stdout,*)"    No errors found in syntax validation, but type/kind-validity not checked!"
      if (info) write(stdout,*)"    If a -key value pair is repeated, the last one is used."
    end subroutine cla_validate_info