X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_MD%2Fsrc%2Fold_F%2FMREMD.F.drabinka;fp=source%2Funres%2Fsrc_MD%2Fsrc%2Fold_F%2FMREMD.F.drabinka;h=0000000000000000000000000000000000000000;hb=0a11a2c4ccee14ed99ae44f2565b270ba8d4bbb6;hp=5b4c9978fed3831d57b6808452fd205782bfa9eb;hpb=5eb407964903815242c59de10960f42761139e10;p=unres.git diff --git a/source/unres/src_MD/src/old_F/MREMD.F.drabinka b/source/unres/src_MD/src/old_F/MREMD.F.drabinka deleted file mode 100644 index 5b4c997..0000000 --- a/source/unres/src_MD/src/old_F/MREMD.F.drabinka +++ /dev/null @@ -1,1199 +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 -cold integer nup(0:maxprocs),ndown(0:maxprocs) - integer rep2i(0:maxprocs),ireqi(maxprocs) - integer itime_all(maxprocs) - integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - 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) - -cold if (i2rep(me).eq.nrep) then -cold nup(0)=0 -cold else -cold nup(0)=remd_m(i2rep(me)+1) -cold k=rep2i(int(i2rep(me)))+1 -cold do i=1,nup(0) -cold nup(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0)) - -cold if (i2rep(me).eq.1) then -cold ndown(0)=0 -cold else -cold ndown(0)=remd_m(i2rep(me)-1) -cold k=rep2i(i2rep(me)-2)+1 -cold do i=1,ndown(0) -cold ndown(i)=k -cold k=k+1 -cold enddo -cold 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 IF (.not.(rest.and.file_exist)) THEN - 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(int(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(int(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 (mod(itime,ntwx).eq.0.and.traj1file) then - if(ntwx_cache.lt.max_cache_traj) then - ntwx_cache=ntwx_cache+1 - - totT_cache(ntwx_cache)=totT - EK_cache(ntwx_cache)=EK - potE_cache(ntwx_cache)=potE - t_bath_cache(ntwx_cache)=t_bath - Uconst_cache(ntwx_cache)=Uconst - - do i=1,nfrag - qfrag_cache(i,ntwx_cache)=qfrag(i) - enddo - do i=1,npair - qpair_cache(i,ntwx_cache)=qpair(i) - enddo - - do i=1,nres*2 - do j=1,3 - c_cache(j,i,ntwx_cache)=c(j,i) - enddo - enddo - else - print *,itime,"processor ",me," over cache ",ntwx_cache - 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,i_sync_step).eq.0 .and. me.ne.king - & .and. .not. mremdsync) then - synflag=.false. - call mpi_iprobe(0,101,mpi_comm_world,synflag,status,ierr) - if (synflag) then - call mpi_recv(itime_master, 1, MPI_INTEGER, - & 0,101,mpi_comm_world, status, ierr) - call mpi_barrier(mpi_comm_world, ierr) - if (out1file.or.traj1file) then - call mpi_gather(itime,1,mpi_integer, - & itime_all,1,mpi_integer,king, - & mpi_comm_world,ierr) - endif - if (.not.out1file) - & write(iout,*) 'REMD synchro at',itime_master,itime - if(itime_master.ge.n_timestep) end_of_run=.true. -ctime 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, - & mpi_comm_world, ireqi(i), ierr) -cd write(iout,*) 'REMD synchro with',i -cd call flush(iout) - enddo - call mpi_waitall(nodes-1,ireqi,statusi,ierr) - call mpi_barrier(mpi_comm_world, ierr) - time01=MPI_WTIME() - write(iout,*) 'REMD synchro at',itime,'time=',time01-time00 - if (out1file.or.traj1file) then - call mpi_gather(itime,1,mpi_integer, - & itime_all,1,mpi_integer,king, - & mpi_comm_world,ierr) -ctime write(iout,'(a19,8000i8)') ' REMD synchro itime', -ctime & (itime_all(i),i=1,nodes) - if(traj1file) then - imin_itime=itime_all(1) - do i=2,nodes - if(itime_all(i).lt.imin_itime) imin_itime=itime_all(i) - enddo - ii_write=(imin_itime-imin_itime_old)/ntwx - imin_itime_old=int(imin_itime/ntwx)*ntwx - write(iout,*) imin_itime,imin_itime_old,ii_write - endif - endif -ctime 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 - time02=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 & mpi_comm_world,ierr) - potEcomp(n_ene+1)=t_bath - potEcomp(n_ene+2)=iset - call mpi_gather(potEcomp(0),n_ene+3,mpi_double_precision, - & remd_ene(0,1),n_ene+3,mpi_double_precision,king, - & mpi_comm_world,ierr) - if(lmuca) then - call mpi_gather(elow,1,mpi_double_precision, - & elowi,1,mpi_double_precision,king, - & mpi_comm_world,ierr) - call mpi_gather(ehigh,1,mpi_double_precision, - & ehighi,1,mpi_double_precision,king, - & mpi_comm_world,ierr) - endif - - time03=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD gather times=',time03-time01 - & ,time03-time02 - endif - - if (restart1file) call write1rst - - time04=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing rst time=',time04-time03 - endif - - if (traj1file) call write1traj - - time05=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing traj time=',time05-time04 - endif - - - 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)) - ene_iex_i=remd_ene(0,iex) -cd write (iout,*) "ene_iex_i",remd_ene(0,iex) - call sum_energy(remd_ene(0,i)) -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)) -c write (iout,*) "ene_i_iex",remd_ene(0,i) - ene_i_iex=remd_ene(0,i) - call sum_energy(remd_ene(0,iex)) - 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(int(i2rep(i-1)))=iremd_tot(int(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(int(i2rep(i-1)))=iremd_acc(int(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 - - time06=MPI_WTIME() - call mpi_scatter(remd_t_bath,1,mpi_double_precision, - & t_bath,1,mpi_double_precision,king, - & mpi_comm_world,ierr) - time07=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD scatter time=',time07-time06 - endif - - if(lmuca) then - call mpi_scatter(elowi,1,mpi_double_precision, - & elow,1,mpi_double_precision,king, - & mpi_comm_world,ierr) - call mpi_scatter(ehighi,1,mpi_double_precision, - & ehigh,1,mpi_double_precision,king, - & mpi_comm_world,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 - time08=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD exchange time=',time08-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,mpi_comm_world,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, - & mpi_comm_world,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, - & mpi_comm_world,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 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,mpi_comm_world,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, - & mpi_comm_world,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, - & mpi_comm_world,ierr) - - if(me.eq.king) then -c open(irest1,file=mremd_rst_name,status='unknown') - call xdrfopen(ixdrf,mremd_rst_name, "w", iret) -c write (irest1,*) (i2rep(i),i=0,nodes-1) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo -c write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes -c write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - do i=0,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - -c write (irest1,*) ndowna(0,il), -c & (ndowna(i,il),i=1,ndowna(0,il)) - do i=0,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes -c write(irest1,*) (t_restart1(j,il),j=1,4) - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres -c write(irest1,'(3e15.5)') (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres -c write(irest1,'(3e15.5)') (d_restart2(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo -c close(irest1) - call xdrfclose(ixdrf, iret) - 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) - - call mpi_bcast(ii_write,1,mpi_integer, - & king,mpi_comm_world,ierr) - - print *,'traj1file',me,ii_write,ntwx_cache - - if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) - do ii=1,ii_write - t5_restart1(1)=totT_cache(ii) - t5_restart1(2)=EK_cache(ii) - t5_restart1(3)=potE_cache(ii) - t5_restart1(4)=t_bath_cache(ii) - t5_restart1(5)=Uconst_cache(ii) - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,mpi_comm_world,ierr) - - do i=1,nfrag - r_qfrag(i)=qfrag_cache(i,ii) - enddo - do i=1,npair - r_qpair(i)=qpair_cache(i,ii) - enddo - - call mpi_gather(r_qfrag,nfrag,mpi_real, - & p_qfrag,nfrag,mpi_real,king, - & mpi_comm_world,ierr) - call mpi_gather(r_qpair,npair,mpi_real, - & p_qpair,npair,mpi_real,king, - & mpi_comm_world,ierr) - - do i=1,nres*2 - do j=1,3 - r_c(j,i)=c_cache(j,i,ii) - enddo - enddo - - call mpi_gather(r_c,3*2*nres,mpi_real, - & p_c,3*2*nres,mpi_real,king, - & mpi_comm_world,ierr) - - if(me.eq.king) then - - 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 - endif - enddo - if(me.eq.king) call xdrfclose(ixdrf, iret) - do i=1,ntwx_cache-ii_write - - totT_cache(i)=totT_cache(ii_write+i) - EK_cache(i)=EK_cache(ii_write+i) - potE_cache(i)=potE_cache(ii_write+i) - t_bath_cache(i)=t_bath_cache(ii_write+i) - Uconst_cache(i)=Uconst_cache(ii_write+i) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,ii_write+i) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,ii_write+i) - enddo - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,ii_write+i) - enddo - enddo - enddo - ntwx_cache=ntwx_cache-ii_write - 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,*,err=334) i - write(iout,*) "Reading old rst in ASCI format" - close(irest2) - call read1restart_old - return - 334 continue - call xdrfopen(ixdrf,mremd_rst_name, "r", iret) - -c read (irest2,*) (i2rep(i),i=0,nodes-1) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo -c read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes -c read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - call xdrfint(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - -c read (irest2,*) ndowna(0,il), -c & (ndowna(i,il),i=1,ndowna(0,il)) - call xdrfint(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes -c read(irest2,*) (t_restart1(j,il),j=1,4) - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,mpi_comm_world,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 -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,mpi_comm_world,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 -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,mpi_comm_world,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 - - subroutine read1restart_old - 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,mpi_comm_world,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,mpi_comm_world,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,mpi_comm_world,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 - \ No newline at end of file