subroutine make_SCSC_inter_list
      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(maxint_res*maxres),contlistj(maxint_res*maxres)
!      integer :: newcontlisti(200*nres),newcontlistj(200*nres) 
      integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
     &  ilist_sc,g_ilist_sc
      integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
      logical lprn /.false./
!            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
            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)
             xi=dmod(xi,boxxsize)
             if (xi.lt.0) xi=xi+boxxsize
             yi=dmod(yi,boxysize)
             if (yi.lt.0) yi=yi+boxysize
             zi=dmod(zi,boxzsize)
             if (zi.lt.0) zi=zi+boxzsize
             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)
               xj=dmod(xj,boxxsize)
               if (xj.lt.0) xj=xj+boxxsize
               yj=dmod(yj,boxysize)
               if (yj.lt.0) yj=yj+boxysize
               zj=dmod(zj,boxzsize)
               if (zj.lt.0) zj=zj+boxzsize
               dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
               xj_safe=xj
               yj_safe=yj
               zj_safe=zj
               subchap=0
               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-xi)**2+(yj-yi)**2+(zj-zi)**2
               if(dist_temp.lt.dist_init) then
                dist_init=dist_temp
                xj_temp=xj
                yj_temp=yj
                zj_temp=zj
                subchap=1
               endif
               enddo
               enddo
               enddo
               if (subchap.eq.1) then
               xj=xj_temp-xi
               yj=yj_temp-yi
               zj=zj_temp-zi
               else
               xj=xj_safe-xi
               yj=yj_safe-yi
               zj=zj_safe-zi
               endif
! r_buff_list is a read value for a buffer 
               if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
! Here the list is created
                 ilist_sc=ilist_sc+1
! this can be substituted by cantor and anti-cantor
                 contlisti(ilist_sc)=i
                 contlistj(ilist_sc)=j

               endif
             enddo
             enddo
             enddo
!         call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
!          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
!        call MPI_Gather(newnss,1,MPI_INTEGER,&
!                        i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
#ifdef MPI
#ifdef DEBUG
      write (iout,*) "before MPIREDUCE",ilist_sc
c      do i=1,ilist_sc
c      write (iout,*) i,contlisti(i),contlistj(i)
c      enddo
#endif
      if (nfgtasks.gt.1)then

        call MPI_Reduce(ilist_sc,g_ilist_sc,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.gt.maxres*maxint_res) then
          if ((me.eq.king.or.out1file).and.energy_dec) then
            write (iout,*) "Too many SCSC interactions",
     &      g_ilist_sc," only",maxres*maxint_res," allowed."
            write (iout,*) "Reduce r_cut_int and resubmit"
            write (iout,*) "Specify a smaller r_cut_int and resubmit"
            call flush(iout)
          endif
          write (*,*) "Processor:",me,": Too many SCSC interactions",
     &      g_ilist_sc," only",maxres*maxint_res," allowed."
            write (iout,*) "Reduce r_cut_int and resubmit"
            write (iout,*) "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_sc,1,MPI_INTEGER,
     &                  i_ilist_sc,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(i-1)+displ(i-1)
        enddo
!        write(iout,*) "before gather",displ(0),displ(1)        
        call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,
     &                   newcontlisti,i_ilist_sc,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
c        write (iout,*) "SCSC after gatherv ierr",ierr
        call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,
     &                   newcontlistj,i_ilist_sc,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
c        write (iout,*) "SCSC bcast reduce ierr",ierr
!        write(iout,*) "before bcast",g_ilist_sc
!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
        call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,
     &                 IERR)
c        write (iout,*) "SCSC bcast reduce ierr",ierr
        call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
     &                 IERR)
c        write (iout,*) "SCSC after bcast ierr",ierr
!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)

        else
#endif
        g_ilist_sc=ilist_sc

        do i=1,ilist_sc
        newcontlisti(i)=contlisti(i)
        newcontlistj(i)=contlistj(i)
        enddo
#ifdef MPI
        endif
#endif      
      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
     & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions",
     & g_ilist_sc," per residue on average",g_ilist_sc/nres
