c
c****************************************************************************
c  CASE
c****************************************************************************
c
      function case (string)
c
c     Function case
c
c     Created:  April 8, 1999 by P. L. Fast
c               This code was taken from Polyrate
c     Revised:
c     Purpose:  consistent case
c
c     Description:  this function takes a string of 80 characters and
c                   converts all the upper case letters to lower case.
c
c     Called by: rline, chkln, g98oute, mg98oute, mg98outg, mg98outh
c     Calls:
c
c     Variables defined here: 
c
c
      implicit none
c
      integer  itry, i
      character*80 string, case
      character * 1 xlett
c
      do 10 i = 1, 80
        xlett = string(i:i)
        itry = ichar (xlett)
        if (xlett .ge. 'A' .and. xlett .le. 'Z') then
          itry = itry + 32
          string (i:i) = char (itry)
        endif
 10   continue
c
      case  = string
c
      return
      end
c
c
c****************************************************************************
c  RLINE
c****************************************************************************
c
      subroutine rline(iunitr,string,istrt,isect,iscend,iend)
c
c     Created:  April 8, 1999 by P. L. Fast
c               Taken from Polyrate
c     Revised:  June 18, 1999 by JMR
c
c     This subroutine finds the first non-comment and non-blank line
c     and the location of the first character on that line.  The contents
c     of the line are placed in the variable string.  It will
c     then change it to all lower case using the routine 'case'.
c     A flag is set if the line is the start of a new section.
c
c     istrt:   location in 80 character string that is the first non-blank
c     isect:   a 1 is returned if the first non-blank character is a *
c              signalling the start of a section
c     iscend:  a 1 is returned if the line is 'end' signalling a section
c              end
c     iend:    a 1 is returned if the end of file 5 is encountered
c     string:  80 character string that is the contents of the current line
c
c     Called by: read5, rmlgen, rlc, rimo, rmlopt, rextopt, rhc, rgeom,
c        rhfmo, rib, rmcsac, rsac, rmccmco, rmccmnm, rmccmut, rcoef, rg2,   
c        rmcg2, rg3, rmcg3, rmqcisd, rmcomp2, rmcco,rmc3bb,rmc3mpw                 0712BL02 
c     Calls: fchar, chkln, case
c
      use files, only : outfile
      implicit none
c
      integer  iunitr, istrt, isect, iend, j, iblnk 
      integer  iscend, icommt
      character * 80 string, case
c
1000  format(A80)
c
c       initialize variables
c
      istrt = 1
      isect = 0
      iend = 0
      iblnk = 1
      iscend = 0
      icommt = 1
c
c     read in next line in iunitr - find first non-blank character  with
c     fchar and then check the line with chkln to see if it is a comment
c     line. Continue cycling through lines in infile until a non-blank,
c     non-comment line is found 
c
      do while ((iblnk .eq. 1) .and. (icommt .eq. 1))
         istrt=1
         read(iunitr,1000,end=9999) string
         call fchar(string, istrt, iblnk)
         if (iblnk .ne. 1) then
            call chkln(string, istrt, isect, icommt, iscend)
         endif
      end do
c
c     strip off any trailing comments on the line
c
      do 1 j=istrt,80
         if (string(j:j).eq.'#') then
            string(j:80) = ' '
            return
         endif
1     continue
c
c     change to lower case
c
      string = case(string)
      return

9999  iend=1
      return
      end
c
c
c*******************************************************************************
c  READ5
c*******************************************************************************
c
      subroutine read5( mlgeninp, progrms, mloptinp, extoptinp, 
     *     llc, mcinp, mgswit, hfmoinp, mcoptl, sacinp, mcsinp,ibinp,
     *     mcoinp, mnminp, mutinp, g2inp, mg2inp, g3inp, mg3inp,
     *     mqcinp, mcomp2inp, mccoinp, g3sxmp3inp,mc3bbinp,mc3mpwinp,   0712BL02
     *     limohc,imohcinp, ltest, tmeth, tbas, toptl )                 0111PF00
                                                                         
c
c     Subroutine read5
c
c     Created:  April 8, 1999 by P. L. Fast
c     Revised:  Summer 1999 by JMR
c               July 12, 2002 by B. J. Lynch
c     Purpose:  read the input file
c
c     Description:  this subroutine is used to call additional subroutines
c                   to read the input file and return values for all
c                   parameters specified by the user.
c
c     Called by:  main
c     Calls: defgen, deflc, defimo, rline, rmlgen, rimo, rlc,
c         insumry, rextopt, rmlopt
c
c     Variables defined here:  istrt, isect, iend, j, string
c
c
      use input
      use files, only : outfile, infile
      implicit none
c
      integer  istrt,isect,iend,j,iscend
      character*80  string

      type (proglist) :: progrms
      type (general) :: mlgeninp
      integer  llc, limohc, ltest
      type (mctype)  :: mcinp
      type (mgtype)  :: mgswit
      type (hfmoinf) :: hfmoinp
      character*80   :: mcoptl(5), toptl(5)
      character*20   :: tmeth, tbas
      type (mcinf)   :: sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp
      type (ginf)    :: g2inp, g3inp
      type (mginf)   :: mg2inp, mg3inp, mqcinp,mc3mpwinp,               0111PF00
     *                  mcomp2inp, mccoinp, g3sxmp3inp,mc3bbinp         0712BL02
      type (imoinf)  :: imohcinp
      type (extopt)  :: extoptinp
      type (mlopt)   :: mloptinp
c
c     initialize variables and set defaults
c
      call defprog( progrms )
      call defgen( mlgeninp, mloptinp, extoptinp ) 
      call defimo( limohc, imohcinp )
      call deftest( ltest, tmeth, tbas, toptl )
      call deflc( llc, mcinp, mgswit, hfmoinp, mcoptl, sacinp,
     *     mcsinp, ibinp, mcoinp, mnminp, mutinp, g2inp, mg2inp,
     *     g3inp, mg3inp, mqcinp,                                       0111PF00
     *     mcomp2inp, mccoinp, g3sxmp3inp, mc3bbinp, mc3mpwinp)         0712BL02
        limohc=0

c
c     read the first section of the input file
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c     check that the input file was not empty
c
      if (iend .eq. 1) then
        write (outfile,1000)
 1000   format (3x, 'Error:  input file was empty')
        stop 'read5  1'
      endif
c
c     check that the first line of the input file is a section header
c
      if (isect .ne. 1) then
         write (outfile,1100)
 1100    format (3x, 'Error:  the first line of the input file must',
     *               ' be a section header that begins with an *')
         stop 'read5 2'
      endif
c
c     Call the correct subroutine to read the data in the section.
c     Control is returned back to this subroutine when another section
c     is found.  This loop will continue until the end of file is reached.
c
      j = 0
c
      do while (iend .eq. 0)
        j = istrt + 1      
        if (string(j:j+7) .eq. 'multigen') then
           call rmlgen (mlgeninp,string, iend, istrt)
        elseif (string(j:j+2) .eq. 'imo') then
           call rimo (progrms, limohc, imohcinp, mlgeninp%geom%natoms, 
     *           string, iend, istrt)
        elseif (string(j:j+3) .eq. 'test') then
           call rtest (progrms, tmeth, tbas, toptl, 
     *           string, iend, istrt)
           ltest = 1
        elseif (string(j:j+1) .eq. 'lc') then
           llc = 1
           call rlc (progrms, llc, mcinp, mgswit, hfmoinp, mcoptl, 
     *        sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp, g2inp,
     *        mg2inp, g3inp, mg3inp, mqcinp, mcomp2inp, mccoinp,        0712BL02
     *        g3sxmp3inp, mc3bbinp, mc3mpwinp,                          1011YZ03
     *        string, iend, istrt)                                      0111PF00 
        elseif (string(j:j+7) .eq. 'multiopt') then
           mlgeninp%lopt = 1
           call rmlopt(progrms, mloptinp, mlgeninp%geom%natoms,
     *                   string, istrt, iend, mlgeninp%geomunit)        0713NG04
        elseif (string(j:j+5) .eq. 'extopt') then
           mlgeninp%lextopt = 1
           call rextopt( progrms, extoptinp, string, istrt, iend )
        else
           write (outfile,1200) string(j-1:80)
           stop 'read5 3'
        endif
      enddo
c
 1200 format (3x, 'Error:  the following is not a valid section name: ',
     *            a)
c
c  Check that no invalid combinations were placed in the input file.
c    i.e.  anything requiring an MP4D gradient or hessian.
c  
c     call chkinp( mlgeninp, mloptinp, mcinp, sacinp, mcsinp, ibinp,
c    *               mcoinp, mutinp )
c
c     print out all input parameters
c
      call insumry( mlgeninp, progrms, mloptinp, extoptinp, llc, 
     *      mcinp, mgswit, hfmoinp, mcoptl, sacinp, mcsinp, ibinp,
     *      mcoinp,mnminp, mutinp, g2inp, mg2inp, g3inp, mg3inp,
     *     mqcinp,mcomp2inp,mccoinp,g3sxmp3inp,mc3bbinp,mc3mpwinp,      0712BL02 
     *      limohc, imohcinp, ltest, tmeth, tbas, toptl )               0111PF00 
c
      return
      end
c 
c
c*******************************************************************************
c  DEFPROG
c*******************************************************************************
c
      subroutine defprog( progrms )
c
c     Created:  August 16, 1999 by J. M. Rodgers
c     Revised:
c     Purpose:  To set all the default programs called for different 
c        Multilevel calculations
c
c     Called by:  read5
c     Calls:
c
c     Variables defined here:
c
      use input, only : proglist
      use progdef

      type (proglist) :: progrms

      progrms%mcprog = defmcp
      progrms%g2prog = defg2p
      progrms%g3prog = defg3p
      progrms%hfprog = defhfp
      progrms%moprog = defmop
      progrms%imohlprog = defimohlp
      progrms%imollprog = defimollp
      progrms%extoptprog = defextoptp
      progrms%testprog = deftestp
      progrms%hessprog = defhessp

      return
      end
c
c
c*******************************************************************************
c  DEFGEN
c*******************************************************************************
c
      subroutine defgen( mlgeninp, mloptinp, extoptinp )
c
c     Created:  April 14, 1999 by P. L. Fast
c     Revised:
c     Purpose:  To set all the default variables used in the multigen,
c         extopt, and multiopt sections
c
c     Description:  Lists all variables for the Multilevel keywords in
c         the Multigen section and defines those that have default values
c         or initializes them to zero.  All switch parameters are defined
c         as integers and assigned values 0 or 1.
c
c     Called by:  read5
c     Calls:
c
c     Variables defined here:
c
      use input, only : general, maxatm, mlopt, extopt
      use input, only : nebopt                                          0515NG06
      use energy, only : eso, ecc, erel
      use param, only : nonlin, lowhs
      use pseudopot                                                     1106RMP13
      implicit none
c
      type (general)  :: mlgeninp
      type (mlopt)    :: mloptinp
      type (nebopt) :: nebinp                                           0515NG06
      type (extopt)   :: extoptinp
      integer i, j
c     
c -------------------------------------
c set defaults for switches
c -------------------------------------
c
c switch                   ml name
c ------                   -------
c ENERGY                   lener
c GRADIENT                 lgrad
c HESSIAN                  lhess
c EXTOPT                   lextopt
c MLOPT                    lopt
c PRSUM                    lprsum                                       0418PJ01
c
c
      mlgeninp%lener = 1
      mlgeninp%lgrad = 0
      mlgeninp%lhess = 0
      mlgeninp%lextopt = 0
      mlgeninp%lopt  = 0
      mlgeninp%lprsum = 0                                               0418PJ01
c
c -------------------------------------
c set defaults for variables
c -------------------------------------
c
c variable                 ml name
c --------                 -------
c NATOMS                   natoms
c TITLE                    mtitle
c CHARGE                   charge
c MULTIPLICITY             mult
c GEOMUNIT                 geomunit
c GEOMTYPE                 geomtype
c GEOM                     geom
c ESO                      eso
c ECC                      ecc
c EREL                     erel
c EXTOPT                   extoptinp
c MLOPT                    mloptinp
c NEBITER                  nebiter                                      0515NG06
c KSPR                     kspr                                         0515NG06
c INTERP                   interp                                       0515NG06
c
c  No default for NATOMS.
c
c  TITLE is blank by default.
c
      do 10 i=1, 5
          mlgeninp%mtitle(i) = '   '
  10  continue
c
c  Charge and Multiplicity defaults
c
      mlgeninp%geom%charge = 0
      mlgeninp%geom%mult = 1
c
c  Default input geometry unit is angstroms.
c  Default input geometry format is cartesian.
c
      mlgeninp%geomunit = 1
      mlgeninp%geomtype = 0
c
c  Set 3-d geometry array to 0.
c  Set array of atoms to blanks and atomic mass array to 0.0
c
      do 30 i=1, 3*maxatm
         mlgeninp%geom%angcoord(i) = 0.0d0
  30  continue
      do 35 i=1, maxatm
         mlgeninp%geom%atm(i) = '  '
         mlgeninp%geom%atmmss(i) = 0.0d0 
 35   continue
c
c  Set spin-orbit, core-correlation, and relativistic energies to 0.0
c
      eso =  0.0000d0
      ecc =  0.0000d0
      erel = 0.0000d0
c 
c  EXTOPT
c     Set external optimization parameters
c
      extoptinp%meth    = 'mp2'
      extoptinp%bas     = 'cc-pvdz'
      do 50 i=1, 5
         extoptinp%optl(i) = '   '
  50  continue
C Default values for pseudopotentials                                   1106RMP13 
      genecp  = '   '                                                   1106RMP13
      lgenecp  = 0                                                      1106RMP13
c
c
c
c  MLOPT
c     Set Multilevel optimization parameters - in Atomic Units
c
c  NR optimization
c
      mloptinp%algrthm  = 0
c
c  Type of Hessian used = low level (usually HF)
c
      mloptinp%htyp = lowhs
      mloptinp%hmeth = 'hf             '
      mloptinp%hbas = '6-31G*         '
      mloptinp%hscale = 1.0d-5
      mloptinp%ihunit = 1
c
c  Return molecule to old orientation after optimization
c
      mloptinp%reorient = 1
c
c  Use the SAC Method as described in LC or with the default parameters
c
      mloptinp%mlmeth   = 'sac '
c
c  Set molecule type to nonlinear minimum
c
      mloptinp%iop  = nonlin
c
c  Step size for 1st deriv of grad in geom optimization
c
      mloptinp%dlx2     = 1.0d-5
c
c  Max allowed grad component
c
      mloptinp%gcomp    = 1.0d-3
c
c  Max RMS step before Brent line minimization
c
      mloptinp%scale    = 1.0d0
c
c  'optimization failure' parameter
c
      mloptinp%stptol   = 1.0d-5
c
c  Recalc hessian every 10 steps
c
      mloptinp%hrec     = 10
c
c  Maximum of 50 optimization iterations
c
      mloptinp%niter    = 50
c
c  Don't switch to full Newton if original optimization fail
c
      mloptinp%retry    = 0
c
c  RMIN, RMAX, OMIN, DDMAX, DDMAXTS IUPD
c
 
       mloptinp%rmin    = 0.0d0                                          02YZ
       mloptinp%rmax    = 4.0d0                                          02YZ
       mloptinp%omin    = 0.8d0	                                         02YZ
       mloptinp%ddmax   = 0.5d0	                                         02YZ
       mloptinp%ddmaxts = 0.3d0                                          02YZ
       mloptinp%iupd    = 0
c
c  1st step is steepest descent
c
      mloptinp%sdstrt   = 1
c
c  Hold x1, y1, z1, y2, z2, z3 constant (since nonlin is default)
c
      do 57 i=1, 3*maxatm
         mloptinp%constant(i) = 0
  57  continue
      do  i=1, 5
         mloptinp%optl(i) = '   '
      enddo 

      mloptinp%constant(1) = 1
      mloptinp%constant(2) = 1
      mloptinp%constant(3) = 1
      mloptinp%constant(5) = 1
      mloptinp%constant(6) = 1
      mloptinp%constant(9) = 1

c
c  Maximum of 40 NEB optimization iterations
c  Default Value for k spring
c  Default value for Interpolation: LINEAL
c
      mloptinp%nebinp%nebiter    = 40                                          
      mloptinp%nebinp%kspr       = 1.0d-2
      mloptinp%nebinp%interp     = 1
c
c

      return
      end
c
c
c*******************************************************************************
c  DEFLC
c*******************************************************************************
c
      subroutine deflc( llc, mcinp, mgswit, hfmoinp, mcoptl,
     *      sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp, g2inp,
     *      mg2inp, g3inp, mg3inp, mqcinp, mcomp2inp, mccoinp,          0712BL02
     *      g3sxmp3inp, mc3bbinp,mc3mpwinp)                              1011YZ03
c
c     Created:  April 14, 1999 by P. L. Fast
c     Revised:  January 11, 2000 by P. L. Fast
c     Purpose:  To set all the defaults used in the LC section
c
c     Description:  Lists all variables for the Multilevel keywords in
c         the LC section and defines those that have default values
c         or initializes them to zero.  All switch parameters are defined
c         as integers and assigned values 0 or 1.
c
c     Called by:  read5
c     Calls:
c
c     Variables defined here:
c
      use input, only : mctype, mgtype, hfmoinf, mcinf, mginf, ginf
      use param
      use gparam
      implicit none
c
      integer i
      integer  llc
      type (mctype)  :: mcinp
      type (mgtype)  :: mgswit
      type (hfmoinf) :: hfmoinp
      character*80   :: mcoptl(5)
      type (mcinf)   :: sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp
      type (ginf)    :: g2inp, g3inp
      type (mginf)   :: mg2inp, mg3inp, mqcinp,                         0111PF00
     *                  mcomp2inp, mccoinp,                             0712BL02
     *                  g3sxmp3inp, mc3bbinp,mc3mpwinp                  1011YZ03 
c set defaults for switches
c -------------------------------------
c
c switch                   ml name
c ------                   -------
c LC                       llc
c HFMO                     hfmoinp%lhfmo
c IB                       mcinp%lib
c SAC                      mcinp%lsac
c MCSAC                    mcinp%lmcsac
c MCCMCO                   mcinp%lmccmco
c MCCMNM                   mcinp%lmccmnm
c MCCMUT                   mcinp%lmccmut
c COOP/NOCOOP              mcinp%lcoop
c G2                       mgswit%lg2
c MCG2                     mgswit%lmcg2
c G3                       mgswit%lg3
c MCG3                     mgswit%lmcg3
c MCQCISD                  mgswit%lmqcisd
c MCOMP2                   mgswit%lmcomp2                               0710PJ00
c MCCO                     mgswit%lmcco                                 0712BL02
c G3SX(MP3)                mgswit%lg3sxmp3                              1011YZ03
c MC3BB                    mgswit%lmc3bb                                1011YZ03
c
      llc           = 0
      hfmoinp%lhfmo = 0
      mcinp%lib     = 0
      mcinp%lsac    = 0
      mcinp%lmcsac  = 0
      mcinp%lmccmco = 0
      mcinp%lmccmnm = 0
      mcinp%lmccmut = 0
      mcinp%lcoop   = 0
      mgswit%lg2    = 0
      mgswit%lmcg2   = 0 
      mgswit%lg3     = 0
      mgswit%lmcg3   = 0
      mgswit%lmqcisd = 0                                                0111PF00
      mgswit%lmcomp2 = 0                                                0710PJ00
      mgswit%lmcco   = 0                                                0712BL02
      mgswit%lg3sxmp3= 0                                                1011YZ03
      mgswit%lmc3bb  = 0                                                1011YZ03
      mgswit%lmc3mpw  = 0                                               0111YZ04
