matching_delimiter Subroutine

public impure elemental subroutine matching_delimiter(str, ipos, imatch)

NAME

 matching_delimiter(3f) - [M_strings:QUOTES] find position of matching delimiter
 (LICENSE:PD)

SYNOPSIS

impure elemental subroutine matching_delimiter(str,ipos,imatch)

character(len=*),intent(in)  :: str
integer,intent(in)           :: ipos
integer,intent(out)          :: imatch

DESCRIPTION

Sets imatch to the position in string of the delimiter matching the
delimiter in position ipos. Allowable delimiters are (), [], {}, <>.

OPTIONS

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.

EXAMPLE

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

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
integer, intent(in) :: ipos
integer, intent(out) :: imatch

Contents

Source Code

matching_delimiter

Source Code

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