Fortran Wiki
A discussion on a standard command argument parser leveraging NAMELIST

proposal for a standard command argument parsing routine

Most operating systems that support command line arguments use a convention such as IEEE Std 1003.1-2001 and C getopts(3c) provide for Unix and GNU/Unix systems. Although often available from C and so potentially available by building an interface from Fortran to C using the ISO_C_BINDING interface, you are still then required to convert the string values associated with the keywords to their appropriate types.

Fortran NAMELIST groups already provide a way to define a group of variables and associated values, but NAMELIST groups cannot be associated via USE association in standard-conforming code.

If there were an extension made to allow a special NAMELIST group to be accessed at least by a special routine (let us call it GET_ARGS(3f)) then it should be as simple as the following illustrates to get command line arguments:

program illustration
use M_arguments,  only : unnamed
implicit none
integer :: i

! declare and initialize a namelist
! letter_ denotes an uppercase short command keyword
! all values should be allocated before calling get_args(3f)
real              :: x=111.1, y=222.2, z=333.3
real              :: point(3)=[10.0,20.0,30.0]
character(len=80) :: title=" "
logical           :: help=.false., version=.false.
logical           :: l=.false., l_=.false., v=.false., h=.false.
! you can equivalence short and long options
equivalence       (help,h),(version,v)
! just add a variable here and it is a new parameter !!
namelist /args/ x,y,z,point,title,help,h,version,v,l,l_
   !
   call get_args()  ! crack command line options
   ! do stuff with your variables
end program illustration

category: code

Perhaps this could be done assuming the NAMELIST is always called ‘ARGS’ or there would be a new command called ARGLIST instead of NAMELIST that was otherwise identical.

I would envision that you could pass in a procedure name as an argument that would support common standards like getopts(3c), IEEE Std 1003.1-2001, or DOS or OpenVMS syntax that would be provided by default.

Vendors and users could add additional syntax styles by providing a function that parsed the command line and returned a string in NAMELIST input format.

This would help standardize the use of Fortran programs called from command lines and prevent a standard solution for this very common problem, but leverage NAMELIST in a unique way to eliminate the step of converting all your argument values to the correct type.

Please add discussion points here …

Illustrative Example

For illustrative purposes a module is attached that comes close to the desired behavior but requires a contained routine to be added (but not changed) to the main program.

To keep the example self-contained but minimize the effort to provide it I had to include parts of several other rather large modules for manipulating simple lists and strings. That ended up making the example a bit long.

The example has only been tested with gfortran 7.0.4. Feel free to make changes to accomodate other programming environments or to otherwise improve the example.

module M_arguments
use iso_fortran_env, only : stderr=>ERROR_UNIT,stdin=>OUTPUT_UNIT    ! access computing environment
implicit none
private
!===================================================================================================================================
public  :: get_namelist
public  :: print_dictionary
public unnamed
!===================================================================================================================================
private :: get_command_arguments_as_raw_namelist
private :: longest_command_argument
private :: namelist_to_dictionary
private :: update
private :: get
private :: wipe_dictionary
!===================================================================================================================================
private isupper         !  elemental function returns .true. if CHR is an uppercase letter (A-Z)
private upper           !  elemental function converts string to uppercase
private lower           !  elemental function converts string to miniscule
private quote           !  add quotes to string as if written with list-directed input
!===================================================================================================================================
character(len=:),allocatable   :: keywords(:)
character(len=:),allocatable   :: values(:)
integer,allocatable            :: counts(:)
logical,allocatable            :: present_in(:)

logical                        :: keyword_single=.true.
character(len=:),allocatable   :: namelist_name

character(len=:),allocatable   :: unnamed(:)
logical                        :: return_all

private locate        ! [M_list] find PLACE in sorted character array where value can be found or should be placed
   private locate_c
private insert        ! [M_list] insert entry into a sorted allocatable array at specified position
   private insert_c
   private insert_i
   private insert_l
private replace       ! [M_list] replace entry by index from a sorted allocatable array if it is present
   private replace_c
   private replace_i
   private replace_l
private remove        ! [M_list] delete entry by index from a sorted allocatable array if it is present
   private remove_c
   private remove_i
   private remove_l

interface locate
   module procedure locate_c
end interface

interface insert
   module procedure insert_c, insert_i, insert_l
end interface

interface replace
   module procedure replace_c, replace_i, replace_l
end interface

interface remove
   module procedure remove_c, remove_i, remove_l
end interface
contains
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    get_namelist(3f) - [ARGUMENTS:M_arguments] NAMELIST-based command line argument parsing
!!
!!##SYNOPSIS
!!
!!   function get_namelist(definition,all) result(string)
!!
!!    character(len=*),intent(in),optional  :: definition
!!    logical,intent(in),optional  :: all
!!    character(len=:),allocatable :: string
!!##DESCRIPTION
!!
!!    parse command line options
!!
!!    This routine leverages NAMELIST groups to do the conversion from strings
!!    to numeric values required by other command line parsers.
!!
!!    There is no need to convert from strings to numeric
!!    values in the source code. Even arrays and user-defined types can be
!!    used, complex values can be input ... just define the variable and
!!    add it to the NAMELIST definition.
!!
!!    To use the routine 
!!
!!    o define a NAMELIST group called ARGS. Initialize all the values.
!!    o write the NAMELIST group to a character variable so the parser has
!!      information on which keywords are LOGICAL, CHARACTER, or numeric.
!!    o call the routine that returns the command line as a string in namelist format
!!       o namelist()
!!           direct NAMELIST syntax in KEYWORD=VALUE pairs
!!       o namelist_values()
!!           -KEYWORD VALUE syntax
!!       o getopts()
!!    o read that string as a namelist
!!
!!    Note that since all the arguments are defined in a NAMELIST group
!!    that config files can easily be used for the same options.
!!    Just create a NAMELIST input file and read it.
!!
!!    NAMELIST syntax can vary between different programming environments.
!!    Currently, this routine has only been tested using gfortran 7.0.4;
!!    and requires at least Fortran 2003.
!!
!!    PASS IN A NAMELIST STRING
!!
!!    If you want to pass in options using syntax similar to that provided
!!    by the C getopts(3c) procedure pass in a NAMELIST string. Typically,
!!    you would generate the input string by writing the NAMELIST group to
!!    an internal file.
!!
!!    The following program can be called using commands like
!!
!!      cmd -A 'string Value' -l -V --help -p 3.4,5.6 -- *
!!
!!    Typical program skeleton:
!!
!!     program short
!!     use M_arguments,  only : unnamed
!!     implicit none
!!     integer :: i
!!
!!     ! declare and initialize a namelist
!!     ! letter_ denotes an uppercase short command keyword
!!     ! all values should be allocated before calling get_args(3f)
!!     real              :: x=111.1, y=222.2, z=333.3
!!     real              :: point(3)=[10.0,20.0,30.0]
!!     character(len=80) :: title=" "
!!     logical           :: help=.false., version=.false.
!!     logical           :: l=.false., l_=.false., v=.false., h=.false.
!!     ! you can equivalence short and long options
!!     equivalence       (help,h),(version,v)
!!     ! just add a variable here and it is a new parameter !!
!!     namelist /args/ x,y,z,point,title,help,h,version,v,l,l_
!!     !
!!        call get_args()  ! crack command line options and apply to namelist
!!        ! do stuff with your variables
!!        write(*,*)'VALUES ARE NOW'
!!        write(*,nml=args)
!!        if(size(unnamed).gt.0)then
!!           write(*,'(a)')'UNNAMED:'
!!           write(*,'(i6.6,3a)')(i,'[',unnamed(i),']',i=1,size(unnamed))
!!        endif
!!     contains
!!     subroutine get_args()
!!     ! The NAMELIST cannot be passed as an option to a routine so this
!!     ! routine must be in a contained routine or directly in the body of
!!     ! the routine that declares the NAMELIST. get_args(3f) should not
!!     ! need changed except for possibly the length of HOLD_NAMELIST
!!     use M_arguments,    only : get_namelist, print_dictionary
!!     !
!!     integer :: ios, i
!!     character(len=255) :: message ! use for I/O error messages
!!     character(len=:),allocatable :: readme  ! stores updated namelist
!!     ! make big enough for all of namelist
!!     character(len=10000) :: hold_namelist
!!     ! the routine needs a copy of the options to determine what values
!!     ! are character and logical versus numeric
!!        write(hold_namelist,nml=args,iostat=ios,iomsg=message)
!!        if(ios.eq.0)then
!!           ! pass in the namelist and get an updated copy that includes
!!           ! values specified on the command line
!!           readme=get_namelist(hold_namelist)
!!           ! read the updated namelist to update the values
!!           ! in the namelist group
!!           read(readme,nml=args,iostat=ios,iomsg=message)
!!        endif
!!        if(ios.ne.0)then
!!           write(*,'("ERROR:",i0,1x,a)')ios, trim(message)
!!           call print_dictionary()
!!           stop 1
!!        endif
!!        ! all done cracking the command line
!!     end subroutine get_args
!!     end program short
!!
!!    Instead of writing the NAMELIST group into a string you can compose
!!    the string yourself. only defined names will be able to be specified
!!    on the command line. 
!!
!!     call get_namelist('&ARGS A_="A value",B_=" ",C_=11 22 33, help=F/')
!!
!!##OPTIONS
!!
!!    DESCRIPTION   null or composed of all command arguments concatenated
!!                  into a string prepared for reading as a NAMELIST group
!!                  or a Unix-line command prototype string.
!!
!!                  o all values except logicals get a value.
!!                  o long names (--keyword) should be all lowercase
!!                  o short names (-letter) that are uppercase map to a
!!                    NAMELIST variable called "letter_", but lowercase
!!                    short names map to NAMELIST name "letter".
!!                  o strings MUST be delimited with double-quotes and
!!                    must be at least one space and internal
!!                    double-quotes are represented with two double-quotes
!!                  o lists of numbers should be comma-delimited.
!!                     No spaces are allowed in lists of numbers.
!!                  o the values follow the rules for NAMELIST values, so
!!                    "-p 2*0" for example would define two values.
!!
!!    NOTE: IF NO DESCRIPTION IS GIVEN
!!
!!    If the routine is called with no definition string arguments are passed
!!    in on the command line using NAMELIST syntax (ie. KEYWORD=VALUE). This
!!    is particularly suited for passing a few numeric values.
!!    You can call the example program with syntax like:
!!
!!       cmd  r=200e3 i=200
!!       cmd  K=33333,J=22222,I=11111
!!       cmd  point = 1, 2, 3 s= -3.0e4 t = 405.5
!!
!!    If you do pass in strings nested quotes or escaped double-quote
!!    characters are typically required. How to do that can vary with what
!!    shell and OS you are running in. 
!!
!!    ALL           By default the output NAMELIST string only contains
!!                  keywords and values for names that were specified on
!!                  the command line. If ALL is .TRUE. a full NAMELIST
!!                  string is returned containing all the variables from
!!                  the input string.
!!##RETURNS
!!
!!    STRING   The output is a NAMELIST string than can be read to update
!!             the NAMELIST "ARGS" with the keywords that were supplied on
!!             the command line.
!!
!!    When using one of the Unix-like command line forms note that
!!    (subject to change) the following variations from other common
!!    commnd-line parsers:
!!
!!       o duplicate keywords are replaced by the rightmost entry
!!
!!       o numeric keywords are not allowed; but this allows
!!         negative numbers to be used as values.
!!
!!       o specifying both names of an equivalenced keyword will have
!!         undefined results (currrently, their alphabetical order
!!         will define what the Fortran variable values become).
!!
!!       o there is currently no mapping of short names to long
!!         names except via an EQUIVALENCE.
!!
!!       o short keywords cannot be combined. -a -b -c is required,
!!         not -abc even for Boolean keys.
!!
!!       o shuffling is not supported. Values must follow their
!!         keywords.
!!
!!       o if a parameter value of just "-" is supplied it is
!!         converted to the string "stdin".
!!
!!       o if the keyword "--" is encountered the rest of the
!!         command arguments go into the character array "UNUSED".
!!
!!       o values not matching a keyword go into the character
!!         array "UNUSED".
!!
!!       o long names do not take the --KEY=VALUE form, just
!!         --KEY VALUE; and long names should be all lowercase and
!!         always more than one character.
!!
!!       o short-name parameters of the form -LETTER VALUE
!!         map to a NAMELIST name of LETTER_ if uppercase
!===================================================================================================================================
function get_namelist(definition,all) result (readme)

