+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ subroutine make_SCSC_inter_list_RESPA
+ implicit none
+ include "DIMENSIONS"
+#ifdef MPI
+ include 'mpif.h'
+ include "COMMON.SETUP"
+#endif
+ include "COMMON.CONTROL"
+ include "COMMON.CHAIN"
+ include "COMMON.INTERACT"
+ include "COMMON.SPLITELE"
+ include "COMMON.IOUNITS"
+ double precision xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,
+ & xj_temp,yj_temp,zj_temp
+ double precision dist_init, dist_temp,r_buff_list
+ integer contlisti_long(maxint_res*maxres),
+ & contlisti_short(maxint_res*maxres),
+ & contlistj_long(maxint_res*maxres),
+ & contlistj_short(maxint_res*maxres)
+! integer :: newcontlisti(200*nres),newcontlistj(200*nres)
+ integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,
+ & ilist_sc_long,g_ilist_sc_long,ilist_sc_short,g_ilist_sc_short
+ integer displ(0:max_fg_procs),i_ilist_sc_long(0:max_fg_procs),
+ & i_ilist_sc_short(0:max_fg_procs),ierr
+ logical lprn /.false./
+ double precision boxshift
+ double precision d_scale,r_respa_buf
+! print *,"START make_SC"
+#ifdef DEBUG
+ write (iout,*) "make_SCSC_inter_list maxint_res",maxint_res
+ write (iout,*) "iatsc_s",iatsc_s," iatsc_e",iatsc_e
+#endif
+ r_buff_list=5.0d0
+ r_respa_buf=rlamb
+ ilist_sc_long=0
+ ilist_sc_short=0
+ do i=iatsc_s,iatsc_e
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ xi=c(1,nres+i)
+ yi=c(2,nres+i)
+ zi=c(3,nres+i)
+ call to_box(xi,yi,zi)
+ do iint=1,nint_gr(i)
+ do j=istart(i,iint),iend(i,iint)
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
+ xj=c(1,nres+j)
+ yj=c(2,nres+j)
+ zj=c(3,nres+j)
+ call to_box(xj,yj,zj)
+ xj=boxshift(xj-xi,boxxsize)
+ yj=boxshift(yj-yi,boxysize)
+ zj=boxshift(zj-zi,boxzsize)
+ dist_init=dsqrt(xj*xj+yj*yj+zj*zj)
+! r_buff_list is a read value for a buffer
+ if (dist_init.le.(r_cut_int+r_buff_list)) then
+! Here the list is created
+ d_scale=dist_init/sigmaii(itypi,itypj)
+ if (d_scale.le.r_cut_respa+r_respa_buf) then
+ ilist_sc_short=ilist_sc_short+1
+ contlisti_short(ilist_sc_short)=i
+ contlistj_short(ilist_sc_short)=j
+ endif
+ if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then
+ ilist_sc_long=ilist_sc_long+1
+! this can be substituted by cantor and anti-cantor
+ contlisti_long(ilist_sc_long)=i
+ contlistj_long(ilist_sc_long)=j
+ endif
+ endif
+ enddo
+ enddo
+ enddo
+#ifdef MPI
+#ifdef DEBUG
+ write (iout,*) "before MPIREDUCE ilist_sc_long",ilist_sc_long
+c do i=1,ilist_sc_long
+c write (iout,*) i,contlisti_long(i),contlistj_long(i)
+c enddo
+ write (iout,*) "before MPIREDUCE ilist_sc_short",ilist_sc_short
+c do i=1,ilist_sc_short
+c write (iout,*) i,contlisti_short(i),contlistj_short(i)
+c enddo
+#endif
+ if (nfgtasks.gt.1)then
+
+ call MPI_Reduce(ilist_sc_long,g_ilist_sc_long,1,
+ & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+ call MPI_Reduce(ilist_sc_short,g_ilist_sc_short,1,
+ & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+c write (iout,*) "SCSC after reduce ierr",ierr
+ if (fg_rank.eq.0.and.(g_ilist_sc_long.gt.maxres*maxint_res .or.
+ & g_ilist_sc_short.gt.maxres*maxint_res)) then
+ if ((me.eq.king.or.out1file).and.energy_dec) then
+ write (iout,*) "Too many SCSC interactions",
+ & g_ilist_sc_long,g_ilist_sc_short,
+ & " only",maxres*maxint_res," allowed."
+ write (iout,*) "Specify a smaller r_cut_int and resubmit"
+ call flush(iout)
+ endif
+ write (*,*) "Processor:",me,": Too many SCSC interactions",
+ & g_ilist_sc_long+g_ilist_sc_short," only",
+ & maxres*maxint_res," allowed."
+ write (*,*) "Specify a smaller r_cut_int and resubmit"
+ call MPI_Abort(MPI_COMM_WORLD,ierr)
+ endif
+c write(iout,*) "before bcast",g_ilist_sc_long
+ call MPI_Gather(ilist_sc_long,1,MPI_INTEGER,
+ & i_ilist_sc_long,1,MPI_INTEGER,king,FG_COMM,IERR)
+c write (iout,*) "SCSC after gather ierr",ierr
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_sc_long(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlisti_long,ilist_sc_long,MPI_INTEGER,
+ & newcontlisti_long,i_ilist_sc_long,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+c write (iout,*) "SCSC after gatherv ierr",ierr
+ call MPI_Gatherv(contlistj_long,ilist_sc_long,MPI_INTEGER,
+ & newcontlistj_long,i_ilist_sc_long,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_sc_long,1,MPI_INT,king,FG_COMM,IERR)
+c write (iout,*) "SCSC bcast reduce ierr",ierr
+! write(iout,*) "before bcast",g_ilist_sc_long
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlisti_long,g_ilist_sc_long,MPI_INT,king,
+ & FG_COMM,IERR)
+c write (iout,*) "SCSC bcast reduce ierr",ierr
+ call MPI_Bcast(newcontlistj_long,g_ilist_sc_long,MPI_INT,king,
+ & FG_COMM,IERR)
+c write (iout,*) "SCSC after bcast ierr",ierr
+! write(iout,*) "before gather",displ(0),displ(1)
+c write(iout,*) "before bcast",g_ilist_sc_short
+ call MPI_Gather(ilist_sc_short,1,MPI_INTEGER,
+ & i_ilist_sc_short,1,MPI_INTEGER,king,FG_COMM,IERR)
+c write (iout,*) "SCSC after gather ierr",ierr
+ displ(0)=0
+ do i=1,nfgtasks-1,1
+ displ(i)=i_ilist_sc_short(i-1)+displ(i-1)
+ enddo
+! write(iout,*) "before gather",displ(0),displ(1)
+ call MPI_Gatherv(contlisti_short,ilist_sc_short,MPI_INTEGER,
+ & newcontlisti_short,i_ilist_sc_short,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+c write (iout,*) "SCSC after gatherv ierr",ierr
+ call MPI_Gatherv(contlistj_short,ilist_sc_short,MPI_INTEGER,
+ & newcontlistj_short,i_ilist_sc_short,displ,MPI_INTEGER,
+ & king,FG_COMM,IERR)
+ call MPI_Bcast(g_ilist_sc_short,1,MPI_INT,king,FG_COMM,IERR)
+c write (iout,*) "SCSC bcast reduce ierr",ierr
+! write(iout,*) "before bcast",g_ilist_sc_short
+! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM)
+ call MPI_Bcast(newcontlisti_short,g_ilist_sc_short,MPI_INT,king,
+ & FG_COMM,IERR)
+c write (iout,*) "SCSC bcast reduce ierr",ierr
+ call MPI_Bcast(newcontlistj_short,g_ilist_sc_short,MPI_INT,king,
+ ^ FG_COMM,IERR)
+c write (iout,*) "SCSC after bcast ierr",ierr
+ else
+#endif
+ g_ilist_sc_long=ilist_sc_long
+
+ do i=1,ilist_sc_long
+ newcontlisti_long(i)=contlisti_long(i)
+ newcontlistj_long(i)=contlistj_long(i)
+ enddo
+
+ g_ilist_sc_short=ilist_sc_short
+
+ do i=1,ilist_sc_short
+ newcontlisti_short(i)=contlisti_short(i)
+ newcontlistj_short(i)=contlistj_short(i)
+ enddo
+#ifdef MPI
+ endif
+#endif
+ if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec)
+ & write (iout,'(a30,2i10,a,2i4)')
+ & "Number of long- and short-range SC-SC interactions",
+ & g_ilist_sc_long,g_ilist_sc_short," per residue on average",
+ & g_ilist_sc_long/nres,g_ilist_sc_short/nres
+#ifdef DEBUG
+ write (iout,*)
+ & "make_SCSC_inter_list: g_ilist_sc_long after GATHERV",
+ & g_ilist_sc_long
+ write (iout,*) "List of long-range SCSC interactions"
+ do i=1,g_ilist_sc_long
+ write (iout,*) i,newcontlisti_long(i),newcontlistj_long(i)
+ enddo
+ write (iout,*)
+ & "make_SCSC_inter_list: g_ilist_sc_short after GATHERV",
+ & g_ilist_sc_short
+ write (iout,*) "List of short-range SCSC interactions"
+ do i=1,g_ilist_sc_short
+ write (iout,*) i,newcontlisti_short(i),newcontlistj_short(i)
+ enddo
+#endif
+ call int_bounds(g_ilist_sc_long,g_listscsc_start_long,
+ & g_listscsc_end_long)
+ call int_bounds(g_ilist_sc_short,g_listscsc_start_short,
+ & g_listscsc_end_short)
+#ifdef DEBUG
+ write (iout,*) "g_list_sc_start",g_listscsc_start_long,
+ & "g_list_sc_end",g_listscsc_end_long
+ write (iout,*)"g_list_sc_start_short",g_listscsc_start_short,
+ & "g_list_sc_end_short",g_listscsc_end_short
+#endif
+ return
+ end
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!