c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine initrot  --  set bonds for dihedral rotation  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "initrot" asks for torsional angles which are to be rotated
c     in subsequent computation, it will automatically locate all
c     rotatable single bonds if desired; assumes that an appropriate
c     internal coordinates file has already been read in
c
c
      subroutine initrot
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'couple.i'
      include 'iounit.i'
      include 'math.i'
      include 'omega.i'
      include 'ring.i'
      include 'zcoord.i'
      integer i,j,k,j1,j2,mode
      integer bond1,bond2
      integer attach1,attach2
      integer nfixed,ifixed(2,maxbnd)
      integer list(maxatm)
      character*80 record,string
      logical exist,query
      logical rotate,rotcheck
c
c
c     initialize the number of rotatable torsional angles
c
      nomega = 0
c
c     choose automatic or manual selection of torsional angles
c
      mode = 0
      query = .true.
      call nextarg (string,exist)
      if (exist) then
         read (string,*,err=10,end=10)  mode
         query = .false.
      end if
   10 continue
      if (query) then
         write (iout,20)
   20    format (/,' Selection of Torsional Angles for Rotation :',
     &           //,'    0  - Automatic Selection of Torsional Angles',
     &            /,'    1  - Manual Selection of Angles to Rotate',
     &            /,'    2  - Manual Selection of Angles to Freeze',
     &           //,' Enter the Method of Choice [0] :  ',$)
         read (input,30)  mode
   30    format (i10)
      end if
      if (mode.ne.1 .and. mode.ne.2)  mode = 0
c
c     manual selection of the torsional angles to be rotated
c
      if (mode .eq. 1) then
         dowhile (nomega .lt. maxrot)
            nomega = nomega + 1
            j1 = 0
            j2 = 0
            write (iout,40)  nomega
   40       format (/,' Enter Atoms in Rotatable Bond',i5,' :  ',$)
            read (input,50)  record
   50       format (a80)
            read (record,*,err=80,end=80)  j1,j2
            if (j1.eq.0 .and. j2.eq.0)  goto 80
            do i = 4, n
               if (iz(4,i) .eq. 0) then
                  bond1 = iz(1,i)
                  bond2 = iz(2,i)
                  attach1 = n12(bond1)
                  attach2 = n12(bond2)
                  if (attach1.gt.1 .and. attach2.gt.1) then
                     if ((bond1.eq.j1 .and. bond2.eq.j2) .or.
     &                   (bond1.eq.j2 .and. bond2.eq.j1)) then
                        if (rotcheck(bond1,bond2)) then
                           iomega(1,nomega) = bond1
                           iomega(2,nomega) = bond2
                           dihed(nomega) = bet(i) / radian
                           zline(nomega) = i
                           goto 70
                        end if
                     end if
                  end if
               end if
            end do
            nomega = nomega - 1
            write (iout,60)  j1,j2
   60       format (/,' INITROT  --  Bond between Atoms',2i6,
     &                 ' is not Rotatable')
   70       continue
         end do
   80    continue
         nomega = nomega - 1
      end if
c
c     manual selection of the torsional angles to be frozen
c
      nfixed = 0
      if (mode .eq. 2) then
         do i = 1, maxrot
            ifixed(1,i) = 0
            ifixed(2,i) = 0
            write (iout,90)  i
   90       format (/,' Enter Atoms in Frozen Bond',i5,' :  ',$)
            read (input,100)  record
  100       format (a80)
            read (record,*,err=110,end=110)  ifixed(1,i),ifixed(2,i)
            if (ifixed(1,i).eq.0 .and. ifixed(2,i).eq.0)  goto 110
            nfixed = nfixed + 1
         end do
  110    continue
      end if
c
c     perform the automatic selection of torsional angles to rotate
c
      if (mode.eq.0 .or. mode.eq.2) then
         do i = 4, n
            if (iz(4,i) .eq. 0) then
               rotate = .true.
               bond1 = iz(1,i)
               bond2 = iz(2,i)
c
c     do not rotate a bond if either bonded atom is univalent
c
               attach1 = n12(bond1)
               attach2 = n12(bond2)
               if (attach1.le.1 .or. attach2.le.1)  rotate = .false.
c
c     do not rotate if both atoms of bond are in a small ring
c
               do j = 1, n
                  list(j) = 0
               end do
               do j = 1, nring3
                  do k = 1, 3
                     list(iring3(k,j)) = j
                  end do
                  if (list(bond1).eq.j .and. list(bond2).eq.j) then
                     rotate = .false.
                     goto 120
                  end if
               end do
               do j = 1, n
                  list(j) = 0
               end do
               do j = 1, nring4
                  do k = 1, 4
                     list(iring4(k,j)) = j
                  end do
                  if (list(bond1).eq.j .and. list(bond2).eq.j) then
                     rotate = .false.
                     goto 120
                  end if
               end do
               do j = 1, n
                  list(j) = 0
               end do
               do j = 1, nring5
                  do k = 1, 5
                     list(iring5(k,j)) = j
                  end do
                  if (list(bond1).eq.j .and. list(bond2).eq.j) then
                     rotate = .false.
                     goto 120
                  end if
               end do
               do j = 1, n
                  list(j) = 0
               end do
               do j = 1, nring6
                  do k = 1, 6
                     list(iring6(k,j)) = j
                  end do
                  if (list(bond1).eq.j .and. list(bond2).eq.j) then
                     rotate = .false.
                     goto 120
                  end if
               end do
  120          continue
c
c     do not rotate bonds explicitly frozen by the user
c
               if (mode.eq.2 .and. rotate) then
                  do j = 1, nfixed
                     j1 = ifixed(1,j)
                     j2 = ifixed(2,j)
                     if ((bond1.eq.j1 .and. bond2.eq.j2) .or.
     &                   (bond1.eq.j2 .and. bond2.eq.j1)) then
                        rotate = .false.
                        goto 130
                     end if
                  end do
               end if
  130          continue
c
c     do not rotate bonds with inactive atoms on both sides
c
               if (rotate) then
                  if (.not. rotcheck(bond1,bond2))  rotate = .false.
               end if
c
c     check for possible duplication of rotatable bonds
c
               if (rotate) then
                  do j = 1, nomega
                     j1 = iomega(1,j)
                     j2 = iomega(2,j)
                     if ((bond1.eq.j1 .and. bond2.eq.j2) .or.
     &                   (bond1.eq.j2 .and. bond2.eq.j1)) then
                        write (iout,140)  bond1,bond2
  140                   format (/,' INITROT  --  Rotation about',2i6,
     &                             ' occurs more than once in Z-matrix')
                        call fatal
                     end if
                  end do
                  nomega = nomega + 1
                  iomega(1,nomega) = bond1
                  iomega(2,nomega) = bond2
                  dihed(nomega) = bet(i) / radian
                  zline(nomega) = i
               end if
            end if
         end do
      end if
c
c     write out the number of rotatable torsions to be used
c
      if (nomega .eq. 0) then
         write (iout,150)
  150    format (/,' INITROT  --  No Torsions for Subsequent',
     &              ' Computation')
         call fatal
      else if (nomega .gt. maxrot) then
         write (iout,160)
  160    format (/,' INITROT  --  Too many Torsions;',
     &              ' Increase MAXROT')
         call fatal
      end if
      write (iout,170)  nomega
  170 format (/,' Number of Torsions Used in Derivative',
     &           ' Computation :',i6)
      return
      end
c
c
c     ################################################################
c     ##                                                            ##
c     ##  function rotcheck  --  check for fixed atoms across bond  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "rotcheck" tests a specified candidate rotatable bond for
c     the disallowed case where inactive atoms are found on both
c     sides of the candidate bond
c
c
      function rotcheck (base,partner)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'rotate.i'
      include 'usage.i'
      integer i,base,partner
      logical rotcheck,value
      logical list(maxatm)
c
c
c     initialize status and find atoms on short side of the bond
c
      value = .true.
      call rotlist (base,partner)
c
c     rotation is allowed if all atoms on one side are active
c
      do i = 1, nrot
         if (.not. use(rot(i))) then
            value = .false.
            goto 10
         end if
      end do
   10 continue
c
c     if short side had inactive atoms, check the other side
c
      if (.not. value) then
         do i = 1, n
            list(i) = .true.
         end do
         do i = 1, nrot
            list(rot(i)) = .false.
         end do
         do i = 1, n
            if (list(i) .and. .not.use(i))  goto 20
         end do
         value = .true.
   20    continue
      end if
c
c     set the final return value of the function
c
      rotcheck = value
      return
      end
