PROGRAM Life
  IMPLICIT NONE
  CHARACTER (LEN=*), PARAMETER :: tiedosto = 'life.dat'
  INTEGER, PARAMETER :: maksimikoko = 200
  INTEGER, DIMENSION(:,:), POINTER :: lauta_1, lauta_2
  INTEGER :: leveys = 20, korkeus = 20, toistot = 1000, iter
  
  CALL lue_lauta
  CALL pyyhi

  DO iter = 1, toistot/2
    CALL piirra(lauta_1,lauta_2)
    CALL laske(lauta_1,lauta_2)
    CALL piirra(lauta_2,lauta_1)
    CALL laske(lauta_2,lauta_1)
  END DO
  IF (MOD(toistot,2) == 1) THEN
    CALL piirra(lauta_1,lauta_2)
    CALL laske(lauta_1,lauta_2)
  END IF

  CALL pyyhi

CONTAINS

  SUBROUTINE pyyhi
    WRITE (*,'(A)') CHAR(27) // '[2J'
  END SUBROUTINE pyyhi

  SUBROUTINE lue_lauta
    IMPLICIT NONE
    INTEGER :: i, j
    CHARACTER(LEN=maksimikoko) :: rivi
    NAMELIST / lista / toistot, leveys, korkeus

    OPEN (1, FILE=tiedosto, STATUS='OLD', ACTION='READ', &
	FORM='FORMATTED')
    READ (1, NML=lista)
    IF (toistot < 1) STOP 'Iteraatioiden maksimimäärä &
        &nolla tai negatiivinen!'
    IF (leveys < 1 .OR. korkeus < 1 .OR. &
        leveys > maksimikoko) STOP 'Liian pieni tai iso lauta!'
    ALLOCATE (lauta_1(korkeus,leveys))
    lauta_1 = 0
    DO i = 1, korkeus
      READ(1,'(A)',END=99) rivi
      DO j = 1, leveys
        IF (rivi(j:j) /= ' ') lauta_1(i,j) = 1
      END DO
    END DO
99  CLOSE(1)
    ALLOCATE (lauta_2(SIZE(lauta_1,1),SIZE(lauta_1,2)))
    lauta_2(:,:) = 0

  END SUBROUTINE lue_lauta

  SUBROUTINE laske(lauta_1,lauta_2)
    IMPLICIT NONE
    INTEGER, DIMENSION(:,:), POINTER :: lauta_1, lauta_2
    INTEGER, DIMENSION(SIZE(lauta_1,1),SIZE(lauta_1,2)) :: &
	summa

    summa = CSHIFT (lauta_1, shift= 1, DIM=1) + &
	CSHIFT (lauta_1, shift=-1, DIM=1) + &
	CSHIFT (lauta_1, shift= 1, DIM=2) + &
	CSHIFT (lauta_1, shift=-1, DIM=2) + &
	CSHIFT (CSHIFT (lauta_1, shift= 1, DIM=2), &
                shift= 1, DIM=1) + &
	CSHIFT (CSHIFT (lauta_1, shift= 1, DIM=2), &
                shift=-1, DIM=1) + &
	CSHIFT (CSHIFT (lauta_1, shift=-1, DIM=2), &
                shift= 1, DIM=1) + &
	CSHIFT (CSHIFT (lauta_1, shift=-1, DIM=2), &
                shift=-1, DIM=1)
    WHERE (summa < 2 .OR. summa > 3)
      lauta_2 = 0
    ELSEWHERE
      lauta_2 = lauta_1
    END WHERE
    WHERE (summa == 3) lauta_2 = 1
  END SUBROUTINE laske

  SUBROUTINE piirra(lauta_1,lauta_2)
    USE muotoilu ! Käytetään operaattoria ".fmt."
    IMPLICIT NONE
    CHARACTER(LEN=*), PARAMETER :: escape = CHAR(27) // '['
    INTEGER, DIMENSION(:,:), POINTER :: lauta_1, lauta_2
    INTEGER :: i, j

    DO i = 1, SIZE(lauta_1,1)
      DO j = 1, SIZE(lauta_1,2)
        IF (lauta_1(i,j) /= lauta_2(i,j)) THEN
          WRITE (*,'(A)',ADVANCE='NO') escape
          WRITE (*,'(' // .fmt. i // ',A)', &
              ADVANCE='NO') i, ';'
          WRITE (*,'(' // .fmt. (j-1) // ',A)', &
              ADVANCE='NO') j-1, 'H'
          IF (lauta_1(i,j) /= 0) THEN
            WRITE (*,'(A)',ADVANCE='NO') '*'
          ELSE
            WRITE (*,'(A)',ADVANCE='NO') ' '
          END IF
        END IF
      END DO
    END DO
    IF (lauta_1(1,1) /= 0) THEN
      WRITE (*,'(A)') escape // '1;0H*'
    ELSE
      WRITE (*,'(A)') escape // '1;0H '
    END IF
  END SUBROUTINE piirra

END PROGRAM Life