c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine kvdw  --  van der Waals parameter assignment  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "kvdw" assigns the parameters to be used in computing the
c     van der Waals interactions and processes any new or changed
c     values for these parameters
c
c
      subroutine kvdw
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'couple.i'
      include 'inform.i'
      include 'iounit.i'
      include 'keys.i'
      include 'kvdws.i'
      include 'kvdwpr.i'
      include 'math.i'
      include 'potent.i'
      include 'vdw.i'
      include 'vdwpot.i'
      integer i,k,ia,ib,next
      integer size,number
      real*8 rd,ep,rdn
      real*8 srad(maxtyp),seps(maxtyp)
C hailin
      real*8 srad4(maxclass)
      real*8 seps4(maxclass)
C hailinend
      character*3 pa,pb
      character*6 pt
      character*20 keyword
      character*80 record,string
      logical header
c
c
c     process keywords containing van der Waals parameters
c
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:4) .eq. 'VDW ') then
            k = 0
            rd = 0.0d0
            ep = 0.0d0
            rdn = 0.0d0
            string = record(next:80)
            read (string,*,err=10,end=10)  k,rd,ep,rdn
   10       continue
            if (k.ge.1 .and. k.le.maxtyp) then
               if (header) then
                  header = .false.
                  write (iout,20)
   20             format (/,' Additional van der Waals Parameters :',
     &                    //,6x,'Class',6x,'Radius',5x,'Epsilon',
     &                       4x,'Reduction',/)
               end if
               if (ep .eq. 0.0d0)  ep = eps(k)
               if (rdn .eq. 0.0d0)  rdn = reduct(k)
               rad(k) = rd
               eps(k) = ep
               reduct(k) = rdn
               write (iout,30)  k,rd,ep,rdn
   30          format (4x,i6,1x,2f12.4,f11.3)
            else if (k .gt. maxclass) then
               write (iout,40)  maxclass
   40          format (/,' KVDW  --  Only Atom Classes through',i4,
     &                    ' are Allowed')
               abort = .true.
            end if
         end if
      end do
c
C hailin
c     
c     process keywords containing 1-4 van der Waals parameters
c     
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)   
         if (keyword(1:6) .eq. 'VDW14 ') then
            k = 0
            rd = 0.0d0
            ep = 0.0d0
