X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fmake_xx_list.F;h=a83740fb8cecbe4417ed5a53c205615fb5855cf5;hb=e03a9f80b12c006af17dcbe2d9a6a8c431db1dd1;hp=fb6c0555e520d30972659ead1ff8840ed04957b3;hpb=88fb48306668af16f9c3593176db04bd83d935f8;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 fb6c055..a83740f 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -331,6 +331,166 @@ c write(iout,*) "before bcast",g_ilist_sc return end !----------------------------------------------------------------------------- + subroutine make_pp_vdw_inter_list + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + 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 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(200*maxres),contlistpp_vdwj(200*maxres) +! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + 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 +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_pp_vdw_inter_list" +#endif + ilist_pp_vdw=0 + r_buff_list=5.0 + 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 + 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 + + if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then +! Here the list is created + ilist_pp_vdw=ilist_pp_vdw+1 +! this can be substituted by cantor and anti-cantor + contlistpp_vdwi(ilist_pp_vdw)=i + contlistpp_vdwj(ilist_pp_vdw)=j + endif + 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) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! 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) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_pp_vdw(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) +! 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(g_ilist_sc,1,MPI_INT,king,FG_COMM) + + else +#endif + g_ilist_pp_vdw=ilist_pp_vdw + + do i=1,ilist_pp_vdw + newcontlistpp_vdwi(i)=contlistpp_vdwi(i) + newcontlistpp_vdwj(i)=contlistpp_vdwj(i) + enddo +#ifdef MPI + endif +#endif + call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, + & g_listpp_vdw_end) +#ifdef DEBUG + write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, + & "g_listpp_vdw_end",g_listpp_vdw_end + write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw + do i=1,g_ilist_pp_vdw + write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) + enddo +#endif + return + end +!----------------------------------------------------------------------------- subroutine make_pp_inter_list implicit none include "DIMENSIONS"