!character(len=*),parameter::ident_2=&
!&"@(#)M_arguments::get_namelist(3f): return all command arguments as a NAMELIST(3f) string to read"

character(len=*),intent(in),optional :: definition
logical,intent(in),optional          :: all
character(len=:),allocatable         :: hold               ! stores command line argument
character(len=:),allocatable         :: readme             ! stores command line argument
integer                              :: ibig

   if(allocated(unnamed))then
       deallocate(unnamed)
   endif
   ibig=longest_command_argument() ! bug in gfortran. len=0 should be fine
   allocate(character(len=ibig) :: unnamed(0))
   if(present(all))then
      return_all=all
   else
      return_all=.false.
   endif
   if(present(definition))then
      call wipe_dictionary()
      hold=adjustl(definition)
      call namelist_to_dictionary(hold)
      present_in=.false.
      if(allocated(unnamed))deallocate(unnamed)
      ibig=longest_command_argument() ! bug in gfortran. len=0 should be fine
      allocate(character(len=ibig) ::unnamed(0))
      
      call cmd_args_to_dictionary(check=.true.)
         
      call dictionary_to_namelist(readme)
   else                                                    ! assume should read command line as a raw string in NAMELIST format
      readme=get_command_arguments_as_raw_namelist()
   endif

   if(.not.allocated(unnamed))then
       allocate(character(len=0) :: unnamed(0))
   endif

end function get_namelist
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    get_command_arguments_as_raw_namelist(3f) - [ARGUMENTS:M_arguments] NAMELIST-based command line argument parsing
!!
!!##SYNOPSIS
!!
!!   subroutine get_command_arguments_as_raw_namelist(string)
!!
!!    character(len=:),allocatable,intent(out) :: string
!!##DESCRIPTION
!!
!!    NAMELIST can be used to pass keyword-value pairs via the command
!!    line. the following example program simply needs an initialized
!!    variable added to the NAMELIST and it automatically is available as
!!    a command line argument. Hard to imagine it getting much simpler.
!!
!!    You can call the example program with syntax like:
!!
!!       testit r=200e3 i=200
!!       testit K=33333,J=22222,I=11111
!!
!!    Note that if you pass in strings you probably will have to use nested
!!    quotes or escape your quote characters. How you do that can vary with
!!    what shell and OS you are running in.
!!
!!       # just quote the entire argument list with single quotes ...
!!       testit 'c="my character string" S=10,T=20.30,R=3e-2'
!!
!!       or nest the quotes ...
!!       testit c='"string"' S=20.30
!!
!!       or escape the quotes ...
!!       testit c=\"string\"
!!
!!    As you will see, there is no need to convert from strings to numeric
!!    values in the source code. Even arrays and user-defined types can be
!!    used, complex values can be input ... just define the variable and
!!    add it to the NAMELIST definition.
!!
!!    And if you want to use a config file instead of command line arguments
!!    since your arguments are defined in a NAMELIST group just create a
!!    NAMELIST input file and read it.
!!
!!##RETURNS
!!    STRING  composed of all command arguments concatenated into a string
!!            prepared for reading as a NAMELIST.
!!
!===================================================================================================================================
function get_command_arguments_as_raw_namelist() result (string)

