Aufgabe 11

PROGRAM D_06
 CHARACTER*30 :: file, wort*80, zahl
 INTEGER      :: anzahl
 LOGICAL      :: exist

INTERFACE
 SUBROUTINE zaehlen (file, wort, wieoft, teil)
  IMPLICIT NONE
  CHARACTER(LEN=*)     :: file, wort
  INTEGER, INTENT(OUT) :: wieoft
  LOGICAL, OPTIONAL    :: teil
 END SUBROUTINE
END INTERFACE

 DO
  WRITE (*,'(A)',ADVANCE='NO') 'Geben Sie den Filenamen an: '
  READ (*,'(A)',IOSTAT=iostat) file
  IF (iostat == 0) THEN
   INQUIRE (FILE=file,EXIST=exist)
   IF (exist) EXIT
  ELSE IF (iostat < 0) THEN
   STOP
  ENDIF
 ENDDO
 DO 
  WRITE (*,'(A)',ADVANCE='NO') 'Geben Sie das Wort ein: '
  READ (*,'(A)',IOSTAT=iostat) wort
  IF (iostat == 0) EXIT
 END DO

 CALL zaehlen (file,TRIM(ADJUSTL(wort)),anzahl)
 WRITE (Zahl,*) anzahl
 WRITE (*,'(A)') 'Das Wort kommt '//TRIM(ADJUSTL(zahl))//' mal vor!'
 STOP
END PROGRAM D_06

SUBROUTINE zaehlen (file, wort, wieoft, teil)
!-------------------------------------------------------------------------------
! stellt fest, wie oft ein bestimmtes Wort in einem File	vorkommt
!-------------------------------------------------------------------------------
 IMPLICIT NONE                                   ! sicher ist sicher
                                                 !
 CHARACTER(LEN=*)     :: file, wort              ! Filename und Suchwort
 INTEGER, INTENT(OUT) :: wieoft                  ! wieoft kommt das Wort vor 
 LOGICAL, OPTIONAL    :: teil                    ! suchen auch nach Wortteilen?
                                                 !
!------------------------ lokale Variable --------------------------------------
                                                 !
 CHARACTER*80         :: zeile                   ! eine Zeile (und damit auch
 LOGICAL              :: exist, akt_teil         ! ein Wort) kann maximal 80 
 INTEGER              :: iostat, j, k            ! Zeichen lang sein.
                                                 !
!---------------------- Fehlerabfrage ------------------------------------------
                                                 !
 INQUIRE (FILE=file, EXIST=exist)                ! Abfrage auf File
 IF (.NOT. exist) STOP 'File existiert nicht!'   ! Abbruch
 wort = ADJUSTL(wort)                            ! loesche f. Leerzeichen
 wieoft = 0                                      !
 OPEN (10, FILE=file, POSITION='REWIND')         ! Oeffnen des Files
 DO                                              !
  READ (10,'(a)',IOSTAT=iostat) zeile            ! Lies naechste Zeile
  IF (iostat < 0) EXIT                           ! Fileende (EOF)
  zeile = ADJUSTL(zeile)                         !
  DO                                             !
   j = INDEX(zeile, TRIM(wort))                  ! suche nach wort (ohne nachf.
   k = j+LEN_TRIM(wort)-1
   IF (akt_teil) THEN                            !
    IF (j > 0) THEN                              ! Leerzeichen
     zeile(j:k) = ' '                            ! loesche wort aus Zeile
     wieoft = wieoft+1                           ! erhoehe Anzahl
     CYCLE
    ENDIF
   ELSE
    IF (((j==1).AND.(LEN(zeile)==LEN(wort))) &   ! nur dieses Wort in der Zeile
   .OR. ((j==1).AND.(zeile(k+1:k+1)==' '))   &   ! Wort am Zeilenanfang
   .OR. ((k==LEN(zeile)).AND.(zeile(j-1:j-1)==' ')) & ! Zeilenende
   .OR. ((zeile(k+1:k+1)==' ').AND.(zeile(j-1:j-1)==' '))) THEN
     zeile(j:k) = ' '                            ! loesche wort aus Zeile
     wieoft = wieoft+1                           ! erhoehe Anzahl
    ELSE
     zeile(j:k) = ' '                            ! loesche teilwort aus Zeile
    ENDIF
    IF (j > 0) CYCLE
   ENDIF
   EXIT
  END DO
 ENDDO
 CLOSE (10)
END SUBROUTINE zaehlen