c
c******************************************************************************
c  MAIN
c******************************************************************************
c
      program main
c
c     Multilevel is a computer program, written in standard Fortran 90,
c       for calculating IMOHC, HF||MO, MC, or MG single-point energies, 
c       gradients, or Hessians, or geometry optimizations.
c
c     The majority of the work is done in the different hooks, mlehook,
c       mlghook, mlhhook, and mlohook.
c
c     Code Reference: J. M. Rodgers, B. J. Lynch, P. L. Fast, 
c                     Y.-Y. Chuang, and D. G. Truhlar, 
c                     Multilevel-version 2.0, 
c                     University of Minnesota, Minneapolis, 2000.
c     
c     Program main.F
c
c     Created:  April 8, 1999 by P. L. Fast
c     Revised:  June 1999 by JMR
c               January 6, 2000 by P. L. Fast
c     Purpose:  Main program driver for the Multilevel code
c
c     Description: main.f opens and closes all the necessary input 
c                  and output files.  it also initiates all calls to 
c                  the subroutines.  
c
c     Calls: mlhedr, read5, mlehook, mlghook, mlhhook, mlohook, progohk
c
c     Variables Defined Here: lexit
c
c     
      use input
      use files
      use caltyp                                                        0418PJ01
      implicit none
c
      logical  lexit
      integer  ierr

      type (general)   :: mlgeninp
      integer          :: llc, limohc, ltest
      integer          :: prtype                                        0418PJ01
      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,g3sxmp3inp,mc3bbinp,   0106PF00
     *                    mcomp2inp, mccoinp, mc3mpwinp                 0712BL02
      type (imoinf)    :: imohcinp
      type (mlopt)     :: mloptinp
      type (extopt)    :: extoptinp
      type (proglist)  :: progrms
c
c     open the input and output files (ml.inp and ml.out).  any additional
c        files will be opened and closed as needed.
c
      ierr = 0
c
      open (unit=outfile, file=mlout, status='unknown',
     *      form='formatted', err=6000)
      open (unit=infile, file=mlin, status='old', 
     *      form='formatted', err=5000)
c
c     write program header to outfile
c
      call mlhedr
c
c     read the input from infile (ml.inp) and write a summary to outfile
c
      call read5( mlgeninp, progrms, mloptinp, extoptinp, llc, mcinp, 
     *      mgswit, hfmoinp, mcoptl, sacinp, mcsinp, ibinp, mcoinp, 
     *      mnminp, mutinp, g2inp, mg2inp, g3inp, mg3inp, mqcinp,       0106PF00
     *      mcomp2inp, mccoinp, g3sxmp3inp, mc3bbinp, mc3mpwinp,        0712BL02
     *      limohc, imohcinp, ltest, tmeth, tbas, toptl)

c
c  Call the external and internal optimization hooks if selected.
c  If both ohooks activiated then call the external optimization first
c    to create a starting point for the Multilevel optimization.
c  Once optimized will still be able to run the energy, gradient, or
c    hessian hooks if selected.
c  Currently automatically activate the energy hooks for all lower level
c    energies.
c
      if (mlgeninp%lextopt .eq. 1) then
         call progohk(mlgeninp%geom, extoptinp, progrms%extoptprog, 
     *              ierr)
      endif
      if (ierr.eq.1)  goto 7000

      if (mlgeninp%lopt .eq. 1) then
         call mlohook(progrms, mlgeninp%geom,
     *      mloptinp, hfmoinp, mcoptl, sacinp,
     *      mcsinp, ibinp, mcoinp, mnminp, mutinp, g2inp, mg2inp, 
     *      g3inp, mg3inp, mqcinp, mcomp2inp,mccoinp,g3sxmp3inp,        0712BL02
     *      mc3bbinp, mc3mpwinp,imohcinp, tmeth, tbas, toptl, ierr)     0106PF00
         mlgeninp%lener = 1
      endif
      if (ierr.eq.1)  goto 8000
c
c  Call either the hessian, gradient or energy hooks - but only call one,
c    the most expensive chosen - it will produce all the rest of the
c    information.
c
      if (mlgeninp%lhess .eq. 1) then
         call mlhhook(progrms, mlgeninp%geom,
     *       mcinp, mgswit, hfmoinp,
     *       mcoptl, sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp,
     *       g2inp, mg2inp, g3inp, mg3inp, mqcinp, mcomp2inp,mccoinp,   0712BL02
     *       g3sxmp3inp, mc3bbinp, mc3mpwinp,                           0130YZ04
     *       limohc,imohcinp,ltest,tmeth,tbas,toptl, ierr)              0106PF00
      elseif (mlgeninp%lgrad .eq. 1) then
         call mlghook(progrms, mlgeninp%geom,
     *       mcinp, mgswit, hfmoinp,
     *       mcoptl, sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp,
     *       g2inp, mg2inp, g3inp, mg3inp, mqcinp,mcomp2inp,mccoinp,    0712BL02
     *       g3sxmp3inp,mc3bbinp, mc3mpwinp,
     *       limohc, imohcinp,ltest,tmeth,tbas,toptl,ierr)              0106PF00
      elseif (mlgeninp%lener .eq. 1) then
         call mlehook(progrms, mlgeninp%geom, mcinp, mgswit, hfmoinp, 
     *       mcoptl, sacinp, mcsinp, ibinp, mcoinp, mnminp, mutinp, 
     *       g2inp, mg2inp, g3inp, mg3inp, mqcinp, mcomp2inp,mccoinp,   0712BL02
     *       g3sxmp3inp, mc3bbinp, mc3mpwinp,                           1012YZ03
     *       limohc, imohcinp,ltest, tmeth, tbas, toptl, ierr)          0106PF00
      endif

      write(outfile,1070)
1070  format(//,80('-'),/80('-')/)
      write(*,*)

c
c     write summary file for interface program MultilevelRate           0418PJ01
c
      if (mlgeninp%lprsum .eq. 1) then                                  0418PJ01
          open (unit=sumfile, file=mlsum, status='unknown',             0418PJ01
     *          form='formatted', err=4000)                             0418PJ01

          if ( mlgeninp%lhess .eq. 1) then                              0418PJ01
              prtype = thess                                            0418PJ01
          else if (mlgeninp%lgrad .eq. 1) then                          0418PJ01
              prtype = tgrad                                            0418PJ01
          else if (mlgeninp%lener .eq. 1) then                          0418PJ01
              prtype = tener                                            0418PJ01
          end if                                                        0418PJ01

          call sumdisp(mlgeninp%geom, 3*mlgeninp%geom%natoms, prtype,   0418PJ01
     *                 ltest, limohc, hfmoinp, mcinp, mgswit)           0418PJ01
      end if


      goto 9999


4000  write(*,'(/a)') 'ERROR: Cannot open the summary file.'            0418PJ01
      close(sumfile)                                                    0418PJ01
      close(outfile)                                                    0418PJ01
      close(infile)                                                     0418PJ01
      stop 'main 3'                                                     0418PJ01


5000  write (*,'(/a)') 'ERROR: Cannot open the input file.'
      close (infile)
      close (outfile)
      stop 'main 2'

6000  write (*,'(/a)') 'ERROR: Cannot open the output file.'
      close (outfile)
      stop 'main 1'

7000  write (outfile,'(/a)') 'ERROR: External Optimization failed.'
      goto 9999

8000  write (outfile,'(/a)') 'ERROR: Multilevel Optimization failed.'
      goto 9999

9999  close (infile)
      close (outfile)

      if (mlgeninp%lprsum .eq. 1) then
           close (sumfile)                                              0418PJ01
      end if

      end
