    module command_line_support
! COMMAND_LINE_SUPPORT - support routines for parsing command-line options,
! filename manipulation, and miscellaneous run-time support.
    contains
!----------------------
    subroutine program_exit(code)
!  PROGRAM_EXIT - halt the program and return CODE to the shell.
!  If absent, CODE defaults to 0.
!
    integer,intent(in),optional::code
!
    integer::retcode
!
    if(present(code)) then
       retcode=code
    else
       retcode=0
    endif
    call exit(retcode)  ! nonstandard call
    end subroutine program_exit
!----------------------
    subroutine numeric_filename(template,repl,ival,fn)
!  NUMERIC_FILENAME - given a template, a replacement text, and
!  an integer value, return a new name that is the template with the 
!  first occurrence of the replacement text in the template
!  replaced by the decimal representation of the integer.
!  Example:  numeric_filename('myfile.%n','%n',3,fn) returns fn as 'myfile.3'.
!  Example:  if you just want to suffix the template with the numerical
!  value, use a blank replacement text: numeric_filename(template,' ',ival,fn).
!  (This assumes that the filename contains no significant embedded blanks.)
!  Caveats:
!  - The decimal integer representation does NOT contain leading zeros.
!  - The template must be sufficiently long to accommodate
!  the substitution of the integer value without discarding nonblank
!  characters.
!  - If the replacement text isn't found in the template, the template
!  string itself is returned with the decimal representation of ival
!  appended.
!
    implicit none
    character(*),intent(in)::template,repl
    integer,intent(in)::ival
    character(*),intent(out)::fn
!
!  Local variables
!
    integer::lenr,istart,leni
    character(10)::aval
!
!  Find the location of the replaceable text (which may contain blanks)
!  in the template.  If the text isn't there, then return the template.
!  
    lenr=len(repl)   ! may contain blanks
    write(aval,'(i10)') ival
    call no_leading_blanks(aval)
    istart=index(template,repl)   
    if(istart.eq.0) then       ! repl not in template; append value
       fn=trim(template)//aval
    else                       ! replace repl with ival
       fn=template(1:istart-1)//trim(aval)//template(istart+lenr:)
    endif
    return
    end subroutine numeric_filename
!----------------------
    subroutine no_leading_blanks(s)
!  NO_LEADING_BLANKS - modify the string S so it contains no leading blanks.
!
    implicit none
    character(*),intent(inout)::s
!
    integer::j,k,n 
!
    n=len(s)
    k=0
    do j=1,n  ! put number of leading blanks into k
       if(s(j:j).eq.' ') then
          k=k+1
       else
          exit
       endif
    enddo
    if(k.gt.0.and.k.lt.n) then
       s(1:n-k)=s(k+1:n)
       s(n-k+1:n)=' '
    endif
    return
    end subroutine no_leading_blanks
!------------------------------------
    subroutine getopt(iopt,optarg,optind,control)
!  GETOPT - parse an execute line for options and their arguments.
!  Designed for one sequence of consecutive calls to parse the command line.
!  This is designed to have similar functionality to the Posix standard
!  getopt.
!  IOPT    := when positive, the integer such that CHAR(IOPT) is the option 
!                letter; -1 indicates the end of the option list.
!                If an option is found that is not in the control string,
!                IOPT is set such that CHAR(IOPT) is '?'.
!  OPTARG  := character string set to the corresponding argument of the
!                option, if any.
!  OPTIND  := Set to the index of the next unexamined argument.
!  CONTROL  : control string containing the list of all valid options.
!                Option letters which take arguments are followed by a colon.
!                (See getopt(3c)).
!
    integer,parameter::ARGLEN=128,STDERR=0
    integer,intent(out)::iopt,optind
    character(*),intent(out)::optarg
    character(*),intent(in)::control
!
!  Local variables
!
    integer::idx,numarg
    character(ARGLEN)::arg
    character::unk
    integer,save::argnum=1,argidx=2
    integer,external::iargc
    external getarg
!
!  ARGNUM is the number of the argument (as a consecutive word) to fetch
!  in the next call.  ARGIDX is the index within an argument to check for
!  an option letter.  Both must be properly set before the call proceeds.
!  Check for end of options.
!
    numarg=iargc()
    if(argnum.gt.numarg) goto 90
    call getarg(argnum,arg)
    if(arg(1:1).ne.'-') goto 90
    if(arg(1:2).eq.'--') then
       argnum=argnum+1
       goto 90
    endif
!
!  Find position of option letter in control string.  0 means it's not
!  there, so it's not valid.
!
    idx=index(control,arg(argidx:argidx))
    if(idx.eq.0) then
       iopt=ichar('?')
       unk=arg(argidx:argidx)
       call getarg(0,arg)
       write(STDERR,910) trim(arg),unk
       argidx=argidx+1
       if(arg(argidx:argidx).eq.' ') then
          argnum=argnum+1
          argidx=2
       endif
    else
       iopt=ichar(arg(argidx:argidx))
       argidx=argidx+1
!
!  Get option argument, which may or may not be separated from the
!  option by a blank.
!
       idx=idx+1
       if(control(idx:idx).eq.':') then
          if(arg(argidx:argidx).ne.' ') then
             optarg=arg(argidx:ARGLEN)
          else
             argnum=argnum+1
             if(argnum.gt.numarg) then
                optarg=' '
                unk=arg(argidx-1:argidx-1)
                call getarg(0,arg)
                write(STDERR,900) trim(arg),unk
             else
                call getarg(argnum,optarg)
             endif
          endif
          argnum=argnum+1
          argidx=2
