subroutine cvirlr(xcm,ldim,npm,mmp,evirclr)
	implicit none
        include 'pimc.par'
        integer kp,k,ik,js,ldim,npm,mmp,l,i
        real*8 dummy,xcm(ldim,mmp),dumi1,dumi2,evirclr,d
        include 'pimc.cm'
	
        evirclr=0.d0
        do js=1,nslices
         kp=0
         do k=1,nshlls
          dummy=0.d0
          do ik=kmult(k-1)+1,kmult(k)
           kp=kp+2
           dumi1=0.d0
           dumi2=0.d0
           do i=1,npm
            d=0.d0
            do l=1,ldim
             d=d+rkcomp(l,i)*pbc(xb(l,i,js),xcm(l,i),l)
            enddo
            dumi1=dumi1+d*pwmatb(kp,i,js)
            dumi2=dumi2+d*pwmatb(kp-1,i,js)
           enddo
           dummy=dummy+dumi1*rhokb(kp-1,js)
     &                -dumi2*rhokb(kp,js)
          enddo
          evirclr=evirclr+dummy*vk(k)
         enddo
        enddo
        evirclr=evirclr*charge/vol/dble(nslices)
	return
	end