c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #############################################################
c     ##                                                         ##
c     ##  subroutine makeint  --  convert Cartesian to internal  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "makeint" converts Cartesian to internal coordinates where
c     selection of internal coordinates is controlled by "mode"
c
c        mode = 0     automatic internal coordinates
c        mode = 1     manual selection of coordinates
c        mode = 2     use existing structure as a template
c        mode = 3     use dihedral angles in all cases
c
c
      subroutine makeint (mode)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'couple.i'
      include 'iounit.i'
      include 'math.i'
      include 'zclose.i'
      include 'zcoord.i'
      integer i,j,i1,i2,i3,i4,i5
      integer adjacent,next,mode
      integer iz0(0:maxatm),iz1(maxatm)
      real*8 bndangle,dihedral,sign
      character*1 answer,default
      character*8 phrase
      logical more
c
c
c     zero out the values of the local defining atoms
c
      i1 = 0
      i2 = 0
      i3 = 0
      i4 = 0
      i5 = 0
      iz0(0) = 0
      do i = 1, n
         iz0(i) = 0
         iz1(i) = 0
      end do
c
c     zero out the final internal coordinate values
c
      if (mode .ne. 2) then
         do i = 1, n
            do j = 1, 4
               iz(j,i) = 0
            end do
         end do
      end if
      do i = 1, n
         blen(i) = 0.0d0
         alph(i) = 0.0d0
         bet(i) = 0.0d0
      end do
c
c     first, decide which of the atoms to define next
c
      do i = 1, n
         if (mode .eq. 1) then
            next = i1 + 1
   10       continue
            write (iout,20)  next
   20       format (/,' Atom Number to be Defined [',i5,'] :  ',$)
            read (input,30,err=10)  i1
   30       format (i10)
            if (i1 .eq. 0)  i1 = next
            if (iz0(i1) .ne. 0) then
               write (iout,40)
   40          format (/,' Already done that Atom; Choose Another')
               if (i1 .eq. next)  next = next + 1
               goto 10
            end if
         else
            i1 = i
         end if
c
c     define the bond length for the current atom
c
         if (i .ge. 2) then
            if (mode .ne. 2) then
               i2 = adjacent (i1,0,mode,more,iz0,iz1)
               if (i2 .eq. 0) then
                  write (iout,50)  i1
   50             format (/,' MAKEINT  --  Connectivity Error',
     &                       ' defining Atom',i6)
                  call fatal
               end if
            else if (mode .eq. 2) then
               i2 = iz(1,i1)
            end if
            blen(i1) = sqrt((x(i1)-x(i2))**2 + (y(i1)-y(i2))**2
     &                             + (z(i1)-z(i2))**2)
         end if
c
c     define the bond angle for the current atom
c
         if (i .ge. 3) then
            if (mode .ne. 2) then
               i3 = adjacent (i2,i1,mode,more,iz0,iz1)
               if (i3 .eq. 0) then
                  write (iout,60)  i1
   60             format (/,' MAKEINT  --  Connectivity Error',
     &                       ' defining Atom',i6)
                  call fatal
               end if
            else if (mode .eq. 2) then
               i3 = iz(2,i1)
            end if
            alph(i1) = bndangle (i1,i2,i3)
         end if
c
c     decide whether to use a dihedral or second bond angle;
c     then find the value of the angle
c
         if (i .ge. 4) then
            if (mode .eq. 1) then
               if (more) then
                  phrase = 'D or [B]'
                  default = 'B'
               else
                  phrase = '[D] or B'
                  default = 'D'
               end if
               write (iout,70)  phrase
   70          format (/,' Specify with Dihedral Angle or Second',
     &                    ' Bond Angle (',a8,') :  ',$)
               read (input,80)  answer
   80          format (a1)
               call upcase (answer)
               if (answer.ne.'B' .and. answer.ne.'D')  answer = default
            else if (mode .eq. 0) then
               if (more) then
                  answer = 'B'
               else
                  answer = 'D'
               end if
            else if (mode .eq. 2) then
               if (iz(4,i1) .eq. 0) then
                  answer = 'D'
               else
                  answer = 'B'
               end if
            else if (mode .eq. 3) then
               answer = 'D'
            end if
            if (answer .eq. 'B') then
               if (mode .ne. 2) then
                  i4 = adjacent (i2,i3,mode,more,iz0,iz1)
                  if (i4 .eq. 0) then
                     write (iout,90)  i1
   90                format (/,' MAKEINT  --  Connectivity Error',
     &                          ' defining Atom',i6)
                     call fatal
                  end if
               else if (mode .eq. 2) then
                  i4 = iz(3,i1)
               end if
               bet(i1) = bndangle (i1,i2,i4)
               i5 = 1
               sign = dihedral (i1,i2,i3,i4)
               if (sign .gt. 0.0d0)  i5 = -1
            else if (answer .eq. 'D') then
               if (mode .ne. 2) then
                  i4 = adjacent (i3,i2,mode,more,iz0,iz1)
                  if (i4 .eq. 0) then
                     write (iout,100)  i1
  100                format (/,' MAKEINT  --  Connectivity Error',
     &                          ' defining Atom',i6)
                     call fatal
                  end if
               else if (mode .eq. 2) then
                  i4 = iz(3,i1)
               end if
               i5 = 0
               bet(i1) = dihedral (i1,i2,i3,i4)
            end if
         end if
c
c     transfer defining atoms to permanent array;
c     mark the current atom as finished
c
         iz(1,i1) = iz0(i2)
         iz(2,i1) = iz0(i3)
         iz(3,i1) = iz0(i4)
         iz(4,i1) = i5
         iz0(i1) = i
         iz1(i1) = i2
      end do
c
c     add any bonds needed to make ring closures
c
      nadd = 0
      do i = 1, n
         do j = 1, n12(i)
            if (iz0(i) .lt. iz0(i12(j,i)) .and.
     &          iz1(i12(j,i)) .ne. i) then
               nadd = nadd + 1
               iadd(1,nadd) = iz0(i)
               iadd(2,nadd) = iz0(i12(j,i))
            end if
         end do
      end do
      return
      end