!
!  No option for argument - check if next option is appended to same string.
!
       else 
          if(arg(argidx:argidx).eq.' ') then
             argidx=2
             argnum=argnum+1
          endif
          optarg=' '
       endif
    endif
    optind=argnum
    return
!
!  Out of options
!
 90 continue
    iopt=-1
    optind=argnum
    optarg=' '
    return
!
  900 format(a,': option ',a1,' requires an argument')
  910 format(a,': unknown option ',a1)
    end subroutine getopt
!------------------------------------
     subroutine getsubopt(string,list,n,status,value,parse_err)
!  GETSUBOPT: like XPG4 version in C.
!  Given an option string like abc=3,def=4, decompose the string
!  into name, value pairs as follows:
!  STRING:=:  contains the string to be parsed.  On return, contains
!    only the unparsed bits, corresponding to unmatched options, if any.
!  LIST  : holds a list of potential options
!  N     : length of list
!  STATUS:= logical array of length N.  Set to .true. if corresponding
!           option is found.
!  VALUES := Kth element is set to matching value, if any is found,
!           of corresponding option.  If there is no corresponding
!           value, then the entry is set to 0.
!  LIMITATIONS:
!  If one suboption is an initial substring of another, then the shorter
!  option must appear first in any argument string.
!  EXAMPLE:  suppose that list(1)="abc"
!  and list(2)="abcdef".  The string abc=1,abcdef=2 is parsed correctly,
!  but abcdef=2,abc=1 is not.
!  Therefore, in production code, it is best to avoid suboptions such
!  that one is a leading substring of another.
!
    implicit none
    integer,intent(in)::n
    character(*),intent(in)::list(n)
    character(*),intent(inout)::string
    logical,intent(out)::status(n),parse_err
    integer,intent(out)::value(n)
!
!  Local variables
!
    integer::k,istart,iend,icom,optend,ios,lenstring
    character(len(string))::valstr
!
    parse_err=.false.
    status=.false.
    value=0
    lenstring=len_trim(string)
    do k=1,n
       valstr=' '
       call delimit(trim(list(k)),string,istart,iend)
       if(istart.gt.0) then
          if(iend.lt.lenstring) then    ! look for possible subopt=valstr
             if(string(iend+1:iend+1).eq.'=') then
                icom=index(string(iend+1:),',')
                if(icom.eq.1) then      ! have subopt=,
                   optend=iend+2
                   valstr=' '
                   parse_err=.true.
                else if(iend+1.eq.lenstring) then ! have subopt= at end
                   optend=iend+1
                   valstr=' '
                   parse_err=.true.
                else if(icom.eq.0) then    ! subopt=valstr lies at end
                   optend=lenstring
                   valstr=string(iend+2:optend)
                else
                   optend=iend+icom
                   valstr=string(iend+2:optend-1)
                endif
             else       ! no = after subopt
                icom=index(string(iend+1:),',')
                optend=iend+icom
             endif
          else
             optend=iend
          endif
          status(k)=.true.
          if(len_trim(valstr).gt.0) then
             read(valstr,*,iostat=ios) value(k)
             if(ios.ne.0) then
                parse_err=.true.
                value(k)=0.0
             endif
          else
             value(k)=0.0
          endif
          string(istart:)=string(optend+1:)
       endif
    enddo
   !
   ! If anything is unparsed, then there are extra options not in LIST.
   ! Note: previous version replaced istart:optend with blanks instead
   ! of moving down the contents of string each time.  That was a hazard
   ! as it didn't always identify . instead of , as separator.  If .
   ! was used accidentally, there was a possibility that all subsequent
   ! values after the . would be erased.  This version sometimes accepts
   ! . instead of , but its presence is harmless if it isn't detected -
   ! usually it is, and parse_err is set, depending on the order in which
   ! the options are tested.
   !
    if(len_trim(string).gt.0) parse_err=.true.
    return
    contains
      !
      ! DELIMIT checks whether sym is a substring of another possible
      ! symbol.  If sym doesn't exist in str, then ISTART=0.
      ! Otherwise, ISTART and IEND delimit the starting and ending
      ! indices, respectively, of SYM.  The remaining code needs to check
      ! whether etring(iend+1) is an '=' or ',' as appropriate.
      !
       subroutine delimit(sym,str,istart,iend)
       implicit none
       character(*),intent(in)::sym,str
       integer,intent(out)::istart,iend
       !
       integer::j,m,lensym,lenstr
       !
       lensym=len_trim(sym)
       lenstr=len_trim(str)
       istart=0
       j=1
       do while(j.le.lenstr)
          m=index(str(j:),sym)-1
          if(m.lt.0) then         ! sym does not exist in str
             istart=0
             exit
          else if(m.eq.0) then    ! sym is an initial substring
             istart=j
          else                    ! sym may be an initial substring; check
             istart=j+m
             if(index('=, ',str(istart-1:istart-1)).eq.0) then
                j=istart          ! it's not; look further on in str
                cycle
             endif
          endif
          iend=istart+lensym      ! 1 past tentative end of symbol
          if(iend.eq.lenstr+1) then  ! it's at end, so it matches
             iend=iend-1
             exit
          else if(index('=, ',str(iend:iend)).eq.0) then  ! just a substring
             j=istart+lensym
             cycle
          else       ! we have a match; don't include trailing =
             iend=iend-1
             exit
          endif
       enddo
       if(j.gt.lenstr) istart=0
       return 
       end subroutine delimit
    end subroutine getsubopt
!------------------------------------
    end module command_line_support
