X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2FMREMD.f90;h=69b8ae9c85236e4a45269af0e0a319d1a092143e;hb=10689ab7d813dfbdbb0c6e631d90234d78ea306a;hp=97a91e56b007dfe89125a306d98c37dced2d2aff;hpb=e42cb389c07a8bdb6de95554720f33e09c701cce;p=unres4.git diff --git a/source/unres/MREMD.f90 b/source/unres/MREMD.f90 index 97a91e5..69b8ae9 100644 --- a/source/unres/MREMD.f90 +++ b/source/unres/MREMD.f90 @@ -82,9 +82,10 @@ integer :: ERRCODE real(kind=8),dimension(3) :: L,vcm real(kind=8) :: energia(0:n_ene) + real(kind=8) :: remd_t_bath(Nprocs) !(maxprocs) integer :: iremd_iset(Nprocs) !(maxprocs) - integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,max0(Nprocs/200,1),max0(Nprocs/200,1)) + integer(kind=2) :: i_index(Nprocs,Nprocs,Nprocs,Nprocs) ! (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) real(kind=8) :: remd_ene(0:n_ene+4,Nprocs) !(0:n_ene+4,maxprocs) integer :: iremd_acc(Nprocs),iremd_tot(Nprocs) !(maxprocs) @@ -110,6 +111,8 @@ integer,dimension(4,nres/3) :: iharp !(4,nres/3)(4,maxres/3) !deb imin_itime_old=0 integer :: nres2 !el + WRITE(iout,*) "JUST AFTER CALL" +! if (.not.allocated(remd_ene)) allocate(remd_ene(0:n_ene+4,Nprocs)) nres2=2*nres time001=0.0d0 @@ -127,9 +130,10 @@ endif mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst" -!d print *,'MREMD',nodes -!d print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep) -!de write (iout,*) "Start MREMD: me",me," t_bath",t_bath + print *,'MREMD',nodes + print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep) + write (iout,*) "Start MREMD: me",me," t_bath",t_bath + print *,"NSET=",nset, "MSET=", mset k=0 rep2i(k)=-1 do il=1,max0(nset,1) @@ -193,8 +197,8 @@ !d print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) !el common /przechowalnia/ - if(.not.allocated(d_restart1)) allocate(d_restart1(3,(nres2+1)*nodes)) - if(.not.allocated(d_restart2)) allocate(d_restart2(3,(nres2+1)*nodes)) + if(.not.allocated(d_restart1)) allocate(d_restart1(3,0:(nres2+1)*nodes)) + if(.not.allocated(d_restart2)) allocate(d_restart2(3,0:(nres2+1)*nodes)) if(.not.allocated(p_c)) allocate(p_c(3,(nres2+2)*nodes)) !el------------- @@ -540,7 +544,10 @@ #endif endif if(ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) + if (mod(itime,ntwe).eq.0) then + call statout(itime) + call enerprint(potEcomp) + endif endif if (mod(itime,ntwx).eq.0.and..not.traj1file) then write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath @@ -559,7 +566,7 @@ if (max_cache_traj_use.ne.1) & print *,itime,"processor ",me," over cache ",ntwx_cache do i=1,ntwx_cache-1 - + call returnbox totT_cache(i)=totT_cache(i+1) EK_cache(i)=EK_cache(i+1) potE_cache(i)=potE_cache(i+1) @@ -606,7 +613,7 @@ ugamma_cache(i,ntwx_cache)=ugamma(i) uscdiff_cache(i,ntwx_cache)=uscdiff(i) enddo - +! call returnbox do i=1,nres*2 do j=1,3 c_cache(j,i,ntwx_cache)=c(j,i) @@ -683,7 +690,7 @@ icache_all,1,mpi_integer,king,& CG_COMM,ierr) if (.not.out1file) & - write(iout,*) 'REMD synchro at',itime_master,itime + write(iout,*) 'REMD synchro at3',itime_master,itime if (itime_master.ge.n_timestep .or. ovrtim()) & end_of_run=.true. !time call flush(iout) @@ -704,7 +711,7 @@ call mpi_waitall(nodes-1,ireqi,statusi,ierr) call mpi_barrier(CG_COMM, ierr) time01=MPI_WTIME() - write(iout,*) 'REMD synchro at',itime,'time=',time01-time00 + write(iout,*) 'REMD synchro at2',itime,'time=',time01-time00 if (out1file.or.traj1file) then !deb call mpi_gather(itime,1,mpi_integer, !deb & itime_all,1,mpi_integer,king, @@ -736,12 +743,15 @@ if(mremdsync .and. mod(itime,nstex).eq.0) then synflag=.true. if (me.eq.king .or. .not. out1file) & - write(iout,*) 'REMD synchro at',itime - + write(iout,*) 'REMD synchro at1',itime,ntwx_cache,Nprocs,nodes + write(iout,*) icache_all if(traj1file) then + write(iout,*) "before mpi_gather ntwx_cache" call mpi_gather(ntwx_cache,1,mpi_integer,& - icache_all,1,mpi_integer,king,& + icache_all(1),1,mpi_integer,king,& ! CONSULT WITH ADAM CG_COMM,ierr) + write(iout,*) "after mpi_gather ntwx_cache" + if (me.eq.king) then write(iout,'(a19,8000i8)') ' ntwx_cache',& (icache_all(i),i=1,nodes) @@ -924,7 +934,7 @@ ene_i_iex=remd_ene(0,i) ! write (iout,*) "0,iex",remd_t_bath(iex) -! call enerprint(remd_ene(0,iex)) + call enerprint(remd_ene(0,iex)) call sum_energy(remd_ene(0,iex),.false.) if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then @@ -1342,7 +1352,7 @@ real(kind=4) :: t5_restart1(5) integer :: iret,itmp ! integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,Nprocs/200,Nprocs/200) - integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,max0(Nprocs/200,1),max0(Nprocs/200,1)) + integer(kind=2) :: i_index(Nprocs,Nprocs,Nprocs,Nprocs) !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1,d_restart2 @@ -1758,7 +1768,7 @@ !el real(kind=4) :: d_restart1(3,2*nres*maxprocs) real(kind=4) :: r_d(3,0:2*nres),t5_restart1(5) ! integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,Nprocs/200,Nprocs/200) - integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,max0(Nprocs/200,1),max0(Nprocs/200,1)) + integer(kind=2) :: i_index(Nprocs,Nprocs,Nprocs,Nprocs) !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1