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.CHAIN"
   9       include "COMMON.INTERACT"
  10       include "COMMON.SPLITELE"
  11       include "COMMON.IOUNITS"
  12       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
  13      &  xj_temp,yj_temp,zj_temp
  14       double precision dist_init, dist_temp,r_buff_list
  15       integer contlisti(200*maxres),contlistj(200*maxres)
  16 !      integer :: newcontlisti(200*nres),newcontlistj(200*nres)
  17       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
  18      &  ilist_sc,g_ilist_sc
  19       integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
  20 !            print *,"START make_SC"
  21 #ifdef DEBUG
  22       write (iout,*) "make_SCSC_inter_list"
  23 #endif
  24           r_buff_list=5.0d0
  25             ilist_sc=0
  26             do i=iatsc_s,iatsc_e
  27              itypi=iabs(itype(i))
  28              if (itypi.eq.ntyp1) cycle
  29              xi=c(1,nres+i)
  30              yi=c(2,nres+i)
  31              zi=c(3,nres+i)
  32              xi=dmod(xi,boxxsize)
  33              if (xi.lt.0) xi=xi+boxxsize
  34              yi=dmod(yi,boxysize)
  35              if (yi.lt.0) yi=yi+boxysize
  36              zi=dmod(zi,boxzsize)
  37              if (zi.lt.0) zi=zi+boxzsize
  38              do iint=1,nint_gr(i)
  39               do j=istart(i,iint),iend(i,iint)
  40                itypj=iabs(itype(j))
  41                if (itypj.eq.ntyp1) cycle
  42                xj=c(1,nres+j)
  43                yj=c(2,nres+j)
  44                zj=c(3,nres+j)
  45                xj=dmod(xj,boxxsize)
  46                if (xj.lt.0) xj=xj+boxxsize
  47                yj=dmod(yj,boxysize)
  48                if (yj.lt.0) yj=yj+boxysize
  49                zj=dmod(zj,boxzsize)
  50                if (zj.lt.0) zj=zj+boxzsize
  51                dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  52                xj_safe=xj
  53                yj_safe=yj
  54                zj_safe=zj
  55                subchap=0
  56                do xshift=-1,1
  57                do yshift=-1,1
  58                do zshift=-1,1
  59                xj=xj_safe+xshift*boxxsize
  60                yj=yj_safe+yshift*boxysize
  61                zj=zj_safe+zshift*boxzsize
  62                dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
  63                if(dist_temp.lt.dist_init) then
  64                 dist_init=dist_temp
  65                 xj_temp=xj
  66                 yj_temp=yj
  67                 zj_temp=zj
  68                 subchap=1
  69                endif
  70                enddo
  71                enddo
  72                enddo
  73                if (subchap.eq.1) then
  74                xj=xj_temp-xi
  75                yj=yj_temp-yi
  76                zj=zj_temp-zi
  77                else
  78                xj=xj_safe-xi
  79                yj=yj_safe-yi
  80                zj=zj_safe-zi
  81                endif
  82 ! r_buff_list is a read value for a buffer
  83                if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
  84 ! Here the list is created
  85                  ilist_sc=ilist_sc+1
  86 ! this can be substituted by cantor and anti-cantor
  87                  contlisti(ilist_sc)=i
  88                  contlistj(ilist_sc)=j
  89
  90                endif
  91              enddo
  92              enddo
  93              enddo
  94 !         call MPI_Reduce(ilist_sc,g_ilist_sc,1,&
  95 !          MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
  96 !        call MPI_Gather(newnss,1,MPI_INTEGER,&
  97 !                        i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
  98 #ifdef MPI
  99 #ifdef DEBUG
 100       write (iout,*) "before MPIREDUCE",ilist_sc
 101       do i=1,ilist_sc
 102       write (iout,*) i,contlisti(i),contlistj(i)
 103       enddo
 104 #endif
 105       if (nfgtasks.gt.1)then
 106
 107         call MPI_Reduce(ilist_sc,g_ilist_sc,1,
 108      &                  MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 109 c        write(iout,*) "before bcast",g_ilist_sc
 110         call MPI_Gather(ilist_sc,1,MPI_INTEGER,
 111      &                  i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR)
 112         displ(0)=0
 113         do i=1,nfgtasks-1,1
 114           displ(i)=i_ilist_sc(i-1)+displ(i-1)
 115         enddo
 116 !        write(iout,*) "before gather",displ(0),displ(1)
 117         call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,
 118      &                   newcontlisti,i_ilist_sc,displ,MPI_INTEGER,
 119      &                   king,FG_COMM,IERR)
 120         call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,
 121      &                   newcontlistj,i_ilist_sc,displ,MPI_INTEGER,
 122      &                   king,FG_COMM,IERR)
 123         call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR)
 124 !        write(iout,*) "before bcast",g_ilist_sc
 125 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 126         call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,
 127      &                 IERR)
 128         call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
 129      &                 IERR)
 130 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 131
 132         else
 133 #endif
 134         g_ilist_sc=ilist_sc
 135
 136         do i=1,ilist_sc
 137         newcontlisti(i)=contlisti(i)
 138         newcontlistj(i)=contlistj(i)
 139         enddo
 140 #ifdef MPI
 141         endif
 142 #endif
 143 #ifdef DEBUG
 144       write (iout,*) "after GATHERV",g_ilist_sc
 145       do i=1,g_ilist_sc
 146       write (iout,*) i,newcontlisti(i),newcontlistj(i)
 147       enddo
 148 #endif
 149         call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
 150       return
 151       end
 152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 153       subroutine make_SCp_inter_list
 154       implicit none
 155       include "DIMENSIONS"
 156 #ifdef MPI
 157       include 'mpif.h'
 158       include "COMMON.SETUP"
 159 #endif
 160       include "COMMON.CHAIN"
 161       include "COMMON.INTERACT"
 162       include "COMMON.SPLITELE"
 163       include "COMMON.IOUNITS"
 164       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 165      &  xj_temp,yj_temp,zj_temp
 166       double precision dist_init, dist_temp,r_buff_list
 167       integer contlistscpi(200*maxres),contlistscpj(200*maxres)
 168 !      integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres)
 169       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 170      &  ilist_scp,g_ilist_scp
 171       integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr
 172       integer contlistscpi_f(200*maxres),contlistscpj_f(200*maxres)
 173       integer ilist_scp_first,ifirstrun,g_ilist_sc
 174 !            print *,"START make_SC"
 175 #ifdef DEBUG
 176       write (iout,*) "make_SCp_inter_list"
 177 #endif
 178       r_buff_list=5.0
 179             ilist_scp=0
 180             ilist_scp_first=0
 181       do i=iatscp_s,iatscp_e
 182         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 183         xi=0.5D0*(c(1,i)+c(1,i+1))
 184         yi=0.5D0*(c(2,i)+c(2,i+1))
 185         zi=0.5D0*(c(3,i)+c(3,i+1))
 186           xi=mod(xi,boxxsize)
 187           if (xi.lt.0) xi=xi+boxxsize
 188           yi=mod(yi,boxysize)
 189           if (yi.lt.0) yi=yi+boxysize
 190           zi=mod(zi,boxzsize)
 191           if (zi.lt.0) zi=zi+boxzsize
 192
 193         do iint=1,nscp_gr(i)
 194
 195         do j=iscpstart(i,iint),iscpend(i,iint)
 196           itypj=iabs(itype(j))
 197           if (itypj.eq.ntyp1) cycle
 198 ! Uncomment following three lines for SC-p interactions
 199 !         xj=c(1,nres+j)-xi
 200 !         yj=c(2,nres+j)-yi
 201 !         zj=c(3,nres+j)-zi
 202 ! Uncomment following three lines for Ca-p interactions
 203 !          xj=c(1,j)-xi
 204 !          yj=c(2,j)-yi
 205 !          zj=c(3,j)-zi
 206           xj=c(1,j)
 207           yj=c(2,j)
 208           zj=c(3,j)
 209           xj=mod(xj,boxxsize)
 210           if (xj.lt.0) xj=xj+boxxsize
 211           yj=mod(yj,boxysize)
 212           if (yj.lt.0) yj=yj+boxysize
 213           zj=mod(zj,boxzsize)
 214           if (zj.lt.0) zj=zj+boxzsize
 215       dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 216       xj_safe=xj
 217       yj_safe=yj
 218       zj_safe=zj
 219       subchap=0
 220       do xshift=-1,1
 221       do yshift=-1,1
 222       do zshift=-1,1
 223           xj=xj_safe+xshift*boxxsize
 224           yj=yj_safe+yshift*boxysize
 225           zj=zj_safe+zshift*boxzsize
 226           dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
 227           if(dist_temp.lt.dist_init) then
 228             dist_init=dist_temp
 229             xj_temp=xj
 230             yj_temp=yj
 231             zj_temp=zj
 232             subchap=1
 233           endif
 234        enddo
 235        enddo
 236        enddo
 237        if (subchap.eq.1) then
 238           xj=xj_temp-xi
 239           yj=yj_temp-yi
 240           zj=zj_temp-zi
 241        else
 242           xj=xj_safe-xi
 243           yj=yj_safe-yi
 244           zj=zj_safe-zi
 245        endif
 246 #ifdef DEBUG
 247                 ! r_buff_list is a read value for a buffer
 248               if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
 249      &        then
 250 ! Here the list is created
 251                  ilist_scp_first=ilist_scp_first+1
 252 ! this can be substituted by cantor and anti-cantor
 253                  contlistscpi_f(ilist_scp_first)=i
 254                  contlistscpj_f(ilist_scp_first)=j
 255               endif
 256 #endif
 257 ! r_buff_list is a read value for a buffer
 258                if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 259 ! Here the list is created
 260                  ilist_scp=ilist_scp+1
 261 ! this can be substituted by cantor and anti-cantor
 262                  contlistscpi(ilist_scp)=i
 263                  contlistscpj(ilist_scp)=j
 264               endif
 265              enddo
 266              enddo
 267              enddo
 268 #ifdef MPI
 269 #ifdef DEBUG
 270       write (iout,*) "before MPIREDUCE",ilist_scp
 271       do i=1,ilist_scp
 272       write (iout,*) i,contlistscpi(i),contlistscpj(i)
 273       enddo
 274 #endif
 275       if (nfgtasks.gt.1)then
 276
 277         call MPI_Reduce(ilist_scp,g_ilist_scp,1,
 278      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 279 c        write(iout,*) "before bcast",g_ilist_sc
 280         call MPI_Gather(ilist_scp,1,MPI_INTEGER,
 281      &                  i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR)
 282         displ(0)=0
 283         do i=1,nfgtasks-1,1
 284           displ(i)=i_ilist_scp(i-1)+displ(i-1)
 285         enddo
 286 !        write(iout,*) "before gather",displ(0),displ(1)
 287         call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,
 288      &                   newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,
 289      &                   king,FG_COMM,IERR)
 290         call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
 291      &                   newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
 292      &                   king,FG_COMM,IERR)
 293         call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR)
 294 !        write(iout,*) "before bcast",g_ilist_sc
 295 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 296         call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,
 297      &                   IERR)
 298         call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
 299      &                   IERR)
 300 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 301         else
 302 #endif
 303         g_ilist_scp=ilist_scp
 304
 305         do i=1,ilist_scp
 306         newcontlistscpi(i)=contlistscpi(i)
 307         newcontlistscpj(i)=contlistscpj(i)
 308         enddo
 309 #ifdef MPI
 310         endif
 311 #endif
 312 #ifdef DEBUG
 313       write (iout,*) "after MPIREDUCE",g_ilist_scp
 314       do i=1,g_ilist_scp
 315       write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
 316       enddo
 317
 318 !      if (ifirstrun.eq.0) ifirstrun=1
 319 !      do i=1,ilist_scp_first
 320 !       do j=1,g_ilist_scp
 321 !        if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
 322 !         (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
 323 !        enddo
 324 !       print *,itime_mat,"ERROR matrix needs updating"
 325 !       print *,contlistscpi_f(i),contlistscpj_f(i)
 326 !  126  continue
 327 !      enddo
 328 #endif
 329         call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
 330
 331       return
 332       end
 333 !-----------------------------------------------------------------------------
 334       subroutine make_pp_inter_list
 335       implicit none
 336       include "DIMENSIONS"
 337 #ifdef MPI
 338       include 'mpif.h'
 339       include "COMMON.SETUP"
 340 #endif
 341       include "COMMON.CHAIN"
 342       include "COMMON.INTERACT"
 343       include "COMMON.SPLITELE"
 344       include "COMMON.IOUNITS"
 345       double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
 346      &  xj_temp,yj_temp,zj_temp
 347       double precision xmedj,ymedj,zmedj
 348       double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
 349      &  xmedi,ymedi,zmedi
 350       double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
 351      &  dx_normj,dy_normj,dz_normj
 352       integer contlistppi(200*maxres),contlistppj(200*maxres)
 353 !      integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
 354       integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
 355      &  ilist_pp,g_ilist_pp
 356       integer displ(0:max_fg_procs),i_ilist_pp(0:max_fg_procs),ierr
 357 !            print *,"START make_SC"
 358 #ifdef DEBUG
 359       write (iout,*) "make_pp_inter_list"
 360 #endif
 361       ilist_pp=0
 362       r_buff_list=5.0
 363       do i=iatel_s,iatel_e
 364         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
 365         dxi=dc(1,i)
 366         dyi=dc(2,i)
 367         dzi=dc(3,i)
 368         dx_normi=dc_norm(1,i)
 369         dy_normi=dc_norm(2,i)
 370         dz_normi=dc_norm(3,i)
 371         xmedi=c(1,i)+0.5d0*dxi
 372         ymedi=c(2,i)+0.5d0*dyi
 373         zmedi=c(3,i)+0.5d0*dzi
 374           xmedi=dmod(xmedi,boxxsize)
 375           if (xmedi.lt.0) xmedi=xmedi+boxxsize
 376           ymedi=dmod(ymedi,boxysize)
 377           if (ymedi.lt.0) ymedi=ymedi+boxysize
 378           zmedi=dmod(zmedi,boxzsize)
 379           if (zmedi.lt.0) zmedi=zmedi+boxzsize
 380              do j=ielstart(i),ielend(i)
 381 !          write (iout,*) i,j,itype(i),itype(j)
 382           if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
 383
 384 ! 1,j)
 385           dxj=dc(1,j)
 386           dyj=dc(2,j)
 387           dzj=dc(3,j)
 388           dx_normj=dc_norm(1,j)
 389           dy_normj=dc_norm(2,j)
 390           dz_normj=dc_norm(3,j)
 391 !          xj=c(1,j)+0.5D0*dxj-xmedi
 392 !          yj=c(2,j)+0.5D0*dyj-ymedi
 393 !          zj=c(3,j)+0.5D0*dzj-zmedi
 394           xj=c(1,j)+0.5D0*dxj
 395           yj=c(2,j)+0.5D0*dyj
 396           zj=c(3,j)+0.5D0*dzj
 397           xj=mod(xj,boxxsize)
 398           if (xj.lt.0) xj=xj+boxxsize
 399           yj=mod(yj,boxysize)
 400           if (yj.lt.0) yj=yj+boxysize
 401           zj=mod(zj,boxzsize)
 402           if (zj.lt.0) zj=zj+boxzsize
 403
 404       dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 405       xj_safe=xj
 406       yj_safe=yj
 407       zj_safe=zj
 408       do xshift=-1,1
 409       do yshift=-1,1
 410       do zshift=-1,1
 411           xj=xj_safe+xshift*boxxsize
 412           yj=yj_safe+yshift*boxysize
 413           zj=zj_safe+zshift*boxzsize
 414           dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
 415           if(dist_temp.lt.dist_init) then
 416             dist_init=dist_temp
 417             xj_temp=xj
 418             yj_temp=yj
 419             zj_temp=zj
 420           endif
 421        enddo
 422        enddo
 423        enddo
 424
 425       if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
 426 ! Here the list is created
 427                  ilist_pp=ilist_pp+1
 428 ! this can be substituted by cantor and anti-cantor
 429                  contlistppi(ilist_pp)=i
 430                  contlistppj(ilist_pp)=j
 431               endif
 432              enddo
 433              enddo
 434 !             enddo
 435 #ifdef MPI
 436 #ifdef DEBUG
 437       write (iout,*) "before MPIREDUCE",ilist_pp
 438       do i=1,ilist_pp
 439       write (iout,*) i,contlistppi(i),contlistppj(i)
 440       enddo
 441 #endif
 442       if (nfgtasks.gt.1)then
 443
 444         call MPI_Reduce(ilist_pp,g_ilist_pp,1,
 445      &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
 446 !        write(iout,*) "before bcast",g_ilist_sc
 447         call MPI_Gather(ilist_pp,1,MPI_INTEGER,
 448      &                  i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
 449         displ(0)=0
 450         do i=1,nfgtasks-1,1
 451           displ(i)=i_ilist_pp(i-1)+displ(i-1)
 452         enddo
 453 !        write(iout,*) "before gather",displ(0),displ(1)
 454         call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
 455      &                   newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
 456      &                   king,FG_COMM,IERR)
 457         call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
 458      &                   newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
 459      &                   king,FG_COMM,IERR)
 460         call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
 461 !        write(iout,*) "before bcast",g_ilist_sc
 462 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 463         call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
 464      &                   IERR)
 465         call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
 466      &                   IERR)
 467
 468 !        call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
 469
 470         else
 471 #endif
 472         g_ilist_pp=ilist_pp
 473
 474         do i=1,ilist_pp
 475         newcontlistppi(i)=contlistppi(i)
 476         newcontlistppj(i)=contlistppj(i)
 477         enddo
 478 #ifdef MPI
 479         endif
 480 #endif
 481         call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
 482 #ifdef DEBUG
 483       write (iout,*) "after MPIREDUCE",g_ilist_pp
 484       do i=1,g_ilist_pp
 485       write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
 486       enddo
 487 #endif
 488       return
 489       end