!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! File:  ct10spec.f90
! Subroutines related to the spec file options.
!
! 24 Dec 2008: Taken from old versions.  Nothing's changed.
! 09 Feb 2010: v5.
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

module ct10spec
  use precision, only : ip, rp
  use ctGlobal,  only : iDisc, iCPrt, iRefn, iRefL, refTol
  implicit none

  private
  public :: ctrl3key, ctrl3opt, ctrl3tie

contains

  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  subroutine ctrl3key ( key, loc )
    integer(ip)   :: loc
    character(16) :: key

    !===================================================================
    ! ctrl3key  sets key to be the standard form for the first keyword
    ! on each line of a SPECS file.
    !
    ! 21 Aug 2008: Current version of ctrl3key.
    !===================================================================
    integer(ip) ::          maxkey
    parameter         (     maxkey = 93)
    character          keys(maxkey)*16
    logical ::         sorted
    parameter         (sorted =   .true.)
    ! ------------------------------------------------------------------
    data &
         keys(  1) /'AIJ          '/, &
         keys(  2) /'BACKUP       '/, &
         keys(  3) /'BOUNDS       '/, &
         keys(  4) /'CALL         '/, &
         keys(  5) /'CENTRAL      '/, &
         keys(  6) /'CG           '/, &
         keys(  7) /'CHECK        '/, &
         keys(  8) /'COEFFICIENTS '/, &
         keys(  9) /'COLD         '/, &
         keys( 10) /'COLUMNS      '/, &
         keys( 11) /'CONTROL      '/, & ! snctrl
         keys( 12) /'CRASH        '/, &
         keys( 13) /'CYCLE        '/, &
         keys( 14) /'DEBUG        '/, &
         keys( 15) /'DEFAULTS     '/, &
         keys( 16) /'DERIVATIVE   '/, &
         keys( 17) /'DIFFERENCE   '/, &
         keys( 18) /'DISCRETIZATION'/,& ! snctrl
         keys( 19) /'DUMP         '/, &
         keys( 20) /'ELASTIC      '/, &
         keys( 21) /'ELEMENTS     '/, &
         keys( 22) /'ERROR        '/

    data &
         keys( 23) /'EXPAND       '/, &
         keys( 24) /'FACTORIZATION'/, &
         keys( 25) /'FEASIBILITY  '/, &
         keys( 26) /'FEASIBLE     '/, &
         keys( 27) /'FUNCTION     '/, &
         keys( 28) /'HESSIAN      '/, &
         keys( 29) /'HOT          '/, &
         keys( 30) /'INFEASIBLE   '/, &
         keys( 31) /'INFINITE     '/, &
         keys( 32) /'INSERT       '/, &
         keys( 33) /'ITERATIONS   '/, &

         keys( 34) /'IW           '/, &
         keys( 35) /'JACOBIAN     '/, &
         keys( 36) /'LINESEARCH   '/, &
         keys( 37) /'LIST         '/, &
         keys( 38) /'LOAD         '/, &
         keys( 39) /'LOG          '/, &
         keys( 40) /'LOWER        '/, &
         keys( 41) /'LP           '/

    data &
         keys( 42) /'LU           '/, &
         keys( 43) /'MAJOR        '/, &
         keys( 44) /'MAXIMIZE     '/, &
         keys( 45) /'MINIMIZE     '/, &
         keys( 46) /'MINOR        '/, &
         keys( 47) /'MPS          '/, &
         keys( 48) /'NEW          '/, &
         keys( 49) /'NO           '/, &
         keys( 50) /'NON          '/, &
         keys( 51) /'NONDERIVATIVE'/, &
         keys( 52) /'NONLINEAR    '/, &
         keys( 53) /'OBJECTIVE    '/, &
         keys( 54) /'OLD          '/, &
         keys( 55) /'OPTIMALITY   '/, &
         keys( 56) /'PARTIAL      '/, &
         keys( 57) /'PENALTY      '/, &
         keys( 58) /'PIVOT        '/, &
         keys( 59) /'PRINT        '/, &
         keys( 60) /'PROBLEM      '/, &
         keys( 61) /'PROXIMAL     '/

    data &
         keys( 62) /'PUNCH        '/, &
         keys( 63) /'QP           '/, &
         keys( 64) /'QPSOLVER     '/, &
         keys( 65) /'RANGES       '/, &
         keys( 66) /'REDUCED      '/, &
         keys( 67) /'REFINEMENT   '/, & ! snctrl
         keys( 68) /'REPORT       '/, &
         keys( 69) /'RHS          '/, &
         keys( 70) /'ROWS         '/, &
         keys( 71) /'RW           '/, &
         keys( 72) /'SAVE         '/, &
         keys( 73) /'SCALE        '/, &
         keys( 74) /'SOLUTION     '/, &
         keys( 75) /'START        '/, &
         keys( 76) /'STICKY       '/, &
         keys( 77) /'STOP         '/, &

         keys( 78) /'SUBSPACE     '/, &
         keys( 79) /'SUMMARY      '/, &
         keys( 80) /'SUPERBASICS  '/, &
         keys( 81) /'SUPPRESS     '/

    data &
         keys( 82) /'SYSTEM       '/, &
         keys( 83) /'TIMING       '/, &
         keys( 84) /'TOTAL        '/, &
         keys( 85) /'UNBOUNDED    '/, &
         keys( 86) /'UPPER        '/, &
         keys( 87) /'USER         '/, &
         keys( 88) /'VARIABLE     '/, &  ! snctrl
         keys( 89) /'VERIFY       '/, &
         keys( 90) /'VIOLATION    '/, &
         keys( 91) /'WARM         '/, &
         keys( 92) /'WORKING      '/, &
         keys( 93) /'WORKSPACE    '/
    !-------------------------------------------------------------------
    call oplook( maxkey, keys, sorted, key, loc )

  end subroutine ctrl3key

  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  subroutine ctrl3opt &
       ( s, buffer, key, c, i, r, lPrnt, lSumm, Errors, &
       cw, lencw, iw, leniw, rw, lenrw )
    logical :: &
         s
    integer(ip) :: &
         lPrnt, lSumm, Errors, i, lencw, leniw, lenrw, iw(leniw)
    real(rp) :: &
         r, rw(lenrw)
    character :: &
         c*8, cw(lencw)*8
    character*(*) :: &
         buffer, key

    ! ==================================================================
    ! ctrl3opt  decodes the option contained in  buffer  in order to
    ! set or get a parameter value in the relevant array iw or rw.
    !
    ! The buffer is output to file iPrint, minus trailing blanks.
    ! Error messages are output to files iPrint and iSumm.
    ! buffer is echoed to iPrint but normally not to iSumm.
    ! It is echoed to iSumm before any error msg.
    !
    ! On entry,
    ! buffer contains the option string to be processed.
    ! s      is true if an option is to be extracted from buffer.
    ! Otherwise, c, i and r are to be assigned the value of the
    ! option defined in the option string.
    ! lPrnt  is iPrint as given to s3file.
    ! lSumm  is iSumm  as given to s3file.
    ! Errors is the number of errors so far.
    !
    ! On exit,
    ! key    is the first keyword contained in buffer.
    ! If s is true, c, i and r may be ignored.  (They are usually
    ! option values that have been saved in cw, iw, rw.)
    ! If s is false,
    ! c      is the OBJECTIVE, RHS, RANGE or BOUND name if key is
    ! one of those words.
    ! r      is the first numerical value found in buffer (or zero).
    ! i      is int(r) if  abs(r) < maxint.
    ! Errors is the number of errors so far.
    !
    !
    ! ctrl3opt  uses opnumb and the subprograms
    ! lookup, scannr, tokens, upcase
    ! (now called oplook, opscan, optokn, opuppr)
    ! supplied by Sterling Software, Palo Alto, California.
    !
    ! 21 Aug 2008: Current version of ctrl3opt.
    ! 18 Nov 2008: Added refinement limit option.
    !===================================================================
    external :: &
         opnumb, s1intmx
    logical :: &
         opnumb, more, number
    character :: &
         key2*16, key3*16, value*16, str*132, str1*132
    integer(ip) :: &
         cgItmx, DerOpt, i0, i1, i2, i3, &
         lenb, lenbuf, loc1, loc2, m1, nToken, &
         iBack, iCrash, iDump, iInsrt, iLoadB, iMPS, iNewB, &
         iOldB, iPnch, iPrint, iReprt, iSoln, iSumm, itnlim, &
         jverf1, jverf2, jverf3, jverf4, jverf5, jverf6, kchk, &
         kDegen, kfac, klog, kReset, ksav, kSumm, lDenJ, lEmode, &
         lprDbg, lprPrm, lprSch, lprScl, lprSol, lvlDer, lvlHes, &
         lvlInf, lvlPiv, lvlPre, lvlPPm, lvlSch, lvlScl, lvlSrt, &
         lvlSys, lvlTim, lvlVer, maxbuf, maxcu, maxcw, maxint, &
         maxiu, maxiw, maxm, maxn, maxne, maxR, maxru, maxrw, maxS, &
         mBnd, mEr, mFlush, minmax, MjrPrt, mLst, mMajor, mMinor, &
         MnrPrt, mObj, mQNmod, mRhs, mRng, nnCon, nnJac, nnObj, &
         nnL, nParPr, nProb, npStat, ObjRow, QPslvr, qpStat, &
         s1intmx, stkyOp
    integer(ip) :: &
         etarg, tolCG, tolFP, tolQP, tolNLP, tolx, tolCon, tolpiv, &
         tCrash, tolswp, tolfac, tolupd, infBnd, bigFx, bigdx, epsrf, &
         fdint1, fdint2, xdlim, vilim, wolfeG, wtInf0, mNewSB, xPen0, &
         scltol, Aijtol, bStrc1, bStrc2, Utol1, Utol2, Dens2, wtMax
    !-------------------------------------------------------------------
    integer(ip) ::           maxtok
    parameter         (      maxtok = 10)
    character          token(maxtok)*16

    real(rp)    ::     zero
    parameter         (zero   =   0.0d+0)

    parameter         (tolFP     =  51) ! Minor Phase 1 Opt tol
    parameter         (tolQP     =  52) ! Minor Phase 2 Opt tol
    parameter         (tolNLP    =  53) ! Major Optimality tolerance
    parameter         (tolCG     =  54) ! cg tolerance
    parameter         (tolx      =  56) ! Minor feasibility tolerance
    parameter         (tolCon    =  57) ! Major feasibility tolerance
    parameter         (tolpiv    =  60) ! excludes small pivot elems
    parameter         (tCrash    =  62) ! crash tolerance
    parameter         (tolswp    =  65) ! LU swap tolerance
    parameter         (tolfac    =  66) ! LU factor tolerance
    parameter         (tolupd    =  67) ! LU update tolerance
    parameter         (infBnd    =  70) ! definition of plus infinity
    parameter         (bigFx     =  71) ! unbounded objective
    parameter         (bigdx     =  72) ! unbounded step
    parameter         (epsrf     =  73) ! relative function precision
    parameter         (fdint1    =  76) ! forward difference interval
    parameter         (fdint2    =  77) ! central difference interval
    parameter         (xdlim     =  80) ! Step limit
    parameter         (vilim     =  81) ! violation limit
    parameter         (etarg     =  83) ! Quasi-Newton QP rg tolerance
    parameter         (wolfeG    =  84) ! line search tolerance
    parameter         (wtInf0    =  88) ! infeasibility weight
    parameter         (xPen0     =  89) ! initial penalty parameter
    parameter         (wtMax     =  90) ! Elastic weightmax
    parameter         (scltol    =  92) ! scale tolerance
    parameter         (Aijtol    =  95) ! zero Aij tolerance
    parameter         (bStrc1    =  96) ! default lower bound on x
    parameter         (bStrc2    =  97) ! default upper bound on x
    parameter         (Utol1     = 154) ! abs tol for small diag of U
    parameter         (Utol2     = 155) ! rel tol for small diag of U
    parameter         (Dens2     = 158) ! switch to dense LU
    parameter         (maxru     =   2) ! Start of SNOPT part of rw
    parameter         (maxrw     =   3) ! End   of SNOPT part of rw
    parameter         (maxiu     =   4) ! Start of SNOPT part of iw
    parameter         (maxiw     =   5) ! End   of SNOPT part of iw
    parameter         (maxcu     =   6) ! Start of SNOPT part of cw
    parameter         (maxcw     =   7) ! End   of SNOPT part of cw
    parameter         (iPrint    =  12) ! Print   file
    parameter         (iSumm     =  13) ! Summary file
    parameter         (nnJac     =  21) ! # nonlinear Jacobian variables
    parameter         (nnObj     =  22) ! # variables in gObj
    parameter         (nnCon     =  23) ! nonlinear constraints
    parameter         (nnL       =  24) !   max( nnObj, nnJac )
    parameter         (maxR      =  52) ! max columns of R
    parameter         (maxS      =  53) ! max # of superbasics
    parameter         (mQNmod    =  54) ! (ge 0) max # of BFGS updates
    parameter         (QPslvr    =  55) ! 0(1) => QP(QN) QP solver
    parameter         (lEmode    =  56) ! >0    => use elastic mode
    parameter         (kchk      =  58) ! check (row) frequency
    parameter         (kfac      =  59) ! factorization frequency
    parameter         (ksav      =  60) ! save basis map
    parameter         (klog      =  61) ! log/print frequency
    parameter         (kSumm     =  62) ! Summary print frequency
    parameter         (kDegen    =  63) ! max. expansions of featol
    parameter         (kReset    =  64) ! Hessian frequency
    parameter         (mFlush    =  66) ! Hessian flush
    parameter         (lvlSrt    =  69) ! = 0(1) => cold(warm) start
    parameter         (lvlDer    =  70) ! derivative level
    parameter         (lvlSys    =  71) ! > 0   => print system info
    parameter         (lvlHes    =  72) ! 0,1,2 => LM, FM, Exact H
    parameter         (lvlInf    =  73) ! Elastic option
    parameter         (lvlScl    =  75) ! scale option
    parameter         (lvlSch    =  76) ! >0 => deriv. line search
    parameter         (lvlPre    =  77) ! >0 => QN preconditioned CG
    parameter         (lvlVer    =  78) ! Verify level
    parameter         (lvlPPm    =  79) ! Proximal Point method for x0
    parameter         (lvlPiv    =  80) ! 0(1 2 3) LU pivoting
    parameter         (lprPrm    =  81) ! > 0  =>  parms are printed
    parameter         (lprSch    =  82) ! line search debug start itn
    parameter         (lprScl    =  83) ! > 0  => print the scales
    parameter         (lprSol    =  84) ! > 0  =>  print the solution
    parameter         (lprDbg    =  85) ! > 0  => private debug print
    parameter         (minmax    =  87) ! 1, -1  => MIN, FP, MAX
    parameter         (iCrash    =  88) ! Crash option
    parameter         (itnlim    =  89) ! limit on total iterations
    parameter         (mMajor    =  90) ! limit on major iterations
    parameter         (mMinor    =  91) ! limit on minor iterations
    parameter         (MjrPrt    =  92) ! Major print level
    parameter         (MnrPrt    =  93) ! Minor print level
    parameter         (nParPr    =  94) ! # partial pricing sections
    parameter         (mNewSB    =  95) ! maximum # of new SB
    parameter         (cgItmx    =  97) ! CG iteration limit
    parameter         (ObjRow    = 103) ! Objective row
    parameter         (DerOpt    = 104) ! 0, 1, 2 => derivative option
    parameter         (lDenJ     = 105) ! 1(2) => dense(sparse) deriv.
    parameter         (mEr       = 106) ! maximum # errors in MPS data
    parameter         (mLst      = 107) ! maximum # lines  of MPS data
    parameter         (nProb     = 108) ! problem number
    parameter         (jverf1    = 110) ! start g derivative checking
    parameter         (jverf2    = 111) ! stop  g derivative checking
    parameter         (jverf3    = 112) ! start J derivative checking
    parameter         (jverf4    = 113) ! stop  J derivative checking
    parameter         (jverf5    = 114) ! start H derivative checking
    parameter         (jverf6    = 115) ! stop  H derivative checking
    parameter         (stkyOp    = 116) ! > 0 => sticky parameters
    parameter         (iBack     = 120) ! backup file
    parameter         (iDump     = 121) ! dump file
    parameter         (iLoadB    = 122) ! load file
    parameter         (iMPS      = 123) ! MPS file
    parameter         (iNewB     = 124) ! new basis file
    parameter         (iInsrt    = 125) ! insert file
    parameter         (iOldB     = 126) ! old basis file
    parameter         (iPnch     = 127) ! punch file
    parameter         (iReprt    = 130) ! Report file
    parameter         (iSoln     = 131) ! Solution file
    parameter         (maxm      = 133) ! Row    estimate
    parameter         (maxn      = 134) ! Column estimate
    parameter         (maxne     = 135) ! Estimated element count
    parameter         (lvlTim    = 182) ! Timing level
    parameter         (qpStat    = 235) ! QP user-routine call-status
    parameter         (npStat    = 236) ! NP user-routine call-status

    parameter         (mObj      =  52) ! Objective name
    parameter         (mRhs      =  53) ! Right-hand side name
    parameter         (mRng      =  54) ! Range name
    parameter         (mBnd      =  55) ! Bnd section name

    !-------------------------------------------------------------------
    maxint = s1intmx( )
    ! ------------------------------------------------------------------
    ! Trim trailing blanks and echo to the Print file.
    ! ------------------------------------------------------------------
    call s1trim( buffer, lenbuf )
    maxbuf = min( 120,lenbuf)

    if (lPrnt > 0) then
       write(str, '(6x,a)') buffer(1:maxbuf)
       call snPRNT( 1, str, iw, leniw )
    end if

    ! Set lenb = length of buffer without trailing comments.
    ! Eliminate comments and empty lines.
    ! A '*' appearing anywhere in buffer terminates the string.

    i  = index( buffer(1:lenbuf), '*' )
    if (i == 0) then
       lenb = lenbuf
    else
       lenb = i - 1
    end if
    if (lenb <= 0) then
       key = '*'
       go to 900
    end if

    ! ------------------------------------------------------------------
    ! Extract up to maxtok tokens from the record.
    ! ntoken returns how many were actually found.
    ! key, key2, are the first tokens if any, otherwise blank.
    ! For some values of key (bounds, objective, ranges, rhs)
    ! we have to save key2 before s3tie (and oplook) alter it.
    ! For example, if the data is     objective = obj
    ! oplook will change obj to objective.
    ! ------------------------------------------------------------------
    call optokn( buffer(1:lenbuf), maxtok, ntoken, token )
    key    = token(1)
    key2   = token(2)
    key3   = token(3)
    c      = key2(1:8)

    ! Certain keywords require no action.

    if (key == '   ') go to 900 ! blank line
    if (key == '*  ') go to 900 ! comment starting in column no. > 1
    if (key == 'END') go to 900

    ! Convert the keywords to their most fundamental form
    ! (upper case, no abbreviations).
    ! loci   says where the keywords are in the dictionaries.
    ! loci = 0 signals that the keyword wasn't there.

    call ctrl3key ( key , loc1 )
    call ctrl3tie ( key2, loc2 )

    ! Most keywords will have an associated integer or real value,
    ! so look for it no matter what the keyword.

    c      = key2(1:8)
    i      = 1
    number = .false.

    !+    while (i .lt. ntoken  .and.  .not. number) loop