c
c -------------------------------------
c set defaults for variables
c -------------------------------------
c
c variable                 ml name
c --------                 -------
c HFMO
c   HFKEY
c     BASIS                hfmoinp%hfkbas
c     OPTIONS              hfmoinp%hfkoptl
c   MOKEY
c     METHOD               hfmoinp%mokmeth
c     OPTIONS              hfmoinp%mokoptl
c   FRACHF                 hfmoinp%frachf
c MCOPTIONS                mcoptl
c IB
c   METHOD                 ibinp%meth
c   LLBASIS                ibinp%bas1
c   HLBASIS                ibinp%bas2
c   ALPHA                  ibinp%coef(1)
c   BETA                   ibinp%coef(2)
c MCSAC
c   METHOD                 mcsinp%meth
c   BASIS                  mcsinp%bas1
c   COEFS                  mcsinp%coef
c   VERSION                mcsinp%version
c MCCMCO
c   METHOD                 mcoinp%meth
c   LLBASIS                mcoinp%bas1
c   HLBASIS                mcoinp%bas2
c   COEFS                  mcoinp%coef
c   VERSION                mcoinp%version
c MCCMNM
c   METHOD                 mnminp%meth
c   LLBASIS                mnminp%bas1
c   MLBASIS                mnminp%bas2
c   HLBASIS                mnminp%bas3
c   COEFS                  mnminp%coef
c   VERSION                mnminp%version
c MCCMUT
c   METHOD                 mutinp%meth
c   LLBASIS                mutinp%bas1
c   HLBASIS                mutinp%bas2
c   COEFS                  mutinp%coef
c   VERSION                mutinp%version
c SAC
c   METHOD                 sacinp%meth
c   BASIS                  sacinp%bas
c   COEF                   sacinp%coef
c   VERSION                sacinp%version
c
c G2
c   OPTIONS                g2inp%optl
c   ALPHA                  g2inp%alpha
c   BETA                   g2inp%beta
c G2OPTIONS                mg2inp%optl
c MCG2
c   COEFS                  mg2inp%mcoef
c   VERSION                mg2inp%version
c
c G3
c   OPTIONS                g3inp%optl
c   ALPHA                  g3inp%alpha
c   BETA                   g3inp%beta
c MG3OPTIONS               mg3inp%optl
c MCG3
c   COEFS                  mcg3inp%coef
C   VERSION                mcg3inp%version
c
c MQCISDOPTIONS            mqcinp%optl
c MCQCISD
c   COEFS                  mqcinp%mqcoef
c   VERSION                mqcinp%version
c
c MCOMP2OPTIONS            mcomp2inp%optl                               0710PJ00
c MCOMP2                                                                0710PJ00
c   COEFS                  mcomp2inp%mcomp2coef                         0710PJ00
c   VERSION                mcomp2inp%version                            0710PJ00
c
c MCCOOPTIONS              mccoinp%optl                                 0712BL02
c MCCO                                                                  0712BL02 
c   COEFS                  mccoinp%mccocoef                             0712BL02 
c   VERSION                mccoinp%version                              0712BL02 
c
c HFMO options
c
      hfmoinp%hfkbas = 'sto-3g'
c
      do 10 i = 1, 5
         hfmoinp%hfkoptl(i) = '   '
 10   continue
c
      hfmoinp%mokmeth = 'am1'
c
      do 20 i = 1, 5
         hfmoinp%mokoptl(i) = '   '
 20   continue
c
      hfmoinp%frachf = 0.25d0
c
c MC Options (for sac, mcsac, ib, and mccm calculations)
c
      do 25 i = 1, 5
         mcoptl(i) = '   '
 25   continue
c
c IB options
c
      ibinp%meth = 'mp2'
c
      ibinp%bas1 = 'cc-pvdz'
      ibinp%bas2 = 'cc-pvtz'
      ibinp%coef(1) = ibdefa
      ibinp%coef(2)  = ibdefb(pmp2)
      ibinp%version = '   '
c
c MCSAC options
c
      mcsinp%meth = 'ccsd'
      mcsinp%bas1  = 'cc-pvdz'
      mcsinp%version = 'v3s'
c
c initialize mcscoef
c
      do 50 i = 1, 10
         mcsinp%coef(i) = 0.0d0
 50   continue
c
c set defaults for mcscoef (mcsac-ccsd/cc-pvdz)
c
      do 55 i=1, 4
        mcsinp%coef(i) = mcsdefc(v3s,pccsd,pdz,i)
 55   continue
c
c MCCMCO options
c
      mcoinp%meth = 'mp2'
      mcoinp%bas1 = 'cc-pvdz'
      mcoinp%bas2 = 'cc-pvtz'
      mcoinp%version = 'v3s'
c
c initialize mcocoef
c
      do 70 i = 1, 10
         mcoinp%coef(i) = 0.0d0
 70   continue
c
c set defaults for mcocoef (mccm-mp2)
c
      do 75 i=1, 10
         mcoinp%coef(i) = mcodefc(v3s,pmp2,i)
 75   continue
c      
c MCCMNM options
c
      mnminp%meth = 'ccsd(t)'
      mnminp%bas1 = 'cc-pvdz'
c      mnminp%bas2 = 'pdz+' 
      mnminp%bas2 = 'mpdz'                                              0808RMP12
      mnminp%bas3 = 'cc-pvtz'
      mnminp%version = 'v2m'
c
c initialize mnmcoef
c
      do 90 i = 1, 10
         mnminp%coef(i) = 0.0d0
 90   continue 
c
c set defaults for mnmcoef (mccm-ccsd(t);mp2;hf+)
c
      do 95 i=1, 7
         mnminp%coef(i) = mnmdefc(v2m,i)
 95   continue
c
c MCCMUT options
c
      mutinp%meth = 'ccsd(t)'
      mutinp%bas1 = 'cc-pvdz'
      mutinp%bas2 = 'cc-pvtz'
      mutinp%version = 'v3s'
c
c initialize mutcoef
c
      do 110 i = 1, 10
         mutinp%coef(i) = 0.0d0
 110  continue
c
c set defaults for mutcoef (mccm-ccsd(t);mp2)
c
      do 115 i=1, 7
         mutinp%coef(i) = mutdefc(v3s,pccsdt,i)
 115  continue
c
c SAC options
c
      sacinp%meth = 'mp2'
      sacinp%bas1  = '6-31+g(d,2p)'
      sacinp%coef(1) = sacdefc(v3s,pmp2,dz)
      sacinp%version = 'v3s'
c
c G2 options
c
      do 120 i = 1, 5
         g2inp%optl(i) = '   '
 120  continue
c
c no default for number of alpha and beta electrons
c
c
c MCG2 options
c
      do 130 i = 1, 5
         mg2inp%optl(i) = '   '
 130  continue
c
c set defaults for mcg2coef (mcg2)
c
      mg2inp%version = 'v3s'
c
      do 140 i=1, 9
         mg2inp%mcoef(i) = mc2defc(g3s,i)
 140  continue
c
c G3 options
c
      do 165 i = 1, 5
         g3inp%optl(i) = '   '
 165  continue
c                
c no default for number of alpha and beta electrons
c
c
c MCG3 options
c
      do 170 i = 1, 5
         mg3inp%optl(i) = '   '
 170  continue
c
c set defaults for mc3coef
c
      mg3inp%version = 'v3s'                                            0224BL02
c
      do 180 i = 1, 9
         mg3inp%mcoef(i) = mc3defc(g3s,i)                               0224BL02
 180  continue
c
c G3SX(MP3) options
c
      g3sxmp3inp%version = 'v3s'
c
      do 185 i = 1, 5
        g3sxmp3inp%optl(i) = '   '
        g3sxmp3inp%g3sxmp3coef(i) = g3sxmp3defc(g3s,i)
 185  continue  
c
c set defaults for g3sxmp3coef 

c
c MC3BB options
c
      do 186 i = 1, 5
         mc3bbinp%optl(i) = '   '
 186  continue
c
c set defaults for mc3bbcoef
c
      mc3bbinp%version = '   '                                          0224BL02
c
      do 187 i = 1, 2                                                   0808RMP12
         mc3bbinp%mc3bbcoef(i) = mc3bbdefc(g3s,i)                       1220YZ03 
 187  continue

c
c MC3MPW options
c
c
      do 188 i = 1, 5
         mc3mpwinp%optl(i) = '   '
 188  continue
c
c set defaults for mc3bbcoef
c
      mc3mpwinp%version = '   '                                         0224BL02
c
      do 189 i = 1, 2                                                   0808RMP12
         mc3mpwinp%mc3mpwcoef(i) = mc3mpwdefc(g3s,i)                    1220YZ03 
 189  continue




c
c set defaults for mcqcisd
c

      mqcinp%version = 'v3s'                                            0224BL02

c
      do 220 i = 1, 4                                                   0112PF00
         mqcinp%mqcoef(i) = mqcdefc(g3s,i)                              0224BL02
         mqcinp%optl(i) = '   '                                         0112PF00
 220  continue                                                          0112PF00
c
c set defaults for mcomp2                                               0710PJ00
c                                                                       0710PJ00 
      mcomp2inp%version = 'v3s'                                         0224BL02
c
      do 230 i = 1, 4                                                   0710PJ00
         mcomp2inp%mcomp2coef(i) = mcomp2defc(g3s,i)                    0224BL02
         mcomp2inp%optl(i) = '   '                                      0710PJ00
 230  continue                                                          0710PJ00

c set defaults for mcco                                                 0712BL02
c                                                                       0712BL02 
      mccoinp%version = 'v3s'                                           0712BL02
c
      do 240 i = 1, 4                                                   0712BL02
         mccoinp%mccocoef(i) = mccodefc(g3s,i)                          0712BL02
         mccoinp%optl(i) = '   '                                        0712BL02
 240  continue                                                          0712BL02

c
c  Set defaults for switches indicated whether MCCM, IB, MCSAC, and SAC
c    methods and basis sets are standard or nonstandard.
c  Default to standard for all switches.
c
      ibinp%stdm   = 1
      ibinp%stdb1  = 1
      ibinp%stdb2  = 1
      mcsinp%stdm  = 1
      mcsinp%stdb1 = 1
      mcoinp%stdm  = 1
      mcoinp%stdb1 = 1
      mcoinp%stdb2 = 1
      mnminp%stdm  = 1
      mnminp%stdb1 = 1
      mnminp%stdb2 = 1
      mnminp%stdb3 = 1
      mutinp%stdm  = 1
      mutinp%stdb1 = 1
      mutinp%stdb2 = 1
      sacinp%stdm  = 1
      sacinp%stdb1 = 1
c
c
       return
       end
c
c
c*******************************************************************************
c  DEFTEST
c*******************************************************************************
c     
      subroutine deftest(ltest, tmeth, tbas, toptl)
c
c     Created:  August 5, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  create default values for the test jobs
c
c     Called by:  read5
c     Calls:
c
      use pseudopot                                                     1106RMP13
      implicit none
c
      integer  ltest, i
      character*20  tmeth, tbas
      character*80  toptl(5)

      ltest = 0
      tmeth = 'mp2 '
      tbas = 'cc-pvdz '
      genecp = '     '                                                  1106RMP13
      lgenecp = 0                                                       1106RMP13

      do 20 i=1, 5
         toptl(i) = '                               '
  20  continue

      return
      end
c 
c 
c*******************************************************************************
c  DEFIMO
c*******************************************************************************
c 
      subroutine defimo(limohc, imohcinp)
c 
c     Created:  August 2, 1999 by J.M. Rodgers and B. J. Lynch
c     Revised:
c     Purpose:  create default values for the IMO values
c
c     Called by:  read5
c     Calls:
c
      use input, only : imoinf, maxatm

      implicit none
c
      integer  limohc, i
      type (imoinf) :: imohcinp
c
c  Switch for IMOHC off
c
      limohc = 0
c
c  Default values only for methods and bases - all information on the capping
c    must be supplied by the user.
c
      imohcinp%hlmeth = 'mp2 '
      imohcinp%hlbas  = ' '
      imohcinp%llmeth = 'hf '
      imohcinp%llbas  = ' '

      imohcinp%capatm = 0
      do 21 i=1, maxatm
         imohcinp%ssatm(i) = 0
         imohcinp%lsatm(i) = 0
  21  continue

      imohcinp%bond%k = 0.0000d0
      imohcinp%angle%k = 0.0000d0
      imohcinp%tors%k = 0.0000d0
      imohcinp%bond%eqval = 0.0000d0
      imohcinp%angle%eqval = 0.0000d0
      imohcinp%tors%eqval = 0.0000d0
      do 31 i=1, 4
         imohcinp%bond%atoms(i) = 0
         imohcinp%angle%atoms(i) = 0
         imohcinp%tors%atoms(i) = 0
  31  continue
c  
      do 41 i=1, 5
         imohcinp%hloptl(i) = '   '
         imohcinp%lloptl(i) = '   '
  41  continue
   
      return
      end   
c
c
c*******************************************************************************
c  RTEST
c*******************************************************************************
c
      subroutine rtest( progrms, tmeth, tbas, toptl, 
     *     string, iend, istrt )
c
c     Created:  August 5, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  read the TEST
c
c     Called by:  read5
c     Calls:  rline, rlist, rvar
c
      use files, only : outfile, infile
      use input, only : proglist
      use pseudopot                                                     1106RMP13
      implicit none
c
      integer istrt, ierr, iend, isect, icint, iscend
      character*80  string, toptl(5)
      character*20  rvar, tbas, tmeth
      type (proglist) :: progrms

      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of this section until the end of the
c section is reached.
c
      do while (isect.eq.0 .and. iend.eq.0 .and. iscend.eq.0)
         if (string(istrt:istrt+5).eq.'method') then
            tmeth = rvar(string,istrt,'TEST:METHOD')
         elseif (string(istrt:istrt+4).eq.'basis') then
            tbas = rvar(string,istrt,'TEST:BASIS')
         elseif (string(istrt:istrt+6).eq.'options') then
            call rlist(toptl, 'TEST:OPTIONS', iend )
         elseif (string(istrt:istrt+6).eq.'program') then
            progrms%testprog = rvar(string,istrt,'TEST:PROGRAM')
            if (string(istrt:istrt+2) .ne. 'g98' .and.
     *            string(istrt:istrt+3) .ne. 'pg98' .and.
     *            string(istrt:istrt+2) .ne. 'g94' .and.
     *            string(istrt:istrt+2) .ne. 'g03' .and.                1409ZY03
     *            string(istrt:istrt+2) .ne. 'g09') then                0808RMP12
               write (outfile,500)
  500          format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                 'the only allowed PROGRAMs for this ',
     *                 'version of Multilevel')
               stop 'rtest 2' 
            endif
c 
c GENECP                                                                1106RMP13 
c                                                                       
         elseif (string(istrt:istrt+5) .eq. 'genecp') then              1106RMP13
            genecp = rvar( string, istrt, 'TEST:GENECP')                1106RMP13
c            tbas = 'gen'                                               1106RMP13 
            lgenecp = 1                                                 1106RMP13
c

         else
            write (outfile,1000) string(istrt:80)
            stop 'rtest 1'
 1000      format(3x,'ERROR: the following is not a valid keyword in ',
     *               'the TEST section: ',a)
         endif
c
         call rline(infile,string,istrt,isect,iscend,iend)
c
      enddo

      return
      end
c
c
c*******************************************************************************
c  RIMO
c*******************************************************************************
c
      subroutine rimo( progrms, limohc, imohcinp, natoms, 
     *           string, iend, istrt )
c
c     Created:  August 2, 1999 by J.M. Rodgers and B. J. Lynch
c     Revised:
c     Purpose:  read the IMO section of the input file
c
c     Called by:  read5
c     Calls:  rline, rcss, rhc, rlist
c
      use input, only : imoinf, proglist
      use files, only : outfile, infile
      implicit none
c
      integer istrt, ierr, iend, isect, icint, iscend, limohc,
     *     natoms, i, j, iscend2, iscend3
      character*80  string
      type (imoinf)  :: imohcinp
      type (proglist) :: progrms
      character*20  rvar
c
c  read lines until reach IMOHC subsection reached
c
      do while (string(istrt:istrt+4).ne.'imohc')
         call  rline(infile,string, istrt, isect, iscend, iend)
      enddo
c zyzy
      limohc = 1 
      call rline(infile,string,istrt,isect,iscend,iend)
c  
c loop through the keywords of this section until the end of the
c section is reached.
c
      do while (isect.eq.0 .and. iend.eq.0 .and. iscend.eq.0)
c
c  CSS
c
         if (string(istrt:istrt+2).eq.'css') then
            call rcss( imohcinp%ssatm, imohcinp%ssnatm, iend )
c
c  CAPATOM
c
         elseif (string(istrt:istrt+6).eq.'capatom') then
            imohcinp%capatm = icint(rvar(string,istrt,'CAPATOM'))
c
c  HC
c
         elseif (string(istrt:istrt+1).eq.'hc') then
            call rhc(imohcinp%bond,imohcinp%angle,imohcinp%tors,iend)
c
c HLKEY
c
         elseif (string(istrt:istrt+4) .eq. 'hlkey') then
c
c read first line of hlkey
c 
            call rline(infile,string,istrt,isect,iscend2,iend)
            do while (iscend2.eq.0.and.isect.eq.0.and.iend.eq.0)
c
c HLKEY:METHOD
c
               if (string(istrt:istrt+5) .eq. 'method') then
                  imohcinp%hlmeth = rvar(string, istrt, 'HLKEY:METHOD')
c
c HLKEY:BASIS
c
               elseif (string(istrt:istrt+4) .eq. 'basis') then
                  imohcinp%hlbas = rvar(string, istrt, 'HLKEY:BASIS')
