X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2FMREMD.f90;h=350ab5288fff529ca3568895ba623810967a2bf3;hb=8ca97b16fe25b7053f258263899ba030572cc58f;hp=92a11783058a83321d56eccf4ae0ef8e171f0b59;hpb=299e2c41124d3fa8adba7244716515a2cc160ed1;p=unres4.git diff --git a/source/unres/MREMD.f90 b/source/unres/MREMD.f90 index 92a1178..350ab52 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 @@ -82,21 +82,22 @@ 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/4,Nprocs/20,Nprocs/200,Nprocs/200) +! (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,& @@ -192,8 +193,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*nodes)) - if(.not.allocated(d_restart2)) allocate(d_restart2(3,nres2*nodes)) + 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(p_c)) allocate(p_c(3,(nres2+2)*nodes)) !el------------- @@ -346,11 +347,15 @@ 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 @@ -382,10 +387,12 @@ 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 @@ -1250,11 +1257,12 @@ 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() @@ -1330,10 +1338,11 @@ !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) + !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1,d_restart2 integer :: i,j,il,il1,ierr,ixdrf @@ -1347,23 +1356,26 @@ 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 @@ -1392,16 +1404,16 @@ 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 @@ -1452,16 +1464,16 @@ 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 @@ -1511,9 +1523,9 @@ 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 @@ -1742,8 +1754,9 @@ ! 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) + !(maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) !el common /przechowalnia/ d_restart1 integer :: i,j,il,il1,ierr,itmp,iret,ixdrf @@ -1818,45 +1831,45 @@ 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 @@ -1928,7 +1941,7 @@ ! 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 @@ -1955,16 +1968,16 @@ 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 @@ -1973,13 +1986,13 @@ 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 @@ -1991,7 +2004,7 @@ 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)