*     *************************************************************************

      subroutine robs( nroot,  fr, to,  lib,  ba, nba,  su, nsu,
     +                 bep, beptr, ftstem, pr, depth, xst, kdist )

*     *************************************************************************

*     Purpose :
*     ---------

*     This routine obtains the flow augmenting paths for all
*     the superbasic variables whose indices are in SU. 
*     It also finds the root of the subtree defined by the
*     basic variables whose indices are in BA.

*     Parameters :
*     ------------

*     nroot   ( int )

*       input  : meaningless.
*       output : the root of the subtree defined by the basic
*                variables whose indices are in BA.

*     fr      ( int )

*       input  : the vector containing the origine nodes of the arcs.
*       output : unmodified.

*     to      ( int )

*       input  : the vector containing the end nodes of the arcs.
*       output : unmodified.

*     lib     ( int )

*       input  : vetor containing the indices of all the basic 
*                variables. The ith indice corresponds to the 
*                indice of the basic arc having the following
*                endnodes i and PR(i).
*       output : unmodified.

*     ba      ( int )

*       input  : vector containing the indices of the basic 
*                variables in the current subspace.
*       output : unmodified.

*     nba     ( int )

*       input  : the number of basic variables in the current
*                subspace.
*       output : unmodified.

*     su      ( int )

*       input  : vector containing the indices of the superbasic
*                variables in the current subspace.
*       output : unmodified.

*     nsu     ( int )

*       input  : the number of superbasic variables in the current
*                subspace.
*       output : unmodified.

*     bep     ( int )

*       input  : meaningless.
*       output : it contains the flow augmenting paths of all
*                the superbasic variables in the current subspace.

*     beptr   ( int )

*       input  : meaningless.
*       output : array whose kth value is the position of the 
*                first element of the the flow augmenting path
*                of the superbasic variable K, in array BEP.

*     ftstem  ( int )

*       input  : vector containing for each superbasic variable,
*                the length from its origine node to the stem
*                node and the length of its flow augmenting path.
*       output : unmodified.

*     pr      ( int )

*       input  : the predecessor vector.
*       output : unmodified.

*     depth   ( int )

*       input  : the depth vector.
*       output : unmodified.

*     xst     ( int )

*       input  : vector containing the status of the variables.
*       output : unmodified.

*     kdist   ( int )

*       input  : meaningless.
*       output : vector containing for each superbasic variable
*                the length of its flow augmenting path.

*     Routines used :
*     ---------------

*     fapbep, snxnds, sxndis, gxndis.

*     Programming :
*     -------------

*     D. Tuyttens

*     ========================================================================

*     Routine parameters

      integer  nroot,  fr(*), to(*),  ba(*),  nba,  su(*),  nsu, 
     +         kdist(*),  bep(*),  beptr(*),  ftstem(*),  pr(*), 
     +         depth(*),  xst(*),  lib(*)

*     Internal variables

      integer  i, ik, k, fk, tk, kdis, idepth, ptr, nod, nn
      logical  gxndis

*     Common specifications

      integer           arcs, nodes, elem
      common / prbdim / arcs, nodes, elem

*
*     We obtain the flow augmenting paths for all the
*     superbasic variables and we store them in array BEP.
*
      ptr = 1
      do 10 ik = 1 , nsu
        k = su(ik)
        beptr(k) = ptr
        call fapbep( k, kdis, ftstem, pr, fr, to, lib, nba, bep(ptr) )
        kdist(ik) = kdis
        ptr = ptr + kdis
 10   continue
*
*     For each node of the graph, set its status to a status
*     that corresponds to a node that does not belong to the 
*     subgraph defined by the basic and superbasic variables.
*
      nroot = 0
      do 20 i = 1 , nodes+1
        call snxnds(xst(i))
 20   continue
*
*     Loop on the basic variables.
*
      do 30 ik = 1 , nba
        k  = ba(ik)
        fk = fr(k)
        tk = to(k)
*
*       Modify the status of the endnodes of the basic arc K,
*       to correspond to status of nodes that belong to the 
*       subgraph defined by the basic and superbasic variables.
*
        call sxndis(xst(fk))
        call sxndis(xst(tk))
*
*       Select the node of the basic arc K having the minimum depth.
*
        if( depth(fk).lt.depth(tk) ) then
          nod = fk
        else
          nod = tk
        endif
*
*       We test if the node NOD could be considered as a local 
*       root. In fact, we test if the status of the node PR(NOD)
*       corresponds to the status of a node that does not belong
*       to the subgraph defined by the basic and superbasic variables.
*
        if( .not.gxndis(xst(pr(nod))) ) then
*
*         The node NOD is considered as a local root.
*
          if( nroot.eq.0 ) then
*
*           First estimate of NROOT.
*
            nroot = nod
          else
            if( nod.ne.nroot ) then
*
*             The two nodes NROOT and NOD are local roots.
*             We set NROOT to the node having the minimum depth.
*             We set NN    to the node having the maximum depth.
*
              if( depth(nroot).lt.depth(nod) ) then
                nn     = nod
                idepth = depth(nod) - depth(nroot)
              else
                nn     = nroot
                nroot  = nod
                idepth = depth(nn) - depth(nroot)
              endif
*
*             We loop until finding a node NN having the same
*             depth as node NROOT.
*
              do 40 i = 1 , idepth
                nn = pr(nn)
                call sxndis(xst(nn))
 40           continue
*
*             We climb the two branches of the tree at the same
*             time until reaching one common node that will become
*             the new estimate of the root NROOT.
*
 100          continue
              if( nn.ne.nroot ) then
                nn      = pr(nn)
                call sxndis(xst(nn))
                nroot   = pr(nroot)
                call sxndis(xst(nroot))
                go to 100
              endif
            endif
          endif
        endif
*
*       Next basic variable.
*
 30   continue
*
      return
      end