c
c HLKEY:PROGRAM
c
               elseif (string(istrt:istrt+6) .eq. 'program') then
                  progrms%imohlprog = rvar(string, istrt, 
     *                   'HLKEY:PROGRAM')
                  if (string(istrt:istrt+2) .ne. 'g98' .and.
     *                  string(istrt:istrt+3) .ne. 'pg98' .and.
     *                  string(istrt:istrt+2) .ne. 'g94'  .and.
     *                  string(istrt:istrt+2) .ne. 'g03'  .and.
     *                  string(istrt:istrt+2) .ne. 'g09') then          0808RMP12
                     write (outfile,500)
  500                format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                       'the only allowed PROGRAMs for this ',
     *                       'version of Multilevel')
                  endif
                  stop 'rimo 2' 
c              
c HLKEY:OPTIONS
c              
               elseif (string(istrt:istrt+6) .eq. 'options') then
                  call rlist(imohcinp%hloptl, 'HLKEY:OPTIONS', iend )
               else
                  write (outfile,1100) string(istrt:80)
1100              format(/3x,'ERROR: the following is not a valid ',
     *                   'option of the HLKEY keyword: ', a)
                  stop 'rimo 3'
               endif
               call rline(infile,string,istrt,isect,iscend2,iend)
            enddo
c
c LLKEY
c
         elseif (string(istrt:istrt+4) .eq. 'llkey') then
c
c read first line of llkey
c
            call rline(infile,string,istrt,isect,iscend3,iend)
            do while (iscend3.eq.0.and.isect.eq.0.and.iend.eq.0)
c
c LLKEY:METHOD
c
               if (string(istrt:istrt+5) .eq. 'method') then
                  imohcinp%llmeth = rvar(string, istrt, 'LLKEY:METHOD')
c 
c LLKEY:BASIS  
c 
               elseif (string(istrt:istrt+4) .eq. 'basis') then 
                  imohcinp%llbas = rvar(string, istrt, 'LLKEY:BASIS')  
c 
c LLKEY:PROGRAM
c 
               elseif (string(istrt:istrt+6) .eq. 'program') then 
                  progrms%imollprog = rvar(string, istrt, 
     *                      'LLKEY:PROGRAM')
                  if (string(istrt:istrt+2) .ne. 'g98' .and.
     *                  string(istrt:istrt+3) .ne. 'pg98' .and.
     *                  string(istrt:istrt+2) .ne. 'g94'  .and.
     *                  string(istrt:istrt+2) .ne. 'g03'  .and.
     *                  string(istrt:istrt+2) .ne. 'g09') then          0808RMP12
                     write (outfile,600)
  600                format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                       'the only allowed PROGRAMs for this ',
     *                       'version of Multilevel')
                     stop 'rimo 4' 
                  endif
c
c LLKEY:OPTIONS
c
               elseif (string(istrt:istrt+6) .eq. 'options') then  
                  call rlist(imohcinp%lloptl, 'LLKEY:OPTIONS', iend )
               else
                  write (outfile,1100) string(istrt:80)
1200              format(/3x,'ERROR: the following is not a valid ',
     *                   'option of the LLKEY keyword: ', a)
                  stop 'rimo 5'
               endif
               call rline(infile,string,istrt,isect,iscend3,iend)
            enddo
c
c  Invalid option
c
         else
            write (outfile,1000) string(istrt:80)
            stop 'rimo 1'
 1000      format(3x,'ERROR: the following is not a valid keyword in ',
     *               'the IMOHC section: ',a)
         endif
c
         call rline(infile,string,istrt,isect,iscend,iend)
c
      enddo
c
c  Finish out array of small system indices and create array of large
c    system indices (skipping only the cap atom)
c 
      imohcinp%ssatm(imohcinp%ssnatm) = imohcinp%capatm
      imohcinp%lsnatm = natoms - 1
      i = 1
      j = 1
      do while (i.le.natoms-1)
         if (i.eq.imohcinp%capatm) j = j+1
         imohcinp%lsatm(i) = j
         i = i+1
         j = j+1
      enddo
c
c  Scroll until hit end of file or next section heading
c
      do while (isect.eq.0 .and. iend.eq.0)
         call  rline(infile,string, istrt, isect, iscend, iend)
      enddo      

c
      return
      end
c
c*******************************************************************************
c  RCSS
c*******************************************************************************
c
      subroutine rcss( ssatm, ssnatm, iend )
c
c     Created:  August 2, 1999 by J.M. Rodgers
c     Revised:  
c     Purpose:  Reads the list of atoms in the small IMOHC system
c
c     Description:  Using the index i, loop through each line after the
c     input file line.  Reads in a line and finds the first character with
c     fchar and then checks the line with chkln. Converts the value to an
c     integer and saves to css to if appropriate.
c
c     Called by:  rimo
c     Calls:  fchar, fspace, rline, icint
c
      use input, only : maxatm
      use files, only : outfile, infile
      implicit none
c    
      integer  i,j,istrt,isect,iend,iblnk,iscend,icommt, ifin,
     *            ssatm(maxatm), ssnatm, icint, ierr, ilong, ibeg
      character*80  string

      i = 1
      isect = 0
      iend = 0
      iscend = 0

      call rline(infile,string,ibeg,isect,iscend,iend)
 
      do while (isect.eq.0.and.iscend.eq.0.and.iend.eq.0)
         ierr = 0
         ilong = 0
         ibeg = 1
         call fchar(string, ibeg, ierr)
         do while (ierr.eq.0 .and. ilong.eq.0)
            if (i .gt. maxatm-1)  goto 100
            ifin = ibeg + 1
            call fspace(string, ifin, ilong)
            if (ilong .eq. 0) then
               ifin = ifin - 1
            endif
            ssatm(i) = icint(string(ibeg:ifin+1))
            i = i+1
            ibeg = ifin + 1
            call fchar(string, ibeg, ierr)
         end do
         call rline(infile, string, ibeg, isect, iscend, iend)
      end do
c
c  Terminate if end of file or new section reached  before the end
c    of the coefficient list.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write (outfile, 1100)
1100     format(/3x,'ERROR: No end to CSS list')
         stop 'rcss 2'
      endif
      
      ssnatm = i

      return
  
 100  write (outfile, 1000)
1000  format(/3x,'ERROR:  Too many atoms in CSS')
      stop 'rcss 1'
      
      end
c
c*******************************************************************************
c  RHC
c*******************************************************************************
c
      subroutine rhc(bond,angle,tors,iend)
c
c     Created:  August 2, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Reads the harmonic cap info section of IMOHC
c
c     Called by:  rimo
c     Calls:  rline, rword, cfloat, icint
c
      use input, only : maxatm, hcinf
      use files, only : outfile, infile
      implicit none

      integer  iend, cnt, iscend, istrt, isect, ibeg, ifin, 
     *    ierr, i, icint
      type (hcinf)  :: bond, angle, tors
      character*80  string
      double precision  cfloat
c
c read each line in the HC section until an 'end' is found.  for each
c line read the k, the equilib. value, and the atoms involved.
c       
      cnt = 0
      call rline(infile,string,istrt,isect,iscend,iend)
      if (iend.eq.1)  return
      if (iscend.eq.1) then
         write(outfile, 1001)
         stop 'rhc 1'
      endif
      cnt = cnt+1

      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 2'
      endif
      bond%k = cfloat(string(ibeg:ifin))

      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1   
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 3'
      endif
      bond%eqval = cfloat(string(ibeg:ifin))

      do 100 i=1, 2
         ibeg = istrt
         call rword(string,istrt,ierr)
         ifin = istrt - 1   
         if (ierr.eq.1 .and. i.ne.2) then
            write(outfile,1011) string
            stop 'rhc 4'
         endif
         bond%atoms(i) = icint(string(ibeg:ifin))
 100  continue

      call rline(infile,string,istrt,isect,iscend,iend)
      if (iend.eq.1)  return
      if (iscend.eq.1) then
         write(outfile, 1001)
         stop 'rhc 5'
      endif
      cnt = cnt+1
               
      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 6'
      endif
      angle%k = cfloat(string(ibeg:ifin))
     
      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 7'
      endif
      angle%eqval = cfloat(string(ibeg:ifin))
      angle%eqval = angle%eqval*3.14159d0/180.0d0
 
      do 200 i=1, 3
         ibeg = istrt
         call rword(string,istrt,ierr)
         ifin = istrt - 1
         if (ierr.eq.1 .and. i.ne.3) then
            write(outfile,1011) string
            stop 'rhc 8'
         endif
         angle%atoms(i) = icint(string(ibeg:ifin))
 200  continue

      call rline(infile,string,istrt,isect,iscend,iend)
      if (iend.eq.1)  return
      if (iscend.eq.1) then
         write(outfile, 1001)
         stop 'rhc 9'
      endif
      cnt = cnt+1
               
      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 10'
      endif
      tors%k = cfloat(string(ibeg:ifin))
     
      ibeg = istrt
      call rword(string,istrt,ierr)
      ifin = istrt - 1
      if (ierr.eq.1) then
         write(outfile,1011) string
         stop 'rhc 11'
      endif
      tors%eqval = cfloat(string(ibeg:ifin))
      tors%eqval = tors%eqval*3.14159d0/180.0d0 

      do 300 i=1, 4
         ibeg = istrt
         call rword(string,istrt,ierr)
         ifin = istrt - 1
         if (ierr.eq.1 .and. i.ne.4) then
            write(outfile,1011) string
            stop 'rhc 12'
         endif
         tors%atoms(i) = icint(string(ibeg:ifin))
 300  continue

      call rline(infile,string,istrt,isect,iscend,iend)
      if (iscend.ne.1 .or. iend.eq.1) then
         write (outfile,1021)
         stop 'rhc 13'
      endif

      return

1001  format(/,'ERROR: HC section does not have the 3 necessary lines.')
1011  format(/,'ERROR: Invalid line in HC section:',/a80)
1021  format(/,'ERROR: HC section in IMOHC not terminated correctly')

      end
c
c
c*******************************************************************************
c  RMLGEN
c*******************************************************************************
c
      subroutine rmlgen(mlgeninp,string,iend,istrt)
c
c     Created:  April 15, 1999 by P. L. Fast
c     Revised:
c     Purpose:  read the MULTIGEN section of the input file
c
c     Description:  The Multigen section is scanned with rline and for
c     each keyword present, a value is assigned to the appropriate
c     variable or a function is called to do this.
c
c     Called by: read5
c     Calls: rline, rlist, icint, rgeom, cfloat, rvar
c
      use input, only : general
      use files, only : outfile, infile
      use energy, only : eso, ecc, erel
      use param, only : maxatm
      implicit none
c
      integer istrt, ierr, iend, isect, icint, iscend
      integer atmset, numatom
      double precision  cfloat
      character*20 unit, type, rvar
      character*80 string
      type (general)  :: mlgeninp

      atmset = 0
c
c read first line of this section
c
      call rline(infile,string,istrt,isect,iscend,iend)      
c
c loop through the keywords of this section until the end of the 
c section is reached.
c
      do while (isect.eq.0 .and. iend.eq.0 .and. iscend.eq.0)
c
c TITLE
c
        if (string(istrt:istrt+4) .eq. 'title') then
           call rlist(mlgeninp%mtitle, 'TITLE', iend)
c
c ENERGY
c
        elseif (string(istrt:istrt+5) .eq. 'energy') then
          mlgeninp%lener = 1
c
c NOENERGY
c
        elseif (string(istrt:istrt+7) .eq. 'noenergy') then
           mlgeninp%lener = 0
c
c GRADIENT
c
        elseif (string(istrt:istrt+7) .eq. 'gradient') then
           mlgeninp%lgrad = 1
c
c NOGRADIENT
c
        elseif (string(istrt:istrt+9) .eq. 'nogradient') then
           mlgeninp%lgrad = 0
c
c HESSIAN
c
        elseif (string(istrt:istrt+6) .eq. 'hessian') then
           mlgeninp%lhess = 1
c
c NOHESSIAN
c
        elseif (string(istrt:istrt+8) .eq. 'nohessian') then
           mlgeninp%lhess = 0
c
c NATOMS
c
        elseif (string(istrt:istrt+5) .eq. 'natoms') then
           mlgeninp%geom%natoms = icint(rvar(string, istrt, 'NATOMS'))
           atmset = 1
c
c GEOMUNIT
c
        elseif (string(istrt:istrt+7) .eq. 'geomunit') then
           unit = rvar(string, istrt, 'GEOMUNIT')
           if (unit(:3) .eq. 'ang') then
              mlgeninp%geomunit = 1
	   elseif (unit(:2) .eq. 'au') then
              mlgeninp%geomunit = 0
	   else
              write (outfile,11) string
  11          format ('ERROR:  Invalid GEOMUNIT option:', a80)
              stop 'rmlgen 3'
           endif
c
c GEOMTYPE
c
        elseif (string(istrt:istrt+7) .eq. 'geomtype') then
           type = rvar(string, istrt, 'GEOMTYPE')
           if (type(:9) .eq. 'cartesian') then
              mlgeninp%geomtype = 0
           else
              write (outfile,21) string
  21          format ( 'ERROR:  Invalid GEOMTYPE option:', a80)
              stop 'rmlgen 5'
           endif
c
c GEOM
c
        elseif (string(istrt:istrt+3) .eq. 'geom') then
           call rgeom(mlgeninp%geom, mlgeninp%geomunit, numatom,
     *                  string, istrt, iend)
c
c CHARGE
c
        elseif (string(istrt:istrt+5) .eq. 'charge') then
           mlgeninp%geom%charge = icint(rvar(string,istrt,'CHARGE'))
c
c MULTIPLICITY
c
        elseif (string(istrt:istrt+11) .eq. 'multiplicity') then
           mlgeninp%geom%mult = icint(rvar(string,istrt,'MULTIPLICITY'))
c
c ESO
c
        elseif (string(istrt:istrt+2) .eq. 'eso') then
           eso = cfloat(rvar(string,istrt,'ESO'))
c
c ECC
c
        elseif (string(istrt:istrt+2) .eq. 'ecc') then
           ecc = cfloat(rvar(string,istrt,'ECC'))
c
c EREL
c
        elseif (string(istrt:istrt+3) .eq. 'erel') then
           erel = cfloat(rvar(string,istrt,'EREL'))
c
c PRSUM                                                                 0418PJ01
c                                                                       
        elseif (string(istrt:istrt+4) .eq. 'prsum') then                0418PJ01
           mlgeninp%lprsum = 1                                          0418PJ01
c
c NOPRSUM                                                               0418PJ01
c
        elseif (string(istrt:istrt+6) .eq. 'noprsum') then              0418PJ01
           mlgeninp%lprsum = 0                                          0418PJ01
c
c Invalid option
c
        else
           write (outfile,1000) string(istrt:80)
           stop 'rmlgen 9'
 1000      format(3x,'ERROR: the following is not a valid keyword in ',
     *               'the GENERAL section: ',a)
        endif
c
        call rline(infile,string,istrt,isect,iscend,iend)
c
      end do
c
c  Stop if NATOMS never specified.
c
      if (atmset .ne. 1) then
         write (outfile,*) 'ERROR:  must specify natoms.'
         stop 'rmlgen 10'
c
c  Stop if NATOMS and GEOM not match each other.
c
      elseif (mlgeninp%geom%natoms .ne. numatom) then
         write (outfile,1100) numatom, mlgeninp%geom%natoms
1100     format ('ERROR: atoms in GEOM not equal NATOMS.',i3,i3)
         stop 'rmlgen 11'
      endif
c
      return
      end
c
c
c*******************************************************************************
c  REXTOPT
c*******************************************************************************
c
      subroutine rextopt( progrms, extoptinp, string, istrt, iend )
c
c     Created:  July 13, 1999 by J.M. Rodgers
c     Revised:  
c     Purpose:  reads the EXTOPT input section under multigen
c     
c     Called by:  rmlgen
c     Calls:  rline, rvar, rlist
c     
      use files, only : outfile, infile
      use input, only : extopt, proglist
      use pseudopot                                                     1106RMP13
      implicit none
c
      type (extopt)   :: extoptinp
      type (proglist) :: progrms
      integer  i, j, istrt, isect, iend, iscend
      character*80  string
      character*20  rvar
c
      isect = 0 
      iscend = 0
c
c read first line in EXTOPT section
c  
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the EXTOPT section
c
      do while (isect.eq.0 .and. iend.eq.0)
c
c PROGRAM
c
         if (string(istrt:istrt+6).eq.'program') then
            progrms%extoptprog = rvar(string, istrt, 'EXTOPT:PROGRAM')
            if (string(istrt:istrt+2) .ne. 'g98' .and.
     *             string(istrt:istrt+3) .ne. 'pg98' .and.
     *             string(istrt:istrt+2) .ne. 'g94'  .and.
     *             string(istrt:istrt+2) .ne. 'g03'  .and.
     *             string(istrt:istrt+2) .ne. 'g09') then               0808RMP12
               write (outfile,500)
  500          format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                   'the only allowed PROGRAMs for this ', 
     *                   'version of Multilevel')
               stop 'rextopt1'
            endif
c
c METHOD   
c
         elseif (string(istrt:istrt+5) .eq. 'method') then
            extoptinp%meth = rvar( string, istrt, 'EXTOPT:METHOD' )
c
c BASIS
c
         elseif (string(istrt:istrt+4) .eq. 'basis') then
            extoptinp%bas = rvar( string, istrt, 'EXTOPT:BASIS' )
c 
c GENECP                                                                1106RMP13 
c                                                                       1106RMP13 
         elseif (string(istrt:istrt+5) .eq. 'genecp') then              1106RMP13
            genecp = rvar( string, istrt, 'EXTOPT:GENECP' )             1106RMP13
            extoptinp%bas = 'gen             '                          1106RMP13
            lgenecp = 1                                                 1106RMP13
c
c OPTIONS
c
         elseif (string(istrt:istrt+6) .eq. 'options') then
            call rlist(extoptinp%optl, 'EXTOPT:OPTIONS', iend )


c
c Invalid option
c
         else
             write (outfile, 11) string
  11         format ( 'ERROR: Invalid EXTOPT option:', a80)
             stop 'extopt 2'
         endif
c
c read next line 
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo

      return
      end
c 
c
c*******************************************************************************
c  RMLOPT
c*******************************************************************************
c
      subroutine rmlopt( progrms, mloptinp, natoms, string, 
     *      istrt, iend, geomunit)                                      0713NG04
c
c     Created:  July 13, 1999 by J.M. Rodgers
c     Revised:  January 11, 2000 by P. L. Fast 
c               January 25, 2000 by P. L. Fast
c               July 13, 2004 by N. Gonzalez-Garcia                     0713NG04
c               (add geomunit to parameter list)                        0713NG04 
c     Purpose:  reads the MLOPT input section
c
c     Called by:  rmlgen
c     Calls:  rline, rvar, cfloat, icint
c
      use files, only : outfile, infile
      use param, only : linear, nonlin, lints, nonlints, uniths, lowhs,
     *     highhs
      use input, only : mlopt, proglist
      implicit none
