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 #endif
  26           r_buff_list=5.0d0
  27             ilist_sc=0
  28             do i=iatsc_s,iatsc_e
  29              itypi=iabs(itype(i))
  30              if (itypi.eq.ntyp1) cycle
  31              xi=c(1,nres+i)
  32              yi=c(2,nres+i)
  33              zi=c(3,nres+i)
  34              xi=dmod(xi,boxxsize)
  35              if (xi.lt.0) xi=xi+boxxsize
  36              yi=dmod(yi,boxysize)
  37              if (yi.lt.0) yi=yi+boxysize
  38              zi=dmod(zi,boxzsize)
  39              if (zi.lt.0) zi=zi+boxzsize
  40              do iint=1,nint_gr(i)
  41               do j=istart(i,iint),iend(i,iint)
  42                itypj=iabs(itype(j))
  43                if (itypj.eq.ntyp1) cycle
  44                xj=c(1,nres+j)
  45                yj=c(2,nres+j)
  46                zj=c(3,nres+j)
  47                xj=dmod(xj,boxxsize)
  48                if (xj.lt.0) xj=xj+boxxsize
  49                yj=dmod(yj,boxysize)
  50                if (yj.lt.0) yj=yj+boxysize
  51                zj=dmod(zj,boxzsize)
  52                if (zj.lt.0) zj=zj+boxzsize
  53                dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  54                xj_safe=xj
  55                yj_safe=yj
  56                zj_safe=zj
  57                subchap=0
  58                do xshift=-1,1
  59                do yshift=-1,1
  60                do zshift=-1,1
  61                xj=xj_safe+xshift*boxxsize
  62                yj=yj_safe+yshift*boxysize
  63                zj=zj_safe+zshift*boxzsize
  64                dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  65                if(dist_temp.lt.dist_init) then
  66                 dist_init=dist_temp
  67                 xj_temp=xj
  68                 yj_temp=yj
  69                 zj_temp=zj
  70                 subchap=1
  71                endif
  72                enddo
  73                enddo
  74                enddo
  75                if (subchap.eq.1) then
  76                xj=xj_temp-xi
  77                yj=yj_temp-yi
  78                zj=zj_temp-zi
  79                else
  80                xj=xj_safe-xi
  81                yj=yj_safe-yi
  82                zj=zj_safe-zi
  83                endif
  84 ! r_buff_list is a read value for a buffer
  85                if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
  86 ! Here the list is created
  87                  ilist_sc=ilist_sc+1
  88 ! this can be substituted by cantor and anti-cantor
  89                  contlisti(ilist_sc)=i
  90                  contlistj(ilist_sc)=j
  91
  92                endif
  93              enddo
  94              enddo
  95              enddo
  96 !         call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
  97 !          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
  98 !        call MPI_Gather(newnss,1,MPI_INTEGER,&
  99 !                        i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
 100 #ifdef MPI
 101 #ifdef DEBUG
 102       write (iout,*) "before MPIREDUCE",ilist_sc
 103       do i=1,ilist_sc
 104       write (iout,*) i,contlisti(i),contlistj(i)
 105       enddo
 106 #endif
 107       if (nfgtasks.gt.1)then
 108
 109         call MPI_Reduce(ilist_sc,g_ilist_sc,1,
 110      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 111 c        write (iout,*) "SCSC after reduce ierr",ierr
 112         if (fg_rank.eq.0.and.g_ilist_sc.gt.maxres*maxint_res) then
 113           if ((me.eq.king.or.out1file).and.energy_dec) then
 114             write (iout,*) "Too many SCSC interactions",
 115      &      g_ilist_sc," only",maxres*maxint_res," allowed."
 116             write (iout,*) "Reduce r_cut_int and resubmit"
 117             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 118             call flush(iout)
 119           endif
 120           write (*,*) "Processor:",me,": Too many SCSC interactions",
 121      &      g_ilist_sc," only",maxres*maxint_res," allowed."
 122             write (iout,*) "Reduce r_cut_int and resubmit"
 123             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 124           call MPI_Abort(MPI_COMM_WORLD,ierr)
 125         endif
 126 c        write(iout,*) "before bcast",g_ilist_sc
 127         call MPI_Gather(ilist_sc,1,MPI_INTEGER,
 128      &                  i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
 129 c        write (iout,*) "SCSC after gather ierr",ierr
 130         displ(0)=0
 131         do i=1,nfgtasks-1,1
 132           displ(i)=i_ilist_sc(i-1)+displ(i-1)
 133         enddo
 134 !        write(iout,*) "before gather",displ(0),displ(1)
 135         call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,
 136      &                   newcontlisti,i_ilist_sc,displ,MPI_INTEGER,
 137      &                   king,FG_COMM,IERR)
 138 c        write (iout,*) "SCSC after gatherv ierr",ierr
 139         call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,
 140      &                   newcontlistj,i_ilist_sc,displ,MPI_INTEGER,
 141      &                   king,FG_COMM,IERR)
 142         call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
 143 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 144 !        write(iout,*) "before bcast",g_ilist_sc
 145 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 146         call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,
 147      &                 IERR)
 148 c        write (iout,*) "SCSC bcast reduce ierr",ierr
 149         call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
 150      &                 IERR)
 151 c        write (iout,*) "SCSC after bcast ierr",ierr
 152 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 153
 154         else
 155 #endif
 156         g_ilist_sc=ilist_sc
 157
 158         do i=1,ilist_sc
 159         newcontlisti(i)=contlisti(i)
 160         newcontlistj(i)=contlistj(i)
 161         enddo
 162 #ifdef MPI
 163         endif
 164 #endif
 165       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 166      & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions",
 167      & g_ilist_sc," per residue on average",g_ilist_sc/nres
 168 #ifdef DEBUG
 169       write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc
 170       do i=1,g_ilist_sc
 171       write (iout,*) i,newcontlisti(i),newcontlistj(i)
 172       enddo
 173 #endif
 174         call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
 175       return
 176       end
 177 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 178       subroutine make_SCp_inter_list
 179       implicit none
 180       include "DIMENSIONS"
 181 #ifdef MPI
 182       include 'mpif.h'
 183       include "COMMON.SETUP"
 184 #endif
 185       include "COMMON.CONTROL"
 186       include "COMMON.CHAIN"
 187       include "COMMON.INTERACT"
 188       include "COMMON.SPLITELE"
 189       include "COMMON.IOUNITS"
 190       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 191      &  xj_temp,yj_temp,zj_temp
 192       double precision dist_init, dist_temp,r_buff_list
 193       integer contlistscpi(2*maxint_res*maxres),
 194      & contlistscpj(2*maxint_res*maxres)
 195 !      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
 196       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 197      &  ilist_scp,g_ilist_scp
 198       integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr
 199 c      integer contlistscpi_f(2*maxint_res*maxres),
 200 c     &  contlistscpj_f(2*maxint_res*maxres)
 201       integer ilist_scp_first,ifirstrun,g_ilist_sc
 202 !            print *,"START make_SC"
 203 #ifdef DEBUG
 204       write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
 205 #endif
 206       r_buff_list=5.0
 207             ilist_scp=0
 208             ilist_scp_first=0
 209       do i=iatscp_s,iatscp_e
 210         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 211         xi=0.5D0*(c(1,i)+c(1,i+1))
 212         yi=0.5D0*(c(2,i)+c(2,i+1))
 213         zi=0.5D0*(c(3,i)+c(3,i+1))
 214           xi=mod(xi,boxxsize)
 215           if (xi.lt.0) xi=xi+boxxsize
 216           yi=mod(yi,boxysize)
 217           if (yi.lt.0) yi=yi+boxysize
 218           zi=mod(zi,boxzsize)
 219           if (zi.lt.0) zi=zi+boxzsize
 220
 221         do iint=1,nscp_gr(i)
 222
 223         do j=iscpstart(i,iint),iscpend(i,iint)
 224           itypj=iabs(itype(j))
 225           if (itypj.eq.ntyp1) cycle
 226 ! Uncomment following three lines for SC-p interactions
 227 !         xj=c(1,nres+j)-xi
 228 !         yj=c(2,nres+j)-yi
 229 !         zj=c(3,nres+j)-zi
 230 ! Uncomment following three lines for Ca-p interactions
 231 !          xj=c(1,j)-xi
 232 !          yj=c(2,j)-yi
 233 !          zj=c(3,j)-zi
 234           xj=c(1,j)
 235           yj=c(2,j)
 236           zj=c(3,j)
 237           xj=mod(xj,boxxsize)
 238           if (xj.lt.0) xj=xj+boxxsize
 239           yj=mod(yj,boxysize)
 240           if (yj.lt.0) yj=yj+boxysize
 241           zj=mod(zj,boxzsize)
 242           if (zj.lt.0) zj=zj+boxzsize
 243       dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 244       xj_safe=xj
 245       yj_safe=yj
 246       zj_safe=zj
 247       subchap=0
 248       do xshift=-1,1
 249       do yshift=-1,1
 250       do zshift=-1,1
 251           xj=xj_safe+xshift*boxxsize
 252           yj=yj_safe+yshift*boxysize
 253           zj=zj_safe+zshift*boxzsize
 254           dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 255           if(dist_temp.lt.dist_init) then
 256             dist_init=dist_temp
 257             xj_temp=xj
 258             yj_temp=yj
 259             zj_temp=zj
 260             subchap=1
 261           endif
 262        enddo
 263        enddo
 264        enddo
 265        if (subchap.eq.1) then
 266           xj=xj_temp-xi
 267           yj=yj_temp-yi
 268           zj=zj_temp-zi
 269        else
 270           xj=xj_safe-xi
 271           yj=yj_safe-yi
 272           zj=zj_safe-zi
 273        endif
 274 #ifdef DEBUG
 275                 ! r_buff_list is a read value for a buffer
 276               if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
 277      &        then
 278 ! Here the list is created
 279                  ilist_scp_first=ilist_scp_first+1
 280 ! this can be substituted by cantor and anti-cantor
 281                  contlistscpi_f(ilist_scp_first)=i
 282                  contlistscpj_f(ilist_scp_first)=j
 283               endif
 284 #endif
 285 ! r_buff_list is a read value for a buffer
 286                if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 287 ! Here the list is created
 288                  ilist_scp=ilist_scp+1
 289 ! this can be substituted by cantor and anti-cantor
 290                  contlistscpi(ilist_scp)=i
 291                  contlistscpj(ilist_scp)=j
 292               endif
 293              enddo
 294              enddo
 295              enddo
 296 #ifdef MPI
 297 #ifdef DEBUG
 298       write (iout,*) "before MPIREDUCE",ilist_scp
 299       do i=1,ilist_scp
 300       write (iout,*) i,contlistscpi(i),contlistscpj(i)
 301       enddo
 302 #endif
 303       if (nfgtasks.gt.1)then
 304
 305         call MPI_Reduce(ilist_scp,g_ilist_scp,1,
 306      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 307 c        write (iout,*) "SCp after reduce ierr",ierr
 308         if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then
 309           if ((me.eq.king.or.out1file).and.energy_dec) then
 310             write (iout,*) "Too many SCp interactions",
 311      &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
 312             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 313             call flush(iout)
 314           endif
 315           write (*,*) "Processor:",me,": Too many SCp interactions",
 316      &      g_ilist_scp," only",2*maxres*maxint_res," allowed."
 317           write (*,*) "Specify a smaller r_cut_int and resubmit"
 318           call MPI_Abort(MPI_COMM_WORLD,ierr)
 319         endif
 320 c        write(iout,*) "before bcast",g_ilist_sc
 321         call MPI_Gather(ilist_scp,1,MPI_INTEGER,
 322      &                  i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
 323 c        write (iout,*) "SCp after gather ierr",ierr
 324         displ(0)=0
 325         do i=1,nfgtasks-1,1
 326           displ(i)=i_ilist_scp(i-1)+displ(i-1)
 327         enddo
 328 !        write(iout,*) "before gather",displ(0),displ(1)
 329         call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,
 330      &                   newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,
 331      &                   king,FG_COMM,IERR)
 332 c        write (iout,*) "SCp after gatherv ierr",ierr
 333         call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
 334      &                   newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
 335      &                   king,FG_COMM,IERR)
 336 c        write (iout,*) "SCp after gatherv ierr",ierr
 337         call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
 338 c        write (iout,*) "SCp after bcast ierr",ierr
 339 !        write(iout,*) "before bcast",g_ilist_sc
 340 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 341         call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,
 342      &                   IERR)
 343 c        write (iout,*) "SCp after bcast ierr",ierr
 344         call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
 345      &                   IERR)
 346 c        write (iout,*) "SCp bcast reduce ierr",ierr
 347 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 348         else
 349 #endif
 350         g_ilist_scp=ilist_scp
 351
 352         do i=1,ilist_scp
 353         newcontlistscpi(i)=contlistscpi(i)
 354         newcontlistscpj(i)=contlistscpj(i)
 355         enddo
 356 #ifdef MPI
 357         endif
 358 #endif
 359       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 360      & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions",
 361      & g_ilist_scp," per residue on average",g_ilist_scp/nres
 362 #ifdef DEBUG
 363       write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp
 364       do i=1,g_ilist_scp
 365       write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
 366       enddo
 367
 368 !      if (ifirstrun.eq.0) ifirstrun=1
 369 !      do i=1,ilist_scp_first
 370 !       do j=1,g_ilist_scp
 371 !        if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
 372 !         (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
 373 !        enddo
 374 !       print *,itime_mat,"ERROR matrix needs updating"
 375 !       print *,contlistscpi_f(i),contlistscpj_f(i)
 376 !  126  continue
 377 !      enddo
 378 #endif
 379         call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
 380
 381       return
 382       end
 383 !-----------------------------------------------------------------------------
 384       subroutine make_pp_vdw_inter_list
 385       implicit none
 386       include "DIMENSIONS"
 387 #ifdef MPI
 388       include 'mpif.h'
 389       include "COMMON.SETUP"
 390 #endif
 391       include "COMMON.CONTROL"
 392       include "COMMON.CHAIN"
 393       include "COMMON.INTERACT"
 394       include "COMMON.SPLITELE"
 395       include "COMMON.IOUNITS"
 396       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 397      &  xj_temp,yj_temp,zj_temp
 398       double precision xmedj,ymedj,zmedj
 399       double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
 400      &  xmedi,ymedi,zmedi
 401       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
 402      &  dx_normj,dy_normj,dz_normj
 403       integer contlistpp_vdwi(maxint_res*maxres),
 404      & contlistpp_vdwj(maxint_res*maxres)
 405 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
 406       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 407      &  ilist_pp_vdw,g_ilist_pp_vdw
 408       integer displ(0:max_fg_procs),i_ilist_pp_vdw(0:max_fg_procs),ierr
 409 !            print *,"START make_SC"
 410 #ifdef DEBUG
 411       write (iout,*) "make_pp_vdw_inter_list"
 412 #endif
 413       ilist_pp_vdw=0
 414       r_buff_list=5.0
 415       do i=iatel_s_vdw,iatel_e_vdw
 416         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 417         dxi=dc(1,i)
 418         dyi=dc(2,i)
 419         dzi=dc(3,i)
 420         dx_normi=dc_norm(1,i)
 421         dy_normi=dc_norm(2,i)
 422         dz_normi=dc_norm(3,i)
 423         xmedi=c(1,i)+0.5d0*dxi
 424         ymedi=c(2,i)+0.5d0*dyi
 425         zmedi=c(3,i)+0.5d0*dzi
 426         xmedi=dmod(xmedi,boxxsize)
 427         if (xmedi.lt.0) xmedi=xmedi+boxxsize
 428         ymedi=dmod(ymedi,boxysize)
 429         if (ymedi.lt.0) ymedi=ymedi+boxysize
 430         zmedi=dmod(zmedi,boxzsize)
 431         if (zmedi.lt.0) zmedi=zmedi+boxzsize
 432         do j=ielstart_vdw(i),ielend_vdw(i)
 433 !          write (iout,*) i,j,itype(i),itype(j)
 434           if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
 435
 436 ! 1,j)
 437           dxj=dc(1,j)
 438           dyj=dc(2,j)
 439           dzj=dc(3,j)
 440           dx_normj=dc_norm(1,j)
 441           dy_normj=dc_norm(2,j)
 442           dz_normj=dc_norm(3,j)
 443 !          xj=c(1,j)+0.5D0*dxj-xmedi
 444 !          yj=c(2,j)+0.5D0*dyj-ymedi
 445 !          zj=c(3,j)+0.5D0*dzj-zmedi
 446           xj=c(1,j)+0.5D0*dxj
 447           yj=c(2,j)+0.5D0*dyj
 448           zj=c(3,j)+0.5D0*dzj
 449           xj=mod(xj,boxxsize)
 450           if (xj.lt.0) xj=xj+boxxsize
 451           yj=mod(yj,boxysize)
 452           if (yj.lt.0) yj=yj+boxysize
 453           zj=mod(zj,boxzsize)
 454           if (zj.lt.0) zj=zj+boxzsize
 455
 456           dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 457           xj_safe=xj
 458           yj_safe=yj
 459           zj_safe=zj
 460           do xshift=-1,1
 461           do yshift=-1,1
 462           do zshift=-1,1
 463           xj=xj_safe+xshift*boxxsize
 464           yj=yj_safe+yshift*boxysize
 465           zj=zj_safe+zshift*boxzsize
 466           dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 467           if(dist_temp.lt.dist_init) then
 468             dist_init=dist_temp
 469             xj_temp=xj
 470             yj_temp=yj
 471             zj_temp=zj
 472           endif
 473           enddo
 474           enddo
 475           enddo
 476
 477           if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 478 ! Here the list is created
 479             ilist_pp_vdw=ilist_pp_vdw+1
 480 ! this can be substituted by cantor and anti-cantor
 481             contlistpp_vdwi(ilist_pp_vdw)=i
 482             contlistpp_vdwj(ilist_pp_vdw)=j
 483           endif
 484           enddo
 485           enddo
 486 !             enddo
 487 #ifdef MPI
 488 #ifdef DEBUG
 489       write (iout,*) "before MPIREDUCE",ilist_pp_vdw
 490       do i=1,ilist_pp_vdw
 491         write (iout,*) i,contlistpp_vdwi(i),contlistpp_vdwj(i)
 492       enddo
 493 #endif
 494       if (nfgtasks.gt.1)then
 495
 496         call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1,
 497      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 498         if (fg_rank.eq.0.and.g_ilist_pp_vdw.gt.maxres*maxint_res) then
 499           if ((me.eq.king.or.out1file).and.energy_dec) then
 500             write (iout,*) "Too many pp VDW interactions",
 501      &      g_ilist_pp_vdw," only",maxres*maxint_res," allowed."
 502             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 503             call flush(iout)
 504           endif
 505           write (*,*) "Processor:",me,": Too many pp VDW interactions",
 506      &      g_ilist_pp_vdw," only",maxres*maxint_res," allowed."
 507           write (8,*) "Specify a smaller r_cut_int and resubmit"
 508           call MPI_Abort(MPI_COMM_WORLD,ierr)
 509         endif
 510 !        write(iout,*) "before bcast",g_ilist_sc
 511         call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER,
 512      &                  i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR)
 513         displ(0)=0
 514         do i=1,nfgtasks-1,1
 515           displ(i)=i_ilist_pp_vdw(i-1)+displ(i-1)
 516         enddo
 517 !        write(iout,*) "before gather",displ(0),displ(1)
 518         call MPI_Gatherv(contlistpp_vdwi,ilist_pp_vdw,MPI_INTEGER,
 519      &              newcontlistpp_vdwi,i_ilist_pp_vdw,displ,MPI_INTEGER,
 520      &              king,FG_COMM,IERR)
 521         call MPI_Gatherv(contlistpp_vdwj,ilist_pp_vdw,MPI_INTEGER,
 522      &              newcontlistpp_vdwj,i_ilist_pp_vdw,displ,MPI_INTEGER,
 523      &              king,FG_COMM,IERR)
 524         call MPI_Bcast(g_ilist_pp_vdw,1,MPI_INT,king,FG_COMM,IERR)
 525 !        write(iout,*) "before bcast",g_ilist_sc
 526 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 527         call MPI_Bcast(newcontlistpp_vdwi,g_ilist_pp_vdw,MPI_INT,king,
 528      &                   FG_COMM,IERR)
 529         call MPI_Bcast(newcontlistpp_vdwj,g_ilist_pp_vdw,MPI_INT,king,
 530      &                   FG_COMM,IERR)
 531
 532 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 533
 534         else
 535 #endif
 536         g_ilist_pp_vdw=ilist_pp_vdw
 537
 538         do i=1,ilist_pp_vdw
 539           newcontlistpp_vdwi(i)=contlistpp_vdwi(i)
 540           newcontlistpp_vdwj(i)=contlistpp_vdwj(i)
 541         enddo
 542 #ifdef MPI
 543         endif
 544 #endif
 545         call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start,
 546      &       g_listpp_vdw_end)
 547       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 548      &write (iout,'(a30,i10,a,i4)') "Number of p-p VDW interactions",
 549      & g_ilist_pp_vdw," per residue on average",g_ilist_pp_vdw/nres
 550 #ifdef DEBUG
 551       write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start,
 552      &  "g_listpp_vdw_end",g_listpp_vdw_end
 553       write (iout,*) "make_pp_vdw_inter_list: after GATHERV",
 554      &  g_ilist_pp_vdw
 555       do i=1,g_ilist_pp_vdw
 556         write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i)
 557       enddo
 558 #endif
 559       return
 560       end
 561 !-----------------------------------------------------------------------------
 562       subroutine make_pp_inter_list
 563       implicit none
 564       include "DIMENSIONS"
 565 #ifdef MPI
 566       include 'mpif.h'
 567       include "COMMON.SETUP"
 568 #endif
 569       include "COMMON.CONTROL"
 570       include "COMMON.CHAIN"
 571       include "COMMON.INTERACT"
 572       include "COMMON.SPLITELE"
 573       include "COMMON.IOUNITS"
 574       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 575      &  xj_temp,yj_temp,zj_temp
 576       double precision xmedj,ymedj,zmedj
 577       double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
 578      &  xmedi,ymedi,zmedi
 579       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
 580      &  dx_normj,dy_normj,dz_normj
 581       integer contlistppi(maxint_res*maxres),
 582      &  contlistppj(maxint_res*maxres)
 583 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
 584       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 585      &  ilist_pp,g_ilist_pp
 586       integer displ(0:max_fg_procs),i_ilist_pp(0:max_fg_procs),ierr
 587 !            print *,"START make_SC"
 588 #ifdef DEBUG
 589       write (iout,*) "make_pp_inter_list"
 590 #endif
 591       ilist_pp=0
 592       r_buff_list=5.0
 593       do i=iatel_s,iatel_e
 594         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 595         dxi=dc(1,i)
 596         dyi=dc(2,i)
 597         dzi=dc(3,i)
 598         dx_normi=dc_norm(1,i)
 599         dy_normi=dc_norm(2,i)
 600         dz_normi=dc_norm(3,i)
 601         xmedi=c(1,i)+0.5d0*dxi
 602         ymedi=c(2,i)+0.5d0*dyi
 603         zmedi=c(3,i)+0.5d0*dzi
 604           xmedi=dmod(xmedi,boxxsize)
 605           if (xmedi.lt.0) xmedi=xmedi+boxxsize
 606           ymedi=dmod(ymedi,boxysize)
 607           if (ymedi.lt.0) ymedi=ymedi+boxysize
 608           zmedi=dmod(zmedi,boxzsize)
 609           if (zmedi.lt.0) zmedi=zmedi+boxzsize
 610              do j=ielstart(i),ielend(i)
 611 !          write (iout,*) i,j,itype(i),itype(j)
 612           if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
 613
 614 ! 1,j)
 615           dxj=dc(1,j)
 616           dyj=dc(2,j)
 617           dzj=dc(3,j)
 618           dx_normj=dc_norm(1,j)
 619           dy_normj=dc_norm(2,j)
 620           dz_normj=dc_norm(3,j)
 621 !          xj=c(1,j)+0.5D0*dxj-xmedi
 622 !          yj=c(2,j)+0.5D0*dyj-ymedi
 623 !          zj=c(3,j)+0.5D0*dzj-zmedi
 624           xj=c(1,j)+0.5D0*dxj
 625           yj=c(2,j)+0.5D0*dyj
 626           zj=c(3,j)+0.5D0*dzj
 627           xj=mod(xj,boxxsize)
 628           if (xj.lt.0) xj=xj+boxxsize
 629           yj=mod(yj,boxysize)
 630           if (yj.lt.0) yj=yj+boxysize
 631           zj=mod(zj,boxzsize)
 632           if (zj.lt.0) zj=zj+boxzsize
 633
 634       dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 635       xj_safe=xj
 636       yj_safe=yj
 637       zj_safe=zj
 638       do xshift=-1,1
 639       do yshift=-1,1
 640       do zshift=-1,1
 641           xj=xj_safe+xshift*boxxsize
 642           yj=yj_safe+yshift*boxysize
 643           zj=zj_safe+zshift*boxzsize
 644           dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 645           if(dist_temp.lt.dist_init) then
 646             dist_init=dist_temp
 647             xj_temp=xj
 648             yj_temp=yj
 649             zj_temp=zj
 650           endif
 651        enddo
 652        enddo
 653        enddo
 654
 655       if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 656 ! Here the list is created
 657                  ilist_pp=ilist_pp+1
 658 ! this can be substituted by cantor and anti-cantor
 659                  contlistppi(ilist_pp)=i
 660                  contlistppj(ilist_pp)=j
 661               endif
 662              enddo
 663              enddo
 664 !             enddo
 665 #ifdef MPI
 666 #ifdef DEBUG
 667       write (iout,*) "before MPIREDUCE",ilist_pp
 668       do i=1,ilist_pp
 669       write (iout,*) i,contlistppi(i),contlistppj(i)
 670       enddo
 671 #endif
 672       if (nfgtasks.gt.1)then
 673
 674         call MPI_Reduce(ilist_pp,g_ilist_pp,1,
 675      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 676 c       write (iout,*) "After reduce ierr",ierr
 677         if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then
 678           if ((me.eq.king.or.out1file).and.energy_dec) then
 679             write (iout,*) "Too many pp interactions",
 680      &      g_ilist_pp," only",maxres*maxint_res," allowed."
 681             write (iout,*) "Specify a smaller r_cut_int and resubmit"
 682             call flush(iout)
 683           endif
 684           write (*,*) "Processor:",me,": Too many pp interactions",
 685      &      g_ilist_pp," only",maxres*maxint_res," allowed."
 686           write (*,*) "Specify a smaller r_cut_int and resubmit"
 687           call MPI_Abort(MPI_COMM_WORLD,ierr)
 688         endif
 689 !        write(iout,*) "before bcast",g_ilist_sc
 690         call MPI_Gather(ilist_pp,1,MPI_INTEGER,
 691      &                  i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
 692 c       write (iout,*) "After gather ierr",ierr
 693         displ(0)=0
 694         do i=1,nfgtasks-1,1
 695           displ(i)=i_ilist_pp(i-1)+displ(i-1)
 696         enddo
 697 !        write(iout,*) "before gather",displ(0),displ(1)
 698         call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
 699      &                   newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
 700      &                   king,FG_COMM,IERR)
 701 c       write (iout,*) "After gatherb ierr",ierr
 702         call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
 703      &                   newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
 704      &                   king,FG_COMM,IERR)
 705 c       write (iout,*) "After gatherb ierr",ierr
 706         call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
 707 !        write(iout,*) "before bcast",g_ilist_sc
 708 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 709 c       write (iout,*) "After bcast ierr",ierr
 710         call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
 711      &                   IERR)
 712 c       write (iout,*) "After bcast ierr",ierr
 713         call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
 714      &                   IERR)
 715 c       write (iout,*) "After bcast ierr",ierr
 716
 717 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 718
 719         else
 720 #endif
 721         g_ilist_pp=ilist_pp
 722
 723         do i=1,ilist_pp
 724         newcontlistppi(i)=contlistppi(i)
 725         newcontlistppj(i)=contlistppj(i)
 726         enddo
 727 #ifdef MPI
 728         endif
 729 #endif
 730         call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
 731       if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
 732      & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions",
 733      & g_ilist_pp," per residue on average",g_ilist_pp/nres
 734 #ifdef DEBUG
 735       write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp
 736       do i=1,g_ilist_pp
 737       write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
 738       enddo
 739 #endif
 740       return
 741       end