* ************************************************************************* subroutine testfs( fr, tt, x, feasbl, tolfsb, + aflow, sumbi, ipdevc, what ) * ************************************************************************* * Purpose: * -------- * This routine tests if the flow X verifies the network * constraints. * FEASBL is set to .true. if the flow X is feasible. * Otherwise, it is set to .false. and artificial arcs * are introduced. Their orientation and flows are chosen * to enforce the feasibility of the extended flow vector * and the nonnegativity of their associated variables. * Parameters : * ------------ * fr ( int ) * input : vector containing the origine nodes of the arcs. * output : the components from FR(ARCS+1) to FR(ARCS+NODES) * contain the origine node of the atificial arcs. * tt ( int ) * input : vector containing the end node of the arcs. * output : the components from TT(ARCS+1) to TT(ARCS+NODES) * contain the end node of the artificial arcs. * x ( dble ) * input : the current iterate vector. * output : the components from X(ARCS+1) to X(ARCS+NODES) * are the values of the artificial arcs. * feasbl ( log ) * input : meaningless. * output : .true. if the flow X is feasible, * .false. otherwise. * tolfsb ( dble ) * input : tolerance used to test if a constraint is * verified or not. * output : unmodified. * aflow ( dble ) * input : meaningless. * output : = 0.0D0 if the flow X is feasible. * Otherwise, it is equal to the sum of * the flows of the artificial arcs, which * is the value of the linear objective * function to minimize to obtain a * feasible flow X. * sumbi ( dble ) * input : the sum of the right hand side components. * output : unmodified. * ipdevc ( int ) * input : output device unit number for printing messages. * output : unmodified. * what ( int ) * input : >= 2, the routine prints out the message saying * if the flow is feasible or not. * < 2, no output is produced. * output : unmodified. * Routines used : * --------------- * max, abs. * rhs. * Programming : * ------------- * D. Tuyttens * ========================================================================= * Routine parameters integer fr(*), tt(*), ipdevc, what logical feasbl double precision x(*), aflow, tolfsb, sumbi * Internal variables integer naa, i, if, it, nd1 double precision rest, xmax, xi, rhs, infeas * 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. * nd1 = nodes + 1 xmax = zero feasbl = .true. infeas = zero aflow = zero naa = arcs * * We compute the residual vector b-Ax and we * store it in X(ARCS+i) for i=1 up to i=NODES. * do 10 i = 1, nodes x(arcs+i) = rhs(i) 10 continue * do 20 i = 1, arcs if = fr(i) it = tt(i) xi = x(i) x(arcs+if) = x(arcs+if) - xi x(arcs+it) = x(arcs+it) + xi xmax = max( xmax, abs(xi) ) 20 continue * * We loop on the constraints and we test if * they are verified. * do 30 i = 1 , nodes naa = naa + 1 rest = dabs(x(naa)) feasbl = feasbl .and. + rest.le.( tolfsb*(one+abs(rhs(i))+xmax) + sumbi ) infeas = max( infeas , rest ) * * The orientation of the artificial arc is chosen to * enforce the nonnegativity of its associated flow. * if( x(naa).ge.zero ) then aflow = aflow + x(naa) fr(naa) = i tt(naa) = nd1 else x(naa) = -x(naa) aflow = aflow + x(naa) fr(naa) = nd1 tt(naa) = i endif 30 continue * if( feasbl ) then * * The flow X is feasible. * if( what.ge.2 ) write (ipdevc,70) infeas, sumbi 70 format (/' * FLOW IS FEASIBLE *'/ + ' NORM OF INFEASIBILITY = ',D12.5/ + ' SUM OF THE RHS VALUES = ',D12.5) else * * The flow X is infeasible * if( what.ge.2 ) write (ipdevc,60) infeas, sumbi 60 format (/' * FLOW IS INFEASIBLE *'/ + ' NORM OF INFEASIBILITY = ',D12.5/ + ' SUM OF THE RHS VALUES = ',D12.5) endif * return end