c
      type (mlopt)   :: mloptinp
      type (proglist) :: progrms
      integer  i, j, istrt, isect, iend, iscend, constset
      integer geomunit                                                  0713NG04
c
      character*80  string
      character*20  rvar, tempalg, mlm, tempret, tempsds, tempmol,
     *   temphtyp, tempih
      integer icint, natoms
      double precision  cfloat
c
      isect = 0
      iscend = 0
      constset = 0
c
c initialize the NEB setion
      mloptinp%nebset = 0                                               0706NG04 
c
c read first line in MULTIOPT section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MLOPT section
c
      do while (isect.eq.0 .and. iend.eq.0)
c
c ALGORITHM  
c
         if (string(istrt:istrt+8).eq.'algorithm') then
            tempalg = rvar( string, istrt, 'ALGORITHM' )
            if (tempalg(:4) .eq. 'bfgs') then
               mloptinp%algrthm = 1
            elseif (tempalg(:2) .eq. 'nr') then
               mloptinp%algrthm = 0
            elseif (tempalg(:3) .eq. 'dfp') then
               mloptinp%algrthm = 2
            elseif (tempalg(:2) .eq. 'ef')  then
               mloptinp%algrthm =3
            elseif (tempalg(:6) .eq. 'gauext')  then
               mloptinp%algrthm =4 
            elseif (tempalg(:3) .eq. 'neb') then                        0714NG04
               mloptinp%algrthm =5                                      0714NG04 
            else
               write (outfile,1001) tempalg
1001           format('ERROR: Invalid ALGORITHM:',2x,a)
               stop 'rmlopt 1'
            endif
c
c METHOD
c
         elseif (string(istrt:istrt+5).eq.'method') then
            mlm = rvar( string, istrt, 'METHOD' )
            if (mlm(:6).ne.'mccmco' .and. mlm(:6).ne.'mccmnm' .and.
     *            mlm(:6).ne.'mccmut' .and. mlm(:5).ne.'mcsac'  .and.
     *            mlm(:2).ne.'ib'     .and. mlm(:3).ne.'sac'    .and.
     *            mlm(:4).ne.'hfmo'   .and. mlm(:5).ne.'imohc'  .and.
     *            mlm(:2).ne.'g2'     .and. mlm(:2).ne.'g3'     .and.
     *            mlm(:4).ne.'mcg2'   .and. mlm(:4).ne.'mcg3'   .and.
     *            mlm(:7).ne.'g3sxmp3' .and. mlm(:5).ne.'mc3bb' .and.   1011YZ03
     *            mlm(:4).ne.'mcco' .and. mlm(:6).ne.'mc3mpw' .and.     0712BL02
     *            mlm(:6).ne.'mcomp2' .and.                             0712PJ00
     *            mlm(:7).ne.'mcqcisd'.and. mlm(:4).ne.'test' )  then   0111PF00
               write (outfile,1011) mlm
1011           format('ERROR: Invalid MLOPT METHOD:',2x,a)
               stop 'rmlopt 2'
            else
              mloptinp%mlmeth = mlm
            endif
c
c MOLTYPE
c
        elseif (string(istrt:istrt+6).eq.'moltype') then
           tempmol = rvar(string, istrt, 'MOLTYPE')
           if (tempmol(:8).eq.'nonlints') then                          0125PF00
              mloptinp%iop = nonlints                                   0125PF00
           elseif (tempmol(:5).eq.'lints') then                         0125PF00
              mloptinp%iop = lints
           elseif (tempmol(:3).eq.'lin') then
              mloptinp%iop = linear
           elseif (tempmol(:6).eq.'nonlin') then                        0125PF00
              mloptinp%iop = nonlin                                     0125PF00
           else
              write (outfile,1016) tempmol
1016          format('ERROR: Invalid MOLTYPE:',2x,a)
              stop 'rmlopt 7'
           endif
c
c  CONSTANT
c
        elseif (string(istrt:istrt+7).eq.'constant')  then
           call rconst(mloptinp%constant, natoms, iend)
           constset = 1
c
c  REORIENT
c
        elseif (string(istrt:istrt+7).eq.'reorient') then
           mloptinp%reorient = 1
        elseif (string(istrt:istrt+9).eq.'noreorient') then
           mloptinp%reorient = 1
c
c HESSIAN
c
        elseif (string(istrt:istrt+6).eq.'hessian') then
           temphtyp = rvar(string, istrt, 'HESSIAN')
           if (temphtyp(:7).eq.'unitmat') then
              mloptinp%htyp = uniths
           elseif (temphtyp(:6).eq.'lowlev') then
              mloptinp%htyp = lowhs
           elseif (temphtyp(:7).eq.'highlev') then
              mloptinp%htyp = highhs
           else
              write (outfile,1017) temphtyp
1017          format('ERROR: Invalid HESSIAN option:',2x,a)
              stop 'rmlopt 8'
           endif
c
c HMETH
c
         elseif (string(istrt:istrt+4).eq.'hmeth') then
            mloptinp%hmeth = rvar(string, istrt, 'HMETH')
c
c HBAS
c             
         elseif (string(istrt:istrt+3).eq.'hbas') then
            mloptinp%hbas = rvar(string, istrt, 'HBAS')
c
c HPROG
c
         elseif (string(istrt:istrt+4).eq.'hprog') then
            progrms%hessprog = rvar(string, istrt, 'HPROG')
c
c HSCALE
c
         elseif (string(istrt:istrt+5).eq.'hscale') then
            mloptinp%hscale = cfloat(rvar(string,istrt,'HSCALE'))
c
c INITHESS
c
         elseif (string(istrt:istrt+7).eq.'inithess') then
            tempih = rvar(string, istrt, 'INITHESS')
            if (tempih(:2).eq.'on') then
               mloptinp%ihunit = 1
            elseif (tempih(:3).eq.'off') then
               mloptinp%ihunit = 0
            else
               write (outfile,1018)  tempih
1018           format('ERROR: Invalid INITHESS option:',2x,a)
               stop 'rmlopt 9'
            endif
c
c DLX2
c
         elseif (string(istrt:istrt+3).eq.'dlx2') then
            mloptinp%dlx2 = cfloat(rvar(string, istrt, 'DLX2'))
c
c GCOMP
c
         elseif (string(istrt:istrt+4).eq.'gcomp') then
            mloptinp%gcomp = cfloat(rvar(string,istrt,'GCOMP'))
c
c SCALE
c
         elseif (string(istrt:istrt+4).eq.'scale') then
            mloptinp%scale = cfloat(rvar(string,istrt,'SCALE'))
c RMIN								   
c
         elseif (string(istrt:istrt+3).eq.'rmin') then                   YZ02
           mloptinp%rmin = cfloat(rvar(string,istrt,'RMIN'))             YZ02
c
c RMAX
c
         elseif (string(istrt:istrt+3).eq.'rmax') then                   YZ02
           mloptinp%rmax = cfloat(rvar(string,istrt,'RMAX'))             YZ02
c
c omin
c 
         elseif (string(istrt:istrt+3).eq.'omin') then                   YZ02
           mloptinp%omin = cfloat(rvar(string,istrt,'OMIN'))             YZ02
c
c DDMAX
c	 
         elseif (string(istrt:istrt+4).eq.'ddmax') then                   YZ02
           mloptinp%ddmax = cfloat(rvar(string,istrt,'DDMAX'))            YZ02
c
c DDMAXTS
c
         elseif (string(istrt:istrt+6).eq.'ddmaxts') then                 YZ02
           mloptinp%ddmaxts = cfloat(rvar(string,istrt,'DDMAXTS'))        YZ02
c
c IUPD
c
         elseif (string(istrt:istrt+3).eq.'iupd') then                    YZ02
           mloptinp%iupd = cfloat(rvar(string,istrt,'IUPD'))              YZ02
c
c STPTOL
c
         elseif (string(istrt:istrt+5).eq.'stptol') then
            mloptinp%stptol = cfloat(rvar(string,istrt,'STPTOL'))
c
c HREC
c
         elseif (string(istrt:istrt+3).eq.'hrec') then
            mloptinp%hrec = icint(rvar(string,istrt,'HREC'))

c
c OPTIONS
c
         elseif (string(istrt:istrt+12) .eq. 'gauextoptions') then
            call rlist(mloptinp%optl, 'GAUEXTOPTIONS', iend )

c
c NITER
c
         elseif (string(istrt:istrt+4).eq.'niter') then
            mloptinp%niter = icint(rvar(string,istrt,'NITER'))
c
c RETRY
c
         elseif (string(istrt:istrt+4).eq.'retry') then
            tempret = rvar(string,istrt,'RETRY')
            if (tempret(:3).eq.'off') then
               mloptinp%retry = 0
            elseif (tempret(:2).eq.'on') then
               mloptinp%retry = 1
            else
               write (outfile,1021) tempret
 1021          format('ERROR: Invalid RETRY input:',2x,a)
               stop 'rmlopt 3'
            endif
c
c SDSTRT
c
         elseif (string(istrt:istrt+5).eq.'sdstrt') then
            tempsds = rvar(string,istrt,'SDSTRT')
            if (tempsds(:3).eq.'off') then
               mloptinp%sdstrt = 0
            elseif (tempsds(:2).eq.'on') then
               mloptinp%sdstrt = 1
            else
               write (outfile,1031) tempsds
1031           format('ERROR: Invalid SDSTRT input:',2x,a)
               stop 'rmlopt 4'
            endif
c
c NEB                                                                   0706NG04
c
         elseif (string(istrt:istrt+2).eq.'neb') then                   0706NG04
            call rneb(mloptinp%nebinp, natoms, iend, geomunit)          0706NG04
            mloptinp%nebset = 1                                         0706NG04 
         else
            write (outfile, 11) string
  11        format ( 'ERROR: Invalid MLOPT option:', a80)
            stop 'rmlopt 5'
         endif
c
c read next line
c 
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  If constant keyword not set and using a linear molecule then 
c    change 1 value in constant
c
      if ((mloptinp%iop.eq.linear .or. mloptinp%iop.eq.lints) 
     *       .and. constset.eq.0) then
         mloptinp%constant(9) = 0
      endif

      return
      end
c
c*******************************************************************************
c  RNEB
c*******************************************************************************
c
      subroutine rneb(nebinp, natoms, iend, geomunit)
c
c     Created:  July 1, 2004 by Nuria Gonzalez-Garcia
c     Revised:
c     Purpose:  Reads the NEB options used in optimization
c
c     Called by:  
c     Calls:  
c
      use files, only : infile, outfile
      use input, only : nebopt
c
      integer natoms, iend, geomunit
      type (nebopt) :: nebinp
c
c define some local variables
c
      integer  i,j,istrt,isect,iblnk,iscend,icint
      double precision cfloat
      character*80 string
      character*20 unit, rvar, tempalg
c
      istrt = 0
      isect = 0
      iend = 0
      iscend = 0
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the NEBOPT section
c
       do while (iscend.eq.0.and.iend.eq.0)
c
c REACTANTS GEOM
c
        if (string(istrt:istrt+4) .eq. 'react') then
            call rgeom(nebinp%rgeom, geomunit, natoms,
     *                string, istrt, iend)
            nebinp%rgeom%natoms=natoms
c
c PRODUCTS GEOM
c
        elseif (string(istrt:istrt+3) .eq. 'prod') then
            call rgeom(nebinp%pgeom, geomunit, natoms,
     *                string, istrt, iend)
            nebinp%pgeom%natoms=natoms
c
c NIMG
c
         elseif (string(istrt:istrt+3).eq.'nimg') then
              nebinp%nimg = icint(rvar(string,istrt,'NIMG'))
c
c NEBITER
c
c
         elseif (string(istrt:istrt+6).eq.'nebiter') then
              nebinp%nebiter = icint(rvar(string,istrt,'NEBITER'))   
c
c INTERP ALGORITHM
c
         elseif (string(istrt:istrt+5).eq.'interp') then
            tempalg = rvar( string, istrt, 'INTERP' )
            if (tempalg(:6) .eq. 'linear') then
               nebinp%interp = 1
            endif
c
c IMG FILE
c
         elseif (string(istrt:istrt+6).eq.'imgfile') then
            nebinp%imgfile = rvar( string, istrt, 'imgfile' )
c
c KSPR
         elseif (string(istrt:istrt+3).eq.'kspr') then
              nebinp%kspr = cfloat(rvar(string,istrt,'KSRP'))
c
c NEBALG
c
c  algoritme de calcul de la tangent
         elseif (string(istrt:istrt+5).eq.'nebalg') then
            tempalg = rvar( string, istrt, 'NEBALG' )
            if (tempalg(:6) .eq. 'it-neb') then                         0208NG06
               nebinp%nebalg = 1
            elseif (tempalg(:6) .eq. 'ci-neb') then                     0208NG06
               nebinp%nebalg = 2
            elseif (tempalg(:5) .eq. 'd-neb') then
               nebinp%nebalg = 3 
            elseif (tempalg(:5) .eq. 'b-neb') then                      0208NG06
               nebinp%nebalg = 4
            else
               write (outfile,1003) tempalg
1003           format('ERROR: Invalid NEBALG:',2x,a)
               stop 'RNEB 3'
            endif

c
c OPTM
c
         elseif (string(istrt:istrt+3).eq.'optm') then
            tempalg = rvar( string, istrt, 'OPTM' )
            if (tempalg(:4) .eq. 'bfgs') then
               nebinp%optm = 1
            elseif (tempalg(:3) .eq. 'dfp') then
               nebinp%optm = 2
            elseif (tempalg(:2) .eq. 'nr') then
               nebinp%optm = 3
            elseif (tempalg(:2) .eq. 'vb')  then
               nebinp%optm = 4
            elseif (tempalg(:2) .eq. 'ef')  then
               nebinp%optm = 5
            elseif (tempalg(:6) .eq. 'gauext')  then
               nebinp%optm = 6
            else
               write (outfile,1004) tempalg
1004           format('ERROR: Invalid OPTM:',2x,a)
               stop 'RNEB 4'
            endif
         else
            write (outfile, 1001) string
1001        format ( 'ERROR: Invalid NEBOPT option:', a80)
            stop 'RNEB 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
      return
      end
c
c*******************************************************************************
c  RCONST
c*******************************************************************************
c
      subroutine rconst(constant, natoms, iend)
c
c     Created:  August 10, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Reads the constant coordinates for MLOPT
c
c     Called by:  rmlopt
c     Calls:  rline, fchar, fspace
c
      use files, only : infile, outfile
      implicit none
c

      integer  numcoord, iend, isect, iscend, i, j, natoms, atm
      integer   ilong, ifin, ibeg, ierr, constant(3*natoms), icint
      character*20 name
      character*80 string

      i = 1
      isect = 0
      iend = 0
      iscend = 0
c
c  Initialize constant array to 0
c
      do 20 j=1, 3*natoms
         constant(j) = 0
  20  continue

      call rline(infile,string,ibeg,isect,iscend,iend)

      do while (isect.eq.0.and.iscend.eq.0.and.iend.eq.0)
         ierr = 0
         ilong = 0
         ibeg = 1
         call fchar(string, ibeg, ierr)
         ifin = ibeg + 1
         call fspace(string, ifin, ilong)
         if (ilong .eq. 0) then
            ifin = ifin - 1
         endif
         ifin = ifin+1
         atm = icint(string(ibeg:ifin))
         ibeg = ifin
         call fchar(string, ibeg, ierr)
         do while (ierr.eq.0 .and. ilong.eq.0)
            if (i.gt.6 .or. (natoms.eq.2 .and. i.gt.5))  goto 100
            ifin = ibeg + 1
            call fspace(string, ifin, ilong)
            if (ilong .eq. 0) then
               ifin = ifin - 1
            endif
            if (string(ibeg:ibeg).eq.'x') then
               constant(3*(atm-1)+1) = 1
            elseif (string(ibeg:ibeg).eq.'y') then
               constant(3*(atm-1)+2) = 1
            elseif (string(ibeg:ibeg).eq.'z') then
               constant(3*(atm-1)+3) = 1
            else
               write(outfile,*) 'Invalid Coordinate in CONSTANT'
               stop 'rconst 1'
            endif
            i = i+1
            ibeg = ifin + 1
            call fchar(string, ibeg, ierr)
         end do
         call rline(infile, string, ibeg, isect, iscend, iend)
      end do
c
c  Terminate if end of file or new section reached  before the end
c    of the coefficient list.
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write (outfile, 1100)
1100     format(/3x,'ERROR: No end to CONSTANT' )
         stop 'rconst 2'
      endif

      return

 100  write (outfile, 1000)
1000  format(/3x,'ERROR:  Too many coordinates in CONSTANT')
      stop 'rconst 3'
  
      return
      end

c
c
c*******************************************************************************
c  RLIST
c*******************************************************************************
c
      subroutine rlist(list, sctname, iend) 
c 
c     Created:  April 15, 1999 by P. L. Fast 
c     Revised:  June 17, 1999 by jmr 
c     Purpose:  reads a 5 line list following a list keyword
c 
c     Description:  Using the index i, loop through each line after the
c     input file line w/ section name.  Reads in a line and finds the
c     first character with fchar and then checks the line with chkln.
c     Saves the line to list if appropriate.
c
c     Called by:  rmlgen, rimo, rlc, rextopt, rhfmo
c     Calls:  fchar, chkln
c

      use files, only : outfile, infile
      implicit none
c
      integer  i, j, istrt, isect, iend, iblnk, iscend, icommt
      character*80  string, list(5)
      character*(*)  sctname

      i = 0
      isect = 0
      iend = 0
      iscend = 0
c
c     Reads and checks the next non-blank, non-comment line.
c
  20  i = i + 1
      iblnk = 1
      icommt = 1
      do while ((iblnk .eq. 1) .or. (icommt .eq. 1))
         istrt=1
         read(infile,800,end=9999) string
 800     format(a80)
         call fchar(string, istrt, iblnk)
         call chkln(string, istrt, isect, icommt, iscend)
      end do
c
c     Exits if a new section is reached.  Ends if an 'END' is found.
c     Exits if the list is longer than 5 lines and no 'END' is found.
c     Otherwise saves the line to list
c
      if (isect .eq. 1) then
         write (outfile, 1000) sctname
1000     format(/3x, 'ERROR:  No termination of ', a20, ' section.')
         stop 'rlist 1'
      elseif (iscend .eq. 1) then
         goto 40
      elseif (i .gt. 5) then
         write (outfile, 1100) sctname
1100     format (/3x, 'ERROR: ', /a20, ' section longer than 5 lines.')
         stop 'rlist 2'
      else
         list(i) = string
         goto 20
      endif

   40 return

9999  write (outfile, 1200) sctname
1200  format(/3x, 'ERROR:  No termination of ', a,' before EOF.')
      stop 'rlist 3'
      end
c
c
c*******************************************************************************
c  RWORD 
c*******************************************************************************
c
      subroutine rword(string,istrt,ierr)
