* ************************************************************************* subroutine fgh0( inform, x, xst, elst, elptr, elvar, + fx, fuval, fcalc, lfc, gptr, lg, hptr, + nefval, negval, nehval, w1, w2, w3, w4, + prec, dpr ) * ************************************************************************* * Purpose : * --------- * This routine evaluates the objective function value FX * at the current iterate X. The element function values * are stored in array FUVAL. The element gradient vectors * and the element Hessians matrices are also evaluated and * are stored in array FUVAL. * A considerable flexibility in the computation of the * derivatives is provided in LSNNO. If the element gradient * and/or the element Hessian are not supplied by the user, * the software contains an assortment of routines for * computing suitable approximations of these quantities. * The way these quantities will be computed is indicated * in array ELST that contains the status of the elemnt * functions. * Every time informations on some element function values or * on some element gradient values or on some element Hessian * values are needed, a return is made to the main program. * This routine is then re-entered with the information available * and the calculation proceeds. * Parameters : * ------------ * 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 then * re-entered with some information that was needed * to proceed the calculation. * output : If it is not equal to zero, some element function * values or some element gradient values or some * element Hessian values are needed to proceed the * calculation. A return is then made to the main * program. * Otherwise, no further information is needed. * x ( dble ) * input : the current iterate vector. * output : unmodified. * xst ( int ) * input : vector containing the status of the variables. * output : unmodified. * elst ( int ) * input : vector containing the status of the element * functions. * 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. * fx ( dble ) * input : meaningless. * output : the objective function value evaluated at * the current iterate X. * fuval ( dble ) * input : array used to store the function and derivative * values of the element functions. * output : it contains the function and derivative values * of the element functions estimated at the current * iterate X. * fcalc ( int ) * input : meaningless. * output : this vector contains the indices of the element * functions for which information is required. * lfc ( int ) * input : meaningless. * output : the number of element functions for which * information is required. * gptr ( int ) * input : array whose ith value is the position of the * first component of the ith element gradient * in FUVAL. * output : unmodified. * lg ( int ) * input : the total lenght of the element gradient vectors. * output : unmodified. * hptr ( int ) * input : array whose ith value is the position of the * first component of the ith element Hessian * in FUVAL. * output : unmodified. * nefval ( int ) * input : the number of element function evaluations. * output : this number is increased by one each time * an element function needs to be evaluated. * negval ( int ) * input : the number of element gradient evaluations. * output : this number is increased by one each time * an element gradient needs to be evaluated. * nehval ( int ) * input : the number of element Hessian evaluations. * output : this number is increased by one each time * an element Hessian needs to be evaluated. * 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. * w4 ( dble ) * input : array used as workspace. * output : meaningless. * prec ( log ) * input : .true. if the user wants to use a preconditioned * conjugate gradient scheme to solve the linear * systems of equations which arise at each * iteration of the minimization procedure. * .false. if the user does not want to use a * preconditioner. * output : unmodified. * dpr ( dble ) * input : meaningless vector. * output : initialized Dembo preconditioner. * Routines used : * --------------- * mod. * analg, elint, fdingf, fdelgf, fdinhg, fdelhg, * fdinhf, fdelhf, range, hessid, dsetvl. * Programming : * ------------- * D. Tuyttens * ======================================================================== * Routine parameters integer inform, xst(*), elst(*), elptr(*), + elvar(*), gptr(*), lg, hptr(*), nefval, + negval, nehval, fcalc(*), lfc logical prec double precision x(*), fx, fuval(*), w1(*), w2(*), + w3(*), w4(*), dpr(*) * Internal variables integer iel, els, dim, eldim, intdim, ifc logical analg, elint * Save variables save iel, els, dim, eldim, intdim, ifc * 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 * * Reverse communication test. * if( inform.ne.0 ) then go to( 200, 150, 160, 500, 500, + 300, 300, 700, 700, 700, + 700, 700, 700, 100 ) inform endif * * All the element functions need to * be evaluated at current iterate X. * lfc = elem do 11 ifc = 1 , lfc fcalc(ifc) = ifc 11 continue nefval = elem inform = 14 return * * Element function evaluations. * 100 continue negval = 0 nehval = 0 inform = 0 * * The objective function value * is computed and stored in FX. * fx = zero do 30 iel = 1 , elem fx = fx + fuval(iel) 30 continue * * We obtain from the informations stored in array * ELST, the way the element gradients and element * Hessians will be estimated. * * * The gradient and the Hessian are provided by the user. * lfc = 0 do 60 iel = 1, elem els = mod( elst( iel ), 8 ) if( analg(elst(iel)) .and. (els .eq. 0 .or. els .eq. 3) ) then lfc = lfc + 1 fcalc(lfc) = iel endif 60 continue * * Element gradient and Hessian evaluations. * if( lfc .gt. 0 ) then negval = negval + lfc nehval = nehval + lfc inform = 2 return endif 150 continue * * Only the gradient is provided by the user. * lfc = 0 do 70 iel = 1, elem els = mod( elst( iel ), 8 ) if( analg(elst(iel)) .and. els .ne. 0 .and. els .ne. 3 ) then lfc = lfc + 1 fcalc(lfc) = iel endif 70 continue * * Element gradient evaluations. * if( lfc .gt. 0 ) then negval = negval + lfc inform = 3 return endif 160 continue * * Only the Hessian is provided by the user. * lfc = 0 do 80 iel = 1, elem els = mod( elst( iel ), 8 ) if( .not. analg(elst(iel)) .and. (els.eq.0 .or. els.eq.3) )then lfc = lfc + 1 fcalc(lfc) = iel endif 80 continue * * Element Hessian evaluations. * if( lfc .gt. 0 ) then nehval = nehval + lfc inform = 1 return endif 200 continue inform = 0 * * The gradient vector is estimated by * differences in the function values. * lfc = 1 if( elem .ge. 1 ) then iel = 1 10 continue if ( .not. analg(elst(iel)) ) then fcalc(1) = iel 300 continue if( elint( elst( iel ) ) ) then * * The element gradient has an internal representation. * call fdingf( iel, elptr, elvar, x, w1, w2, w3, + gptr, fuval, nefval, inform ) else * * The element gradient has an elemental representation. * call fdelgf( iel, elptr, elvar, xst, x, + gptr, fuval, nefval, inform ) endif if( inform.ne.0 ) return * * Element function evaluations. * endif iel = iel + 1 if ( iel .le. elem ) go to 10 endif * * The Hessian matrix is estimated by * differences in the gradient values. * lfc = 1 if ( elem .ge. 1 ) then iel = 1 40 continue els = mod( elst( iel ), 8 ) if( els.eq.1 .or. els.eq.4 ) then fcalc(1) = iel 500 continue if( elint(elst(iel)) ) then * * The element Hessian has an internal representation. * call fdinhg( iel, elptr, elvar, x, w1, w2, w3, w4, + fuval, gptr, hptr, negval, inform ) else * * The element Hessian has an elemental representation. * call fdelhg( iel, elptr, elvar, xst, x, gptr, hptr, + fuval, negval, w1, inform ) endif if( inform.ne.0 ) return * * Element gradient evaluations. * endif iel = iel + 1 if ( iel .le. elem ) go to 40 endif * * The Hessian matrix is estimated by * differences in the function values. * lfc = 1 if ( elem .ge. 1 ) then iel = 1 50 continue els = mod( elst( iel ), 8 ) if( els.eq.2 .or. els.eq.5 ) then fcalc(1) = iel 700 continue if( elint(elst(iel)) ) then * * The element Hessian has an internal representation. * call fdinhf( iel, elptr, elvar, x, w1, w2, w3, w4, + hptr, fuval, nefval, inform ) else * * The element Hessian has an elemental representation. * call fdelhf( iel, elptr, elvar, xst, x, w1, w2, + hptr, fuval, nefval, inform ) endif if( inform.ne.0 ) return * * Element function evaluations. * end if iel = iel + 1 if ( iel .le. elem ) go to 50 endif * * The element Hessian matrix is initialized * to the identity matrix before a quasi-Newton * update is applied. * do 20 iel = 1 , elem if( mod(elst(iel),8) .eq. 6 ) then * * We obtain the dimension of the * Hessian matrix. * eldim = elptr(iel+1) - elptr(iel) if( elint(elst(iel)) ) then call range( iel, eldim, intdim, w1, w2, 0 ) dim = intdim else dim = eldim endif * * We set the Hessian matrix to the identity * matrix. * call hessid( dim, fuval(hptr(iel)), one ) endif 20 continue * * When Dembo's preconditioner is used, * an estimate of the diagonal of the * Hessian matrix is stored in FUVAL. * This estimate is now initialized to * one. * do 90 iel = 1, elem if( mod(elst(iel),8) .eq. 7 .and. prec ) then call dsetvl( elptr(elem+1)-1, dpr(arcs+lg+1), 1, one ) go to 900 endif 90 continue * 900 continue inform = 0 * return end