Adam's unres update
[unres.git] / source / unres / src-HCD-5D / make_xx_list.F
index 480aeb2..a1f6b45 100644 (file)
@@ -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
 #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