Paul Tucker
Paul Tucker

Reputation: 45

Unclassifiable Statement at SUBROUTINE declaration inside a PROGRAM

So I've written a basic Vigenere Cypher in Fortran 90, however when I try to compile it, I am hammered with Unclassifiable Statement Errors due to my internal SUBROUTINES.

I have listed the variables used in each SUBROUTINE in '(' ')', but I am still getting back errors. I think it's a really simple fix, but I can't seem to find a solution to it.

Here is my code:

PROGRAM Assign_8

IMPLICIT NONE


CHARACTER*750 :: Input
CHARACTER*10 :: Key
CHARACTER*750 :: RepeatedKey
CHARACTER*750 :: Encrypted, Decrypted
LOGICAL :: Path
CHARACTER*10 :: Validation
INTEGER :: Reps, Encrypt, Decrypt, KeyInt, InputInt, MergeInt, UnmergeInt

WRITE(*,*) 'Do you wish to Encrypt or Decrypt a file?'

CALL Validation_Sub

SUBROUTINE Validation_Sub(Path, Validation)

IMPLICIT NONE

    READ(*,*) Validation

        SELECT CASE (Validation)

            CASE ('Encrypt' , 'encrypt')
                WRITE(*,*) 'You have selected to Encrypt a file.'
                Path = .TRUE.

            CASE ('Decrypt' , 'decrypt')
                WRITE(*,*) 'You have selected to Decrypt a file.'
                Path = .FALSE.

            CASE DEFAULT
                WRITE(*,*) 'Selection not valid please select to either Encrypt or Decrypt a file.'

                IF (Path .EQV. .TRUE.) THEN

                CALL Encrypt_Sub

                ELSE IF (Path .EQV. .FALSE.) THEN   

                CALL Decrypt_Sub

                END IF
            END SELECT
END SUBROUTINE

SUBROUTINE Encrypt_Sub(Input, Key, RepeatedKey, Encrypt, InputInt, KeyInt, MergeInt, Encrypted)

    IMPLICIT NONE

        OPEN(1,FILE='plaintext.txt')
        READ(1,'(A)') Input

        WRITE(*,*) 'Please Enter a Key Phrase of 10 Characters (Including Spaces and Punctuation)'
        READ(*,*) Key
        RepeatedKey = REPEAT(Key(1:10),75)

        DO Encrypt = 1, LEN_TRIM(Input)
            InputInt = IACHAR(Input(Encrypt:Encrypt))
            KeyInt = IACHAR(RepeatedKey(Encrypt:Encrypt))
            MergeInt = InputInt + (KeyInt - 32)

            IF (MergeInt > 126) THEN
                MergeInt = MergeInt - 94
            END IF

            Encrypted(Encrypt:Encrypt) = ACHAR(MergeInt)

        END DO

        OPEN(2,FILE='EncryptionTest.txt')
        WRITE(2,'(A)') Encrypted
        CLOSE(2)

END SUBROUTINE

SUBROUTINE Decrypt_Sub(Encrypted, Key, RepeatedKey, Decrypt, MergeInt, KeyInt, UnmergeInt, Decrypted)

    IMPLICIT NONE

        OPEN(1,FILE='EncryptionTest.txt')
        READ(1,'(A)') Encrypted
        CLOSE(1)

        WRITE(*,*) 'Please Enter Your Key Phrase'
        READ(*,'(A)') Key
        RepeatedKey = REPEAT(Key(1:10),75)

        DO Decrypt = 1, 750, 1
            MergeInt = IACHAR(Encrypted(Decrypt:Decrypt))
            KeyInt = IACHAR(RepeatedKey(Decrypt:Decrypt))
            UnmergeInt = MergeInt - (KeyInt - 32)

            IF (UnmergeInt < 32) THEN
                UnmergeInt = UnmergeInt + 94
            END IF

            Decrypted(Decrypt:Decrypt) = ACHAR(UnmergeInt)

    END DO      

    OPEN(2,FILE='DecryptionTest.txt')
    WRITE(2,'(A)') Decrypted
    CLOSE(2)

END SUBROUTINE

END PROGRAM Assign_8

And the specific errors I am getting back are:

SUBROUTINE Validation_Sub(Path, Validation)
1

>Unclassifiable Statement at (1)

(Spacer)

IMPLICIT NONE
             1

>Unexpected IMPLICIT NONE statement at (1)

I suspect the IMPLICIT NONE error is due to the SUBROUTINE not being defined properly.

END SUBROUTINE
   1

>Expecting END Program statement at (1)

As before, I suspect this is because the SUBROUTINE has not been defined.

These errors repeat themselves for:

