delim Subroutine

public subroutine delim(line, array, n, icount, ibegin, iterm, lgth, dlim)

NAME

  delim(3f) - [M_strings:TOKENS] parse a string and store tokens into
  an array
  (LICENSE:PD)

SYNOPSIS

subroutine delim(line,array,n,icount,ibegin,iterm,lgth,dlim)

 character(len=*),intent(in)  :: line
 integer,integer(in)          :: n
 integer,intent(out)          :: icount
 character(len=*)             :: array(n)
 integer,intent(out)          :: ibegin(n)
 integer,intent(out)          :: iterm(n)
 integer,intent(out)          :: lgth
 character(len=*)             :: dlim

DESCRIPTION

  Given a LINE of structure " par1 par2 par3 ... parn "
  store each par(n) into a separate variable in ARRAY (UNLESS
  ARRAY(1) == '#N#')

  Also set ICOUNT to number of elements of array initialized, and
  return beginning and ending positions for each element in IBEGIN(N)
  and ITERM(N).

  Return position of last non-blank character (even if more
  than N elements were found) in lgth

  No quoting or escaping of delimiter is allowed, so the delimiter
  character can not be placed in a token.

  No checking for more than N parameters; If any more they are ignored.

OPTIONS

LINE      input string to parse into tokens
ARRAY(N)  array that receives tokens
N         size of arrays ARRAY, IBEGIN, ITERM
ICOUNT    number of tokens found
IBEGIN(N) starting columns of tokens found
ITERM(N)  ending columns of tokens found
LGTH      position of last non-blank character in input string LINE
DLIM      delimiter characters

EXAMPLES

Sample program:

 program demo_delim

 use M_strings, only: delim
 implicit none
 character(len=80) :: line
 character(len=80) :: dlm
 integer,parameter :: n=10
 character(len=20) :: array(n)=' '
 integer           :: ibegin(n),iterm(n)
 integer           :: i20, icount, lgth, i10
 line=' first  second 10.3 words_of_stuff  '
 do i20=1,4
    ! change delimiter list and what is calculated or parsed
    if(i20 == 1)dlm=' '
    if(i20 == 2)dlm='o'
    if(i20 == 3)dlm=' aeiou'    ! NOTE SPACE IS FIRST
    if(i20 == 3)ARRAY(1)='#N#'  ! QUIT RETURNING STRING ARRAY
    if(i20 == 4)line='AAAaBBBBBBbIIIIIi  J K L'

    ! write out a break line composed of =========== ..
    write(*,'(57("="))')
    ! show line being parsed
    write(*,'(a)')'PARSING=['//trim(line)//'] on '//trim(dlm)
    ! call parsing procedure
    call delim(line,array,n,icount,ibegin,iterm,lgth,dlm)
    write(*,*)'number of tokens found=',icount
    write(*,*)'last character in column ',lgth
    if(icount > 0)then
       if(lgth /= iterm(icount))then
          write(*,*)'ignored from column ',iterm(icount)+1,' to ',lgth
       endif
       do i10=1,icount
          ! check flag to see if ARRAY() was set
          if(array(1) /= '#N#')then
             ! from returned array
             write(*,'(a,a,a)',advance='no')&
             &'[',array(i10)(:iterm(i10)-ibegin(i10)+1),']'
          endif
       enddo
       ! using start and end positions in IBEGIN() and ITERM()
       write(*,*)
       do i10=1,icount
          ! from positions in original line
          write(*,'(a,a,a)',advance='no')&
          &'[',line(ibegin(i10):iterm(i10)),']'
       enddo
       write(*,*)
    endif
 enddo
 end program demo_delim

Results:

=========================================================
PARSING=[ first  second 10.3 words_of_stuff] on
 number of tokens found=           4
 last character in column           34
[first][second][10.3][words_of_stuff]
[first][second][10.3][words_of_stuff]
=========================================================
PARSING=[ first  second 10.3 words_of_stuff] on o
 number of tokens found=           4
 last character in column           34
