pure function split(input_line, delimiters, order, nulls) result(array)
!-----------------------------------------------------------------------------------------------------------------------------------
! ident_8="@(#) M_strings split(3f) parse string on delimiter characters and store tokens into an allocatable array"
! John S. Urban
!-----------------------------------------------------------------------------------------------------------------------------------
intrinsic index, min, present, len
!-----------------------------------------------------------------------------------------------------------------------------------
! given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array.
! o by default adjacent delimiters in the input string do not create an empty string in the output array
! o no quoting of delimiters is supported
character(len=*), intent(in) :: input_line ! input string to tokenize
character(len=*), optional, intent(in) :: delimiters ! list of delimiter characters
character(len=*), optional, intent(in) :: order ! order of output array sequential|[reverse|right]
character(len=*), optional, intent(in) :: nulls ! return strings composed of delimiters or not ignore|return|ignoreend
character(len=:), allocatable :: array(:) ! output array of tokens
!-----------------------------------------------------------------------------------------------------------------------------------
integer :: n ! max number of strings INPUT_LINE could split into if all delimiter
integer, allocatable :: ibegin(:) ! positions in input string where tokens start
integer, allocatable :: iterm(:) ! positions in input string where tokens end
character(len=:), allocatable :: dlim ! string containing delimiter characters
character(len=:), allocatable :: ordr ! string containing order keyword
character(len=:), allocatable :: nlls ! string containing nulls keyword
integer :: ii, iiii ! loop parameters used to control print order
integer :: icount ! number of tokens found
integer :: lgth ! length of input string with trailing spaces trimmed
integer :: i10, i20, i30 ! loop counters
integer :: icol ! pointer into input string as it is being parsed
integer :: idlim ! number of delimiter characters
integer :: ifound ! where next delimiter character is found in remaining input string data
integer :: inotnull ! count strings not composed of delimiters
integer :: ireturn ! number of tokens returned
integer :: imax ! length of longest token
!-----------------------------------------------------------------------------------------------------------------------------------
! decide on value for optional DELIMITERS parameter
if (present(delimiters)) then ! optional delimiter list was present
if (delimiters /= '') then ! if DELIMITERS was specified and not null use it
dlim = delimiters
else ! DELIMITERS was specified on call as empty string
dlim = ' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified
end if
else ! no delimiter value was specified
dlim = ' '//char(9)//char(10)//char(11)//char(12)//char(13)//char(0) ! use default delimiter when not specified
end if
idlim = len(dlim) ! dlim a lot of blanks on some machines if dlim is a big string
!-----------------------------------------------------------------------------------------------------------------------------------
if (present(order)) then; ordr = lower(adjustl(order)); else; ordr = 'sequential'; end if ! decide on value for optional ORDER parameter
if (present(nulls)) then; nlls = lower(adjustl(nulls)); else; nlls = 'ignore'; end if ! optional parameter
!-----------------------------------------------------------------------------------------------------------------------------------
n = len(input_line) + 1 ! max number of strings INPUT_LINE could split into if all delimiter
if (allocated(ibegin)) deallocate (ibegin) !x! intel compiler says allocated already ?
if (allocated(iterm)) deallocate (iterm) !x! intel compiler says allocated already ?
allocate (ibegin(n)) ! allocate enough space to hold starting location of tokens if string all tokens
allocate (iterm(n)) ! allocate enough space to hold ending location of tokens if string all tokens
ibegin(:) = 1
iterm(:) = 1
!-----------------------------------------------------------------------------------------------------------------------------------
lgth = len(input_line) ! lgth is the column position of the last non-blank character
icount = 0 ! how many tokens found
inotnull = 0 ! how many tokens found not composed of delimiters
imax = 0 ! length of longest token found
!-----------------------------------------------------------------------------------------------------------------------------------
if (lgth > 0) then ! there is at least one non-delimiter in INPUT_LINE if get here
icol = 1 ! initialize pointer into input line
INFINITE: do i30 = 1, lgth, 1 ! store into each array element
ibegin(i30) = icol ! assume start new token on the character
if (index(dlim(1:idlim), input_line(icol:icol)) == 0) then ! if current character is not a delimiter
iterm(i30) = lgth ! initially assume no more tokens
do i10 = 1, idlim ! search for next delimiter
ifound = index(input_line(ibegin(i30):lgth), dlim(i10:i10))
IF (ifound > 0) then
iterm(i30) = min(iterm(i30), ifound + ibegin(i30) - 2)
end if
end do
icol = iterm(i30) + 2 ! next place to look as found end of this token
inotnull = inotnull + 1 ! increment count of number of tokens not composed of delimiters
else ! character is a delimiter for a null string
iterm(i30) = icol - 1 ! record assumed end of string. Will be less than beginning
icol = icol + 1 ! advance pointer into input string
end if
imax = max(imax, iterm(i30) - ibegin(i30) + 1)
icount = i30 ! increment count of number of tokens found
if (icol > lgth) then ! no text left
exit INFINITE
end if
end do INFINITE
end if
!-----------------------------------------------------------------------------------------------------------------------------------
select case (trim(adjustl(nlls)))
case ('ignore', '', 'ignoreend')
ireturn = inotnull
case default
ireturn = icount
end select
allocate (character(len=imax) :: array(ireturn)) ! allocate the array to return
!allocate(array(ireturn)) ! allocate the array to return
!-----------------------------------------------------------------------------------------------------------------------------------
select case (trim(adjustl(ordr))) ! decide which order to store tokens
case ('reverse', 'right'); ii = ireturn; iiii = -1 ! last to first
case default; ii = 1; iiii = 1 ! first to last
end select
!-----------------------------------------------------------------------------------------------------------------------------------
do i20 = 1, icount ! fill the array with the tokens that were found
if (iterm(i20) < ibegin(i20)) then
select case (trim(adjustl(nlls)))
case ('ignore', '', 'ignoreend')
case default
array(ii) = ' '
ii = ii + iiii
end select
else
array(ii) = input_line(ibegin(i20):iterm(i20))
ii = ii + iiii
end if
end do
!-----------------------------------------------------------------------------------------------------------------------------------
end function split