delim(3f) - [M_strings:TOKENS] parse a string and store tokens into
an array
(LICENSE:PD)
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
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.
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
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]
John S. Urban
Public Domain
| Type | Intent | Optional | 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 |
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