module mod_tree_map
  implicit none
  integer, private, parameter :: key_kind = 4
  integer, private, parameter :: val_kind = 4

  type t_entry
    private
    integer(key_kind) :: key
    integer(val_kind) :: val
  end type

  type t_node
    private
    type(t_node), pointer :: left => null(), right => null()
    integer :: level = 1
    type(t_entry), pointer :: e => null()
  end type

  type tree_map
    integer :: size = 0
    type(t_node), private, pointer :: root => null()
    integer(val_kind) :: default = 0
  contains
    procedure :: clear => clear
    procedure :: is_empty => is_empty
    procedure :: is_not_empty => is_not_empty
    procedure :: get_keys => get_keys
    procedure :: put => put
    procedure :: remove => remove
    procedure :: get => get
    procedure :: contains => contain
    procedure :: first_key => get_first_key
    procedure :: poll_first => poll_first
    procedure :: last_key => get_last_key
    procedure :: poll_last => poll_last
    procedure :: floor_key => floor_key
    procedure :: lower_key => lower_key
    procedure :: ceiling_key => ceiling_key
    procedure :: higher_key => higher_key
  end type

contains

  function new_entry(key, val) result(res)
    integer(key_kind), intent(in) :: key
    integer(val_kind), optional, intent(in) :: val
    type(t_entry), pointer :: res
    res => null()
    allocate(res)
    res%key = key
    res%val = merge(val, 0_val_kind, present(val))
  end

  function new_node(e) result(res)
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: res
    res => null()
    allocate(res)
    res%e => e
  end

  integer function level(node) result(res)
    type(t_node), pointer, intent(in) :: node
    res = merge(node%level, 0, associated(node))
  end

  logical function is_leaf(node) result(res)
    type(t_node), pointer, intent(in) :: node
    res = associated(node) .and. &
      .not.associated(node%left) .and. &
      .not.associated(node%right)
  end

  function skew(node) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_node), pointer :: res
    if (.not.associated(node)) then
      res => null()
    else if (.not.associated(node%left)) then
      res => node
    else if (level(node%left) == level(node)) then
      res => node%left
      node%left => res%right
      res%right => node
    else
      res => node
    end if
  end

  function split(node) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_node), pointer :: res
    if (.not.associated(node)) then
      res => null()
    else if (.not.associated(node%right)) then
      res => node
    else if (.not.associated(node%right%right)) then
      res => node
    else if (level(node%right%right) == level(node)) then
      res => node%right
      node%right => res%left
      res%left => node
      res%level = res%level + 1
    else
      res => node
    end if
  end

  function predecessor(node) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_node), pointer :: res
    res => null()
    if (.not.associated(node%left)) return
    res => node%left
    do while (associated(res%right))
      res => res%right
    end do
  end

  function successor(node) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_node), pointer :: res
    res => null()
    if (.not.associated(node%right)) return
    res => node%right
    do while (associated(res%left))
      res => res%left
    end do
  end

  recursive function insert(node, e) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: res
    res => new_node(e)
    if (.not.associated(node)) return
    res => node
    if (e%key < res%e%key) then
      res%left => insert(res%left, e)
    else if (e%key > res%e%key) then
      res%right => insert(res%right, e)
    else
      res%e => e
    end if
    res => skew(res)
    res => split(res)
  end

  recursive function delete(node, e) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: res, l
    res => node
    if (.not.associated(node)) return
    if (e%key < res%e%key) then
      res%left => delete(res%left,e)
    else if (e%key > res%e%key) then
      res%right => delete(res%right,e)
    else
      if (is_leaf(res)) then
        res => null()
        return
      end if
      if (.not.associated(res%left)) then
        l => successor(res)
        res%right => delete(res%right, l%e)
        res%e => l%e
      else
        l => predecessor(res)
        res%left => delete(res%left, l%e)
        res%e => l%e
      end if
    end if
    res => decrease_level(res)
    res => skew(res)
    res%right => skew(res%right)
    if (associated(res%right)) res%right%right => skew(res%right%right)
    res => split(res)
    res%right => split(res%right)
  end

  function decrease_level(node) result(res)
    type(t_node), pointer, intent(in) :: node
    type(t_node), pointer :: res
    integer :: should_be
    res => node
    should_be = min(level(res%left), level(res%right)) + 1
    if (res%level > should_be) then
      res%level = should_be
      if (level(res%right) > should_be) res%right%level = should_be
    end if
  end

  recursive subroutine release_tree(node)
    type(t_node), pointer, intent(inout) :: node
    if (.not.associated(node)) return
    call release_tree(node%left)
    call release_tree(node%right)
    deallocate(node)
  end

  recursive subroutine get_keys_list(node, keys, num)
    type(t_node), pointer, intent(in) :: node
    integer(key_kind), intent(inout) :: keys(:)
    integer, intent(inout) :: num
    if (.not.associated(node)) return
    call get_keys_list(node%left, keys, num)
    num = num + 1
    keys(num) = node%e%key
    call get_keys_list(node%right, keys, num)
  end

  subroutine clear(this)
    class(tree_map), intent(inout) :: this
    call release_tree(this%root)
    this%root => null()
  end

  logical function is_empty(this) result(res)
    class(tree_map), intent(in) :: this
    res = .not.associated(this%root)
  end

  logical function is_not_empty(this) result(res)
    class(tree_map), intent(in) :: this
    res = associated(this%root)
  end

  subroutine put_entry(map, e)
    type(tree_map), intent(inout) :: map
    type(t_entry), pointer, intent(in) :: e
    if (.not.contains_entry(map, e)) map%size = map%size + 1
    map%root => insert(map%root, e)
  end

  subroutine remove_entry(map, e)
    type(tree_map), intent(inout) :: map
    type(t_entry), pointer, intent(in) :: e
    if (contains_entry(map, e)) then
      map%root => delete(map%root, e)
      map%size = map%size - 1
    end if
  end

  function get_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => null()
    n => map%root
    do while (associated(n))
      if (e%key < n%e%key) then
        n => n%left
      else if (e%key > n%e%key) then
        n => n%right
      else
        res => n%e
        return
      end if
    end do
  end

  function contains_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: n
    logical :: res
    res = .false.
    n => map%root
    do while (associated(n))
      if (e%key < n%e%key) then
        n => n%left
      else if (e%key > n%e%key) then
        n => n%right
      else
        res = .true.
        return
      end if
    end do
  end

  function get_first_entry(map) result(res)
    type(tree_map), intent(in) :: map
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => null()
    n => map%root
    if (.not.associated(n)) return
    do while (associated(n%left))
      n => n%left
    end do
    res => n%e
  end

  function poll_first_entry(map) result(res)
    type(tree_map), intent(inout) :: map
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => get_first_entry(map)
    map%root => delete(map%root, res)
  end

  function get_last_entry(map) result(res)
    type(tree_map), intent(in) :: map
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => null()
    n => map%root
    if (.not.associated(n)) return
    do while (associated(n%right))
      n => n%right
    end do
    res => n%e
  end

  function poll_last_entry(map) result(res)
    type(tree_map), intent(inout) :: map
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => get_last_entry(map)
    map%root => delete(map%root, res)
  end

  function floor_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => null()
    n => map%root
    do while (associated(n))
      if (e%key < n%e%key) then
        n => n%left
      else if (e%key > n%e%key) then
        if (.not.associated(res)) then
          res => n%e
          cycle
        end if
        if (e%key - res%key > e%key - n%e%key) res => n%e
        n => n%right
      else
        res => n%e
        return
      end if
    end do
  end

  function lower_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_entry), pointer :: res
    res => floor_entry(map, new_entry(e%key - 1))
  end

  function ceiling_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_node), pointer :: n
    type(t_entry), pointer :: res
    res => null()
    n => map%root
    do while (associated(n))
      if (e%key < n%e%key) then
        if (.not.associated(res)) then
          res => n%e
          cycle
        end if
        if (e%key - res%key < e%key - n%e%key) res => n%e
        n => n%left
      else if (e%key > n%e%key) then
        n => n%right
      else
        res => n%e
        return
      end if
    end do
  end

  function higher_entry(map, e) result(res)
    type(tree_map), intent(in) :: map
    type(t_entry), pointer, intent(in) :: e
    type(t_entry), pointer :: res
    res => ceiling_entry(map, new_entry(e%key + 1))
  end

  function get_keys(this) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind) :: res(this%size)
    integer :: num
    res = 0
    num = 0
    call get_keys_list(this%root, res, num)
  end

  subroutine put(this, key, val)
    class(tree_map), intent(inout) :: this
    integer(key_kind), intent(in) :: key
    integer(val_kind), intent(in) :: val
    call put_entry(this, new_entry(key, val))
  end

  subroutine remove(this, key)
    class(tree_map), intent(inout) :: this
    integer(key_kind), intent(in) :: key
    call remove_entry(this, new_entry(key))
  end

  integer(val_kind) function get(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    type(t_entry), pointer :: e
    res = this%default
    e => get_entry(this, new_entry(key))
    if (.not.associated(e)) return
    res = e%val
  end

  logical function contain(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    res = contains_entry(this, new_entry(key))
  end

  integer(key_kind) function get_first_key(this) result(res)
    class(tree_map), intent(in) :: this
    type(t_entry), pointer :: e
    res = this%default
    e => get_first_entry(this)
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function poll_first(this) result(res)
    class(tree_map), intent(inout) :: this
    type(t_entry), pointer :: e
    res = this%default
    e => poll_first_entry(this)
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function get_last_key(this) result(res)
    class(tree_map), intent(in) :: this
    type(t_entry), pointer :: e
    res = this%default
    e => get_last_entry(this)
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function poll_last(this) result(res)
    class(tree_map), intent(inout) :: this
    type(t_entry), pointer :: e
    res = this%default
    e => poll_last_entry(this)
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function floor_key(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    type(t_entry), pointer :: e
    res = this%default
    e => floor_entry(this, new_entry(key))
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function lower_key(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    type(t_entry), pointer :: e
    res = this%default
    e => lower_entry(this, new_entry(key))
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function ceiling_key(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    type(t_entry), pointer :: e
    res = this%default
    e => ceiling_entry(this, new_entry(key))
    if (.not.associated(e)) return
    res = e%key
  end

  integer(key_kind) function higher_key(this, key) result(res)
    class(tree_map), intent(in) :: this
    integer(key_kind), intent(in) :: key
    type(t_entry), pointer :: e
    res = this%default
    e => higher_entry(this, new_entry(key))
    if (.not.associated(e)) return
    res = e%key
  end

end module mod_tree_map
program i_hate_shortest_path_problem
  use mod_tree_map
  implicit none
  integer :: h, w, a, b, c, d, e, key, val, i
  type(tree_map) :: map, cnt
  read(*,*) h, w
  do i = 1, w
    call map%put(i, i)
  end do
  call cnt%put(0, w)
  do i = 1, h
    read(*,*) a, b
    key = map%ceiling_key(a)
    b = b + 1
    c = -1
    do while (key <= b .and. key > 0)
      val = map%get(key)
      c = max(c, val)
      d = key - val
      e = cnt%get(d) - 1
      if (e == 0) then
        call cnt%remove(d)
      else
        call cnt%put(d, e)
      end if
      call map%remove(key)
      key = map%ceiling_key(key)
    end do
    if (c > 0 .and. b <= w) then
      call map%put(b, c)
      d = b - c
      call cnt%put(d, cnt%get(d) + 1)
    end if
    write(*,'(i0)') merge(cnt%first_key() + i, -1, cnt%size > 0)
  end do
end program i_hate_shortest_path_problem

Measured memory_bytes: 508508