c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1995  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine kpolar  --  assign polarizability parameters  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "kpolar" assigns atomic dipole polarizabilities to the atoms
c     within the structure and processes any new or changed values
c
c
      subroutine kpolar
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'inform.i'
      include 'iounit.i'
      include 'keys.i'
      include 'kpolr.i'
      include 'mpole.i'
      include 'polar.i'
      include 'polpot.i'
      include 'potent.i'
      integer i,k,next
      real*8 pol,proot,sixth
      character*20 keyword
      character*80 record,string
      logical header
c
c
c     process keywords containing polarizability parameters
c
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:9) .eq. 'POLARIZE ') then
            string = record(next:80)
            read (string,*,err=40,end=40)  k,pol
            if (k .gt. 0) then
               if (header) then
                  header = .false.
                  write (iout,10)
   10             format (/,' Additional Atomic Dipole',
     &                       ' Polarizability Parameters :',
     &                    //,6x,'Atom Type',10x,'Alpha',/)
               end if
               if (k .le. maxtyp) then
                  polr(k) = pol
                  write (iout,20)  k,pol
   20             format (6x,i6,6x,f12.3)
               else
                  write (iout,30)
   30             format (/,' KPOLAR  --  Too many Dipole',
     &                       ' Polarizability Parameters')
                  abort = .true.
               end if
            end if
   40       continue
         end if
      end do
c
c     find and store all the atomic dipole polarizabilities
c
      do i = 1, n
         polarize(i) = polr(type(i))
      end do
c
c     process keywords containing atom specific polarizabilities
c
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:9) .eq. 'POLARIZE ') then
            k = 0
            pol = 0.0d0
            string = record(next:80)
            read (string,*,err=70,end=70)  k,pol
            if (k.lt.0 .and. k.ge.-n) then
               k = -k
               if (header) then
                  header = .false.
                  write (iout,50)
   50             format (/,' Additional Dipole Polarizabilities',
     &                       ' for Specific Atoms :',
     &                    //,8x,'Atom',13x,'Alpha',/)
               end if
               write (iout,60)  k,pol
   60          format (6x,i6,6x,f12.3)
               polarize(k) = pol
            end if
   70       continue
         end if
      end do
c
c     remove zero and undefined polarizable multipoles from the list
c
      npole = 0
      do i = 1, n
         if (polsiz(i).ne.0 .or. polarize(i).ne.0.0d0) then
            if (zaxis(i).ne.0 .and. xaxis(i).ne.0) then
               npole = npole + 1
               ipole(npole) = i
               zaxis(npole) = zaxis(i)
               xaxis(npole) = xaxis(i)
               polaxe(npole) = polaxe(i)
               polsiz(npole) = polsiz(i)
               do k = 1, maxpole
                  pole(k,npole) = pole(k,i)
               end do
               polarize(npole) = polarize(i)
            end if
         end if
      end do
c
c     set the values used in the damping of the polarizability
c
      sixth = 1.0d0 / 6.0d0
      proot = 0.0d0
      if (pradius .gt. 0.0d0)  proot = sqrt(pradius)
      do i = 1, npole
         pdamp(i) = proot * polarize(i)**sixth
      end do
c
c     count the final number of polarizable multipole sites
c
      npolar = 0
      do i = 1, npole
         if (polarize(i) .ne. 0.0d0)  npolar = npolar + 1
      end do
c
c     if no polarizable multipoles are used, turn off the potentials
c
      if (npole .eq. 0)  use_mpole = .false.
      if (npolar .eq. 0)  use_polar = .false.
      return
      end
