*     *************************************************************************

      subroutine endprt( ipdevc, what, x, xst, su, nsu, ba, nba, nb,
     +                   itmaj, itmin, itcg, itcgmx, nefval, negval,
     +                   nehval, npiv, ndacts,  nacti,  rgra,  epsf,
     +                   finit,  fx )

*     *************************************************************************

*     Purpose :
*     ---------

*     This routine prints out the statistics of the minimization
*     procedure. The strict complementarity at the end solution
*     is also tested. When WHAT=0, no output is generated.

*     Parameters :
*     ------------

*     ipdevc  ( int )

*       input  : output device unit number for printing messages.
*       output : unmodified.

*     what    ( int )

*       input  : = 0, no output is produced,
*                > 0, the statistics of the minimization are
*                     printed.
*       output : unmodified.

*     x       ( dble )

*       input  : the end feasible solution vector.
*       output : unmodified.

*     xst     ( int )

*       input  : vector containing the status of the variables.
*       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.

*     ba      ( int )

*       input  : vector containing the indices of the basic
*                variables.
*       output : unmodified.

*     nba     ( int )

*       input  : the number of basic variables.
*       output : unmodified.

*     nb      ( int )

*       input  : the number of nonbasic variables.
*       output : unmodified.

*     itmaj   ( int )

*       input  : the number of major iterations performed.
*       output : unmodified.

*     itmin   ( int )

*       input  : the number of minor iterations performed.
*       output : unmodified.

*     itcg    ( int )

*       input  : the number of conjugate gradient iterations
*                performed.
*       output : unmodified.

*     itcgmx  ( int )

*       input  : the maximal number of conjugate gradient
*                iterations needed if all the linear system
*                were solved exactly.
*                We consider here that a NxN linear system
*                requires N conjugate gradient iterations to
*                be solved exactly.
*                This quantity is used to estimate the average
*                size of the linear systems solved during the
*                minimization.
*       output : unmodified.

*     nefval  ( int )

*       input  : the number of element functions evaluations.
*       output : unmodified.

*     negval  ( int )

*       input  : the number of element gradients evaluations.
*       output : unmodified.

*     nehval  ( int )

*       input  : the number of element Hessians evaluations.
*       output : unmodified.

*     npiv    ( int )

*       input  : the number of iterations involving a pivoting.
*       output : unmodified.

*     ndacts  ( int )

*       input  : the number of variables that have been de-activated
*                during the minimization.
*       output : unmodified.

*     nacti   ( int )

*       input  : the number of variables that have been activated
*                during the minimization.
*       output : unmodified.

*     rgra    ( dble )

*       input  : the reduced gradient vector.
*       output : unmodified.

*     epsf    ( dble )

*       input  : measure of accuracy required to stop the
*                minimization procedure.
*       output : unmodified.

*     finit   ( dble )

*       input  : the value of the objective function estimated
*                at the starting point.
*       output : unmodified.

*     fx      ( dble )

*       input  : the value of the objective function estimated
*                at the solution X.
*       output : unmodified.

*     Routines used :
*     ---------------

*     xlower, xupper, gxbdg, gxnb, normrg.

*     Programming :
*     -------------

*     D. Tuyttens

*     ========================================================================

*     Routine parameters

      integer           ipdevc,  xst(*), su(*), nsu, nba, nb, itmaj,
     +                  itmin, itcg, itcgmx, nefval, negval, nehval,
     +                  npiv,  ndacts,  nacti,  what,  ba(*)
      double precision  x(*),  rgra(*), epsf,  finit,  fx

*     Internal variables

      integer           k, act
      logical           compl, gxnb, gxbdg
      double precision  rgnor, rgmax
      real              ro, rog, rop
      character*6       f
      double precision  xlower, xupper

*     Common specifications

      integer           arcs, nodes, elem
      real              fcpu, gcpu, hcpu
      real              xocpu, totcpu, cgcpu, prdcpu, lnscpu, updcpu
      common / prbdim / arcs, nodes, elem
      common / fghcp  / fcpu, gcpu, hcpu
      common / prbcpu / xocpu, totcpu, cgcpu, prdcpu, lnscpu, updcpu

*
*     Title of the output.
*
      if( what.gt.0 ) write(ipdevc,1040)
 1040 format(/' * STATISTICS :',/,
     +        ' --------------'/)
*
*     A loop is made on all the variables :
*      1. to test the feasibility of the variables,
*      2. to obtain the number of active variables at the solution,
*      3. to check the strict complementarity at the solution.
*
      act   = 0
      compl = .false.
      do 10 k = 1 , arcs
*
*       We test if the variables are still between their bounds.
*
        if( x(k).lt.xlower(k) .or. x(k).gt.xupper(k) ) then
          write(ipdevc,1234) k
 1234     format(' Variable ',i3,' is not between the bounds !!!')
        endif
*
*       The number of active variables is updated if necessary.
*
        if( gxbdg(xst(k)) ) act = act + 1
