      program ambfor
c
c  AMBER General Force Field for organic mol. (June, 2003)
c  The AMBFOR implementation:
c  
c   1 X   Placeholder for wildcard
c   2 c   Sp2 C carbonyl group 
c   3 c1  Sp C
c   4 c2  Sp2 C  
c   5 c3  Sp3 C
c   6 ca  Sp2 C in pure aromatic systems
c   7 cp  Head Sp2 C that connect two rings in biphenyl sys. 
c   8 cq  Head Sp2 C that connect two rings in biphenyl sys. identical to cp 
c   9 cc  Sp2 carbons in non-pure aromatic systems
c  10 cd  Sp2 carbons in non-pure aromatic systems, identical to cc
c  11 ce  Inner Sp2 carbons in conjugated systems
c  12 cf  Inner Sp2 carbons in conjugated systems, identical to ce
c  13 cg  Inner Sp carbons in conjugated systems
c  14 ch  Inner Sp carbons in conjugated systems, identical to cg
c  15 cx  Sp3 carbons in triangle systems
c  16 cy  Sp3 carbons in square systems
c  17 cu  Sp2 carbons in triangle systems
c  18 cv  Sp2 carbons in square systems
c  19 h1  H bonded to aliphatic carbon with 1 electrwd. group  
c  20 h2  H bonded to aliphatic carbon with 2 electrwd. group 
c  21 h3  H bonded to aliphatic carbon with 3 electrwd. group 
c  22 h4  H bonded to non-sp3 carbon with 1 electrwd. group 
c  23 h5  H bonded to non-sp3 carbon with 2 electrwd. group 
c  24 ha  H bonded to aromatic carbon  
c  25 hc  H bonded to aliphatic carbon without electrwd. group 
c  26 hn  H bonded to nitrogen atoms
c  27 ho  Hydroxyl group
c  28 hp  H bonded to phosphate 
c  29 hs  Hydrogen bonded to sulphur 
c  30 hw  Hydrogen in water 
c  31 hx  H bonded to C next to positively charged group  
c  32 f   Fluorine
c  33 cl  Chlorine 
c  34 br  Bromine 
c  35 i   Iodine 
c  36 n   Sp2 nitrogen in amide groups
c  37 n1  Sp N  
c  38 n2  aliphatic Sp2 N with two connected atoms 
c  39 n3  Sp3 N with three connected atoms
c  40 n4  Sp3 N with four connected atoms 
c  41 na  Sp2 N with three connected atoms 
c  42 nb  Sp2 N in pure aromatic systems 
c  43 nc  Sp2 N in non-pure aromatic systems
c  44 nd  Sp2 N in non-pure aromatic systems, identical to nc
c  45 ne  Inner Sp2 N in conjugated systems
c  46 nf  Inner Sp2 N in conjugated systems, identical to ne
c  47 nh  Amine N connected one or more aromatic rings 
c  48 no  Nitro N  
c  49 o   Oxygen with one connected atom
c  50 oh  Oxygen in hydroxyl group
c  51 os  Ether and ester oxygen
c  52 ow  Oxygen in water 
c  53 p2  Phosphate with two connected atoms 
c  54 p3  Phosphate with three connected atoms, such as PH3
c  55 p4  Phosphate with three connected atoms, such as O=P(CH3)2
c  56 p5  Phosphate with four connected atoms, such as O=P(OH)3
c  57 pb  Sp2 P in pure aromatic systems 
c  58 pc  Sp2 P in non-pure aromatic systems
c  59 pd  Sp2 P in non-pure aromatic systems, identical to pc
c  60 pe  Inner Sp2 P in conjugated systems
c  61 pf  Inner Sp2 P in conjugated systems, identical to pe
c  62 px  Special p4 in conjugated systems
c  63 py  Special p5 in conjugated systems
c  64 s   S with one connected atom 
c  65 s2  S with two connected atom, involved at least one double bond  
c  66 s4  S with three connected atoms 
c  67 s6  S with four connected atoms 
c  68 sh  Sp3 S connected with hydrogen 
c  69 ss  Sp3 S in thio-ester and thio-ether
c  70 sx  Special s4 in conjugated systems
c  71 sy  Special s6 in conjugated systems
c
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxamb=701)
      parameter (mxgff=71)
      character line*132,fniun*132
      character argstr*75
      logical opfil,gargpl,osingl
      common /fnam/ fniun, lenf
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      common /opts/ idebug,imon,iarc,ilog,osingl
      character*3 ambstr
      character*2 gffstr
      common /ffstr/ ambstr(mxamb), gffstr(mxgff)
      data (ambstr(i),i=1,100) /
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','HC ','N  ','CT ','C  ','H  ','O  ','H1 ',
     & 'CT ','HC ','CT ','HC ','CT ','HC ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','HC ','CT ','HC ','CT ','HC ','CT ','HC ',
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ','CT ','HC ',
     & 'CT ','HC ','CT ','HC ','N  ','CT ','C  ','H  ','O  ','H1 ',
     & 'CT ','H1 ','OH ','HO ','N  ','CT ','C  ','H  ','O  ','H1 ',
     & 'CT ','H1 ','OH ','HO ','CT ','HC ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','H1 ','SH ','HS ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','H1 ','S  ','N  ','CT ','C  ','O  ','H1 '/
      data (ambstr(i),i=101,200) /
     & 'CT ','HC ','CT ','HC ','CT ','H1 ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','HC ','CA ','CA ','HA ','CA ','HA ','CA ',
     & 'HA ','N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ','CA ',
     & 'CA ','HA ','CA ','HA ','C  ','OH ','HO ','N  ','CT ','C  ',
     & 'H  ','O  ','H1 ','CT ','HC ','C* ','CW ','H4 ','CB ','NA ',
     & 'H  ','CN ','CA ','HA ','CA ','HA ','CA ','HA ','CA ','HA ',
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ','CC ','NA ',
     & 'H  ','CW ','H4 ','CR ','H5 ','NA ','H  ','N  ','CT ','C  ',
     & 'H  ','O  ','H1 ','CT ','HC ','CC ','NA ','H  ','CV ','H4 ',
     & 'CR ','H5 ','NB ','N  ','CT ','C  ','H  ','O  ','H1 ','CT '/
      data (ambstr(i),i=201,300) /
     & 'HC ','CC ','NB ','CW ','H4 ','CR ','H5 ','NA ','H  ','N  ',
     & 'CT ','C  ','H  ','O  ','H1 ','CT ','HC ','C  ','O2 ','N  ',
     & 'CT ','C  ','H  ','O  ','H1 ','CT ','HC ','C  ','O  ','N  ',
     & 'H  ','N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ','CT ',
     & 'HC ','C  ','O2 ','N  ','CT ','C  ','H  ','O  ','H1 ','CT ',
     & 'HC ','CT ','HC ','C  ','O  ','N  ','H  ','N  ','CT ','C  ',
     & 'H  ','O  ','H1 ','CT ','HC ','CT ','H1 ','S  ','CT ','H1 ',
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ','CT ','HC ',
     & 'CT ','HC ','CT ','HP ','N3 ','H  ','N  ','CT ','C  ','H  ',
     & 'O  ','H1 ','CT ','HC ','CT ','HC ','CT ','H1 ','N2 ','H  '/
      data (ambstr(i),i=301,400) /
     & 'CA ','N2 ','H  ','N  ','CT ','C  ','H  ','O  ','H1 ','CT ',
     & 'HC ','CT ','HC ','CT ','HP ','N3 ','H  ','N  ','CT ','C  ',
     & 'H  ','O  ','CT ','HC ','N  ','CT ','C  ','H  ','O  ','H1 ',
     & 'CT ','HC ','CT ','HC ','C  ','O  ','C  ','H  ','O  ','CT ',
     & 'HC ','C  ','O  ','N  ','H  ','N  ','H  ','CT ','H1 ','N3 ',
     & 'CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ',
     & 'H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ',
     & 'H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ',
     & 'CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ',
     & 'H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  '/
      data (ambstr(i),i=401,500) /
     & 'H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','CT ',
     & 'HP ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ',
     & 'H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ',
     & 'CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ',
     & 'H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ',
     & 'H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ',
     & 'CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ',
     & 'H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ',
     & 'H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  ','H1 ','N3 ',
     & 'CT ','C  ','H  ','O  ','H1 ','N3 ','CT ','C  ','H  ','O  '/
      data (ambstr(i),i=501,600) /
     & 'N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ',
     & 'O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ',
     & 'C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ',
     & 'N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ',
     & 'O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ',
     & 'C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','O2 ','H1 ','N  ',
     & 'CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ',
     & 'H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ',
     & 'H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ',
     & 'CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 '/
      data (ambstr(i),i=601,659) /
     & 'H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ',
     & 'H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ',
     & 'CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ',
     & 'H1 ','N  ','CT ','C  ','H  ','O2 ','H1 ','N  ','CT ','C  ',
     & 'H  ','O2 ','H1 ','N  ','CT ','C  ','H  ','O2 ','OW ','HW ',
     & 'Li+','Na+','K+ ','Rb+','Cs+','Mg+','Ca+','Zn+','Cl-'/

