bfs Subroutine

   subroutine bfs(graph, source, level, prev, err)
      !! Breadth-first search, ignoring edge weights.
      !!
      !! `level(v)` is the least number of edges from `source` to `v`, zero at
      !! the source and `GRAPH_UNREACHABLE` for a vertex that cannot be
      !! reached. `prev(v)` is the predecessor on that shortest hop path, or
      !! `GRAPH_NO_PREDECESSOR`. Because CSR rows are sorted ascending and the
      !! queue is FIFO, `prev` is deterministic here too: among equal-hop
      !! predecessors the one reached first in that order wins.
      !!
      !! Edge weights are not read at all, so negative weights are accepted.
      !! Reports `ERROR_VALIDATION` for a malformed or non-square graph or an
      !! out-of-range `source`.
      type(csr_t), intent(in) :: graph
         !! Square adjacency matrix of the graph; values are ignored
      integer(default_int), intent(in) :: source
         !! Source vertex, in `1:n`
      integer(default_int), allocatable, intent(out) :: level(:)
         !! Hop count to each vertex
      integer(default_int), allocatable, intent(out) :: prev(:)
         !! Predecessor of each vertex on its shortest hop path
      type(error_t), intent(out), optional :: err

      integer(default_int), allocatable :: queue(:)
      integer(default_int) :: n, head, tail, u, v, k

      if (.not. check_graph(graph, source, err)) then
         allocate (level(0))
         allocate (prev(0))
         return
      end if

      n = graph%n_rows()
      allocate (level(n))
      allocate (prev(n))
      allocate (queue(n))
      level = GRAPH_UNREACHABLE
      prev = GRAPH_NO_PREDECESSOR

      level(source) = 0
      queue(1) = source
      head = 1
      tail = 1
      do while (head <= tail)
         u = queue(head)
         head = head + 1
         do k = graph%row_ptr(u), graph%row_ptr(u + 1) - 1
            v = graph%col_idx(k)
            if (level(v) /= GRAPH_UNREACHABLE) cycle
            level(v) = level(u) + 1
            prev(v) = u
            tail = tail + 1
            queue(tail) = v
         end do
      end do
   end subroutine bfs