Reputation:
I am trying to do the following in Fortran:
My loop seems to run indefinitely and no words are being written into the output documents
My test input document is just 2 lines:
The first line is being read and encoded correctly
PROGRAM zeichen
USE PufferMod
IMPLICIT NONE
CHARACTER(LEN=132) :: z
CHARACTER(maxlen):: x
INTEGER:: a,e,i,l
OPEN(UNIT=39,FILE="intext.txt",ACTION="READ", STATUS="OLD")
OPEN(UNIT=40, FILE="outext.txt", ACTION="WRITE")
DO
2 READ(39,"(A)", end=10) z
a=1;
DO WHILE(a<133)
WRITE(*,*) z
WRITE(*,*) a
CALL Suche_Wort(z,a,e)
l=e-a+1
WRITE(*,*) a,e,l
DO i=a,e
IF(z(i:i)/="") THEN
CALL Codiere(z(i:i),l)
END IF
END DO
a=e+1
END DO
WRITE(40,*) z
END DO
10 CLOSE(UNIT=39)
CLOSE(UNIT=40)
END PROGRAM zeichen
MODULE PufferMod
IMPLICIT NONE
PRIVATE
PUBLIC :: maxlen, Codiere, Suche_Wort
INTEGER, PARAMETER :: maxlen = 132
CONTAINS
FUNCTION Kleinbuchstabe(z)
CHARACTER(LEN=1) :: z
LOGICAL :: Kleinbuchstabe
Kleinbuchstabe= "a" <= z .AND. z <= "z"
END FUNCTION Kleinbuchstabe
FUNCTION Grossbuchstabe(z)
CHARACTER(LEN=1) :: z
LOGICAL :: Grossbuchstabe
Grossbuchstabe= "A" <= z .AND. z <= "Z"
END FUNCTION Grossbuchstabe
FUNCTION Buchstabe(z)
CHARACTER(LEN=1) :: z
LOGICAL :: Buchstabe
Buchstabe= (("a" <= z .AND. z <= "z") .OR. ("A" <= z .AND. z <= "Z"))
END FUNCTION Buchstabe
SUBROUTINE Codiere(z, Verschiebung)
CHARACTER(LEN=1) :: z
INTEGER, INTENT(IN) :: Verschiebung
INTEGER :: CodevonA
IF ( Kleinbuchstabe(z) ) THEN
CodevonA= ICHAR("a")
ELSE IF ( Grossbuchstabe(z) ) THEN
CodevonA= ICHAR("A")
END IF
z= CHAR( CodevonA + MOD( ICHAR(z) - CodevonA + Verschiebung, 26 ) )
END SUBROUTINE Codiere
SUBROUTINE Suche_Wort(z,a,e)
CHARACTER(LEN=maxlen), INTENT(in):: z
INTEGER, INTENT(inout):: a
INTEGER, INTENT(out):: e
CHARACTER:: x, temp*1
INTEGER:: i
i=1
temp=z(a:a)
!WRITE(*,*) "a before loop",a, "temp", temp
DO WHILE(temp == " ") !Find start of next word
temp=z(a+i:a+i)
i=i+1
a=a+1
END DO
!WRITE(*,*) "a after loop", a
e=a+1
i=1
temp=z(e:e)
DO WHILE(temp/= "") !find where the word ends by finding a space
temp=z(e+i:e+i)
i=i+1
e=e+1
IF(temp == " ") EXIT
END DO
END SUBROUTINE Suche_Wort
END MODULE PufferMod
Upvotes: 0
Views: 280
Reputation: 203
Why do you need to consider words at all ? Just convert A:Z or a:z.
PROGRAM zeichen
CHARACTER(LEN=132) :: z
INTEGER :: iostat, Verschiebung = 1
OPEN (UNIT=39, FILE="ziechen.f90", ACTION="READ", STATUS="OLD")
OPEN (UNIT=40, FILE="outext.txt", STATUS="UNKNOWN")
DO
READ (39,fmt="(A)", iostat=iostat) z
if ( iostat /= 0 ) exit
call convert_line ( z, Verschiebung )
WRITE (40,fmt="(A)") trim (z)
WRITE ( *,fmt="(A)") trim (z)
END DO
END PROGRAM zeichen
Subroutine convert_line ( z, inc )
character*(*) z
integer inc, i
do i = 1, len_trim (z)
call convert_character ( z(i:i), inc )
end do
end Subroutine convert_line
Subroutine convert_character ( z, inc )
character z
integer inc, ia, ic
!
if ( z >= 'A' .and. z <= 'Z' ) then
ia = ichar ('A')
else if ( z >= 'a' .and. z <= 'z' ) then
ia = ichar ('a')
else
return
end if
ic = mod ( ichar (z) - ia + inc + 26, 26 )
z = char (ia + ic )
!
end Subroutine convert_character
Upvotes: 0
Reputation: 1123
Your Suche_Wort
subroutine has at least three issues:
It never checks if the indices of the z
variable are within bounds.
It assumes that the end index is strictly bigger than the start index, therefore not allowing for 1-character words.
In each of its loops, it increments by one both i
and the other integer variable (a
in the first loop, e
in the second loop), effectively incrementing the index of z by 2 in every iteration.
I would recommend applying two changes to the zeichen
program in order to get rid of the trailing spaces, by using the intrinsic functions trim
(remove trailing space) and len_trim
(compute length of the trimmed variable):
2 READ(39,"(A)", end=10) z
a=1;
DO WHILE(a<=len_trim(z))
WRITE(*,*) z
WRITE(*,*) a
CALL Suche_Wort(trim(z),a,e)
!...
Then, the checks and corrections can be added to the Suche_Wort
subroutine (more easily than if we had to worry about the possibility that all characters left in z(a:)
were spaces):
SUBROUTINE Suche_Wort(z,a,e)
CHARACTER(LEN=*), INTENT(in):: z ! Dummy argument has length of actual argument
INTEGER, INTENT(inout):: a
INTEGER, INTENT(out):: e
CHARACTER(len=1):: temp
temp=z(a:a)
DO WHILE((temp == " ").and.(a<len(z))) !Find start of next word
temp=z(a+1:a+1)
a=a+1
END DO
e=a ! Allows 1-character words
DO WHILE((temp/= " ").and.(e<len(z))) !find where the word ends by finding a space
temp=z(e+1:e+1)
e=e+1
END DO
END SUBROUTINE Suche_Wort
Upvotes: 1