c     some neutral residues

      data (ambstr(i),i=660,671) /
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ',
     & 'C  ','O  ','OH ','HO '/ 
      data (ambstr(i),i=672,685) /
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ',
     & 'CT ','HC ','C  ','O  ','OH ','HO '/ 
      data (ambstr(i),i=686,701) /
     & 'N  ','CT ','C  ','H  ','O  ','H1 ','CT ','HC ',
     & 'CT ','HC ','CT ','HC ','CT ','HP ','N3 ','H  '/ 

c GAFF
      data gffstr /
     &  'x ', 'c ', 'c1', 'c2', 'c3', 'ca', 'cp', 'cq', 'cc', 'cd',
     &  'ce', 'cf', 'cg', 'ch', 'cx', 'cy', 'cu', 'cv', 'h1', 'h2',
     &  'h3', 'h4', 'h5', 'ha', 'hc', 'hn', 'ho', 'hp', 'hs', 'hw',
     &  'hx', 'f ', 'cl', 'br', 'i ', 'n ', 'n1', 'n2', 'n3', 'n4',
     &  'na', 'nb', 'nc', 'nd', 'ne', 'nf', 'nh', 'no', 'o ', 'oh',
     &  'os', 'ow', 'p2', 'p3', 'p4', 'p5', 'pb', 'pc', 'pd', 'pe',
     &  'pf', 'px', 'py', 's ', 's2', 's4', 's6', 'sh', 'ss', 'sx',
     &  'sy'/

      idebug = 0
      osingl = .false.
      imon = 0
      iarc = 0
      ilog = 0
      gtol = 0.01d0
      nsd  = 100000
  
      n = iargc()

      if (idebug.eq.1) then
         if (.not.opfil(61,"log",5,1,0,0)) then
            stop
         endif
      endif

      icnt = 1
      do while (icnt.le.n)
         call getarg(icnt,line)
         if (idebug.eq.1) write(61,*) "=",line,"="
         if (line(1:1).eq.'-') then

            if (line(1:2).eq.'-v') then
               idebug = 1
            elseif (line(1:2).eq.'-m') then
               imon = 1
            elseif (line(1:2).eq.'-n') then
               ilog = 1
            elseif (line(1:2).eq.'-a') then
               iarc = 1
            elseif (line(1:2).eq.'-s') then
               osingl = .true.
            elseif (line(1:2).eq.'-g') then
               if (gargpl('-g',icnt,line,argstr)) then
                  gtol = reada(argstr,1,len(argstr))
               endif
            elseif (line(1:2).eq.'-c') then
               if (gargpl('-c',icnt,line,argstr)) then
                  read(argstr,*) nsd
               endif
            else 
               if (idebug.eq.1) then
                 write(61,*) 'Unknown commandline option '//line(1:2)
               else
                 print*, 'Unknown commandline option '//line(1:2)
                 print*, 
     &           'Usage: ambfor [commandline options] ambfor_file[.xyz]'
                 print*, ' '
                 print*, '  Commandline options:'
                 print*, '    -m     - used in conjuction with molden'
                 print*, '             produces a file per iteration:'
                 print*, '             ambfor_file.001 etc.'
                 print*, '    -n     - write optimisation details to '
                 print*, '             ambfor_file.log'
                 print*, 
     &             '    -a     - concatenate intermediate structures'
                 print*, 
     &             '             into an archive file : ambfor_file.arc'
                 print*, ' '
                 print*, 
     &             'Optimised structure in file ambfor_file_opt.xyz' 
               endif
               stop
            endif

         else

            lenf = index(line,' ')-1
            if (linlen(line).gt.lenf) lenf = linlen(line)
            call fndchr(line(1:lenf),lenf,'.',idot)
            call fndchr(line(1:lenf),lenf,'/',isl)
            if (idot.gt.0.and.idot.gt.isl) then
               fniun = line(1:idot-1)
            else
               fniun = line(1:linlen(line))
            endif
            lenf = linlen(fniun)
            if (idebug.eq.1) 
     &         write(61,*) fniun(1:lenf),lenf
            call opfiles
            icnt = n

         endif

         icnt = icnt + 1

      end do

      if (idebug.eq.1) then
         write(61,*) "end of argument parsing"
         write(61,*) "gtol=",gtol," nsd=",nsd
         close(61)
      endif

      call param

      call getinp(istat)

      call conn34(istat)

      call bndarr(istat)
      call angarr(istat)
      call itrarr(istat)
      call torarr(istat)
      call asschg

      call optimise(emin,gtol,nsd)

      call wrtout(iun3,emin)
      close(iun3)

      if (iarc.eq.1) close(iun4)
      if (ilog.eq.1) close(iun5)

      end

      subroutine opfiles
      implicit double precision (a-h,o-z)
      common /rdwr/ iun1,iun2,iun3,iun4,iun5
      character fniun*132
      common /fnam/ fniun, lenf
      common /opts/ idebug,imon,iarc,ilog,osingl
      character fniunt*132
      logical opfil, osingl

      fniunt = fniun(1:lenf)//'.xyz'
      lenft = lenf + 4

      if (opfil(48,fniunt,lenft,1,1,0)) then
         iun2 = 48
         fniunt = fniun(1:lenf)//'_opt.xyz'
         lenft = lenf + 7
         if (opfil(50,fniunt,lenft,1,0,0)) then
            iun3 = 50
         else
            print*,'Cant open output file !'//fniunt(1:lenft)
            stop
         endif

         if (iarc.eq.1) then
            fniunt = fniun(1:lenf)//'.arc'
            lenft = lenf + 4
            if (opfil(60,fniunt,lenft,1,0,0)) then
               iun4 = 60
            else
               print*,'Cant find/open arc file !'//fniunt(1:lenft)
               stop
            endif
         endif

         if (ilog.eq.1) then
            fniunt = fniun(1:lenf)//'.log'
            lenft = lenf + 4
            if (opfil(70,fniunt,lenft,1,0,0)) then
               iun5 = 70
            else
               print*,'Cant find/open log file !'//fniunt(1:lenft)
               stop
            endif
         else
            iun5 = 6
         endif

      else
         print*,'Cant find/open file !'//fniunt(1:lenft)
         stop
      endif

      return
      end

      logical function opfil(iun,filenm,lenfn,iform,iold,isil)
      implicit double precision (a-h,o-z)
      character*(*) filenm
      character*7 stat

      opfil = .true.

      if (iold.eq.1) then
          stat = 'old'
      else
          stat = 'unknown'
      endif

      if (lenfn.eq.0.or.filenm.eq.' ') then
          print*, 'Invalid Filename !'
          opfil = .false.
      else
          close(iun)
          if (iform.eq.1) then
             open(unit=iun,form='formatted',file=filenm,
     &               status=stat,err=100)
          else
             open(unit=iun,form='unformatted',file=filenm,
     &               status=stat,err=100)
          endif
      endif

      return

100   print*,'Error Opening File !'

      opfil = .false.
      return
      end
