* ************************************************************************* subroutine canli ( npoint, imove, rgmx, opt, + fr, tt, lin, ns, x, xst, w ) * ************************************************************************* * Purpose : * --------- * This routine searchs the nonbasic variable ITMP having * the best pricing. This variable is candidate to change * its flow value. * Only a part of the nonbasic variables is priced. ( A * loop with a positive increment is done ). If no candidate * has been found, another part of the nonbasic variables * is priced, and so on until all the nonbasic variables are * priced. * OPT is set to .true. if no good candidate has been found. * The current iterate X is then the optimal solution of the * linear optimization problem. * Parameters : * ------------ * npoint ( int ) * input : the first nonbasic variable that will be * priced is LN(NPOINT+1). * output : this value is updated for the next pricing. * imove ( int ) * input : meaningless. * output : the indice of the component of array LN * containing the indice ITMP of the best * candidate found. * rgmx ( dble ) * input : meaningless. * output : the reduced cost of the best candidate found. * opt ( log ) * input : meaningless. * output : .true. iff no candidate has been found. * The current iterate X is the optimal * solution of the linear optimization * problem, * .false. iff a good candidate has been found. * fr ( int ) * input : vector containing the origine nodes of the arcs. * output : unmodified. * tt ( int ) * input : vector containing the end nodes of the arcs. * output : unmodified. * lin ( int ) * input : vector containing the indices of the nonbasic * variables. * output : unmodified. * ns ( int ) * input : the number of nonbasic variables. * output : unmodified. * x ( dble ) * input : the current iterate vector. * output : unmodified. * xst ( int ) * input : vector containing the status of the variables. * output : unmodified. * w ( dble ) * input : the dual variables vector. * output : unmodified. * Routines used : * --------------- * sqrt, max, abs. * xlower, xupper, gxfix, * Programming : * ------------- * D. Tuyttens * ========================================================================= * Routine parameters integer fr(*), tt(*), npoint, imove, lin(*), + ns, xst(*) double precision rgmx, w(*), x(*), xlower, xupper logical opt * Internal variables integer nsmax, ncomb, nsrch, inp, ind, i, itmp double precision price, argmx, lbitmp, ubitmp, tolss logical gxfix, fixed * Common specifications integer arcs, nodes, elem double precision epsmch, huge, tiny, tol common / prbdim / arcs, nodes, elem common / prbmch / epsmch, huge, tiny, tol double precision zero, one, two, three, half, tenm1, tenm2, tenm4 common / prbcst / zero, one, two, three, half, tenm1, tenm2, tenm4 * * Some initializations. * tolss = sqrt(epsmch) opt = .true. argmx = zero rgmx = zero nsrch = 1 nsmax = 30 ncomb = max( 1 , ns/nsmax ) inp = npoint * * We price the nonbasic variables whose corresponding * indices in array LN go from component INP+1 to component * INP+NS, with increment NCOMP. * 100 if( inp .ge. ns ) inp = inp - ns do 10 i = 1, ns, ncomb ind = inp + i if( ind .gt. ns ) ind = ind - ns itmp = lin(ind) * * If the nonbasic arc ITMP is fixed, it is not a * candidate to change its flow value and therefore * it is excluded. * if( itmp .le. arcs ) then fixed = gxfix( xst( itmp ) ) else fixed = .false. endif * if( .not. fixed ) then * * We compute the reduced cost of the nonbasic * variable ITMP. * price = -w(tt(itmp)) + w(fr(itmp)) * lbitmp = xlower(itmp) ubitmp = xupper(itmp) * if( x(itmp)-lbitmp .le. tol*(one+abs(lbitmp)) ) then * * The nonbasic arc ITMP is lower bounded. * if( price .lt. -argmx ) then argmx = -price rgmx = price imove = ind endif else if( ubitmp-x(itmp) .le. tol*(one+abs(ubitmp)) ) then * * The nonbasic arc ITMP is upper bounded. * if( price .gt. argmx ) then argmx = price rgmx = price imove = ind endif else * * The nonbasic arc ITMP is non bounded. * if( abs(price) .gt. argmx ) then argmx = abs(price) rgmx = price imove = ind endif endif endif * 10 continue * * We check if a good candidate has been found. * if( argmx .gt. tolss ) then opt = .false. npoint = inp + 1 return endif * * No good candidate has been found. * if( nsrch .lt. ncomb ) then * * We update the starting indice INP and * a new search starts. * nsrch = nsrch + 1 inp = inp + 1 go to 100 endif * * No good candidate has been found and all * the nonbasic variables are priced. The * current iterate X is the optimal solution * of the linear optimization problem. * return end