*     ------------------------------------------------------------------
*     File sntoy.f  (Unix version)
*
*     This is a main program to illustrate the use of subroutine SNOPT,
*     which is part of the SNOPT 5.3 package.
*
*     31 Jul 1996: First   version.
*     07 Feb 1998: Current version.
*     ------------------------------------------------------------------
      program            sntoy
      implicit           double precision (a-h,o-z)

      parameter        ( maxm   = 100,
     $                   maxn   = 100,
     $                   maxne  = 300,
     $                   nName  = 1 )

      character*8        Prob
      character*8        Names(nName)
      integer            ha(maxne) , hs(maxn+maxm)
      integer            ka(maxn+1)
      double precision   a(maxne)  , bl(maxn+maxm), bu(maxn+maxm),
     $                   x(maxn+maxm), pi(maxm)   , rc(maxn+maxm)

*     SNOPT workspace

      parameter          (  lenrw = 20000)
      double precision   rw(lenrw)
      parameter          (  leniw = 10000) 
      integer            iw(leniw)
      parameter          (  lencw =   500) 
      character*8        cw(lencw)

      external           funcon, funobj

      logical            byname
      character*20       lfile
*     ------------------------------------------------------------------
*     Give a name to the Problem.

      Prob = 'Toy NLP '

*     Specify some of the SNOPT files.
*     iSpecs  is the Specs file   (0 if none).
*     iPrint  is the Print file   (0 if none).
*     iSumm   is the Summary file (0 if none).
*
*     nout    is an output file used here by sntoy.

      iSpecs = 4
      iPrint = 15
      iSumm  = 6

      nout   = 6

      byname = .true.
 
      if ( byname ) then

*        Unix and DOS systems.  Open the Specs and print files.

         lfile = 'sntoy.spc'
         open( iSpecs, file=lfile, status='OLD',     err=800 )

         lfile = 'sntoy.out'
         open( iPrint, file=lfile, status='UNKNOWN', err=800 )
      end if

*     ------------------------------------------------------------------
*     First,  snInit MUST be called to initialize optional parameters 
*     to their default values.
*     ------------------------------------------------------------------
      call snInit( iPrint, iSumm,
     $             cw, lencw, iw, leniw, rw, lenrw )

*     ------------------------------------------------------------------
*     Read a Specs file (optional). 
*     ------------------------------------------------------------------
      call snSpec( iSpecs, inform,
     $             cw, lencw, iw, leniw, rw, lenrw )

      if (inform .ge. 2) then
         write(nout, *) 'iSpecs > 0 but no Specs file found'
         go to 990
      end if

*     ------------------------------------------------------------------
*     Define what we mean by an infinite bound.
*     ------------------------------------------------------------------
      BigBnd  =  1.0d+18
      call snsetr( 'Infinite Bound', BigBnd, iPrint, iSumm, inform,
     $             cw, lencw, iw, leniw, rw, lenrw )

*     ------------------------------------------------------------------
*     Set up the problem constraints and bounds.
*     Assign dummy values for the nonlinear Jacobian elements. 
*     ------------------------------------------------------------------
      call ToyDat( Prob, maxm, maxn, maxne, inform,
     $             m, n, ne, nnCon, nnObj, nnJac, iObj,
     $             ObjAdd, BigBnd,
     $             a, ha, ka, bl, bu, hs, x, pi )

*     ------------------------------------------------------------------
*     Specify options that were not set in the Specs file.
*     i1 and i2 may refer to the Print and Summary file respectively.
*     Setting them to 0 suppresses printing.
*     ------------------------------------------------------------------
      itnlim = 250
      i1     =   0
      i2     =   0
      call snseti( 'Iterations        ', itnlim, i1, i2, inform,
     $             cw, lencw, iw, leniw, rw, lenrw )

*     ------------------------------------------------------------------
*     Go for it, using a Cold start.
*     hs     need not be set if a basis file is to be input.
*            Otherwise, each hs(1:n) should be 0, 1, 2, 3, 4, or 5.
*            The values are used by the Crash procedure m2crsh
*            to choose an initial basis B.
*            If hs(j) = 0 or 1, column j is eligible for B.
*            If hs(j) = 2, column j is initially superbasic (not in B).
*            If hs(j) = 3, column j is eligible for B and is given
*                          preference over columns with hs(j) = 0 or 1.
*            If hs(j) = 4 or 5, column j is initially nonbasic.
*     ------------------------------------------------------------------
      call snopt ( 'Cold', m, n, ne, nName,
     $             nnCon, nnObj, nnJac,
     $             iObj, ObjAdd, Prob,
     $             funcon, funobj, 
     $             a, ha, ka, bl, bu, Names,
     $             hs, x, pi, rc, 
     $             inform, mincw, miniw, minrw,
     $             nS, nInf, sInf, Obj,
     $             cw, lencw, iw, leniw, rw, lenrw, 
     $             cw, lencw, iw, leniw, rw, lenrw )

      if (inform .eq. 42 .or. inform .eq. 43 .or. inform .eq. 44) then
         write(nout, *) ' '
         write(nout, *) 'Estimate of required lencw:', mincw
         write(nout, *) 'Estimate of required leniw:', miniw
         write(nout, *) 'Estimate of required lenrw:', minrw
         go to 910
      end if

      write(nout, *) ' '
      write(nout, *) 'snopt finished.'
      write(nout, *) 'inform =', inform
      write(nout, *) 'nInf   =', nInf
      write(nout, *) 'sInf   =', sInf
      write(nout, *) 'obj    =', obj
      if (inform .ge. 20) go to 910
      stop

*     ------------------------------------------------------------------
*     Error exit.
*     ------------------------------------------------------------------
  800 write(nout, 4000) 'Error while opening file', lfile
      stop

  910 write(nout, *) ' '
      write(nout, *) 'STOPPING because of error condition'

  990 stop

 4000 format(/  a, 2x, a  )

*     end of main program to test subroutine snopt
      end