c
c     Created:  April 15, 1999 by P. L. Fast
c               Taken from Polyrate
c     Revised:  June 18, 1999 by JMR
c     Purpose:  read the next word on the line after the word that istrt
c                   is in.
c
c     Called by:  rhc, rgeom, rvar
c     Calls:  fspace, fchar
c
c
      implicit none
c
      integer istrt, ierr
      character*80  string
c
c clear flags
c
      ierr = 0
c
c search for the first blank - signaling the end of the current word
c
      call fspace(string, istrt, ierr)
      if (ierr .eq. 1) then
         return
      endif
c
c find first letter of next word
c
      call fchar(string, istrt, ierr)
      return
      end
c
c
c*******************************************************************************
c  FSPACE
c*******************************************************************************
c
      subroutine fspace(string, istrt, ierr)
c
c     Created:  June 18, 1999 by J. M. Rodgers
c     Revised:
c     Purpose:  Find the next space on the line
c
c     Description:  Scrolls through the positions in string starting
c        at position istrt.  Sets istrt to the position of the first
c        space.  Or if there is no spacebar left on the line, sets 
c        ierr to 1.
c
c     Called by:  rword, rcss, cfloat, icint, rvar, rcoef
c     Calls:  
c
      implicit none
c
      integer istrt, ierr, blnk, length
      character*(*) string

      ierr=0
      blnk = 0
      length = len(string)

      do while (istrt .le. length .and. blnk .eq. 0)
         if (string(istrt:istrt) .eq. ' ') then
            blnk = 1
         elseif (istrt .eq. length) then
            ierr = 1
         endif
         istrt = istrt + 1
      enddo
c
c     Sets istrt back 1 in order to counter act increment at end
c       of do while loop.
c
      istrt = istrt - 1

      return
      end
c  
c*******************************************************************************
c  FCHAR
c*******************************************************************************
c  
      subroutine fchar(string, istrt, ierr)
c               
c     Created:  June 18, 1999 by J. M. Rodgers
c     Revised:
c     Purpose:  Find the next character on the line
c
c     Description:  Scrolls through the positions in string starting
c         at position istrt.  Sets istrt to position of first character.
c         If there is no character left on the line, sets ierr to 1.
c
c     Called by:  rline, rcss, rlist, rword, cfloat, icint, rcoef
c     Calls:
c
      implicit none
c
      integer istrt, ierr, char, length
      character*(*) string

      ierr = 0
      char = 0
      length = len(string)

      do while (istrt .le. length .and. char .eq. 0)
         if (string(istrt:istrt) .ne. ' ') then
            char = 1
         elseif (istrt .eq. length) then
            ierr = 1
         endif
         istrt = istrt + 1
      enddo
c
c     Sets istrt back 1 in order to counteract increment at end
c       of do-while loop.
c
      istrt = istrt -1

      return
      end
c
c*******************************************************************************
c  CHKLN
c*******************************************************************************
c  
      subroutine chkln(string, istrt, isect, icommt, iscend)
c     
c     Created:  June 18, 1999 by J. M. Rodgers
c     Revised:
c     Purpose:  Check line to see if it's a special type.
c
c     Description:  Examines character at istrt to see if the line 
c       is a comment or a section header.  Examine 1st 4 characters
c       starting at istrt to see if it's a section end.
c
c     Called by:  rline, rlist
c     Calls:
c
      implicit none
c
      integer istrt, isect, icommt, iscend
      character*80 string, case, wrd

      isect = 0
      icommt = 0
      iscend = 0

      wrd = string
      wrd = case(wrd)

      if (wrd(istrt:istrt) .eq. '*') then
         isect=1
      elseif (wrd(istrt:istrt) .eq. '#') then
         icommt=1
      elseif (wrd(istrt:istrt+3) .eq. 'end ') then
         iscend = 1
      endif

      return
      end
c     
c
c*******************************************************************************
c  RGEOM
c*******************************************************************************
c
      subroutine rgeom(geom,geomunit,numatom,string,istrt,iend)
c
c     Created:  April 20, 1999 by P. L. Fast
c     Revised:
c     Purpose:  Read the atoms and geometry from the input file.
c
c     Called by:  rmlgen
c     Calls:  rline, rword, cfloat
c
      use input, only : cartgeom
      use atminfo
      use files, only : infile, outfile
      implicit none
c
      integer i, istrt, isect, iend, iatom, ierr, iscend
      integer ifin, ibeg, ifind, iasym, numatom, geomunit, chindex
      type (cartgeom) :: geom
      double precision cfloat
      double precision angtoau
      character*80  string
c
c number of angstroms in a bohr (au)
c
      angtoau = 0.52918d0
c
c read each line in the GEOM section until an 'end' is found.  for each
c line read the atomic symbol and cartesian coordinates.
c
      iatom = 0
      call rline(infile,string,istrt,isect,iscend,iend)
c
      do while (iscend .ne. 1)
c
c  get the atomic symbol, determine the atomic number and therefore the
c  atomic mass from that.  Store the symbol (with the first letter back in
c  uppercase) and mass in atm(i) and atmmass(i) within the structure geom
c
         iatom = iatom + 1
         ibeg = istrt
         call rword(string,istrt,ierr)
         ifin = istrt - 1
         if (ierr.ne.1) then
            ifind = 0
            iasym = 1
            do while(ifind.eq.0.and.iasym.le.103)
               if (string(ibeg:ibeg+1).eq.asymb(iasym)) then
                  chindex = ichar(string(ibeg:ibeg)) - 32
                  string(ibeg:ibeg) = char(chindex)
                  geom%atm(iatom) = string(ibeg:ibeg+1)
                  geom%atmmss(iatom) = ams(iasym)
                  ifind = 1
               endif
c
               iasym = iasym + 1
c
            end do
c
            if (ifind.eq.0) then
               write (outfile,1000) string(istrt:istrt+1)
 1000          format (/3x,'ERROR: illegal atomic symbol: ',a2)
               stop 'rgeom 1'
            endif
c
c get coordinates off rest of line
c
            do 100 i = -2, 0
               ibeg = istrt
               call rword(string,istrt,ierr)
               ifin = istrt - 1
c
c check that the coordinate was found on the line
c
               if (ierr.eq.1 .and. i.ne.0) then
                  write (outfile,1100) string
 1100             format(/3x,'ERROR:  invalid Cartesian coordinate ',
     *                   ' in GEOM.  Invalid line is: ',/a80)
                  stop 'rgeom 2'
               endif
c
c save coordinate:
c    i = 1  x-coordinate, *geom(1, iatom)
c    i = 2  y-coordinate, *geom(2, iatom)
c    i = 3  z-coordinate, *geom(3, iatom)
c
               if (geomunit .eq. 1) then
		  geom%angcoord(3*iatom+i) = cfloat(string(ibeg:ifin))
                  geom%aucoord(3*iatom+i) = 
     *                  geom%angcoord(3*iatom+i)/angtoau
               else
                  geom%aucoord(3*iatom+i) = cfloat(string(ibeg:ifin))
                  geom%angcoord(3*iatom+i) = 
     *                  geom%aucoord(3*iatom+i)*angtoau
               endif
c
 100        continue
c
         else
            write (outfile,1200) string
 1200       format(/3x,'ERROR: invalid line in GEOM: ',/a80)
            stop 'rgeom 3'
         endif
c
         call rline(infile,string,istrt,isect,iscend,iend)
c
      end do
c
c  return the final iatom value.
c
      numatom = iatom

      return
      end
c
c
c*******************************************************************************
c  CFLOAT
c*******************************************************************************
c
      function cfloat(string)
c
c     Created:  April 20, 1999 by P. L. Fast
c     Revised:
c     Purpose:  Convert a string to a double precision number
c
c     Called by:  rhc,rmlgen,rmlopt,rgeom,rhfmo,rib,rcoef
c     Calls:  fchar, fspace
c
      use files, only : outfile
      implicit none
c
      integer length, ibeg, iblnk, ifin, ierr, i, j
      integer idec, iue, ile, iud, ild, isum, iexp, n
      double precision  cfloat, f1, f2, f3, sign, esign
      character*(*) string
      character*80 number
      character ch
      logical lexp, ldec
c
      lexp = .false.
      ldec = .false.

      idec = 0
      iue = 0
      ile = 0
      iud = 0
      ild = 0
      isum = 0
      iexp = 0

      length = len(string)
      if (length .eq. 0) then
         cfloat = 0.0d0
         return
      endif
c
c     find the first nonblank character
c
      ibeg = 1
      call fchar(string, ibeg, iblnk)
c
c     if it is a blank string set function to zero
c
      if (iblnk .eq. 1) then
         cfloat = 0.0d0
         return
      endif
c
c     find the first blank character after the number
c
      ifin = ibeg+1
      call fspace(string, ifin, ierr)
      if (ierr .eq. 1) then
	 ifin = length
      else 
         ifin = ifin - 1
      endif
c
c     strip the blanks before and after the number
c
      number = string(ibeg:ifin)
      length = ifin - ibeg + 1
c
c     find the decimal point
c
      idec = index(number,'.')
      if (idec .ne. 0) ldec = .true.
c
c     finds the exponential symbol and ensures that there
c     is only one such marker (d or e) in the whole number
c
      iue = index(number,'e')
      ile = index(number(iue+1:),'e')
      iud = index(number,'d')
      ild = index(number(iud+1:),'d')
      isum = iue + ile + iud + ild
      iexp = max0(iue,ile,iud,ild)
      if (isum .gt. iexp) then
         write(outfile,1000) string
         stop 'cfloat 2'
      endif
      if (iexp .ne. 0) then
         lexp = .true.
      else
         iexp = length + 1
      endif
c
      if (.not. ldec) idec = iexp
c
c     get the number before decimal
c
      ibeg = 2
      if (number(1:1) .eq. '+') then
         sign = 1.0d0
      elseif(number(1:1) .eq. '-') then
         sign = -1.0d0
      else
         sign = 1.0d0
         ibeg = 1
      endif
      if (ibeg .eq. iexp) then
         f1 = 1.0d0
      else
         f1 = 0.0d0
      endif
      do 50 i = ibeg,idec-1
         ch = number(i:i)
         if (ch .ge. '0' .and. ch .le. '9') then
            n = ichar(ch) - ichar('0')
            f1 = f1 * 10.0d0 + dble(n)
         else
            write(outfile,1001) string
            stop 'cfloat 3'
         endif
50    continue
c
c     get the number after decimal
c
      f2 = 0.0d0
      if (ldec) then
         j = 0
         do 60 i = idec+1,iexp-1
            ch = number(i:i)
            if (ch .ge. '0' .and. ch .le. '9') then
               n = ichar(ch) - ichar('0')
               f2 = f2 * 10.0d0 + dble(n)
               j = j + 1
            else
               write(outfile,1002) string
               stop 'cfloat 4'
            endif
60       continue
         f2 = f2 / 10.0d0 ** dble(j)
      endif
c
c    get the exponent
c
      esign = 1.0d0
      f3 = 0.0d0
      if (lexp) then
         ibeg = iexp + 2
         if (number(iexp+1:iexp+1) .eq. '+') then
            esign = 1.0d0
         elseif(number(iexp+1:iexp+1) .eq. '-') then
            esign = -1.0d0
         else
            esign = 1.0d0
            ibeg = iexp + 1
         endif
         do 70 i = ibeg,length
            ch = number(i:i)
            if (ch .ge. '0' .and. ch .le. '9') then
               n = ichar(ch) - ichar('0')
               f3 = f3 * 10.0d0 + dble(n)
            else
               write(outfile,1003) string
               stop 'cfloat 5'
            endif
70       continue
      endif
c
      cfloat = (sign * (f1 + f2)) * 10.0d0 ** (esign*f3)
c
      return
c
1000  format(/1x,'illegal number-1: ',a80)
1001  format(/1x,'illegal number-2: ',a80) 
1002  format(/1x,'illegal number-3: ',a80) 
1003  format(/1x,'illegal number-4: ',a80) 
c
      end
c
c


c*******************************************************************************
c  ICINT
c*******************************************************************************
c
      function icint(svalue)
c
c     Created:  April 20, 1999 by P. L. Fast
c     Revised:
c     Purpose:  Convert a string into an integer
c
c     Called by:  rimo,rcss,rhc,rmlgen,rmlopt,rg2,rg3
c     Calls:  fchar, fspace
c
      use files, only : outfile
      implicit none
c
      integer icint, ibeg, ifin, iblnk, ierr, length, isign
      integer istart, i, n
      character*(*) svalue
      character ch

      length = len(svalue)
      if (length .eq. 0) then
         icint = 0
         return
      endif
c
c     find the first nonblank character
c
      ibeg = 1
      call fchar(svalue, ibeg, iblnk)
c
c     if it is a blank string set function to zero
c    
      if (iblnk .eq. 1) then
         icint = 0
         return
      endif
c
c     find the first blank character after the number
c
      ifin = ibeg+1
      call fspace(svalue, ifin, ierr)
      if (ierr .eq. 1) then
         ifin = length
      else
         ifin = ifin - 1
      endif
c
c     strip the blanks before and after the number
c
      svalue = svalue(ibeg:ifin)
      length = ifin - ibeg + 1
c
c
c     check for negative or positive sign (- or +)
c
      icint = 0
      istart = 2
      isign = +1
      if (svalue(1:1).eq.'+') then
         isign = +1
         ibeg = ibeg + 1
      elseif (svalue(1:1).eq.'-') then
         isign = -1
         ibeg = ibeg + 1
      else
         istart = 1
      endif
c
c     now convert each character to an integer - and store in icint
c
      do 70 i = ibeg,length
         ch = svalue(i:i)
         if (ch .ge. '0' .and. ch .le. '9') then
            n = ichar(ch) - ichar('0')
            icint = icint * 10 + n
         else
            write(outfile,1000) svalue
            stop 'icint 1'
         endif
70    continue

      icint = icint * isign
c
      return

1000  format(/3x,'ERROR: illegal digit in an integer: ',A80)

      end
c
c*******************************************************************************
c  RLC
c*******************************************************************************
c
      subroutine rlc(progrms, llc, mcinp, mgswit, hfmoinp, mcoptl, 
     *   sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp, g2inp,          
     *   mg2inp, g3inp, mg3inp, mqcinp, mcomp2inp, mccoinp,             0712BL02
     *   g3sxmp3inp, mc3bbinp,mc3mpwinp,
     *   string, iend, istrt)

c
c     Created:  April 21, 1999 by P. L. Fast
c     Revised:  June 1999 by JMR
c               January 11, 2000 by PLF
c     Purpose:  To read the LC section of input.
c
c     Called by:  read5
c     Calls:  rline, rlist, rhfmo, rsac, rib, rmcsac, rmccmco, rmccmut, 
c        rg3sxmp3,rmc3bb,rmc3mpw                                        1011YZ03
c        rmccmnm, rg2, rmcg2, rg3, rmcg3, rmqcisd, rmcomp2, rmcco       0712BL02
c
      use input, only : hfmoinf, mctype, mgtype, mcinf, ginf, mginf,
     *      proglist
      use files, only : outfile, infile
      implicit none
c
      integer llc
      type (proglist) :: progrms
      type (mctype)  :: mcinp
      type (mgtype)  :: mgswit
      type (hfmoinf) :: hfmoinp
      character*20   :: rvar
      character*80   :: mcoptl(5)
      type (mcinf)   :: sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp
      type (ginf)    :: g2inp, g3inp
      type (mginf)   :: mg2inp, mg3inp, mqcinp, g3sxmp3inp, mc3bbinp,   0111PF00
     *                  mcomp2inp, mccoinp,mc3mpwinp                    0712BL02
      integer iend, istrt, isect, iscend
      character*80 string
c
c read first line of this section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of this section until the end of the
c section is reached.
c
      do while (isect.eq.0 .and. iend.eq.0)
c
c HFMO
c
         if (string(istrt:istrt+3) .eq. 'hfmo') then
            hfmoinp%lhfmo = 1
            call rhfmo(progrms%hfprog,progrms%moprog,hfmoinp,iend)
c
c MCOPTL
c
         elseif (string(istrt:istrt+8) .eq. 'mcoptions') then
            call rlist(mcoptl, 'MCOPTIONS', iend)
c
c MCPROGRAM
c
         elseif (string(istrt:istrt+8) .eq. 'mcprogram') then
            progrms%mcprog = rvar(string, istrt, 'MCPROGRAM')
           if (string(istrt:istrt+2) .ne. 'g98' .and.
     *             string(istrt:istrt+3) .ne. 'pg98' .and.
     *             string(istrt:istrt+2) .ne. 'g94'  .and.
     *             string(istrt:istrt+2) .ne. 'g03'  .and.
     *             string(istrt:istrt+2) .ne. 'g09') then               0808RMP12
              write (outfile,500)
  500         format(3x, 'ERROR: G03, G98 and G94 are ',
     *                   'the only allowed PROGRAMs for this ',
     *                   'version of Multilevel')
              stop 'rlc 2'
           endif
c
c COOP
c
         elseif (string(istrt:istrt+3) .eq. 'coop') then
            mcinp%lcoop = 1
c
c NOCOOP
c
         elseif (string(istrt:istrt+5) .eq. 'nocoop') then
            mcinp%lcoop = 0
c
c IB
c
         elseif (string(istrt:istrt+1) .eq. 'ib') then
            mcinp%lib = 1
            call rib(ibinp,iend)
c
c SAC
c
         elseif (string(istrt:istrt+2) .eq. 'sac') then
            mcinp%lsac = 1
            call rsac(sacinp,iend)
c
c MCSAC
c
         elseif (string(istrt:istrt+4) .eq. 'mcsac') then
            mcinp%lmcsac = 1
            call rmcsac(mcsinp,iend)
c
c MCCMCO
c
         elseif (string(istrt:istrt+5) .eq. 'mccmco') then
            mcinp%lmccmco = 1
            call rmccmco(mcoinp,iend)
c
c MCCMNM
c
         elseif (string(istrt:istrt+5) .eq. 'mccmnm') then
            mcinp%lmccmnm = 1
            call rmccmnm(mnminp,iend)
c
c MCCMUT
c
         elseif (string(istrt:istrt+5) .eq. 'mccmut') then
            mcinp%lmccmut = 1
            call rmccmut(mutinp,iend)
c
c G2/MCG2
c
c  options same for each of these methods.
c
         elseif (string(istrt:istrt+8) .eq. 'g2options') then
            call rlist( mg2inp%optl, 'G2OPTIONS', iend )
            g2inp%optl = mg2inp%optl
