Initial data commit

Task/String-matching/Fortran/string-matching-2.f

@@ -0,0 +1,62 @@
+!-----------------------------------------------------------------------
+!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