c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine kangle  --  angle bend parameter assignment  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "kangle" assigns the force constants and ideal angles for
c     the bond angles; also processes new or changed parameters
c
c
      subroutine kangle
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'couple.i'
      include 'inform.i'
      include 'iounit.i'
      include 'kangs.i'
      include 'keys.i'
      include 'potent.i'
      include 'ring.i'
      integer i,j,k,iring,next,size
      integer ia,ib,ic,id,ita,itb,itc
      integer jen,ih,nh,minatomic
      real*8 fc,an1,an2,an3
      character*3 pa,pb,pc
      character*9 pt
      character*20 keyword
      character*80 record,string
      logical header,use_ring3
      logical use_ring4,use_ring5
c
c
c     process keywords containing bond angle bending parameters
c
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         iring = -1
         if (keyword(1:6) .eq. 'ANGLE ')  iring = 0
         if (keyword(1:7) .eq. 'ANGLE5 ')  iring = 5
         if (keyword(1:7) .eq. 'ANGLE4 ')  iring = 4
         if (keyword(1:7) .eq. 'ANGLE3 ')  iring = 3
         if (iring .ge. 0) then
            ia = 0
            ib = 0
            ic = 0
            fc = 0.0d0
            an1 = 0.0d0
            an2 = 0.0d0
            an3 = 0.0d0
            jen = 0
            string = record(next:80)
            read (string,*,err=10,end=10)  ia,ib,ic,fc,an1,an2,an3
   10       continue
            if (an2.ne.0.0d0 .or. an3.ne.0.0d0)  jen = 1
            if (header) then
               header = .false.
               write (iout,20)
   20          format (/,' Additional Angle Bending Parameters :',
     &                 //,5x,'Atom Classes',9x,'K(B)',7x,'Angle',/)
            end if
            if (iring .eq. 0) then
               if (jen .eq. 0) then
                  write (iout,30)  ia,ib,ic,fc,an1
   30             format (4x,3i4,2x,2f12.3)
               else if (an1 .ne. 0.0d0) then
                  write (iout,40)  ia,ib,ic,fc,an1
   40             format (4x,3i4,2x,2f12.3,3x,'0-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,50)  ia,ib,ic,fc,an2
   50             format (4x,3i4,2x,2f12.3,3x,'1-H''s')
               end if
               if (an3 .ne. 0.0d0) then
                  write (iout,60)  ia,ib,ic,fc,an3
   60             format (4x,3i4,2x,2f12.3,3x,'2-H''s')
               end if
            else if (iring .eq. 5) then
               if (jen .eq. 0) then
                  write (iout,70)  ia,ib,ic,fc,an1
   70             format (4x,3i4,2x,2f12.3,3x,'5-Ring')
               else if (an1 .ne. 0.0d0) then
                  write (iout,80)  ia,ib,ic,fc,an1
   80             format (4x,3i4,2x,2f12.3,3x,'5-Ring',3x,'0-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,90)  ia,ib,ic,fc,an2
   90             format (4x,3i4,2x,2f12.3,3x,'5-Ring',3x,'1-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,100)  ia,ib,ic,fc,an3
  100             format (4x,3i4,2x,2f12.3,3x,'5-Ring',3x,'2-H''s')
               end if
            else if (iring .eq. 4) then
               if (jen .eq. 0) then
                  write (iout,110)  ia,ib,ic,fc,an1
  110             format (4x,3i4,2x,2f12.3,3x,'4-Ring')
               else if (an1 .ne. 0.0d0) then
                  write (iout,120)  ia,ib,ic,fc,an1
  120             format (4x,3i4,2x,2f12.3,3x,'4-Ring',3x,'0-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,130)  ia,ib,ic,fc,an2
  130             format (4x,3i4,2x,2f12.3,3x,'4-Ring',3x,'1-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,140)  ia,ib,ic,fc,an3
  140             format (4x,3i4,2x,2f12.3,3x,'4-Ring',3x,'2-H''s')
               end if
            else if (iring .eq. 3) then
               if (jen .eq. 0) then
                  write (iout,150)  ia,ib,ic,fc,an1
  150             format (4x,3i4,2x,2f12.3,3x,'3-Ring')
               else if (an1 .ne. 0.0d0) then
                  write (iout,160)  ia,ib,ic,fc,an1
  160             format (4x,3i4,2x,2f12.3,3x,'3-Ring',3x,'0-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,170)  ia,ib,ic,fc,an2
  170             format (4x,3i4,2x,2f12.3,3x,'3-Ring',3x,'1-H''s')
               end if
               if (an2 .ne. 0.0d0) then
                  write (iout,180)  ia,ib,ic,fc,an3
  180             format (4x,3i4,2x,2f12.3,3x,'3-Ring',3x,'2-H''s')
               end if
            end if
            size = 3
            call numeral (ia,pa,size)
            call numeral (ib,pb,size)
            call numeral (ic,pc,size)
            if (ia .le. ic) then
               pt = pa//pb//pc
            else
               pt = pc//pb//pa
            end if
            if (iring .eq. 0) then
               do j = 1, maxna
                  if (ka(j).eq.'         ' .or. ka(j).eq.pt) then
                     ka(j) = pt
                     con(j) = fc
                     ang(1,j) = an1
                     ang(2,j) = an2
                     ang(3,j) = an3
                     goto 230
                  end if
               end do
               write (iout,190)
  190          format (/,' KANGLE  --  Too many Bond Angle',
     &                       ' Bending Parameters')
               abort = .true.
            else if (iring .eq. 5) then
               do j = 1, maxna5
                  if (ka5(j).eq.'         ' .or. ka5(j).eq.pt) then
                     ka5(j) = pt
                     con5(j) = fc
                     ang5(1,j) = an1
                     ang5(2,j) = an2
                     ang5(3,j) = an3
                     goto 230
                  end if
               end do
               write (iout,200)
  200          format (/,' KANGLE  --  Too many 5-Ring Angle',
     &                       ' Bending Parameters')
               abort = .true.
            else if (iring .eq. 4) then
               do j = 1, maxna4
                  if (ka4(j).eq.'         ' .or. ka4(j).eq.pt) then
                     ka4(j) = pt
                     con4(j) = fc
                     ang4(1,j) = an1
                     ang4(2,j) = an2
                     ang4(3,j) = an3
                     goto 230
                  end if
               end do
               write (iout,210)
  210          format (/,' KANGLE  --  Too many 4-Ring Angle',
     &                       ' Bending Parameters')
               abort = .true.
            else if (iring .eq. 3) then
               do j = 1, maxna3
                  if (ka3(j).eq.'         ' .or. ka3(j).eq.pt) then
                     ka3(j) = pt
                     con3(j) = fc
                     ang3(1,j) = an1
                     ang3(2,j) = an2
                     ang3(3,j) = an3
                     goto 230
                  end if
               end do
               write (iout,220)
  220          format (/,' KANGLE  --  Too many 3-Ring Angle',
     &                       ' Bending Parameters')
               abort = .true.
            end if
  230       continue
         end if
      end do
c
c     set generic parameters for use with any number of hydrogens
c
      do j = 1, maxna
         if (ka(j) .eq. '         ')  goto 240
         if (ang(2,j).eq.0.0d0 .and. ang(3,j).eq.0.0d0) then
            ang(2,j) = ang(1,j)
            ang(3,j) = ang(1,j)
         end if
      end do
  240 continue
      do j = 1, maxna5
         if (ka5(j) .eq. '         ')  goto 250
         if (ang5(2,j).eq.0.0d0 .and. ang5(3,j).eq.0.0d0) then
            ang5(2,j) = ang5(1,j)
            ang5(3,j) = ang5(1,j)
         end if
      end do
  250 continue
      do j = 1, maxna4
         if (ka4(j) .eq. '         ')  goto 260
         if (ang4(2,j).eq.0.0d0 .and. ang4(3,j).eq.0.0d0) then
            ang4(2,j) = ang4(1,j)
            ang4(3,j) = ang4(1,j)
         end if
      end do
  260 continue
      do j = 1, maxna3
         if (ka3(j) .eq. '         ')  goto 270
         if (ang3(2,j).eq.0.0d0 .and. ang3(3,j).eq.0.0d0) then
            ang3(2,j) = ang3(1,j)
            ang3(3,j) = ang3(1,j)
         end if
      end do
  270 continue
c
c     use small rings if present and parameters are available
c
      if (nring3.eq.0 .or. ka3(1).eq.'         ') then
         use_ring3 = .false.
      else
         use_ring3 = .true.
      end if
      if (nring4.eq.0 .or. ka4(1).eq.'         ') then
         use_ring4 = .false.
      else
         use_ring4 = .true.
      end if
      if (nring5.eq.0 .or. ka5(1).eq.'         ') then
         use_ring5 = .false.
      else
         use_ring5 = .true.
      end if
c
c     loop over all angles assigning the necessary constants
c
      header = .true.
      do i = 1, nangle
         ia = iang(1,i)
         ib = iang(2,i)
         ic = iang(3,i)
         ita = class(ia)
         itb = class(ib)
         itc = class(ic)
         minatomic = min(atomic(ia),atomic(ib),atomic(ic))
         size = 3
         call numeral (ita,pa,size)
         call numeral (itb,pb,size)
         call numeral (itc,pc,size)
         if (ita .le. itc) then
            pt = pa//pb//pc
         else
            pt = pc//pb//pa
         end if
         acon(i) = 0.0d0
         anat(i) = 0.0d0
c
c     count number of non-angle hydrogens on the central atom
c
         nh = 1
         do j = 1, n12(ib)
            ih = i12(j,ib)
            if (ih.ne.ia .and. ih.ne.ic .and. atomic(ih).eq.1)
     &         nh = nh + 1
         end do
c
c     make a check for bond angles inside small rings
c
         iring = 0
         if (n12(ia).eq.1 .or. n12(ic).eq.1)  goto 280
         if (use_ring3) then
            do j = 1, n12(ia)
               if (ic .eq. i12(j,ia)) then
                  iring = 3
                  goto 280
               end if
            end do
         end if
         if (use_ring4) then
            do j = 1, n12(ia)
               id = i12(j,ia)
               if (ib .ne. id) then
                  do k = 1, n12(ic)
                     if (id .eq. i12(k,ic)) then
                        iring = 4
                        goto 280
                     end if
                  end do
               end if
            end do
         end if
         if (use_ring5) then
            do j = 1, n12(ia)
               id = i12(j,ia)
               if (ib .ne. id) then
                  do k = 1, n13(ic)
                     if (id .eq. i13(k,ic)) then
                        iring = 5
                        goto 280
                     end if
                  end do
               end if
            end do
         end if
  280    continue
c
c     assign angle bending parameters for each bond angle
c
         if (iring .eq. 0) then
            do j = 1, maxna
               if (ka(j).eq.pt .and. ang(nh,j).ne.0.0d0) then
                  acon(i) = con(j)
                  anat(i) = ang(nh,j)
                  goto 310
               end if
            end do
            if (minatomic .ne. 0) then
               abort = .true.
               if (header) then
                  header = .false.
                  write (iout,290)
  290             format (/,' Undefined Angle Bending Parameters :',
     &                    //,' Type',18x,'Atom Names',19x,
     &                       'Atom Classes',/)
               end if
               write (iout,300)  ia,name(ia),ib,name(ib),ic,name(ic),
     &                           ita,itb,itc
  300          format (' Angle',6x,3(i6,'-',a3),7x,3i5)
            end if
  310       continue
c
c     assign bending parameters for 5-membered ring angles
c
         else if (iring .eq. 5) then
            do j = 1, maxna5
               if (ka5(j).eq.pt .and. ang5(nh,j).ne.0.0d0) then
                  acon(i) = con5(j)
                  anat(i) = ang5(nh,j)
                  goto 340
               end if
            end do
            if (minatomic .ne. 0) then
               abort = .true.
               if (header) then
                  header = .false.
                  write (iout,320)
  320             format (/,' Undefined Angle Bending Parameters :',
     &                    //,' Type',18x,'Atom Names',19x,
     &                       'Atom Classes',/)
               end if
               write (iout,330)  ia,name(ia),ib,name(ib),ic,name(ic),
     &                           ita,itb,itc
  330          format (' 5-Ring',5x,3(i6,'-',a3),7x,3i5)
            end if
  340       continue
c
c     assign bending parameters for 4-membered ring angles
c
         else if (iring .eq. 4) then
            do j = 1, maxna4
               if (ka4(j).eq.pt .and. ang4(nh,j).ne.0.0d0) then
                  acon(i) = con4(j)
                  anat(i) = ang4(nh,j)
                  goto 370
               end if
            end do
            if (minatomic .ne. 0) then
               abort = .true.
               if (header) then
                  header = .false.
                  write (iout,350)
  350             format (/,' Undefined Angle Bending Parameters :',
     &                    //,' Type',18x,'Atom Names',19x,
     &                       'Atom Classes',/)
               end if
               write (iout,360)  ia,name(ia),ib,name(ib),ic,name(ic),
     &                           ita,itb,itc
  360          format (' 4-Ring',5x,3(i6,'-',a3),7x,3i5)
            end if
  370       continue
c
c     assign bending parameters for 3-membered ring angles
c
         else if (iring .eq. 3) then
            do j = 1, maxna3
               if (ka3(j).eq.pt .and. ang3(nh,j).ne.0.0d0) then
                  acon(i) = con3(j)
                  anat(i) = ang3(nh,j)
                  goto 400
               end if
            end do
            if (minatomic .ne. 0) then
               abort = .true.
               if (header) then
                  header = .false.
                  write (iout,380)
  380             format (/,' Undefined Angle Bending Parameters :',
     &                    //,' Type',18x,'Atom Names',19x,
     &                       'Atom Classes',/)
               end if
               write (iout,390)  ia,name(ia),ib,name(ib),ic,name(ic),
     &                           ita,itb,itc
  390          format (' 3-Ring',5x,3(i6,'-',a3),7x,3i5)
            end if
  400       continue
         end if
      end do
c
c     if no angle bend terms are used, turn off the potential
c
      if (nangle .eq. 0)  use_angle = .false.
      return
      end