50  if    (i < ntoken  .AND.  .NOT. number) then
       i      = i + 1
       value  = token(i)
       number = opnumb( value )
       go to 50
    end if
    !+    end while

    i = 0
    r = zero
    if ( number ) then
       read  (value, '(bn, e16.0)') r
       i = maxint
       if (abs(r) < maxint) i = int(r)
    end if

    ! ------------------------------------------------------------------
    ! Decide what to do about each keyword.
    ! The second keyword (if any) might be needed to break ties.
    ! Some seemingly redundant testing of more is used
    ! to avoid compiler limits on the number of consecutive else ifs.
    ! ------------------------------------------------------------------

    m1     = -1
    i0     =  0
    i1     =  1
    i2     =  2
    i3     =  3
    more   = .true.

    ! ------------------------------------------------------------------
    ! Keywords for control interface.
    ! ------------------------------------------------------------------
    if (more) then
       more   = .false.
       if      (key == 'DISCRETIZATION') then
!          if   (loc2 ==  0              ) go to 820
          if   (key2 == 'HS         ') iDisc = 1 !call optDisc ( s, 1_ip )  !call s3optl(s,iDisc,i1,i)
          if   (key2 == 'TR         ') iDisc = 0 !call optDisc ( s, 0_ip )  !call s3optl(s,iDisc,i0,i)
       else if (key == 'REFINEMENT    ') then