c
c G2PROGRAM
c
         elseif (string(istrt:istrt+8) .eq. 'g2program') then
            progrms%g2prog = rvar(string, istrt, 'G2PROGRAM')
           if (string(istrt:istrt+2) .ne. 'g98' .and.
     *             string(istrt:istrt+3) .ne. 'pg98' .and.
     *             string(istrt:istrt+2) .ne. 'g94'  .and.
     *             string(istrt:istrt+2) .ne. 'g03'  .and.
     *             string(istrt:istrt+2) .ne. 'g09') then               0808RMP12
              write (outfile,600)
  600         format(3x, 'ERROR: G03, G98 and G94 are ',
     *                   'the only allowed PROGRAMs for this ',
     *                   'version of Multilevel')
              stop 'lc 3'
           endif
c
         elseif (string(istrt:istrt+1) .eq. 'g2') then
            mgswit%lg2 = 1
            call rg2(g2inp, iend)
c
         elseif (string(istrt:istrt+3) .eq. 'mcg2') then
            mgswit%lmcg2 = 1
            call rmcg2(mg2inp,iend)
c
c G3 
c
         elseif (string(istrt:istrt+8) .eq. 'g3options') then
            call rlist( g3inp%optl, 'G3OPTIONS', iend )

c
c G3SX(MP3)
c
         elseif (string(istrt:istrt+13) .eq. 'g3sxmp3options') then
            call rlist( g3sxmp3inp%optl, 'G3SXMP3OPTIONS', iend )

c
c MCG3
c
           elseif (string(istrt:istrt+10) .eq. 'mcg3options') then      0702YZ02
            call rlist( mg3inp%optl, 'MCG3OPTIONS', iend )
c           mqcinp%optl = mg3inp%optl                                   0111PF00
c
c MQCISD
c
         elseif (string(istrt:istrt+13) .eq. 'mcqcisdoptions') then     0112PF00
            call rlist( mqcinp%optl, 'MCQCISDOPTIONS', iend )           0112PF00
c
c MCOMP2
c
         elseif (string(istrt:istrt+12) .eq. 'mcomp2options') then      0710PJ00
            call rlist( mcomp2inp%optl, 'MCOMP2OPTIONS', iend )         0710PJ00
c
c MCCO
c
         elseif (string(istrt:istrt+12) .eq. 'mccooptions') then        0712BL02
            call rlist( mccoinp%optl, 'MCCOOPTIONS', iend )             0712BL02

c
c  MC3BB
c
         elseif (string(istrt:istrt+13) .eq. 'mc3bboptions') then       0712YZ03
            call rlist( mc3bbinp%optl, 'MC3BBOPTIONS', iend )           0712YZ03
c
c  MC3MPW
c
         elseif (string(istrt:istrt+14) .eq. 'mc3mpwoptions') then      0712YZ03
            call rlist( mc3mpwinp%optl, 'MC3MPWOPTIONS', iend )          0712YZ03

  

c
c G3PROGRAM
c
         elseif (string(istrt:istrt+8) .eq. 'g3program') then
            progrms%g3prog = rvar(string, istrt, 'G3PROGRAM')
           if (string(istrt:istrt+2) .ne. 'g98' .and.
     *             string(istrt:istrt+3) .ne. 'pg98' .and.
     *             string(istrt:istrt+2) .ne. 'g94'. and.
     *             string(istrt:istrt+2) .ne. 'g03'. and.
     *             string(istrt:istrt+2) .ne. 'g09') then               0808RMP12
              write (outfile,700)
  700         format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                   'the only allowed PROGRAMs for this ',
     *                   'version of Multilevel')
              stop 'rlc 4'
           endif
c
         elseif (string(istrt:istrt+6) .eq. 'g3sxmp3') then
            mgswit%lg3sxmp3 = 1
            call rg3sxmp3(g3sxmp3inp,iend)
c
         elseif (string(istrt:istrt+5) .eq. 'mc3bb') then
            mgswit%lmc3bb =1
            call rmc3bb(mc3bbinp,iend)
c
         elseif (string(istrt:istrt+5) .eq. 'mc3mpw') then
            mgswit%lmc3mpw =1
            call rmc3mpw(mc3mpwinp,iend)
c
         elseif (string(istrt:istrt+1) .eq. 'g3') then
            mgswit%lg3 = 1
            call rg3(g3inp, iend)
c
         elseif (string(istrt:istrt+3) .eq. 'mcg3') then
            mgswit%lmcg3 = 1
            call rmcg3(mg3inp,iend)
c
         elseif (string(istrt:istrt+6) .eq. 'mcqcisd') then             0111PF00
            mgswit%lmqcisd = 1                                          0111PF00
            call rmqcisd(mqcinp,iend)                                   0111PF00
c
         elseif (string(istrt:istrt+5) .eq. 'mcomp2') then              0710PJ00
            mgswit%lmcomp2 = 1                                          0710PJ00
            call rmcomp2(mcomp2inp,iend)                                0710PJ00

         elseif (string(istrt:istrt+5) .eq. 'mcco') then                0712BL02
            mgswit%lmcco = 1                                            0712BL02
            call rmcco(mccoinp,iend)                                    0712BL02

c
c invalid keywords
c
         else
            write (outfile,1000) string(istrt:80)
            stop 'rlc 1'
 1000       format(/3x,'ERROR: the folowing is not a valid keyword in ',
     *                'the LC section: ',a)
         endif
c 
        call rline(infile,string,istrt,isect,iscend,iend)
c
      end do
c
      return
      end
c
c
c*******************************************************************************
c  RHFMO
c*******************************************************************************
c
      subroutine rhfmo(hfprog, moprog, hfmoinp,iend)
c
c     Created:  April 22, 1999 by P. L. Fast
c     Revised:  June 21, 1999 JMR
c     Purpose:  Read the HFMO section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, rlist, cfloat
c
c
      use input, only : hfmoinf
      use files, only : infile, outfile
      implicit none
c
      integer istrt, isect, iscend, iscend2, iscend3, iend
      double precision cfloat
      character*80 string
      character*20 rvar
      character*10 hfprog, moprog

      type (hfmoinf) :: hfmoinp

      isect = 0
      iscend = 0
      iscend2 = 0
      iscend3 = 0
      iend = 0
c
c read first line in HFMO section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the HFMO section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c HFKEY
c
         if (string(istrt:istrt+4) .eq. 'hfkey') then
c
c read first line of hfkey
c
            call rline(infile,string,istrt,isect,iscend2,iend)
            do while (iscend2.eq.0.and.isect.eq.0.and.iend.eq.0)
c
c HFKEY:BASIS
c
               if (string(istrt:istrt+4) .eq. 'basis') then
                  hfmoinp%hfkbas = rvar(string, istrt, 'HFKEY:BASIS')
c
c HFKEY:OPTIONS
c
               else if (string(istrt:istrt+6) .eq. 'options') then
                  call rlist(hfmoinp%hfkoptl, 'HFKEY:OPTIONS', iend)
c
c HFKEY:PROGRAM
c
               elseif (string(istrt:istrt+6) .eq. 'program') then
                  hfprog = rvar(string, istrt, 'HFKEY:PROGRAM')
                  if (string(istrt:istrt+2) .ne. 'g98' .and.
     *                  string(istrt:istrt+3) .ne. 'pg98' .and.
     *                  string(istrt:istrt+2) .ne. 'g94'  .and.
     *                  string(istrt:istrt+2) .ne. 'g03'  .and.
     *                  string(istrt:istrt+2) .ne. 'g09') then          0808RMP12
                     write (outfile,500)
  500                format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                          'the only allowed PROGRAMs for this ',
     *                          'version of Multilevel')
                     stop 'rhfmo 6'
                  endif
c
               else
                  write (outfile,1000) string(istrt:80)
 1000             format(/3x,'ERROR: the following is not a valid ',
     *                   'option of the HFKEY keyword: ',a)
                  stop 'rhfmo 2'
               endif
               call rline(infile,string,istrt,isect,iscend2,iend)
            enddo
c
c MOKEY
c
         elseif (string(istrt:istrt+4) .eq. 'mokey') then
c
c read first line of mokey
c
            call rline(infile,string,istrt,isect,iscend3,iend)
            do while (iscend3.eq.0.and.isect.eq.0.and.iend.eq.0)
c
c MOKEY:METHOD
c
               if (string(istrt:istrt+5) .eq. 'method') then
                  hfmoinp%mokmeth = rvar(string, istrt, 'MOKEY:METHOD')
c
c MOKEY:OPTIONS
c
               elseif (string(istrt:istrt+6) .eq. 'options') then
                  call rlist(hfmoinp%mokoptl, 'MOKEY:OPTIONS', iend)
c
c MOKEY:PROGRAM
c 
               elseif (string(istrt:istrt+6) .eq. 'program') then
                  moprog = rvar(string, istrt, 'MOKEY:PROGRAM')
                  if (string(istrt:istrt+2) .ne. 'g98' .and.
     *                  string(istrt:istrt+3) .ne. 'pg98' .and.
     *                  string(istrt:istrt+2) .ne. 'g94'  .and.
     *                  string(istrt:istrt+2) .ne. 'g03'  .and.
     *                  string(istrt:istrt+2) .ne. 'g09') then          0808RMP12
                     write (outfile,600)
  600                format(3x, 'ERROR: G09, G03, G98 and G94 are ',
     *                          'the only allowed PROGRAMs for this ',
     *                          'version of Multilevel')
                     stop 'rhfmo 7' 
                  endif
c
               else
                  write (outfile,1100) string(istrt:80)
1100              format(/3x,'ERROR: the following is not a valid ',
     *                   'option of the MOKEY keyword: ', a)
                  stop 'rhfmo 8'
               endif
               call rline(infile,string,istrt,isect,iscend3,iend) 
            enddo
c
c read the fraction
c  
         elseif (string(istrt:istrt+5) .eq. 'frachf') then
               hfmoinp%frachf = cfloat(rvar(string, istrt, 'FRACHF'))
         else
               write (outfile,11) string
  11           format ( 'ERROR: Invalid HFMO option:',a80)
               stop 'rhfmo 4'
            endif

      call rline(infile,string,istrt,isect,iscend,iend)
      enddo

c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c 
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rhfmo 5'
      endif

      return
      end
c
c
c*******************************************************************************
c  RIB
c*******************************************************************************
c
      subroutine rib(ibinp,iend)
c 
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the IB section of the input file
c     
c     Called by:  rlc
c     Calls:  rline, rvar, cfloat
c 
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend, methset, basset, betaset
      double precision cfloat   
      character*80 string
      character*20 rvar

      type (mcinf) :: ibinp

      isect = 0
      iscend = 0
      betaset = 0
      methset = 0
      basset = 0
c 
c read first line in IB section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the IB section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then
            ibinp%meth = rvar( string, istrt, 'IB:METHOD' )
            methset = 1
c    sets stdibm to nonstand. if method isn't ccsd(t), ccsd, mp4, or mp2
            if (ibinp%meth(:4).ne.'ccsd' .and. 
     *           ibinp%meth(:3).ne.'mp2' .and. 
     *           ibinp%meth(:3).ne.'mp4') then
               ibinp%stdm = 0
            endif
c
c LLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'llbasis') then
            ibinp%bas1 = rvar( string, istrt, 'IB:LLBASIS' )
            basset = 1
c    sets stdibb1 to nonstandard if basis isn't cc-pVDZ
            if (ibinp%bas1(:7).ne.'cc-pvdz' .or. 
c     *            ibinp%bas1(:8).eq.'pdz+') then
     *            ibinp%bas1(:8).eq.'mpdz') then                        0808RMP12
               ibinp%stdb1 = 0
            endif
c
c HLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'hlbasis') then
            ibinp%bas2 = rvar( string, istrt, 'IB:HLBASIS' )
            basset = 1
c    sets stdibb2 to nonstandard if basis isn't cc-pVTZ
            if (ibinp%bas2(:7).ne.'cc-pvtz') then 
               ibinp%stdb2 = 0
            endif
c
c ALPHA
c
         elseif (string(istrt:istrt+4) .eq. 'alpha') then
            ibinp%coef(1) = cfloat( rvar(string, istrt, 'IB:ALPHA' ) )
c
c BETA
c
         elseif (string(istrt:istrt+3) .eq. 'beta' ) then
            ibinp%coef(2) = cfloat( rvar(string, istrt, 'IB:BETA' ) )
            betaset = 1
c
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid IB option:', a80)
             stop 'rib 1'
         endif

      call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rib 2'
      endif
c
c Set default beta if a non-default or non-standard method is specified.
c
      if ( betaset.eq.0 .and. (methset.eq.1 .or. basset.eq.1) ) then
         if (ibinp%stdb1.eq.1 .and. ibinp%stdb2.eq.1 .and. 
     *         ibinp%stdm.eq.1) then
            if (ibinp%meth(:3) .eq. 'mp4') then
               ibinp%coef(2) = ibdefb(pmp4)
            elseif (ibinp%meth(:7) .eq. 'ccsd(t)') then
               ibinp%coef(2) = ibdefb(pccsdt)
            elseif (ibinp%meth(:4) .eq. 'ccsd') then
               ibinp%coef(2) = ibdefb(pccsd)
            elseif (ibinp%meth(:3) .eq. 'mp2') then
               ibinp%coef(2) = ibdefb(pmp2)
            endif
         else
            ibinp%coef(2) = ibdefb(nstd)
         endif
      endif

      return
      end
c
c
c*******************************************************************************
c  RMCSAC
c*******************************************************************************
c
      subroutine rmcsac(mcsinp,iend)
c     
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCSAC section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, rcoef
c
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend, i
      integer methset, basset, coefset, nodefalt, verset
      integer meth, bas, vers
      double precision cfloat
      character*80 string
      character*20 rvar

      type (mcinf) :: mcsinp

      isect = 0 
      iscend = 0     
      coefset = 0
      verset = 0
      methset = 0
      basset = 0
      nodefalt = 0
c 
c read first line in MCSAC section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c 
c loop through the keywords of the MCSAC section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c 
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then 
            mcsinp%meth = rvar( string, istrt, 'MCSAC:METHOD' )
            methset = 1
c    sets stdmcsm to nonstandard if method isn't ccsd(t), ccsd,
c      mp4sdq, or mp4.
            if (mcsinp%meth(:4).ne.'ccsd' .and. 
     *            mcsinp%meth(:4).ne.'mp4 ' .and.
     *            mcsinp%meth(:4).ne.'mp4s') then
               mcsinp%stdm = 0
               write(outfile, 1000)
1000           format('ERROR: Non-standard MCSAC methods not allowed.')
               stop 'rmcsac 1'
            endif
c
c BASIS
c
         elseif (string(istrt:istrt+4) .eq. 'basis') then
            mcsinp%bas1 = rvar( string, istrt, 'MCSAC:BASIS' )
            basset = 1
c    sets stdmcsb to nonstandard if basis set isn't cc-pVDZ or cc-pVTZ
            if ((mcsinp%bas1(:7).ne.'cc-pvdz' .and. 
     *            mcsinp%bas1(:7).ne.'cc-pvtz')
c     *            .or. mcsinp%bas1(:8).eq.'pdz+') then
     *            .or. mcsinp%bas1(:8).eq.'mpdz') then                  0808RMP12
               mcsinp%stdb1 = 0
            endif
c
c VERSION
c
        elseif (string(istrt:istrt+6).eq.'version') then
           mcsinp%version = rvar(string,istrt,'MCSAC:VERSION')
           if (mcsinp%version(:2) .ne. 'v1' .and.
     *         mcsinp%version(:2) .ne. 'ch' .and. 
     *         mcsinp%version(:2) .ne. 'v2' .and. 
     *         mcsinp%version(:2) .ne. 'v3') then
              write(outfile,5500) mcsinp%version
 5500         format('ERROR: Invalid MCSAC Version:',2x,a5)
              stop 'rmcsac 6'
           endif 
           verset = 1
c
c COEFFS
c
         elseif (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mcsinp%coef, 4, 'MCSAC:COEFFS', iend )
            coefset = 1
c
         else 
             write (outfile, 11) string
  11         format ( 'ERROR: Invalid MCSAC option:', a80)
             stop 'rmcsac 3'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcsac 4'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 5200)
5200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')                                          0908BL00   
         stop 'rmsac 5'
      endif
c
c If either the method or the basis set has been changed from its default
c and a new coefficient list has not been specified then read in defaults
c for that method/basis set combo.  Or set all to 1 if a nonstandard
c method or basis has been specified
c

      if ( (methset.eq.1 .or. basset.eq.1) .and. coefset.eq.0 ) then
         do 20 i=1, 4
            mcsinp%coef(i) = 0.0d0
  20     continue
         if (mcsinp%stdm.eq.0 .or. mcsinp%stdb1.eq.0) then
            do 40 i=1, 4
               mcsinp%coef(i) = 1.0000d0
  40        continue
         else

           if (mcsinp%version(:4) .eq. 'v1sc') then
              vers = v1sc
           elseif (mcsinp%version(:4) .eq. 'v2sc') then
              vers = v2sc
           elseif (mcsinp%version(:3) .eq. 'cho') then
              vers = cho
           elseif (mcsinp%version(:3) .eq. 'v2m') then
              vers = v2m
           elseif (mcsinp%version(:3) .eq. 'v2s') then
              vers = v2s
           elseif (mcsinp%version(:3) .eq. 'v3m') then
              vers = v3m
           elseif (mcsinp%version(:3) .eq. 'v3s') then
              vers = v3s
           else
              write(outfile,1012) mcsinp%version
1012          format('ERROR: Invalid MCSAC VERSION:',2x,a)
              stop 'rmcsac 2'
           end if

            if (mcsinp%bas1(:7) .eq. 'cc-pvdz') then
               bas = pdz
            elseif (mcsinp%bas1(:7) .eq. 'cc-pvtz') then
               bas = ptz
            endif

            if (mcsinp%meth(:6) .eq. 'mp4sdq') then
               meth = pmp4sdq
            elseif (mcsinp%meth(:3) .eq. 'mp4') then
               meth = pmp4
            elseif (mcsinp%meth(:7) .eq. 'ccsd(t)') then
               meth = pccsdt
            elseif (mcsinp%meth(:4) .eq. 'ccsd') then
               meth = pccsd
            endif


            do 60 i=1,4
               mcsinp%coef(i) = mcsdefc(vers,meth,bas,i)
  60        continue

         endif
      endif
c 
      return
      end
c
c
c*******************************************************************************
c RMCCMCO
c*******************************************************************************
c
c
      subroutine rmccmco(mcoinp,iend) 
c
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCCMCO section of the input file
c
c     Called by:  rlc
c     Calls: rline, rvar, rcoef
c
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend, i
      integer methset, basset, coefset, nodefalt, meth, vers, verset
      double precision cfloat
      character*80 string
      character*20 rvar

      type (mcinf) :: mcoinp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
      methset = 0
      basset = 0
      nodefalt = 0
c
c read first line in MCCMCO section  
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCCMCO section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then
            mcoinp%meth = rvar( string, istrt, 'MCCMCO:METHOD' )
            methset = 1
