* ************************************************************************* subroutine fdingf( iel, elptr, elvar, x, w1, w2, w3, + gptr, fuval, nefval, inform ) * ************************************************************************* * Purpose : * --------- * This routine estimates the IELth element gradient vector * by forward differences in the element function values. * This IELth element gradient has an internal representation. * Every time information on the element function value is needed, * a return is made to the main program. This routine is then * re-entered with the information available and the calculation * proceeds. * Parameters : * ------------ * iel ( int ) * input : the indice of the element gradient vector * that will be estimated. * 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. * elvar ( int ) * input : array containing the indices of the varaibles * in the first element, followed by those in the * second element, etc. * output : unmodified. * x ( dble ) * input : the current iterate vector. * output : unmodified. * w1 ( dble ) * input : array used as workspace. * output : meaningless. * w2 ( dble ) * input : array used as workspace. * output : meaningless. * w3 ( dble ) * input : array used as workspace. * output : meaningless. * gptr ( int ) * input : array whose ith value is the position of the * first component of the ith element gradient * in FUVAL. * output : unmodified. * fuval ( dble ) * input : array used to store the function and derivative * values of the element functions. * output : the components of indices GPTR(IEL) up to * GPTR(IEL+1)-1 will be set to the estimate * of the element gradient vector by forward * differences in the element function values. * nefval ( int ) * input : the number of element function evaluations. * output : this number is increased by one each time * one element function needs to be evaluated. * inform ( int ) * input : must be set to zero the first time this routine * is called. * If it is not equal to zero, the routine is re-entered * with an element function value that was needed * to proceed the calculation. * output : If it is not equal to zero, an element function * value is needed to proceed the calculation. A return * is then made to the main program. * Otherwise, no further information is needed. * Routines used : * --------------- * sqrt. * range, dcopcd, dsetvl, dxpycd. * Programming : * ------------- * D. Tuyttens * ======================================================================== * Routine parameters integer iel, elptr(*), elvar(*), gptr(*), + nefval, inform double precision x(*), w1(*), w2(*), w3(*), fuval(*) * Internal variables integer i, debg, debx, eldim, intdim double precision sqrem, tempf * Save variables save i, debg, debx, eldim, intdim save sqrem, tempf * 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 * * Reverse communication test. * if( inform.ne.0 ) goto 100 * * Estimate of the IELth element gradient vector by * forward differences in the element function values. * sqrem = sqrt(epsmch) debg = gptr(iel)-1 debx = elptr(iel) eldim = elptr(iel+1) - elptr(iel) call range( iel, eldim, intdim, w1, w2, 0 ) call dcopcd( eldim, elvar(debx), x, w3 ) call dsetvl( intdim, w1, 1, zero ) * tempf = fuval(iel) i = 1 10 continue w1(i) = sqrem call range( iel, eldim, intdim, w1, w2, 3 ) w1(i) = zero call dxpycd( eldim, elvar(debx), x, w2 ) nefval = nefval + 1 inform = 7 return * * Element function evaluation. * 100 continue inform = 0 fuval(debg+i) = ( fuval(iel) - tempf ) / sqrem call dcopcd( eldim, elvar(debx), w3, x ) i = i + 1 if( i .le. intdim ) go to 10 fuval(iel) = tempf * return end