PROGRAM ca1
*     one-dimensional Boolean cellular automata
      IMPLICIT NONE
      INTEGER IR_, L, update(0:7), site(0:1601), tmax
      DATA site/1602*0/

      CALL setrule(update)
      CALL initial(site,L,tmax)
      CALL iterate(site,L,update,tmax)

      END
C
      SUBROUTINE setrule(update)
      IMPLICIT NONE
      CHARACTER Stmp1_*80
      INTEGER IR_, bit0, bit1, bit2, i, rule, update(0:7)
      DATA rule/22/

      rule=22;
      WRITE(*, *) 'rule number = ', rule
      DO i = 7, 0, -1
         update(i) = rule/2**i              ! find binary representation
         rule = rule - update(i)*2**i
         bit2 = i/4
         bit1 = (i - 4*bit2)/2
         bit0 = i - 4*bit2 - 2*bit1
*        show possible neighborhoods
         WRITE(*, '(3(I1,1X),A,$)') bit2, bit1, bit0, '   '
      END DO
      WRITE(*,*)
      DO i = 7, 0, -1
         WRITE(*, '(2X,I1,$)') update(i)    ! print rules
         WRITE(*, '(A,$)') '      '
      END DO
      WRITE(*,*)
      END
C
      SUBROUTINE initial(site,L,tmax)
      IMPLICIT NONE
      INTEGER IR_, site(0:1601), L, tmax

      L = 60
      IF(L .GE. 1601) L = 1600
      tmax = 100
      site(L/2) = 1                         ! center site

      END
C
      SUBROUTINE iterate(site,L,update,tmax)
      IMPLICIT NONE
      INTEGER IR_, i, index, sitenew(0:1601), L, update(0:7),
     +       t, site(0:1601), tmax, Itmp1_
*     update lattice
*     need to introduce additional array, sitenew, to temporarily
*     store values of newly updated sites
      DO t = 1, tmax
         DO i = 1, L
            index = 4*site(i-1) + 2*site(i) + site(i+1)
            sitenew(i) = update(index)
            IF(sitenew(i) .EQ. 1) then
               write(6,'(A1,$)') 'X'
            else
               write(6,'(A1,$)') '.'
            endif
         END DO
         write(6,'(A)') ' '
         DO Itmp1_ = 1, L
            site(Itmp1_) = sitenew(Itmp1_)
         END DO
         site(0) = site(L)                  ! periodic boundary conditions
         site(L+1) = site(1)
      END DO
      END