c    Sets stdmcom to nonstandard if the method isn't ccsd(t), ccsd, mp4,
c      mp4sdq, or mp2.
            if (mcoinp%meth(:4).ne.'ccsd' .and. 
     *           mcoinp%meth(:3).ne.'mp4'
     *           .and. mcoinp%meth(:3).ne.'mp2') then
               mcoinp%stdm = 0
               write(outfile, 1000)
1000           format('ERROR: Nonstandard MCCMCO methods not allowed.')
               stop 'rmccmco 1'
            endif
c
c LLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'llbasis') then
            mcoinp%bas1 = rvar( string, istrt, 'MCCMCO:LLBASIS' )
            basset = 1
c    sets stdmcob1 to nonstandard if basis set isn't cc-pVDZ
            if (mcoinp%bas1(:7).ne.'cc-pvdz' .or. 
c     *           mcoinp%bas1(:8).eq.'pdz+') then
     *           mcoinp%bas1(:8).eq.'mpdz') then                        0808RMP12
               mcoinp%stdb1 = 0
            endif
c
c HLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'hlbasis') then
            mcoinp%bas2 = rvar( string, istrt, 'MCCMCO:HLBASIS' )
            basset = 1
c    sets stdmcob2 to nonstandard if basis set isn't cc-pVTZ
            if (mcoinp%bas2(:7).ne.'cc-pvtz') then
               mcoinp%stdb2 = 0
            endif
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
           mcoinp%version = rvar(string,istrt,'MCCMCO:VERSION')
           if (mcoinp%version(:2) .ne. 'v1' .and.
     *         mcoinp%version(:3) .ne. 'cho' .and. 
     *         mcoinp%version(:2) .ne. 'v3'  .and. 
     *         mcoinp%version(:2) .ne. 'v2') then 
               write(outfile,5500) mcoinp%version
5500           format('ERROR: Invalid MCCMCO Version:',2x,a5)
               stop 'rmccmco 6'
           endif
           verset = 1
c
c COEFFS
c
         elseif (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mcoinp%coef, 10, 'MCCMCO:COEFFS', iend )
            coefset = 1
         else
             write (outfile,19) string
  19         format ('ERROR:  Invalid MCCMCO option:', a80)
             stop 'rmccmco 2'  
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo   
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmccmco 4'
      endif
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 5200)
5200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')                                         0908BL00
         stop 'rmccmco 5'
      endif
c
c If either the method or the basis set has been changed from its default
c and a new coefficient list has not been specified then read in defaults
c for that method/basis set combo
c
      if ( (methset.eq.1 .or. basset.eq.1) .and. coefset.eq.0 ) then
         do 20 i=1, 10
            mcoinp%coef(i) = 0.0000d0
  20     continue
         if (mcoinp%stdm.eq.1 .and. mcoinp%stdb1.eq.1 .and.
     *         mcoinp%stdb2.eq.1) then

           if (mcoinp%version(:4) .eq. 'v1sc') then
              vers = v1sc
           elseif (mcoinp%version(:4) .eq. 'v2sc') then
              vers = v2sc
           elseif (mcoinp%version(:3) .eq. 'cho') then
              vers = cho
           elseif (mcoinp%version(:3) .eq. 'v2s') then
              vers = v2s
           elseif (mcoinp%version(:3) .eq. 'v2m') then 
              vers = v2m
           elseif (mcoinp%version(:3) .eq. 'v3m') then 
              vers = v3m
           elseif (mcoinp%version(:3) .eq. 'v3s') then 
              vers = v3s
           else
              write(outfile,1012) mcoinp%version
1012          format('ERROR: Invalid MCCMCO VERSION:',2x,a)
              stop 'rmccmco 3'
           end if

            if (mcoinp%meth(:3) .eq. 'mp2') then
               meth = pmp2
            elseif (mcoinp%meth(:6) .eq. 'mp4sdq') then
               meth = pmp4sdq
            elseif (mcoinp%meth(:3) .eq. 'mp4') then
               meth = pmp4
            elseif (mcoinp%meth(:7) .eq. 'ccsd(t)') then
               meth = pccsdt
            elseif (mcoinp%meth(:4) .eq. 'ccsd') then
               meth = pccsd
            endif

            do 40 i=1, 10
               mcoinp%coef(i) = mcodefc(vers,meth,i)
  40        continue
   
         else
            write( outfile, 1200 )mcoinp%stdm,mcoinp%stdb1,
     *                            mcoinp%stdb2 
1200        format('ERROR:', i3,x,i3,x,i3)
            stop 'rmccmco 6'

         endif
      endif
     
      return
      end
c
c
c*******************************************************************************
c RMCCMUT
c*******************************************************************************
c
c
      subroutine rmccmut(mutinp,iend)
c
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCCMUT section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, rcoef
c
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend, i
      integer methset, basset, coefset, nodefalt, meth
      integer verset, vers
      double precision cfloat
      character*80 string
      character*20 rvar

      type (mcinf) :: mutinp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
      methset = 0
      basset = 0
      nodefalt = 0
c
c read first line in MCCMUT section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCCMUT section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then
            mutinp%meth = rvar( string, istrt, 'MCCMUT:METHOD' )
            methset = 1
c    Sets stdmutm to nonstandard if the method isn't ccsd(t), ccsd, mp4,
c      mp4sdq.
            if (mutinp%meth(:4).ne.'ccsd' .and. 
     *           mutinp%meth(:3).ne.'mp4') then   
               mutinp%stdm = 0
               write(outfile, 1000) 
1000           format('ERROR: Nonstandard MCCMUT methods not allowed.')
               stop 'rmccmut 1'
            endif
c
c LLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'llbasis') then
            mutinp%bas1 = rvar( string, istrt, 'MCCMUT:LLBASIS' )
            basset = 1
c    sets stdmutb1 to nonstandard if basis set isn't cc-pVDZ
            if (mutinp%bas1(:7).ne.'cc-pvdz' .or.
c     *           mutinp%bas1(:8).eq.'pdz+') then
     *           mutinp%bas1(:8).eq.'mpdz') then                        0808RMP12
               mutinp%stdb1 = 0
            endif
c
c HLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'hlbasis') then
            mutinp%bas2 = rvar( string, istrt, 'MCCMUT:HLBASIS' )
            basset = 1
c    sets stdmutb2 to nonstandard if basis set isn't cc-pVTZ 
            if (mutinp%bas2(:7).ne.'cc-pvtz') then 
               mutinp%stdb2 = 0
            endif 
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
           mutinp%version = rvar(string,istrt,'MCCMUT:VERSION')
           if (mutinp%version(:2).ne.'v1' .and.
     *         mutinp%version(:2).ne.'v2') then
              write(outfile,5500) mutinp%version
5500          format('ERROR: Invalid MCCMUT Version:',2x,a5)
              stop 'rmccmut 6'
           endif
           verset = 1
c
c COEFFS
c
         elseif (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mutinp%coef, 7, 'MCCMUT:COEFFS', iend )
            coefset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCCMUT option:', a80)
             stop 'rmccmut 2'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmccmut 4'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 5200)
5200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmccmut 5'
      endif
c
c If either the method or the basis set has been changed from its default
c and a new coefficient list has not been specified then read in defaults
c for that method/basis set combo   
c
      if ( (methset.eq.1 .or. basset.eq.1) .and. coefset.eq.0 ) then
         do 20 i=1, 7
            mutinp%coef(i) = 0.0000d0
  20     continue
         if (mutinp%stdm.eq.1 .and. mutinp%stdb1.eq.1 .and.
     *         mutinp%stdb2.eq.1) then

           if (mutinp%version(:4) .eq. 'v1sc') then
              vers = v1sc
           elseif (mutinp%version(:4) .eq. 'v2sc') then
              vers = v2sc
           elseif (mutinp%version(:3) .eq. 'cho') then
              vers = cho
           elseif (mutinp%version(:3) .eq. 'v2s') then
              vers = v2s
           elseif (mutinp%version(:3) .eq. 'v2m') then
              vers = v2m
           elseif (mutinp%version(:3) .eq. 'v3m') then
              vers = v3m
           elseif (mutinp%version(:3) .eq. 'v3s') then
              vers = v3s
           else
              write(outfile,1012) mutinp%version
1012          format('ERROR: Invalid MCCMUT VERSION:',2x,a)
              stop 'rmccmut 3'
           end if

            if (mutinp%meth(:6) .eq. 'mp4sdq') then
               meth = pmp4sdq
            elseif (mutinp%meth(:3) .eq. 'mp4') then
               meth = pmp4
            elseif (mutinp%meth(:7) .eq. 'ccsd(t)') then
               meth = pccsdt
            elseif (mutinp%meth(:4) .eq. 'ccsd') then
               meth = pccsd
            endif
            do 40 i=1, 7
               mutinp%coef(i) = mutdefc(vers,meth,i)
  40        continue
         else
            write( outfile, 1200 )
1200        format('ERROR: Must specify MCCMUT coeff. for these bases.')
            stop 'rmccmut 6'
         endif
      endif
c         
      return
      end
c
c 
c*******************************************************************************
c RMCCMNM
c*******************************************************************************
c
c
      subroutine rmccmnm(mnminp,iend)
c
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCCMNM section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, rcoef
c 
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend, i
      integer methset, basset, coefset, nodefalt, meth
      integer verset, vers
      double precision cfloat
      character*80 string
      character*20 rvar

      type (mcinf) :: mnminp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
      methset = 0
      basset = 0
      nodefalt = 0
c
c read first line in MCCMNM section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCCMNM section
c  
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then
            mnminp%meth = rvar( string, istrt, 'MCCMNM:METHOD' )
            methset = 1
c    Sets stdmnmm to nonstandard if the method isn't ccsd(t)
            if (mnminp%meth(:7).ne.'ccsd(t)') then
               mnminp%stdm = 0
               write(outfile, 1000)
1000           format('ERROR: Nonstandard MCCMNM methods not allowed.')
               stop 'rmccmnm 1'
            endif
c 
c LLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'llbasis') then
            mnminp%bas1 = rvar( string, istrt, 'MCCMNM:LLBASIS' )
            basset = 1
c    sets stdmnmb1 to nonstandard if basis set isn't cc-pVDZ
            if (mnminp%bas1(:7).ne.'cc-pvdz') then
               mnminp%stdb1 = 0
            endif
c
c MLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'mlbasis') then
            mnminp%bas2 = rvar( string, istrt, 'MCCMNM:MLBASIS' )
            basset = 1
c    sets stdmnmb2 to nonstandard if basis set isn't pDZ+
c            if (mnminp%bas2(:8).ne.'pdz+') then
            if (mnminp%bas2(:8).ne.'mpdz') then                         0808RMP12
               mnminp%stdb2 = 0
            endif
c
c HLBASIS
c
         elseif (string(istrt:istrt+6) .eq. 'hlbasis') then
            mnminp%bas3 = rvar( string, istrt, 'MCCMNM:HLBASIS' )
            basset = 1
c    sets stdmnmb1 to nonstandard if basis set isn't cc-pVTZ
            if (mnminp%bas3(:7).ne.'cc-pvtz') then
               mnminp%stdb3 = 0
            endif
c
c VERSION
c
        elseif (string(istrt:istrt+6).eq.'version') then
           mnminp%version = rvar(string,istrt,'MCCCMNM:VERSION')
           if (mnminp%version(:2) .ne. 'v1' .and.
     *         mnminp%version(:2) .ne. 'v2') then
              write(outfile,5500) mnminp%version
5500          format('ERROR: Invalid MCCMNM Version:',2x,a5)
              stop 'rmccmnm 6'
           endif
           verset = 1
c
c COEFFS
c
         elseif (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mnminp%coef, 7, 'MCCMNM:COEFFS', iend )
            coefset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCCMNM option:', a80 )
             stop 'rmccmnm 2'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmccmnm 4'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 5200)
5200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmccmnm 5'
      endif
c
c If either the method or the basis set has been changed from its default
c and a new coefficient list has not been specified then read in defaults
c for that method/basis set combo
c
      if ( (methset.eq.1 .or. basset.eq.1) .and. coefset.eq.0 ) then
         do 20 i=1, 7
            mnminp%coef(i) = 0.0000d0   
  20     continue
         if (mnminp%stdm.eq.1 .and. mnminp%stdb1.eq.1 .and. 
     *         mnminp%stdb2.eq.1 .and. mnminp%stdb3.eq.1) then

           if (mnminp%version(:4) .eq. 'v1sc') then
              vers = v1sc
           elseif (mnminp%version(:4) .eq. 'v2sc') then
              vers = v2sc
           elseif (mnminp%version(:3) .eq. 'cho') then
              vers = cho
           elseif (mnminp%version(:3) .eq. 'v2s') then
              vers = v2s
           elseif (mnminp%version(:3) .eq. 'v2m') then
              vers = v2m
           elseif (mnminp%version(:3) .eq. 'v3m') then
              vers = v3m
           elseif (mnminp%version(:3) .eq. 'v3s') then
              vers = v3s
           else
              write(outfile,1012) mnminp%version
1012          format('ERROR: Invalid MCSAC VERSION:',2x,a)
              stop 'rmccmnm 3'
           end if

            if (mnminp%meth(:7) .eq. 'ccsd(t)') then
               meth = pccsdt
            endif
            do 40 i=1, 7
               mnminp%coef(i) = mnmdefc(vers,i)
  40        continue
         else
            write( outfile, 1200 )
1200        format('ERROR: Must specify MCCMNM coeff. for these bases.')
            stop 'rmccmnm 3'
         endif
      endif
c         
      return
      end
c
c
c*******************************************************************************
c  RG2
c*******************************************************************************
c
c
      subroutine rg2(g2inp,iend)
c 
c     Created:  July 1, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the G2 section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, icint
c
      use input, only : ginf
      use files, only : infile, outfile
      implicit none
c
      integer istrt, isect, iscend, iend, icint
      character*80 string
      character*20 rvar

      type (ginf) :: g2inp
               
      isect = 0
      iscend = 0
c
c read first line in G2 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the G2 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c ALPHA electrons
c
         if (string(istrt:istrt+4) .eq. 'alpha') then
            g2inp%alpha = icint( rvar(string,istrt,'G2:ALPHA') )
c
c BETA electrons
c
         elseif (string(istrt:istrt+3) .eq. 'beta') then
            g2inp%beta = icint( rvar(string,istrt,'G2:BETA') )
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid G2 option:', a80 )
             stop 'rg2 2'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rg2 2'
      endif

      return
      end
c
c
c*******************************************************************************
c RMCG2
c*******************************************************************************
c
c
      subroutine rmcg2(mg2inp,iend)
c 
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCG2 section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, istrt, isect, iscend, iend, coefset, verset, vers
      character*20 rvar
      character*80 string

      type (mginf) :: mg2inp
               
      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCG2 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCG2 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mg2inp%mcoef, 9, 'MCG2:COEFFS', iend )
            coefset = 1
c
c VERSION
c
        elseif (string(istrt:istrt+6).eq.'version') then
           mg2inp%version = rvar(string,istrt,'MCG2:VERSION')
           if (mg2inp%version(:4) .eq. 'v1sc') then
              vers = g1sc
              do 10 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 10           continue
           elseif (mg2inp%version(:4) .eq. 'v1m') then
              vers = g1m
              do 20 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 20           continue
           elseif (mg2inp%version(:4) .eq. 'v2sc') then
              vers = g2sc
              do 30 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 30           continue

           elseif (mg2inp%version(:3) .eq. 'v2s') then
              vers = g2s
              do 40 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 40           continue

           elseif (mg2inp%version(:3) .eq. 'cho') then
              vers = gchos
              do 41 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 41           continue

           elseif (mg2inp%version(:3) .eq. 'v3m') then
              vers = g3m
              do 42 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 42           continue

           elseif (mg2inp%version(:3) .eq. 'v3s') then
              vers = g3s
              do 43 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 43           continue

           elseif (mg2inp%version(:3) .eq. 'v2m') then
              vers = g2m
              do 50 i = 1, 9
                    mg2inp%mcoef(i) = mc2defc(vers,i)
 50           continue

           else
              write(outfile,1012) mg2inp%version
1012          format('ERROR: Invalid MCG2 VERSION:',2x,a)
              stop 'rmcg2 3'
           end if
           verset = 1
c
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCG2 option:', a80)
             stop 'rmcg2 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcg2 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmcg2 5'
      endif
c
      return
      end
c
c
c*******************************************************************************
c  RG3
c*******************************************************************************
c
c
      subroutine rg3(g3inp,iend)
c 
c     Created:  July 1, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the G3 section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, icint
c
      use input, only : ginf
      use files, only : infile, outfile
      implicit none
c
      integer istrt, isect, iscend, iend, icint
      character*80 string
      character*20 rvar

      type (ginf) :: g3inp
               
      isect = 0
      iscend = 0
c
c read first line in G3 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the G3 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c ALPHA electrons
c
         if (string(istrt:istrt+4) .eq. 'alpha') then
            g3inp%alpha = icint( rvar(string,istrt,'G3:ALPHA') )
c
c BETA electrons
c
         elseif (string(istrt:istrt+3) .eq. 'beta') then
            g3inp%beta = icint( rvar(string,istrt,'G3:BETA') )
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid G3 option:', a80 )
             stop 'rg3 2'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rg3 2'
      endif

      return
      end


c
c
c*******************************************************************************
c RMCG3
c*******************************************************************************
c
c
      subroutine rmcg3(mg3inp,iend)
c 
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the MCG3 section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, verset, coefset, istrt, isect, iscend, iend
      integer vers
      character*20 rvar
      character*80 string

      type (mginf) :: mg3inp
               
      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCG3 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCG3 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mg3inp%mcoef, 7, 'MCG3:COEFFS', iend )          0224BL02
            coefset = 1
c
c VERSION
c
        elseif (string(istrt:istrt+6).eq.'version') then
           mg3inp%version = rvar(string,istrt,'MCG3:VERSION')
           if (mg3inp%version(:4) .eq. 'v2sc') then
              vers = g2sc
              do 10 i = 1, 8
                    mg3inp%mcoef(i) = mc3defc(vers,i)
 10           continue
           elseif (mg3inp%version(:3) .eq. 'v2s') then
              vers = g2s
              do 20 i = 1, 8
                    mg3inp%mcoef(i) = mc3defc(vers,i)
 20           continue
           elseif (mg3inp%version(:3) .eq. 'v2m') then
              vers = g2m
              do 30 i = 1, 8
                    mg3inp%mcoef(i) = mc3defc(vers,i)
 30           continue
           elseif (mg3inp%version(:3) .eq. 'cho')then                   0224BL02
              vers = gchos                                              0224BL02
              do 40 i = 1, 8                                            0224BL02
                    mg3inp%mcoef(i) = mc3defc(vers,i)                   0224BL02
 40           continue                                                  0224BL02
           elseif (mg3inp%version(:3) .eq. 'v3m') then                  0224BL02
              vers = g3m                                                0224BL02
              do 50 i = 1, 7                                            0224BL02
                    mg3inp%mcoef(i) = mc3defc(vers,i)                   0224BL02
 50           continue                                                  0224BL02
           elseif (mg3inp%version(:3) .eq. 'v3s') then                  0224BL02
              vers = g3s                                                0224BL02
              do 60 i = 1, 7                                            0224BL02
                    mg3inp%mcoef(i) = mc3defc(vers,i)                   0224BL02
 60           continue                                                  0224BL02
           else
              write(outfile,1012) mg3inp%version
