module mod_unweighted_lca
  implicit none
  type t_list
    integer, allocatable :: at(:)
  end type
  type unweighted_lca
    type(t_list), allocatable :: list(:)
    integer, allocatable :: parent(:, :)
    integer, allocatable :: depth(:)
  contains
    procedure :: of => of
    procedure :: distance => distance
  end type
  interface unweighted_lca
    module procedure :: newlca0
  end interface unweighted_lca
contains
  type(unweighted_lca) function newlca0(n, m, a, b, undirected) result(res)
    integer, intent(in) :: n, m, a(:), b(:)
    logical, optional, intent(in) :: undirected
    logical :: u
    integer :: k, c(n), i, j
    if (present(undirected)) then
      u = undirected
    else
      u = .true.
    end if
    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))) = b(i)
      c(a(i)) = c(a(i)) - 1
      if (u) then
        res%list(b(i))%at(c(b(i))) = a(i)
        c(b(i)) = c(b(i)) - 1
      end if
    end do
    k = 1
    do while (lshift(1, k) < n)
      k = k + 1
    end do
    allocate(res%parent(0:k - 1, n))
    allocate(res%depth(n))
    call lcadfs(res, 1, -1, 0)
    do i = 0, k - 2
      do j = 1, n
        if (res%parent(i, j) < 0) then
          res%parent(i + 1, j) = -1
        else
          res%parent(i + 1, j) = res%parent(i, res%parent(i, j))
        end if
      end do
    end do
  end
  recursive subroutine lcadfs(lca, v, p, d)
    type(unweighted_lca), intent(inout) :: lca
    integer, intent(in) :: v, p, d
    integer :: i, u
    lca%parent(0, v) = p
    lca%depth(v) = d
    do i = 1, size(lca%list(v)%at)
      u = lca%list(v)%at(i)
      if (u /= p) call lcadfs(lca, u, v, d + 1)
    end do
  end
  integer function of(this, a, b) result(res)
    class(unweighted_lca), intent(in) :: this
    integer, intent(in) :: a, b
    integer :: x, y, i
    if (this%depth(a) > this%depth(b)) then
      x = b
      y = a
    else
      x = a
      y = b
    end if
    do i = 0, size(this%parent, 1) - 1
      if (btest(this%depth(y) - this%depth(x), i)) then
        y = this%parent(i, y)
      end if
    end do
    if (x == y) then
      res = x
      return
    end if
    do i = size(this%parent, 1) - 1, 0, -1
      if (this%parent(i, x) /= this%parent(i, y)) then
        x = this%parent(i, x)
        y = this%parent(i, y)
      end if
    end do
    res = this%parent(0, x)
  end
  integer function distance(this, a, b) result(res)
    class(unweighted_lca), intent(in) :: this
    integer, intent(in) :: a, b
    res = this%depth(a) + this%depth(b) - 2 * this%depth(of(this, a, b))
  end
end module mod_unweighted_lca
program playing_tag_on_tree
  use mod_unweighted_lca
  implicit none
  integer :: n, u, v, i, x = 0, du, dv
  integer, dimension(100000) :: a = 0, b = 0
  type(unweighted_lca) :: lca
  read(*,*) n, u, v
  do i = 1, n - 1
    read(*,*) a(i), b(i)
  end do
  lca = unweighted_lca(n, n - 1, a, b)
  do i = 1, n
    if (size(lca%list(i)%at) > 1) cycle
    du = lca%distance(u, i)
    dv = lca%distance(v, i)
    if (du < dv .and. x < dv) x = dv
  end do
  write(*,'(i0)') x - 1
end program playing_tag_on_tree

Measured memory_bytes: 28076