C     ******************************************************************
C     ******************************************************************
      subroutine fparam(epsfeas,epsopt,iprint,ncomp)

      implicit none

C     SCALAR ARGUMENTS
      integer ncomp,iprint
      double precision epsfeas,epsopt

#include "dim.par"
#include "algparam.com"
#include "fixvar.com"
#include "slacks.com"
#include "scaling.com"

C     PARAMETERS
      integer nwords
      parameter ( nwords = 13 )

C     DATA BLOCKS
      character * 1 lower(26),upper(26)
      data lower /'a','b','c','d','e','f','g','h','i','j','k','l','m',
     +            'n','o','p','q','r','s','t','u','v','w','x','y','z'/
      data upper /'A','B','C','D','E','F','G','H','I','J','K','L','M',
     +            'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/

      character * 10 dictionary(nwords)
      data dictionary( 1) /'INCREMENTA'/
      data dictionary( 2) /'HESSIAN-AP'/
      data dictionary( 3) /'TRUE-HESSI'/
      data dictionary( 4) /'PERFORM-AC'/
      data dictionary( 5) /'DIRECT-SOL'/
      data dictionary( 6) /'SCALE-LINE'/
      data dictionary( 7) /'DO-NOT-REM'/
      data dictionary( 8) /'ADD-SLACKS'/
      data dictionary( 9) /'SCALE-OBJE'/
      data dictionary(10) /'FEASIBILIT'/
      data dictionary(11) /'OPTIMALITY'/
      data dictionary(12) /'OUTPUT-DET'/
      data dictionary(13) /'NCOMP-ARRA'/

      character * 31 description(nwords)
      data description( 1) /'INCREMENTAL-QUOTIENTS-IN-CG    '/
      data description( 2) /'HESSIAN-APPROXIMATION-IN-CG    '/
      data description( 3) /'TRUE-HESSIAN-PRODUCT-IN-CG     '/
      data description( 4) /'PERFORM-ACCELERATION-STEP      '/
      data description( 5) /'DIRECT-SOLVER                  '/
      data description( 6) /'SCALE-LINEAR-SYSTEMS           '/
      data description( 7) /'DO-NOT-REMOVE-FIXED-VARIABLES  '/
      data description( 8) /'ADD-SLACKS                     '/
      data description( 9) /'SCALE-OBJECTIVE-AND-CONSTRAINTS'/
      data description(10) /'FEASIBILITY-TOLERANCE          '/
      data description(11) /'OPTIMALITY-TOLERANCE           '/
      data description(12) /'OUTPUT-DETAIL                  '/
      data description(13) /'NCOMP-ARRAY                    '/

      character * 1 addinfo(nwords)
      data addinfo( 1) /' '/
      data addinfo( 2) /' '/
      data addinfo( 3) /' '/
      data addinfo( 4) /' '/
      data addinfo( 5) /' '/
      data addinfo( 6) /' '/
      data addinfo( 7) /' '/
      data addinfo( 8) /' '/
      data addinfo( 9) /' '/
      data addinfo(10) /'D'/
      data addinfo(11) /'D'/
      data addinfo(12) /'I'/
      data addinfo(13) /'I'/

C     LOCAL SCALARS
      logical lss,scl
      integer i,ifirst,ikey,ilast,inum,j
      double precision dnum

C     LOCAL ARRAYS
      character * 80 line
      character * 10 keyword
      character *  4 lsssub
      character *  4 sclsub

C     EXTERNAL FUNCTIONS
      external lss,scl

C     OPENING THE SPECIFICATION FILE
      open(20,err=300,file='algencan.dat',status='old')

C     MAIN LOOP
C     write(*, 9005)
      write(10,9005)

 100  continue

C     READING LINES
      read(20,fmt=1000,err=400,end=200) line

C     PROCESS LINES

C     Find first character
      i = 1
 110  if ( i .le. 80 .and. line(i:i) .eq. ' ' ) then
          i = i + 1
          go to 110
      end if

C     Skip blank lines
      if ( i .gt. 80 ) then
          go to 100
      end if

      ifirst = i

C     Skip comments
      if ( line(ifirst:ifirst) .eq. '*' .or.
     +     line(ifirst:ifirst) .eq. '#' ) then
          go to 100
      end if

