Merge branch 'devel' into feature-ga
[unres.git] / source / unres / src_MD / old_F / MREMD_nosy1traj.F
diff --git a/source/unres/src_MD/old_F/MREMD_nosy1traj.F b/source/unres/src_MD/old_F/MREMD_nosy1traj.F
deleted file mode 100644 (file)
index b95f165..0000000
+++ /dev/null
@@ -1,907 +0,0 @@
-      subroutine MREMD
-      implicit real*8 (a-h,o-z)
-      include 'DIMENSIONS'
-      include 'mpif.h'
-      include 'COMMON.CONTROL'
-      include 'COMMON.VAR'
-      include 'COMMON.MD'
-#ifndef LANG0
-      include 'COMMON.LANGEVIN'
-#else
-      include 'COMMON.LANGEVIN.lang0'
-#endif
-      include 'COMMON.CHAIN'
-      include 'COMMON.DERIV'
-      include 'COMMON.GEO'
-      include 'COMMON.LOCAL'
-      include 'COMMON.INTERACT'
-      include 'COMMON.IOUNITS'
-      include 'COMMON.NAMES'
-      include 'COMMON.TIME1'
-      include 'COMMON.REMD'
-      include 'COMMON.SETUP'
-      include 'COMMON.MUCA'
-      double precision cm(3),L(3),vcm(3)
-      double precision energia(0:n_ene)
-      double precision remd_t_bath(maxprocs)
-      double precision remd_ene(0:n_ene+1,maxprocs)
-      integer iremd_acc(maxprocs),iremd_tot(maxprocs)
-      integer ilen,rstcount
-      external ilen
-      character*50 tytul
-      common /gucio/ cm
-      integer itime
-      integer nup(0:maxprocs),ndown(0:maxprocs)
-      integer rep2i(0:maxprocs)
-      integer itime_all(maxprocs)
-      integer status(MPI_STATUS_SIZE)
-      logical synflag,end_of_run,file_exist
-
-      time00=MPI_WTIME()
-      if(me.eq.king.or..not.out1file)
-     & write  (iout,*) 'MREMD',nodes,'time before',time00-walltime
-
-      synflag=.false.
-      mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst"
-
-cd      print *,'MREMD',nodes
-
-cd      print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep)
-
-cde      write (iout,*) "Start MREMD: me",me," t_bath",t_bath
-      k=0
-      rep2i(k)=-1
-      do i=1,nrep
-        iremd_acc(i)=0
-        iremd_tot(i)=0
-        do j=1,remd_m(i)
-          i2rep(k)=i
-          rep2i(i)=k
-          k=k+1
-        enddo
-      enddo
-
-c      print *,'i2rep',me,i2rep(me)
-c      print *,'rep2i',(rep2i(i),i=0,nrep)
-
-       if (i2rep(me).eq.nrep) then
-        nup(0)=0
-       else
-        nup(0)=remd_m(i2rep(me)+1)
-        k=rep2i(i2rep(me))+1
-        do i=1,nup(0)
-         nup(i)=k
-         k=k+1
-        enddo
-       endif
-
-cd       print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0))
-
-       if (i2rep(me).eq.1) then
-        ndown(0)=0
-       else
-        ndown(0)=remd_m(i2rep(me)-1)
-        k=rep2i(i2rep(me)-2)+1
-        do i=1,ndown(0)
-         ndown(i)=k
-         k=k+1
-        enddo
-       endif
-
-cd       print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0))
-
-       
-       if(rest.and.restart1file) then 
-           inquire(file=mremd_rst_name,exist=file_exist)
-           if(file_exist) call read1restart
-       endif
-
-       if(me.eq.king) then
-        if (rest.and..not.restart1file) 
-     &          inquire(file=mremd_rst_name,exist=file_exist)
-        IF (rest.and.file_exist.and..not.restart1file) THEN
-             open(irest2,file=mremd_rst_name,status='unknown')
-             read (irest2,*) 
-             read (irest2,*) (i2rep(i),i=0,nodes-1)
-             read (irest2,*) 
-             read (irest2,*) (ifirst(i),i=1,remd_m(1))
-             do il=1,nodes
-              read (irest2,*) 
-              read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
-              read (irest2,*) 
-              read (irest2,*) ndowna(0,il),
-     &                    (ndowna(i,il),i=1,ndowna(0,il))
-             enddo
-             close(irest2)
-
-             write (iout,'(a6,1000i5)') "i2rep",(i2rep(i),i=0,nodes-1)
-             write (iout,'(a6,1000i5)') "ifirst",
-     &                    (ifirst(i),i=1,remd_m(1))
-             do il=1,nodes
-              write (iout,'(a6,i4,a1,100i4)') "nupa",il,":",
-     &                    (nupa(i,il),i=1,nupa(0,il))
-              write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":",
-     &                    (ndowna(i,il),i=1,ndowna(0,il))
-             enddo
-        ELSE
-         do il=1,remd_m(1)
-          ifirst(il)=il
-         enddo
-
-         do il=1,nodes
-
-          if (i2rep(il-1).eq.nrep) then
-           nupa(0,il)=0
-          else
-           nupa(0,il)=remd_m(i2rep(il-1)+1)
-           k=rep2i(i2rep(il-1))+1
-           do i=1,nupa(0,il)
-            nupa(i,il)=k+1
-            k=k+1
-           enddo
-          endif
-
-          if (i2rep(il-1).eq.1) then
-           ndowna(0,il)=0
-          else
-           ndowna(0,il)=remd_m(i2rep(il-1)-1)
-           k=rep2i(i2rep(il-1)-2)+1
-           do i=1,ndowna(0,il)
-            ndowna(i,il)=k+1
-            k=k+1
-           enddo
-          endif
-
-         enddo
-        
-c        write (iout,'(a6,100i4)') "ifirst",
-c     &                    (ifirst(i),i=1,remd_m(1))
-c        do il=1,nodes
-c         write (iout,'(a6,i4,a1,100i4)') "nupa",il,":",
-c     &                    (nupa(i,il),i=1,nupa(0,il))
-c         write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":",
-c     &                    (ndowna(i,il),i=1,ndowna(0,il))
-c        enddo
-        
-        ENDIF
-       endif
-c
-c      t_bath=retmin+(retmax-retmin)*me/(nodes-1)
-       if(.not.(rest.and.file_exist.and.restart1file)) then
-         if (me .eq. king) then 
-           t_bath=retmin
-         else 
-            t_bath=retmin+(retmax-retmin)*exp(float(i2rep(me)-nrep))
-         endif
-cd       print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep)
-         if (remd_tlist) t_bath=remd_t(i2rep(me))
-       endif
-c
-        stdfp=dsqrt(2*Rb*t_bath/d_time)
-       do i=1,ntyp
-          stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
-        enddo 
-
-c      print *,'irep',me,t_bath
-       if (.not.rest) then  
-        if (me.eq.king .or. .not. out1file)
-     &   write (iout,'(a60,f10.5)') "REMD Temperature:",t_bath
-        call rescale_weights(t_bath)
-       endif
-
-
-c------copy MD--------------
-c  The driver for molecular dynamics subroutines
-c------------------------------------------------
-      t_MDsetup=0.0d0
-      t_langsetup=0.0d0
-      t_MD=0.0d0
-      t_enegrad=0.0d0
-      t_sdsetup=0.0d0
-      if(me.eq.king.or..not.out1file)
-     & write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started"
-      tt0 = tcpu()
-c Determine the inverse of the inertia matrix.
-      call setup_MD_matrices
-c Initialize MD
-      call init_MD
-      if (rest) then  
-       if (me.eq.king .or. .not. out1file)
-     &  write (iout,'(a60,f10.5)') "REMD restart Temperature:",t_bath
-       stdfp=dsqrt(2*Rb*t_bath/d_time)
-       do i=1,ntyp
-          stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
-       enddo 
-       call rescale_weights(t_bath)
-      endif
-
-      t_MDsetup = tcpu()-tt0
-      rstcount=0 
-c   Entering the MD loop       
-      tt0 = tcpu()
-      if (lang.eq.2 .or. lang.eq.3) then
-        call setup_fricmat
-        if (lang.eq.2) then
-          call sd_verlet_p_setup       
-        else
-          call sd_verlet_ciccotti_setup
-        endif
-#ifndef   LANG0
-        do i=1,dimen
-          do j=1,dimen
-            pfric0_mat(i,j,0)=pfric_mat(i,j)
-            afric0_mat(i,j,0)=afric_mat(i,j)
-            vfric0_mat(i,j,0)=vfric_mat(i,j)
-            prand0_mat(i,j,0)=prand_mat(i,j)
-            vrand0_mat1(i,j,0)=vrand_mat1(i,j)
-            vrand0_mat2(i,j,0)=vrand_mat2(i,j)
-          enddo
-        enddo
-#endif
-        flag_stoch(0)=.true.
-        do i=1,maxflag_stoch
-          flag_stoch(i)=.false.
-        enddo  
-      else if (lang.eq.1 .or. lang.eq.4) then
-        call setup_fricmat
-      endif
-      time00=MPI_WTIME()
-      if (me.eq.king .or. .not. out1file)
-     & write(iout,*) 'Setup time',time00-walltime
-      call flush(iout)
-      t_langsetup=tcpu()-tt0
-      tt0=tcpu()
-      itime=0
-      end_of_run=.false.
-      do while(.not.end_of_run)
-        itime=itime+1
-        if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true.
-        if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true.
-        rstcount=rstcount+1
-        if (lang.gt.0 .and. surfarea .and. 
-     &      mod(itime,reset_fricmat).eq.0) then
-          if (lang.eq.2 .or. lang.eq.3) then
-            call setup_fricmat
-            if (lang.eq.2) then
-              call sd_verlet_p_setup
-            else
-              call sd_verlet_ciccotti_setup
-            endif
-#ifndef   LANG0
-            do i=1,dimen
-              do j=1,dimen
-                pfric0_mat(i,j,0)=pfric_mat(i,j)
-                afric0_mat(i,j,0)=afric_mat(i,j)
-                vfric0_mat(i,j,0)=vfric_mat(i,j)
-                prand0_mat(i,j,0)=prand_mat(i,j)
-                vrand0_mat1(i,j,0)=vrand_mat1(i,j)
-                vrand0_mat2(i,j,0)=vrand_mat2(i,j)
-              enddo
-            enddo
-#endif
-            flag_stoch(0)=.true.
-            do i=1,maxflag_stoch
-              flag_stoch(i)=.false.
-            enddo   
-          else if (lang.eq.1 .or. lang.eq.4) then
-            call setup_fricmat
-          endif
-          write (iout,'(a,i10)') 
-     &      "Friction matrix reset based on surface area, itime",itime
-        endif
-        if (reset_vel .and. tbf .and. lang.eq.0 
-     &      .and. mod(itime,count_reset_vel).eq.0) then
-          call random_vel
-          if (me.eq.king .or. .not. out1file)
-     &     write(iout,'(a,f20.2)') 
-     &     "Velocities reset to random values, time",totT      
-          do i=0,2*nres
-            do j=1,3
-              d_t_old(j,i)=d_t(j,i)
-            enddo
-          enddo
-        endif
-               if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then
-          call inertia_tensor  
-          call vcm_vel(vcm)
-          do j=1,3
-             d_t(j,0)=d_t(j,0)-vcm(j)
-          enddo
-          call kinetic(EK)
-          kinetic_T=2.0d0/(dimen*Rb)*EK
-          scalfac=dsqrt(T_bath/kinetic_T)
-cd          write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT    
-          do i=0,2*nres
-            do j=1,3
-              d_t_old(j,i)=scalfac*d_t(j,i)
-            enddo
-          enddo
-        endif  
-        if (lang.ne.4) then
-          if (RESPA) then
-c Time-reversible RESPA algorithm 
-c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992)
-            call RESPA_step(itime)
-          else
-c Variable time step algorithm.
-            call velverlet_step(itime)
-          endif
-        else
-          call brown_step(itime)
-        endif
-        if(ntwe.ne.0) then
-          if (mod(itime,ntwe).eq.0) call statout(itime)
-        endif
-        if (mod(itime,ntwx).eq.0.and..not.traj1file) then
-          write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath
-          if(mdpdb) then
-             call pdbout(potE,tytul,ipdb)
-          else 
-             call cartout(totT)
-          endif
-        endif
-        if ((rstcount.eq.1000.or.itime.eq.n_timestep)
-     &                         .and..not.restart1file) then
-
-           if(me.eq.king) then
-             open(irest1,file=mremd_rst_name,status='unknown')
-             write (irest1,*) "i2rep"
-             write (irest1,*) (i2rep(i),i=0,nodes-1)
-             write (irest1,*) "ifirst"
-             write (irest1,*) (ifirst(i),i=1,remd_m(1))
-             do il=1,nodes
-              write (irest1,*) "nupa",il
-              write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
-              write (irest1,*) "ndowna",il
-              write (irest1,*) ndowna(0,il),
-     &                   (ndowna(i,il),i=1,ndowna(0,il))
-             enddo
-             close(irest1)
-           endif
-           open(irest2,file=rest2name,status='unknown')
-           write(irest2,*) totT,EK,potE,totE,t_bath
-           do i=1,2*nres
-            write (irest2,'(3e15.5)') (d_t(j,i),j=1,3)
-           enddo
-           do i=1,2*nres
-            write (irest2,'(3e15.5)') (dc(j,i),j=1,3)
-           enddo
-          close(irest2)
-          rstcount=0
-        endif 
-
-c REMD - exchange
-c forced synchronization
-        if (mod(itime,100).eq.0 .and. me.ne.king 
-     &                                .and. .not. mremdsync) then 
-            synflag=.false.
-            call mpi_iprobe(0,101,CG_COMM,synflag,status,ierr)
-            if (synflag) then 
-               call mpi_recv(itime_master, 1, MPI_INTEGER,
-     &                             0,101,CG_COMM, status, ierr)
-               if (.not. out1file) then
-                write(iout,*) 'REMD synchro at',itime_master,itime
-               else
-                call mpi_gather(itime,1,mpi_integer,
-     &             itime_all,1,mpi_integer,king,
-     &             CG_COMM,ierr)
-               endif
-               if(itime_master.ge.n_timestep) end_of_run=.true.
-               call flush(iout)
-            endif
-        endif
-
-c REMD - exchange
-        if ((mod(itime,nstex).eq.0.and.me.eq.king
-     &                  .or.end_of_run.and.me.eq.king )
-     &       .and. .not. mremdsync ) then
-           synflag=.true.
-           time00=MPI_WTIME()
-           do i=1,nodes-1
-            call mpi_isend(itime,1,MPI_INTEGER,i,101,
-     &                                   CG_COMM, ireq, ierr)
-cd            write(iout,*) 'REMD synchro with',i
-cd            call flush(iout)
-           enddo
-           time02=MPI_WTIME()
-           write(iout,*) 'REMD synchro at',itime,'time=',time02-time00
-           if (out1file) then
-            call mpi_gather(itime,1,mpi_integer,
-     &             itime_all,1,mpi_integer,king,
-     &             CG_COMM,ierr)
-            write(iout,'(a18,8000i8)') 'REMD synchro itime',
-     &                    (itime_all(i),i=1,nodes)
-           endif
-           call flush(iout)
-        endif
-        if(mremdsync .and. mod(itime,nstex).eq.0) then
-           synflag=.true.
-           if (me.eq.king .or. .not. out1file)
-     &      write(iout,*) 'REMD synchro at',itime
-           call flush(iout)
-        endif
-        if(synflag.and..not.end_of_run) then
-           time00=MPI_WTIME()
-           synflag=.false.
-
-cd           write(iout,*) 'REMD before',me,t_bath
-
-c           call mpi_gather(t_bath,1,mpi_double_precision,
-c     &             remd_t_bath,1,mpi_double_precision,king,
-c     &             CG_COMM,ierr)
-           potEcomp(n_ene+1)=t_bath
-           call mpi_gather(potEcomp(0),n_ene+2,mpi_double_precision,
-     &             remd_ene(0,1),n_ene+2,mpi_double_precision,king,
-     &             CG_COMM,ierr)
-           if(lmuca) then 
-            call mpi_gather(elow,1,mpi_double_precision,
-     &             elowi,1,mpi_double_precision,king,
-     &             CG_COMM,ierr)
-            call mpi_gather(ehigh,1,mpi_double_precision,
-     &             ehighi,1,mpi_double_precision,king,
-     &             CG_COMM,ierr)
-           endif
-
-          if (restart1file) call write1rst
-          if (traj1file) call write1traj
-
-          if (me.eq.king) then
-            do i=1,nodes
-               remd_t_bath(i)=remd_ene(n_ene+1,i)
-            enddo
-            if(lmuca) then
-co             write(iout,*) 'REMD exchange temp,ene,elow,ehigh'
-             do i=1,nodes
-               write(iout,'(i4,4f12.5)') i,remd_t_bath(i),remd_ene(0,i),
-     &            elowi(i),ehighi(i)       
-             enddo
-            else
-cd              write(iout,*) 'REMD exchange temp,ene'
-c             do i=1,nodes
-co              write(iout,'(i4,2f12.5)') i,remd_t_bath(i),remd_ene(0,i)
-c              write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene)
-c             enddo
-            endif
-c-------------------------------------           
-           do irr=1,remd_m(1)
-           i=ifirst(iran_num(1,remd_m(1)))
-           do ii=1,nodes-1
-
-            if(i.gt.0.and.nupa(0,i).gt.0) then
-              iex=nupa(iran_num(1,int(nupa(0,i))),i)
-             if (lmuca) then
-               call muca_delta(remd_t_bath,remd_ene,i,iex,delta)
-             else
-c Swap temperatures between conformations i and iex with recalculating the free energies
-c following temperature changes.
-              ene_iex_iex=remd_ene(0,iex)
-              ene_i_i=remd_ene(0,i)
-co              write (iout,*) "rescaling weights with temperature",
-co     &          remd_t_bath(i)
-              call rescale_weights(remd_t_bath(i))
-              call sum_energy(remd_ene(0,iex),.false.)
-              ene_iex_i=remd_ene(0,iex)
-cd              write (iout,*) "ene_iex_i",remd_ene(0,iex)
-              call sum_energy(remd_ene(0,i),.false.)
-cd              write (iout,*) "ene_i_i",remd_ene(0,i)
-c              write (iout,*) "rescaling weights with temperature",
-c     &          remd_t_bath(iex)
-              if (real(ene_i_i).ne.real(remd_ene(0,i))) then
-                write (iout,*) "ERROR: inconsistent energies:",i,
-     &            ene_i_i,remd_ene(0,i)
-              endif
-              call rescale_weights(remd_t_bath(iex))
-              call sum_energy(remd_ene(0,i),.false.)
-c              write (iout,*) "ene_i_iex",remd_ene(0,i)
-              ene_i_iex=remd_ene(0,i)
-              call sum_energy(remd_ene(0,iex),.false.)
-              if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then
-                write (iout,*) "ERROR: inconsistent energies:",iex,
-     &            ene_iex_iex,remd_ene(0,iex)
-              endif
-c              write (iout,*) "ene_iex_iex",remd_ene(0,iex)
-c              write (iout,*) "i",i," iex",iex
-co              write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i,
-co     &           " ene_i_iex",ene_i_iex,
-co     &           " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex
-              delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))-
-     &              (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i))
-              delta=-delta
-c              write(iout,*) 'delta',delta
-c              delta=(remd_t_bath(i)-remd_t_bath(iex))*
-c     &              (remd_ene(i)-remd_ene(iex))/Rb/
-c     &              (remd_t_bath(i)*remd_t_bath(iex))
-             endif
-              if (delta .gt. 50.0d0) then
-                delta=0.0d0
-              else
-#ifdef OSF 
-                if(isnan(delta))then
-                  delta=0.0d0
-                else if (delta.lt.-50.0d0) then
-                  delta=dexp(50.0d0)
-                else
-                delta=dexp(-delta)
-              endif
-#else
-                delta=dexp(-delta)
-#endif
-              endif
-              iremd_tot(i2rep(i-1))=iremd_tot(i2rep(i-1))+1
-              xxx=ran_number(0.0d0,1.0d0)
-co              write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx
-              if (delta .gt. xxx) then
-                tmp=remd_t_bath(i)       
-                remd_t_bath(i)=remd_t_bath(iex)
-                remd_t_bath(iex)=tmp
-                remd_ene(0,i)=ene_i_iex
-                remd_ene(0,iex)=ene_iex_i
-                if(lmuca) then
-                  tmp=elowi(i)
-                  elowi(i)=elowi(iex)
-                  elowi(iex)=tmp  
-                  tmp=ehighi(i)
-                  ehighi(i)=ehighi(iex)
-                  ehighi(iex)=tmp  
-                endif
-
-
-                do k=0,nodes
-                  itmp=nupa(k,i)
-                  nupa(k,i)=nupa(k,iex)
-                  nupa(k,iex)=itmp
-                  itmp=ndowna(k,i)
-                  ndowna(k,i)=ndowna(k,iex)
-                  ndowna(k,iex)=itmp
-                enddo
-                do il=1,nodes
-                 if (ifirst(il).eq.i) ifirst(il)=iex
-                 do k=1,nupa(0,il)
-                  if (nupa(k,il).eq.i) then 
-                     nupa(k,il)=iex
-                  elseif (nupa(k,il).eq.iex) then 
-                     nupa(k,il)=i
-                  endif
-                 enddo
-                 do k=1,ndowna(0,il)
-                  if (ndowna(k,il).eq.i) then 
-                     ndowna(k,il)=iex
-                  elseif (ndowna(k,il).eq.iex) then 
-                     ndowna(k,il)=i
-                  endif
-                 enddo
-                enddo
-
-                iremd_acc(i2rep(i-1))=iremd_acc(i2rep(i-1))+1
-                itmp=i2rep(i-1)
-                i2rep(i-1)=i2rep(iex-1)
-                i2rep(iex-1)=itmp
-
-cd                write(iout,*) 'exchange',i,iex
-cd              write (iout,'(a8,100i4)') "@ ifirst",
-cd     &                    (ifirst(k),k=1,remd_m(1))
-cd              do il=1,nodes
-cd               write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":",
-cd     &                    (nupa(k,il),k=1,nupa(0,il))
-cd               write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":",
-cd     &                    (ndowna(k,il),k=1,ndowna(0,il))
-cd              enddo
-
-              else
-               remd_ene(0,iex)=ene_iex_iex
-               remd_ene(0,i)=ene_i_i
-               i=iex
-              endif 
-            endif
-           enddo
-           enddo
-c-------------------------------------
-             do i=1,nrep
-              if(iremd_tot(i).ne.0)
-     &          write(iout,'(a3,i4,2f12.5)') 'ACC',i,remd_t(i)
-     &           ,iremd_acc(i)/(1.0*iremd_tot(i))
-             enddo
-
-cd              write (iout,'(a6,100i4)') "ifirst",
-cd     &                    (ifirst(i),i=1,remd_m(1))
-cd              do il=1,nodes
-cd               write (iout,'(a5,i4,a1,100i4)') "nup",il,":",
-cd     &                    (nupa(i,il),i=1,nupa(0,il))
-cd               write (iout,'(a5,i4,a1,100i4)') "ndown",il,":",
-cd     &                    (ndowna(i,il),i=1,ndowna(0,il))
-cd              enddo
-          endif
-
-         call mpi_scatter(remd_t_bath,1,mpi_double_precision,
-     &           t_bath,1,mpi_double_precision,king,
-     &           CG_COMM,ierr) 
-         if(lmuca) then
-           call mpi_scatter(elowi,1,mpi_double_precision,
-     &           elow,1,mpi_double_precision,king,
-     &           CG_COMM,ierr) 
-           call mpi_scatter(ehighi,1,mpi_double_precision,
-     &           ehigh,1,mpi_double_precision,king,
-     &           CG_COMM,ierr) 
-         endif
-         call rescale_weights(t_bath)
-co         write (iout,*) "Processor",me,
-co     &    " rescaling weights with temperature",t_bath
-
-         stdfp=dsqrt(2*Rb*t_bath/d_time)
-         do i=1,ntyp
-           stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
-         enddo 
-
-cde         write(iout,*) 'REMD after',me,t_bath
-           time02=MPI_WTIME()
-           if (me.eq.king .or. .not. out1file) then
-            write(iout,*) 'REMD exchange time=',time02-time00
-            call flush(iout)
-           endif
-        endif
-      enddo
-
-      if (restart1file) then 
-          if (me.eq.king .or. .not. out1file)
-     &      write(iout,*) 'writing restart at the end of run'
-           call write1rst
-      endif
-
-      if (traj1file) call write1traj
-
-
-      t_MD=tcpu()-tt0
-      if (me.eq.king .or. .not. out1file) then
-       write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') 
-     &  '  Timing  ',
-     & 'MD calculations setup:',t_MDsetup,
-     & 'Energy & gradient evaluation:',t_enegrad,
-     & 'Stochastic MD setup:',t_langsetup,
-     & 'Stochastic MD step setup:',t_sdsetup,
-     & 'MD steps:',t_MD
-       write (iout,'(/28(1h=),a25,27(1h=))') 
-     & '  End of MD calculation  '
-      endif
-      return
-      end
-
-      subroutine write1rst
-      implicit real*8 (a-h,o-z)
-      include 'DIMENSIONS'
-      include 'mpif.h'
-      include 'COMMON.MD'
-      include 'COMMON.IOUNITS'
-      include 'COMMON.REMD'
-      include 'COMMON.SETUP'
-      include 'COMMON.CHAIN'
-      include 'COMMON.SBRIDGE'
-      include 'COMMON.INTERACT'
-               
-      real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
-     &     d_restart2(3,2*maxres*maxprocs)
-      real t5_restart1(5)
-      integer iret,itmp
-
-
-       t5_restart1(1)=totT
-       t5_restart1(2)=EK
-       t5_restart1(3)=potE
-       t5_restart1(4)=t_bath
-       t5_restart1(5)=Uconst
-       
-       call mpi_gather(t5_restart1,5,mpi_real,
-     &      t_restart1,5,mpi_real,king,CG_COMM,ierr)
-
-
-       do i=1,2*nres
-         do j=1,3
-           r_d(j,i)=d_t(j,i)
-         enddo
-       enddo
-       call mpi_gather(r_d,3*2*nres,mpi_real,
-     &           d_restart1,3*2*nres,mpi_real,king,
-     &           CG_COMM,ierr)
-
-
-       do i=1,2*nres
-         do j=1,3
-           r_d(j,i)=dc(j,i)
-         enddo
-       enddo
-       call mpi_gather(r_d,3*2*nres,mpi_real,
-     &           d_restart2,3*2*nres,mpi_real,king,
-     &           CG_COMM,ierr)
-
-       if(me.eq.king) then
-         open(irest1,file=mremd_rst_name,status='unknown')
-         write (irest1,*) (i2rep(i),i=0,nodes-1)
-         write (irest1,*) (ifirst(i),i=1,remd_m(1))
-         do il=1,nodes
-              write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
-              write (irest1,*) ndowna(0,il),
-     &                   (ndowna(i,il),i=1,ndowna(0,il))
-         enddo
-
-         do il=1,nodes
-           write(irest1,*) (t_restart1(j,il),j=1,4)
-         enddo
-
-         do il=0,nodes-1
-           do i=1,2*nres
-             write(irest1,'(3e15.5)') (d_restart1(j,i+2*nres*il),j=1,3)
-           enddo
-         enddo
-         do il=0,nodes-1
-           do i=1,2*nres
-             write(irest1,'(3e15.5)') (d_restart2(j,i+2*nres*il),j=1,3)
-           enddo
-         enddo
-         close(irest1)
-       endif
-
-
-      return
-      end
-
-      subroutine write1traj
-      implicit real*8 (a-h,o-z)
-      include 'DIMENSIONS'
-      include 'mpif.h'
-      include 'COMMON.MD'
-      include 'COMMON.IOUNITS'
-      include 'COMMON.REMD'
-      include 'COMMON.SETUP'
-      include 'COMMON.CHAIN'
-      include 'COMMON.SBRIDGE'
-      include 'COMMON.INTERACT'
-               
-      real t5_restart1(5)
-      integer iret,itmp
-      real xcoord(3,maxres2+2),prec
-      real r_qfrag(50),r_qpair(100)
-      real p_qfrag(50*maxprocs),p_qpair(100*maxprocs)
-      real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2)
-
-      if(.not.restart1file) then
-       t5_restart1(1)=totT
-       t5_restart1(2)=EK
-       t5_restart1(3)=potE
-       t5_restart1(4)=t_bath
-       t5_restart1(5)=Uconst
-       call mpi_gather(t5_restart1,5,mpi_real,
-     &      t_restart1,5,mpi_real,king,CG_COMM,ierr)
-      endif
-
-          do i=1,nfrag
-           r_qfrag(i)=qfrag(i)
-          enddo
-          do i=1,npair
-           r_qpair(i)=qpair(i)
-          enddo
-
-        call mpi_gather(r_qfrag,nfrag,mpi_real,
-     &           p_qfrag,nfrag,mpi_real,king,
-     &           CG_COMM,ierr)
-        call mpi_gather(qpair,nfrag,mpi_real,
-     &           p_qpair,nfrag,mpi_real,king,
-     &           CG_COMM,ierr)
-
-        do i=1,nres*2
-         do j=1,3
-          r_c(j,i)=c(j,i)
-         enddo
-        enddo
-
-        call mpi_gather(r_c,3*2*nres,mpi_real,
-     &           p_c,3*2*nres,mpi_real,king,
-     &           CG_COMM,ierr)
-
-       if(me.eq.king) then
-         call xdrfopen(ixdrf,cartname, "a", iret)
-         do il=1,nodes
-          call xdrffloat(ixdrf, real(t_restart1(1,il)), iret)
-          call xdrffloat(ixdrf, real(t_restart1(3,il)), iret)
-          call xdrffloat(ixdrf, real(t_restart1(5,il)), iret)
-          call xdrffloat(ixdrf, real(t_restart1(4,il)), iret)
-          call xdrfint(ixdrf, nss, iret) 
-          do j=1,nss
-           call xdrfint(ixdrf, ihpb(j), iret)
-           call xdrfint(ixdrf, jhpb(j), iret)
-          enddo
-          call xdrfint(ixdrf, nfrag+npair, iret)
-          do i=1,nfrag
-           call xdrffloat(ixdrf, p_qfrag(i+(il-1)*nfrag), iret)
-          enddo
-          do i=1,npair
-           call xdrffloat(ixdrf, p_qpair(i+(il-1)*npair), iret)
-          enddo
-          prec=10000.0
-          do i=1,nres
-           do j=1,3
-            xcoord(j,i)=p_c(j,i+(il-1)*nres*2)
-           enddo
-          enddo
-          do i=nnt,nct
-           do j=1,3
-            xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2)
-           enddo
-          enddo
-          itmp=nres+nct-nnt+1
-          call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
-         enddo
-         call xdrfclose(ixdrf, iret)
-       endif
-      return
-      end
-
-
-      subroutine read1restart
-      implicit real*8 (a-h,o-z)
-      include 'DIMENSIONS'
-      include 'mpif.h'
-      include 'COMMON.MD'
-      include 'COMMON.IOUNITS'
-      include 'COMMON.REMD'
-      include 'COMMON.SETUP'
-      include 'COMMON.CHAIN'
-      include 'COMMON.SBRIDGE'
-      include 'COMMON.INTERACT'
-      real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
-     &                 t5_restart1(5)
-
-         if(me.eq.king)then
-             open(irest2,file=mremd_rst_name,status='unknown')
-             read (irest2,*) (i2rep(i),i=0,nodes-1)
-             read (irest2,*) (ifirst(i),i=1,remd_m(1))
-             do il=1,nodes
-              read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
-              read (irest2,*) ndowna(0,il),
-     &                    (ndowna(i,il),i=1,ndowna(0,il))
-             enddo
-             do il=1,nodes
-               read(irest2,*) (t_restart1(j,il),j=1,4)
-             enddo
-         endif
-         call mpi_scatter(t_restart1,5,mpi_real,
-     &           t5_restart1,5,mpi_real,king,CG_COMM,ierr)
-         totT=t5_restart1(1)              
-         EK=t5_restart1(2)
-         potE=t5_restart1(3)
-         t_bath=t5_restart1(4)
-
-         if(me.eq.king)then
-              do il=0,nodes-1
-               do i=1,2*nres
-                read(irest2,'(3e15.5)') 
-     &                (d_restart1(j,i+2*nres*il),j=1,3)
-               enddo
-              enddo
-         endif
-         call mpi_scatter(d_restart1,3*2*nres,mpi_real,
-     &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-
-         do i=1,2*nres
-           do j=1,3
-            d_t(j,i)=r_d(j,i)
-           enddo
-         enddo
-         if(me.eq.king)then 
-              do il=0,nodes-1
-               do i=1,2*nres
-                read(irest2,'(3e15.5)') 
-     &                (d_restart1(j,i+2*nres*il),j=1,3)
-               enddo
-              enddo
-         endif
-         call mpi_scatter(d_restart1,3*2*nres,mpi_real,
-     &           r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-         do i=1,2*nres
-           do j=1,3
-            dc(j,i)=r_d(j,i)
-           enddo
-         enddo
-        if(me.eq.king) close(irest2)
-        return
-        end
-