* ************************************************************************ subroutine inptst( elptr, gptr, hptr, elst, dbstr, xst, wk, + info, iflag ) * ************************************************************************ * Purpose : * --------- * This routine builds the gradient and the Hessian pointers * lists. It also initializes the status of the element * functions and the status of the variables. * Parameters : * ------------ * elptr ( int ) * input : array whose kth value is the position of the * first variable of element k, in the list ELVAR. * output : unmodified. * gptr ( int ) * input : meaningless. * output : array whose ith value is the position of the * first component of the ith element gradient * in FUVAL. * hptr ( int ) * input : meaningless. * output : array whose ith value is the position of the * first component of the ith element Hessian * in FUVAL. * elst ( int ) * input : vector containing the status of the element * functions. * output : this status vector is initialized corresponding * to the input value of ELST defined by the user. * dbstr ( log ) * input : meaningless. * output : .true. if at least one element function is * treated with Dembo'strategy * .false. otherwise. * xst ( int ) * input : vector containing the status of the variables. * output : this status vector is initialized corresponding * to the input value of XST defined by the user. * wk ( int ) * input : array used as workspace. * output : meaningless. * info ( int ) * input : meaningless. * output : if IFLAG = 0, meaningless. * if IFLAG = 6, the indice of the element function * for which the input status corresponds to a facility * that is not available. * iflag ( int ) * input : should be zero. * output : 6 iff the input status of an element function * corresponds to a facility that is not available. * 0 otherwise. * Routine used : * -------------- * Inelst, selint, range, inxst. * Programming : * ------------- * D. Tuyttens * ======================================================================== * Routine parameters integer elptr(*), gptr(*), hptr(*), elst(*), xst(*), + info, iflag double precision wk(*) logical dbstr * Internal variables. integer iel, eldim, intdim, dimaux * Common specifications integer arcs, nodes, elem common / prbdim / arcs, nodes, elem * * Initialization of the gradient and * the Hessian pointers. * gptr(1) = elem + 1 hptr(1) = elem + 1 * * Loop on the elements functions. * dbstr = .false. * do 10 iel = 1, elem * * Check the validity of the input status * for element IEL. * if( elst(iel).eq.-8 ) then info = iel iflag = 6 return endif * * Correct the input status if necessary. * if( elst(iel).eq.-2 .or. elst(iel).eq.-5 ) then elst(iel) = elst(iel) - 1 endif * * Initialize the status of the element function IEL. * call inelst(elst(iel)) eldim = elptr(iel+1) - elptr(iel) call range( iel, eldim, intdim, wk, wk, 0 ) * * Test if element function IEL has an elemental * or an internal representation. * if( intdim.lt.eldim ) then * * Internal dimension case. * call selint(elst(iel)) if( mod(elst(iel),8) .eq. 7 ) then hptr(iel+1) = hptr(iel) dbstr = .true. else hptr(iel+1) = hptr(iel) + ( intdim * ( intdim + 1 ) ) / 2 endif gptr(iel+1) = gptr(iel) + intdim * else * * Elemental dimension case. * if( mod(elst(iel),8) .eq. 7 ) then hptr(iel+1) = hptr(iel) dbstr = .true. else hptr(iel+1) = hptr(iel) + ( eldim * ( eldim + 1 ) ) / 2 endif gptr(iel+1) = gptr(iel) + eldim * endif * 10 continue * dimaux = gptr(elem+1) - gptr(1) do 20 iel = 1 , elem+1 hptr(iel) = hptr(iel) + dimaux 20 continue * * Initialization of the status of the variables. * call inxst( xst, arcs ) * return end