module cubedag_digraph
  use gkernel_interfaces
  use cubetools_parameters
  use cubedag_node_type
  use cubedag_messaging
  use cubedag_dag
  use cubedag_walker

  integer(kind=4) :: lun,mode

contains
  !
  subroutine cubedag_digraph_create(ofile,imode,error)
    !-------------------------------------------------------------------
    ! Build the digraph (.dot file) by recursing children from the root
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: ofile
    integer(kind=4),  intent(in)    :: imode
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='DIGRAPH>CREATE'
    integer(kind=4) :: ier
    class(cubedag_node_object_t), pointer :: root
    !
    mode = imode
    !
    ier = sic_getlun(lun)
    if (mod(ier,2).eq.0) then
      call cubedag_message(seve%e,rname,'Cannot allocate LUN')
      error = .true.
      return
    endif
    ier = sic_open(lun,ofile,'NEW',.false.)
    if (ier.ne.0) then
      call putios('E-SIC, ',ier)
      error = .true.
      return
    endif
    !
    write(lun,'(A)')  'digraph toto {'
    write(lun,'(A)')  '  rankdir=BT;'
    write(lun,'(A)')  '  node [shape = ellipse];'
    !
    call cubedag_dag_get_root(root)
    call cubedag_childwalker_reset(root,cubedag_digraph_link,error)
    if (error)  return
    !
    write(lun,'(A)')  '}'
    !
    ier = sic_close(lun)
    call sic_frelun(lun)
  end subroutine cubedag_digraph_create
  !
  subroutine cubedag_digraph_link(par,chi,error)
    !-------------------------------------------------------------------
    ! Link a parent to its child in the digraph
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), pointer       :: par
    class(cubedag_node_object_t), pointer       :: chi
    logical,                      intent(inout) :: error
    !
    write(lun,'(5A)')  '  "',trim(cubedag_digraph_nodename(chi,error)),  &
                    '" -> "',trim(cubedag_digraph_nodename(par,error)),'";'
  end subroutine cubedag_digraph_link
  !
  function cubedag_digraph_nodename(no,error)
    character(len=base_l) :: cubedag_digraph_nodename
    class(cubedag_node_object_t), pointer       :: no
    logical,                      intent(inout) :: error
    ! Local
    character(len=32) :: strflag
    character(len=base_l) :: nodename
    integer(kind=4) :: nc
    !
    if (mode.eq.1) then
      write(cubedag_digraph_nodename,'(I0)')  no%node%id
      return
    endif
    !
    call no%node%flag%repr(strflag,nc,error)
    if (error)  return
    !
    if (nc.le.0) then
      nodename = no%node%family
    else
      nodename = trim(no%node%family)//'\n'//strflag(1:nc)
    endif
    !
    if (mode.eq.2) then
      cubedag_digraph_nodename = nodename
    elseif (mode.eq.3) then
      write(cubedag_digraph_nodename,'(I0,A,A)')  no%node%id,': ',trim(nodename)
    endif
  end function cubedag_digraph_nodename
  !
end module cubedag_digraph
