PROGRAM Text_Editor
!-----------------------------------------------------------------------
! Program to perform some basic text-editing functions on lines of
! text.  The basic operation is replacing a substring of the text
! with another string.  This replacement is accomplished by a command
! of the form
!                    oldstring/newstring/
! where oldstring specifies the substring in the text to be replaced
! with newstring; newstring may be an empty string, which then causes
! oldstring (if found) to be deleted.  The text lines are read from a
! file, and after editing, the edited lines are written to another
! file.  Identifiers used are:
!   InputFile  : name of the input file
!   OutputFile : name of the output file
!   EndOfFile  : end-of-file indicator
!   TextLine   : a character string representing a line of text
!   Length     : length of text line (constant
!   Change     : a character string specifying the edit operation
!                Value is of the form:
!                         "oldstring/newstring/"
!   Response   : user response (Y or N)
!
! Input (keyboard):  InputFile, OutputFile, TextLine, Change, Response
! Output (screen):   User prompts, TextLine
! Input (file):      Lines of text
! Output (file):     Edited lines of text
!-----------------------------------------------------------------------

  IMPLICIT NONE
  INTEGER, PARAMETER :: Length = 70
  CHARACTER(Length) :: TextLine, Change
  CHARACTER(20) :: InputFile, OutputFile
  CHARACTER(1) :: Response
  INTEGER :: EndOfFile

  ! Get names of input and output files and open the files
  WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter the name of the input file: "
  READ *, InputFile
  WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter the name of the output file: "
  READ *, OutputFile
  OPEN (UNIT = 15, FILE = InputFile, STATUS = "OLD")
  OPEN (UNIT = 16, FILE = OutputFile, STATUS = "NEW")

  ! While there is more data, read a line of text and edit it
  DO
     READ (15, "(A)", IOSTAT = EndOfFile) TextLine
     IF (EndOfFile < 0) EXIT
     ! If end of file reached, stop text editing

     ! Otherwise continue with the following


     PRINT *
     PRINT *, TextLine

     DO
        WRITE (*, '(1X, A)', ADVANCE = "NO") "Edit this line (Y OR N)? "
        READ *, Response
        IF (Response == "N") EXIT
        ! No editing needed -- terminate loop

        ! Otherwise  get editing change, modify the
        ! line of text, and display the edited line
        PRINT *, "Enter edit change:"
        READ '(A)', Change
        CALL Edit(TextLine, Change)
        PRINT *, TextLine
     END DO

     ! Write the edited line to the output file
     WRITE (16, *) TextLine
  END DO

  CLOSE(15)
  CLOSE(16)
  STOP

CONTAINS

  !-Edit------------------------------------------------------------------
  ! Subroutine to edit a line of TextLine by replacing a substring of the
  ! text by another string as specified by the command Change, which has
  ! the form
  !                    oldstring/newstring/
  ! newstring (which may be empty) replaces the first occurrence of
  ! oldstring in TextLine.  Local identifiers used are:
  !   FirstSlash          : position of first slash (/) in Change
  !   SecondSlash         : position of second slash (/) in Change
  !   OldString           : old string -- to be replaced
  !   OldLength           : actual length of OldString
  !   NewString           : new replacement string
  !   NewLength           : actual length of NewString
  !   Index_of_OldString  : index of old string in TextLine
  !
  ! Accepts:  TextLine, Change
  ! Returns:  TextLine (modified)
  !-----------------------------------------------------------------------

  SUBROUTINE Edit(TextLine, Change)

    CHARACTER(Length), INTENT(IN OUT) :: TextLine
    CHARACTER(Length), INTENT(IN) :: Change
    INTEGER :: FirstSlash, SecondSlash, OldLength, &
               Index_of_OldString
    CHARACTER(Length) :: OldString, NewString

    ! Attempt to locate slash delimiters in Change
    FirstSlash = INDEX(Change, "/")
    SecondSlash = INDEX(Change, "/", .TRUE.)
    IF (FirstSlash == 0 .OR. SecondSlash == FirstSlash) THEN
       PRINT *, "Missing slash"
       RETURN
    END IF

    ! Slashes were found, so continue with editing
    ! First extract OldString and NewString from Change, and locate
    ! OldString in TextLine

    OldLength = FirstSlash - 1
    OldString = Change( : OldLength)
    NewString = Change(FirstSlash + 1: SecondSlash - 1)
    Index_of_OldString = INDEX(TextLine, TRIM(OldString))
    IF (Index_of_OldString > 0) THEN
       TextLine = TextLine( : Index_of_OldString - 1) // &
               TRIM(NewString) // TextLine(Index_of_OldString + OldLength : )
    END IF
  RETURN

  END SUBROUTINE Edit

END PROGRAM Text_Editor