Initial data commit

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

@@ -0,0 +1,40 @@
+      SUBROUTINE STARTS(A,B)	!Text A starts with text B?
+       CHARACTER*(*) A,B
+        IF (INDEX(A,B).EQ.1) THEN	!Searches A to find B.
+          WRITE (6,*) ">",A,"< starts with >",B,"<"
+         ELSE
+          WRITE (6,*) ">",A,"< does not start with >",B,"<"
+        END IF
+      END SUBROUTINE STARTS
+
+      SUBROUTINE HAS(A,B)	!Text B appears somewhere in text A?
+       CHARACTER*(*) A,B
+       INTEGER L
+        L = INDEX(A,B)		!The first position in A where B matches.
+        IF (L.LE.0) THEN
+          WRITE (6,*) ">",A,"< does not contain >",B,"<"
+         ELSE
+          WRITE (6,*) ">",A,"< contains a >",B,"<, offset",L
+        END IF
+      END SUBROUTINE HAS
+
+      SUBROUTINE ENDS(A,B)	!Text A ends with text B.
+       CHARACTER*(*) A,B
+       INTEGER L
+        L = LEN(A) - LEN(B)	!Find the tail end of A that B might match.
+        IF (L.LT.0) THEN	!Dare not use an OR, because of full evaluation risks.
+          WRITE (6,*) ">",A,"< is too short to end with >",B,"<"	!Might as well have a special message.
+        ELSE IF (A(L + 1:L + LEN(B)).NE.B) THEN	!Otherwise, it is safe to look.
+          WRITE (6,*) ">",A,"< does not end with >",B,"<"
+        ELSE
+          WRITE (6,*) ">",A,"< ends with >",B,"<"
+        END IF
+      END SUBROUTINE ENDS
+
+      CALL STARTS("This","is")
+      CALL STARTS("Theory","The")
+      CALL HAS("Bananas","an")
+      CALL ENDS("Banana","an")
+      CALL ENDS("Banana","na")
+      CALL ENDS("Brief","Much longer")
+      END

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