63 lines
2.3 KiB
Fortran
63 lines
2.3 KiB
Fortran
!-----------------------------------------------------------------------
|
|
!Main program string_matching
|
|
!-----------------------------------------------------------------------
|
|
program string_matching
|
|
implicit none
|
|
character(len=*), parameter :: fmt= '(I0)'
|
|
write(*,fmt) starts("this","is")
|
|
write(*,fmt) starts("theory","the")
|
|
write(*,fmt) has("bananas","an")
|
|
write(*,fmt) ends("banana","an")
|
|
write(*,fmt) ends("banana","na")
|
|
write(*,fmt) ends("brief","much longer")
|
|
|
|
contains
|
|
! Determining if the first string starts with second string
|
|
function starts(string1, string2) result(answer)
|
|
implicit none
|
|
character(len=*), intent(in) :: string1
|
|
character(len=*), intent(in) :: string2
|
|
integer :: answer
|
|
answer = 0
|
|
if(len(string2)>len(string1)) return
|
|
if(string1(1:len(string2))==string2) answer = 1
|
|
end function starts
|
|
! Determining if the first string contains the second string at any location
|
|
function has(string1, string2) result(answer)
|
|
implicit none
|
|
character(len=*), intent(in) :: string1
|
|
character(len=*), intent(in) :: string2
|
|
character(len=:),allocatable :: temp
|
|
integer :: answer, add
|
|
character(len=*), parameter :: fmt= '(A6,X,I0)'
|
|
answer = 0
|
|
add = 0
|
|
if(len(string2)>len(string1)) return
|
|
answer = index(string1, string2)
|
|
if(answer==0) return
|
|
! Print the location of the match for part 2
|
|
write(*,fmt) " at ", answer
|
|
! Handle multiple occurrences of a string for part 2.
|
|
add = answer
|
|
temp = string1(answer+1:)
|
|
do while(answer>0)
|
|
answer = index(temp, string2)
|
|
add = add + answer
|
|
if(answer>0) write(*,fmt) " at ", add
|
|
! deallocate(temp)
|
|
temp = string1(add+1:) ! auto reallocation
|
|
enddo
|
|
answer = 1
|
|
end function has
|
|
! Determining if the first string ends with the second string
|
|
function ends(string1, string2) result(answer)
|
|
implicit none
|
|
character(len=*), intent(in) :: string1
|
|
character(len=*), intent(in) :: string2
|
|
integer :: answer
|
|
answer = 0
|
|
if(len(string2)>len(string1)) return
|
|
if(string1(len(string1)-len(string2)+1:)==string2) answer = 1
|
|
end function ends
|
|
end program string_matching
|