PROGRAM NXOR
IMPLICIT NONE
! Declare variables
REAL*8, DIMENSION(0:2,2) :: Weights, DWeights
REAL*8, PARAMETER :: V0 = 0.5, V1 = 0.5, V2 = 0.5
INTEGER :: I, J, K, Count = 0, MaxCount
REAL*8 :: ALpha, G, FPrime, Beta
INTEGER, DIMENSION(4,2) :: Train = 0
INTEGER, DIMENSION(4) :: Tar = 0, F
REAL*8, DIMENSION(2) :: H = 0.0, Z = 0.0
 CALL Setup() ! Call subroutine to set up weight arrays
 ! Open output files
 OPEN(UNIT = 10, FILE = "Perc.txt") 
 OPEN(UNIT = 20, FILE = "Weights.txt")
 OPEN (UNIT = 30, FILE = "Final.txt")
 WRITE (10, '(32("-"))') ! first output line to file, a line of "-"
 Epoch: DO
     WeightUpdate: DO I = 1, 4 ! Do for all 4 training vectors
          DO J = 1, 2 ! Do for the 2 input and hidden neurons
               Z(J) = Weights(0,J) + Weights(1,J) * Train(I,1) + Weights(2,J) *&
               &Train(I,2) !Calculate Z
               H(J) = DTANH(Beta * Z(J)) ! Activity for hidden neuron
               G = V0 + V1 * H(1) + V2 * H(2) ! Input to output neuron
               FPrime = Beta * (1 - (H(J) * H(J))) ! Calculate derivative of TANH
               ! Calculate change in weights
               DWeights(0,J) = Alpha * (Tar(I) - G) * FPrime * V0 
               DWeights(1,J) = Alpha * (Tar(I) - G) * FPrime * V1 * Train(I,1)  
               DWeights(2,J) = Alpha * (Tar(I) - G) * FPrime * V2 * Train(I,2)
               ! Update weights
               Weights(0,J) = Weights(0,J) + DWeights(0,J)
               Weights(1,J) = Weights(1,J) + DWeights(1,J)
               Weights(2,J) = Weights(2,J) + DWeights(2,J)
          END DO
     END DO WeightUpdate
     ! Output final weights for each epoch to file
     DO I = 0, 2
          DO J = 1, 2
               WRITE(20, 300, ADVANCE = "NO") I, J, Weights(I,J)
          END DO
     END DO
     WRITE (20,*)
     DO I = 1,4 ! Calculate output of Madaline ANN after epoch is complete
          DO J = 1, 2
               Z(J) = Weights(0,J) + Weights(1,J) * Train(I,1) + Weights(2,J) *&
               &Train(I,2) !Calculate Z
               H(J) = DTANH(Beta * Z(J)) ! Calculate activity for hidden neuron
          END DO
          G = V0 + V1 * H(1) + V2 * H(2) ! Input to output neuron
          F(I) = NINT((ABS(G) / G)) ! F(I) = SIGN(G)
          WRITE(30,400, ADVANCE = "NO") I, G ! Output final neuron's output
     END DO
     WRITE(30,*)
     Count = Count + 1 ! increment count
     IF (Count == MaxCount) THEN ! If nonconvergence occurs, exit loop
          PRINT *, "Failed to converge after", MaxCount, "epochs"
          EXIT Epoch
     END IF
     DO I = 1, 4 ! write target and actual outputs to file
          WRITE (10, 200) Count, Tar(I), F(I)
     END DO
     WRITE (10, '(32("-"))')
     DO I = 1, 4
          IF (F(I) /= Tar(I)) THEN ! If the output /= target, do another epoch
               Z = 0.0
               G = 0.0
               DWeights = 0.0
               H = 0.0
               F = 0
               CYCLE Epoch
          END IF
     END DO
      
     PRINT *, "The computer has learned the NXOR gate! It took ", Count, "epochs"
     EXIT Epoch
END DO Epoch
200 FORMAT (1X, I4, T19, "t=", I2, T29, "y=", I2)
300 FORMAT (1X, "(", I1, ",", I1, ")", 1X, F13.10)
400 FORMAT (1X, "(", I1, ")", 1X, F13.10)

! ---------------------------------------------------------------
 CONTAINS
! ---------------------------------------------------------------

SUBROUTINE Setup
     ! Setup arrays
     DWeights = 0.0
     Weights(0,1) = 0.23
     Weights(1,1) = -0.19 
     Weights(2,1) = 0.24
     Weights(0,2) = 0.15
     Weights(1,2) = 0.33
     Weights(2,2) = -0.29
     Train = RESHAPE((/1,1,-1,-1,1,-1,1,-1/),(/4,2/))
     Tar = RESHAPE((/1,-1,-1,1/),(/4/))
     ! Declare constants
     Alpha = 0.275
     Beta = 0.5
     MaxCount = 1000
END SUBROUTINE
END PROGRAM