matching_delimiter(3f) - [M_strings:QUOTES] find position of matching delimiter
(LICENSE:PD)
impure elemental subroutine matching_delimiter(str,ipos,imatch)
character(len=*),intent(in) :: str
integer,intent(in) :: ipos
integer,intent(out) :: imatch
Sets imatch to the position in string of the delimiter matching the
delimiter in position ipos. Allowable delimiters are (), [], {}, <>.
str input string to locate delimiter position in
ipos position of delimiter to find match for
imatch location of matching delimiter. If no match is found, zero (0)
is returned.
Sample program:
program demo_matching_delimiter
use M_strings, only : matching_delimiter
implicit none
character(len=128) :: str
integer :: imatch
str=' a [[[[b] and ] then ] finally ]'
write(*,*)'string=',str
call matching_delimiter(str,1,imatch)
write(*,*)'location=',imatch
call matching_delimiter(str,4,imatch)
write(*,*)'location=',imatch
call matching_delimiter(str,5,imatch)
write(*,*)'location=',imatch
call matching_delimiter(str,6,imatch)
write(*,*)'location=',imatch
call matching_delimiter(str,7,imatch)
write(*,*)'location=',imatch
call matching_delimiter(str,32,imatch)
write(*,*)'location=',imatch
end program demo_matching_delimiter
John S. Urban
Public Domain
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | str | |||
integer, | intent(in) | :: | ipos | |||
integer, | intent(out) | :: | imatch |
impure elemental subroutine matching_delimiter(str,ipos,imatch)
! Sets imatch to the position in string of the delimiter matching the delimiter
! in position ipos. Allowable delimiters are (), [], {}, <>.
! pedigree?
character(len=*),intent(in) :: str
integer,intent(in) :: ipos
integer,intent(out) :: imatch
character :: delim1,delim2,ch
integer :: lenstr
integer :: idelim2
integer :: istart, iend
integer :: inc
integer :: isum
integer :: i
imatch=0
lenstr=len_trim(str)
delim1=str(ipos:ipos)
select case(delim1)
case('(')
idelim2=iachar(delim1)+1
istart=ipos+1
iend=lenstr
inc=1
case(')')
idelim2=iachar(delim1)-1
istart=ipos-1
iend=1
inc=-1
case('[','{','<')
idelim2=iachar(delim1)+2
istart=ipos+1
iend=lenstr
inc=1
case(']','}','>')
idelim2=iachar(delim1)-2
istart=ipos-1
iend=1
inc=-1
case default
write(*,*) delim1,' is not a valid delimiter'
return
end select
if(istart < 1 .or. istart > lenstr) then
write(*,*) delim1,' has no matching delimiter'
return
endif
delim2=achar(idelim2) ! matching delimiter
isum=1
do i=istart,iend,inc
ch=str(i:i)
if(ch /= delim1 .and. ch /= delim2) cycle
if(ch == delim1) isum=isum+1
if(ch == delim2) isum=isum-1
if(isum == 0) exit
enddo
if(isum /= 0) then
write(*,*) delim1,' has no matching delimiter'
return
endif
imatch=i
end subroutine matching_delimiter