* ************************************************************************* subroutine hrgra( fuval, gptr, gra, rgra, pi, w2, pr, thr, + depth, fr, to, elvar, elptr, ba, su, nsu, + elst, xst, nroot ) * ************************************************************************* * Purpose : * --------- * This routine computes the reduced gradient vector by using * the constraints Lagrange multipliers. * Only the components corresponding to the indices of the * superbasic set SU are computed. * Parameters : * ------------ * fuval ( dble ) * input : array used to store the function and derivative * values for the element functions. * output : unmodified. * gptr ( int ) * input : array whose ith value is the position of the * first component of the ith element gradient * in FUVAL. * output : unmodified. * gra ( dble ) * input : meaningless. * output : the gradient vector of the objective function. * rgra ( dble ) * input : the reduced gradient vector. * output : the components corresponding to the indices * SU(i) for i=1 up to i=NSU are computed. * pi ( dble ) * input : array used as workspace. * output : it contains the constraint Lagrange multipliers. * w2 ( dble ) * input : array used as workspace. * output : meaningless. * pr ( int ) * input : the predecessor vector. * output : unmodified. * thr ( int ) * input : the traversal vector. * output : unmodified. * depth ( int ) * input : the depth vector. * 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. * elvar ( int ) * input : array containing the indices of the variables * in the first element, followed by those in the * second element, etc. * output : unmodified. * elptr ( int ) * input : array whose kth value is the position of the * first variable of element k, in the list ELVAR. * output : unmodified. * ba ( int ) * input : vector containing the indices of the basic * variables. The ith component corresponds to * the indice of the basic arc having endnodes * i and PR(i). * 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. * elst ( int ) * input : vector containing the status of the element * functions. * output : unmodified. * xst ( int ) * input : vector containing the status of the variables. * output : unmodified. * nroot ( int ) * input : the root of the subgraph used. * output : unmodified. * Routine used : * -------------- * assgra, gxndis. * Programming : * ------------- * D. Tuyttens * ========================================================================= * Routine parameters double precision fuval(*), gra(*), rgra(*), pi(*), w2(*) integer pr(*), thr(*), depth(*), fr(*), to(*), + elvar(*), elptr(*), ba(*), su(*), nsu, + elst(*), xst(*), gptr(*), nroot * Internal variables integer nn, nnpr, ik, k, depth1 logical gxndis * Common specifications integer arcs, nodes, elem common / prbdim / arcs, nodes, elem * * Assemble the gradient of the objective function from * the element gradients vectors stored in FUVAL. * call assgra( fuval, gptr, gra, w2, elptr, elvar, elst ) * * We evaluate by recursion the constraints Lagrange * multipliers, only at the nodes ( the constraints ) * of the subgraph used during the current iteration. * We start from the root node NROOT. * depth1 = depth(nroot) pi(nroot) = 0 nn = thr(nroot) 10 nnpr = pr(nn) * * K is the indice of the basic arc having * endnodes NN and PR(NN). * k = ba(nn) * * We obtain the constraint Lagrange multiplier at node NN * from the constraint Lagrange multiplier at node NNPR. * if( fr(k).eq.nnpr ) then pi(nn) = pi(nnpr) - gra(k) else pi(nn) = pi(nnpr) + gra(k) endif * * We go through the tree, using the traversal array THR. * 20 nn = thr(nn) if( nn.ne.nodes+1 .and. depth(nn).gt.depth1 ) then if( .not.gxndis(xst(nn)) ) go to 20 go to 10 endif * * We obtain the reduced gradient vector. * do 40 ik = 1 , nsu k = su(ik) rgra(k) = gra(k) - pi(fr(k)) + pi(to(k)) 40 continue * return end