Preorder Traversal

program main
  implicit none
  integer :: value(7), left(7), right(7)
  integer :: queue(8), front, back, output(7), n, id
  character(len=128) :: out
  call setup(value, left, right)
  n = 0
  call preorder(4, value, left, right, output, n)
  call print_list(output, n)
contains
  subroutine setup(value, left, right)
    integer, intent(out) :: value(7), left(7), right(7)
    value = [1,2,3,4,5,6,7]; left = 0; right = 0
    left(4) = 2; right(4) = 6; left(2) = 1; right(2) = 3; left(6) = 5; right(6) = 7
  end subroutine setup
  subroutine append(out, text)
    character(len=*), intent(inout) :: out
    character(len=*), intent(in) :: text
    out = trim(out) // text
  end subroutine append
  recursive subroutine render_node(id, value, left, right, out)
    integer, intent(in) :: id, value(7), left(7), right(7)
    character(len=*), intent(inout) :: out
    character(len=16) :: buf
    if (id == 0) then; call append(out, '_'); return; end if
    write(buf, '(I0)') value(id); call append(out, trim(buf))
    if (left(id) /= 0 .or. right(id) /= 0) then
      call append(out, '('); call render_node(left(id), value, left, right, out); call append(out, ',')
      call render_node(right(id), value, left, right, out); call append(out, ')')
    end if
  end subroutine render_node
  recursive subroutine preorder(id, value, left, right, output, n)
    integer, intent(in) :: id, value(7), left(7), right(7)
    integer, intent(inout) :: output(7), n
    if (id == 0) return
    n = n + 1; output(n) = value(id)
    call preorder(left(id), value, left, right, output, n)
    call preorder(right(id), value, left, right, output, n)
  end subroutine preorder
  subroutine print_list(output, n)
    integer, intent(in) :: output(7), n
    integer :: i
    write(*, '(A)', advance='no') '['
    do i = 1, n
      if (i > 1) write(*, '(A)', advance='no') ', '
      write(*, '(I0)', advance='no') output(i)
    end do
    print '(A)', ']'
  end subroutine print_list
  logical function search_value(id, target, value, left, right)
    integer, intent(in) :: id, target, value(7), left(7), right(7)
    integer :: cur
    cur = id
    do while (cur /= 0)
      if (target == value(cur)) then; search_value = .true.; return; end if
      if (target < value(cur)) then; cur = left(cur); else; cur = right(cur); end if
    end do
    search_value = .false.
  end function search_value
end program main