#ifdef DEBUG
      write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc
      do i=1,g_ilist_sc
      write (iout,*) i,newcontlisti(i),newcontlistj(i)
      enddo
#endif
      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"
#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(2*maxint_res*maxres),
     & contlistscpj(2*maxint_res*maxres)
!      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
      integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
     &  ilist_scp,g_ilist_scp
      integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr
c      integer contlistscpi_f(2*maxint_res*maxres),
c     &  contlistscpj_f(2*maxint_res*maxres)
      integer ilist_scp_first,ifirstrun,g_ilist_sc
!            print *,"START make_SC"
#ifdef DEBUG
      write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
#endif
      r_buff_list=5.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))
        yi=0.5D0*(c(2,i)+c(2,i+1))
        zi=0.5D0*(c(3,i)+c(3,i+1))
          xi=mod(xi,boxxsize)
          if (xi.lt.0) xi=xi+boxxsize
          yi=mod(yi,boxysize)
          if (yi.lt.0) yi=yi+boxysize
          zi=mod(zi,boxzsize)
          if (zi.lt.0) zi=zi+boxzsize

        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)
          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-xi)**2+(yj-yi)**2+(zj-zi)**2
      xj_safe=xj
      yj_safe=yj
      zj_safe=zj
      subchap=0
      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-xi)**2+(yj-yi)**2+(zj-zi)**2
          if(dist_temp.lt.dist_init) then
            dist_init=dist_temp
            xj_temp=xj
            yj_temp=yj
            zj_temp=zj
            subchap=1
          endif
       enddo
       enddo
       enddo
       if (subchap.eq.1) then
          xj=xj_temp-xi
          yj=yj_temp-yi
          zj=zj_temp-zi
       else
          xj=xj_safe-xi
          yj=yj_safe-yi
          zj=zj_safe-zi
       endif
#ifdef DEBUG
                ! r_buff_list is a read value for a buffer 
              if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
     &        then
! Here the list is created
                 ilist_scp_first=ilist_scp_first+1
! this can be substituted by cantor and anti-cantor
                 contlistscpi_f(ilist_scp_first)=i
                 contlistscpj_f(ilist_scp_first)=j
              endif
#endif
! r_buff_list is a read value for a buffer 
               if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
! Here the list is created
                 ilist_scp=ilist_scp+1
! this can be substituted by cantor and anti-cantor
                 contlistscpi(ilist_scp)=i
                 contlistscpj(ilist_scp)=j
              endif
             enddo
             enddo
             enddo
#ifdef MPI
#ifdef DEBUG
      write (iout,*) "before MPIREDUCE",ilist_scp
      do i=1,ilist_scp
      write (iout,*) i,contlistscpi(i),contlistscpj(i)
      enddo
#endif
      if (nfgtasks.gt.1)then

        call MPI_Reduce(ilist_scp,g_ilist_scp,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.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," 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," 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,1,MPI_INTEGER,
     &                  i_ilist_scp,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(i-1)+displ(i-1)
        enddo
!        write(iout,*) "before gather",displ(0),displ(1)
        call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,
     &                   newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
c        write (iout,*) "SCp after gatherv ierr",ierr
        call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
     &                   newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
c        write (iout,*) "SCp after gatherv ierr",ierr
        call MPI_Bcast(g_ilist_scp,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,g_ilist_scp,MPI_INT,king,FG_COMM,
     &                   IERR)
c        write (iout,*) "SCp after bcast ierr",ierr
        call MPI_Bcast(newcontlistscpj,g_ilist_scp,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)
        else
#endif
        g_ilist_scp=ilist_scp

        do i=1,ilist_scp
        newcontlistscpi(i)=contlistscpi(i)
        newcontlistscpj(i)=contlistscpj(i)
        enddo
#ifdef MPI
        endif
#endif
      if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) 
     & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions",
     & g_ilist_scp," per residue on average",g_ilist_scp/nres
#ifdef DEBUG
      write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp
      do i=1,g_ilist_scp
      write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
      enddo

