C
C $Id: mccopy.F,v 1.3 1998/07/16 16:40:04 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      subroutine mccopynew(ires,movedres,subpicked1)

      implicit double precision(a-h,o-z)
#include "divcon.dim"
#include "divcon.h"

C     called if new configuration is accepted

C     locals & arguments:
      dimension ires(maxres)
      logical subpicked1(maxsub)

      nstepmc = ntry
      naccpt = naccpt + 1
      eheatmc = eheat
      electmc = eelect
      ecoremc = ecore
      etotmc = etot
      enthmc = enth
      pressmc = pressins
      ptermmc = pterm
       do i=1,4
      virmc(i) = vir(i)
       enddo
      densmc = dens
      denstempmc = denstemp
      pmerecmc = pmerec
      pmedirmc = pmedir
      pmeselfmc = pmeself
      ecoulmc = ecoul
      elrmc = elr
      recip1mc = recip1(1)
      recip2mc = recip2(2)
      recip3mc = recip3(3)
      boxvolmc = boxvol
      betapmemc = betapme
      do i=1,3
         xyzminmc(i) = xyzmin(i)
         xyzmaxmc(i) = xyzmax(i)
         dxyzmc(i) = dxyz(i)
         gcminmc(i) = gcmin(i)
         gcmaxmc(i) = gcmax(i)
         dboxmc(i) = dbox(i)
         dhalfmc(i) = dhalf(i)
         boxmaxmc(i) = boxmax(i)
         boxminmc(i) = boxmin(i)
      enddo

C     note that gcres is fine
      do 130 imv=1,movedres
         ir = ires(imv)
         i1 = irpnt(ir)
         i2 = irpnt(ir+1)-1
         do 110 i=i1,i2
            do 100 j=1,3
               xyzmc(j,i) = xyz(j,i)
 100        continue
 110     continue
         do 120 i=1,3
            gcmc(i,ir) = gc(i,ir)
 120     continue
 130  continue

      do i=1,natoms
         atchgmc(i) = atchg(i)
      enddo

C     accepted, so update forces on all residues
      if (smartmc) call getrforc

C     if accepted all coefficients are fine, so reset subpicked1
      if (frozenmc.and.(.not.stand)) then
         do i=1,nsub
            subpicked1(i) = .false.
         enddo
      endif

#ifdef LARGE_MEMORY_MC
      iimax = iimat(natoms+1)-1
      ipmax = ip1(natoms+1)
      ijmax = ijmat(ipmax)-1

C     copy the old density matrix
      do 177 ii=1,iimax
         pdiagmc(ii) = pdiag(ii)
         pdiatmc(ii) = pdiat(ii)
 177  continue
      do 178 ii=iimax+1,ijmax
         pdiatmc(ii) = pdiat(ii)
 178  continue
#endif

      end

CC--------------------------------------------------------------CC

      subroutine mccopyold(ires,movedres)

      implicit double precision(a-h,o-z)
#include "divcon.dim"
#include "divcon.h"

C     called if new configuration is rejected

C     locals & arguments:
      dimension ires(maxres)

      eheat = eheatmc
      eelect = electmc
      ecore = ecoremc
      etot = etotmc
      enth = enthmc
      pressins = pressmc
      pterm = ptermmc
       do i=1,4
      vir(i) = virmc(i)
       enddo
      dens = densmc
      denstemp = denstempmc
      pmerec = pmerecmc
      pmedir = pmedirmc
      pmeself = pmeselfmc
      ecoul = ecoulmc
      elr = elrmc
      recip1(1) = recip1mc
      recip2(2) = recip2mc
      recip3(3) = recip3mc
      boxvol = boxvolmc
      betapme = betapmemc
      do i=1,3
         xyzmin(i) = xyzminmc(i)
         xyzmax(i) = xyzmaxmc(i)
         dxyz(i) = dxyzmc(i)
         gcmin(i) = gcminmc(i)
         gcmax(i) = gcmaxmc(i)
         dbox(i) = dboxmc(i)
         dhalf(i) = dhalfmc(i)
         boxmax(i) = boxmaxmc(i)
         boxmin(i) = boxminmc(i)
      enddo

C     copy gcres back (not touched in mccopynew)
      do 130 imv=1,movedres
         ir = ires(imv)
         do 100 i=1,3
            gc(i,ir) = gcmc(i,ir)
 100     continue
         i1 = irpnt(ir)
         i2 = irpnt(ir+1)-1
         do 120 i=i1,i2
            do 110 j=1,3
               xyz(j,i) = xyzmc(j,i)
               gcres(j,i) = gc(j,ir)
 110        continue
 120     continue
 130  continue

      do i=1,natoms
         atchg(i) = atchgmc(i)
      enddo

C     don't touch rforcmc: coordinates have been reset,
C     so old forces are still valid.

C     don't touch notfroz: since this configuration was rejected,
C     the coefficients of the subsystems that moved in this step
C     have to be updated as well

#ifdef LARGE_MEMORY_MC
      iimax = iimat(natoms+1)-1
      ipmax = ip1(natoms+1)
      ijmax = ijmat(ipmax)-1

C     copy the old density matrix
      do 177 ii=1,iimax
         pdiag(ii) = pdiagmc(ii)
         pdiat(ii) = pdiatmc(ii)
 177  continue
      do 178 ii=iimax+1,ijmax
         pdiat(ii) = pdiatmc(ii)
 178  continue
#endif

      end