program main
  use iso_fortran_env, only: int64
  implicit none
  integer :: D, L, k, ant, j, i, cost, mini, cost0, linea, rr, ok, col, okcol
  integer, dimension(0:5, 0:5) :: map
  integer, dimension(0:35) :: hj, hi
  integer, dimension (0:5) :: opt 
  integer(kind=int64) :: kount 
  real :: r
  
  D = 6
  L = D -1
  k = D*D
  do i = 0, L
    do j = 0, L
      k = k - 1
      hj ( k ) = j
      hi ( k ) = i
      map(i, j) = k
    end do
  end do
  linea = L
  col = L
  kount = 0
  mini = 999999
  CALL init_random_seed()

  do i=0,L
    do j=0,L
      ant = map(i,j)
      !k = (int) drand48()*(L+1);
      !ok = (int) drand48()*(L+1);
      call RANDOM_NUMBER(r)
      k = floor ( r * D)
      call RANDOM_NUMBER(r)
      ok = floor ( r * D)
      map(i,j) = map(k,ok)
      map(k,ok) = ant
      hi(map(k,ok)) = k
      hj(map(k,ok)) = ok
      hi(map(i,j)) = i
      hj(map(i,j)) = j
    end do
  end do

  do
    k = -1   
    j = hj(0)
    i = hi(0)
    if (j - 1 >= 0) then
      k = k + 1
      opt(k) =0
    end if  
    if (i - 1 >= 0) then
      k = k + 1
      opt(k) =1
    end if  
    if (j + 1 <= col) then
      k = k + 1
      opt (k) = 2
    end if  
    if (i + 1 <= linea) then
      k = k + 1
      opt(k) = 3
    end if  
    k = k+1

    call random_number(r)
    rr = opt ( floor ( r * k ) )

    select case (rr) 
      case (0) 
        ant = map( i, j-1 )
        map( i , j-1 ) = 0 
        map( i, j ) = ant
        hj(0) = hj(0)-1
        hj(ant) = hj(ant)+1
      case (1) 
        ant = map( i - 1 , j  )
        map( i -1 , j ) = 0 
        map( i, j ) = ant
        hi(0)=hi(0)-1
        hi(ant)=hi(ant)+1
      case (2) 
        ant = map( i , j+1 )
        map( i , j+1 ) = 0 
        map( i, j ) = ant
        hj(0)=hj(0)+1
        hj(ant)=hj(ant)-1
      case (3) 
        ant = map( i+1 , j )
        map( i+1 , j ) = 0 
        map( i, j ) = ant
        hi(0)=hi(0)+1
        hi(ant)=hi(ant)-1
      case default
        stop 'great error!'
    end select      
    cost = 0
    k = 0
    okcol = 0
    do i =  0,L
      cost0 = 0
      do j =  0,L
        cost0  = cost0 + abs(map(i,j)-k)       !*(k+1)
        if (map(i,j)==k .and. j==col) okcol = okcol +1
        k = k + 1
      end do
      cost = cost + cost0
      if (cost0 == 0 .AND. i==linea .AND. linea>1) linea = linea -1
    end do
    if (okcol == D .and. col > 1) col = col-1
    
    if (cost <= mini) then
      !  kount = 0
      write (*,*) "COST=", cost
      do i = 0,L 
        print "(6(i2,' '))", map(i,0), map(i,1), map(i,2), map(i,3), map(i,4), map(i,5)
      end do
      write (*,*)
      mini = cost
      if (cost == 2) kount = kount + 100000000    ! fan of comp.lang.fortran
      !  backup(0:L,0:L) = map(0:L,0:L)
      ! else
    end if  
    kount = kount + 1
    !  if ( mod(kount, 1000) ==0) then 
    !    map(0:L,0:L) = backup(0:L,0:L)
    !    do i = 0,L 
    !      do j = 0,L
    !        map(i,j) = backup(i,j)
    !        hi( map(i,j) ) = i
    !        hj( map(i,j) ) = j
    !      end do
    !    end do
    !  endif
    ! endif
    if (kount > 50000000000_int64) stop "Problem without solution!" 
    if (cost == 0) exit
  end do 
end program main

subroutine init_random_seed()
  use iso_fortran_env, only: int64
  implicit none
  integer, allocatable :: seed(:)
  integer :: i, n, un, istat, dt(8), pid
  integer(int64) :: t

  call random_seed(size = n)
  allocate(seed(n))
  ! First try if the OS provides a random number generator
  open(newunit=un, file="/dev/urandom", access="stream", &
       form="unformatted", action="read", status="old", iostat=istat)
  if (istat == 0) then
    read(un) seed
    close(un)
  else
    ! Fallback to XOR:ing the current time and pid. The PID is
    ! useful in case one launches multiple instances of the same
    ! program in parallel.
    call system_clock(t)
    if (t == 0) then
      call date_and_time(values=dt)
      t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
        + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 &
        + dt(3) * 24_int64 * 60 * 60 * 1000 &
        + dt(5) * 60 * 60 * 1000 &
        + dt(6) * 60 * 1000 + dt(7) * 1000 &
        + dt(8)
    end if
    pid = getpid()
    t = ieor(t, int(pid, kind(t)))
    do i = 1, n
      seed(i) = lcg(t)
    end do
  end if
  call random_seed(put=seed)
contains
  ! This simple PRNG might not be good enough for real work, but is
  ! sufficient for seeding a better PRNG.
  function lcg(s)
    integer :: lcg
    integer(int64) :: s
    if (s == 0) then
      s = 104729
    else
      s = mod(s, 4294967296_int64)
    end if
    s = mod(s * 279470273_int64, 4294967291_int64)
    lcg = int(mod(s, int(huge(0), int64)), kind(0))
  end function lcg
end subroutine init_random_seed