!          if   (loc2 ==  0              ) go to 820
          if   (key2 == 'NO         ') iRefn = 0 !call optRefn ( s, 0_ip )  !call s3optl(s,iRefn,i0,i)
          if   (key2 == 'YES        ') iRefn = 1 ! call optRefn ( s, 1_ip )  !call s3optl(s,iRefn,i1,i)
          if   (key2 == 'TOLERANCE  ') refTol = r !call optRefTol ( s, r )   !call s3optr(s,refTol,r)
          if   (key2 == 'LIMIT      ') iRefL  = i !call optRefLim ( s, i )   !call s3opti(s,refLim,i)
       else if (key == 'CONTROL       ') then
          if   (loc2 ==  0              ) go to 820
          if   (key2 == 'SOLUTION      ') then
             if(key3 == 'NO         ') iCPrt = 0 !call optCPrt ( s, 0_ip )  !call s3optl(s,iCPrt,i0,i)
             if(key3 == 'YES        ') iCPrt = 1!call optCPrt ( s, 1_ip )  !call s3optl(s,iCPrt,i1,i)
          end if
       else
          more   = .true.
       end if
    end if

    ! ------------------------------------------------------------------
    ! Keywords for SNOPT.
    ! ------------------------------------------------------------------
    if (more) then
       more   = .false.
       if      (key == 'BACKUP      ') then
          call s3opti(s, iw(iBack ), i)

       else if (key == 'CALL        ') then
          call s3opti(s, iw(qpStat), i)
          call s3opti(s, iw(npStat), i)

       else if (key == 'CENTRAL     ') then
          call s3optr(s, rw(fdint2), r)

       else if (key == 'CG          ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'TOLERANCE   ') call s3optr(s, rw(tolCG ), r)
          if (key2 == 'PRECONDITIONING') &
               call s3opti(s, iw(lvlPre), i)
          if (key2 == 'ITERATIONS  ') call s3opti(s, iw(cgItmx), i)

       else if (key == 'CHECK       ') then
          call s3opti(s, iw(kchk  ), i)

       else if (key == 'COLD        ') then
          call s3opti(s, iw(lvlSrt),i0)

       else if (key == 'CRASH       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'OPTION      ') call s3opti(s, iw(iCrash), i)
          if (key2 == 'TOLERANCE   ') call s3optr(s, rw(tCrash), r)

       else if (key == 'DEBUG       ') then
          call s3opti(s, iw(lprDbg), i)
       else if (key == 'DEFAULTS    ') then
          call s3unsetPrm &
               ( cw, lencw, iw, leniw, rw, lenrw )

       else if (key == 'DERIVATIVE  ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'LEVEL       ') call s3opti(s, iw(lvlDer), i)
          if (key2 == 'LINESEARCH  ')call s3optl(s,iw(lvlSch),i1,i)
          if (key2 == 'OPTION      ') call s3opti(s, iw(DerOpt), i)

       else if (key == 'DIFFERENCE  ') then
          call s3optr(s, rw(fdint1), r)
       else if (key == 'DUMP        ') then
          call s3opti(s, iw(iDump ), i)

       else if (key == 'ELASTIC     ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'OBJECTIVE   ') call s3opti(s, iw(lvlInf), i)
          if (key2 == 'MODE        ') call s3opti(s, iw(lEmode), i)
          if (key2 == 'WEIGHT      ') call s3optr(s, rw(wtInf0), r)
          if (key2 == 'WEIGHTMAX   ') call s3optr(s, rw(wtMax ), r)

       else if (key == 'EXPAND      ') then
          call s3opti(s, iw(kDegen), i)
       else if (key == 'FACTORIZATION') then
          call s3opti(s, iw(kfac  ), i)

       else if (key == 'FEASIBLE    ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'POINT       ')call s3optl(s,iw(minmax),i0,i)
          if (key2 == 'EXIT        ') go to 890

       else if (key == 'FEASIBILITY ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'TOLERANCE   ') call s3optr(s, rw(tolx  ), r)

       else if (key == 'FUNCTION    ') then
          call s3optr(s, rw(epsrf ), r)

       else if (key == 'HESSIAN     ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'COLUMNS     ') call s3opti(s, iw(nnL   ), i)
          if (key2 == 'DIMENSION   ') call s3opti(s, iw(maxR  ), i)
          if (key2 == 'FREQUENCY   ') call s3opti(s, iw(kReset), i)
          if (key2 == 'FLUSH       ') call s3opti(s, iw(mFlush), i)
          if (key2 == 'UPDATES     ') call s3opti(s, iw(mQNmod), i)
          if (key2 == 'LIMITED     ')call s3optl(s,iw(lvlHes),i0,i)
          if (key2 == 'FULL        ')call s3optl(s,iw(lvlHes),i1,i)
          if (key2 == 'PRECONDITIONING') &
               call s3opti(s, iw(lvlPre), i)

       else if (key == 'HOT         ') then
          call s3opti(s, iw(lvlSrt),i3)
       else if (key == 'INFINITE    ') then
          call s3optr(s, rw(infBnd), r)
       else if (key == 'INSERT      ') then
          call s3opti(s, iw(iInsrt), i)
       else if (key == 'ITERATIONS  ') then
          call s3opti(s, iw(itnlim), i)
       else
          more   = .true.
       end if
    end if

    if (more) then
       more   = .false.
       if      (key == 'IW          ') then
          if (i < 1  .OR. i > 500) then
             go to 880
          else if ( s ) then
             ! Allow things like  iw 21 = 100  to set iw(21) = 100
             key2   = token(3)
             read (key2, '(bn, i16)') iw(i)
          else
             ! Grab the contents of  iw(i)
             i = iw(i)
             r = i
          end if

       else if (key == 'LINESEARCH  ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'TOLERANCE   ') call s3optr(s, rw(wolfeG), r)
          if (key2 == 'DEBUG       ') call s3opti(s, iw(lprSch), i)

       else if (key == 'LOAD        ') then
          call s3opti(s, iw(iLoadB), i)
       else if (key == 'LOG         ') then
          call s3opti(s, iw(klog)  , i)

       else if (key == 'LP          ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'FEASIBILITY ') call s3optr(s, rw(tolx  ), r)
          if (key2 == 'OPTIMALITY  ') call s3optr(s, rw(tolQP ), r)

       else if (key == 'LU          ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'PARTIAL     ')call s3optl(s,iw(lvlPiv),i0,i)
          if (key2 == 'COMPLETE    ')call s3optl(s,iw(lvlPiv),i2,i)
          if (key2 == 'DIAGONAL    ')call s3optl(s,iw(lvlPiv),i3,i)
          if (key2 == 'FACTORIZATION')call s3optr(s, rw(tolFac), r)
          if (key2 == 'ROOK        ')call s3optl(s,iw(lvlPiv),i1,i)
          if (key2 == 'UPDATES     ') call s3optr(s, rw(tolUpd), r)
          if (key2 == 'DENSITY     ') call s3optr(s, rw(Dens2 ), r)
          if (key2 == 'SINGULARITY ') then
             call s3optr(s, rw(Utol1), r)
             call s3optr(s, rw(Utol2), r)
          end if
          if (key2 == 'SWAP        ') call s3optr(s, rw(tolswp), r)
          ! if (key2.eq. 'DEFAULTS    ') then
          ! if (loc3.eq.  0           ) go to 820
          ! if (key3.eq.'TPP         ') call s3optr(s,rw(tolDpp),r)
          ! if (key3.eq.'TCP         ') call s3optr(s,rw(tolDcp),r)
          ! if (key3.eq.'UPDATES     ') call s3optr(s,rw(tolDup),r)
          ! end if
       else
          more   = .true.
       end if
    end if

    if (more) then
       more   = .false.
       if      (key == 'MAJOR       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'FEASIBILITY ') call s3optr(s, rw(tolCon), r)
          if (key2 == 'ITERATIONS  ') call s3opti(s, iw(mMajor), i)
          if (key2 == 'OPTIMALITY  ') call s3optr(s, rw(tolNLP), r)
          if (key2 == 'PRINT       ') call s3opti(s, iw(MjrPrt), i)
          if (key2 == 'STEP        ') call s3optr(s, rw(xdlim ), r)

       else if (key == 'MAXIMIZE    ') then
          call s3opti(s, iw(minmax), m1)
       else if (key == 'MINIMIZE    ') then
          call s3opti(s, iw(minmax), i1)

       else if (key == 'MINOR       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'ITERATIONS  ') call s3opti(s, iw(mMinor), i)
          if (key2 == 'FEASIBILITY ') call s3optr(s, rw(tolx  ), r)
          if (key2 == 'OPTIMALITY  ') call s3optr(s, rw(tolQP ), r)
          if (key2 == 'PHASE1      ') call s3optr(s, rw(tolFP ), r)
          if (key2 == 'PHASE2      ') call s3optr(s, rw(tolQP ), r)
          if (key2 == 'PRINT       ') call s3opti(s, iw(MnrPrt), i)
          if (key2 == 'SUPERBASICS ') call s3opti(s, iw(mNewSB), i)

       else if (key == 'NEW         ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'BASIS       ') call s3opti(s, iw(iNewB ), i)
          if (key2 == 'SUPERBASICS ') call s3opti(s, iw(mNewSB), i)

       else if (key == 'NO          '  .OR. &
            key == 'NONDERIVATIVE' .OR. &
            key == 'NON         ') then
          call s3opti(s, iw(lvlSch),i0)

       else if (key == 'OBJECTIVE   ') then
          if (key2 == 'ROW         ') then
             call s3opti(s, iw(ObjRow), i)
          else
             call s3optc(s, cw(mObj  ), c)
          end if
       else if (key == 'OLD         ') then
          call s3opti(s, iw(iOldB ), i)
       else if (key == 'OPTIMALITY  ') then
          call s3optr(s, rw(tolNLP), r)
       else if (key == 'PARTIAL     ') then
          call s3opti(s, iw(nParPr), i)
       else if (key == 'PENALTY     ') then
          call s3optr(s, rw(xPen0 ), r)
       else if (key == 'PIVOT       ') then
          call s3optr(s, rw(tolpiv), r)

       else if (key == 'PRINT       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'FILE        ') call s3opti(s, iw(iPrint), i)
          if (key2 == 'FREQUENCY   ') call s3opti(s, iw(klog  ), i)
          if (key2 == 'LEVEL       ') call s3opti(s, iw(MnrPrt), i)

       else if (key == 'PROXIMAL    ') then
          call s3opti(s, iw(lvlPPm), i)

       else if (key == 'PUNCH       ') then
          call s3opti(s, iw(iPnch ), i)
       else
          more   = .true.
       end if
    end if

    if (more) then
       more   = .false.
       if      (key == 'QP          ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'COLUMNS     ') call s3opti(s, iw(nnL  ) , i)
          if (key2 == 'FEASIBILITY ') call s3optr(s, rw(tolx ) , r)
          if (key2 == 'OPTIMALITY  ') call s3optr(s, rw(tolQP) , r)

       else if (key == 'QPSOLVER    ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'CHOLESKY    ')call s3optl(s,iw(QPslvr),i0,i)
          if (key2 == 'CG          ')call s3optl(s,iw(QPslvr),i1,i)
          if (key2 == 'QN          ')call s3optl(s,iw(QPslvr),i2,i)

       else if (key == 'REDUCED     ') then
          call s3opti(s, iw(maxR  ), i)

       else if (key == 'REPORT      ') then
          call s3opti(s, iw(iReprt), i)

       else if (key == 'ROWS        ') then
          ! gams should recognize row tolerance
          ! but not just          rows
          ! This is a relic from MINOS
          if (key2 == 'TOLERANCE   ') then
             call s3optr(s, rw(tolCon), r)
          else
             call s3opti(s, iw(maxm  ), i)
          end if

       else if (key == 'RW          ') then
          if (i < 1  .OR. i > 500) then
             go to 880
          else if ( s ) then
             ! Allow things like rw 21 = 2  to set rw(21) = 2.0
             key2   = token(3)
             read (key2, '(bn, e16.0)') rw(i)
          else
             ! Grab the contents of  rw(i)
             r = rw(i)
          end if

       else if (key == 'SAVE        ') then
          call s3opti(s, iw(ksav  ), i)

       else if (key == 'SCALE       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'OPTION      ') call s3opti(s, iw(lvlScl), i)
          if (key2 == 'TOLERANCE   ') call s3optr(s, rw(scltol), r)
          if (key2 == 'PRINT       ')call s3optl(s,iw(lprScl),i1,i)
       else
          more   = .true.
       end if
    end if

    if (more) then
       more   = .false.
       if      (key == 'SOLUTION    ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'FILE        ') call s3opti(s, iw(iSoln ), i)
          if (key2 == 'YES         ')call s3optl(s,iw(lprSol),i2,i)
          if (key2 == 'NO          ')call s3optl(s,iw(lprSol),i0,i)

       else if (key == 'START       ') then
          if (key2 == 'OBJECTIVE   ') call s3opti(s, iw(jverf1), i)
          if (key2 == 'CONSTRAINTS ') call s3opti(s, iw(jverf3), i)
          if (key2 == 'HESSIAN     ') call s3opti(s, iw(jverf5), i)
          if (loc2 ==  0            ) go to 820
       else if (key == 'STOP        ') then
          if (key2 == 'OBJECTIVE   ') call s3opti(s, iw(jverf2), i)
          if (key2 == 'CONSTRAINTS ') call s3opti(s, iw(jverf4), i)
          if (key2 == 'HESSIAN     ') call s3opti(s, iw(jverf6), i)
          if (loc2 ==  0            ) go to 820
       else
          more   = .true.
       end if
    end if

    if (more) then
       more   = .false.
       if      (key == 'STICKY      ') then
          if (loc2 ==  0            ) go to 820
          if (key3 == 'YES         ')call s3optl(s,iw(stkyOp),i1,i)
          if (key3 == 'NO          ')call s3optl(s,iw(stkyOp),i0,i)

       else if      (key == 'SUBSPACE    ') then
          call s3optr(s, rw(etarg ), r)

       else if (key == 'SUPERBASICS ') then
          call s3opti(s, iw(maxS  ), i)

       else if (key == 'SUMMARY     ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'FILE        ') call s3opti(s, iw(iSumm ), i)
          if (key2 == 'FREQUENCY   ') call s3opti(s, iw(ksumm ), i)

       else if (key == 'SUPPRESS    ') then
          call s3opti(s, iw(lprPrm), i)

       else if (key == 'TIMING      ') then
          call s3opti(s, iw(lvlTim), i)

       else if (key == 'SYSTEM      ') then
          if (loc2 ==  0            ) go to 820
          if (key3 == 'YES         ')call s3optl(s,iw(lvlSys),i1,i)
          if (key3 == 'NO          ')call s3optl(s,iw(lvlSys),i0,i)

       else if (key == 'TOTAL       ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'INTEGER     ') call s3opti(s, iw(maxiw ), i)
          if (key2 == 'REAL        ') call s3opti(s, iw(maxrw ), i)
          if (key2 == 'CHARACTER   ') call s3opti(s, iw(maxcw ), i)

       else if (key == 'UNBOUNDED   ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'OBJECTIVE   ') call s3optr(s, rw(bigFx ), r)
          if (key2 == 'STEP        ') call s3optr(s, rw(bigdx ), r)

       else if (key == 'USER        ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'INTEGER     ') call s3opti(s, iw(maxiu ), i)
          if (key2 == 'REAL        ') call s3opti(s, iw(maxru ), i)
          if (key2 == 'CHARACTER   ') call s3opti(s, iw(maxcu ), i)

       else if (key == 'VERIFY      ') then
          if (key2 == '            ') then
             loc2   = 1
             i      = 3
          end if
          if (loc2 ==  0            ) go to 820
          if (key2 == 'OBJECTIVE   ') i = 1
          if (key2 == 'CONSTRAINTS ') i = 2
          if (key2 == 'GRADIENTS   ') i = 3
          if (key2 == 'YES         ') i = 3
          if (key2 == 'NO          ') i = 0
          if (key2 == 'LEVEL       ') i = i
          call s3opti(s, iw(lvlVer), i)

       else if (key == 'VIOLATION   ') then
          call s3optr(s, rw(vilim ), r)
       else if (key == 'WARM        ') then
          call s3opti(s, iw(lvlSrt),i2)
       else if (key == 'WORKSPACE   ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == '(USER)      ') call s3opti(s, iw(maxru), i)
          if (key2 == '(TOTAL)     ') call s3opti(s, iw(maxrw), i)
       else
          more   = .true.
       end if
    end if

    if ( .NOT. more) go to 900

    ! ------------------------------------------------------------------
    ! Keywords for MPS files.
    ! ------------------------------------------------------------------

    if (more) then
       more   = .false.
       if      (key == 'AIJ         ') then
          call s3optr(s, rw(Aijtol), r)
       else if (key == 'BOUNDS      ') then
          call s3optc(s, cw(mBnd  ), c)
       else if (key == 'COEFFICIENTS') then
          call s3opti(s, iw(maxne ), i)
       else if (key == 'COLUMNS     ') then
          call s3opti(s, iw(maxn  ), i)
       else if (key == 'ELEMENTS    ') then
          call s3opti(s, iw(maxne ), i)
       else if (key == 'ERROR       ') then
          call s3opti(s, iw(mEr   ), i)
       else if (key == 'INFINITE    ') then
          call s3optr(s, rw(infBnd), r)

       else if (key == 'JACOBIAN    ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'DENSE       ')call s3optl(s,iw(lDenJ ),i1,i)
          if (key2 == 'SPARSE      ')call s3optl(s,iw(lDenJ ),i2,i)

       else if (key == 'LIST        ') then
          call s3opti(s, iw(mLst  ), i)
       else if (key == 'LOWER       ') then
          call s3optr(s, rw(bStrc1), r)
       else if (key == 'MPS         ') then
          call s3opti(s, iw(iMPS  ), i)

       else if (key == 'NONLINEAR   ') then
          if (loc2 ==  0            ) go to 820
          if (key2 == 'CONSTRAINTS ') call s3opti(s, iw(nnCon ), i)
          if (key2 == 'OBJECTIVE   ') call s3opti(s, iw(nnObj ), i)
          if (key2 == 'JACOBIAN    ') call s3opti(s, iw(nnJac ), i)
          if (key2 == 'VARIABLES   ') then
             call s3opti(s, iw(nnObj), i)
             call s3opti(s, iw(nnJac), i)
          end if

       else if (key == 'OBJECTIVE   ') then
          call s3optc(s, cw(mObj  ), c)
       else if (key == 'PROBLEM     ') then
          call s3opti(s, iw(nProb ), i)
       else if (key == 'RANGES      ') then
          call s3optc(s, cw(mRng  ), c)
       else if (key == 'RHS         ') then
          call s3optc(s, cw(mRhs  ), c)
       else if (key == 'UPPER       ') then
          call s3optr(s, rw(Bstrc2), r)
       else
          more   = .true.
       end if
    end if

    if ( .NOT. more) go to 900

    ! ------------------------------------------------------------------
    ! Error messages.
    ! This is the only way we can think of to concatenate strings
    ! when one of them is of indeterminate length.
    ! ------------------------------------------------------------------
    write(str, '(2a)') ' XXX  Keyword not recognized:         ', key
    go to 895

820 write(str, '(2a)') ' XXX  Second keyword not recognized:  ', key2
    go to 895

840 write(str, '(2a)') ' XXX  Fourth keyword not recognized:  ', key2
    go to 895

880 write(str,'(a,i8)')' XXX  parm subscript out of range:    ', i
    go to 895

890 str    = ' XXX  Obsolete option'
    go to 895

    ! The buffer should have been output already to the Print file.
    ! First output it to the Summary file.
    ! Then print the error message.

895 Errors = Errors + 1
    if (lSumm > 0) then
       write(str1, '(1x,a)') buffer(1:maxbuf)
       call snPRNT( 2, str1, iw, leniw )
    end if
    call snPRNT( 4, str, iw, leniw )

900 return

  end subroutine ctrl3opt

  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  subroutine ctrl3tie ( tie, loc )
    integer(ip) :: &
         loc
    character :: &
         tie*16

    !===================================================================
    ! ctrl3tie  sets key to be the standard form for the second keyword
    ! on each line of a SPECS file.
    !
    ! 21 Aug 2008: Current version of ctrl3tie.
    ! 18 Nov 2008: Added LIMIT (for refinement limit).
    !===================================================================
    integer(ip) ::                 maxtie
    parameter         (     maxtie = 75)
    character   ::     ties(maxtie)*16
    logical ::            sorted
    parameter         (sorted =   .true.)
    !-------------------------------------------------------------------
    data &
         ties(  1) /'(TOTAL)      '/, &
         ties(  2) /'(USER)       '/, &
         ties(  3) /'ALL          '/, &
         ties(  4) /'BASIC        '/, &
         ties(  5) /'BASIS        '/, &
         ties(  6) /'BOUND        '/, &
         ties(  7) /'CG           '/, &
         ties(  8) /'CHARACTER    '/, &
         ties(  9) /'CHOLESKY     '/, &
         ties( 10) /'COLUMNS      '/, &
         ties( 11) /'COMPLETE     '/, &
         ties( 12) /'CONSTRAINTS  '/, &
         ties( 13) /'DAMPING      '/, &
         ties( 14) /'DEBUG        '/, &
         ties( 15) /'DENSE        '/, &
         ties( 16) /'DENSITY      '/, &
         ties( 17) /'DERIVATIVE   '/, &
         ties( 18) /'DIAGONAL     '/, &
         ties( 19) /'DIFFERENCES  '/, &
         ties( 20) /'DIMENSION    '/

    data &
         ties( 21) /'ELEMENTS     '/, &
         ties( 22) /'EXIT         '/, &
         ties( 23) /'FACTORIZATION'/, &
         ties( 24) /'FEASIBILITY  '/, &
         ties( 25) /'FILE         '/, &
         ties( 26) /'FLUSH        '/, &
         ties( 27) /'FREQUENCY    '/, &
         ties( 28) /'FULL         '/, &
         ties( 29) /'GRADIENTS    '/, &
         ties( 30) /'HS           '/, &
         ties( 31) /'INFORMATION  '/, &
         ties( 32) /'INTEGER      '/, &
         ties( 33) /'ITERATIONS   '/, &
         ties( 34) /'JACOBIAN     '/, &
         ties( 35) /'LEVEL        '/, &
         ties( 36) /'LIMIT        '/, &
         ties( 37) /'LIMITED      '/, &
         ties( 38) /'LINEAR       '/, &
         ties( 39) /'LINESEARCH   '/, &
         ties( 40) /'LOG          '/, &
         ties( 41) /'MODE         '/, &
         ties( 42) /'NEWTON       '/

    data &
         ties( 43) /'NO           '/, &
         ties( 44) /'NONLINEAR    '/, &
         ties( 45) /'OBJECTIVE    '/, &
         ties( 46) /'OPTIMALITY   '/, &
         ties( 47) /'OPTION       '/, &
         ties( 48) /'PARAMETERS   '/, &
         ties( 49) /'PARTIAL      '/, &
         ties( 50) /'PHASE1       '/, &
         ties( 51) /'PHASE2       '/, &
         ties( 52) /'POINT        '/, &
         ties( 53) /'PRECONDITIONING'/, &
         ties( 54) /'PRINT        '/, &
         ties( 55) /'QN           '/, &
         ties( 56) /'REAL         '/, &
         ties( 57) /'ROOK         '/, &
         ties( 58) /'ROW          '/, &
         ties( 59) /'SINGULARITY  '/, &
         ties( 60) /'SOLUTION     '/, &
         ties( 61) /'SOLVER       '/, &
         ties( 62) /'SPARSE       '/, &
         ties( 63) /'START        '/

    data &
         ties( 64) /'STEP         '/, &
         ties( 65) /'STOP         '/, &
         ties( 66) /'SUPERBASICS  '/, &
         ties( 67) /'SWAP         '/, &
         ties( 68) /'TIME         '/, &
         ties( 69) /'TOLERANCE    '/, &
         ties( 70) /'TR           '/, &
         ties( 71) /'UPDATES      '/, &
         ties( 72) /'VARIABLES    '/, &
         ties( 73) /'WEIGHT       '/, &
         ties( 74) /'WEIGHTMAX    '/, &
         ties( 75) /'YES          '/
    !-------------------------------------------------------------------
    call oplook( maxtie, ties, sorted, tie, loc )

  end subroutine ctrl3tie

  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

end module ct10spec
