      subroutine asschd(ityp,q)
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxamb=701)
      integer ambcls
      common /typpar/ ambchg(mxamb),ambcls(mxamb)
      common /athlp/  iatoms, mxnat
      integer*2 ityp
      dimension ityp(*),q(*)

      nion = 0

      do i=1,iatoms
          if (ityp(i).gt.0.and.ityp(i).le.mxamb) then
             q(i) = ambchg(ityp(i))
          elseif (ityp(i).eq.0) then
             q(i) = 0.0d0
          endif
      end do

      return
      end

      subroutine charge(ec,nac,iac,nad,iad,
     &                  coo,iconn,q,forces,potscl)
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxcon=10)
      parameter (mxac=3*mxcon)
      parameter (mxad=9*mxcon)
      common /athlp/  iatoms, mxnat
      common /limits/ cutvdw, cutchg
      dimension vr(3),ded(3)
      dimension coo(3,*),q(*),iconn(mxcon+1,*),
     &          nac(*),nad(*),iac(mxac,*),iad(mxad,*),
     &          forces(3,*),potscl(*)

      econv = 332.05382d0
      cut2 = cutchg * cutchg
      v14sc = 1.0d0 / 1.2d0
      ec = 0.0d0

      do i=1,iatoms-1

         do j=1,iatoms
            potscl(j) = 1.0d0
         end do

         do j=1,iconn(1,i)
            jj = iconn(1+j,i)
            if (jj.gt.0) then
               potscl(jj) = 0.0d0
            endif
         end do

         do j=1,nac(i)
            potscl(iac(j,i)) = 0.0d0
         end do

         do j=1,nad(i)
            potscl(iad(j,i)) = v14sc
         end do

         do k=i+1,iatoms

               do j=1,3
                  vr(j) = coo(j,i) - coo(j,k)
               end do

               r2 = vr(1)*vr(1) + vr(2)*vr(2) + vr(3)*vr(3)

               if (r2.le.cut2) then
                  r = dsqrt(r2)
                  e = econv * q(i) * q(k) * potscl(k) / r
                  de = -e / r
                  de = de / r

                  do j=1,3
                     ded(j) = de * vr(j)
                  end do

c                  print*,'echg ',i,' ',k,' ',e,' scl ',potscl(k),'ded '
c     &                   ,(ded(j),j=1,3)

                  ec = ec + e

                  do j=1,3
                     forces(j,i) = forces(j,i) + ded(j)
                     forces(j,k) = forces(j,k) - ded(j)
                  end do

               end if
         end do
      end do

      return
      end
