cla_get_char Subroutine

public subroutine cla_get_char(key, value)

Arguments

Type IntentOptional Attributes Name
character(len=*) :: key
character(len=STRLEN) :: value

Calls

proc~~cla_get_char~~CallsGraph proc~cla_get_char cla_get_char proc~cla_command_argument_count cla_command_argument_count proc~cla_get_char->proc~cla_command_argument_count proc~cla_get_command_argument cla_get_command_argument proc~cla_get_char->proc~cla_get_command_argument proc~cla_key_arg_match cla_key_arg_match proc~cla_get_char->proc~cla_key_arg_match proc~cla_show cla_show proc~cla_get_char->proc~cla_show proc~cla_str_eq cla_str_eq proc~cla_get_char->proc~cla_str_eq proc~cla_key_arg_match->proc~cla_str_eq proc~cla_show->proc~cla_get_char proc~cla_key_present cla_key_present proc~cla_show->proc~cla_key_present proc~cla_message cla_message proc~cla_show->proc~cla_message proc~cla_key_present->proc~cla_command_argument_count proc~cla_key_present->proc~cla_get_command_argument proc~cla_key_present->proc~cla_key_arg_match proc~cla_key_present->proc~cla_show proc~cla_fatal cla_fatal proc~cla_key_present->proc~cla_fatal

Called by

proc~~cla_get_char~~CalledByGraph proc~cla_get_char cla_get_char proc~cla_show cla_show proc~cla_get_char->proc~cla_show interface~cla_get cla_get interface~cla_get->proc~cla_get_char proc~cla_get_float_r4 cla_get_float_r4 interface~cla_get->proc~cla_get_float_r4 proc~cla_get_float_r8 cla_get_float_r8 interface~cla_get->proc~cla_get_float_r8 proc~cla_get_int_i4 cla_get_int_i4 interface~cla_get->proc~cla_get_int_i4 proc~cla_get_int_i8 cla_get_int_i8 interface~cla_get->proc~cla_get_int_i8 proc~cla_get_logical cla_get_logical interface~cla_get->proc~cla_get_logical proc~cla_get_flag cla_get_flag proc~cla_get_flag->proc~cla_get_char proc~cla_get_float_r4->proc~cla_get_char proc~cla_get_float_r8->proc~cla_get_char proc~cla_get_int_i4->proc~cla_get_char proc~cla_get_int_i8->proc~cla_get_char proc~cla_get_logical->proc~cla_get_char proc~cla_show->proc~cla_get_char proc~cla_key_present cla_key_present proc~cla_show->proc~cla_key_present proc~cla_key_present->proc~cla_show proc~get_cla_gvec_to_jorek get_CLA_gvec_to_jorek proc~get_cla_gvec_to_jorek->interface~cla_get proc~get_cla_gvec_to_jorek->proc~cla_key_present program~gvec GVEC program~gvec->interface~cla_get

Source Code

    subroutine cla_get_char(key,value)
      implicit none
      character(len=STRLEN)  :: arg
      character(len=*)       :: key
      character(len=2)       :: shortkey
      character(len=STRLEN)  :: longkey
      character(len=STRLEN)  :: value, pvalue
      character(len=STRLEN)  :: kkey
      integer(kind=int_kind) :: ncla, k, kkind, iequal
      integer :: kk, kmatch, ordinal
      logical :: just_matched, prev_matched, is_match, carryover
!      integer :: cla_command_argument_count
!      external cla_command_argument_count

      !     Loop over the command line arguments to assign to
      !     value.
      !     Note that no error is reported if the key was NOT
      !     registered, but it is present on the command line.
      if (index(key,"-") /= 1)then
         ! assume positional argument, confirm by matching name
         ordinal = -1
         do k=1,cla_posarg_num
            ! must test for exact match, not just substring
            if (cla_str_eq(trim(cla_posarg_registry(k)%key),trim(key))) then
               pvalue = trim(cla_posarg_registry(k)%default)
               ordinal = k
            end if
         end do

         ! It seems that value is not yet defined here:
         !         if (index(trim(value),trim(cla_empty)) /= 0) then
         if (ordinal == -1) then
            write(stderr,*) 'Error: You tried to retrieve an unknown command line argument: ',trim(key)
            call cla_show
            stop 5
         endif

         if (ordinal > 0) then
            ncla = cla_command_argument_count()
            if (ncla == 0) then
               value=pvalue
               return
            end if
            kmatch = 0
            prev_matched = .False.

            do k=1,ncla
               call cla_get_command_argument(k,arg)
               ! test for exact match among key args
               just_matched = .False.
               do kk = 1, cla_num
                  kkey = cla_registry(kk)%key
                  kkind = cla_registry(kk)%kind
                  is_match = cla_key_arg_match(kkey,cla_registry(kk)%longkey,arg)
                  carryover = kkind/=cla_flag
                  iequal = index(arg,"=")
                  if (is_match .and. iequal > 1)then
                     carryover = .False.
                  end if
                  just_matched = just_matched .or. is_match
                  if (just_matched) exit  ! preserve kkey and kkind
               end do
               if (just_matched .or. prev_matched )then
                  ! current arg part of keyword arg constructal
                  ! so this is not positional
                  prev_matched = just_matched .and. carryover
                  carryover = .False.
                  cycle
               end if
               kmatch = kmatch + 1
               ! increment # of positionals
               if(kmatch == ordinal) then
                  pvalue = trim(arg)
                  value=pvalue
                  return
               end if

            end do
         end if
         value = pvalue
         return
      end if

      ! keyword
      do k=1,cla_num
         ! must test for exact match, not just substring
         if (cla_key_arg_match(cla_registry(k)%key, &
              cla_registry(k)%longkey, &
              key)) then
            shortkey = cla_registry(k)%key
            longkey = cla_registry(k)%longkey

            value = trim(cla_registry(k)%default)
            kkind = cla_registry(k)%kind
         end if
      end do

      if (index(trim(value),trim(cla_empty)) /= 0) then
         write(stderr,*) 'Error: You tried to retrieve an unknown command line argument: ',trim(key)
         call cla_show
         stop 5
      endif

      ncla = cla_command_argument_count()
      if (ncla == 0) return

      do k=1,ncla
         call cla_get_command_argument(k,arg)
         ! test for exact match
         if (cla_key_arg_match(shortkey,longkey,trim(arg))) then
            if (kkind == cla_flag) then
               value = 't'
               return
            else
               iequal = index(arg,"=")
               if (iequal < 1)then
                  call cla_get_command_argument(k+1,arg)
                  value = trim(arg)
                  return
               else
                  value=arg(iequal+1:len_trim(arg))
                  return
               end if
            endif
         end if
      enddo

    end subroutine cla_get_char