* ************************************************************************* subroutine tblock( block, k, kdis, bep, rgra, x ) * ************************************************************************* * Purpose : * --------- * This routine checks if the nonbasic variable K candidate * for de-activation is blocked ( BLOCK = .true. ) or not * ( BLOCK = .false. ). * Parameters : * ------------ * block ( log ) * input : meaningless. * output : .true. iff the variable K is blocked. * .false. otherwise. * k ( int ) * input : the nonbasic variable that will be checked. * output : unmodified. * kdis ( int ) * input : the number of basic variables composing * the flow augmenting path of the nonbasic * variable K. * output : unmodified. * bep ( int ) * input : array containing the indices and the orientations * of the basic variables composing the flow augmenting * path of the nonbasic arc K. * output : unmodified. * rgra ( dble ) * input : the reduced gradient vector. * output : unmodified. * x ( dble ) * input : the current iterate vector. * output : unmodified. * Routine used : * -------------- * abs. * Programming : * ------------- * D. Tuyttens * ========================================================================= * Routine parameters integer k, kdis, bep(*) logical block double precision x(*), rgra(*) * Internal variables integer i, kk logical tlb, tub double precision xupper, xlower, ub, lb * 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 block = .false. * * Loop on the basic variables composing the flow augmenting * path of the nonbasic variable K. * do 10 i = 1 , kdis * kk = abs(bep(i)) lb = xlower(kk) tlb = x(kk)-lb .le. tol*(one+abs(lb)) ub = xupper(kk) tub = ub-x(kk) .le. tol*(one+abs(ub)) * * Test if the nonbasic arc K is blocked ? * if( ( tlb .and. rgra(k)*bep(i).gt.zero ) .or. + ( tub .and. rgra(k)*bep(i).lt.zero ) ) then block = .true. return endif * 10 continue * return end