* ************************************************************************* subroutine super( kout, indkin, nsi, nsj, nbj, susel, + pivot, pivstr, fr, to, su, nsu, x, + xst, ftstem, bep, beptr, pr ) * ************************************************************************* * Purpose : * --------- * This routine tries to find a non bounded superbasic arc * candidate for pivoting with the bounded basic arc KOUT. * If no candidate is found, SUSEL is set to .false., otherwise * it is set to .true. and the indice of the component of SU * corresponding to the superbasic arc candidate for pivoting * is set in INDKIN. * Three strategies are implemented: * PIVSTR = 0 : we choose the non bounded superbasic arc including * the basic arc KOUT in its flow augmenting path * and having the maximum of the smallest distance * form its value to its nearest bound. * = 1 : we choose the non bounded superbasic arc including * the basic arc KOUT in its flow augmenting path * and having the smallest flow augmenting path length. * = 2 : the first non bounded superbasic arc including * the basic arc KOUT in its flow augmenting path * is choosen. * Parameters : * ------------ * kout ( int ) * input : the indice of the bounded basic arc. * output : unmodified. * indkin ( int ) * input : meaningless. * output : the indice of the component in SU corresponding * to the non bounded superbasic arc found as a * candidate for pivoting with the bounded basic * arc KOUT. * nsi ( int ) * input : meaningless. * output : one of the endnodes of the non bounded superbasic * arc candidate for pivoting with the bounded basic * arc KOUT. * nsj ( int ) * input : meaningless. * output : the other endnode of the non bounded superbasic * arc candidate for pivoting with the bounded basic * arc KOUT. The path connecting nodes NSJ and NBJ * is called the pivot's path. * nbj ( int ) * input : meaningless. * output : one of the endnodes of the bounded basic arc KOUT. * The other endnode is PR(NBJ). * susel ( log ) * input : meaningless. * output : .true. iff a candidate has been found, * .false. otherwise. * pivot ( log ) * input : .true. iff a pivoting has already been performed * during the current iteration. * .false. otherwise. * output : unmodified. * pivstr ( int ) * input : = 0, the candidate with the maximum smallest * distance form its value to its nearest * bound is choosen, * = 1, the candidate with the smallest flow * augmenting path length is choosen, * = 2, the first candidate is choosen. * output : unmodified. * fr ( int ) * input : vector containing the origine nodes of the arcs. * output : unmodified. * to ( int ) * input : vector containing the end nodes of the arcs. * output : unmodified. * su ( int ) * input : vector containing the indices of the superbasic * variables. * output : unmodified. * nsu ( int ) * input : the number of superbasic variables. * output : unmodified. * x ( dble ) * input : the current iterate vector. * output : unmodified. * xst ( int ) * input : vector containing the status of the variables. * output : unmodified. * 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. * bep ( int ) * input : vector containing the flow augmenting paths * of the superbasic variables. * output : unmodified. * beptr ( int ) * input : array whose kth value is the position of the first * element of the flow augmenting path of the superbasic * variable k, in the array BEP. * output : unmodified. * pr ( int ) * input : the predecessor vector. * output : unmodified. * Routines used : * --------------- * min, abs. * gxbdg, xlower, xupper. * Programming : * ------------- * D. Tuyttens * ======================================================================== * Routine parameters integer kout, indkin, nsi, nsj, nbj, pivstr, + fr(*), to(*), su(*), nsu, xst(*), + ftstem(*), bep(*), beptr(*), pr(*) logical susel, pivot double precision x(*) * Internal variables integer i, ik, k, kdis, fstem, n, minft, + frkout, tokout logical iftk, iftkin, gxbdg double precision maxd, mind, lb, ub, xlower, xupper * Common specifications integer arcs, nodes, elem common / prbdim / arcs, nodes, elem double precision zero, one, two, three, half, tenm1, tenm2, tenm4 common / prbcst / zero, one, two, three, half, tenm1, tenm2, tenm4 * * Some initializations. * frkout = fr(kout) tokout = to(kout) minft = nodes maxd = zero * * Loop on the superbasic variables. * do 10 ik = 1 , nsu k = su(ik) * * The superbasic variable K may not be bounded * to be a candidate. * if( .not.gxbdg(xst(k)) ) then * * The superbasic variable K is not bounded. * call getdbl( ftstem(k), fstem, kdis ) lb = xlower(k) ub = xupper(k) * * For PIVSTR = 0 or 1, we test if the superbasic * variable K is the best candidate. Try another * superbasic variable if it is not the case. * if( pivstr.ne.2 ) then if( pivstr.eq.0 ) then mind = min( ub-x(k) , x(k)-lb ) if( mind.le.maxd ) go to 10 else if( kdis.ge.minft ) go to 10 endif endif * * We test if the basic arc KOUT belongs to the flow * augmenting path of the superbasic arc K. When no * pivoting has been done during the current iteration, * the flow augmenting path of K is stored in array BEP. * if( .not.pivot ) then iftk = .true. do 20 i = beptr(k) , beptr(k)+kdis-1 if( abs(bep(i)).eq.kout ) then * * The basic arc KOUT belongs to the flow * augmenting path. The superbasic arc K is * a candidate for pivoting. * if( i-beptr(k).ge.fstem ) iftk = .false. if( (iftk .and. bep(i).lt.0) .or. + (.not.iftk .and. bep(i).gt.0 ) ) then nbj = frkout else nbj = tokout endif go to 40 endif 20 continue * * The basic arc KOUT does not belong to the flow * augmenting path. Try with another superbasic arc. * go to 10 endif * * We test if the basic arc KOUT belongs to the flow * augmenting path of the superbasic arc K. When a * pivoting has already been done during the current * iteration, the flow augmenting path of K is not * stored in array BEP, and we have to compose it. * n = fr(k) iftk = .true. do 30 i = 1 , kdis if( i.eq.fstem+1 ) then n = to(k) iftk = .false. endif if( (frkout.eq.n .and. tokout.eq.pr(n)) .or. + (frkout.eq.pr(n) .and. tokout.eq.n) ) then * * The basic arc KOUT belongs to the flow * augmenting path. The superbasic arc K is * a candidate for pivoting. * nbj = n go to 40 endif n = pr(n) 30 continue * * The basic arc KOUT does not belong to the flow * augmenting path. Try with another superbasic arc. * go to 10 * * Update the indice INDKIN of the best candidate found. * 40 continue indkin = ik iftkin = iftk susel = .true. if( pivstr.eq.2 ) go to 50 * * Update variables MAXD or MINFT. * if( pivstr.eq.0 ) then maxd = mind else minft = kdis endif endif * * Next superbasic variable. * 10 continue * * No candidate has been found. * if( .not.susel ) return k = su(indkin) 50 continue * * A candidate has been found. The node NSJ * is choosen such that the path connecting * nodes NSJ and NBJ forms the pivot' path. * if( iftkin ) then nsj = fr(k) nsi = to(k) else nsj = to(k) nsi = fr(k) endif * return end