subroutine compactdbg(messagge,input)
       implicit none
       include 'pimc.par'
       integer l,js,step,is,il,n,m,nj,ik,is1,js1,ismin,input,i
       integer mover(mmovers)
       real*4 etime,tim(2)
       real*8 phonon3,coulomb,phonon4,act2,yself
       real*8 dbgepact,dbgepact1,dbgep12,dbgcpot,dbgact
       real*8 dbgxb(mdim,mparts,mslices)
       real*8 dbgxd(mdim,mparts,mslices)
       real*8 dbgcxb(mdim,mparts,mslices)
       real*8 dbgrhokb(mnkv2,mslices),dbgpwmatb(mnkv2,mparts,mslices)
       real*8 dbgepactew(mslices,mslices),dbgcpotew(mslices)
       real*8 epactlr,cewald,ppp
       external phonon3,coulomb
       character*80 messagge
       include 'pimc.cm'
	
c compute the action of the actual path
       dbgepact=0.d0
       dbgepact1=0.d0
       dbgep12=0.d0
       dbgcpot=0.d0
       do js=1,nslices
        call copy(xb(1,1,js),dbgxb(1,1,js),ndim*np)
       enddo
       if (alpha.ne.0.d0.and.ncumtr.eq.1) then
        do js=1,nslices
         call copy(xd(1,1,js),dbgxd(1,1,js),ndim*np)
         call copy(cxb(1,1,js),dbgcxb(1,1,js),ndim*np)
        enddo
        call rijtab
c       write(*,'(i3,3g15.6)')
c    &      (js,(xb(l,1,js)-dbgxb(l,1,js),l=1,ndim),js=1,nslices)
c       write (*,*)
c       write(*,'(i3,3g15.6)')
c    &      (js,(xd(l,1,js)-dbgxd(l,1,js),l=1,ndim),js=1,nslices)
c       write (*,*)
c       write(*,'(i3,3g15.6)')
c    &      (js,(cxb(l,1,js)-dbgcxb(l,1,js),l=1,ndim),js=1,nslices)
c       write (*,*)
       endif
       do n=1,np
c intramolecular contribution
        do js=1,nslices
         js1=iwrap(js-1)
         spring(n,js)=0.
         do l=1,ndim
          spring(n,js) = spring(n,js)+(pbc(x(l,n,js),x(l,n,js1),l))**2
         enddo
         if (alpha.ne.0.d0) then
          ismin=js+1
          if (ncumtr.eq.1) ismin=js
          do is=ismin,nslices
           is1=iwrap(is-1)
           il=iwrap(js-is)
           if(ncumtr.eq.0) then
            ppp=phonon3(il,x(1,n,js1),x(1,n,js)
     &                            ,x(1,n,is1),x(1,n,is),ndim)
            dbgepact=dbgepact+ppp
           elseif(ncumtr.eq.1) then
            dbgepact=dbgepact+phonon4(il,ndim,x(1,n,js1),x(1,n,js)
     &                         ,x(1,n,is1),x(1,n,is),cxb(1,n,js)
     &                         ,cxb(1,n,is),xd(1,n,js),xd(1,n,is)
     &                         )
            dbgepact1=dbgepact1+
     &             act2(il,ndim,xb(1,n,js),xb(1,n,is),xd(1,n,js))
           endif
          enddo
c   self-term
          if(ncumtr.eq.0) then
           call splint(rptself,6,aself(1,1),aself(1,2),lptable,
     &                 dsqrt(spring(n,js)),yself)
           yself=0.5d0*yself
c          write (*,*) js,dsqrt(spring(n,js)),yself
           dbgepact=dbgepact+yself
          endif
         endif
        enddo
c intermolecular contribution
        do m=1,n-1
         do js=1,nslices
          js1=iwrap(js-1)
          if (alpha.ne.0.d0) then
           do ik=js-ilcut+1,js+ilcut
            is=iwrap(ik)
            il=iwrap(js-is)
            is1=iwrap(is-1)
c           write(*,*) n,js,m,is,il
            dbgep12=dbgep12+phonon3(il,x(1,n,js1),x(1,n,js)
     &                       ,x(1,m,is1),x(1,m,is),ndim)
           enddo
          endif
          if (charge.ne.0.d0) 
     &     dbgcpot=dbgcpot+coulomb(x(1,n,js),x(1,m,js),
     &                       x(1,n,js1),x(1,m,js1),ndim)
         enddo
        enddo
       enddo
c computes reciprocal space contributions
       if (ifewald.ne.0) then
        do i=1,np
         do js=1,nslices
          js1=iwrap(js-1)
          do l=1,ndim
           xb(l,i,js)=(x(l,i,js)+x(l,i,js1))/2.d0
          enddo
         enddo
        enddo
        do js=1,nslices
         call copy(rhokb(1,js),dbgrhokb(1,js),mnkv2)
         call copy(pwmatb(1,1,js),dbgpwmatb(1,1,js),mnkv2*mparts)
         call rhokall(xb(1,1,js),rhokb(1,js),pwmatb(1,1,js),nvects)
        enddo
        if (alpha.ne.0.d0) then
         epactlr=0.d0
         do js=1,nslices
          dbgepactew(js,js)=epactew(js,js)
          call ephew(js,js,nslices)
          epactlr=epactlr+epactew(js,js)
          do is=js+1,nslices
           il=is-js
           if (il.le.ilcut.or.nslices-il.le.ilcut) then
            dbgepactew(js,is)=epactew(js,is)
            dbgepactew(is,js)=epactew(js,is)
            call ephew(js,is,il)
            epactlr=epactlr+2.d0*epactew(js,is)
           endif
          enddo
         enddo
         dbgepact=dbgepact+epactlr
        endif
        if (charge.ne.0.d0) then
         do js=1,nslices
          dbgcpotew(js)=cpotew(js)
          mover(js)=js
         enddo
         call coulew(nslices,mover)
         cewald=0.d0
         do js=1,nslices
          cewald=cewald+cpotew(js)
         enddo
         write (*,*) 'cpot,cewald, cewald/cpot'
         if (dbgcpot.ne.0.d0) write (*,*) dbgcpot,cewald,cewald/dbgcpot
         dbgcpot=dbgcpot+cewald
        endif
       endif
       if (charge.ne.0.d0) dbgcpot=dbgcpot+vkconst
       dbgact=dbgcpot+dbgepact+dbgepact1+dbgep12

       write (*,'(a30,i5)') messagge,input 
       write (*,'(5g15.6)') action,epact,epact1,ep12,cpot
       write (*,'(5g15.6)') dbgact,dbgepact,dbgepact1,dbgep12,dbgcpot

       do js=1,nslices
        call copy(dbgxb(1,1,js),xb(1,1,js),ndim*np)
        call copy(dbgepactew(1,js),epactew(1,js),nslices)
        call copy(dbgrhokb(1,js),rhokb(1,js),mnkv2)
        call copy(dbgpwmatb(1,1,js),pwmatb(1,1,js),mnkv2*mparts)
       enddo
       call copy(dbgcpotew,cpotew,nslices)
       if (alpha.ne.0.and.ncumtr.eq.1) then
        do js=1,nslices
         call copy(dbgxd(1,1,js),xd(1,1,js),ndim*np)
         call copy(dbgcxb(1,1,js),cxb(1,1,js),ndim*np)
        enddo
       endif
       return
       end