SUBROUTINE Encrypt_Sub

&

SUBROUTINE Decrypt_Sub

Any help would be greatly appreciated, if anyone does spot any immediate errors within my Vigenere Cypher code itself it would also be greatly appreciated if you could point them out if its no trouble.

Upvotes: 3

Views: 2783

Answers (2)

You are missing CONTAINS before your subroutine.

In the future learn modules, but now use CONTAINS to make those subroutines properly internal to the main program.

So it should look like

PROGRAM Assign_8
  ...

  CALL Validation_Sub

CONTAINS

  SUBROUTINE Validation_Sub(Path, Validation)
  END SUBROUTINE

  ...

END PROGRAM Assign_8

Upvotes: 1

muddle
muddle

Reputation: 167

As well as "Contains" being missing from the top, there are several other little things. Your select case should end after the default case, with the if (Path.. outside of it. The default case should also stop the programme. You have also not closed one of your file units.

Here is code that I compiled with $ gfortran -Og -std=f95 -Wall test.f90

 PROGRAM Assign_8

  IMPLICIT NONE

  LOGICAL :: Path
  CHARACTER(LEN=10) :: Validation
  CHARACTER(LEN=750) :: Input
  CHARACTER(LEN=10) :: Key
  CHARACTER(LEN=750) :: RepeatedKey
  CHARACTER(LEN=750) :: Encrypted, Decrypted
  INTEGER :: Encrypt, Decrypt, KeyInt, InputInt, MergeInt, UnmergeInt

  WRITE(*,*) 'Do you wish to Encrypt or Decrypt a file?'

  CALL Validation_Sub

 CONTAINS

  SUBROUTINE Validation_Sub

    IMPLICIT NONE

    READ(*,*) Validation

    SELECT CASE (Validation)

    CASE ('Encrypt' , 'encrypt')
       WRITE(*,*) 'You have selected to Encrypt a file.'
       Path = .TRUE.

    CASE ('Decrypt' , 'decrypt')
       WRITE(*,*) 'You have selected to Decrypt a file.'
       Path = .FALSE.

    CASE DEFAULT
       WRITE(*,*) 'Selection not valid please select to either Encrypt or Decrypt a file.'
       stop
    end SELECT

    IF (Path .EQV. .TRUE.) THEN

       CALL Encrypt_Sub

    ELSE IF (Path .EQV. .FALSE.) THEN   

       CALL Decrypt_Sub

    END IF

  END SUBROUTINE Validation_Sub

  SUBROUTINE Encrypt_Sub

    IMPLICIT NONE

    OPEN(1,FILE='plaintext.txt')
    READ(1,'(A)') Input
    close(1)

    WRITE(*,*) 'Please Enter a Key Phrase of 10 Characters (Including  Spaces and Punctuation)'
    READ(*,*) Key
    RepeatedKey = REPEAT(Key,75)

    DO Encrypt = 1, LEN_TRIM(Input)
       InputInt = IACHAR(Input(Encrypt:Encrypt))
       KeyInt = IACHAR(RepeatedKey(Encrypt:Encrypt))
       MergeInt = InputInt + (KeyInt - 32)

       IF (MergeInt > 126) THEN
          MergeInt = MergeInt - 94
       END IF

       Encrypted(Encrypt:Encrypt) = ACHAR(MergeInt)

    END DO

    OPEN(2,FILE='EncryptionTest.txt')
    WRITE(2,'(A)') Encrypted
    CLOSE(2)

  END SUBROUTINE Encrypt_Sub

  SUBROUTINE Decrypt_Sub

    IMPLICIT NONE

    OPEN(1,FILE='EncryptionTest.txt')
    READ(1,'(A)') Encrypted
    CLOSE(1)

    WRITE(*,*) 'Please Enter Your Key Phrase'
    READ(*,'(A)') Key
    RepeatedKey = REPEAT(Key,75)

    DO Decrypt = 1, 750, 1
       MergeInt = IACHAR(Encrypted(Decrypt:Decrypt))
       KeyInt = IACHAR(RepeatedKey(Decrypt:Decrypt))
       UnmergeInt = MergeInt - (KeyInt - 32)

       IF (UnmergeInt < 32) THEN
          UnmergeInt = UnmergeInt + 94
       END IF

       Decrypted(Decrypt:Decrypt) = ACHAR(UnmergeInt)

    END DO

    OPEN(2,FILE='DecryptionTest.txt')
    WRITE(2,'(A)') Decrypted
    CLOSE(2)

  END SUBROUTINE Decrypt_Sub

END PROGRAM Assign_8

Upvotes: 1

Related Questions