subroutine cvirlr(xcm,ldim,npm,mmp,evirclr)
	implicit none
        include 'pimc.par'
        integer kp,k,ik,js,ldim,npm,mmp,l,i,is
        real*8 dummy,xcm(ldim,mmp),dumi1,dumi2,evirclr,d
        real*8 dumi3,dumi4
        include 'pimc.cm'
	
        evirclr=0.d0
        do js=1,nslices
         do is=1,js-1
          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
            dumi3=0.d0
            dumi4=0.d0
            do i=1,npm
             d=0.d0
             do l=1,ldim
              d=d+rkcomp(l,i)*(xb(l,i,js)-xb(l,i,is))
             enddo
             dumi1=dumi1+d*pwmatb(kp,i,js)
             dumi2=dumi2+d*pwmatb(kp-1,i,js)
             dumi3=dumi3+d*pwmatb(kp,i,is)
             dumi4=dumi4+d*pwmatb(kp-1,i,is)
            enddo
            dummy=dummy+dumi1*rhokb(kp-1,js)
     &                 -dumi2*rhokb(kp,js)
     &                 -dumi3*rhokb(kp-1,is)
     &                 +dumi4*rhokb(kp,is)
           enddo
           evirclr=evirclr+dummy*vk(k)
          enddo
         enddo
        enddo
        evirclr=evirclr*charge/vol/dble(nslices*nslices)
	return
	end