c            string = record(next:120)                                  0305MH08
            string = record(next:80)                                    0305MH08
            read (string,*,err=9950,end=9950)  k,rd,ep
 9950       continue
            if (k.ge.1 .and. k.le.maxclass) then
               if (header) then
                  header = .false.
                  write (iout,9960)
 9960             format (/,' Additional 1-4 van der Waals',
     &                       ' Parameters :',
     &                    //,5x,'Atom Class',9x,'Radius',5x,'Epsilon',/)
               end if
               if (ep .eq. 0.0d0)  ep = eps4(k)   
               rad4(k) = rd
               eps4(k) = ep
               write (iout,9970)  k,rd,ep
 9970          format (4x,i6,8x,2f12.4)
            else if (k .gt. maxclass) then
               write (iout,9980)  maxclass
 9980          format (/,' KVDW  --  Only Atom Classes through',i4,
     &                    ' are Allowed')
               abort = .true.
            end if
         end if
      end do
C hailinend
C
c     process keywords containing specific pair vdw parameters
c
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:6) .eq. 'VDWPR ') then
            ia = 0
            ib = 0
            rd = 0.0d0
            ep = 0.0d0
            string = record(next:80)
            read (string,*,err=80,end=80)  ia,ib,rd,ep
            if (header) then
               header = .false.
               write (iout,50)
   50          format (/,' User van der Waals Parameters for',
     &                    ' Specific Pairs :',
     &                 //,6x,'Classes',5x,'Radii Sum',3x,'Epsilon',/)
            end if
            write (iout,60)  ia,ib,rd,ep
   60       format (3x,2i4,2x,2f12.4)
            size = 3
            call numeral (ia,pa,size)
            call numeral (ib,pb,size)
            if (ia .le. ib) then
               pt = pa//pb
            else
               pt = pb//pa
            end if
            do k = 1, maxnvp
               if (kvpr(k).eq.'      ' .or. kvpr(k).eq.pt) then
                  kvpr(k) = pt
                  radpr(k) = rd
                  epspr(k) = ep
                  goto 80
               end if
            end do
            write (iout,70)
   70       format (/,' KVDW  --  Too many Special VDW Pair',
     &                 ' Parameters')
            abort = .true.
   80       continue
         end if
      end do
c
c     get the vdw radius and well depth for each atom class
c
C hailin
      do i = 1, maxclass
         if (rad4(i) .eq. 0.0d0)  rad4(i) = rad(i)
         if (eps4(i) .eq. 0.0d0)  eps4(i) = eps(i)
         if (radtyp .eq. 'SIGMA') then
            rad(i) = twosix * rad(i)
            rad4(i) = twosix * rad4(i)
         end if
         if (radsiz .eq. 'DIAMETER') then
            rad(i) = 0.5d0 * rad(i)
            rad4(i) = 0.5d0 * rad4(i)
         end if
         srad(i) = sqrt(rad(i))
         eps(i) = abs(eps(i))
         seps(i) = sqrt(eps(i))
         srad4(i) = sqrt(rad4(i))   
         eps4(i) = abs(eps4(i))
         seps4(i) = sqrt(eps4(i))
      end do
C hailinend 
C hailin
C      do i = 1, maxclass
C         if (radtyp .eq. 'SIGMA')  rad(i) = twosix * rad(i)
C         if (radsiz .eq. 'DIAMETER')  rad(i) = 0.5d0 * rad(i)
C         srad(i) = sqrt(rad(i))
C         eps(i) = abs(eps(i))
C         seps(i) = sqrt(eps(i))
C      end do
C hailinend
c
c     use combination rules to set pairwise vdw radii sums
c
      do i = 1, maxclass
         do k = i, maxclass
            if (rad(i).eq.0.0d0 .and. rad(k).eq.0.0d0) then
               rd = 0.0d0
            else if (radrule(1:10) .eq. 'ARITHMETIC') then
               rd = rad(i) + rad(k)
            else if (radrule(1:9) .eq. 'GEOMETRIC') then
               rd = 2.0d0 * (srad(i) * srad(k))
            else if (radrule(1:10) .eq. 'CUBIC-MEAN') then
               rd = 2.0d0 * (rad(i)**3+rad(k)**3)/(rad(i)**2+rad(k)**2)
            else
               rd = rad(i) + rad(k)
            end if
            radmin(i,k) = rd
            radmin(k,i) = rd
         end do
      end do
c
c     use combination rules to set pairwise well depths
c
      do i = 1, maxclass
         do k = i, maxclass
            if (eps(i).eq.0.0d0 .and. eps(k).eq.0.0d0) then
               ep = 0.0d0
            else if (epsrule(1:10) .eq. 'ARITHMETIC') then
               ep = 0.5d0 * (eps(i) + eps(k))
            else if (epsrule(1:9) .eq. 'GEOMETRIC') then
               ep = seps(i) * seps(k)
            else if (epsrule(1:8) .eq. 'HARMONIC') then
               ep = 2.0d0 * (eps(i)*eps(k)) / (eps(i)+eps(k))
            else if (epsrule(1:3) .eq. 'HHG') then
               ep = 4.0d0 * (eps(i)*eps(k)) / (seps(i)+seps(k))**2
            else
               ep = seps(i) * seps(k)
            end if
            epsilon(i,k) = ep
            epsilon(k,i) = ep
         end do
      end do
c
C hailin
c
c     use combination rules to set pairwise 1-4 vdw radii sums
c
      do i = 1, maxclass
         do k = i, maxclass
            if (rad4(i).eq.0.0d0 .and. rad4(k).eq.0.0d0) then
               rd = 0.0d0
            else if (radrule(1:10) .eq. 'ARITHMETIC') then
               rd = rad4(i) + rad4(k)
            else if (radrule(1:9) .eq. 'GEOMETRIC') then
               rd = 2.0d0 * (srad4(i) * srad4(k))
            else if (radrule(1:10) .eq. 'CUBIC-MEAN') then
               rd = 2.0d0 * (rad4(i)**3+rad4(k)**3)
     &                         / (rad4(i)**2+rad4(k)**2)
            else
               rd = rad4(i) + rad4(k)
            end if
            radmin4(i,k) = rd
            radmin4(k,i) = rd
         end do
      end do
c
c     use combination rules to set pairwise 1-4 well depths
c
      do i = 1, maxclass
         do k = i, maxclass
            if (eps4(i).eq.0.0d0 .and. eps4(k).eq.0.0d0) then
               ep = 0.0d0
            else if (epsrule(1:10) .eq. 'ARITHMETIC') then
               ep = 0.5d0 * (eps4(i) + eps4(k))
            else if (epsrule(1:9) .eq. 'GEOMETRIC') then
               ep = seps4(i) * seps4(k)
            else if (epsrule(1:8) .eq. 'HARMONIC') then
               ep = 2.0d0 * (eps4(i)*eps4(k)) / (eps4(i)+eps4(k))
            else if (epsrule(1:3) .eq. 'HHG') then
               ep = 4.0d0 * (eps4(i)*eps4(k)) / (seps4(i)+seps4(k))**2
            else
               ep = seps4(i) * seps4(k)
            end if
            epsilon4(i,k) = ep
            epsilon4(k,i) = ep
         end do
      end do
c
C hailinend
C
c     vdw reduction factor information for each individual atom
c
      do i = 1, n
         kred(i) = reduct(class(i))
         if (n12(i).ne.1 .or. kred(i).eq.0.0d0) then
            ired(i) = i
         else
            ired(i) = i12(1,i)
         end if
      end do
c
c     radii and well depths for special atom class pairs
c
      do i = 1, maxnvp
         if (kvpr(i) .eq. '      ')  goto 90
         ia = number (kvpr(i)(1:3))
         ib = number (kvpr(i)(4:6))
         if (rad(ia) .eq. 0.0d0)  rad(ia) = 0.001d0
         if (rad(ib) .eq. 0.0d0)  rad(ib) = 0.001d0
         radmin(ia,ib) = radpr(i)
         radmin(ib,ia) = radpr(i)
         epsilon(ia,ib) = abs(epspr(i))
         epsilon(ib,ia) = abs(epspr(i))
         radmin4(ia,ib) = radpr(i)
         radmin4(ib,ia) = radpr(i)
         epsilon4(ia,ib) = abs(epspr(i))
         epsilon4(ib,ia) = abs(epspr(i))
      end do
   90 continue
c
c     set the coefficients for a 2- or 4-Gaussian L-J fit
c
      if (use_gauss) then
         if (ngauss .eq. 4) then
            igauss(1,1) = 846706.7d0
            igauss(2,1) = 15.464405d0
            igauss(1,2) = 2713.651d0
            igauss(2,2) = 7.346875d0
            igauss(1,3) = -9.699172d0
            igauss(2,3) = 1.8503725d0
            igauss(1,4) = -0.7154420d0
            igauss(2,4) = 0.639621d0
         else
            ngauss = 2
            igauss(1,1) = 14487.1d0
            igauss(2,1) = 9.05148d0
            igauss(1,2) = -5.55338d0
            igauss(2,2) = 1.22536d0
            igauss(1,3) = 0.0d0
            igauss(2,3) = 0.0d0
            igauss(1,4) = 0.0d0
            igauss(2,4) = 0.0d0
         end if
      end if
c
c     remove zero-sized atoms from the list of vdw sites
c
      nvdw = 0
      do i = 1, n
         if (rad(class(i)) .ne. 0.0d0) then
            nvdw = nvdw + 1
            ivdw(nvdw) = i
         end if
      end do
      return
      end
