1 subroutine make_SCSC_inter_list
8 include "COMMON.CONTROL"
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,
20 integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr
21 logical lprn /.false./
22 ! print *,"START make_SC"
24 write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
25 write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e
31 if (itypi.eq.ntyp1) cycle
36 if (xi.lt.0) xi=xi+boxxsize
38 if (yi.lt.0) yi=yi+boxysize
40 if (zi.lt.0) zi=zi+boxzsize
42 do j=istart(i,iint),iend(i,iint)
44 if (itypj.eq.ntyp1) cycle
49 if (xj.lt.0) xj=xj+boxxsize
51 if (yj.lt.0) yj=yj+boxysize
53 if (zj.lt.0) zj=zj+boxzsize
54 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
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
76 if (subchap.eq.1) then
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
89 ! this can be substituted by cantor and anti-cantor
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)
103 write (iout,*) "before MPIREDUCE",ilist_sc
105 c write (iout,*) i,contlisti(i),contlistj(i)
108 if (nfgtasks.gt.1)then
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"
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)
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
133 displ(i)=i_ilist_sc(i-1)+displ(i-1)
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,
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,
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,
149 c write (iout,*) "SCSC bcast reduce ierr",ierr
150 call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,
152 c write (iout,*) "SCSC after bcast ierr",ierr
153 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
160 newcontlisti(i)=contlisti(i)
161 newcontlistj(i)=contlistj(i)
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
170 write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc
172 write (iout,*) i,newcontlisti(i),newcontlistj(i)
175 call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end)
177 write (iout,*) "g_listscsc_start",g_listscsc_start,
178 & "g_listscsc_end",g_listscsc_end
182 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
183 subroutine make_SCSC_inter_list_RESPA
188 include "COMMON.SETUP"
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"
212 write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
213 write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e
221 if (itypi.eq.ntyp1) cycle
225 call to_box(xi,yi,zi)
227 do j=istart(i,iint),iend(i,iint)
229 if (itypj.eq.ntyp1) cycle
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
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
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)
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)
268 if (nfgtasks.gt.1)then
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"
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)
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
296 displ(i)=i_ilist_sc_long(i-1)+displ(i-1)
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,
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,
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,
312 c write (iout,*) "SCSC bcast reduce ierr",ierr
313 call MPI_Bcast(newcontlistj_long,g_ilist_sc_long,MPI_INT,king,
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
323 displ(i)=i_ilist_sc_short(i-1)+displ(i-1)
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,
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,
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,
339 c write (iout,*) "SCSC bcast reduce ierr",ierr
340 call MPI_Bcast(newcontlistj_short,g_ilist_sc_short,MPI_INT,king,
342 c write (iout,*) "SCSC after bcast ierr",ierr
345 g_ilist_sc_long=ilist_sc_long
348 newcontlisti_long(i)=contlisti_long(i)
349 newcontlistj_long(i)=contlistj_long(i)
352 g_ilist_sc_short=ilist_sc_short
354 do i=1,ilist_sc_short
355 newcontlisti_short(i)=contlisti_short(i)
356 newcontlistj_short(i)=contlistj_short(i)
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
368 & "make_SCSC_inter_list: g_ilist_sc_long after GATHERV",
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)
375 & "make_SCSC_inter_list: g_ilist_sc_short after GATHERV",
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)
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)
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
394 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
395 subroutine make_SCp_inter_list
400 include "COMMON.SETUP"
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"
421 write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
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))
432 if (xi.lt.0) xi=xi+boxxsize
434 if (yi.lt.0) yi=yi+boxysize
436 if (zi.lt.0) zi=zi+boxzsize
440 do j=iscpstart(i,iint),iscpend(i,iint)
442 if (itypj.eq.ntyp1) cycle
443 ! Uncomment following three lines for SC-p interactions
447 ! Uncomment following three lines for Ca-p interactions
455 if (xj.lt.0) xj=xj+boxxsize
457 if (yj.lt.0) yj=yj+boxysize
459 if (zj.lt.0) zj=zj+boxzsize
460 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
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
482 if (subchap.eq.1) then
492 ! r_buff_list is a read value for a buffer
493 if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0))
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
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
515 write (iout,*) "before MPIREDUCE",ilist_scp
517 write (iout,*) i,contlistscpi(i),contlistscpj(i)
520 if (nfgtasks.gt.1)then
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"
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)
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
543 displ(i)=i_ilist_scp(i-1)+displ(i-1)
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,
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,
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,
560 c write (iout,*) "SCp after bcast ierr",ierr
561 call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,
563 c write (iout,*) "SCp bcast reduce ierr",ierr
564 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
567 g_ilist_scp=ilist_scp
570 newcontlistscpi(i)=contlistscpi(i)
571 newcontlistscpj(i)=contlistscpj(i)
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
580 write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp
582 write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i)
585 ! if (ifirstrun.eq.0) ifirstrun=1
586 ! do i=1,ilist_scp_first
588 ! if ((newcontlistscpi(j).eq.contlistscpi_f(i)).and.&
589 ! (newcontlistscpj(j).eq.contlistscpj_f(i))) go to 126
591 ! print *,itime_mat,"ERROR matrix needs updating"
592 ! print *,contlistscpi_f(i),contlistscpj_f(i)
596 call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end)
598 write (iout,*) "g_listscp_start",g_listscp_start,
599 & "g_listscp_end",g_listscp_end
603 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
604 subroutine make_SCp_inter_list_RESPA
609 include "COMMON.SETUP"
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"
634 write (iout,*) "make_SCp_inter_list maxint_res",maxint_res
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)
648 do j=iscpstart(i,iint),iscpend(i,iint)
650 if (itypj.eq.ntyp1) cycle
651 ! Uncomment following three lines for SC-p interactions
655 ! Uncomment following three lines for Ca-p interactions
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
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
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
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)
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)
699 if (nfgtasks.gt.1)then
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"
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)
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
730 displ(i)=i_ilist_scp_long(i-1)+displ(i-1)
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,
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,
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,
747 c write (iout,*) "SCp after bcast ierr",ierr
748 call MPI_Bcast(newcontlistscpj_long,g_ilist_scp_long,MPI_INT,
750 c write (iout,*) "SCp bcast reduce ierr",ierr
751 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
754 displ(i)=i_ilist_scp_short(i-1)+displ(i-1)
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,
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,
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,
768 c write (iout,*) "SCp after bcast ierr",ierr
769 call MPI_Bcast(newcontlistscpj_short,g_ilist_scp_short,MPI_INT,
773 g_ilist_scp_long=ilist_scp_long
775 do i=1,ilist_scp_long
776 newcontlistscpi_long(i)=contlistscpi_long(i)
777 newcontlistscpj_long(i)=contlistscpj_long(i)
779 g_ilist_scp_short=ilist_scp_short
781 do i=1,ilist_scp_short
782 newcontlistscpi_short(i)=contlistscpi_short(i)
783 newcontlistscpj_short(i)=contlistscpj_short(i)
788 if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
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
798 write (iout,*) "make_SCp_inter_list: after GATHERV long-range",
800 do i=1,g_ilist_scp_long
801 write (iout,*) i,newcontlistscpi_long(i),newcontlistscpj_long(i)
803 write (iout,*) "make_SCp_inter_list: after GATHERV short-range",
805 do i=1,g_ilist_scp_short
806 write (iout,*) i,newcontlistscpi_short(i),
807 & newcontlistscpj_short(i)
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)
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
823 !-----------------------------------------------------------------------------
824 subroutine make_pp_vdw_inter_list_RESPA
829 include "COMMON.SETUP"
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,
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
852 write (iout,*) "make_pp_vdw_inter_list"
857 do i=iatel_s_vdw,iatel_e_vdw
858 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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
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
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)
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
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)
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)
910 if (nfgtasks.gt.1)then
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)
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"
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)
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)
932 displ(i)=i_ilist_pp_vdw_short(i-1)+displ(i-1)
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)
951 g_ilist_pp_vdw_short=ilist_pp_vdw_short
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)
960 if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
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
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)
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)
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
985 !-----------------------------------------------------------------------------
986 subroutine make_pp_inter_list
991 include "COMMON.SETUP"
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,
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"
1013 write (iout,*) "make_pp_inter_list"
1017 do i=iatel_s,iatel_e
1018 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
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
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
1052 if (xj.lt.0) xj=xj+boxxsize
1054 if (yj.lt.0) yj=yj+boxysize
1056 if (zj.lt.0) zj=zj+boxzsize
1058 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
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
1079 if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then
1080 ! Here the list is created
1082 ! this can be substituted by cantor and anti-cantor
1083 contlistppi(ilist_pp)=i
1084 contlistppj(ilist_pp)=j
1091 write (iout,*) "before MPIREDUCE",ilist_pp
1093 write (iout,*) i,contlistppi(i),contlistppj(i)
1096 if (nfgtasks.gt.1)then
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"
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)
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
1119 displ(i)=i_ilist_pp(i-1)+displ(i-1)
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,
1136 c write (iout,*) "After bcast ierr",ierr
1137 call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM,
1139 c write (iout,*) "After bcast ierr",ierr
1141 ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
1148 newcontlistppi(i)=contlistppi(i)
1149 newcontlistppj(i)=contlistppj(i)
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
1158 write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp
1160 write (iout,*) i,newcontlistppi(i),newcontlistppj(i)
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)
1166 write (iout,*) "g_listpp_start",g_listpp_start,
1167 & "g_listpp_end",g_listpp_end