1 subroutine make_SCSC_inter_list
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,
19 integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
20 ! print *,"START make_SC"
22 write (iout,*) "make_SCSC_inter_list"
28 if (itypi.eq.ntyp1) cycle
33 if (xi.lt.0) xi=xi+boxxsize
35 if (yi.lt.0) yi=yi+boxysize
37 if (zi.lt.0) zi=zi+boxzsize
39 do j=istart(i,iint),iend(i,iint)
41 if (itypj.eq.ntyp1) cycle
46 if (xj.lt.0) xj=xj+boxxsize
48 if (yj.lt.0) yj=yj+boxysize
50 if (zj.lt.0) zj=zj+boxzsize
51 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
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
73 if (subchap.eq.1) then
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
86 ! this can be substituted by cantor and anti-cantor
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)
100 write (iout,*) "before MPIREDUCE",ilist_sc
102 write (iout,*) i,contlisti(i),contlistj(i)
105 if (nfgtasks.gt.1)then
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)
114 displ(i)=i_ilist_sc(i-1)+displ(i-1)
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,
120 call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,
121 & newcontlistj,i_ilist_sc,displ,MPI_INTEGER,
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,
128 call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
130 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
137 newcontlisti(i)=contlisti(i)
138 newcontlistj(i)=contlistj(i)
144 write (iout,*) "after GATHERV",g_ilist_sc
146 write (iout,*) i,newcontlisti(i),newcontlistj(i)
149 call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
153 subroutine make_SCp_inter_list
158 include "COMMON.SETUP"
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"
176 write (iout,*) "make_SCp_inter_list"
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))
187 if (xi.lt.0) xi=xi+boxxsize
189 if (yi.lt.0) yi=yi+boxysize
191 if (zi.lt.0) zi=zi+boxzsize
195 do j=iscpstart(i,iint),iscpend(i,iint)
197 if (itypj.eq.ntyp1) cycle
198 ! Uncomment following three lines for SC-p interactions
202 ! Uncomment following three lines for Ca-p interactions
210 if (xj.lt.0) xj=xj+boxxsize
212 if (yj.lt.0) yj=yj+boxysize
214 if (zj.lt.0) zj=zj+boxzsize
215 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
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
237 if (subchap.eq.1) then
247 ! r_buff_list is a read value for a buffer
248 if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
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
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
270 write (iout,*) "before MPIREDUCE",ilist_scp
272 write (iout,*) i,contlistscpi(i),contlistscpj(i)
275 if (nfgtasks.gt.1)then
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)
284 displ(i)=i_ilist_scp(i-1)+displ(i-1)
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,
290 call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,
291 & newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,
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,
298 call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
300 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
303 g_ilist_scp=ilist_scp
306 newcontlistscpi(i)=contlistscpi(i)
307 newcontlistscpj(i)=contlistscpj(i)
313 write (iout,*) "after MPIREDUCE",g_ilist_scp
315 write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
318 ! if (ifirstrun.eq.0) ifirstrun=1
319 ! do i=1,ilist_scp_first
321 ! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
322 ! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
324 ! print *,itime_mat,"ERROR matrix needs updating"
325 ! print *,contlistscpi_f(i),contlistscpj_f(i)
329 call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
333 !-----------------------------------------------------------------------------
334 subroutine make_pp_vdw_inter_list
339 include "COMMON.SETUP"
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,
350 double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
351 & dx_normj,dy_normj,dz_normj
352 integer contlistpp_vdwi(200*maxres),contlistpp_vdwj(200*maxres)
353 ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
354 integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
355 & ilist_pp_vdw,g_ilist_pp_vdw
356 integer displ(0:max_fg_procs),i_ilist_pp_vdw(0:max_fg_procs),ierr
357 ! print *,"START make_SC"
359 write (iout,*) "make_pp_vdw_inter_list"
363 do i=iatel_s_vdw,iatel_e_vdw
364 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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_vdw(i),ielend_vdw(i)
381 ! write (iout,*) i,j,itype(i),itype(j)
382 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
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
398 if (xj.lt.0) xj=xj+boxxsize
400 if (yj.lt.0) yj=yj+boxysize
402 if (zj.lt.0) zj=zj+boxzsize
404 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
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
425 if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
426 ! Here the list is created
427 ilist_pp_vdw=ilist_pp_vdw+1
428 ! this can be substituted by cantor and anti-cantor
429 contlistpp_vdwi(ilist_pp_vdw)=i
430 contlistpp_vdwj(ilist_pp_vdw)=j
437 write (iout,*) "before MPIREDUCE",ilist_pp_vdw
439 write (iout,*) i,contlistpp_vdwi(i),contlistpp_vdwj(i)
442 if (nfgtasks.gt.1)then
444 call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1,
445 & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
446 ! write(iout,*) "before bcast",g_ilist_sc
447 call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER,
448 & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR)
451 displ(i)=i_ilist_pp_vdw(i-1)+displ(i-1)
453 ! write(iout,*) "before gather",displ(0),displ(1)
454 call MPI_Gatherv(contlistpp_vdwi,ilist_pp_vdw,MPI_INTEGER,
455 & newcontlistpp_vdwi,i_ilist_pp_vdw,displ,MPI_INTEGER,
457 call MPI_Gatherv(contlistpp_vdwj,ilist_pp_vdw,MPI_INTEGER,
458 & newcontlistpp_vdwj,i_ilist_pp_vdw,displ,MPI_INTEGER,
460 call MPI_Bcast(g_ilist_pp_vdw,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(newcontlistpp_vdwi,g_ilist_pp_vdw,MPI_INT,king,
465 call MPI_Bcast(newcontlistpp_vdwj,g_ilist_pp_vdw,MPI_INT,king,
468 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
472 g_ilist_pp_vdw=ilist_pp_vdw
475 newcontlistpp_vdwi(i)=contlistpp_vdwi(i)
476 newcontlistpp_vdwj(i)=contlistpp_vdwj(i)
481 call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start,
484 write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start,
485 & "g_listpp_vdw_end",g_listpp_vdw_end
486 write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw
487 do i=1,g_ilist_pp_vdw
488 write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i)
493 !-----------------------------------------------------------------------------
494 subroutine make_pp_inter_list
499 include "COMMON.SETUP"
501 include "COMMON.CHAIN"
502 include "COMMON.INTERACT"
503 include "COMMON.SPLITELE"
504 include "COMMON.IOUNITS"
505 double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
506 & xj_temp,yj_temp,zj_temp
507 double precision xmedj,ymedj,zmedj
508 double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,
510 double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,
511 & dx_normj,dy_normj,dz_normj
512 integer contlistppi(200*maxres),contlistppj(200*maxres)
513 ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres)
514 integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
515 & ilist_pp,g_ilist_pp
516 integer displ(0:max_fg_procs),i_ilist_pp(0:max_fg_procs),ierr
517 ! print *,"START make_SC"
519 write (iout,*) "make_pp_inter_list"
524 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
528 dx_normi=dc_norm(1,i)
529 dy_normi=dc_norm(2,i)
530 dz_normi=dc_norm(3,i)
531 xmedi=c(1,i)+0.5d0*dxi
532 ymedi=c(2,i)+0.5d0*dyi
533 zmedi=c(3,i)+0.5d0*dzi
534 xmedi=dmod(xmedi,boxxsize)
535 if (xmedi.lt.0) xmedi=xmedi+boxxsize
536 ymedi=dmod(ymedi,boxysize)
537 if (ymedi.lt.0) ymedi=ymedi+boxysize
538 zmedi=dmod(zmedi,boxzsize)
539 if (zmedi.lt.0) zmedi=zmedi+boxzsize
540 do j=ielstart(i),ielend(i)
541 ! write (iout,*) i,j,itype(i),itype(j)
542 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
548 dx_normj=dc_norm(1,j)
549 dy_normj=dc_norm(2,j)
550 dz_normj=dc_norm(3,j)
551 ! xj=c(1,j)+0.5D0*dxj-xmedi
552 ! yj=c(2,j)+0.5D0*dyj-ymedi
553 ! zj=c(3,j)+0.5D0*dzj-zmedi
558 if (xj.lt.0) xj=xj+boxxsize
560 if (yj.lt.0) yj=yj+boxysize
562 if (zj.lt.0) zj=zj+boxzsize
564 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
571 xj=xj_safe+xshift*boxxsize
572 yj=yj_safe+yshift*boxysize
573 zj=zj_safe+zshift*boxzsize
574 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
575 if(dist_temp.lt.dist_init) then
585 if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then
586 ! Here the list is created
588 ! this can be substituted by cantor and anti-cantor
589 contlistppi(ilist_pp)=i
590 contlistppj(ilist_pp)=j
597 write (iout,*) "before MPIREDUCE",ilist_pp
599 write (iout,*) i,contlistppi(i),contlistppj(i)
602 if (nfgtasks.gt.1)then
604 call MPI_Reduce(ilist_pp,g_ilist_pp,1,
605 & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
606 ! write(iout,*) "before bcast",g_ilist_sc
607 call MPI_Gather(ilist_pp,1,MPI_INTEGER,
608 & i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR)
611 displ(i)=i_ilist_pp(i-1)+displ(i-1)
613 ! write(iout,*) "before gather",displ(0),displ(1)
614 call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER,
615 & newcontlistppi,i_ilist_pp,displ,MPI_INTEGER,
617 call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER,
618 & newcontlistppj,i_ilist_pp,displ,MPI_INTEGER,
620 call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR)
621 ! write(iout,*) "before bcast",g_ilist_sc
622 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
623 call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM,
625 call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
628 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
635 newcontlistppi(i)=contlistppi(i)
636 newcontlistppj(i)=contlistppj(i)
641 call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end)
643 write (iout,*) "after MPIREDUCE",g_ilist_pp
645 write (iout,*) i,newcontlistppi(i),newcontlistppj(i)