source/unres/src-HCD-5D/make_xx_list.F

   1       subroutine make_SCSC_inter_list
   2       implicit none
   3       include "DIMENSIONS"
   4 #ifdef MPI
   5       include 'mpif.h'
   6       include "COMMON.SETUP"
   7 #endif
   8       include "COMMON.CONTROL"
   9       include "COMMON.CHAIN"
  10       include "COMMON.INTERACT"
  11       include "COMMON.SPLITELE"
  12       include "COMMON.IOUNITS"
  13       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
  14      &  xj_temp,yj_temp,zj_temp
  15       double precision dist_init, dist_temp,r_buff_list
  16       integer contlisti(maxint_res*maxres),contlistj(maxint_res*maxres)
  17 !      integer :: newcontlisti(200*nres),newcontlistj(200*nres)
  18       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
  19      &  ilist_sc,g_ilist_sc
  20       integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
  21       logical lprn /.false./
  22 !            print *,"START make_SC"
  23 #ifdef DEBUG
  24       write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
  25       write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e
  26 #endif
  27           r_buff_list=5.0d0
  28             ilist_sc=0
  29             do i=iatsc_s,iatsc_e
  30              itypi=iabs(itype(i))
  31              if (itypi.eq.ntyp1) cycle
  32              xi=c(1,nres+i)
  33              yi=c(2,nres+i)
  34              zi=c(3,nres+i)
  35              xi=dmod(xi,boxxsize)
  36              if (xi.lt.0) xi=xi+boxxsize
  37              yi=dmod(yi,boxysize)
  38              if (yi.lt.0) yi=yi+boxysize
  39              zi=dmod(zi,boxzsize)
  40              if (zi.lt.0) zi=zi+boxzsize
  41              do iint=1,nint_gr(i)
  42               do j=istart(i,iint),iend(i,iint)
  43                itypj=iabs(itype(j))
  44                if (itypj.eq.ntyp1) cycle
  45                xj=c(1,nres+j)
  46                yj=c(2,nres+j)
  47                zj=c(3,nres+j)
  48                xj=dmod(xj,boxxsize)
  49                if (xj.lt.0) xj=xj+boxxsize
  50                yj=dmod(yj,boxysize)
  51                if (yj.lt.0) yj=yj+boxysize
  52                zj=dmod(zj,boxzsize)
  53                if (zj.lt.0) zj=zj+boxzsize
  54                dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  55                xj_safe=xj
  56                yj_safe=yj
  57                zj_safe=zj
  58                subchap=0
  59                do xshift=-1,1
  60                do yshift=-1,1
  61                do zshift=-1,1
  62                xj=xj_safe+xshift*boxxsize
  63                yj=yj_safe+yshift*boxysize
  64                zj=zj_safe+zshift*boxzsize
  65                dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  66                if(dist_temp.lt.dist_init) then
  67                 dist_init=dist_temp
  68                 xj_temp=xj
  69                 yj_temp=yj
  70                 zj_temp=zj
  71                 subchap=1
  72                endif
  73                enddo
  74                enddo
  75                enddo
  76                if (subchap.eq.1) then
  77                xj=xj_temp-xi
  78                yj=yj_temp-yi
  79                zj=zj_temp-zi
  80                else
  81                xj=xj_safe-xi
  82                yj=yj_safe-yi
  83                zj=zj_safe-zi
  84                endif
  85 ! r_buff_list is a read value for a buffer
  86                if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
  87 ! Here the list is created
  88                  ilist_sc=ilist_sc+1
  89 ! this can be substituted by cantor and anti-cantor
  90                  contlisti(ilist_sc)=i
  91                  contlistj(ilist_sc)=j
  92
  93                endif
  94              enddo
  95              enddo
  96              enddo
  97 !         call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
  98 !          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
  99 !        call MPI_Gather(newnss,1,MPI_INTEGER,&
 100 !                        i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
 101 #ifdef MPI
 102 #ifdef DEBUG
 103       write (iout,*) "before MPIREDUCE",ilist_sc
 104 c      do i=1,ilist_sc
 105 c      write (iout,*) i,contlisti(i),contlistj(i)
 106 c      enddo
 107 #endif
 108       if (nfgtasks.gt.1)then
 109
 110         call MPI_Reduce(ilist_sc,g_ilist_sc,1,
 111      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 112 c        write (iout,*) "SCSC after reduce ierr",ierr
 113         if (fg_rank.eq.0.and.g_ilist_sc.gt.maxres*maxint_res) then
 114           if ((me.eq.king.or.out1file).and.energy_dec) then
 115             write (iout,*) "Too many SCSC interactions",
 116      &      g_ilist_sc," only",maxres*maxint_res," allowed."
 117             write (iout,*) "Reduce r_cut_int and resubmit"
 118             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 119             call flush(iout)
 120           endif
 121           write (*,*) "Processor:",me,": Too many SCSC interactions",
 122      &      g_ilist_sc," only",maxres*maxint_res," allowed."
 123             write (iout,*) "Reduce r_cut_int and resubmit"
 124             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 125           call MPI_Abort(MPI_COMM_WORLD,ierr)
 126         endif
 127 c        write(iout,*) "before bcast",g_ilist_sc
 128         call MPI_Gather(ilist_sc,1,MPI_INTEGER,
 129      &                  i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
 130 c        write (iout,*) "SCSC after gather ierr",ierr
 131         displ(0)=0
 132         do i=1,nfgtasks-1,1
 133           displ(i)=i_ilist_sc(i-1)+displ(i-1)
 134         enddo
 135 !        write(iout,*) "before gather",displ(0),displ(1)
 136         call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,
 137      &                   newcontlisti,i_ilist_sc,displ,MPI_INTEGER,
 138      &                   king,FG_COMM,IERR)
 139 c        write (iout,*) "SCSC after gatherv ierr",ierr
 140         call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,
 141      &                   newcontlistj,i_ilist_sc,displ,MPI_INTEGER,
 142      &                   king,FG_COMM,IERR)
 143         call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
 144 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 145 !        write(iout,*) "before bcast",g_ilist_sc
 146 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 147         call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,
 148      &                 IERR)
 149 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 150         call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
 151      &                 IERR)
 152 c        write (iout,*) "SCSC after bcast ierr",ierr
 153 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 154
 155         else
 156 #endif
 157         g_ilist_sc=ilist_sc
 158
 159         do i=1,ilist_sc
 160         newcontlisti(i)=contlisti(i)
 161         newcontlistj(i)=contlistj(i)
 162         enddo
 163 #ifdef MPI
 164         endif
 165 #endif
 166       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 167      & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions",
 168      & g_ilist_sc," per residue on average",g_ilist_sc/nres
 169 #ifdef DEBUG
 170       write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc
 171       do i=1,g_ilist_sc
 172       write (iout,*) i,newcontlisti(i),newcontlistj(i)
 173       enddo
 174 #endif
 175       call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
 176 #ifdef DEBUG
 177       write (iout,*) "g_listscsc_start",g_listscsc_start,
 178      &  "g_listscsc_end",g_listscsc_end
 179       return
 180 #endif
 181       end
 182 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 183       subroutine make_SCSC_inter_list_RESPA
 184       implicit none
 185       include "DIMENSIONS"
 186 #ifdef MPI
 187       include 'mpif.h'
 188       include "COMMON.SETUP"
 189 #endif
 190       include "COMMON.CONTROL"
 191       include "COMMON.CHAIN"
 192       include "COMMON.INTERACT"
 193       include "COMMON.SPLITELE"
 194       include "COMMON.IOUNITS"
 195       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 196      &  xj_temp,yj_temp,zj_temp
 197       double precision dist_init, dist_temp,r_buff_list
 198       integer contlisti_long(maxint_res*maxres),
 199      &  contlisti_short(maxint_res*maxres),
 200      &  contlistj_long(maxint_res*maxres),
 201      &  contlistj_short(maxint_res*maxres)
 202 !      integer :: newcontlisti(200*nres),newcontlistj(200*nres)
 203       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 204      &  ilist_sc_long,g_ilist_sc_long,ilist_sc_short,g_ilist_sc_short
 205       integer displ(0:max_fg_procs),i_ilist_sc_long(0:max_fg_procs),
 206      & i_ilist_sc_short(0:max_fg_procs),ierr
 207       logical lprn /.false./
 208       double precision boxshift
 209       double precision d_scale,r_respa_buf
 210 !            print *,"START make_SC"
 211 #ifdef DEBUG
 212       write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
 213       write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e
 214 #endif
 215       r_buff_list=5.0d0
 216       r_respa_buf=rlamb
 217       ilist_sc_long=0
 218       ilist_sc_short=0
 219       do i=iatsc_s,iatsc_e
 220         itypi=iabs(itype(i))
 221         if (itypi.eq.ntyp1) cycle
 222         xi=c(1,nres+i)
 223         yi=c(2,nres+i)
 224         zi=c(3,nres+i)
 225         call to_box(xi,yi,zi)
 226         do iint=1,nint_gr(i)
 227           do j=istart(i,iint),iend(i,iint)
 228             itypj=iabs(itype(j))
 229             if (itypj.eq.ntyp1) cycle
 230             xj=c(1,nres+j)
 231             yj=c(2,nres+j)
 232             zj=c(3,nres+j)
 233             call to_box(xj,yj,zj)
 234             xj=boxshift(xj-xi,boxxsize)
 235             yj=boxshift(yj-yi,boxysize)
 236             zj=boxshift(zj-zi,boxzsize)
 237             dist_init=dsqrt(xj*xj+yj*yj+zj*zj)
 238 ! r_buff_list is a read value for a buffer
 239             if (dist_init.le.(r_cut_int+r_buff_list)) then
 240 ! Here the list is created
 241               d_scale=dist_init/sigmaii(itypi,itypj)
 242               if (d_scale.le.r_cut_respa+r_respa_buf) then
 243                 ilist_sc_short=ilist_sc_short+1
 244                 contlisti_short(ilist_sc_short)=i
 245                 contlistj_short(ilist_sc_short)=j
 246               endif
 247               if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then
 248                 ilist_sc_long=ilist_sc_long+1
 249 ! this can be substituted by cantor and anti-cantor
 250                 contlisti_long(ilist_sc_long)=i
 251                 contlistj_long(ilist_sc_long)=j
 252               endif
 253             endif
 254           enddo
 255         enddo
 256       enddo
 257 #ifdef MPI
 258 #ifdef DEBUG
 259       write (iout,*) "before MPIREDUCE ilist_sc_long",ilist_sc_long
 260 c      do i=1,ilist_sc_long
 261 c      write (iout,*) i,contlisti_long(i),contlistj_long(i)
 262 c      enddo
 263       write (iout,*) "before MPIREDUCE ilist_sc_short",ilist_sc_short
 264 c      do i=1,ilist_sc_short
 265 c      write (iout,*) i,contlisti_short(i),contlistj_short(i)
 266 c      enddo
 267 #endif
 268       if (nfgtasks.gt.1)then
 269
 270         call MPI_Reduce(ilist_sc_long,g_ilist_sc_long,1,
 271      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 272         call MPI_Reduce(ilist_sc_short,g_ilist_sc_short,1,
 273      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 274 c        write (iout,*) "SCSC after reduce ierr",ierr
 275         if (fg_rank.eq.0.and.(g_ilist_sc_long.gt.maxres*maxint_res .or.
 276      &      g_ilist_sc_short.gt.maxres*maxint_res)) then
 277           if ((me.eq.king.or.out1file).and.energy_dec) then
 278             write (iout,*) "Too many SCSC interactions",
 279      &      g_ilist_sc_long,g_ilist_sc_short,
 280      &       " only",maxres*maxint_res," allowed."
 281             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 282             call flush(iout)
 283           endif
 284           write (*,*) "Processor:",me,": Too many SCSC interactions",
 285      &      g_ilist_sc_long+g_ilist_sc_short," only",
 286      &      maxres*maxint_res," allowed."
 287             write (*,*) "Specify a smaller r_cut_int and resubmit"
 288           call MPI_Abort(MPI_COMM_WORLD,ierr)
 289         endif
 290 c        write(iout,*) "before bcast",g_ilist_sc_long
 291         call MPI_Gather(ilist_sc_long,1,MPI_INTEGER,
 292      &                  i_ilist_sc_long,1,MPI_INTEGER,king,FG_COMM,IERR)
 293 c        write (iout,*) "SCSC after gather ierr",ierr
 294         displ(0)=0
 295         do i=1,nfgtasks-1,1
 296           displ(i)=i_ilist_sc_long(i-1)+displ(i-1)
 297         enddo
 298 !        write(iout,*) "before gather",displ(0),displ(1)
 299         call MPI_Gatherv(contlisti_long,ilist_sc_long,MPI_INTEGER,
 300      &             newcontlisti_long,i_ilist_sc_long,displ,MPI_INTEGER,
 301      &             king,FG_COMM,IERR)
 302 c        write (iout,*) "SCSC after gatherv ierr",ierr
 303         call MPI_Gatherv(contlistj_long,ilist_sc_long,MPI_INTEGER,
 304      &             newcontlistj_long,i_ilist_sc_long,displ,MPI_INTEGER,
 305      &             king,FG_COMM,IERR)
 306         call MPI_Bcast(g_ilist_sc_long,1,MPI_INT,king,FG_COMM,IERR)
 307 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 308 !        write(iout,*) "before bcast",g_ilist_sc_long
 309 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 310         call MPI_Bcast(newcontlisti_long,g_ilist_sc_long,MPI_INT,king,
 311      &       FG_COMM,IERR)
 312 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 313         call MPI_Bcast(newcontlistj_long,g_ilist_sc_long,MPI_INT,king,
 314      &       FG_COMM,IERR)
 315 c        write (iout,*) "SCSC after bcast ierr",ierr
 316 !        write(iout,*) "before gather",displ(0),displ(1)
 317 c        write(iout,*) "before bcast",g_ilist_sc_short
 318         call MPI_Gather(ilist_sc_short,1,MPI_INTEGER,
 319      &                i_ilist_sc_short,1,MPI_INTEGER,king,FG_COMM,IERR)
 320 c        write (iout,*) "SCSC after gather ierr",ierr
 321         displ(0)=0
 322         do i=1,nfgtasks-1,1
 323           displ(i)=i_ilist_sc_short(i-1)+displ(i-1)
 324         enddo
 325 !        write(iout,*) "before gather",displ(0),displ(1)
 326         call MPI_Gatherv(contlisti_short,ilist_sc_short,MPI_INTEGER,
 327      &            newcontlisti_short,i_ilist_sc_short,displ,MPI_INTEGER,
 328      &            king,FG_COMM,IERR)
 329 c        write (iout,*) "SCSC after gatherv ierr",ierr
 330         call MPI_Gatherv(contlistj_short,ilist_sc_short,MPI_INTEGER,
 331      &           newcontlistj_short,i_ilist_sc_short,displ,MPI_INTEGER,
 332      &           king,FG_COMM,IERR)
 333         call MPI_Bcast(g_ilist_sc_short,1,MPI_INT,king,FG_COMM,IERR)
 334 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 335 !        write(iout,*) "before bcast",g_ilist_sc_short
 336 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 337         call MPI_Bcast(newcontlisti_short,g_ilist_sc_short,MPI_INT,king,
 338      &       FG_COMM,IERR)
 339 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 340         call MPI_Bcast(newcontlistj_short,g_ilist_sc_short,MPI_INT,king,
 341      ^       FG_COMM,IERR)
 342 c        write (iout,*) "SCSC after bcast ierr",ierr
 343         else
 344 #endif
 345           g_ilist_sc_long=ilist_sc_long
 346
 347           do i=1,ilist_sc_long
 348             newcontlisti_long(i)=contlisti_long(i)
 349             newcontlistj_long(i)=contlistj_long(i)
 350           enddo
 351
 352           g_ilist_sc_short=ilist_sc_short
 353
 354           do i=1,ilist_sc_short
 355             newcontlisti_short(i)=contlisti_short(i)
 356             newcontlistj_short(i)=contlistj_short(i)
 357           enddo
 358 #ifdef MPI
 359         endif
 360 #endif
 361       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 362      & write (iout,'(a30,2i10,a,2i4)')
 363      &  "Number of long- and short-range SC-SC interactions",
 364      &  g_ilist_sc_long,g_ilist_sc_short," per residue on average",
 365      &  g_ilist_sc_long/nres,g_ilist_sc_short/nres
 366 #ifdef DEBUG
 367       write (iout,*)
 368      &  "make_SCSC_inter_list: g_ilist_sc_long after GATHERV",
 369      &  g_ilist_sc_long
 370       write (iout,*) "List of long-range SCSC interactions"
 371       do i=1,g_ilist_sc_long
 372       write (iout,*) i,newcontlisti_long(i),newcontlistj_long(i)
 373       enddo
 374       write (iout,*)
 375      &  "make_SCSC_inter_list: g_ilist_sc_short after GATHERV",
 376      &  g_ilist_sc_short
 377       write (iout,*) "List of short-range SCSC interactions"
 378       do i=1,g_ilist_sc_short
 379       write (iout,*) i,newcontlisti_short(i),newcontlistj_short(i)
 380       enddo
 381 #endif
 382       call int_bounds(g_ilist_sc_long,g_listscsc_start_long,
 383      & g_listscsc_end_long)
 384       call int_bounds(g_ilist_sc_short,g_listscsc_start_short,
 385      & g_listscsc_end_short)
 386 #ifdef DEBUG
 387       write (iout,*) "g_list_sc_start",g_listscsc_start_long,
 388      &  "g_list_sc_end",g_listscsc_end_long
 389       write (iout,*)"g_list_sc_start_short",g_listscsc_start_short,
 390      &  "g_list_sc_end_short",g_listscsc_end_short
 391 #endif
 392       return
 393       end
 394 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 395       subroutine make_SCp_inter_list
 396       implicit none
 397       include "DIMENSIONS"
 398 #ifdef MPI
 399       include 'mpif.h'
 400       include "COMMON.SETUP"
 401 #endif
 402       include "COMMON.CONTROL"
 403       include "COMMON.CHAIN"
 404       include "COMMON.INTERACT"
 405       include "COMMON.SPLITELE"
 406       include "COMMON.IOUNITS"
 407       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 408      &  xj_temp,yj_temp,zj_temp
 409       double precision dist_init, dist_temp,r_buff_list
 410       integer contlistscpi(2*maxint_res*maxres),
 411      & contlistscpj(2*maxint_res*maxres)
 412 !      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
 413       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 414      &  ilist_scp,g_ilist_scp
 415       integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr
 416 c      integer contlistscpi_f(2*maxint_res*maxres),
 417 c     &  contlistscpj_f(2*maxint_res*maxres)
 418       integer ilist_scp_first,ifirstrun,g_ilist_sc
 419 !            print *,"START make_SC"
 420 #ifdef DEBUG
 421       write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
 422 #endif
 423       r_buff_list=5.0
 424       ilist_scp=0
 425       ilist_scp_first=0
 426       do i=iatscp_s,iatscp_e
 427         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 428         xi=0.5D0*(c(1,i)+c(1,i+1))
 429         yi=0.5D0*(c(2,i)+c(2,i+1))
 430         zi=0.5D0*(c(3,i)+c(3,i+1))
 431           xi=mod(xi,boxxsize)
 432           if (xi.lt.0) xi=xi+boxxsize
 433           yi=mod(yi,boxysize)
 434           if (yi.lt.0) yi=yi+boxysize
 435           zi=mod(zi,boxzsize)
 436           if (zi.lt.0) zi=zi+boxzsize
 437
 438         do iint=1,nscp_gr(i)
 439
 440         do j=iscpstart(i,iint),iscpend(i,iint)
 441           itypj=iabs(itype(j))
 442           if (itypj.eq.ntyp1) cycle
 443 ! Uncomment following three lines for SC-p interactions
 444 !         xj=c(1,nres+j)-xi
 445 !         yj=c(2,nres+j)-yi
 446 !         zj=c(3,nres+j)-zi
 447 ! Uncomment following three lines for Ca-p interactions
 448 !          xj=c(1,j)-xi
 449 !          yj=c(2,j)-yi
 450 !          zj=c(3,j)-zi
 451           xj=c(1,j)
 452           yj=c(2,j)
 453           zj=c(3,j)
 454           xj=mod(xj,boxxsize)
 455           if (xj.lt.0) xj=xj+boxxsize
 456           yj=mod(yj,boxysize)
 457           if (yj.lt.0) yj=yj+boxysize
 458           zj=mod(zj,boxzsize)
 459           if (zj.lt.0) zj=zj+boxzsize
 460       dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 461       xj_safe=xj
 462       yj_safe=yj
 463       zj_safe=zj
 464       subchap=0
 465       do xshift=-1,1
 466       do yshift=-1,1
 467       do zshift=-1,1
 468           xj=xj_safe+xshift*boxxsize
 469           yj=yj_safe+yshift*boxysize
 470           zj=zj_safe+zshift*boxzsize
 471           dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 472           if(dist_temp.lt.dist_init) then
 473             dist_init=dist_temp
 474             xj_temp=xj
 475             yj_temp=yj
 476             zj_temp=zj
 477             subchap=1
 478           endif
 479        enddo
 480        enddo
 481        enddo
 482        if (subchap.eq.1) then
 483           xj=xj_temp-xi
 484           yj=yj_temp-yi
 485           zj=zj_temp-zi
 486        else
 487           xj=xj_safe-xi
 488           yj=yj_safe-yi
 489           zj=zj_safe-zi
 490        endif
 491 #ifdef DEBUG
 492                 ! r_buff_list is a read value for a buffer
 493               if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
 494      &        then
 495 ! Here the list is created
 496                  ilist_scp_first=ilist_scp_first+1
 497 ! this can be substituted by cantor and anti-cantor
 498                  contlistscpi_f(ilist_scp_first)=i
 499                  contlistscpj_f(ilist_scp_first)=j
 500               endif
 501 #endif
 502 ! r_buff_list is a read value for a buffer
 503                if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 504 ! Here the list is created
 505                  ilist_scp=ilist_scp+1
 506 ! this can be substituted by cantor and anti-cantor
 507                  contlistscpi(ilist_scp)=i
 508                  contlistscpj(ilist_scp)=j
 509               endif
 510              enddo
 511              enddo
 512              enddo
 513 #ifdef MPI
 514 #ifdef DEBUG
 515       write (iout,*) "before MPIREDUCE",ilist_scp
 516       do i=1,ilist_scp
 517       write (iout,*) i,contlistscpi(i),contlistscpj(i)
 518       enddo
 519 #endif
 520       if (nfgtasks.gt.1)then
 521
 522         call MPI_Reduce(ilist_scp,g_ilist_scp,1,
 523      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 524 c        write (iout,*) "SCp after reduce ierr",ierr
 525         if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then
 526           if ((me.eq.king.or.out1file).and.energy_dec) then
 527             write (iout,*) "Too many SCp interactions",
 528      &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
 529             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 530             call flush(iout)
 531           endif
 532           write (*,*) "Processor:",me,": Too many SCp interactions",
 533      &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
 534           write (*,*) "Specify a smaller r_cut_int and resubmit"
 535           call MPI_Abort(MPI_COMM_WORLD,ierr)
 536         endif
 537 c        write(iout,*) "before bcast",g_ilist_sc
 538         call MPI_Gather(ilist_scp,1,MPI_INTEGER,
 539      &                  i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
 540 c        write (iout,*) "SCp after gather ierr",ierr
 541         displ(0)=0
 542         do i=1,nfgtasks-1,1
 543           displ(i)=i_ilist_scp(i-1)+displ(i-1)
 544         enddo
 545 !        write(iout,*) "before gather",displ(0),displ(1)
 546         call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,
 547      &                   newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,
 548      &                   king,FG_COMM,IERR)
 549 c        write (iout,*) "SCp after gatherv ierr",ierr
 550         call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
 551      &                   newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
 552      &                   king,FG_COMM,IERR)
 553 c        write (iout,*) "SCp after gatherv ierr",ierr
 554         call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
 555 c        write (iout,*) "SCp after bcast ierr",ierr
 556 !        write(iout,*) "before bcast",g_ilist_sc
 557 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 558         call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,
 559      &                   IERR)
 560 c        write (iout,*) "SCp after bcast ierr",ierr
 561         call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
 562      &                   IERR)
 563 c        write (iout,*) "SCp bcast reduce ierr",ierr
 564 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 565         else
 566 #endif
 567         g_ilist_scp=ilist_scp
 568
 569         do i=1,ilist_scp
 570         newcontlistscpi(i)=contlistscpi(i)
 571         newcontlistscpj(i)=contlistscpj(i)
 572         enddo
 573 #ifdef MPI
 574         endif
 575 #endif
 576       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 577      & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions",
 578      & g_ilist_scp," per residue on average",g_ilist_scp/nres
 579 #ifdef DEBUG
 580       write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp
 581       do i=1,g_ilist_scp
 582       write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
 583       enddo
 584
 585 !      if (ifirstrun.eq.0) ifirstrun=1
 586 !      do i=1,ilist_scp_first
 587 !       do j=1,g_ilist_scp
 588 !        if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
 589 !         (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
 590 !        enddo
 591 !       print *,itime_mat,"ERROR matrix needs updating"
 592 !       print *,contlistscpi_f(i),contlistscpj_f(i)
 593 !  126  continue
 594 !      enddo
 595 #endif
 596         call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
 597 #ifdef DEBUG
 598       write (iout,*) "g_listscp_start",g_listscp_start,
 599      &  "g_listscp_end",g_listscp_end
 600 #endif
 601       return
 602       end
 603 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 604       subroutine make_SCp_inter_list_RESPA
 605       implicit none
 606       include "DIMENSIONS"
 607 #ifdef MPI
 608       include 'mpif.h'
 609       include "COMMON.SETUP"
 610 #endif
 611       include "COMMON.CONTROL"
 612       include "COMMON.CHAIN"
 613       include "COMMON.INTERACT"
 614       include "COMMON.SPLITELE"
 615       include "COMMON.IOUNITS"
 616       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 617      &  xj_temp,yj_temp,zj_temp
 618       double precision dist_init, dist_temp,r_buff_list
 619       integer contlistscpi_long(2*maxint_res*maxres),
 620      & contlistscpi_short(2*maxint_res*maxres),
 621      & contlistscpj_long(2*maxint_res*maxres),
 622      & contlistscpj_short(2*maxint_res*maxres)
 623 !      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
 624       integer i,j,iteli,itypj,subchap,xshift,yshift,zshift,iint,
 625      & ilist_scp_long,ilist_scp_short,g_ilist_scp_long,g_ilist_scp_short
 626       integer displ(0:max_fg_procs),i_ilist_scp_long(0:max_fg_procs),
 627      & i_ilist_scp_short(0:max_fg_procs),ierr
 628 c      integer contlistscpi_f(2*maxint_res*maxres),
 629 c     &  contlistscpj_f(2*maxint_res*maxres)
 630       double precision boxshift
 631       double precision d_scale,r_respa_buf
 632 !            print *,"START make_SC"
 633 #ifdef DEBUG
 634       write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
 635 #endif
 636       r_buff_list=5.0
 637       r_respa_buf=rlamb
 638       ilist_scp_long=0
 639       ilist_scp_short=0
 640       do i=iatscp_s,iatscp_e
 641         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 642         xi=0.5D0*(c(1,i)+c(1,i+1))
 643         yi=0.5D0*(c(2,i)+c(2,i+1))
 644         zi=0.5D0*(c(3,i)+c(3,i+1))
 645         call to_box(xi,yi,zi)
 646         iteli=itel(i)
 647         do iint=1,nscp_gr(i)
 648           do j=iscpstart(i,iint),iscpend(i,iint)
 649             itypj=iabs(itype(j))
 650             if (itypj.eq.ntyp1) cycle
 651 ! Uncomment following three lines for SC-p interactions
 652 !           xj=c(1,nres+j)-xi
 653 !           yj=c(2,nres+j)-yi
 654 !           zj=c(3,nres+j)-zi
 655 ! Uncomment following three lines for Ca-p interactions
 656 !           xj=c(1,j)-xi
 657 !           yj=c(2,j)-yi
 658 !           zj=c(3,j)-zi
 659             xj=c(1,j)
 660             yj=c(2,j)
 661             zj=c(3,j)
 662             call to_box(xj,yj,zj)
 663             xj=boxshift(xj-xi,boxxsize)
 664             yj=boxshift(yj-yi,boxysize)
 665             zj=boxshift(zj-zi,boxzsize)
 666             dist_init=dsqrt(xj*xj+yj*yj+zj*zj)
 667 ! r_buff_list is a read value for a buffer
 668             if (dist_init.le.(r_cut_int+r_buff_list)) then
 669
 670               d_scale=dist_init/rscp(itypj,iteli)
 671               if (d_scale.le.r_cut_respa+r_respa_buf) then
 672 ! Here the list is created
 673                 ilist_scp_short=ilist_scp_short+1
 674                 contlistscpi_short(ilist_scp_short)=i
 675                 contlistscpj_short(ilist_scp_short)=j
 676               endif
 677               if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then
 678 ! this can be substituted by cantor and anti-cantor
 679                 ilist_scp_long=ilist_scp_long+1
 680                 contlistscpi_long(ilist_scp_long)=i
 681                 contlistscpj_long(ilist_scp_long)=j
 682               endif
 683             endif
 684           enddo
 685         enddo
 686       enddo
 687 #ifdef MPI
 688 #ifdef DEBUG
 689       write (iout,*) "before MPIREDUCE",ilist_scp_long,ilist_scp_short
 690       write (iout,*) "Long-range scp interaction list"
 691       do i=1,ilist_scp_long
 692         write (iout,*) i,contlistscpi_long(i),contlistscpj_long(i)
 693       enddo
 694       write (iout,*) "Short-range scp interaction list"
 695       do i=1,ilist_scp_short
 696         write (iout,*) i,contlistscpi_short(i),contlistscpj_short(i)
 697       enddo
 698 #endif
 699       if (nfgtasks.gt.1)then
 700
 701         call MPI_Reduce(ilist_scp_long,g_ilist_scp_long,1,
 702      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 703         call MPI_Reduce(ilist_scp_short,g_ilist_scp_short,1,
 704      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 705 c        write (iout,*) "SCp after reduce ierr",ierr
 706         if (fg_rank.eq.0.and.(g_ilist_scp_long.gt.
 707      &      2*maxres*maxint_res .or. g_ilist_scp_short.gt.
 708      &      2*maxres*maxint_res)) then
 709           if ((me.eq.king.or.out1file).and.energy_dec) then
 710             write (iout,*) "Too many SCp interactions",
 711      &      g_ilist_scp_long+g_ilist_scp_short," only",
 712      &      2*maxres*maxint_res," allowed."
 713             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 714             call flush(iout)
 715           endif
 716           write (*,*) "Processor:",me,": Too many SCp interactions",
 717      &      g_ilist_scp_long+g_ilist_scp_short," only",
 718      &      2*maxres*maxint_res," allowed."
 719           write (*,*) "Specify a smaller r_cut_int and resubmit"
 720           call MPI_Abort(MPI_COMM_WORLD,ierr)
 721         endif
 722 c        write(iout,*) "before bcast",g_ilist_sc
 723         call MPI_Gather(ilist_scp_long,1,MPI_INTEGER,
 724      &               i_ilist_scp_long,1,MPI_INTEGER,king,FG_COMM,IERR)
 725         call MPI_Gather(ilist_scp_short,1,MPI_INTEGER,
 726      &               i_ilist_scp_short,1,MPI_INTEGER,king,FG_COMM,IERR)
 727 c        write (iout,*) "SCp after gather ierr",ierr
 728         displ(0)=0
 729         do i=1,nfgtasks-1,1
 730           displ(i)=i_ilist_scp_long(i-1)+displ(i-1)
 731         enddo
 732 !        write(iout,*) "before gather",displ(0),displ(1)
 733         call MPI_Gatherv(contlistscpi_long,ilist_scp_long,MPI_INTEGER,
 734      &         newcontlistscpi_long,i_ilist_scp_long,displ,MPI_INTEGER,
 735      &         king,FG_COMM,IERR)
 736 c        write (iout,*) "SCp after gatherv ierr",ierr
 737         call MPI_Gatherv(contlistscpj_long,ilist_scp_long,MPI_INTEGER,
 738      &         newcontlistscpj_long,i_ilist_scp_long,displ,MPI_INTEGER,
 739      &         king,FG_COMM,IERR)
 740 c        write (iout,*) "SCp after gatherv ierr",ierr
 741         call MPI_Bcast(g_ilist_scp_long,1,MPI_INT,king,FG_COMM,IERR)
 742 c        write (iout,*) "SCp after bcast ierr",ierr
 743 !        write(iout,*) "before bcast",g_ilist_sc
 744 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 745         call MPI_Bcast(newcontlistscpi_long,g_ilist_scp_long,MPI_INT,
 746      &                   king,FG_COMM,IERR)
 747 c        write (iout,*) "SCp after bcast ierr",ierr
 748         call MPI_Bcast(newcontlistscpj_long,g_ilist_scp_long,MPI_INT,
 749      &                   king,FG_COMM,IERR)
 750 c        write (iout,*) "SCp bcast reduce ierr",ierr
 751 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 752         displ(0)=0
 753         do i=1,nfgtasks-1,1
 754           displ(i)=i_ilist_scp_short(i-1)+displ(i-1)
 755         enddo
 756 !        write(iout,*) "before gather",displ(0),displ(1)
 757         call MPI_Gatherv(contlistscpi_short,ilist_scp_short,MPI_INTEGER,
 758      &        newcontlistscpi_short,i_ilist_scp_short,displ,MPI_INTEGER,
 759      &        king,FG_COMM,IERR)
 760 c        write (iout,*) "SCp after gatherv ierr",ierr
 761         call MPI_Gatherv(contlistscpj_short,ilist_scp_short,MPI_INTEGER,
 762      &        newcontlistscpj_short,i_ilist_scp_short,displ,MPI_INTEGER,
 763      &        king,FG_COMM,IERR)
 764 c        write (iout,*) "SCp after gatherv ierr",ierr
 765         call MPI_Bcast(g_ilist_scp_short,1,MPI_INT,king,FG_COMM,IERR)
 766         call MPI_Bcast(newcontlistscpi_short,g_ilist_scp_short,MPI_INT,
 767      &        king,FG_COMM,IERR)
 768 c        write (iout,*) "SCp after bcast ierr",ierr
 769         call MPI_Bcast(newcontlistscpj_short,g_ilist_scp_short,MPI_INT,
 770      &        king,FG_COMM,IERR)
 771       else
 772 #endif
 773         g_ilist_scp_long=ilist_scp_long
 774
 775         do i=1,ilist_scp_long
 776           newcontlistscpi_long(i)=contlistscpi_long(i)
 777           newcontlistscpj_long(i)=contlistscpj_long(i)
 778         enddo
 779         g_ilist_scp_short=ilist_scp_short
 780
 781         do i=1,ilist_scp_short
 782           newcontlistscpi_short(i)=contlistscpi_short(i)
 783           newcontlistscpj_short(i)=contlistscpj_short(i)
 784         enddo
 785 #ifdef MPI
 786       endif
 787 #endif
 788       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 789      &then
 790         write (iout,'(a30,i10,a,i4)')
 791      &  "Number of long-range SC-p interactions",
 792      &  g_ilist_scp_long," per residue on average",g_ilist_scp_long/nres
 793         write (iout,'(a30,i10,a,i4)')
 794      &  "Number of short-range SC-p interactions",
 795      &g_ilist_scp_short," per residue on average",g_ilist_scp_short/nres
 796       endif
 797 #ifdef DEBUG
 798       write (iout,*) "make_SCp_inter_list: after GATHERV long-range",
 799      &   g_ilist_scp_long
 800       do i=1,g_ilist_scp_long
 801         write (iout,*) i,newcontlistscpi_long(i),newcontlistscpj_long(i)
 802       enddo
 803       write (iout,*) "make_SCp_inter_list: after GATHERV short-range",
 804      &   g_ilist_scp_short
 805       do i=1,g_ilist_scp_short
 806         write (iout,*) i,newcontlistscpi_short(i),
 807      &   newcontlistscpj_short(i)
 808       enddo
 809 #endif
 810       call int_bounds(g_ilist_scp_long,g_listscp_start_long,
 811      &  g_listscp_end_long)
 812       call int_bounds(g_ilist_scp_short,g_listscp_start_short,
 813      &  g_listscp_end_short)
 814       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 815      &then
 816         write (iout,*) "g_listscp_start",g_listscp_start_long,
 817      &  "g_listscp_end",g_listscp_end_long
 818         write (iout,*)"g_listscp_start_short",g_listscp_start_short,
 819      &  "g_listscp_end_short",g_listscp_end_short
 820       endif
 821       return
 822       end
 823 !-----------------------------------------------------------------------------
 824       subroutine make_pp_vdw_inter_list_RESPA
 825       implicit none
 826       include "DIMENSIONS"
 827 #ifdef MPI
 828       include 'mpif.h'
 829       include "COMMON.SETUP"
 830 #endif
 831       include "COMMON.CONTROL"
 832       include "COMMON.CHAIN"
 833       include "COMMON.INTERACT"
 834       include "COMMON.SPLITELE"
 835       include "COMMON.IOUNITS"
 836       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 837      &  xj_temp,yj_temp,zj_temp
 838       double precision xmedj,ymedj,zmedj
 839       double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
 840      &  xmedi,ymedi,zmedi
 841       double precision dxj,dyj,dzj
 842       integer contlistpp_vdwi_short(maxint_res*maxres),
 843      & contlistpp_vdwj_short(maxint_res*maxres)
 844       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 845      &  ilist_pp_vdw_short,g_ilist_pp_vdw_short
 846       integer displ(0:max_fg_procs),
 847      &  i_ilist_pp_vdw_short(0:max_fg_procs),ierr
 848 !            print *,"START make_SC"
 849       double precision boxshift
 850       double precision d_scale,r_respa_buf
 851 #ifdef DEBUG
 852       write (iout,*) "make_pp_vdw_inter_list"
 853 #endif
 854       ilist_pp_vdw_short=0
 855       r_buff_list=5.0
 856       r_respa_buf=rlamb
 857       do i=iatel_s_vdw,iatel_e_vdw
 858         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 859         dxi=dc(1,i)
 860         dyi=dc(2,i)
 861         dzi=dc(3,i)
 862         xmedi=c(1,i)+0.5d0*dxi
 863         ymedi=c(2,i)+0.5d0*dyi
 864         zmedi=c(3,i)+0.5d0*dzi
 865         call to_box(xmedi,ymedi,zmedi)
 866         do j=ielstart_vdw(i),ielend_vdw(i)
 867 !          write (iout,*) i,j,itype(i),itype(j)
 868           if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
 869 ! 1,j)
 870           dxj=dc(1,j)
 871           dyj=dc(2,j)
 872           dzj=dc(3,j)
 873 !          xj=c(1,j)+0.5D0*dxj-xmedi
 874 !          yj=c(2,j)+0.5D0*dyj-ymedi
 875 !          zj=c(3,j)+0.5D0*dzj-zmedi
 876           xj=c(1,j)+0.5D0*dxj
 877           yj=c(2,j)+0.5D0*dyj
 878           zj=c(3,j)+0.5D0*dzj
 879           call to_box(xj,yj,zj)
 880           xj=boxshift(xj-xmedi,boxxsize)
 881           yj=boxshift(yj-ymedi,boxysize)
 882           zj=boxshift(zj-zmedi,boxzsize)
 883           dist_init=dsqrt(xj*xj+yj*yj+zj*zj)
 884
 885           if (dist_init.le.(r_cut_int+r_buff_list)) then
 886             d_scale=dist_init/rpp(itel(i),itel(j))
 887             if (d_scale.le.r_cut_respa+r_respa_buf) then
 888 ! Here the list is created
 889               ilist_pp_vdw_short=ilist_pp_vdw_short+1
 890 ! this can be substituted by cantor and anti-cantor
 891               contlistpp_vdwi_short(ilist_pp_vdw_short)=i
 892               contlistpp_vdwj_short(ilist_pp_vdw_short)=j
 893             endif
 894           endif
 895         enddo
 896       enddo
 897 !             enddo
 898 #ifdef MPI
 899 #ifdef DEBUG
 900       write (iout,*) "before MPIREDUCE longrange",ilist_pp_vdw_long
 901       do i=1,ilist_pp_vdw_long
 902         write (iout,*) i,contlistpp_vdwi_long(i),contlistpp_vdwj_long(i)
 903       enddo
 904       write (iout,*) "before MPIREDUCE shortrange",ilist_pp_vdw_short
 905       do i=1,ilist_pp_vdw_short
 906         write (iout,*) i,contlistpp_vdwi_short(i),
 907      &    contlistpp_vdwj_short(i)
 908       enddo
 909 #endif
 910       if (nfgtasks.gt.1)then
 911
 912         call MPI_Reduce(ilist_pp_vdw_short,g_ilist_pp_vdw_short,1,
 913      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 914         if (fg_rank.eq.0.and.g_ilist_pp_vdw_short.gt.maxres*maxint_res)
 915      &  then
 916           if ((me.eq.king.or.out1file).and.energy_dec) then
 917             write (iout,*) "Too many pp VDW interactions",
 918      &      g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed."
 919             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 920             call flush(iout)
 921           endif
 922           write (*,*) "Processor:",me,": Too many pp VDW interactions",
 923      &      g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed."
 924           write (8,*) "Specify a smaller r_cut_int and resubmit"
 925           call MPI_Abort(MPI_COMM_WORLD,ierr)
 926         endif
 927 !        write(iout,*) "before bcast",g_ilist_sc
 928         call MPI_Gather(ilist_pp_vdw_short,1,MPI_INTEGER,
 929      &            i_ilist_pp_vdw_short,1,MPI_INTEGER,king,FG_COMM,IERR)
 930         displ(0)=0
 931         do i=1,nfgtasks-1,1
 932           displ(i)=i_ilist_pp_vdw_short(i-1)+displ(i-1)
 933         enddo
 934 !        write(iout,*) "before gather",displ(0),displ(1)
 935         call MPI_Gatherv(contlistpp_vdwi_short,ilist_pp_vdw_short,
 936      &  MPI_INTEGER,newcontlistpp_vdwi_short,i_ilist_pp_vdw_short,displ,
 937      &  MPI_INTEGER,king,FG_COMM,IERR)
 938         call MPI_Gatherv(contlistpp_vdwj_short,ilist_pp_vdw_short,
 939      &  MPI_INTEGER,newcontlistpp_vdwj_short,i_ilist_pp_vdw_short,displ,
 940      &  MPI_INTEGER,king,FG_COMM,IERR)
 941         call MPI_Bcast(g_ilist_pp_vdw_short,1,MPI_INT,king,FG_COMM,IERR)
 942 !        write(iout,*) "before bcast",g_ilist_sc
 943 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 944         call MPI_Bcast(newcontlistpp_vdwi_short,g_ilist_pp_vdw_short,
 945      &   MPI_INT,king,FG_COMM,IERR)
 946         call MPI_Bcast(newcontlistpp_vdwj_short,g_ilist_pp_vdw_short,
 947      &   MPI_INT,king,FG_COMM,IERR)
 948 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 949       else
 950 #endif
 951         g_ilist_pp_vdw_short=ilist_pp_vdw_short
 952
 953         do i=1,ilist_pp_vdw_short
 954           newcontlistpp_vdwi_short(i)=contlistpp_vdwi_short(i)
 955           newcontlistpp_vdwj_short(i)=contlistpp_vdwj_short(i)
 956         enddo
 957 #ifdef MPI
 958       endif
 959 #endif
 960       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 961      &then
 962       write (iout,*) "Number of short-range p-p VDW interactions",
 963      & g_ilist_pp_vdw_short," per residue on average",
 964      & g_ilist_pp_vdw_short/nres
 965       endif
 966 #ifdef DEBUG
 967       write (iout,*) "Short-range pp_vdw"
 968       write (iout,*) "make_pp_vdw_inter_list: after GATHERV",
 969      &  g_ilist_pp_vdw_short
 970       do i=1,g_ilist_pp_vdw_short
 971         write (iout,*) i,newcontlistpp_vdwi_short(i),
 972      &     newcontlistpp_vdwj_short(i)
 973       enddo
 974 #endif
 975       call int_bounds(g_ilist_pp_vdw_short,g_listpp_vdw_start_short,
 976      &       g_listpp_vdw_end_short)
 977       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 978      &then
 979         write (iout,*)"g_listpp_vdw_start_short",
 980      &  g_listpp_vdw_start_short,
 981      &  "g_listpp_vdw_end_short",g_listpp_vdw_end_short
 982       endif
 983       return
 984       end
 985 !-----------------------------------------------------------------------------
 986       subroutine make_pp_inter_list
 987       implicit none
 988       include "DIMENSIONS"
 989 #ifdef MPI
 990       include 'mpif.h'
 991       include "COMMON.SETUP"
 992 #endif
 993       include "COMMON.CONTROL"
 994       include "COMMON.CHAIN"
 995       include "COMMON.INTERACT"
 996       include "COMMON.SPLITELE"
 997       include "COMMON.IOUNITS"
 998       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 999      &  xj_temp,yj_temp,zj_temp
1000       double precision xmedj,ymedj,zmedj
1001       double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
1002      &  xmedi,ymedi,zmedi
1003       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
1004      &  dx_normj,dy_normj,dz_normj
1005       integer contlistppi(maxint_res*maxres),
1006      &  contlistppj(maxint_res*maxres)
1007 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
1008       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
1009      &  ilist_pp,g_ilist_pp
1010       integer displ(0:max_fg_procs),i_ilist_pp(0:max_fg_procs),ierr
1011 !            print *,"START make_SC"
1012 #ifdef DEBUG
1013       write (iout,*) "make_pp_inter_list"
1014 #endif
1015       ilist_pp=0
1016       r_buff_list=5.0
1017       do i=iatel_s,iatel_e
1018         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1019         dxi=dc(1,i)
1020         dyi=dc(2,i)
1021         dzi=dc(3,i)
1022         dx_normi=dc_norm(1,i)
1023         dy_normi=dc_norm(2,i)
1024         dz_normi=dc_norm(3,i)
1025         xmedi=c(1,i)+0.5d0*dxi
1026         ymedi=c(2,i)+0.5d0*dyi
1027         zmedi=c(3,i)+0.5d0*dzi
1028           xmedi=dmod(xmedi,boxxsize)
1029           if (xmedi.lt.0) xmedi=xmedi+boxxsize
1030           ymedi=dmod(ymedi,boxysize)
1031           if (ymedi.lt.0) ymedi=ymedi+boxysize
1032           zmedi=dmod(zmedi,boxzsize)
1033           if (zmedi.lt.0) zmedi=zmedi+boxzsize
1034              do j=ielstart(i),ielend(i)
1035 !          write (iout,*) i,j,itype(i),itype(j)
1036           if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
1037
1038 ! 1,j)
1039           dxj=dc(1,j)
1040           dyj=dc(2,j)
1041           dzj=dc(3,j)
1042           dx_normj=dc_norm(1,j)
1043           dy_normj=dc_norm(2,j)
1044           dz_normj=dc_norm(3,j)
1045 !          xj=c(1,j)+0.5D0*dxj-xmedi
1046 !          yj=c(2,j)+0.5D0*dyj-ymedi
1047 !          zj=c(3,j)+0.5D0*dzj-zmedi
1048           xj=c(1,j)+0.5D0*dxj
1049           yj=c(2,j)+0.5D0*dyj
1050           zj=c(3,j)+0.5D0*dzj
1051           xj=mod(xj,boxxsize)
1052           if (xj.lt.0) xj=xj+boxxsize
1053           yj=mod(yj,boxysize)
1054           if (yj.lt.0) yj=yj+boxysize
1055           zj=mod(zj,boxzsize)
1056           if (zj.lt.0) zj=zj+boxzsize
1057
1058       dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
1059       xj_safe=xj
1060       yj_safe=yj
1061       zj_safe=zj
1062       do xshift=-1,1
1063       do yshift=-1,1
1064       do zshift=-1,1
1065           xj=xj_safe+xshift*boxxsize
1066           yj=yj_safe+yshift*boxysize
1067           zj=zj_safe+zshift*boxzsize
1068           dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
1069           if(dist_temp.lt.dist_init) then
1070             dist_init=dist_temp
1071             xj_temp=xj
1072             yj_temp=yj
1073             zj_temp=zj
1074           endif
1075        enddo
1076        enddo
1077        enddo
1078
1079       if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
1080 ! Here the list is created
1081                  ilist_pp=ilist_pp+1
1082 ! this can be substituted by cantor and anti-cantor
1083                  contlistppi(ilist_pp)=i
1084                  contlistppj(ilist_pp)=j
1085               endif
1086              enddo
1087              enddo
1088 !             enddo
1089 #ifdef MPI
1090 #ifdef DEBUG
1091       write (iout,*) "before MPIREDUCE",ilist_pp
1092       do i=1,ilist_pp
1093       write (iout,*) i,contlistppi(i),contlistppj(i)
1094       enddo
1095 #endif
1096       if (nfgtasks.gt.1)then
1097
1098         call MPI_Reduce(ilist_pp,g_ilist_pp,1,
1099      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
1100 c       write (iout,*) "After reduce ierr",ierr
1101         if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then
1102           if ((me.eq.king.or.out1file).and.energy_dec) then
1103             write (iout,*) "Too many pp interactions",
1104      &      g_ilist_pp," only",maxres*maxint_res," allowed."
1105             write (iout,*) "Specify a smaller r_cut_int and resubmit"
1106             call flush(iout)
1107           endif
1108           write (*,*) "Processor:",me,": Too many pp interactions",
1109      &      g_ilist_pp," only",maxres*maxint_res," allowed."
1110           write (*,*) "Specify a smaller r_cut_int and resubmit"
1111           call MPI_Abort(MPI_COMM_WORLD,ierr)
1112         endif
1113 !        write(iout,*) "before bcast",g_ilist_sc
1114         call MPI_Gather(ilist_pp,1,MPI_INTEGER,
1115      &                  i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
1116 c       write (iout,*) "After gather ierr",ierr
1117         displ(0)=0
1118         do i=1,nfgtasks-1,1
1119           displ(i)=i_ilist_pp(i-1)+displ(i-1)
1120         enddo
1121 !        write(iout,*) "before gather",displ(0),displ(1)
1122         call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
1123      &                   newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
1124      &                   king,FG_COMM,IERR)
1125 c       write (iout,*) "After gatherb ierr",ierr
1126         call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
1127      &                   newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
1128      &                   king,FG_COMM,IERR)
1129 c       write (iout,*) "After gatherb ierr",ierr
1130         call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
1131 !        write(iout,*) "before bcast",g_ilist_sc
1132 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
1133 c       write (iout,*) "After bcast ierr",ierr
1134         call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
1135      &                   IERR)
1136 c       write (iout,*) "After bcast ierr",ierr
1137         call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
1138      &                   IERR)
1139 c       write (iout,*) "After bcast ierr",ierr
1140
1141 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
1142
1143       else
1144 #endif
1145         g_ilist_pp=ilist_pp
1146
1147         do i=1,ilist_pp
1148           newcontlistppi(i)=contlistppi(i)
1149           newcontlistppj(i)=contlistppj(i)
1150         enddo
1151 #ifdef MPI
1152       endif
1153 #endif
1154       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
1155      & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions",
1156      & g_ilist_pp," per residue on average",g_ilist_pp/nres
1157 #ifdef DEBUG
1158       write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp
1159       do i=1,g_ilist_pp
1160       write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
1161       enddo
1162 #endif
1163       call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
1164       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
1165      &then
1166         write (iout,*) "g_listpp_start",g_listpp_start,
1167      &  "g_listpp_end",g_listpp_end
1168       endif
1169       return
1170       end