PROGRAM sokkelo
  IMPLICIT NONE
  INTEGER, PARAMETER :: alku = 1, tyhja = alku - 1, &
      reuna = tyhja - 1
  INTEGER, PARAMETER :: ylos = 1, alas = 2, &
      oikealle = 3, vasemmalle = 4
  INTEGER, DIMENSION(:,:), ALLOCATABLE :: taulu
  INTEGER :: leveys, korkeus
  
  CALL alusta
  CALL sijoita(1,1,alku)
  CALL tulosta_numerot
  CALL tulosta
CONTAINS

  SUBROUTINE alusta
    IMPLICIT NONE
    INTEGER :: allocstat
    WRITE (*,*) 'Anna sokkelon leveys ja korkeus:'
    READ (*,*) leveys, korkeus
    IF (leveys <= 1 .OR. korkeus <= 1) &
        STOP 'Liian pieni sokkelo!'
    ALLOCATE (taulu(0:korkeus+1,0:leveys+1), STAT=allocstat)
    IF (allocstat /= 0) STOP 'Muistinvaraus epäonnistui!'
    taulu(1:korkeus,1:leveys) = tyhja
    taulu(0,:) = reuna
    taulu(korkeus+1,:) = reuna
    taulu(:,0) = reuna
    taulu(:,leveys+1) = reuna
  END SUBROUTINE alusta

  RECURSIVE SUBROUTINE sijoita(k, l, n)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: k, l, n
    taulu(k,l) = n
    DO WHILE (.NOT. umpikuja(k,l))
      SELECT CASE (arvaa(k,l))
        CASE(alas);       CALL sijoita(k,l+1,n+1)
        CASE(ylos);       CALL sijoita(k,l-1,n+1)
        CASE(oikealle);   CALL sijoita(k+1,l,n+1)
        CASE(vasemmalle); CALL sijoita(k-1,l,n+1)
      END SELECT
    END DO
  END SUBROUTINE sijoita

  LOGICAL FUNCTION umpikuja(k, l)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: k, l
    umpikuja = taulu(k,l+1) /= tyhja .AND. &
	taulu(k,l-1) /= tyhja .AND. &
	taulu(k+1,l) /= tyhja .AND. &
	taulu(k-1,l) /= tyhja
  END FUNCTION umpikuja

  INTEGER FUNCTION arvaa(k,l)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: k, l
    INTEGER, DIMENSION(3) :: vapaat
    REAL :: t
    SELECT CASE (suuntia(vapaat,k,l))
    CASE(1)
      arvaa = vapaat(1)
    CASE(2)
      CALL RANDOM_NUMBER(t)
      arvaa = vapaat(FLOOR(2*t+1))
    CASE(3)
      CALL RANDOM_NUMBER(t)
      arvaa = vapaat(FLOOR(3*t+1))
    END SELECT
  END FUNCTION arvaa

  FUNCTION suuntia(vapaat,k,l) RESULT(i)
    IMPLICIT NONE
    INTEGER, DIMENSION(:), INTENT(INOUT) :: vapaat
    INTEGER, INTENT(IN) :: k,l
    INTEGER :: i
    i = 0
    IF (taulu(k,l+1) == tyhja) THEN
      i = i + 1; vapaat(i) = alas
    END IF
    IF (taulu(k,l-1) == tyhja) THEN
      i = i + 1; vapaat(i) = ylos
    END IF
    IF (taulu(k+1,l) == tyhja) THEN
      i = i + 1; vapaat(i) = oikealle
    END IF
    IF (taulu(k-1,l) == tyhja) THEN
      i = i + 1; vapaat(i) = vasemmalle
    END IF
  END FUNCTION suuntia

  SUBROUTINE tulosta_numerot
    IMPLICIT NONE
    INTEGER :: k
    DO k = 1, korkeus
      WRITE (*,'(24(I3))') taulu(k,1:leveys)
    END DO
  END SUBROUTINE tulosta_numerot

  SUBROUTINE tulosta
    IMPLICIT NONE
    CHARACTER, PARAMETER :: pystyaita = '!', &
        vaaka_aita = '-', kulmaus = '+', vali = ' '
    CHARACTER(LEN=1), DIMENSION(:,:), ALLOCATABLE :: &
        merkkitaulu
    INTEGER :: allocstat, k, l, mk, ml, i, j
    k = korkeus; l = leveys; mk = 2*k; ml = 2*l
    ALLOCATE(merkkitaulu(0:mk,0:ml), STAT=allocstat)
    IF (allocstat /= 0) STOP 'Muistinvaraus epäonnistui!'
    merkkitaulu(1:mk-1:2,1:ml-1:2) = vali
    merkkitaulu(::2,::2) = kulmaus
    merkkitaulu(1:mk-1:2,::2) = pystyaita
    merkkitaulu(::2,1:ml-1:2) = vaaka_aita
    WHERE (ABS(taulu(1:k-1,1:l)-taulu(2:k,1:l)) == 1) &
        merkkitaulu(2:mk-2:2,1:ml-1:2) = vali
    WHERE (ABS(taulu(1:k,1:l-1)-taulu(1:k,2:l)) == 1) &
        merkkitaulu(1:mk-1:2,2:ml-2:2) = vali
    merkkitaulu(0,1) = vali
    merkkitaulu(mk,ml-1) = vali
    DO i = 0, mk
      DO j = 0, ml-1
        WRITE (*,'(A)',ADVANCE='NO') merkkitaulu(i,j)
      END DO
      WRITE (*,'(A)') merkkitaulu(i,ml)
    END DO
    DEALLOCATE(merkkitaulu)
  END SUBROUTINE tulosta

END PROGRAM sokkelo