X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fmake_xx_list.F;h=a1f6b45d9ceac850881fedb8289bb735e255c725;hb=43dfdc33f5b338546258b5a882326f97a76b5bd4;hp=480aeb2484929ac645ff50174caea746a11438b1;hpb=68aa1d135805a14583695611acfcf637748b4466;p=unres.git diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index 480aeb2..a1f6b45 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -22,6 +22,7 @@ ! print *,"START make_SC" #ifdef DEBUG write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res + write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e #endif r_buff_list=5.0d0 ilist_sc=0 @@ -100,9 +101,9 @@ #ifdef MPI #ifdef DEBUG write (iout,*) "before MPIREDUCE",ilist_sc - do i=1,ilist_sc - write (iout,*) i,contlisti(i),contlistj(i) - enddo +c do i=1,ilist_sc +c write (iout,*) i,contlisti(i),contlistj(i) +c enddo #endif if (nfgtasks.gt.1)then @@ -171,10 +172,226 @@ c write (iout,*) "SCSC after bcast ierr",ierr write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo #endif - call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) + call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) +#ifdef DEBUG + write (iout,*) "g_listscsc_start",g_listscsc_start, + & "g_listscsc_end",g_listscsc_end return +#endif end -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine make_SCSC_inter_list_RESPA + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + include "COMMON.CONTROL" + include "COMMON.CHAIN" + include "COMMON.INTERACT" + include "COMMON.SPLITELE" + include "COMMON.IOUNITS" + double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp + double precision dist_init, dist_temp,r_buff_list + integer contlisti_long(maxint_res*maxres), + & contlisti_short(maxint_res*maxres), + & contlistj_long(maxint_res*maxres), + & contlistj_short(maxint_res*maxres) +! integer :: newcontlisti(200*nres),newcontlistj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_sc_long,g_ilist_sc_long,ilist_sc_short,g_ilist_sc_short + integer displ(0:max_fg_procs),i_ilist_sc_long(0:max_fg_procs), + & i_ilist_sc_short(0:max_fg_procs),ierr + logical lprn /.false./ + double precision boxshift + double precision d_scale,r_respa_buf +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res + write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e +#endif + r_buff_list=5.0d0 + r_respa_buf=rlamb + ilist_sc_long=0 + ilist_sc_short=0 + do i=iatsc_s,iatsc_e + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + do iint=1,nint_gr(i) + do j=istart(i,iint),iend(i,iint) + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) +! r_buff_list is a read value for a buffer + if (dist_init.le.(r_cut_int+r_buff_list)) then +! Here the list is created + d_scale=dist_init/sigmaii(itypi,itypj) + if (d_scale.le.r_cut_respa+r_respa_buf) then + ilist_sc_short=ilist_sc_short+1 + contlisti_short(ilist_sc_short)=i + contlistj_short(ilist_sc_short)=j + endif + if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then + ilist_sc_long=ilist_sc_long+1 +! this can be substituted by cantor and anti-cantor + contlisti_long(ilist_sc_long)=i + contlistj_long(ilist_sc_long)=j + endif + endif + enddo + enddo + enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE ilist_sc_long",ilist_sc_long +c do i=1,ilist_sc_long +c write (iout,*) i,contlisti_long(i),contlistj_long(i) +c enddo + write (iout,*) "before MPIREDUCE ilist_sc_short",ilist_sc_short +c do i=1,ilist_sc_short +c write (iout,*) i,contlisti_short(i),contlistj_short(i) +c enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_sc_long,g_ilist_sc_long,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_sc_short,g_ilist_sc_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCSC after reduce ierr",ierr + if (fg_rank.eq.0.and.(g_ilist_sc_long.gt.maxres*maxint_res .or. + & g_ilist_sc_short.gt.maxres*maxint_res)) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCSC interactions", + & g_ilist_sc_long,g_ilist_sc_short, + & " only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCSC interactions", + & g_ilist_sc_long+g_ilist_sc_short," only", + & maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif +c write(iout,*) "before bcast",g_ilist_sc_long + call MPI_Gather(ilist_sc_long,1,MPI_INTEGER, + & i_ilist_sc_long,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_sc_long(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlisti_long,ilist_sc_long,MPI_INTEGER, + & newcontlisti_long,i_ilist_sc_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr + call MPI_Gatherv(contlistj_long,ilist_sc_long,MPI_INTEGER, + & newcontlistj_long,i_ilist_sc_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_sc_long,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc_long +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlisti_long,g_ilist_sc_long,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr + call MPI_Bcast(newcontlistj_long,g_ilist_sc_long,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC after bcast ierr",ierr +! write(iout,*) "before gather",displ(0),displ(1) +c write(iout,*) "before bcast",g_ilist_sc_short + call MPI_Gather(ilist_sc_short,1,MPI_INTEGER, + & i_ilist_sc_short,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCSC after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_sc_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlisti_short,ilist_sc_short,MPI_INTEGER, + & newcontlisti_short,i_ilist_sc_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr + call MPI_Gatherv(contlistj_short,ilist_sc_short,MPI_INTEGER, + & newcontlistj_short,i_ilist_sc_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_sc_short,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc_short +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlisti_short,g_ilist_sc_short,MPI_INT,king, + & FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr + call MPI_Bcast(newcontlistj_short,g_ilist_sc_short,MPI_INT,king, + ^ FG_COMM,IERR) +c write (iout,*) "SCSC after bcast ierr",ierr + else +#endif + g_ilist_sc_long=ilist_sc_long + + do i=1,ilist_sc_long + newcontlisti_long(i)=contlisti_long(i) + newcontlistj_long(i)=contlistj_long(i) + enddo + + g_ilist_sc_short=ilist_sc_short + + do i=1,ilist_sc_short + newcontlisti_short(i)=contlisti_short(i) + newcontlistj_short(i)=contlistj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,2i10,a,2i4)') + & "Number of long- and short-range SC-SC interactions", + & g_ilist_sc_long,g_ilist_sc_short," per residue on average", + & g_ilist_sc_long/nres,g_ilist_sc_short/nres +#ifdef DEBUG + write (iout,*) + & "make_SCSC_inter_list: g_ilist_sc_long after GATHERV", + & g_ilist_sc_long + write (iout,*) "List of long-range SCSC interactions" + do i=1,g_ilist_sc_long + write (iout,*) i,newcontlisti_long(i),newcontlistj_long(i) + enddo + write (iout,*) + & "make_SCSC_inter_list: g_ilist_sc_short after GATHERV", + & g_ilist_sc_short + write (iout,*) "List of short-range SCSC interactions" + do i=1,g_ilist_sc_short + write (iout,*) i,newcontlisti_short(i),newcontlistj_short(i) + enddo +#endif + call int_bounds(g_ilist_sc_long,g_listscsc_start_long, + & g_listscsc_end_long) + call int_bounds(g_ilist_sc_short,g_listscsc_start_short, + & g_listscsc_end_short) +#ifdef DEBUG + write (iout,*) "g_list_sc_start",g_listscsc_start_long, + & "g_list_sc_end",g_listscsc_end_long + write (iout,*)"g_list_sc_start_short",g_listscsc_start_short, + & "g_list_sc_end_short",g_listscsc_end_short +#endif + return + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine make_SCp_inter_list implicit none include "DIMENSIONS" @@ -204,8 +421,8 @@ c & contlistscpj_f(2*maxint_res*maxres) write (iout,*) "make_SCp_inter_list maxint_res",maxint_res #endif r_buff_list=5.0 - ilist_scp=0 - ilist_scp_first=0 + ilist_scp=0 + ilist_scp_first=0 do i=iatscp_s,iatscp_e if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -377,11 +594,234 @@ c write (iout,*) "SCp bcast reduce ierr",ierr ! enddo #endif call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end) +#ifdef DEBUG + write (iout,*) "g_listscp_start",g_listscp_start, + & "g_listscp_end",g_listscp_end +#endif + return + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine make_SCp_inter_list_RESPA + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + include "COMMON.CONTROL" + include "COMMON.CHAIN" + include "COMMON.INTERACT" + include "COMMON.SPLITELE" + include "COMMON.IOUNITS" + double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe, + & xj_temp,yj_temp,zj_temp + double precision dist_init, dist_temp,r_buff_list + integer contlistscpi_long(2*maxint_res*maxres), + & contlistscpi_short(2*maxint_res*maxres), + & contlistscpj_long(2*maxint_res*maxres), + & contlistscpj_short(2*maxint_res*maxres) +! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) + integer i,j,iteli,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_scp_long,ilist_scp_short,g_ilist_scp_long,g_ilist_scp_short + integer displ(0:max_fg_procs),i_ilist_scp_long(0:max_fg_procs), + & i_ilist_scp_short(0:max_fg_procs),ierr +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) + double precision boxshift + double precision d_scale,r_respa_buf +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res +#endif + r_buff_list=5.0 + r_respa_buf=rlamb + ilist_scp_long=0 + ilist_scp_short=0 + do i=iatscp_s,iatscp_e + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + xi=0.5D0*(c(1,i)+c(1,i+1)) + yi=0.5D0*(c(2,i)+c(2,i+1)) + zi=0.5D0*(c(3,i)+c(3,i+1)) + call to_box(xi,yi,zi) + iteli=itel(i) + do iint=1,nscp_gr(i) + do j=iscpstart(i,iint),iscpend(i,iint) + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle +! Uncomment following three lines for SC-p interactions +! xj=c(1,nres+j)-xi +! yj=c(2,nres+j)-yi +! zj=c(3,nres+j)-zi +! Uncomment following three lines for Ca-p interactions +! xj=c(1,j)-xi +! yj=c(2,j)-yi +! zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) +! r_buff_list is a read value for a buffer + if (dist_init.le.(r_cut_int+r_buff_list)) then + d_scale=dist_init/rscp(itypj,iteli) + if (d_scale.le.r_cut_respa+r_respa_buf) then +! Here the list is created + ilist_scp_short=ilist_scp_short+1 + contlistscpi_short(ilist_scp_short)=i + contlistscpj_short(ilist_scp_short)=j + endif + if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then +! this can be substituted by cantor and anti-cantor + ilist_scp_long=ilist_scp_long+1 + contlistscpi_long(ilist_scp_long)=i + contlistscpj_long(ilist_scp_long)=j + endif + endif + enddo + enddo + enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_scp_long,ilist_scp_short + write (iout,*) "Long-range scp interaction list" + do i=1,ilist_scp_long + write (iout,*) i,contlistscpi_long(i),contlistscpj_long(i) + enddo + write (iout,*) "Short-range scp interaction list" + do i=1,ilist_scp_short + write (iout,*) i,contlistscpi_short(i),contlistscpj_short(i) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_scp_long,g_ilist_scp_long,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_scp_short,g_ilist_scp_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.(g_ilist_scp_long.gt. + & 2*maxres*maxint_res .or. g_ilist_scp_short.gt. + & 2*maxres*maxint_res)) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif +c write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_scp_long,1,MPI_INTEGER, + & i_ilist_scp_long,1,MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gather(ilist_scp_short,1,MPI_INTEGER, + & i_ilist_scp_short,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_long(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpi_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpj_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_long,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistscpi_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpi_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpj_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_short,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistscpi_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) + else +#endif + g_ilist_scp_long=ilist_scp_long + + do i=1,ilist_scp_long + newcontlistscpi_long(i)=contlistscpi_long(i) + newcontlistscpj_long(i)=contlistscpj_long(i) + enddo + g_ilist_scp_short=ilist_scp_short + + do i=1,ilist_scp_short + newcontlistscpi_short(i)=contlistscpi_short(i) + newcontlistscpj_short(i)=contlistscpj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,'(a30,i10,a,i4)') + & "Number of long-range SC-p interactions", + & g_ilist_scp_long," per residue on average",g_ilist_scp_long/nres + write (iout,'(a30,i10,a,i4)') + & "Number of short-range SC-p interactions", + &g_ilist_scp_short," per residue on average",g_ilist_scp_short/nres + endif +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list: after GATHERV long-range", + & g_ilist_scp_long + do i=1,g_ilist_scp_long + write (iout,*) i,newcontlistscpi_long(i),newcontlistscpj_long(i) + enddo + write (iout,*) "make_SCp_inter_list: after GATHERV short-range", + & g_ilist_scp_short + do i=1,g_ilist_scp_short + write (iout,*) i,newcontlistscpi_short(i), + & newcontlistscpj_short(i) + enddo +#endif + call int_bounds(g_ilist_scp_long,g_listscp_start_long, + & g_listscp_end_long) + call int_bounds(g_ilist_scp_short,g_listscp_start_short, + & g_listscp_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listscp_start",g_listscp_start_long, + & "g_listscp_end",g_listscp_end_long + write (iout,*)"g_listscp_start_short",g_listscp_start_short, + & "g_listscp_end_short",g_listscp_end_short + endif return end !----------------------------------------------------------------------------- - subroutine make_pp_vdw_inter_list + subroutine make_pp_vdw_inter_list_RESPA implicit none include "DIMENSIONS" #ifdef MPI @@ -398,164 +838,148 @@ c write (iout,*) "SCp bcast reduce ierr",ierr double precision xmedj,ymedj,zmedj double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi, & xmedi,ymedi,zmedi - double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, - & dx_normj,dy_normj,dz_normj - integer contlistpp_vdwi(maxint_res*maxres), - & contlistpp_vdwj(maxint_res*maxres) -! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + double precision dxj,dyj,dzj + integer contlistpp_vdwi_short(maxint_res*maxres), + & contlistpp_vdwj_short(maxint_res*maxres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, - & ilist_pp_vdw,g_ilist_pp_vdw - integer displ(0:max_fg_procs),i_ilist_pp_vdw(0:max_fg_procs),ierr + & ilist_pp_vdw_short,g_ilist_pp_vdw_short + integer displ(0:max_fg_procs), + & i_ilist_pp_vdw_short(0:max_fg_procs),ierr ! print *,"START make_SC" + double precision boxshift + double precision d_scale,r_respa_buf #ifdef DEBUG write (iout,*) "make_pp_vdw_inter_list" #endif - ilist_pp_vdw=0 + ilist_pp_vdw_short=0 r_buff_list=5.0 + r_respa_buf=rlamb do i=iatel_s_vdw,iatel_e_vdw if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi - xmedi=dmod(xmedi,boxxsize) - if (xmedi.lt.0) xmedi=xmedi+boxxsize - ymedi=dmod(ymedi,boxysize) - if (ymedi.lt.0) ymedi=ymedi+boxysize - zmedi=dmod(zmedi,boxzsize) - if (zmedi.lt.0) zmedi=zmedi+boxzsize + call to_box(xmedi,ymedi,zmedi) do j=ielstart_vdw(i),ielend_vdw(i) ! write (iout,*) i,j,itype(i),itype(j) if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle - ! 1,j) dxj=dc(1,j) dyj=dc(2,j) dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) ! xj=c(1,j)+0.5D0*dxj-xmedi ! yj=c(2,j)+0.5D0*dyj-ymedi ! zj=c(3,j)+0.5D0*dzj-zmedi xj=c(1,j)+0.5D0*dxj yj=c(2,j)+0.5D0*dyj zj=c(3,j)+0.5D0*dzj - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize - - dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - endif - enddo - enddo - enddo + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) - if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dist_init.le.(r_cut_int+r_buff_list)) then + d_scale=dist_init/rpp(itel(i),itel(j)) + if (d_scale.le.r_cut_respa+r_respa_buf) then ! Here the list is created - ilist_pp_vdw=ilist_pp_vdw+1 + ilist_pp_vdw_short=ilist_pp_vdw_short+1 ! this can be substituted by cantor and anti-cantor - contlistpp_vdwi(ilist_pp_vdw)=i - contlistpp_vdwj(ilist_pp_vdw)=j + contlistpp_vdwi_short(ilist_pp_vdw_short)=i + contlistpp_vdwj_short(ilist_pp_vdw_short)=j + endif endif - enddo - enddo + enddo + enddo ! enddo #ifdef MPI #ifdef DEBUG - write (iout,*) "before MPIREDUCE",ilist_pp_vdw - do i=1,ilist_pp_vdw - write (iout,*) i,contlistpp_vdwi(i),contlistpp_vdwj(i) + write (iout,*) "before MPIREDUCE longrange",ilist_pp_vdw_long + do i=1,ilist_pp_vdw_long + write (iout,*) i,contlistpp_vdwi_long(i),contlistpp_vdwj_long(i) + enddo + write (iout,*) "before MPIREDUCE shortrange",ilist_pp_vdw_short + do i=1,ilist_pp_vdw_short + write (iout,*) i,contlistpp_vdwi_short(i), + & contlistpp_vdwj_short(i) enddo #endif if (nfgtasks.gt.1)then - call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, + call MPI_Reduce(ilist_pp_vdw_short,g_ilist_pp_vdw_short,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then + if (fg_rank.eq.0.and.g_ilist_pp_vdw_short.gt.maxres*maxint_res) + & then if ((me.eq.king.or.out1file).and.energy_dec) then write (iout,*) "Too many pp VDW interactions", - & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + & g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed." write (iout,*) "Specify a smaller r_cut_int and resubmit" call flush(iout) endif write (*,*) "Processor:",me,": Too many pp VDW interactions", - & g_ilist_pp_vdw," only",maxres*maxint_res," allowed." + & g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed." write (8,*) "Specify a smaller r_cut_int and resubmit" call MPI_Abort(MPI_COMM_WORLD,ierr) endif ! write(iout,*) "before bcast",g_ilist_sc - call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER, - & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gather(ilist_pp_vdw_short,1,MPI_INTEGER, + & i_ilist_pp_vdw_short,1,MPI_INTEGER,king,FG_COMM,IERR) displ(0)=0 do i=1,nfgtasks-1,1 - displ(i)=i_ilist_pp_vdw(i-1)+displ(i-1) + displ(i)=i_ilist_pp_vdw_short(i-1)+displ(i-1) enddo ! write(iout,*) "before gather",displ(0),displ(1) - call MPI_Gatherv(contlistpp_vdwi,ilist_pp_vdw,MPI_INTEGER, - & newcontlistpp_vdwi,i_ilist_pp_vdw,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Gatherv(contlistpp_vdwj,ilist_pp_vdw,MPI_INTEGER, - & newcontlistpp_vdwj,i_ilist_pp_vdw,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Bcast(g_ilist_pp_vdw,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwi_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwi_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwj_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwj_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_pp_vdw_short,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - call MPI_Bcast(newcontlistpp_vdwi,g_ilist_pp_vdw,MPI_INT,king, - & FG_COMM,IERR) - call MPI_Bcast(newcontlistpp_vdwj,g_ilist_pp_vdw,MPI_INT,king, - & FG_COMM,IERR) - + call MPI_Bcast(newcontlistpp_vdwi_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistpp_vdwj_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - - else + else #endif - g_ilist_pp_vdw=ilist_pp_vdw + g_ilist_pp_vdw_short=ilist_pp_vdw_short - do i=1,ilist_pp_vdw - newcontlistpp_vdwi(i)=contlistpp_vdwi(i) - newcontlistpp_vdwj(i)=contlistpp_vdwj(i) + do i=1,ilist_pp_vdw_short + newcontlistpp_vdwi_short(i)=contlistpp_vdwi_short(i) + newcontlistpp_vdwj_short(i)=contlistpp_vdwj_short(i) enddo #ifdef MPI - endif + endif #endif - call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, - & g_listpp_vdw_end) - if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) - &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions", - & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "Number of short-range p-p VDW interactions", + & g_ilist_pp_vdw_short," per residue on average", + & g_ilist_pp_vdw_short/nres + endif #ifdef DEBUG - write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, - & "g_listpp_vdw_end",g_listpp_vdw_end + write (iout,*) "Short-range pp_vdw" write (iout,*) "make_pp_vdw_inter_list: after GATHERV", - & g_ilist_pp_vdw - do i=1,g_ilist_pp_vdw - write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) + & g_ilist_pp_vdw_short + do i=1,g_ilist_pp_vdw_short + write (iout,*) i,newcontlistpp_vdwi_short(i), + & newcontlistpp_vdwj_short(i) enddo #endif + call int_bounds(g_ilist_pp_vdw_short,g_listpp_vdw_start_short, + & g_listpp_vdw_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*)"g_listpp_vdw_start_short", + & g_listpp_vdw_start_short, + & "g_listpp_vdw_end_short",g_listpp_vdw_end_short + endif return end !----------------------------------------------------------------------------- @@ -716,18 +1140,17 @@ c write (iout,*) "After bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - else + else #endif g_ilist_pp=ilist_pp do i=1,ilist_pp - newcontlistppi(i)=contlistppi(i) - newcontlistppj(i)=contlistppj(i) + newcontlistppi(i)=contlistppi(i) + newcontlistppj(i)=contlistppj(i) enddo #ifdef MPI - endif + endif #endif - call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions", & g_ilist_pp," per residue on average",g_ilist_pp/nres @@ -737,5 +1160,11 @@ c write (iout,*) "After bcast ierr",ierr write (iout,*) i,newcontlistppi(i),newcontlistppj(i) enddo #endif + call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listpp_start",g_listpp_start, + & "g_listpp_end",g_listpp_end + endif return end