* ************************************************************************* 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