module mod_weighted_graph
  implicit none
  integer(8), parameter :: long_infty = lshift(1_8, 62)
  integer, parameter :: int_infty = lshift(1, 30)

  type t_edge
    integer :: from = 0
    integer :: to = 0
    integer :: capacity = 0
    integer :: reverse = 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
    procedure :: ford_fulkerson => ford_fulkerson
  end type

  type t_node
    type(t_node), private, pointer :: left => null(), right => null()
    integer :: rank = 1
    integer :: number
    integer(8) :: 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, capacity, reverse) result(res)
    integer, intent(in) :: from, to
    integer(8), intent(in) :: weight
    integer, optional, intent(in) :: capacity, reverse
    res%from = from
    res%to = to
    res%weight = weight
    if (present(capacity)) res%capacity = capacity
    if (present(reverse)) res%reverse = reverse
  end

  type(weighted_graph) function newwg0(n, m, a, b, weight, capacity, undirected) result(res)
    integer, intent(in) :: n, m, a(:), b(:)
    integer(8), intent(in) :: weight(:)
    integer, optional, intent(in) :: capacity(:)
    logical, optional, intent(in) :: undirected
    logical :: u, cap
    integer :: c(n), i
    if (present(undirected)) then
      u = undirected
    else
      u = .true.
    end if
    cap = present(capacity)
    c = 0
    do i = 1, m
      c(a(i)) = c(a(i)) + 1
      if (cap) c(b(i)) = c(b(i)) + 1
      if (u) then
        c(b(i)) = c(b(i)) + 1
        if (cap) c(a(i)) = c(a(i)) + 1
      end if
    end do
    allocate(res%list(n))
    do i = 1, n
      allocate(res%list(i)%at(c(i)))
    end do
    do i = m, 1, -1
      if (cap) then
        res%list(a(i))%at(c(a(i))) = newe0(a(i), b(i), weight(i), capacity(i), c(b(i)))
        res%list(b(i))%at(c(b(i))) = newe0(b(i), a(i), weight(i), 0, c(a(i)))
        c(a(i)) = c(a(i)) - 1
        c(b(i)) = c(b(i)) - 1
      else
        res%list(a(i))%at(c(a(i))) = newe0(a(i), b(i), weight(i))
        c(a(i)) = c(a(i)) - 1
      end if
      if (u) then
        if (cap) then
          res%list(b(i))%at(c(b(i))) = newe0(b(i), a(i), weight(i), capacity(i), c(a(i)))
          res%list(a(i))%at(c(a(i))) = newe0(a(i), b(i), weight(i), 0, c(b(i)))
          c(a(i)) = c(a(i)) - 1
          c(b(i)) = c(b(i)) - 1
        else
          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 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(number, cost) result(res)
    integer, intent(in) :: number
    integer(8), intent(in) :: cost
    type(t_node), pointer :: res
    res => null()
    allocate(res)
    res%number = number
    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, number, cost)
    class(leftist_heap), intent(inout) :: this
    integer, intent(in) :: number
    integer(8), intent(in) :: cost
    this%root => meld_node(this%root, newn0(number, cost))
    this%size = this%size + 1
  end

  function dijkstra(this, start) result(res)
    class(weighted_graph), intent(in) :: this
    integer, intent(in) :: start
    integer :: number, i
    integer(8) :: 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)
      number = node%number
      cost = node%cost
      deallocate(node)
      if (cost > res(number)) cycle
      do i = 1, size(this%list(number)%at)
        e = this%list(number)%at(i)
        if (res(e%to) > res(number) + e%weight) then
          res(e%to) = res(number) + e%weight
          call offer(pq, e%to, res(e%to))
        end if
      end do
    end do
  end

  integer function ford_fulkerson(this, start, goal) result(res)
    class(weighted_graph), intent(inout) :: this
    integer, intent(in) :: start, goal
    integer :: dflow
    logical :: used(size(this%list))
    res = 0
    do
      used = .false.
      dflow = ffdfs(this, used, start, goal, int_infty)
      if (dflow == 0) return
      res = res + dflow
    end do
  end

  recursive integer function ffdfs(this, used, u, goal, dflow) result(res)
    class(weighted_graph), intent(inout) :: this
    logical, intent(inout) :: used(:)
    integer, intent(in) :: u, goal
    integer, intent(in) :: dflow
    integer :: i, v, capacity, r
    if (u == goal) then
      res = dflow
      return
    end if
    used(u) = .true.
    do i = 1, size(this%list(u)%at)
      v = this%list(u)%at(i)%to
      capacity = this%list(u)%at(i)%capacity
      if (used(v) .or. capacity <= 0) cycle
      res = ffdfs(this, used, v, goal, min(dflow, capacity))
      r = this%list(u)%at(i)%reverse
      if (res > 0) then
        this%list(u)%at(i)%capacity = this%list(u)%at(i)%capacity - res
        this%list(v)%at(r)%capacity = this%list(v)%at(r)%capacity + res
        return
      end if
    end do
    res = 0
  end

end module mod_weighted_graph
program three_circuits
  use mod_weighted_graph
  implicit none
  integer :: n, m, s = -1, t = -1, x, i
  integer, dimension(100000) :: a = 0, b = 0, c = 1
  type(weighted_graph) :: g
  read(*,*) n, m
  do i = 1, m
    read(*,*) a(i), b(i)
  end do
  g = weighted_graph(n, m, a, b, [(0_8, i=1, m)], c)
  do i = 1, n
    x = size(g%list(i)%at) / 2
    if (mod(x, 2) == 1) then
      write(*,'(a)') "No"; stop
    end if
  end do
  do i = 1, n
    x = size(g%list(i)%at) / 2
    if (x >= 6) then
      write(*,'(a)') "Yes"; stop
    end if
    if (x == 4) then
      if (s < 0) then
        s = i; cycle
      end if
      if (t < 0) then
        t = i; cycle
      end if
      write(*,'(a)') "Yes"; stop
    end if
  end do
  if (t < 0) then
    write(*,'(a)') "No"; stop
  end if
  write(*,'(a)') trim(merge("Yes", "No ", g%ford_fulkerson(s, t) == 2))
end program three_circuits

Measured memory_bytes: 26384