* ************************************************************************* subroutine qatst( nqa, su, nsu, x, rgra, d, kdist ) * ************************************************************************* * Purpose : * --------- * This routine counts the number of superbasic variables * that are quasi-active and returns it in NQA. * The set of indices of the superbasic variables SU is * reordered. The first NSU-NQA indices correspond to the * non quasi-active superbasic variables, while the last NQA * indices correspond to the quasi-active superbasic variables. * Parameters : * ------------ * nqa ( int ) * input : meaningless. * output : the number of quasi-active superbasic variables. * su ( int ) * input : array of length NSU, containing the indices * of the superbasic variables. * output : this vector is reordered in such a way that * the first NSU-NQA indices corresponds to the * non quasi-active variables, and the last NQA * indices correspond to the quasi-active variables. * nsu ( int ) * input : the number of superbasic variables. * output : unmodified. * x ( dble ) * input : the current feasible iterate vector. * output : unmodified. * rgra ( dble ) * input : the reduced gradient vector. * output : unmodified. * d ( dble ) * input : array used as workspace. * It will contain the distance between * the iterate value and the bound in the * direction of minus the reduced gradient. * output : meaningless. * kdist ( int ) * input : array containing the number of basic arcs * contained in the flow augmenting path of * all the superbasic variables. * output : this vector is reordered in the same way * as the vector SU. * Routines used : * --------------- * abs, min, sqrt. * Programming : * ------------- * D. Tuyttens * ======================================================================== * Routine parameters integer nqa, su(*), nsu, kdist(*) double precision x(*), rgra(*), d(*) * Internal variables integer k, ik, end, aux double precision etaqa, a, ub, lb, tolqa, xupper, xlower * Common specifications double precision epsmch, huge, tiny, tol 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 * * Evaluate the quasi-active tolerance ETAQA. * This quantity will be used to test if a * superbasic variable is quasi-active or not. * tolqa = tenm4 * tenm1 etaqa = zero do 10 ik = 1 , nsu k = su(ik) a = x(k) - rgra(k) * * Compute the distance to the nearest bound * in direction of minus the reduced gradient. * if( rgra(k).lt.zero ) then ub = xupper(k) d(k) = ub - x(k) if( ub-a .le. tol*(one+abs(ub)) ) a = ub else lb = xlower(k) d(k) = lb - x(k) if( a-lb .le. tol*(one+abs(lb)) ) a = lb endif * * Update the quasi-active tolerance. * a = min( tolqa , abs(x(k)-a) ) etaqa = etaqa + a**2 10 continue * * The quasi-active tolerance is obtained in ETAQA. * etaqa = min( sqrt(etaqa) , tolqa ) * * Loop on the superbasic variables. * end = nsu do 20 ik = nsu , 1 , -1 k = su(ik) if( abs(d(k)).gt.etaqa ) then * * The variable K is not quasi-active. * d(k) = zero else * * The variable K is quasi-active. * We reorder the vectors SU and KDIST. * aux = su(end) su(end) = su(ik) su(ik) = aux aux = kdist(end) kdist(end) = kdist(ik) kdist(ik) = aux end = end - 1 endif 20 continue * * We store the number of quasi-active superbasic * variables in NQA. * nqa = nsu - end * return end