module mod_weighted_graph
  implicit none
  integer, parameter :: long_infty = lshift(1, 30) - 1
  type t_edge
    integer :: from = 0
    integer :: to = 0
    integer(8) :: weight = 0
  end type
  type t_list
    type(t_edge), allocatable :: at(:)
  end type
  type weighted_graph
    type(t_list), allocatable :: list(:)
  contains
    procedure :: dijkstra => dijkstra
  end type
  type t_node
    type(t_node), private, pointer :: left => null(), right => null()
    integer :: rank = 1
    integer :: vertex, cost
  end type
  type leftist_heap
    integer :: size = 0
    type(t_node), private, pointer :: root => null()
  end type
  interface weighted_graph
    module procedure :: newwg0
  end interface weighted_graph
contains
  type(t_edge) function newe0(from, to, weight) result(res)
    integer, intent(in) :: from, to, weight
    res%from = from
    res%to = to
    res%weight = weight
  end
  type(weighted_graph) function newwg0(n, m, a, b, weight, undirected) result(res)
    integer, intent(in) :: n, m, a(:), b(:), weight(:)
    logical, optional, intent(in) :: undirected
    logical :: u
    integer :: c(n), i
    u = merge(undirected, .true., present(undirected))
    c = 0
    do i = 1, m
      c(a(i)) = c(a(i)) + 1
      if (u) c(b(i)) = c(b(i)) + 1
    end do
    allocate(res%list(n))
    do i = 1, n
      allocate(res%list(i)%at(c(i)))
    end do
    do i = m, 1, -1
      res%list(a(i))%at(c(a(i))) = newe0(a(i), b(i), weight(i))
      c(a(i)) = c(a(i)) - 1
      if (u) then
        res%list(b(i))%at(c(b(i))) = newe0(b(i), a(i), weight(i))
        c(b(i)) = c(b(i)) - 1
      end if
    end do
  end
  logical function less(a, b) result(res)
    type(t_node), pointer, intent(in) :: a, b
    res = a%cost < b%cost
  end
  subroutine swap(a, b)
    type(t_node), pointer, intent(inout) :: a, b
    type(t_node), pointer :: c
    c => a
    a => b
    b => c
  end
  function newn0(vertex, cost) result(res)
    integer, intent(in) :: vertex, cost
    type(t_node), pointer :: res
    res => null()
    allocate(res)
    res%vertex = vertex
    res%cost = cost
  end
  recursive function meld_node(a, b) result(res)
    type(t_node), pointer, intent(in) :: a, b
    type(t_node), pointer :: res
    logical :: f
    if (.not.associated(a)) then
      res => b; return
    end if
    if (.not.associated(b)) then
      res => a; return
    end if
    if (less(a, b)) then
      res => a
      res%right => meld_node(res%right, b)
    else
      res => b
      res%right => meld_node(res%right, a)
    end if
    f = .not.associated(res%left)
    if (.not.f) f = res%left%rank < res%right%rank
    if (f) call swap(res%left, res%right)
    res%rank = merge(res%right%rank, 0, associated(res%right)) + 1
  end
  function poll(this) result(res)
    class(leftist_heap), intent(inout) :: this
    type(t_node), pointer :: res
    res => this%root
    this%root => meld_node(this%root%left, this%root%right)
    this%size = this%size - 1
  end
  subroutine offer(this, vertex, cost)
    class(leftist_heap), intent(inout) :: this
    integer, intent(in) :: vertex, cost
    type(t_node), pointer :: node
    node => newn0(vertex, cost)
    this%root => meld_node(this%root, node)
    this%size = this%size + 1
  end
  function dijkstra(this, start) result(res)
    class(weighted_graph), intent(in) :: this
    integer, intent(in) :: start
    integer :: i, v, res(size(this%list)), cost
    type(t_node), pointer :: node
    type(leftist_heap) :: pq
    type(t_edge) :: e
    res = long_infty
    res(start) = 0
    call offer(pq, start, res(start))
    do while (pq%size > 0)
      node => poll(pq)
      v = node%vertex
      cost = node%cost
      deallocate(node)
      if (cost > res(v)) cycle
      do i = 1, size(this%list(v)%at)
        e = this%list(v)%at(i)
        if (res(e%to) > res(v) + e%weight) then
          res(e%to) = res(v) + e%weight
          call offer(pq, e%to, res(e%to))
        end if
      end do
    end do
  end
end module mod_weighted_graph
program range_flip_find_route
  use mod_weighted_graph
  implicit none
  integer :: h, w, n, x(100, 100) = 1, i, j, m = 0
  integer :: a(22000) = 0, b(22000) = 0, weight(22000) = 0, d(10000) = 0
  character(100) :: s
  type(weighted_graph) :: g
  read(*,*) h, w
  do i = 1, h
    read(*,*) s
    do j = 1, w
      if (s(j:j) == '.') x(i, j) = 0
    end do
  end do
  do i = 1, h
    do j = 1, w
      if (j /= w) then
        m = m + 1
        a(m) = idx(i, j)
        b(m) = idx(i, j + 1)
        weight(m) = max(x(i, j + 1) - x(i, j), 0)
      end if
      if (i /= h) then
        m = m + 1
        a(m) = idx(i, j)
        b(m) = idx(i + 1, j)
        weight(m) = max(x(i + 1, j) - x(i, j), 0)
      end if
    end do
  end do
  n = h * w
  g = weighted_graph(n, m, a, b, weight, .false.)
  d(1:n) = g%dijkstra(1)
  write(*,'(i0)') d(n) + x(1, 1)
contains
  integer function idx(i, j) result(res)
    integer, intent(in) :: i, j
    res = (i - 1) * w + j
  end
end program range_flip_find_route

Measured memory_bytes: 4256