1012          format('ERROR: Invalid MCG3 VERSION:',2x,a)
              stop 'rmcg3 3'
           end if
           verset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCG3 option:', a80 )
             stop 'rmcg3 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcg3 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmcg3 5'
      endif
c
      return
      end

c
c
c*******************************************************************************
c RG3SX(MP3)
c*******************************************************************************
c
c
      subroutine rg3sxmp3(g3sxmp3inp,iend)
c
c     Created: October 11, 2003 by Yan Zhao  
c     Revised:
c     Purpose:  Read the G3SX(MP3) section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, verset, coefset, istrt, isect, iscend, iend
      integer vers
      character*20 rvar
      character*80 string

      type (mginf) :: g3sxmp3inp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCG3 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCG3 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
          call rcoef(g3sxmp3inp%g3sxmp3coef,5,'G3SXMP3:COEFFS',iend )     
          coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
              vers = g3s
              do 60 i = 1, 7                                            
               g3sxmp3inp%g3sxmp3coef = g3sxmp3defc(vers,i)              
 60           continue                                                   1011YZ03 
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid G3SX(MP3) option:', a80 )
             stop 'rmcg3 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcg3 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rg3sxmp3 5'
      endif
c
      return
      end

c
c*******************************************************************************
c RMC3BB
c*******************************************************************************
c
c
      subroutine rmc3bb(mc3bbinp,iend)
c
c     Created: October 11, 2003 by Yan Zhao
c     Revised:
c     Purpose:  Read the MC3BB section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, verset, coefset, istrt, isect, iscend, iend
      integer vers
      character*20 rvar
      character*80 string

      type (mginf) :: mc3bbinp 

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MC3BB section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MC3BB section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
          call rcoef(mc3bbinp%mc3bbcoef,2,'MC3BB:COEFFS',iend )
          coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
              vers = g3s
              do 60 i = 1, 7
               mc3bbinp%mc3bbcoef = mc3bbdefc(vers,i)
 60           continue                                                   1011YZ03
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MC3BB option:', a80 )
             stop 'rmcg3 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcg3 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmc3bb 5'
      endif
c
      return
      end

c
c*******************************************************************************
c RMC3MPW
c*******************************************************************************
c
c
      subroutine rmc3mpw(mc3mpwinp,iend)
c
c     Created: October 11, 2003 by Yan Zhao
c     Revised:
c     Purpose:  Read the MC3MPW section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, verset, coefset, istrt, isect, iscend, iend
      integer vers
      character*20 rvar
      character*80 string

      type (mginf) :: mc3mpwinp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MC3MPW section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MC3MPW section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
          call rcoef(mc3mpwinp%mc3mpwcoef,2,'MC3MPW:COEFFS',iend )
          coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
              vers = g3s
              do 60 i = 1, 7
               mc3mpwinp%mc3mpwcoef = mc3mpwdefc(vers,i)
 60           continue                                                   1011YZ03
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MC3MPW option:', a80 )
             stop 'rmcg3 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmc3mpw 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmc3mpw 5'
      endif
c
      return
      end


c
c
c*******************************************************************************
c RMQCISD
c*******************************************************************************
c
c
      subroutine rmqcisd(mqcinp,iend)
c
c     Created:  January 11, 2000 by P. L. Fast
c     Revised:
c     Purpose:  Read the MC-QCISD section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, coefset, istrt, isect, iscend, iend
      integer verset, vers
      character*20 rvar
      character*80 string

      type (mginf) :: mqcinp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCQCISD section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCQCISD section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mqcinp%mqcoef, 4, 'MCQCISD:COEFFS', iend )
            coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
           mqcinp%version = rvar(string,istrt,'MCQCISD:VERSION')
           if (mqcinp%version(:3) .eq. 'v2m') then
              vers = g2m
              do 10 i = 1, 4
                    mqcinp%mqcoef(i) = mqcdefc(vers,i)
 10           continue
          elseif (mqcinp%version(:3) .eq. 'cho') THEN                   0224BL02 
              vers = gchos                                              0224BL02
              do 20 i = 1, 4                                            0224BL02
                    mqcinp%mqcoef(i) = mqcdefc(vers,i)                  0224BL02 
 20           continue                                                  0224BL02 
           elseif (mqcinp%version(:3) .eq. 'v3m') THEN                  0224BL02 
              vers = g3m                                                0224BL02
              do 30 i = 1, 4                                            0224BL02
                    mqcinp%mqcoef(i) = mqcdefc(vers,i)                  0224BL02 
 30           continue                                                  0224BL02 
           elseif (mqcinp%version(:3) .eq. 'v3s') THEN                  0224BL02
              vers = g3s                                                0224BL02
              do 40 i = 1, 4                                            0224BL02
                    mqcinp%mqcoef(i) = mqcdefc(vers,i)                  0224BL02
 40           continue                                                  0224BL02
                                            
           else
              write(outfile,1012) mqcinp%version
1012          format('ERROR: Invalid MCQCISD VERSION:',2x,a)
              stop 'rmqcisd 3'
           end if
           verset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCQCISD option:', a80 )
             stop 'rmqcisd 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c   
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmqcisd 2'
      endif

      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmqcisd 5'
      endif

      return
      end

c
c*******************************************************************************
c RMCOMP2
c*******************************************************************************
c
c
      subroutine rmcomp2(mcomp2inp,iend)
c
c     Created:  January 11, 2000 by P. L. Fast
c     Revised:  July 10, 2000 Jingzhi Pu
c     Purpose:  Read the MCOMP2 section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, coefset, istrt, isect, iscend, iend
      integer verset, vers
      character*20 rvar
      character*80 string

      type (mginf) :: mcomp2inp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCOMP2 section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCOMP2 section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mcomp2inp%mcomp2coef, 4, 'MCOMP2:COEFFS', iend )
            coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
           mcomp2inp%version = rvar(string,istrt,'MCOMP2:VERSION')
           if (mcomp2inp%version(:3) .eq. 'v2m') then
              vers = g2m
              do 10 i = 1, 4
                    mcomp2inp%mcomp2coef(i) = mcomp2defc(vers,i)
 10           continue
           elseif (mcomp2inp%version(:3) .eq. 'v3m') then                    0224BL02
              vers = g3m                                                     0224BL02
              do 20 i = 1, 4                                                 0224BL02
                    mcomp2inp%mcomp2coef(i) = mcomp2defc(vers,i)             0224BL02
 20           continue                                                       0224BL02
           elseif (mcomp2inp%version(:3) .eq. 'v3s') then                    0224BL02
              vers = g3s                                                     0224BL02
              do 30 i = 1, 4                                                 0224BL02
                    mcomp2inp%mcomp2coef(i) = mcomp2defc(vers,i)             0224BL02
 30           continue                                                       0224BL02
           else
              write(outfile,1012) mcomp2inp%version
1012          format('ERROR: Invalid MCOMP2 VERSION:',2x,a)
              stop 'rmcomp2 3'
           end if
           verset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCOMP2 option:', a80 )
             stop 'rmcomp2 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcomp2 2'
      endif

      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmcomp2 5'
      endif

      return
      end
c*******************************************************************************
c RMCCO
c*******************************************************************************
c
c
      subroutine rmcco(mccoinp,iend)
c
c     Created:  July 12, 2002 B. J. Lynch
c     Revised:  
c     Purpose:  Read the MCCO section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rcoef
c
      use input, only : mginf
      use files, only : infile, outfile
      use gparam
      implicit none
c
      integer i, coefset, istrt, isect, iscend, iend
      integer verset, vers
      character*20 rvar
      character*80 string

      type (mginf) :: mccoinp

      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
c
c read first line in MCCO section
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the MCCO section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c COEFFS
c
         if (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( mccoinp%mccocoef, 4, 'MCCO:COEFFS', iend )
            coefset = 1
c
c VERSION
c
         elseif (string(istrt:istrt+6).eq.'version') then
           mccoinp%version = rvar(string,istrt,'MCCO:VERSION')

           if (mccoinp%version(:3) .eq. 'v3s') then
              vers = g3s
              do 10 i = 1, 4
                    mccoinp%mccocoef(i) = mccodefc(vers,i)
 10           continue
           elseif (mccoinp%version(:3) .eq. 'v3m') then                    
              vers = g3m                                                     
              do 20 i = 1, 4                                                 
                    mccoinp%mccocoef(i) = mccodefc(vers,i)             
 20           continue                                                       
           else
              write(outfile,1012) mccoinp%version
1012          format('ERROR: Invalid MCCO VERSION:',2x,a)
              stop 'rmcco 3'
           end if
           verset = 1
         else
             write (outfile,11) string
  11         format( 'ERROR: Invalid MCCO option:', a80 )
             stop 'rmcco 1'
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo
c
c  Terminate if end of file or new section reached  before the end
c    of the section.
c
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rmcco 2'
      endif

      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rmcco 5'
      endif

      return
      end

c
c*******************************************************************************
c RSAC
c*******************************************************************************
c
c
      subroutine rsac(sacinp,iend) 
c
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read the SAC section of the input file
c
c     Called by:  rlc
c     Calls:  rline, rvar, rcoef
c
      use input, only : mcinf
      use files, only : infile, outfile
      use param
      implicit none
c
      integer istrt, isect, iscend, iend
      integer methset, basset, coefset, nodefalt
      integer meth, bas, verset, vers
      double precision cfloat
      character*80 string
      character*20 rvar

      type (mcinf) :: sacinp
            
      isect = 0
      iscend = 0
      coefset = 0
      verset = 0
      methset = 0
      basset = 0
      nodefalt = 0
c
c
c read first line in SAC section  
c
      call rline(infile,string,istrt,isect,iscend,iend)
c
c loop through the keywords of the SAC section
c
      do while (iscend.eq.0 .and. isect.eq.0 .and. iend.eq.0)
c
c METHOD
c
         if (string(istrt:istrt+5) .eq. 'method') then
            sacinp%meth = rvar( string, istrt, 'SAC:METHOD' )
            methset = 1
c    sets stdsacm to nonstandard if method isn't ccsd(t), ccsd,
c      mp4sdq, mp4, or mp2.
            if (sacinp%meth(:4).ne.'ccsd' .and. 
     *           sacinp%meth(:3).ne.'mp4' .and.
     *           sacinp%meth(:3).ne.'mp2') then
               sacinp%stdm = 0
            endif
c
c BASIS
c
         elseif (string(istrt:istrt+4) .eq. 'basis') then
            sacinp%bas1 = rvar( string, istrt, 'SAC:BASIS' )
            basset = 1
c    sets stdsacb to nonstandard if basis set isn't cc-pVDZ or cc-pVTZ
            if ((sacinp%bas1(:7).ne.'cc-pvdz' 
     *           .and. sacinp%bas1(:7).ne.'cc-pvtz'
     *           .and. sacinp%bas1(:12).ne.'6-31+g(d,2p)')
c     *           .or. sacinp%bas1(:8).eq.'pdz+') then
     *           .or. sacinp%bas1(:8).eq.'mpdz') then                   0808RMP12
               sacinp%stdb1 = 0
            endif
c
c VERSION
c
        elseif (string(istrt:istrt+6).eq.'version') then
           sacinp%version = rvar(string,istrt,'SAC:VERSION')
           if (sacinp%version(:4) .ne. 'v1sc' .and.
     *        sacinp%version(:3) .ne. 'v1s' .and.
     *        sacinp%version(:4) .ne. 'v2sc' .and.
     *        sacinp%version(:3) .ne. 'v2s' .and.
     *        sacinp%version(:3) .ne. 'v2m' .and.
     *        sacinp%version(:3) .ne. 'cho' .and.
     *        sacinp%version(:3) .ne. 'v3m' .and.
     *        sacinp%version(:3) .ne. 'v3s') then 
              write(outfile,5500) sacinp%version
5500          format('ERROR: Invalid SAC Version:',2x,a5)
              stop 'rsac 6'
           endif           
           verset = 1
c
c COEFFS
c
         elseif (string(istrt:istrt+5) .eq. 'coeffs') then
            call rcoef( sacinp%coef, 1, 'SAC:COEFFS', iend )
            coefset = 1
         else
             write (outfile,1021) string
1021         format('ERROR: Invalid SAC option:',a80)
             stop 'rsac 1'  
         endif
c
c read next line
c
         call rline(infile,string,istrt,isect,iscend,iend)
      enddo   
c
c  Terminate if end of file or new section reached  before the end
c    of the section.  
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write(outfile,1031)
1031     format('ERROR: Section never terminated.')
         stop 'rsac 2'
      endif
c
      if (coefset.eq.1 .and. verset.eq.1) then
         write(outfile, 1200)
1200     format('ERROR: The VERSION and COEFF keywords can not be'
     *          ,' used together.')
         stop 'rsac 5'
      endif
c
c If either the method or the basis set has been changed from its default
c and a new coefficient list has not been specified then read in defaults
c for that method/basis set combo
c
c
      if ( (methset.eq.1 .or. basset.eq.1) .and. coefset.eq.0 ) then
         if (sacinp%stdm.eq.0 .or. sacinp%stdb1.eq.0) then
            sacinp%coef(1) = 1.2500d0
         else
            if (sacinp%bas1(:7) .eq. 'cc-pvdz') then
               bas = pdz
            elseif (sacinp%bas1(:7) .eq. 'cc-pvtz') then
               bas = ptz
            elseif (sacinp%bas1(:12) .eq. '6-31+g(d,2p)') then
               bas = dz
            endif

            if (sacinp%version(:4) .eq. 'v1sc') then
              vers = v1sc
            elseif (sacinp%version(:3) .eq. 'v1s') then
              vers = v1s
            elseif (sacinp%version(:4) .eq. 'v2sc') then
              vers = v2sc
            elseif (sacinp%version(:3) .eq. 'v2s') then
              vers = v2s
            elseif (sacinp%version(:3) .eq. 'v2m') then
              vers = v2m
            elseif (sacinp%version(:3) .eq. 'cho') then
              vers = cho
            elseif (sacinp%version(:3) .eq. 'v3m') then
              vers = v3m
            elseif (sacinp%version(:3) .eq. 'v3s') then
              vers = v3s
            else
              write(outfile,1012) sacinp%version
1012          format('ERROR: Invalid SAC VERSION:',2x,a)
              stop 'rsac 3'
            end if

            if (sacinp%meth(:3) .eq. 'mp2') then
               meth = pmp2
            elseif (sacinp%meth(:6) .eq. 'mp4sdq') then
               meth = pmp4sdq
            elseif (sacinp%meth(:3) .eq. 'mp4') then
               meth = pmp4
            elseif (sacinp%meth(:7) .eq. 'ccsd(t)') then
               meth = pccsdt
            elseif (sacinp%meth(:4) .eq. 'ccsd') then
               meth = pccsd
            endif

            sacinp%coef(1) = sacdefc(vers,meth,bas)

         endif
      endif
c
      return
      end
c
c
c*******************************************************************************
c  RVAR
c*******************************************************************************
c
      function rvar(string, istrt, varname)
c
c     Created:  June 21, 1999 by J.M. Rodgers
c     Revised:
c     Purpose:  Read a variable following a keyword and assign to var
c
c     Called by:  rimo,rmlgen,rextopt,rmlopt,rhfmo,rib,rmcsac,rmccmco,
c         rmccmut,rmccmnm,rg2,rg3,rsac
c     Calls:  fspace, rword
c
      use files, only : outfile
      implicit none
c

      integer istrt, ifin, length, ierr
      character*80 string
      character*20 rvar
      character*(*) varname

      call rword(string,istrt,ierr)
      if (ierr .eq. 1) then
         write (outfile, 800) varname
 800     format(/3x, 'ERROR: ', a15, ' must have an argument.')
         stop 'rvar 1'
      endif
      ifin = istrt+1
      call fspace(string, ifin, ierr)
      if (ierr .eq. 1) then
         length = ifin - istrt + 1
      else
         length = ifin - istrt
      endif
      if ( length .gt. 20 ) then
         write (outfile, 900) varname, string(istrt:ifin)
 900     format(/3x, 'ERROR: ', a15, ' argument too long: ', /a80)
         stop 'rvar 2'
      endif
      rvar = string(istrt:ifin)

      end
c
c
c*******************************************************************************
c  RCOEF
c*******************************************************************************
c
      subroutine rcoef(coefvar, numcoef, name, iend)
c           
c     Created:  June 21, 1999 by J. M. Rodgers
c     Revised:
c     Purpose:  Read a list of numbers and assign to coefvar
c        
c     Called by:  rmcsac,rmccmco,rmccmut,rmccmnm,rmmcg2,rmcg2,rmmcg3,
c        rmcg3,rsac
c     Calls:  rline, fchar, fspace
c           
      use files, only : infile, outfile
      implicit none
c

      integer  numcoef, iend, isect, iscend, i, j
      integer   ilong, ifin, ibeg, ierr
      double precision coefvar(numcoef), cfloat
      character*20 name
      character*80 string

      i = 1
      isect = 0
      iend = 0
      iscend = 0
c
c  Initialize coefficient array to 0
c
      do 20 j=1, numcoef
         coefvar(j) = 0.0d0
  20  continue

      call rline(infile,string,ibeg,isect,iscend,iend)

      do while (isect.eq.0.and.iscend.eq.0.and.iend.eq.0)
         ierr = 0
         ilong = 0
         ibeg = 1
         call fchar(string, ibeg, ierr)
         do while (ierr.eq.0 .and. ilong.eq.0)
            if (i .gt. numcoef)  goto 100
            ifin = ibeg + 1
            call fspace(string, ifin, ilong)
            if (ilong .eq. 0) then
               ifin = ifin - 1
            endif
            coefvar(i) = cfloat(string(ibeg:ifin))
            i = i+1
            ibeg = ifin + 1
            call fchar(string, ibeg, ierr)
         end do
         call rline(infile, string, ibeg, isect, iscend, iend)
      end do
c
c  Terminate if end of file or new section reached  before the end
c    of the coefficient list.
c    
      if (isect.eq.1 .or. (iend.eq.1 .and. iscend.eq.0)) then
         write (outfile, 1100) name
1100     format(/3x,'ERROR: No end to coefficient list in', a )
         stop 'rcoef 2'
      endif

      return

 100  write (outfile, 1000) name
1000  format(/3x,'ERROR:  Too many coefficients in ', a)
      stop 'rcoef 1'
  
      return

      end