!      if (ifirstrun.eq.0) ifirstrun=1
!      do i=1,ilist_scp_first
!       do j=1,g_ilist_scp
!        if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
!         (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
!        enddo
!       print *,itime_mat,"ERROR matrix needs updating"
!       print *,contlistscpi_f(i),contlistscpj_f(i)
!  126  continue
!      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_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 xmedj,ymedj,zmedj
      double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
     &  xmedi,ymedi,zmedi
      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_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_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)
        xmedi=c(1,i)+0.5d0*dxi
        ymedi=c(2,i)+0.5d0*dyi
        zmedi=c(3,i)+0.5d0*dzi
        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)
!          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
          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 (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_short=ilist_pp_vdw_short+1
! this can be substituted by cantor and anti-cantor
              contlistpp_vdwi_short(ilist_pp_vdw_short)=i
              contlistpp_vdwj_short(ilist_pp_vdw_short)=j
            endif
          endif
        enddo
      enddo
!             enddo
#ifdef MPI
#ifdef DEBUG
      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_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_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_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_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_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_short(i-1)+displ(i-1)
        enddo
!        write(iout,*) "before gather",displ(0),displ(1)
        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_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
#endif
        g_ilist_pp_vdw_short=ilist_pp_vdw_short

        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
      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,*) "Short-range pp_vdw"
      write (iout,*) "make_pp_vdw_inter_list: after GATHERV",
     &  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
!-----------------------------------------------------------------------------
      subroutine make_pp_inter_list
      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 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 contlistppi(maxint_res*maxres),
     &  contlistppj(maxint_res*maxres)
!      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
      integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
     &  ilist_pp,g_ilist_pp
      integer displ(0:max_fg_procs),i_ilist_pp(0:max_fg_procs),ierr
!            print *,"START make_SC"
#ifdef DEBUG
      write (iout,*) "make_pp_inter_list"
#endif
      ilist_pp=0
      r_buff_list=5.0
      do i=iatel_s,iatel_e
        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(i),ielend(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 (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
! Here the list is created
                 ilist_pp=ilist_pp+1
! this can be substituted by cantor and anti-cantor
                 contlistppi(ilist_pp)=i
                 contlistppj(ilist_pp)=j
              endif
             enddo
             enddo
!             enddo
#ifdef MPI
#ifdef DEBUG
      write (iout,*) "before MPIREDUCE",ilist_pp
      do i=1,ilist_pp
      write (iout,*) i,contlistppi(i),contlistppj(i)
      enddo
#endif
      if (nfgtasks.gt.1)then

        call MPI_Reduce(ilist_pp,g_ilist_pp,1,
     &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
c       write (iout,*) "After reduce ierr",ierr
        if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then
          if ((me.eq.king.or.out1file).and.energy_dec) then
            write (iout,*) "Too many pp interactions",
     &      g_ilist_pp," 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 interactions",
     &      g_ilist_pp," only",maxres*maxint_res," allowed."
          write (*,*) "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,1,MPI_INTEGER,
     &                  i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
c       write (iout,*) "After gather ierr",ierr
        displ(0)=0
        do i=1,nfgtasks-1,1
          displ(i)=i_ilist_pp(i-1)+displ(i-1)
        enddo
!        write(iout,*) "before gather",displ(0),displ(1)
        call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
     &                   newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
c       write (iout,*) "After gatherb ierr",ierr
        call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
     &                   newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
     &                   king,FG_COMM,IERR)
c       write (iout,*) "After gatherb ierr",ierr
        call MPI_Bcast(g_ilist_pp,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)
c       write (iout,*) "After bcast ierr",ierr
        call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
     &                   IERR)
c       write (iout,*) "After bcast ierr",ierr
        call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
     &                   IERR)
c       write (iout,*) "After bcast ierr",ierr

!        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)

      else
#endif
        g_ilist_pp=ilist_pp

        do i=1,ilist_pp
          newcontlistppi(i)=contlistppi(i)
          newcontlistppj(i)=contlistppj(i)
        enddo
#ifdef MPI
      endif
#endif
      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
#ifdef DEBUG
      write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp
      do i=1,g_ilist_pp
      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