X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2FMREMD.f90;h=69b8ae9c85236e4a45269af0e0a319d1a092143e;hb=10689ab7d813dfbdbb0c6e631d90234d78ea306a;hp=f33432fc91216af4fbb8837c1e0571134a026203;hpb=35f220f409bd5d21be33a402d79da2c23d3e0c3a;p=unres4.git diff --git a/source/unres/MREMD.f90 b/source/unres/MREMD.f90 index f33432f..69b8ae9 100644 --- a/source/unres/MREMD.f90 +++ b/source/unres/MREMD.f90 @@ -7,7 +7,7 @@ use remd_data use geometry_data use energy_data - use control_data, only:maxprocs +! use control_data, only:maxprocs use MDyn implicit none @@ -18,16 +18,16 @@ integer(kind=2),dimension(:),allocatable :: ifirst !(maxprocs) integer(kind=2),dimension(:,:),allocatable :: nupa,& ndowna !(0:maxprocs/4,0:maxprocs) - real(kind=8),dimension(:,:),allocatable :: t_restart1 !(5,maxprocs) + real(kind=4),dimension(:,:),allocatable :: t_restart1 !(5,maxprocs) integer,dimension(:),allocatable :: iset_restart1 !(maxprocs) ! common /traj1cache/ - real(kind=8),dimension(:),allocatable :: totT_cache,EK_cache,& + real(kind=4),dimension(:),allocatable :: totT_cache,EK_cache,& potE_cache,t_bath_cache,Uconst_cache !(max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: qfrag_cache !(50,max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: qpair_cache !(100,max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: ugamma_cache,& + real(kind=4),dimension(:,:),allocatable :: qfrag_cache !(50,max_cache_traj) + real(kind=4),dimension(:,:),allocatable :: qpair_cache !(100,max_cache_traj) + real(kind=4),dimension(:,:),allocatable :: ugamma_cache,& utheta_cache,uscdiff_cache !(maxfrag_back,max_cache_traj) - real(kind=8),dimension(:,:,:),allocatable :: c_cache !(3,maxres2+2,max_cache_traj) + real(kind=4),dimension(:,:,:),allocatable :: c_cache !(3,maxres2+2,max_cache_traj) integer :: ntwx_cache,ii_write !,max_cache_traj_use integer,dimension(:),allocatable :: iset_cache !(max_cache_traj) !----------------------------------------------------------------------------- @@ -82,21 +82,23 @@ integer :: ERRCODE real(kind=8),dimension(3) :: L,vcm real(kind=8) :: energia(0:n_ene) - real(kind=8) :: remd_t_bath(maxprocs) - integer :: iremd_iset(maxprocs) - integer(kind=2) :: i_index(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - real(kind=8) :: remd_ene(0:n_ene+4,maxprocs) - integer :: iremd_acc(maxprocs),iremd_tot(maxprocs) - integer :: iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs) + + real(kind=8) :: remd_t_bath(Nprocs) !(maxprocs) + integer :: iremd_iset(Nprocs) !(maxprocs) + 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) + integer :: iremd_acc_usa(Nprocs),iremd_tot_usa(Nprocs) !(maxprocs) integer :: rstcount !el ilen, !el external ilen character(len=50) :: tytul !el common /gucio/ cm integer :: itime !old integer nup(0:maxprocs),ndown(0:maxprocs) - integer :: rep2i(0:maxprocs),ireqi(maxprocs) - integer :: icache_all(maxprocs) - integer :: status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) + integer :: rep2i(0:Nprocs),ireqi(Nprocs) !(maxprocs) + integer :: icache_all(Nprocs) !(maxprocs) + integer :: status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,Nprocs)! (MPI_STATUS_SIZE,maxprocs) logical :: synflag, end_of_run, file_exist = .false.!, ovrtim real(kind=8) :: delta,time00,time01,time001,time02,time03,time04,& @@ -109,10 +111,11 @@ 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 -write(iout,*) "jestesmy na poczatku MREMD" ntwx_cache=0 time00=MPI_WTIME() time01=time00 @@ -121,16 +124,16 @@ write(iout,*) "jestesmy na poczatku MREMD" write (iout,*) "NREP=",nrep endif -write(iout,*) "jestesmy na poczatku MREMD" synflag=.false. if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst") 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) @@ -194,8 +197,8 @@ write(iout,*) "jestesmy na poczatku MREMD" !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*nodes)) - if(.not.allocated(d_restart2)) allocate(d_restart2(3,nres2*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------------- @@ -348,11 +351,15 @@ write(iout,*) "jestesmy na poczatku MREMD" if(me.eq.king.or..not.out1file) & write(iout,*) me,"iset=",iset,"t_bath=",t_bath endif -! - stdfp=dsqrt(2*Rb*t_bath/d_time) +! + do i=1,5 + stdfp(i)=dsqrt(2*Rb*t_bath/d_time) + enddo + do j=1,5 do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) + stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time) enddo + enddo ! print *,'irep',me,t_bath if (.not.rest) then @@ -384,10 +391,12 @@ write(iout,*) "jestesmy na poczatku MREMD" 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 j=1,5 + stdfp(j)=dsqrt(2*Rb*t_bath/d_time) do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) + stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time) enddo + enddo call rescale_weights(t_bath) endif @@ -535,7 +544,10 @@ write(iout,*) "jestesmy na poczatku MREMD" #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 @@ -554,7 +566,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) @@ -601,7 +613,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) @@ -678,7 +690,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) @@ -699,7 +711,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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, @@ -731,12 +743,15 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) @@ -831,6 +846,7 @@ write(iout,*) "jestesmy na poczatku MREMD" remd_t_bath(i)=remd_ene(n_ene+1,i) iremd_iset(i)=remd_ene(n_ene+2,i) enddo +#ifdef DEBUG if(lmuca) then !o write(iout,*) 'REMD exchange temp,ene,elow,ehigh' do i=1,nodes @@ -844,6 +860,7 @@ write(iout,*) "jestesmy na poczatku MREMD" write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) enddo endif +#endif !------------------------------------- IF(.not.usampl) THEN write (iout,*) "Enter exchnge, remd_m",remd_m(1),& @@ -857,7 +874,9 @@ write(iout,*) "jestesmy na poczatku MREMD" do ii=1,nodes-1 +#ifdef DEBUG write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i)) +#endif if(i.gt.0.and.nupa(0,i).gt.0) then iex=i ! if (i.eq.1 .and. int(nupa(0,i)).eq.1) then @@ -915,7 +934,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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 @@ -1216,6 +1235,12 @@ write(iout,*) "jestesmy na poczatku MREMD" time06=MPI_WTIME() !d write (iout,*) "Before scatter" !d call flush(iout) +#ifdef DEBUG + if (me.eq.king) then + write (iout,*) "t_bath before scatter",remd_t_bath + call flush(iout) + endif +#endif call mpi_scatter(remd_t_bath,1,mpi_double_precision,& t_bath,1,mpi_double_precision,king,& CG_COMM,ierr) @@ -1242,16 +1267,25 @@ write(iout,*) "jestesmy na poczatku MREMD" call rescale_weights(t_bath) !o write (iout,*) "Processor",me, !o & " rescaling weights with temperature",t_bath - - stdfp=dsqrt(2*Rb*t_bath/d_time) + do j=1,5 + stdfp(j)=dsqrt(2*Rb*t_bath/d_time) do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) + stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time) enddo + enddo !de 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 + write(iout,*) 'REMD exchange time 8-0=',time08-time00 + write(iout,*) 'REMD exchange time 8-7=',time08-time07 + write(iout,*) 'REMD exchange time 7-6=',time07-time06 + write(iout,*) 'REMD exchange time 6-5=',time06-time05 + write(iout,*) 'REMD exchange time 5-4=',time05-time04 + write(iout,*) 'REMD exchange time 4-3=',time04-time03 + write(iout,*) 'REMD exchange time 3-2=',time03-time02 + write(iout,*) 'REMD exchange time 2-1=',time02-time01 + write(iout,*) 'REMD exchange time 1-0=',time01-time00 call flush(iout) endif endif @@ -1291,9 +1325,9 @@ write(iout,*) "jestesmy na poczatku MREMD" ' End of MD calculation ' endif !el common /przechowalnia/ - deallocate(d_restart1) - deallocate(d_restart2) - deallocate(p_c) +! deallocate(d_restart1) +! deallocate(d_restart2) +! deallocate(p_c) !el-------------- return end subroutine MREMD @@ -1314,10 +1348,13 @@ write(iout,*) "jestesmy na poczatku MREMD" !el real(kind=4) :: d_restart1(3,2*nres*maxprocs),& !el d_restart2(3,2*nres*maxprocs) - real(kind=4) :: r_d(3,2*nres) + real(kind=4) :: r_d(3,0:2*nres) real(kind=4) :: t5_restart1(5) integer :: iret,itmp - integer(kind=2) :: i_index(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) +! integer(kind=2) :: i_index(Nprocs/4,Nprocs/20,Nprocs/200,Nprocs/200) + integer(kind=2) :: i_index(Nprocs,Nprocs,Nprocs,Nprocs) + + !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1,d_restart2 integer :: i,j,il,il1,ierr,ixdrf @@ -1331,23 +1368,26 @@ write(iout,*) "jestesmy na poczatku MREMD" t_restart1,5,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,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,& + call mpi_gather(r_d,3*2*nres+3,mpi_real,& + d_restart1,3*2*nres+3,mpi_real,king,& CG_COMM,ierr) + do j=1,3 + dc(j,0)=c(j,1) + enddo - do i=1,2*nres + do i=0,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,& + call mpi_gather(r_d,3*2*nres+3,mpi_real,& + d_restart2,3*2*nres+3,mpi_real,king,& CG_COMM,ierr) if(me.eq.king) then @@ -1376,16 +1416,16 @@ write(iout,*) "jestesmy na poczatku MREMD" enddo do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres do j=1,3 - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat_(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) enddo enddo enddo do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres do j=1,3 - call xdrffloat_(ixdrf, d_restart2(j,i+2*nres*il), iret) + call xdrffloat_(ixdrf, d_restart2(j,i+(2*nres+1)*il), iret) enddo enddo enddo @@ -1436,16 +1476,16 @@ write(iout,*) "jestesmy na poczatku MREMD" enddo do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) enddo enddo enddo do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres do j=1,3 - call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret) + call xdrffloat(ixdrf, d_restart2(j,i+(2*nres+1)*il), iret) enddo enddo enddo @@ -1495,9 +1535,9 @@ write(iout,*) "jestesmy na poczatku MREMD" real(kind=4) :: xcoord(3,2*nres+2),prec real(kind=4) :: r_qfrag(50),r_qpair(100) real(kind=4) :: r_utheta(50),r_ugamma(100),r_uscdiff(100) - real(kind=4) :: p_qfrag(50*maxprocs),p_qpair(100*maxprocs) - real(kind=4) :: p_utheta(50*maxprocs),p_ugamma(100*maxprocs),& - p_uscdiff(100*maxprocs) + real(kind=4) :: p_qfrag(50*Nprocs),p_qpair(100*Nprocs) !(100*maxprocs) + real(kind=4) :: p_utheta(50*Nprocs),p_ugamma(100*Nprocs),& + p_uscdiff(100*Nprocs) !(100*maxprocs) !el real(kind=4) :: p_c(3,(nres2+2)*maxprocs) real(kind=4) :: r_c(3,2*nres+2) !el common /przechowalnia/ p_c @@ -1517,13 +1557,22 @@ write(iout,*) "jestesmy na poczatku MREMD" if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) #endif do ii=1,ii_write +! write (iout,*) "before gather write1traj: from node",ii +! call flush(iout) +! write (iout,*) totT_cache(ii),EK_cache(ii),potE_cache(ii),t_bath_cache(ii),Uconst_cache(ii) +! call flush(iout) 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) +! write (iout,*) "before gather write1traj: from node",ii,t5_restart1(1),t5_restart1(3),t5_restart1(5),t5_restart1(4) + call flush(iout) call mpi_gather(t5_restart1,5,mpi_real,& t_restart1,5,mpi_real,king,CG_COMM,ierr) +! do il=1,nodes +! write (iout,*) "after gather write1traj: from node",il,t_restart1(1,il),t_restart1(3,il),t_restart1(5,il),t_restart1(4,il) +! enddo call mpi_gather(iset_cache(ii),1,mpi_integer,& iset_restart1,1,mpi_integer,king,CG_COMM,ierr) @@ -1627,6 +1676,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) +! write (iout,*) "write1traj: from node",ii,t_restart1(1,il),t_restart1(3,il),t_restart1(5,il),t_restart1(4,il) call xdrfint(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then @@ -1716,8 +1766,11 @@ write(iout,*) "jestesmy na poczatku MREMD" ! include 'COMMON.SBRIDGE' ! include 'COMMON.INTERACT' !el real(kind=4) :: d_restart1(3,2*nres*maxprocs) - real(kind=4) :: r_d(3,2*nres),t5_restart1(5) - integer(kind=2) :: i_index(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) + 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,Nprocs,Nprocs,Nprocs) + + !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1 integer :: i,j,il,il1,ierr,itmp,iret,ixdrf @@ -1792,45 +1845,45 @@ write(iout,*) "jestesmy na poczatku MREMD" if(me.eq.king)then do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres ! read(irest2,'(3e15.5)') ! & (d_restart1(j,i+2*nres*il),j=1,3) do j=1,3 #ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat_(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) #else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) #endif enddo enddo enddo endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real,& - r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) + call mpi_scatter(d_restart1,3*2*nres+3,mpi_real,& + r_d,3*2*nres+3,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,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 + do i=0,2*nres ! read(irest2,'(3e15.5)') ! & (d_restart1(j,i+2*nres*il),j=1,3) do j=1,3 #ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat_(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) #else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) + call xdrffloat(ixdrf, d_restart1(j,i+(2*nres+1)*il), iret) #endif enddo 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 + call mpi_scatter(d_restart1,3*2*nres+3,mpi_real,& + r_d,3*2*nres+3,mpi_real,king,CG_COMM,ierr) + do i=0,2*nres do j=1,3 dc(j,i)=r_d(j,i) enddo @@ -1902,7 +1955,7 @@ write(iout,*) "jestesmy na poczatku MREMD" ! include 'COMMON.SBRIDGE' ! include 'COMMON.INTERACT' !el real(kind=4) :: d_restart1(3,2*nres*maxprocs) - real(kind=4) :: r_d(3,2*nres),t5_restart1(5) + real(kind=4) :: r_d(3,0:2*nres),t5_restart1(5) !el common /przechowalnia/ d_restart1 integer :: i,j,il,ierr @@ -1929,16 +1982,16 @@ write(iout,*) "jestesmy na poczatku MREMD" if(me.eq.king)then do il=0,nodes-1 - do i=1,2*nres + do i=0,2*nres read(irest2,'(3e15.5)') & - (d_restart1(j,i+2*nres*il),j=1,3) + (d_restart1(j,i+(2*nres+1)*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) + call mpi_scatter(d_restart1,3*2*nres+3,mpi_real,& + r_d,3*2*nres+3,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres + do i=0,2*nres do j=1,3 d_t(j,i)=r_d(j,i) enddo @@ -1947,13 +2000,13 @@ write(iout,*) "jestesmy na poczatku MREMD" do il=0,nodes-1 do i=1,2*nres read(irest2,'(3e15.5)') & - (d_restart1(j,i+2*nres*il),j=1,3) + (d_restart1(j,i+(2*nres+1)*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 + call mpi_scatter(d_restart1,3*2*nres+3,mpi_real,& + r_d,3*2*nres+3,mpi_real,king,CG_COMM,ierr) + do i=0,2*nres do j=1,3 dc(j,i)=r_d(j,i) enddo @@ -1965,7 +2018,7 @@ write(iout,*) "jestesmy na poczatku MREMD" subroutine alloc_MREMD_arrays ! if(.not.allocated(mset)) allocate(mset(max0(nset,1))) - if(.not.allocated(stdfsc)) allocate(stdfsc(ntyp1)) !(ntyp1)) + if(.not.allocated(stdfsc)) allocate(stdfsc(ntyp1,5)) !(ntyp1)) ! commom.remd ! common /remdcommon/ in io: read_REMDpar ! real(kind=8),dimension(:),allocatable :: remd_t !(maxprocs)