[ first  sec][nd 10.3 w][rds_][f_stuff]
[ first  sec][nd 10.3 w][rds_][f_stuff]
=========================================================
PARSING=[ first  second 10.3 words_of_stuff] on  aeiou
 number of tokens found=          10
 last character in column           34

[f][rst][s][c][nd][10.3][w][rds_][f_st][ff]
=========================================================
PARSING=[AAAaBBBBBBbIIIIIi  J K L] on  aeiou
 number of tokens found=           5
 last character in column           24

[AAA][BBBBBBbIIIII][J][K][L]

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
character(len=*) :: array(n)
integer, intent(in) :: n
integer, intent(out) :: icount
integer, intent(out) :: ibegin(n)
integer, intent(out) :: iterm(n)
integer, intent(out) :: lgth
character(len=*), intent(in) :: dlim

Contents

Source Code


Source Code

subroutine delim(line,array,n,icount,ibegin,iterm,lgth,dlim)

! ident_10="@(#) M_strings delim(3f) parse a string and store tokens into an array"

!
!     given a line of structure " par1 par2 par3 ... parn "
!     store each par(n) into a separate variable in array.
!
!     IF ARRAY(1) == '#N#' do not store into string array  (KLUDGE))
!
!     also count number of elements of array initialized, and
!     return beginning and ending positions for each element.
!     also return position of last non-blank character (even if more
!     than n elements were found).
!
!     no quoting of delimiter is allowed
!     no checking for more than n parameters, if any more they are ignored
!
character(len=*),intent(in)    :: line
integer,intent(in)             :: n
character(len=*)               :: array(n)
integer,intent(out)            :: icount
integer,intent(out)            :: ibegin(n)
integer,intent(out)            :: iterm(n)
integer,intent(out)            :: lgth
character(len=*),intent(in)    :: dlim
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=len(line)):: line_local
logical             :: lstore
integer             :: i10
integer             :: iarray
integer             :: icol
integer             :: idlim
integer             :: iend
integer             :: ifound
integer             :: istart
!-----------------------------------------------------------------------------------------------------------------------------------
      icount=0
      lgth=len_trim(line)
      line_local=line

      idlim=len(dlim)
      if(idlim > 5)then
         idlim=len_trim(dlim)      ! dlim a lot of blanks on some machines if dlim is a big string
         if(idlim == 0)then
            idlim=1     ! blank string
         endif
      endif

      if(lgth == 0)then                                        ! command was totally blank
         return
      endif
!
!     there is at least one non-blank character in the command
!     lgth is the column position of the last non-blank character
!     find next non-delimiter
      icol=1

      if(array(1) == '#N#')then                                ! special flag to not store into character array
         lstore=.false.
      else
         lstore=.true.
      endif

      do iarray=1,n,1                                          ! store into each array element until done or too many words
         NOINCREMENT: do
            if(index(dlim(1:idlim),line_local(icol:icol)) == 0)then  ! if current character is not a delimiter
               istart=icol                                     ! start new token on the non-delimiter character
               ibegin(iarray)=icol
               iend=lgth-istart+1+1                            ! assume no delimiters so put past end of line
               do i10=1,idlim
                  ifound=index(line_local(istart:lgth),dlim(i10:i10))
                  if(ifound > 0)then
                     iend=min(iend,ifound)
                  endif
               enddo
               if(iend <= 0)then                               ! no remaining delimiters
                 iterm(iarray)=lgth
                 if(lstore)then
                    array(iarray)=line_local(istart:lgth)
                 endif
                 icount=iarray
                 return
               else
                 iend=iend+istart-2
                 iterm(iarray)=iend
                 if(lstore)then
                    array(iarray)=line_local(istart:iend)
                 endif
               endif
               icol=iend+2
               exit NOINCREMENT
            endif
            icol=icol+1
         enddo NOINCREMENT
!        last character in line was a delimiter, so no text left
!        (should not happen where blank=delimiter)
         if(icol > lgth)then
           icount=iarray
           if( (iterm(icount)-ibegin(icount)) < 0)then         ! last token was all delimiters
              icount=icount-1
           endif
           return
         endif
      enddo
      icount=n  ! more than n elements
end subroutine delim