Adam's 5D respa
[unres.git] / source / unres / src-HCD-5D / make_xx_list.F
index fb6c055..a83740f 100644 (file)
@@ -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"