C     Find the end of the keyword
      i = ifirst + 1
 120  if ( i .le. 80 .and. line(i:i) .ne. ' ' ) then
          i = i + 1
          go to 120
      end if

      ilast = i - 1

C     Obtain the first 10 characters and convert to upper-case
      keyword = '          '
      do i = 1,min( 10, ilast - ifirst + 1 )
          keyword(i:i) = line(ifirst+i-1:ifirst+i-1)
          do j = 1,26
              if ( keyword(i:i) .eq. lower(j) ) then
                  keyword(i:i) = upper(j)
              end if
          end do
      end do

C     Look up the keyword in the dictionary
      i = 1
 130  if ( i .le. nwords .and. keyword .ne. dictionary(i) ) then
          i = i + 1
          go to 130
      end if

C     Ignore unknown keywords
      if ( i .gt. nwords ) then
C         write(*, 9020) line(ifirst:ilast)
          write(10,9020) line(ifirst:ilast)
          go to 100
      end if

      ikey = i

C     Read additional information if needed
      if ( addinfo(ikey) .ne. ' ' ) then

C         Skip blanks
          i = ilast + 1
 140      if ( i .le. 80 .and. line(i:i) .eq. ' ' ) then
              i = i + 1
              go to 140
          end if

C         Ignore keywords without the required information
          if ( i .gt. 80 ) then
C             write(*, 9030) description(ikey)
              write(10,9030) description(ikey)
              go to 100
          end if

C         Read additional information
          if ( addinfo(ikey) .eq. 'I' ) then
              read(unit=line(i:80),fmt=2000) inum

          else if ( addinfo(ikey) .eq. 'D' ) then
              read(unit=line(i:80),fmt=3000) dnum
          end if

      end if

C     Process keyword
      if ( addinfo(ikey) .eq. ' ' ) then
C         write(*, 9040) description(ikey)
          write(10,9040) description(ikey)
      else if ( addinfo(ikey) .eq. 'I' ) then
C         write(*, 9041) description(ikey),inum
          write(10,9041) description(ikey),inum
      else if ( addinfo(ikey) .eq. 'D' ) then
C         write(*, 9042) description(ikey),dnum
          write(10,9042) description(ikey),dnum
      end if

C     Set the corresponding algencan argument
      if ( ikey .eq.  1 ) then
          hptype = 'INCQUO'

      else if ( ikey .eq.  2 ) then
          hptype = 'HAPPRO'

      else if ( ikey .eq.  3 ) then
          if ( hlpcoded .or. truehl ) then
              hptype = 'TRUEHL'
          else
C             write(* ,9100) description(ikey)
              write(10,9100) description(ikey)
          end if

      else if ( ikey .eq.  4 ) then
          if ( .not. truehl ) then
C             write(* ,9110) description(ikey)
              write(10,9110) description(ikey)
          else if ( .not. lss(lsssub) ) then
C             write(* ,9120) description(ikey)
              write(10,9120) description(ikey)
          else
              skipacc = .false.
C             write(* ,9060) lsssub
              write(10,9060) lsssub
          end if

      else if ( ikey .eq.  5 ) then
          if ( .not. truehl ) then
C             write(* ,9110) description(ikey)
              write(10,9110) description(ikey)
          else if ( .not. lss(lsssub) ) then
C             write(* ,9120) description(ikey)
              write(10,9120) description(ikey)
          else
              avoidds = .false.
C             write(* ,9050) lsssub
              write(10,9050) lsssub
          end if

      else if ( ikey .eq.  6 ) then
          if ( lss(lsssub) ) then
              if ( lsssub .eq. 'MA57' ) then
                  sclsys = .true.
C                 write(* ,9060) lsssub
                  write(10,9060) lsssub
              else if ( scl(sclsub) ) then
                  sclsys = .true.
C                 write(* ,9070) sclsub
                  write(10,9070) sclsub
              else
C                 write(* ,9130) description(ikey)
                  write(10,9130) description(ikey)
              end if
          end if

      else if ( ikey .eq.  7 ) then
          rmfixv = .false.

      else if ( ikey .eq.  8 ) then
          slacks = .true.

      else if ( ikey .eq.  9 ) then
          scale = .true.

      else if ( ikey .eq. 10 ) then
          epsfeas = dnum

      else if ( ikey .eq. 11 ) then
          epsopt = dnum

      else if ( ikey .eq. 12 ) then
          iprint = inum

      else if ( ikey .eq. 13 ) then
          ncomp = inum
      end if