!character(len=*),parameter::ident_3="&
!&@(#)M_arguments::get_command_arguments_as_raw_namelist(3f): return all command arguments as a NAMELIST(3f) string"

character(len=:),allocatable :: string                     ! stores command line argument
character(len=:),allocatable :: string_bug                 ! bug in gfortran 7.4.0 where string in LHS and RHS causes problems
integer :: command_line_length
   call get_command(length=command_line_length)            ! get length needed to hold command
   allocate(character(len=command_line_length) :: string)
   call get_command(string)
   ! trim off command name and get command line arguments
   string_bug=adjustl(string)//' '                         ! assuming command verb does not have spaces in it
   string=string_bug(index(string_bug,' '):)
   string="&ARGS "//string//" /"                            ! add namelist prefix and terminator
   end function get_command_arguments_as_raw_namelist
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    update(3f) - [ARGUMENTS:M_arguments] update internal dictionary given keyword and value
!!##SYNOPSIS
!!
!!   subroutine update(key,val)
!!
!!    character(len=*),intent(in)           :: key
!!    character(len=*),intent(in),optional  :: val
!!##DESCRIPTION
!!    Update internal dictionary in M_arguments(3fm) module.
!!##OPTIONS
!!    key  name of keyword to add, replace, or delete from dictionary
!!    val  if present add or replace value associated with keyword. If not
!!         present remove keyword entry from dictionary.
!!##RETURNS
!!##EXAMPLE
!!
!===================================================================================================================================
subroutine update(key,val)
character(len=*),intent(in)           :: key
character(len=*),intent(in),optional  :: val
integer                               :: place
integer                               :: ilen
character(len=:),allocatable          :: val_local
   if(present(val))then
      val_local=val
      ilen=len_trim(val_local)
      call locate(keywords,key,place)                   ! find where string is or should be
      if(place.lt.1)then                                ! if string was not found insert it
         call insert(keywords,key,iabs(place))
         call insert(values,val_local,iabs(place))
         call insert(counts,ilen,iabs(place))
         call insert(present_in,.true.,iabs(place))
      else
         call replace(values,val_local,place)
         call replace(counts,ilen,place)
         call replace(present_in,.true.,place)
      endif
   else                                                 ! if no value is present remove the keyword and related values
      call locate(keywords,key,place)
      if(place.gt.0)then
         call remove(keywords,place)
         call remove(values,place)
         call remove(counts,place)
         call remove(present_in,place)
      endif
   endif
end subroutine update
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    wipe_dictionary(3fp) - [ARGUMENTS:M_arguments] reset private M_arguments(3fm) dictionary to empty
!!##SYNOPSIS
!!
!!    subroutine wipe_dictionary()
!!##DESCRIPTION
!!    reset private M_arguments(3fm) dictionary to empty
!!##EXAMPLE
!!
!!    program demo_wipe_dictionary
!!    use M_arguments, only : dictionary
!!       call wipe_dictionary()
!!    end program demo_wipe_dictionary
!===================================================================================================================================
subroutine wipe_dictionary()
   if(allocated(keywords))deallocate(keywords)
   allocate(character(len=0) :: keywords(0))
   if(allocated(values))deallocate(values)
   allocate(character(len=0) :: values(0))
   if(allocated(counts))deallocate(counts)
   allocate(counts(0))
   if(allocated(present_in))deallocate(present_in)
   allocate(present_in(0))
end subroutine wipe_dictionary
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##SYNOPSIS
!!
!!    get(3f) - [ARGUMENTS:M_arguments] get dictionary value associated with key name in private M_arguments(3fm) dictionary
!!##DESCRIPTION
!!    Get dictionary value associated with key name in private M_arguments(3fm) dictionary.
!!##OPTIONS
!!##RETURNS
!!##EXAMPLE
!!
!===================================================================================================================================
function get(key) result(valout)
character(len=*),intent(in)   :: key
character(len=:),allocatable  :: valout
integer                       :: place
   ! find where string is or should be
   call locate(keywords,key,place)
   if(place.lt.1)then
      valout=''
   else
      valout=values(place)(:counts(place))
   endif
end function get
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine cmd_args_to_dictionary(check)
! convert command line arguments to dictionary entries
! reading the namelist output will trap unknown option names so do not really need to trap them here
logical,intent(in),optional  :: check
logical                      :: check_local
integer                      :: pointer
character(len=:),allocatable :: lastkeyword
integer                      :: i
integer                      :: ilength, istatus, imax
character(len=:),allocatable :: current_argument
character(len=:),allocatable :: current_argument_padded
character(len=:),allocatable :: dummy
character(len=:),allocatable :: oldvalue
logical                      :: nomore
   if(present(check))then
      check_local=check
   else
      check_local=.false.
   endif
   nomore=.false.
   pointer=0
   lastkeyword=' '
   keyword_single=.true.
   GET_ARGS: do i=1, command_argument_count()                                                        ! insert and replace entries
      call get_command_argument(number=i,length=ilength,status=istatus)                              ! get next argument
      if(istatus /= 0) then                                                                          ! stop program on error
         write(stderr,*)'*cmd_args_to_dictionary* error obtaining argument ',i,&
            &'status=',istatus,&
            &'length=',ilength
         exit GET_ARGS
      else
         if(allocated(current_argument))deallocate(current_argument)
         ilength=max(ilength,1)
         allocate(character(len=ilength) :: current_argument)
         call get_command_argument(number=i,value=current_argument,length=ilength,status=istatus)    ! get next argument
         if(istatus /= 0) then                                                                       ! stop program on error
            write(stderr,*)'*cmd_args_to_dictionary* error obtaining argument ',i,&
               &'status=',istatus,&
               &'length=',ilength,&
               &'target length=',len(current_argument)
            exit GET_ARGS
          endif
      endif

      if(current_argument.eq.'-')then  ! sort of
         current_argument='"stdin"'
      endif
      if(current_argument.eq.'--')then ! everything after this goes into the unnamed array
         nomore=.true.
         pointer=0
         cycle
      endif
      dummy=current_argument//'   '
      current_argument_padded=current_argument//'   '
      if(.not.nomore.and.current_argument_padded(1:2).eq.'--'.and.index("0123456789.",dummy(3:3)).eq.0)then ! beginning of long word
         keyword_single=.false.
         if(lastkeyword.ne.'')then
            call ifnull()
         endif
         call locate(keywords,current_argument_padded(3:),pointer)
         if(pointer.le.0.and.check_local)then
            call print_dictionary('UNKNOWN LONG KEYWORD: '//current_argument)
            stop 1
         endif
         lastkeyword=trim(current_argument_padded(3:))
      elseif(.not.nomore.and.current_argument_padded(1:1).eq.'-'.and.index("0123456789.",dummy(2:2)).eq.0)then  ! short word
         keyword_single=.true.
         if(lastkeyword.ne.'')then
            call ifnull()
         endif
         call locate(keywords,current_argument_padded(2:),pointer)
         if(pointer.le.0.and.check_local)then
            call print_dictionary('UNKNOWN SHORT KEYWORD: '//current_argument)
            stop 2
         endif
         lastkeyword=trim(current_argument_padded(2:))
      elseif(pointer.eq.0)then                                                                           ! unnamed arguments
         imax=max(len(unnamed),len(current_argument))
         unnamed=[character(len=imax) :: unnamed,current_argument]
      else
         oldvalue=get(keywords(pointer))//' '
         if(oldvalue(1:1).eq.'"')then
            current_argument=quote(current_argument(:ilength))
         endif
         if(upper(oldvalue).eq.'F'.or.upper(oldvalue).eq.'T')then  ! assume boolean parameter
            if(current_argument.ne.' ')then
               imax=max(len(unnamed),len(current_argument))
               unnamed=[character(len=imax) :: unnamed,current_argument]
            endif
            current_argument='T'
         endif
         call update(keywords(pointer),current_argument)
         pointer=0
         lastkeyword=''
      endif
   enddo GET_ARGS
   if(lastkeyword.ne.'')then
      call ifnull()
   endif

contains
subroutine ifnull()
   oldvalue=get(lastkeyword)//' '
   if(upper(oldvalue).eq.'F'.or.upper(oldvalue).eq.'T')then
      call update(lastkeyword,'T')
   elseif(oldvalue(1:1).eq.'"')then
      call update(lastkeyword,'" "')
   else
      call update(lastkeyword,' ')
   endif
end subroutine ifnull

end subroutine cmd_args_to_dictionary
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine dictionary_to_namelist(nml)
character(len=:),allocatable,intent(out) :: nml
integer :: i
character(len=:),allocatable :: newkeyword
   ! build namelist string
   nml=namelist_name//' '
   do i=1,size(keywords)
      if(isupper(keywords(i)(1:1)))then
         newkeyword=trim(lower(keywords(i)))//'_'
      else
         newkeyword=trim(keywords(i))
      endif
      if(return_all.or.present_in(i))then
         nml=nml//newkeyword//'='//trim(values(i))//' '
      endif
   enddo
   nml=nml//' /'
end subroutine dictionary_to_namelist
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!##SYNOPSIS
!!
!!   subroutine print_dictionary(header)
!!
!!    character(len=*),intent(in),optional :: header
!!##DESCRIPTION
!!   Print the internal dictionary created by calls to get_namelist(3f).
!!   This routine is intended to print the state of the argument list
!!   if an error occurs in using the get_namelist(3f) procedure..
!!##OPTIONS
!!   HEADER  label to print before printing the state of the command
!!           argument list.
!!##EXAMPLE
!!
!!    Typical usage:
!!
!!     program demo_get_namelist
!!     use M_arguments,  only : unnamed, get_namelist, print_dictionary
!!     implicit none
!!     integer                      :: i
!!     character(len=255)           :: message ! use for I/O error message
!!     character(len=:),allocatable :: readme  ! stores updated namelist
!!     integer                      :: ios
!!     real               :: x, y, z
!!     logical            :: help, h
!!     equivalence       (help,h)
!!     namelist /args/ x,y,z,help,h
!!     character(len=*),parameter :: cmd='&ARGS X=1 Y=2 Z=3 HELP=F H=F /'
!!     ! initialize namelist from string and then update from command line
!!     readme=cmd
!!     read(readme,nml=args,iostat=ios,iomsg=message)
!!     if(ios.eq.0)then
!!        ! update cmd with options from command line
!!        readme=get_namelist(cmd)
!!        read(readme,nml=args,iostat=ios,iomsg=message)
!!     endif
!!     if(ios.ne.0)then
!!        write(*,'("ERROR:",i0,1x,a)')ios, trim(message)
!!        call print_dictionary('OPTIONS:')
!!        stop 1
!!     endif
!!     ! all done cracking the command line
!!     ! use the values in your program.
!!     write(*,nml=args)
!!     ! the optional unnamed values on the command line are
!!     ! accumulated in the character array "UNNAMED"
!!     if(size(unnamed).gt.0)then
!!        write(*,'(a)')'files:'
!!        write(*,'(i6.6,3a)')(i,'[',unnamed(i),']',i=1,size(unnamed))
!!     endif
!!     end program demo_get_namelist
!===================================================================================================================================
subroutine print_dictionary(header)
character(len=*),intent(in),optional :: header
integer          :: i
   if(present(header))then
      if(header.ne.'')then
         write(stderr,'(a)')header
      endif
   endif
   if(allocated(keywords))then
      if(size(keywords).gt.0)then
         write(stderr,'(*(a,t21,a,t30,a))')'KEYWORD','PRESENT','VALUE'
         write(stderr,'(*(a,t21,l0,t30,"[",a,"]",/))')(trim(keywords(i)),present_in(i),values(i)(:counts(i)),i=1,size(keywords))
      endif
   endif
   if(allocated(unnamed))then
      if(size(unnamed).gt.0)then
         write(stderr,'(a)')'UNNAMED'
         write(stderr,'(i6.6,3a)')(i,'[',unnamed(i),']',i=1,size(unnamed))
      endif
   endif
end subroutine print_dictionary
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    longest_command_argument(3f) - [ARGUMENTS:M_arguments] length of longest argument on command line
!!##SYNOPSIS
!!
!!    function longest_command_argument() result(ilongest)
!!
!!     integer :: ilongest
!!
!!##DESCRIPTION
!!    length of longest argument on command line. Useful when allocating storage for holding arguments
!!##RESULT
!!    longest_command_argument  length of longest command argument
!!##EXAMPLE
!!
!!   Sample program
!!
!!    program demo_longest_command_argument
!!    use M_arguments, only : longest_command_argument
!!       write(*,*)'longest argument is ',longest_command_argument()
!!    end program demo_longest_command_argument
!===================================================================================================================================
function longest_command_argument() result(ilongest)
integer :: i
integer :: ilength
integer :: istatus
integer :: ilongest
   ilength=0
   ilongest=0
   GET_LONGEST: do i=1,command_argument_count()                             ! loop throught command line arguments to find longest
      call get_command_argument(number=i,length=ilength,status=istatus)     ! get next argument
      if(istatus /= 0) then                                                 ! stop program on error
         write(stderr,*)'*longest_command_argument* error obtaining length for argument ',i
         exit GET_LONGEST
      elseif(ilength.gt.0)then
         ilongest=max(ilongest,ilength)
      endif
   enddo GET_LONGEST
end function longest_command_argument
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    namelist_to_dictionary(3f) - [ARGUMENTS:M_arguments] parse namelist string and store tokens into dictionar
!!
!!##SYNOPSIS
!!
!!   subroutine namelist_to_dictionary(string)
!!
!!    character(len=*),intent(in)     ::  string
!!
!!##DESCRIPTION
!! must start with a keyword, any keyword that appears must have a value. A character array can have more than one delimited string
!! unallocated and null values are not allowed
!! set parameter name to blank
!! find undelimited =
!! find previous , or beginning of string. inbetween is a keyword
!! = to , that starts a keyword is a value
!! one keyword and value are known store them
!!&ARGS
!! L = F,
!! A_="xxxxxxxxxxxxxxxxxxxxxxxxxx                                                      ",
!! B_="Value B                                                                         ",
!! P= 2*0.00000000      ,
!! C_=         10,         20,         30, XYZ_=(-123.000000,-456.000000),
!! X=  0.0000000000000000     ,
!! Y=  0.0000000000000000     ,
!! Z=  0.0000000000000000     ,
!! /
!!
!!##OPTIONS
!!    STRING   string is character input string to define command
!===================================================================================================================================
subroutine namelist_to_dictionary(string)
implicit none

!character(len=*),parameter::ident_6=&
!&"@(#)M_arguments::namelist_to_dictionary(3f): parse user command and store tokens into dictionary"

character(len=*),intent(in)       :: string ! string is character input string of options and values

character(len=:),allocatable      :: dummy       ! working copy of string
character(len=:),allocatable      :: dummy_bug   ! bug in gfortran 7.4.0 where if dummy is on LHS and used in RHS get wrong result
character(len=:),allocatable      :: keyword_value
character(len=:),allocatable      :: value
character(len=:),allocatable      :: keyword
logical                           :: delmt   ! flag if in a delimited string or not
character(len=1)                  :: currnt  ! current character being processed
character(len=1)                  :: prev    ! current character being processed
integer                           :: islen   ! number of characters in input string
integer                           :: ipoint
integer                           :: istart
integer                           :: iend
integer                           :: ileft
integer                           :: icut
integer                           :: i
integer                           :: iback1,iback2
   islen=len_trim(string)                               ! find number of characters in input string
   if(islen  ==  0)then                                 ! if input string is blank, even default variable will not be changed
      return
   endif
   islen=islen-1                                        ! by definition last character in NAMELIST output is /
   dummy=trim(adjustl(string(:islen)))
   ! strip off namelist group name
   ileft=index(dummy,'&')
   dummy_bug=adjustl(dummy(ileft+1:))
   ileft=index(dummy_bug,' ')
   if(ileft.eq.0)then
      ileft=len(dummy_bug)
   endif
   namelist_name=upper('&'//dummy_bug(:ileft-1))
   dummy=adjustl(dummy_bug(ileft:))

   islen=len(dummy)
   dummy=dummy//'    '


   keyword=""          ! initial variable name
   value=""            ! initial value of a string
   delmt=.false.       ! whether in a character string or not
   prev=" "
   istart=1
   do ipoint=1,islen
      currnt=dummy(ipoint:ipoint)             ! store current character into currnt
      if(currnt=="=".and..not.delmt)then ! end of a parameter name
         keyword_value=''
         iend=0
         do i=ipoint-1,1,-1
            if(dummy(i:i).eq.' ')cycle
            ! found non-space
            iback1=index(dummy(:i),' ',back=.true.)
            iback2=index(dummy(:i),',',back=.true.)
            iend=max(iback1,iback2)
            exit
         enddo
         if(iend.ne.0)then
            call splitit()
         endif
         istart=iend+1
      elseif(currnt  ==  """")then
         if(prev  ==  """")then               ! second of a double quote, put quote in
            delmt=.not.delmt
         elseif(delmt)then
            delmt=.false.
         else
            delmt=.true.
         endif
      endif
      prev=currnt
      if(ipoint.ge.islen)then
         iend=ipoint
         call splitit()
      endif
   enddo
contains

subroutine splitit()
integer :: ilast
keyword_value=dummy(istart:iend)
! split keyword_value on first = and convert values to lowercase except for LETTER_ convert to uppercase LETTER and
! remove trailing , as NAMELIST output being read should not contain null values as everything in a namelist needs
! to be allocated (at least in this version of Fortran?).
   icut=index(keyword_value,'=')
   if(icut.eq.0)then
      write(stderr,*)'*splitit* INTERNAL ERROR: KEYWORD_VALUE=['//keyword_value//']'
   else
      keyword=adjustl(trim(lower(keyword_value(:icut-1))))
      if(len(keyword).eq.2)then
         if(keyword(2:2).eq.'_')then
            keyword=upper(keyword(1:1))
         endif
      endif
      if(icut.eq.len(keyword_value))then
         value=''
      else
         value=trim(adjustl(keyword_value(icut+1:)))
         ilast=len(value)
         if(ilast.eq.0)then
            value=''
         else
            if(value(ilast:ilast).eq.',')then
               value=trim(value(:ilast-1))
            endif
         endif
      endif
      call update(keyword,value)
   endif
end subroutine splitit

end subroutine namelist_to_dictionary
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
pure elemental function isupper(ch) result(res)

!character(len=*),parameter::ident_66="@(#)M_strings::isupper(3f): returns true if character is an uppercase letter (A-Z)"

character,intent(in) :: ch
logical              :: res
   select case(ch)
   case('A':'Z')
     res=.true.
   case default
     res=.false.
   end select
end function isupper
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!! upper(3f) - [M_strings:CASE] changes a string to uppercase
!!
!!##SYNOPSIS
!!
!!    elemental pure function upper(str,begin,end) result (string)
!!
!!     character(*), intent(in)    :: str
!!     integer,optional,intent(in) :: begin,end
!!     character(len(str))         :: string  ! output string
!!##DESCRIPTION
!!      upper(string) returns a copy of the input string with all characters
!!      converted in the optionally specified range to uppercase, assuming
!!      ASCII character sets are being used. If no range is specified the
!!      entire string is converted to uppercase.
!!
!!##OPTIONS
!!    str    string to convert to uppercase
!!    begin  optional starting position in "str" to begin converting to uppercase
!!    end    optional ending position in "str" to stop converting to uppercase
!!
!!##RESULTS
!!    upper  copy of the input string with all characters converted to uppercase
!!           over optionally specified range.
!!
!!##TRIVIA
!!    The terms "uppercase" and "lowercase" date back to the early days of
!!    the mechanical printing press. Individual metal alloy casts of each
!!    needed letter, or punctuation symbol, were meticulously added to a
!!    press block, by hand, before rolling out copies of a page. These
!!    metal casts were stored and organized in wooden cases. The more
!!    often needed miniscule letters were placed closer to hand, in the
!!    lower cases of the work bench. The less often needed, capitalized,
!!    majiscule letters, ended up in the harder to reach upper cases.
!!
!!##EXAMPLE
!!
!!    Sample program:
!!
!!     program demo_upper
!!     use M_strings, only: upper
!!     implicit none
!!     character(len=:),allocatable  :: s
!!        s=' ABCDEFG abcdefg '
!!        write(*,*) 'mixed-case input string is ....',s
!!        write(*,*) 'upper-case output string is ...',upper(s)
!!        write(*,*) 'make first character uppercase  ... ',upper('this is a sentence.',1,1)
!!        write(*,'(1x,a,*(a:,"+"))') 'UPPER(3f) is elemental ==>',upper(["abc","def","ghi"]
!!     end program demo_upper
!!
!!    Expected output
!!
!!     mixed-case input string is .... ABCDEFG abcdefg
!!     upper-case output string is ... ABCDEFG ABCDEFG
!!     make first character uppercase  ... This is a sentence.
!!     UPPER(3f) is elemental ==>ABC+DEF+GHI
!===================================================================================================================================
elemental pure function upper(str,begin,end) result (string)

!character(len=*),parameter::ident_20="@(#)M_strings::upper(3f): Changes a string to uppercase"

character(*), intent(In)      :: str                 ! inpout string to convert to all uppercase
integer, intent(in), optional :: begin,end
character(len(str))           :: string              ! output string that contains no miniscule letters
integer                       :: i                   ! loop counter
integer                       :: ibegin,iend
   string = str                                      ! initialize output string to input string

   ibegin = 1
   if (present(begin))then
      ibegin = max(ibegin,begin)
   endif

   iend = len_trim(str)
   if (present(end))then
      iend= min(iend,end)
   endif

   do i = ibegin, iend                               ! step thru each letter in the string in specified range
       select case (str(i:i))
       case ('a':'z')                                ! located miniscule letter
          string(i:i) = char(iachar(str(i:i))-32)    ! change miniscule letter to uppercase
       end select
   end do

end function upper
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    lower(3f) - [M_strings:CASE] changes a string to lowercase over specified rang
!!
!!##SYNOPSIS
!!
!!    elemental pure function lower(str,begin,end) result (string)
!!
!!     character(*), intent(in) :: str
!!     integer,optional         :: begin, end
!!     character(len(str))      :: string  ! output string
!!##DESCRIPTION
!!      lower(string) returns a copy of the input string with all characters
!!      converted to miniscule over the specified range, assuming ASCII
!!      character sets are being used. If no range is specified the entire
!!      string is converted to miniscule.
!!
!!##OPTIONS
!!    str    string to convert to miniscule
!!    begin  optional starting position in "str" to begin converting to miniscule
!!    end    optional ending position in "str" to stop converting to miniscule
!!
!!##RESULTS
!!    lower  copy of the input string with all characters converted to miniscule
!!           over optionally specified range.
!!
!!##TRIVIA
!!    The terms "uppercase" and "lowercase" date back to the early days of
!!    the mechanical printing press. Individual metal alloy casts of each
!!    needed letter, or punctuation symbol, were meticulously added to a
!!    press block, by hand, before rolling out copies of a page. These
!!    metal casts were stored and organized in wooden cases. The more
!!    often needed miniscule letters were placed closer to hand, in the
!!    lower cases of the work bench. The less often needed, capitalized,
!!    majiscule letters, ended up in the harder to reach upper cases.
!!
!!##EXAMPLE
!!
!!    Sample program:
!!
!!       program demo_lower
!!       use M_strings, only: lower
!!       implicit none
!!       character(len=:),allocatable  :: s
!!          s=' ABCDEFG abcdefg '
!!          write(*,*) 'mixed-case input string is ....',s
!!          write(*,*) 'lower-case output string is ...',lower(s)
!!       end program demo_lower
!!
!!    Expected output
!!
!!       mixed-case input string is .... ABCDEFG abcdefg
!!       lower-case output string is ... abcdefg abcdefg
!===================================================================================================================================
elemental pure function lower(str,begin,end) result (string)

!character(len=*),parameter::ident_21="@(#)M_strings::lower(3f): Changes a string to lowercase over specified range"

character(*), intent(In)     :: str
character(len(str))          :: string
integer,intent(in),optional  :: begin, end
integer                      :: i
integer                      :: ibegin, iend
   string = str

   ibegin = 1
   if (present(begin))then
      ibegin = max(ibegin,begin)
   endif

   iend = len_trim(str)
   if (present(end))then
      iend= min(iend,end)
   endif

   do i = ibegin, iend                               ! step thru each letter in the string in specified range
      select case (str(i:i))
      case ('A':'Z')
         string(i:i) = char(iachar(str(i:i))+32)     ! change letter to miniscule
      case default
      end select
   end do

end function lower
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=
!===================================================================================================================================
!>
!!##NAME
!!     quote(3f) - [M_strings:QUOTES] add quotes to string as if written with list-directed inpu
!!##SYNOPSIS
!!
!!   function quote(str,mode,clip) result (quoted_str)
!!
!!    character(len=*),intent(in)          :: str
!!    character(len=*),optional,intent(in) :: mode
!!    logical,optional,intent(in)          :: clip
!!    character(len=:),allocatable         :: quoted_str
!!##DESCRIPTION
!!    Add quotes to a CHARACTER variable as if it was written using
!!    list-directed input. This is particularly useful for processing
!!    strings to add to CSV files.
!!
!!##OPTIONS
!!    str         input string to add quotes to, using the rules of
!!                list-directed input (single quotes are replaced by two adjacent quotes)
!!    mode        alternate quoting methods are supported:
!!
!!                   DOUBLE   default. replace quote with double quotes
!!                   ESCAPE   replace quotes with backslash-quote instead of double quotes
!!
!!    clip        default is to trim leading and trailing spaces from the string. If CLIP
!!                is .FALSE. spaces are not trimmed
!!
!!##RESULT
!!    quoted_str  The output string, which is based on adding quotes to STR.
!!##EXAMPLE
!!
!!   Sample program:
!!
!!    program demo_quote
!!    use M_strings, only : quote
!!    implicit none
!!    character(len=:),allocatable :: str
!!    character(len=1024)          :: msg
!!    integer                      :: ios
!!    character(len=80)            :: inline
!!       do
!!          write(*,'(a)',advance='no')'Enter test string:'
!!          read(*,'(a)',iostat=ios,iomsg=msg)inline
!!          if(ios.ne.0)then
!!             write(*,*)trim(inline)
!!             exit
!!          endif
!!
!!          ! the original string
!!          write(*,'(a)')'ORIGINAL     ['//trim(inline)//']'
!!
!!          ! the string processed by quote(3f)
!!          str=quote(inline)
!!          write(*,'(a)')'QUOTED     ['//str//']'
!!
!!          ! write the string list-directed to compare the results
!!          write(*,'(a)',iostat=ios,iomsg=msg) 'LIST DIRECTED:'
!!          write(*,*,iostat=ios,iomsg=msg,delim='none') inline
!!          write(*,*,iostat=ios,iomsg=msg,delim='quote') inline
!!          write(*,*,iostat=ios,iomsg=msg,delim='apostrophe') inline
!!       enddo
!!    end program demo_quote
!===================================================================================================================================
function quote(str,mode,clip) result (quoted_str)
character(len=*),intent(in)          :: str                ! the string to be quoted
character(len=*),optional,intent(in) :: mode
logical,optional,intent(in)          :: clip
character(len=:),allocatable         :: quoted_str

character(len=1),parameter           :: double_quote = '"'
character(len=20)                    :: local_mode
!-----------------------------------------------------------------------------------------------------------------------------------
   local_mode=merge_str(mode,'DOUBLE',present(mode))
   if(merge(clip,.false.,present(clip)))then
      quoted_str=adjustl(str)
   else
      quoted_str=str
   endif
   select case(lower(local_mode))
   case('double')
      quoted_str=double_quote//trim(replace_substring(quoted_str,'"','""'))//double_quote
   case('escape')
      quoted_str=double_quote//trim(replace_substring(quoted_str,'"','\"'))//double_quote
   case default
      write(stderr,*)'*quote* ERROR: unknown quote mode ',local_mode
      quoted_str=str
   end select
!-----------------------------------------------------------------------------------------------------------------------------------
end function quote
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!!NAME
!!   lenset(3f) - [M_strings:LENGTH] return string trimmed or padded to specified length
!!
!!SYNOPSIS
!!   function lenset(str,length) result(strout)
!!
!!    character(len=*)                     :: str
!!    character(len=length)                :: strout
!!    integer,intent(in)                   :: length
!!DESCRIPTION
!!   lenset(3f) truncates a string or pads it with spaces to the specified
!!   length.
!!OPTIONS
!!   str     input string
!!   length  output string length
!!RESULTS
!!   strout  output string
!!EXAMPLE
!!   Sample Program:
!!
!!    program demo_lenset
!!     use M_strings, only : lenset
!!     implicit none
!!     character(len=10)            :: string='abcdefghij'
!!     character(len=:),allocatable :: answer
!!        answer=lenset(string,5)
!!        write(*,'("[",a,"]")') answer
!!        answer=lenset(string,20)
!!        write(*,'("[",a,"]")') answer
!!    end program demo_lenset
!!
!!   Expected output:
!!
!!    [abcde]
!!    [abcdefghij          ]
function lenset(line,length) result(strout)

!@(#) M_strings::lenset(3f): return string trimmed or padded to specified length

character(len=*),intent(in)  ::  line
integer,intent(in)           ::  length
character(len=length)        ::  strout
   strout=line
end function lenset
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    replace_substring(3f) - [M_strings:EDITING] function globally replaces one substring for another in strin
!!
!!##SYNOPSIS
!!
!!    function replace_substring(targetline[,old,new|cmd],range,ierr) result (newline)
!!
!!     character(len=*)                       :: targetline
!!     character(len=*),intent(in),optional   :: old
!!     character(len=*),intent(in),optional   :: new
!!     character(len=*),intent(in),optional   :: cmd
!!     integer,intent(in),optional            :: range(2)
!!     integer,intent(out),optional           :: ierr
!!     logical,intent(in),optional            :: clip
!!     character(len=:),allocatable           :: newline
!!##DESCRIPTION
!!    Globally replace one substring for another in string.
!!    Either CMD or OLD and NEW must be specified.
!!
!!##OPTIONS
!!     targetline  input line to be changed
!!     old         old substring to replace
!!     new         new substring
!!     cmd         alternate way to specify old and new string, in
!!                 the form c/old/new/; where "/" can be any character
!!                 not in "old" or "new"
!!     range       if present, only change range(1) to range(2) of occurrences of old string
!!     ierr        error code. iF ier = -1 bad directive, >= 0 then
!!                 count of changes made
!!     clip        whether to return trailing spaces or not. Defaults to .false.
!!##RETURNS
!!     newline     allocatable string returned
!!
!!##EXAMPLES
!!
!!   Sample Program:
!!
!!    program demo_replace_subtring
!!    use M_strings, only : replace_subtring
!!    implicit none
!!    character(len=:),allocatable :: targetline
!!
!!    targetline='this is the input string'
!!
!!    call testit('th','TH','THis is THe input string')
!!
!!    ! a null old substring means "at beginning of line"
!!    call testit('','BEFORE:', 'BEFORE:THis is THe input string')
!!
!!    ! a null new string deletes occurrences of the old substring
!!    call testit('i','', 'BEFORE:THs s THe nput strng')
!!
!!    write(*,*)'Examples of the use of RANGE='
!!
!!    targetline=replace_substring('a b ab baaa aaaa','a','A')
!!    write(*,*)'replace a with A ['//targetline//']'
!!
!!    targetline=replace_substring('a b ab baaa aaaa','a','A',range=[3,5])
!!    write(*,*)'replace a with A instances 3 to 5 ['//targetline//']'
!!
!!    targetline=replace_substring('a b ab baaa aaaa','a','',range=[3,5])
!!    write(*,*)'replace a with null instances 3 to 5 ['//targetline//']'
!!
!!    targetline=replace_substring('a b ab baaa aaaa aa aa a a a aa aaaaaa','aa','CCCC',range=[3,5])
!!    write(*,*)'replace aa with CCCC instances 3 to 5 ['//targetline//']'
!!
!!    contains
!!    subroutine testit(old,new,expected)
!!    character(len=*),intent(in) :: old,new,expected
!!    write(*,*)repeat('=',79)
!!    write(*,*)'STARTED ['//targetline//']'
!!    write(*,*)'OLD['//old//']', ' NEW['//new//']'
!!    targetline=replace_substring(targetline,old,new)
!!    write(*,*)'GOT     ['//targetline//']'
!!    write(*,*)'EXPECTED['//expected//']'
!!    write(*,*)'TEST    [',targetline.eq.expected,']'
!!    end subroutine testit
!!
!!    end program demo_replace_substring
!!
!!   Expected output
!!
!!     ===============================================================================
!!     STARTED [this is the input string]
!!     OLD[th] NEW[TH]
!!     GOT     [THis is THe input string]
!!     EXPECTED[THis is THe input string]
!!     TEST    [ T ]
!!     ===============================================================================
!!     STARTED [THis is THe input string]
!!     OLD[] NEW[BEFORE:]
!!     GOT     [BEFORE:THis is THe input string]
!!     EXPECTED[BEFORE:THis is THe input string]
!!     TEST    [ T ]
!!     ===============================================================================
!!     STARTED [BEFORE:THis is THe input string]
!!     OLD[i] NEW[]
!!     GOT     [BEFORE:THs s THe nput strng]
!!     EXPECTED[BEFORE:THs s THe nput strng]
!!     TEST    [ T ]
!!     Examples of the use of RANGE=
!!     replace a with A [A b Ab bAAA AAAA]
!!     replace a with A instances 3 to 5 [a b ab bAAA aaaa]
!!     replace a with null instances 3 to 5 [a b ab b aaaa]
!!     replace aa with CCCC instances 3 to 5 [a b ab baaa aaCCCC CCCC CCCC a a a aa aaaaaa]
!===================================================================================================================================
subroutine crack_cmd(cmd,old,new,ierr)
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=*),intent(in)              :: cmd
character(len=:),allocatable,intent(out) :: old,new                ! scratch string buffers
integer                                  :: ierr
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=1)                         :: delimiters
integer                                  :: itoken
integer,parameter                        :: id=2                   ! expected location of delimiter
logical                                  :: ifok
integer                                  :: lmax                   ! length of target string
integer                                  :: start_token,end_token
!-----------------------------------------------------------------------------------------------------------------------------------
   ierr=0
   old=''
   new=''
   lmax=len_trim(cmd)                       ! significant length of change directive

   if(lmax.ge.4)then                      ! strtok ignores blank tokens so look for special case where first token is really null
      delimiters=cmd(id:id)               ! find delimiter in expected location
      itoken=0                            ! initialize strtok(3f) procedure

      if(strtok(cmd(id:),itoken,start_token,end_token,delimiters)) then        ! find OLD string
         old=cmd(start_token+id-1:end_token+id-1)
      else
         old=''
      endif

      if(cmd(id:id).eq.cmd(id+1:id+1))then
         new=old
         old=''
      else                                                                     ! normal case
         ifok=strtok(cmd(id:),itoken,start_token,end_token,delimiters)         ! find NEW string
         if(end_token .eq. (len(cmd)-id+1) )end_token=len_trim(cmd(id:))       ! if missing ending delimiter
         new=cmd(start_token+id-1:min(end_token+id-1,lmax))
      endif
   else                                                                        ! command was two or less characters
      ierr=-1
      write(stderr,*)'*crack_cmd* incorrect change directive -too short'
   endif

end subroutine crack_cmd
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
function replace_substring(targetline,old,new,ierr,cmd,range) result (newline)

!character(len=*),parameter::ident_9="@(#)M_strings::replace_substring(3f): Globally replace one substring for another in string"

!-----------------------------------------------------------------------------------------------------------------------------------
! parameters
character(len=*),intent(in)            :: targetline   ! input line to be changed
character(len=*),intent(in),optional   :: old          ! old substring to replace
character(len=*),intent(in),optional   :: new          ! new substring
integer,intent(out),optional           :: ierr         ! error code. if ierr = -1 bad directive, >=0 then ierr changes made
character(len=*),intent(in),optional   :: cmd          ! contains the instructions changing the string
integer,intent(in),optional            :: range(2)     ! start and end of which changes to make
!-----------------------------------------------------------------------------------------------------------------------------------
! returns
character(len=:),allocatable  :: newline               ! output string buffer
!-----------------------------------------------------------------------------------------------------------------------------------
! local
character(len=:),allocatable  :: new_local, old_local
integer                       :: icount,ichange,ier2
integer                       :: original_input_length
integer                       :: len_old, len_new
integer                       :: ladd
integer                       :: left_margin, right_margin
integer                       :: ind
integer                       :: ic
integer                       :: ichar
integer                       :: range_local(2)
!-----------------------------------------------------------------------------------------------------------------------------------
!  get old_local and new_local from cmd or old and new
   if(present(cmd))then
      call crack_cmd(cmd,old_local,new_local,ier2)
      if(ier2.ne.0)then
         newline=targetline  ! if no changes are made return original string on error
         if(present(ierr))ierr=ier2
         return
      endif
   elseif(present(old).and.present(new))then
      old_local=old
      new_local=new
   else
      newline=targetline  ! if no changes are made return original string on error
      write(stderr,*)'*replace_substring* must specify OLD and NEW or CMD'
      return
   endif
!-----------------------------------------------------------------------------------------------------------------------------------
   icount=0                                            ! initialize error flag/change count
   ichange=0                                           ! initialize error flag/change count
   original_input_length=len_trim(targetline)          ! get non-blank length of input line
   len_old=len(old_local)                              ! length of old substring to be replaced
   len_new=len(new_local)                              ! length of new substring to replace old substring
   left_margin=1                                       ! left_margin is left margin of window to change
   right_margin=len(targetline)                        ! right_margin is right margin of window to change
   newline=''                                          ! begin with a blank line as output string
!-----------------------------------------------------------------------------------------------------------------------------------
   if(present(range))then
      range_local=range
   else
      range_local=[1,original_input_length]
   endif
!-----------------------------------------------------------------------------------------------------------------------------------
   if(len_old.eq.0)then                                ! c//new/ means insert new at beginning of line (or left margin)
      ichar=len_new + original_input_length
      if(len_new.gt.0)then
         newline=new_local(:len_new)//targetline(left_margin:original_input_length)
      else
         newline=targetline(left_margin:original_input_length)
      endif
      ichange=1                                        ! made one change. actually, c/// should maybe return 0
      if(present(ierr))ierr=ichange
      return
   endif
!-----------------------------------------------------------------------------------------------------------------------------------
   ichar=left_margin                                   ! place to put characters into output string
   ic=left_margin                                      ! place looking at in input string
   loop: do
      ind=index(targetline(ic:),old_local(:len_old))+ic-1 ! try finding start of OLD in remaining part of input in change window
      if(ind.eq.ic-1.or.ind.gt.right_margin)then          ! did not find old string or found old string past edit window
         exit loop                                        ! no more changes left to make
      endif
      icount=icount+1                                  ! found an old string to change, so increment count of change candidates
      if(ind.gt.ic)then                                ! if found old string past at current position in input string copy unchanged
         ladd=ind-ic                                   ! find length of character range to copy as-is from input to output
         newline=newline(:ichar-1)//targetline(ic:ind-1)
         ichar=ichar+ladd
      endif
      if(icount.ge.range_local(1).and.icount.le.range_local(2))then    ! check if this is an instance to change or keep
         ichange=ichange+1
         if(len_new.ne.0)then                                          ! put in new string
            newline=newline(:ichar-1)//new_local(:len_new)
            ichar=ichar+len_new
         endif
      else
         if(len_old.ne.0)then                                          ! put in copy of old string
            newline=newline(:ichar-1)//old_local(:len_old)
            ichar=ichar+len_old
         endif
      endif
      ic=ind+len_old
   enddo loop
!-----------------------------------------------------------------------------------------------------------------------------------
   select case (ichange)
   case (0)                                            ! there were no changes made to the window
      newline=targetline                               ! if no changes made output should be input
   case default
      if(ic.lt.len(targetline))then                    ! if there is more after last change on original line add it
         newline=newline(:ichar-1)//targetline(ic:max(ic,original_input_length))
      endif
   end select
   if(present(ierr))ierr=ichange
!-----------------------------------------------------------------------------------------------------------------------------------
end function replace_substring
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!! NAME
!!     strtok(3f) - [M_strings:TOKENS] Tokenize a string
!! SYNOPSIS
!!       function strtok(source_string,itoken,token_start,token_end,delimiters)
!!                 result(strtok_status)
!! 
!!        logical                      :: strtok_status    ! returned value
!!        character(len=*),intent(in)  :: source_string    ! string to tokenize
!!        integer,intent(inout)        :: itoken           ! token count since started
!!        integer,intent(out)          :: token_start      ! beginning of token
!!        integer,intent(inout)        :: token_end        ! end of token
!!        character(len=*),intent(in)  :: delimiters       ! list of separator characters
!! 
!! DESCRIPTION
!!     The STRTOK(3f) function is used to isolate sequential tokens in a string,
!!     SOURCE_STRING. These tokens are delimited in the string by at least one of
!!     the characters in DELIMITERS. The first time that STRTOK(3f) is called,
!!     ITOKEN should be specified as zero. Subsequent calls, wishing to obtain
!!     further tokens from the same string, should pass back in TOKEN_END  and
!!     ITOKEN until the function result returns .false.
!! 
!!     This routine assumes no other calls are made to it using any other input
!!     string while it is processing an input line.
!! 
!! OPTIONS
!!     source_string   input string to parse
!!     itoken          token count should be set to zero for a new string
!!     delimiters      characters used to determine the end of tokens
!! RETURN
!!     token_start     beginning position in SOURCE_STRING where token was found
!!     token_end       ending position in SOURCE_STRING where token was found
!!     strtok_status
!! 
!! EXAMPLES
!!   Sample program:
!! 
!!     !===============================================================================
!!     program demo_strtok
!!     use M_strings, only : strtok
!!     character(len=264)          :: inline
!!     character(len=*),parameter  :: delimiters=' ;,'
!!     integer                     :: ios
!!     !-------------------------------------------------------------------------------
!!        do                        ! read lines from stdin until end-of-file or error
!!           read (unit=*,fmt="(a)",iostat=ios) inline
!!           if(ios.ne.0)stop
!!           itoken=0 ! must set ITOKEN=0 before looping on strtok(3f) on a new string.
!!           do while ( strtok(inline,itoken,istart,iend,delimiters) )
!!              print *, itoken,'TOKEN=['//(inline(istart:iend))//']',istart,iend
!!           enddo
!!        enddo
!!     end program demo_strtok
!!     !===============================================================================
!! 
!!     sample input file
!! 
!!      this is a test of strtok; A:B :;,C;;
!! 
!!     sample output file
!! 
!!     1  TOKEN=[this]    2   5
!!     2  TOKEN=[is]      7   8
!!     3  TOKEN=[a]       10  10
!!     4  TOKEN=[test]    12  15
!!     5  TOKEN=[of]      17  18
!!     6  TOKEN=[strtok]  20  25
!!     7  TOKEN=[A:B]     28  30
!!     8  TOKEN=[:]       32  32
!!     9  TOKEN=[C]       35  35
!! 
FUNCTION strtok(source_string,itoken,token_start,token_end,delimiters) result(strtok_status)
! JSU- 20151030

!@(#) M_strings::strtok(3f): Tokenize a string

character(len=*),intent(in)  :: source_string    ! Source string to tokenize.
character(len=*),intent(in)  :: delimiters       ! list of separator characters. May change between calls
integer,intent(inout)        :: itoken           ! token count since started
logical                      :: strtok_status    ! returned value
integer,intent(out)          :: token_start      ! beginning of token found if function result is .true.
integer,intent(inout)        :: token_end        ! end of token found if function result is .true.
integer,save                 :: isource_len
!----------------------------------------------------------------------------------------------------------------------------
!  calculate where token_start should start for this pass
   if(itoken.le.0)then                           ! this is assumed to be the first call
      token_start=1
   else                                          ! increment start to previous end + 1
      token_start=token_end+1
   endif
!----------------------------------------------------------------------------------------------------------------------------
   isource_len=len(source_string)                ! length of input string
!----------------------------------------------------------------------------------------------------------------------------
   if(token_start.gt.isource_len)then            ! user input error or at end of string
      token_end=isource_len                      ! assume end of token is end of string until proven otherwise so it is set
      strtok_status=.false.
      return
   endif
!----------------------------------------------------------------------------------------------------------------------------
   ! find beginning of token
   do while (token_start .le. isource_len)       ! step thru each character to find next delimiter, if any
      if(index(delimiters,source_string(token_start:token_start)) .ne. 0) then
         token_start = token_start + 1
      else
         exit
      endif
   enddo
!----------------------------------------------------------------------------------------------------------------------------
   token_end=token_start
   do while (token_end .le. isource_len-1)       ! step thru each character to find next delimiter, if any
      if(index(delimiters,source_string(token_end+1:token_end+1)) .ne. 0) then  ! found a delimiter in next character
         exit
      endif
      token_end = token_end + 1
   enddo
!----------------------------------------------------------------------------------------------------------------------------
   if (token_start .gt. isource_len) then        ! determine if finished
      strtok_status=.false.                      ! flag that input string has been completely processed
   else
      itoken=itoken+1                            ! increment count of tokens found
      strtok_status=.true.                       ! flag more tokens may remain
   endif
!----------------------------------------------------------------------------------------------------------------------------
end function strtok
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!! NAME
!!    merge_str(3f) - [M_strings:LENGTH] pads strings to same length and then calls MERGE(3f)
!! 
!! SYNOPSIS
!!    function merge_str(str1,str2,expr) result(strout)
!! 
!!     character(len=*),intent(in)     :: str1
!!     character(len=*),intent(in)     :: str2
!!     logical,intent(in)              :: expr
!!     character(len=:),allocatable    :: strout
!! DESCRIPTION
!!    merge_str(3f) pads the shorter of str1 and str2 to the longest length
!!    of str1 and str2 and then calls MERGE(padded_str1,padded_str2,expr).
!!    It trims trailing spaces off the result and returns the trimmed
!!    string. This makes it easier to call MERGE(3f) with strings, as
!!    MERGE(3f) requires the strings to be the same length.
!! 
!! EXAMPLES
!!   Sample Program:
!! 
!!     program demo_merge_str
!!     use M_strings, only : merge_str
!!     implicit none
!!     character(len=:), allocatable :: answer
!!        answer=merge_str('first string', 'second string is longer',10.eq.10)
!!        write(*,'("[",a,"]")') answer
!!        answer=merge_str('first string', 'second string is longer',10.ne.10)
!!        write(*,'("[",a,"]")') answer
!!     end program demo_merge_str
!! 
!!    Expected output
!! 
!!     [first string]
!!     [second string is longer]
function merge_str(str1,str2,expr) result(strout)
! for some reason the MERGE(3f) intrinsic requires the strings it compares to be of equal length
! make an alias for MERGE(3f) that makes the lengths the same before doing the comparison by padding the shorter one with spaces

!@(#) M_strings::merge_str(3f): pads first and second arguments to MERGE(3f) to same length

character(len=*),intent(in)     :: str1
character(len=*),intent(in)     :: str2
logical,intent(in)              :: expr
character(len=:),allocatable    :: strout
integer                         :: big
   big=max(len(str1),len(str2))
   strout=trim(merge(lenset(str1,big),lenset(str2,big),expr))
end function merge_str
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!>
!!##NAME
!!    M_list(3f) - [M_list] maintain simple lists
!!##SYNOPSIS
!!
!!##DESCRIPTION
!!
!!    The M_list(3fm) module allows for maintaining an array as a sorted
!!    list. An example is given that creates a keyword-value dictionary
!!    using the lists.
!!
!!    The lists are maintained as simple allocatable arrays. Each time an
!!    entry is added or deleted the array is re-allocated. Because of the
!!    expense of reallocating the data these routines are best suited for
!!    maintaining small lists that do not change size frequently.
!!
!!    The advantage is that the dictionary components are simple arrays
!!    which can be easily accessed with standard routines.
!!
!!    BASIC LIST
!!    subroutine locate(list,value,place,ier,errmsg)  finds the index where a
!!                                                    value is found or should
!!                                                    be in a sorted array and
!!                                                    flag if the value exists
!!                                                    already
!!    subroutine insert(list,value,place)     insert entry into an allocatable
!!                                            array at specified position
!!    subroutine replace(list,value,place)    replace entry in an allocatable
!!                                            array at specified position
!!    subroutine remove(list,place)           remove entry from an allocatable
!!                                            array at specified position
!!
!!    BASIC DICTIONARY
!!
!!    Due to bugs in gfortran up to at least 7.4.0, this next section
!!    does not work.
!!
!!    type dictionary
!!
!!       character(len=:),allocatable :: key(:)
!!       character(len=:),allocatable :: value(:)
!!       integer,allocatable          :: count(:)
!!
!!    %get      get value from type(dictionary) given an existing key
!!    %set      set or replace value for type(dictionary) given a key
!!    %del      delete an existing key from type(dictionary)
!!    %clr      empty a type(dictionary)
!!
!!##EXAMPLE
!!
!!   Sample program
!!
!!    program demo_M_list
!!    use M_list, only : insert, locate, replace, remove
!!    ! create a dictionary with character keywords, values, and value lengths
!!    ! using the routines for maintaining a list
!!
!!     use M_list, only : locate, insert, replace
!!     implicit none
!!     character(len=:),allocatable   :: keywords(:)
!!     character(len=:),allocatable   :: values(:)
!!     integer,allocatable            :: counts(:)
!!     integer                        :: i
!!     ! insert and replace entries
!!     call update('b','value of b')
!!     call update('a','value of a')
!!     call update('c','value of c')
!!     call update('c','value of c again')
!!     call update('d','value of d')
!!     call update('a','value of a again')
!!     ! show array
!!     write(*,'(*(a,"==>","[",a,"]",/))')(trim(keywords(i)),values(i)(:counts(i)),i=1,size(keywords)
!!     ! remove some entries
!!     call update('a')
!!     call update('c')
!!     write(*,'(*(a,"==>","[",a,"]",/))')(trim(keywords(i)),values(i)(:counts(i)),i=1,size(keywords)
!!     ! get some values
!!     write(*,*)'get b=>',get('b')
!!     write(*,*)'get d=>',get('d')
!!     write(*,*)'get notthere=>',get('notthere')
!!
!!     contains
!!     subroutine update(key,valin)
!!     character(len=*),intent(in)           :: key
!!     character(len=*),intent(in),optional  :: valin
!!     integer                               :: place
!!     integer                               :: ilen
!!     character(len=:),allocatable          :: val
!!     if(present(valin))then
!!        val=valin
!!        ilen=len_trim(val)
!!        ! find where string is or should be
!!        call locate(keywords,key,place)
!!        ! if string was not found insert it
!!        if(place.lt.1)then
!!           call insert(keywords,key,iabs(place))
!!           call insert(values,val,iabs(place))
!!           call insert(counts,ilen,iabs(place))
!!        else
!!           call replace(values,val,place)
!!           call replace(counts,ilen,place)
!!        endif
!!     else
!!        call locate(keywords,key,place)
!!        if(place.gt.0)then
!!           call remove(keywords,place)
!!           call remove(values,place)
!!           call remove(counts,place)
!!        endif
!!     endif
!!     end subroutine update
!!     function get(key) result(valout)
!!     character(len=*),intent(in)   :: key
!!     character(len=:),allocatable  :: valout
!!     integer                       :: place
!!        ! find where string is or should be
!!        call locate(keywords,key,place)
!!        if(place.lt.1)then
!!           valout=''
!!        else
!!           valout=values(place)(:counts(place))
!!        endif
!!     end function get
!!    end program demo_M_list
!!
!!   Results:
!!
!!    d==>[value of d]
!!    c==>[value of c again]
!!    b==>[value of b]
!!    a==>[value of a again]
!!
!!    d==>[value of d]
!!    b==>[value of b]
!!
!!     get b=>value of b
!!     get d=>value of d
!!     get notthere=>
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=
!===================================================================================================================================
!>
!!##NAME
!!    locate(3f) - [M_list] finds the index where a string is found or should be in a sorted arra
!!
!!##SYNOPSIS
!!
!!   subroutine locate(list,value,place,ier,errmsg)
!!
!!    character(len=:)|doubleprecision|real|integer,allocatable :: list(:)
!!    character(len=*)|doubleprecision|real|integer,intent(in)  :: value
!!    integer, intent(out)                  :: PLACE
!!
!!    integer, intent(out),optional         :: IER
!!    character(len=*),intent(out),optional :: ERRMSG
!!
!!##DESCRIPTION
!!
!!    LOCATE(3f) finds the index where the VALUE is found or should
!!    be found in an array. The array must be sorted in descending
!!    order (highest at top). If VALUE is not found it returns the index
!!    where the name should be placed at with a negative sign.
!!
!!    The array and list must be of the same type (CHARACTER, DOUBLEPRECISION,
!!    REAL,INTEGER)
!!
!!##OPTIONS
!!
!!    VALUE         the value to locate in the list.
!!    LIST          is the list array.
!!
!!##RETURNS
!!    PLACE         is the subscript that the entry was found at if it is
!!                  greater than zero(0).
!!
!!                  If PLACE is negative, the absolute value of
!!                  PLACE indicates the subscript value where the
!!                  new entry should be placed in order to keep the
!!                  list alphabetized.
!!
!!    IER           is zero(0) if no error occurs.
!!                  If an error occurs and IER is not
!!                  present, the program is stopped.
!!
!!    ERRMSG        description of any error
!!
!!##EXAMPLES
!!
!!
!!    Find if a string is in a sorted array, and insert the string into
!!    the list if it is not present ...
!!
!!     program demo_locate
!!     use M_sort, only : sort_shell
!!     use M_list, only : locate
!!     implicit none
!!     character(len=:),allocatable  :: arr(:)
!!     integer                       :: i
!!
!!     arr=[character(len=20) :: '', 'ZZZ', 'aaa', 'b', 'xxx' ]
!!     ! make sure sorted in descending order
!!     call sort_shell(arr,order='d')
!!
!!     call update(arr,'b')
!!     call update(arr,'[')
!!     call update(arr,'c')
!!     call update(arr,'ZZ')
!!     call update(arr,'ZZZZ')
!!     call update(arr,'z')
!!
!!     contains
!!     subroutine update(arr,string)
!!     character(len=:),allocatable :: arr(:)
!!     character(len=*)             :: string
!!     integer                      :: place, plus, ii, end
!!     ! find where string is or should be
!!     call locate(arr,string,place)
!!     write(*,*)'for "'//string//'" index is ',place, size(arr)
!!     ! if string was not found insert it
!!     if(place.lt.1)then
!!        plus=abs(place)
!!        ii=len(arr)
!!        end=size(arr)
!!        ! empty array
!!        if(end.eq.0)then
!!           arr=[character(len=ii) :: string ]
!!        ! put in front of array
!!        elseif(plus.eq.1)then
!!           arr=[character(len=ii) :: string, arr]
!!        ! put at end of array
!!        elseif(plus.eq.end)then
!!           arr=[character(len=ii) :: arr, string ]
!!        ! put in middle of array
!!        else
!!           arr=[character(len=ii) :: arr(:plus-1), string,arr(plus:) ]
!!        endif
!!        ! show array
!!        write(*,'("SIZE=",i0,1x,*(a,","))')end,(trim(arr(i)),i=1,end)
!!     endif
!!     end subroutine update
!!     end program demo_locate
!!
!!   Results:
!!
!!     for "b" index is            2           5
!!     for "[" index is           -4           5
!!    SIZE=5 xxx,b,aaa,[,ZZZ,
!!     for "c" index is           -2           6
!!    SIZE=6 xxx,c,b,aaa,[,ZZZ,
!!     for "ZZ" index is           -7           7
!!    SIZE=7 xxx,c,b,aaa,[,ZZZ,,
!!     for "ZZZZ" index is           -6           8
!!    SIZE=8 xxx,c,b,aaa,[,ZZZZ,ZZZ,,
!!     for "z" index is           -1           9
!!    SIZE=9 z,xxx,c,b,aaa,[,ZZZZ,ZZZ,,
!!
!!##AUTHOR
!!    1989,2017 John S. Urban
!===================================================================================================================================
subroutine locate_c(list,value,place,ier,errmsg)

!character(len=*),parameter::ident_5="&
!&@(#)M_list::locate_c(3f): find PLACE in sorted character array where VALUE can be found or should be placed"

character(len=*),intent(in)             :: value
integer,intent(out)                     :: place
character(len=:),allocatable            :: list(:)
integer,intent(out),optional            :: ier
character(len=*),intent(out),optional   :: errmsg
integer                                 :: i
character(len=:),allocatable            :: message
integer                                 :: arraysize
integer                                 :: maxtry
integer                                 :: imin, imax
integer                                 :: error
   if(.not.allocated(list))then
      list=[character(len=max(len_trim(value),2)) :: ]
   endif
   arraysize=size(list)

   error=0
   if(arraysize.eq.0)then
      maxtry=0
      place=-1
   else
      maxtry=int(log(float(arraysize))/log(2.0)+1.0)
      place=(arraysize+1)/2
   endif
   imin=1
   imax=arraysize
   message=''

   LOOP: block
   do i=1,maxtry

      if(value.eq.list(PLACE))then
         exit LOOP
      else if(value.gt.list(place))then
         imax=place-1
      else
         imin=place+1
      endif

      if(imin.gt.imax)then
         place=-imin
         if(iabs(place).gt.arraysize)then ! ran off end of list. Where new value should go or an unsorted input array'
            exit LOOP
         endif
         exit LOOP
      endif

      place=(imax+imin)/2

      if(place.gt.arraysize.or.place.le.0)then
         message='*locate* error: search is out of bounds of list. Probably an unsorted input array'
         error=-1
         exit LOOP
      endif

   enddo
   message='*locate* exceeded allowed tries. Probably an unsorted input array'
   endblock LOOP
   if(present(ier))then
      ier=error
   else if(error.ne.0)then
      write(stderr,*)message//' VALUE=',trim(value)//' PLACE=',place
      stop 1
   endif
   if(present(errmsg))then
      errmsg=message
   endif
end subroutine locate_c
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=
!===================================================================================================================================
!>
!!##NAME
!!    remove(3f) - [M_list] remove entry from an allocatable array at specified positio
!!
!!##SYNOPSIS
!!
!!   subroutine remove(list,place)
!!
!!    character(len=:)|doubleprecision|real|integer,intent(inout) :: list(:)
!!    integer, intent(out) :: PLACE
!!
!!##DESCRIPTION
!!
!!    Remove a value from an allocatable array at the specified index.
!!    The array is assumed to be sorted in descending order. It may be of
!!    type CHARACTER, DOUBLEPRECISION, REAL, or INTEGER.
!!
!!##OPTIONS
!!
!!    list    is the list array.
!!    PLACE   is the subscript for the entry that should be removed
!!
!!##EXAMPLES
!!
!!
!!    Sample program
!!
!!     program demo_remove
!!     use M_sort, only : sort_shell
!!     use M_list, only : locate, remove
!!     implicit none
!!     character(len=:),allocatable :: arr(:)
!!     integer                       :: i
!!     integer                       :: end
!!
!!     arr=[character(len=20) :: '', 'ZZZ', 'Z', 'aaa', 'b', 'b', 'ab', 'bb', 'xxx' ]
!!     ! make sure sorted in descending order
!!     call sort_shell(arr,order='d')
!!
!!     end=size(arr)
!!     write(*,'("SIZE=",i0,1x,*(a,","))')end,(trim(arr(i)),i=1,end)
!!     call remove(arr,1)
!!     end=size(arr)
!!     write(*,'("SIZE=",i0,1x,*(a,","))')end,(trim(arr(i)),i=1,end)
!!     call remove(arr,4)
!!     end=size(arr)
!!     write(*,'("SIZE=",i0,1x,*(a,","))')end,(trim(arr(i)),i=1,end)
!!
!!     end program demo_remove
!!
!!   Results:
!!
!!    Expected output
!!
!!     SIZE=9 xxx,bb,b,b,ab,aaa,ZZZ,Z,,
!!     SIZE=8 bb,b,b,ab,aaa,ZZZ,Z,,
!!     SIZE=7 bb,b,b,aaa,ZZZ,Z,,
!!
!!##AUTHOR
!!    1989,2017 John S. Urban
!===================================================================================================================================
subroutine remove_c(list,place)
!character(len=*),parameter::ident_9="@(#)M_list::remove_c(3fp): remove string from allocatable string array at specified position"

character(len=:),allocatable :: list(:)
integer,intent(in)           :: place
integer                      :: ii, end
   if(.not.allocated(list))then
      list=[character(len=2) :: ]
   endif
   ii=len(list)
   end=size(list)
   if(place.le.0.or.place.gt.end)then                       ! index out of bounds of array
   elseif(place.eq.end)then                                 ! remove from array
      list=[character(len=ii) :: list(:place-1) ]
   else
      list=[character(len=ii) :: list(:place-1), list(place+1:) ]
   endif
end subroutine remove_c
!===================================================================================================================================
subroutine remove_l(list,place)

!character(len=*),parameter::ident_12="@(#)M_list::remove_l(3fp): remove value from allocatable array at specified position"

logical,allocatable    :: list(:)
integer,intent(in)     :: place
integer                :: end

   if(.not.allocated(list))then
      list=[logical :: ]
   endif
   end=size(list)
   if(place.le.0.or.place.gt.end)then                       ! index out of bounds of array
   elseif(place.eq.end)then                                 ! remove from array
      list=[ list(:place-1)]
   else
      list=[ list(:place-1), list(place+1:) ]
   endif

end subroutine remove_l
!===================================================================================================================================
subroutine remove_i(list,place)

!character(len=*),parameter::ident_13="@(#)M_list::remove_i(3fp): remove value from allocatable array at specified position"
integer,allocatable    :: list(:)
integer,intent(in)     :: place
integer                :: end

   if(.not.allocated(list))then
      list=[integer :: ]
   endif
   end=size(list)
   if(place.le.0.or.place.gt.end)then                       ! index out of bounds of array
   elseif(place.eq.end)then                                 ! remove from array
      list=[ list(:place-1)]
   else
      list=[ list(:place-1), list(place+1:) ]
   endif

end subroutine remove_i
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=
!===================================================================================================================================
!>
!!##NAME
!!    replace(3f) - [M_list] replace entry in a string array at specified position
!!
!!##SYNOPSIS
!!
!!   subroutine replace(list,value,place)
!!
!!    character(len=*)|doubleprecision|real|integer,intent(in) :: value
!!    character(len=:)|doubleprecision|real|integer,intent(in) :: list(:)
!!    integer, intent(out)          :: PLACE
!!
!!##DESCRIPTION
!!
!!    replace a value in an allocatable array at the specified index. Unless the
!!    array needs the string length to increase this is merely an assign of a value
!!    to an array element.
!!
!!    The array may be of type CHARACTER, DOUBLEPRECISION, REAL, or INTEGER>
!!    It is assumed to be sorted in descending order without duplicate values.
!!
!!    The value and list must be of the same type.
!!
!!##OPTIONS
!!
!!    VALUE         the value to place in the array
!!    LIST          is the array.
!!    PLACE         is the subscript that the entry should be placed at
!!
!!##EXAMPLES
!!
!!
!!   Replace key-value pairs in a dictionary
!!
!!     program demo_replace
!!     use M_list, only  : insert, locate, replace
!!     ! Find if a key is in a list and insert it
!!     ! into the key list and value list if it is not present
!!     ! or replace the associated value if the key existed
!!     implicit none
!!     character(len=20)            :: key
!!     character(len=100)           :: val
!!     character(len=:),allocatable :: keywords(:)
!!     character(len=:),allocatable :: values(:)
!!     integer                      :: i
!!     integer                      :: place
!!     call update('b','value of b')
!!     call update('a','value of a')
!!     call update('c','value of c')
!!     call update('c','value of c again')
!!     call update('d','value of d')
!!     call update('a','value of a again')
!!     ! show array
!!     write(*,'(*(a,"==>",a,/))')(trim(keywords(i)),trim(values(i)),i=1,size(keywords)
!!
!!     call locate(keywords,'a',place)
!!     if(place.gt.0)then
!!        write(*,*)'The value of "a" is',trim(values(place))
!!     else
!!        write(*,*)'"a" not found'
!!     endif
!!
!!     contains
!!     subroutine update(key,val)
!!     character(len=*),intent(in)  :: key
!!     character(len=*),intent(in)  :: val
!!     integer                      :: place
!!
!!     ! find where string is or should be
!!     call locate(keywords,key,place)
!!     ! if string was not found insert it
!!     if(place.lt.1)then
!!        call insert(keywords,key,abs(place))
!!        call insert(values,val,abs(place))
!!     else ! replace
!!        call replace(values,val,place)
!!     endif
!!
!!     end subroutine update
!!    end program demo_replace
!!
!!   Expected output
!!
!!    d==>value of d
!!    c==>value of c again
!!    b==>value of b
!!    a==>value of a again
!!
!!##AUTHOR
!!    1989,2017 John S. Urban
!===================================================================================================================================
subroutine replace_c(list,value,place)

!character(len=*),parameter::ident_14="@(#)M_list::replace_c(3fp): replace string in allocatable string array at specified position"

character(len=*),intent(in)  :: value
character(len=:),allocatable :: list(:)
character(len=:),allocatable :: kludge(:)
integer,intent(in)           :: place
integer                      :: ii
integer                      :: tlen
integer                      :: end
   if(.not.allocated(list))then
      list=[character(len=max(len_trim(value),2)) :: ]
   endif
   tlen=len_trim(value)
   end=size(list)
   if(place.lt.0.or.place.gt.end)then
           write(stderr,*)'*replace_c* error: index out of range. end=',end,' index=',place
   elseif(len_trim(value).le.len(list))then
      list(place)=value
   else  ! increase length of variable
      ii=max(tlen,len(list))
      kludge=[character(len=ii) :: list ]
      list=kludge
      list(place)=value
   endif
end subroutine replace_c
!===================================================================================================================================
subroutine replace_l(list,value,place)

!character(len=*),parameter::ident_17="@(#)M_list::replace_l(3fp): place value into allocatable array at specified position"

logical,allocatable   :: list(:)
logical,intent(in)    :: value
integer,intent(in)    :: place
integer               :: end
   if(.not.allocated(list))then
      list=[logical :: ]
   endif
   end=size(list)
   if(end.eq.0)then                                          ! empty array
      list=[value]
   elseif(place.gt.0.and.place.le.end)then
      list(place)=value
   else                                                      ! put in middle of array
      write(stderr,*)'*replace_l* error: index out of range. end=',end,' index=',place
   endif
end subroutine replace_l
!===================================================================================================================================
subroutine replace_i(list,value,place)

!character(len=*),parameter::ident_18="@(#)M_list::replace_i(3fp): place value into allocatable array at specified position"

integer,intent(in)    :: value
integer,allocatable   :: list(:)
integer,intent(in)    :: place
integer               :: end
   if(.not.allocated(list))then
      list=[integer :: ]
   endif
   end=size(list)
   if(end.eq.0)then                                          ! empty array
      list=[value]
   elseif(place.gt.0.and.place.le.end)then
      list(place)=value
   else                                                      ! put in middle of array
      write(stderr,*)'*replace_i* error: index out of range. end=',end,' index=',place
   endif
end subroutine replace_i
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()=
!===================================================================================================================================
!>
!!##NAME
!!    insert(3f) - [M_list] insert entry into a string array at specified positio
!!
!!##SYNOPSIS
!!
!!   subroutine insert(list,value,place)
!!
!!    character(len=*)|doubleprecision|real|integer,intent(in) :: value
!!    character(len=:)|doubleprecision|real|integer,intent(in) :: list(:)
!!    integer,intent(in)    :: place
!!
!!##DESCRIPTION
!!
!!    Insert a value into an allocatable array at the specified index.
!!    The list and value must be of the same type (CHARACTER, DOUBLEPRECISION,
!!    REAL, or INTEGER)
!!
!!##OPTIONS
!!
!!    list    is the list array. Must be sorted in descending order.
!!    value   the value to place in the array
!!    PLACE   is the subscript that the entry should be placed at
!!
!!##EXAMPLES
!!
!!
!!    Find if a string is in a sorted array, and insert the string into
!!    the list if it is not present ...
!!
!!     program demo_insert
!!     use M_sort, only : sort_shell
!!     use M_list, only : locate, insert
!!     implicit none
!!     character(len=:),allocatable :: arr(:)
!!     integer                       :: i
!!
!!     arr=[character(len=20) :: '', 'ZZZ', 'aaa', 'b', 'xxx' ]
!!     ! make sure sorted in descending order
!!     call sort_shell(arr,order='d')
!!     ! add or replace values
!!     call update(arr,'b')
!!     call update(arr,'[')
!!     call update(arr,'c')
!!     call update(arr,'ZZ')
!!     call update(arr,'ZZZ')
!!     call update(arr,'ZZZZ')
!!     call update(arr,'')
!!     call update(arr,'z')
!!
!!     contains
!!     subroutine update(arr,string)
!!     character(len=:),allocatable :: arr(:)
!!     character(len=*)             :: string
!!     integer                      :: place, end
!!
!!     end=size(arr)
!!     ! find where string is or should be
!!     call locate(arr,string,place)
!!     ! if string was not found insert it
!!     if(place.lt.1)then
!!        call insert(arr,string,abs(place))
!!     endif
\!!     ! show array
!!     end=size(arr)
!!     write(*,'("array is now SIZE=",i0,1x,*(a,","))')end,(trim(arr(i)),i=1,end)
!!
!!     end subroutine update
!!     end program demo_insert
!!
!!   Results:
!!
!!     array is now SIZE=5 xxx,b,aaa,ZZZ,,
!!     array is now SIZE=6 xxx,b,aaa,[,ZZZ,,
!!     array is now SIZE=7 xxx,c,b,aaa,[,ZZZ,,
!!     array is now SIZE=8 xxx,c,b,aaa,[,ZZZ,ZZ,,
!!     array is now SIZE=9 xxx,c,b,aaa,[,ZZZZ,ZZZ,ZZ,,
!!     array is now SIZE=10 z,xxx,c,b,aaa,[,ZZZZ,ZZZ,ZZ,,
!!
!!##AUTHOR
!!    1989,2017 John S. Urban
!===================================================================================================================================
subroutine insert_c(list,value,place)

!character(len=*),parameter::ident_19="@(#)M_list::insert_c(3fp): place string into allocatable string array at specified position"

character(len=*),intent(in)  :: value
character(len=:),allocatable :: list(:)
character(len=:),allocatable :: kludge(:)
integer,intent(in)           :: place
integer                      :: ii
integer                      :: end

   if(.not.allocated(list))then
      list=[character(len=max(len_trim(value),2)) :: ]
   endif

   ii=max(len_trim(value),len(list),2)
   end=size(list)

   if(end.eq.0)then                                          ! empty array
      list=[character(len=ii) :: value ]
   elseif(place.eq.1)then                                    ! put in front of array
      kludge=[character(len=ii) :: value, list]
      list=kludge
   elseif(place.gt.end)then                                  ! put at end of array
      kludge=[character(len=ii) :: list, value ]
      list=kludge
   elseif(place.ge.2.and.place.le.end)then                   ! put in middle of array
      kludge=[character(len=ii) :: list(:place-1), value,list(place:) ]
      list=kludge
   else                                                      ! index out of range
      write(stderr,*)'*insert_c* error: index out of range. end=',end,' index=',place,' value=',value
   endif

end subroutine insert_c
!===================================================================================================================================
subroutine insert_l(list,value,place)

!character(len=*),parameter::ident_22="@(#)M_list::insert_l(3fp): place value into allocatable array at specified position"

logical,allocatable   :: list(:)
logical,intent(in)    :: value
integer,intent(in)    :: place
integer               :: end
   if(.not.allocated(list))then
      list=[logical :: ]
   endif
   end=size(list)
   if(end.eq.0)then                                          ! empty array
      list=[value]
   elseif(place.eq.1)then                                    ! put in front of array
      list=[value, list]
   elseif(place.gt.end)then                                  ! put at end of array
      list=[list, value ]
   elseif(place.ge.2.and.place.le.end)then                   ! put in middle of array
      list=[list(:place-1), value,list(place:) ]
   else                                                      ! index out of range
      write(stderr,*)'*insert_l* error: index out of range. end=',end,' index=',place,' value=',value
   endif

end subroutine insert_l
!===================================================================================================================================
subroutine insert_i(list,value,place)

!character(len=*),parameter::ident_23="@(#)M_list::insert_i(3fp): place value into allocatable array at specified position"

integer,allocatable   :: list(:)
integer,intent(in)    :: value
integer,intent(in)    :: place
integer               :: end
   if(.not.allocated(list))then
      list=[integer :: ]
   endif
   end=size(list)
   if(end.eq.0)then                                          ! empty array
      list=[value]
   elseif(place.eq.1)then                                    ! put in front of array
      list=[value, list]
   elseif(place.gt.end)then                                  ! put at end of array
      list=[list, value ]
   elseif(place.ge.2.and.place.le.end)then                   ! put in middle of array
      list=[list(:place-1), value,list(place:) ]
   else                                                      ! index out of range
      write(stderr,*)'*insert_i* error: index out of range. end=',end,' index=',place,' value=',value
   endif

end subroutine insert_i
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
end module M_arguments
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================

To use the module you also need to cut and paste the GET_ARGS(3f) routine shown in the example program below:

program short
use M_arguments,  only : unnamed
implicit none
integer :: i

! declare and initialize a namelist
! letter_ denotes an uppercase short command keyword
! all values should be allocated before calling get_args(3f)
real              :: x=111.1, y=222.2, z=333.3
real              :: point(3)=[10.0,20.0,30.0]
character(len=80) :: title=" "
logical           :: help=.false., version=.false.
logical           :: l=.false., l_=.false., v=.false., h=.false.
! you can equivalence short and long options
equivalence       (help,h),(version,v)
! just add a variable here and it is a new parameter !!
namelist /args/ x,y,z,point,title,help,h,version,v,l,l_
   !
   call get_args()  ! crack command line options
   ! do stuff with your variables
   write(*,*)'VALUES ARE NOW'
   write(*,nml=args)
   if(size(unnamed).gt.0)then
      write(*,'(a)')'UNNAMED:'
      write(*,'(i6.6,3a)')(i,'[',unnamed(i),']',i=1,size(unnamed))
   endif

contains
   subroutine get_args()
      ! The NAMELIST cannot be passed as an option to a routine so this
      ! routine must be in a contained routine or directly in the body of
      ! the routine that declares the NAMELIST. get_args(3f) should not
      ! need changed except for possibly the length of HOLD_NAMELIST
      use M_arguments,    only : get_namelist, print_dictionary
      !
      integer :: ios
      character(len=255) :: message ! use for I/O error messages
      character(len=:),allocatable :: readme  ! stores updated namelist
      ! make big enough for all of namelist
      character(len=10000) :: hold_namelist
      ! the routine needs a copy of the options to determine what values
      ! are character and logical versus numeric
      write(hold_namelist,nml=args,iostat=ios,iomsg=message)
      if(ios.eq.0)then
         ! pass in the namelist and get an updated copy that includes
         ! values specified on the command line
         readme=get_namelist(hold_namelist)
         ! read the updated namelist to update the values
         ! in the namelist group
         read(readme,nml=args,iostat=ios,iomsg=message)
      endif
      if(ios.ne.0)then
         write(*,'("ERROR:",i0,1x,a)')ios, trim(message)
         call print_dictionary()
         stop 1
      endif
      ! all done cracking the command line
   end subroutine get_args
end program short