* ************************************************************************* subroutine assgra( fuval, gptr, gra, w2, elptr, elvar, elst ) * ************************************************************************* * Purpose : * --------- * This routine computes the gradient vector GRA of the objective * function. This vector GRA is obtained by assembling the gradient * vectors of the element functions that are stored in FUVAL in their * elemental or internal form. * Parameters : * ------------ * fuval ( dble ) * input : vector in which are stored 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 : it contains the gradient vector of the * objective function. * w2 ( dble ) * input : array used as workspace. * output : meaningless. * elptr ( int ) * input : array whose kth value is the position of the * first variable of element k, in the list ELVAR. * 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. * elst ( int ) * input : array containing the status of the element * functions. * output : unmodified. * Routine used : * -------------- * dsetvl, range, scattr, elint. * Programming : * ------------- * D. Tuyttens * ========================================================================= * Routine parameters integer gptr(*), elptr(*), elvar(*), elst(*) double precision fuval(*), gra(*), w2(*) * Internal variables integer iel, debg, eldim, intdim, elbeg logical elint * 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 * * Initialization of the gradient vector GRA to zero. * call dsetvl( arcs, gra, 1, zero ) * * Loop on the element functions. * do 10 iel = 1 , elem * * Get informations about the element function. * debg = gptr(iel) elbeg = elptr(iel) eldim = elptr(iel+1) - elptr(iel) * * Assemble the gradient in GRA from the gradient vectors * of the element functions that are stored in FUVAL in * their elemental or internal form. * if( elint(elst(iel)) ) then call range( iel, eldim, intdim, fuval(debg), w2, 2 ) call scattr( eldim, w2, 1, gra, elvar(elbeg) ) else call scattr( eldim, fuval(debg), 1, gra, elvar(elbeg) ) endif 10 continue * return end