C     IIERATE
      go to 100

C     END OF LOOP

C     TERMINATIONS

C     CLOSING SPECIFICATION FILE
 200  continue
      close(20)
      go to 500

C     NO SPECIFICATION FILE
 300  continue
C     write(*, 9000)
      write(10,9000)
      go to 500

C     ERROR READING THE SPECIFICATION FILE
 400  continue
      write(*, 9010)
      write(10,9010)
      go to 500

C     PRINTING PARAMETERS VALUES
 500  continue

C     write(* ,4000) hptype,avoidds,skipacc,sclsys,rmfixv,slacks,
C    +               scale,epsfeas,epsopt,iprint,ncomp
      write(10,4000) hptype,avoidds,skipacc,sclsys,rmfixv,slacks,
     +               scale,epsfeas,epsopt,iprint,ncomp

C     NON-EXECUTABLE STATEMENTS

 1000 format(A80)
 2000 format(BN,I20)
 3000 format(BN,F24.0)
 4000 format(/,' ALGENCAN PARAMETERS:',
     +       /,' hptype   = ',     14X,A6,
     +       /,' avoidds  = ',     19X,L1,
     +       /,' skipacc  = ',     19X,L1,
     +       /,' sclsys   = ',     19X,L1,
     +       /,' rmfixv   = ',     19X,L1,
     +       /,' slacks   = ',     19X,L1,
     +       /,' scale    = ',     19X,L1,
     +       /,' epsfeas  = ',8X,1P,D12.4,
     +       /,' epsopt   = ',8X,1P,D12.4,
     +       /,' iprint   = ',        I20,
     +       /,' ncomp    = ',        I20)
 9000 format(/,' The optional specification file algencan.dat was not',
     +         ' found in the current',/,' directory (this is not a',
     +         ' problem nor an error). The default values for the',/,
     +         ' ALGENCAN parameters will be used.')
 9005 format(/,' Specification file algencan.dat is being used.')
 9010 format(/,' Error reading specification file algencan.dat.')
 9020 format(  ' Ignoring unknown keyword ',A27)
 9030 format(  ' Ignoring incomplete keyword ',A27)
 9040 format(1X,A32)
 9041 format(1X,A32,5X,I20)
 9042 format(1X,A32,1X,1P,D24.8)

 9050 format(1X,' (Subroutine ',A4,' from HSL will be used as a direct',
     +          ' solver for linear systems.)')
 9060 format(1X,' (Linear systems will be scaled using the embedded',
     +          ' scaling option of',/,
     +       1X,' subroutine ',A4,' from HSL.)')
 9070 format(1X,' (Subroutine ',A4,' from HSL will be used for scaling',
     +          ' linear systems.)')

 9100 format(/,' Warning: Ignoring keyword ',A27,'. This option',
     +         ' requires',/,' subroutines EVALH and EVALHC, or,',
     +         ' alternatively, subroutine EVALHLP, to be',/,' coded',
     +         ' by the user. If you already coded them, set array',
     +         ' CODED in subrutine',/,' INIP appropiately.',/)
 9110 format(/,' Warning: Ignoring keyword ',A27,'. This option',
     +         ' requires',/,' subroutines EVALH and EVALHC, or,',
     +         ' alternatively, subroutine EVALHL, to be',/,' coded',
     +         ' by the user. If you already coded them, set array',
     +         ' CODED in subrutine',/,' INIP appropiately.',/)
 9120 format(/,' Warning: Ignoring keyword ',A27,'. This option',
     +         ' requires',/,' subroutine MA27 or MA57 from HSL to be',
     +         ' provided by the user. If you have any',/,' of them,',
     +         ' see the compilation instructions for details.',/)
 9130 format(/,' Warning: Ignoring keyword ',A27,'. This option',
     +         ' requires',/,' subroutine MC30 or MC77 from HSL to be',
     +         ' provided by the user. If you have any',/,' of them,',
     +         ' see the compilation instructions for details.',/)

      end