*
*       The strict complementarity is checked.
*
        compl = compl .or. ( gxnb(xst(k)) .and. rgra(k).le.epsf )
 10   continue
      if( compl ) then
        if( what.gt.0 ) write(ipdevc,1000)
 1000   format(/' Strict complementarity is not verified. ')
      endif
*
*     Data for statistics.
*
      if( what.eq.0 ) then
        write(6,*) ' Nom du fichier  .res ?'
        read(*,7000) f
 7000   format(a6)
        open(unit=15,file=f//'.res',status='new' )
*
        call normrg( rgmax, rgnor, rgra, su, nsu )
        if( compl ) nacti = 9999
        write(15,7001) itmaj,itmin,float(nefval)/float(elem),
     +                 float(negval)/float(elem),
     +                 float(nehval)/float(elem),
     +                 itcg,float(itcgmx)/float(itmin),
     +                 fx,rgmax,rgnor,
     +                 act,npiv,ndacts,nacti
 7001   format(2(1x,i4),3(1x,f7.1),1x,i5,1x,f6.1,1x,d14.7,
     +         2(1x,d8.1),4(1x,i4))

        if( negval.ne.0 .and. itcg.ne.0 ) then
          rog = (gcpu*elem)/negval
          rop = prdcpu/itcg
          ro  = rog / rop
        else
          ro  = 0.
        endif
        write(15,7002) xocpu/1000.,totcpu/1000.,
     +                 fcpu/1000.,gcpu/1000.,hcpu/1000.,
     +                 cgcpu/1000.,prdcpu/1000.,
     +                 lnscpu/1000.,updcpu/1000.,ro
 7002   format(10(1x,f8.2))

        return
      endif
*
*     Printing the statistics of the minimization.
*
      if( what.ge.1 .and. what.le.4 ) then
        call normrg( rgmax, rgnor, rgra, su, nsu )
        write(ipdevc,3000)
        write(ipdevc,3501)
        write(ipdevc,3001) arcs
        write(ipdevc,3002) nodes
        write(ipdevc,3003) elem
        write(ipdevc,3000)
        write(ipdevc,3502)
        write(ipdevc,3004) finit
        write(ipdevc,3005) fx
        write(ipdevc,3000)
        write(ipdevc,3503)
        write(ipdevc,3006) itmaj
        write(ipdevc,3007) itmin
        write(ipdevc,3008) npiv
        write(ipdevc,3009) itcg
        write(ipdevc,3010) float(itcgmx)/float(max(itmin,1))
        write(ipdevc,3025) float(nefval)/float(elem)
        write(ipdevc,3026) float(negval)/float(elem)
        write(ipdevc,3027) float(nehval)/float(elem)
        write(ipdevc,3000)
        write(ipdevc,3504)
        write(ipdevc,3011) nsu
        write(ipdevc,3012) act
        write(ipdevc,3013) ndacts
        write(ipdevc,3014) nacti
        write(ipdevc,3000)
        write(ipdevc,3015) epsf
        write(ipdevc,3016) rgmax
        write(ipdevc,3017) rgnor
        write(ipdevc,3000)
        write(ipdevc,3506)
        write(ipdevc,3018) xocpu/1000.
        write(ipdevc,3019) totcpu/1000.
        write(ipdevc,3020) cgcpu/1000.
        write(ipdevc,3021) prdcpu/1000.
        write(ipdevc,3022) lnscpu/1000.
        write(ipdevc,3023) updcpu/1000.
        write(ipdevc,3024)
*
 3000   format('  ')
 3501   format(' Problem specifications ')
 3001   format('   number of arcs                 :',i6)
 3002   format('   number of nodes                :',i6)
 3003   format('   number of elements             :',i6)
 3502   format(' Function value ')
 3004   format('   at starting point              :',d13.6)
 3005   format('   at optimum point               :',d13.6)
 3503   format(' Iterations counts ')
 3006   format('   Major iterations               :',i6)
 3007   format('   minor iterations               :',i6)
 3008   format('   pivoting iterations            :',i6)
 3009   format('   C.G. iterations                :',i6)
 3010   format('   average dimension              :',f6.1)
 3025   format('   function calls                 :',f6.1)
 3026   format('   gradient calls                 :',f6.1)
 3027   format('   Hessian  calls                 :',f6.1)
 3504   format(' Variables status at optimum ')
 3011   format('   superbasics at optimum         :',i6)
 3012   format('   actives at optimum             :',i6)
 3013   format('   de-activated variables         :',i6)
 3014   format('   activated variables            :',i6)
 3505   format(' Stopping criteria ')
 3015   format('   final tolerance required       :',d13.6)
 3016   format('   reduced gradient inf. norm     :',d13.6)
 3017   format('   reduced gradient l2 norm       :',d13.6)
 3506   format(' C.P.U. time for ')
 3018   format('   initial solution               :',f6.1)
 3019   format('   optimization                   :',f6.1)
 3020   format('   congugate gradient             :',f6.1)
 3021   format('   matrix vector products         :',f6.1)
 3022   format('   linesearch                     :',f6.1)
 3023   format('   Hessian updates                :',f6.1)
 3024   format(/' ********** END OF STATISTICS ********** ')

      endif
*
      return
      end