X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fmake_xx_list.F;h=a1f6b45d9ceac850881fedb8289bb735e255c725;hb=58980cd5a21077fd523753ffccc036765ef70d82;hp=fb6c0555e520d30972659ead1ff8840ed04957b3;hpb=b8a8a950fcfe48a76002af386e3f4de3b510760c;p=unres.git diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index fb6c055..a1f6b45 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -5,6 +5,7 @@ include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -12,14 +13,16 @@ 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(200*maxres),contlistj(200*maxres) + integer contlisti(maxint_res*maxres),contlistj(maxint_res*maxres) ! integer :: newcontlisti(200*nres),newcontlistj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_sc,g_ilist_sc integer displ(0:max_fg_procs),i_ilist_sc(0:max_fg_procs),ierr + logical lprn /.false./ ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCSC_inter_list" + 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 ilist_sc=0 @@ -80,7 +83,7 @@ zj=zj_safe-zi endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_sc=ilist_sc+1 ! this can be substituted by cantor and anti-cantor @@ -98,17 +101,33 @@ #ifdef MPI #ifdef DEBUG write (iout,*) "before MPIREDUCE",ilist_sc - do i=1,ilist_sc - write (iout,*) i,contlisti(i),contlistj(i) - enddo +c do i=1,ilist_sc +c write (iout,*) i,contlisti(i),contlistj(i) +c enddo #endif if (nfgtasks.gt.1)then call MPI_Reduce(ilist_sc,g_ilist_sc,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.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCSC interactions", + & g_ilist_sc," only",maxres*maxint_res," allowed." + write (iout,*) "Reduce r_cut_int and resubmit" + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif c write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_sc,1,MPI_INTEGER, & i_ilist_sc,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(i-1)+displ(i-1) @@ -117,16 +136,20 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER, & newcontlisti,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCSC after gatherv ierr",ierr call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER, & newcontlistj,i_ilist_sc,displ,MPI_INTEGER, & king,FG_COMM,IERR) call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC bcast reduce ierr",ierr call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCSC after bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else @@ -140,16 +163,235 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-SC interactions", + & g_ilist_sc," per residue on average",g_ilist_sc/nres #ifdef DEBUG - write (iout,*) "after GATHERV",g_ilist_sc + write (iout,*) "make_SCSC_inter_list: after GATHERV",g_ilist_sc do i=1,g_ilist_sc write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo #endif - call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) + call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) +#ifdef DEBUG + write (iout,*) "g_listscsc_start",g_listscsc_start, + & "g_listscsc_end",g_listscsc_end + return +#endif + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + 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 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine make_SCp_inter_list implicit none include "DIMENSIONS" @@ -157,6 +399,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -164,20 +407,22 @@ c write(iout,*) "before bcast",g_ilist_sc 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 contlistscpi(200*maxres),contlistscpj(200*maxres) + integer contlistscpi(2*maxint_res*maxres), + & contlistscpj(2*maxint_res*maxres) ! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_scp,g_ilist_scp integer displ(0:max_fg_procs),i_ilist_scp(0:max_fg_procs),ierr - integer contlistscpi_f(200*maxres),contlistscpj_f(200*maxres) +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) integer ilist_scp_first,ifirstrun,g_ilist_sc ! print *,"START make_SC" #ifdef DEBUG - write (iout,*) "make_SCp_inter_list" + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res #endif r_buff_list=5.0 - ilist_scp=0 - ilist_scp_first=0 + ilist_scp=0 + ilist_scp_first=0 do i=iatscp_s,iatscp_e if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -245,7 +490,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #ifdef DEBUG ! r_buff_list is a read value for a buffer - if ((sqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) + if((dsqrt(dist_init).le.(r_cut_int)).and.(ifirstrun.eq.0)) & then ! Here the list is created ilist_scp_first=ilist_scp_first+1 @@ -255,7 +500,7 @@ c write(iout,*) "before bcast",g_ilist_sc endif #endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_scp=ilist_scp+1 ! this can be substituted by cantor and anti-cantor @@ -276,9 +521,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_scp,g_ilist_scp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_scp.gt.2*maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp," only",2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp," only",2*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 call MPI_Gather(ilist_scp,1,MPI_INTEGER, & i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_scp(i-1)+displ(i-1) @@ -287,16 +546,21 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER, & newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER, & newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp after bcast ierr",ierr call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) else #endif @@ -309,8 +573,11 @@ c write(iout,*) "before bcast",g_ilist_sc #ifdef MPI endif #endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of SC-p interactions", + & g_ilist_scp," per residue on average",g_ilist_scp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_scp + write (iout,*) "make_SCp_inter_list: after GATHERV",g_ilist_scp do i=1,g_ilist_scp write (iout,*) i,newcontlistscpi(i),newcontlistscpj(i) enddo @@ -327,10 +594,395 @@ c write(iout,*) "before bcast",g_ilist_sc ! enddo #endif call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end) +#ifdef DEBUG + write (iout,*) "g_listscp_start",g_listscp_start, + & "g_listscp_end",g_listscp_end +#endif + return + end +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine make_SCp_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 contlistscpi_long(2*maxint_res*maxres), + & contlistscpi_short(2*maxint_res*maxres), + & contlistscpj_long(2*maxint_res*maxres), + & contlistscpj_short(2*maxint_res*maxres) +! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) + integer i,j,iteli,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_scp_long,ilist_scp_short,g_ilist_scp_long,g_ilist_scp_short + integer displ(0:max_fg_procs),i_ilist_scp_long(0:max_fg_procs), + & i_ilist_scp_short(0:max_fg_procs),ierr +c integer contlistscpi_f(2*maxint_res*maxres), +c & contlistscpj_f(2*maxint_res*maxres) + double precision boxshift + double precision d_scale,r_respa_buf +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list maxint_res",maxint_res +#endif + r_buff_list=5.0 + r_respa_buf=rlamb + ilist_scp_long=0 + ilist_scp_short=0 + do i=iatscp_s,iatscp_e + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + xi=0.5D0*(c(1,i)+c(1,i+1)) + yi=0.5D0*(c(2,i)+c(2,i+1)) + zi=0.5D0*(c(3,i)+c(3,i+1)) + call to_box(xi,yi,zi) + iteli=itel(i) + do iint=1,nscp_gr(i) + do j=iscpstart(i,iint),iscpend(i,iint) + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle +! Uncomment following three lines for SC-p interactions +! xj=c(1,nres+j)-xi +! yj=c(2,nres+j)-yi +! zj=c(3,nres+j)-zi +! Uncomment following three lines for Ca-p interactions +! xj=c(1,j)-xi +! yj=c(2,j)-yi +! zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,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 + + d_scale=dist_init/rscp(itypj,iteli) + if (d_scale.le.r_cut_respa+r_respa_buf) then +! Here the list is created + ilist_scp_short=ilist_scp_short+1 + contlistscpi_short(ilist_scp_short)=i + contlistscpj_short(ilist_scp_short)=j + endif + if (d_scale.gt.r_cut_respa-rlamb-r_respa_buf) then +! this can be substituted by cantor and anti-cantor + ilist_scp_long=ilist_scp_long+1 + contlistscpi_long(ilist_scp_long)=i + contlistscpj_long(ilist_scp_long)=j + endif + endif + enddo + enddo + enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_scp_long,ilist_scp_short + write (iout,*) "Long-range scp interaction list" + do i=1,ilist_scp_long + write (iout,*) i,contlistscpi_long(i),contlistscpj_long(i) + enddo + write (iout,*) "Short-range scp interaction list" + do i=1,ilist_scp_short + write (iout,*) i,contlistscpi_short(i),contlistscpj_short(i) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_scp_long,g_ilist_scp_long,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_scp_short,g_ilist_scp_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "SCp after reduce ierr",ierr + if (fg_rank.eq.0.and.(g_ilist_scp_long.gt. + & 2*maxres*maxint_res .or. g_ilist_scp_short.gt. + & 2*maxres*maxint_res)) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many SCp interactions", + & g_ilist_scp_long+g_ilist_scp_short," only", + & 2*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 + call MPI_Gather(ilist_scp_long,1,MPI_INTEGER, + & i_ilist_scp_long,1,MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gather(ilist_scp_short,1,MPI_INTEGER, + & i_ilist_scp_short,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "SCp after gather ierr",ierr + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_long(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpi_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_long,ilist_scp_long,MPI_INTEGER, + & newcontlistscpj_long,i_ilist_scp_long,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_long,1,MPI_INT,king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistscpi_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_long,g_ilist_scp_long,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp bcast reduce ierr",ierr +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistscpi_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpi_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Gatherv(contlistscpj_short,ilist_scp_short,MPI_INTEGER, + & newcontlistscpj_short,i_ilist_scp_short,displ,MPI_INTEGER, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after gatherv ierr",ierr + call MPI_Bcast(g_ilist_scp_short,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistscpi_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) +c write (iout,*) "SCp after bcast ierr",ierr + call MPI_Bcast(newcontlistscpj_short,g_ilist_scp_short,MPI_INT, + & king,FG_COMM,IERR) + else +#endif + g_ilist_scp_long=ilist_scp_long + + do i=1,ilist_scp_long + newcontlistscpi_long(i)=contlistscpi_long(i) + newcontlistscpj_long(i)=contlistscpj_long(i) + enddo + g_ilist_scp_short=ilist_scp_short + do i=1,ilist_scp_short + newcontlistscpi_short(i)=contlistscpi_short(i) + newcontlistscpj_short(i)=contlistscpj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,'(a30,i10,a,i4)') + & "Number of long-range SC-p interactions", + & g_ilist_scp_long," per residue on average",g_ilist_scp_long/nres + write (iout,'(a30,i10,a,i4)') + & "Number of short-range SC-p interactions", + &g_ilist_scp_short," per residue on average",g_ilist_scp_short/nres + endif +#ifdef DEBUG + write (iout,*) "make_SCp_inter_list: after GATHERV long-range", + & g_ilist_scp_long + do i=1,g_ilist_scp_long + write (iout,*) i,newcontlistscpi_long(i),newcontlistscpj_long(i) + enddo + write (iout,*) "make_SCp_inter_list: after GATHERV short-range", + & g_ilist_scp_short + do i=1,g_ilist_scp_short + write (iout,*) i,newcontlistscpi_short(i), + & newcontlistscpj_short(i) + enddo +#endif + call int_bounds(g_ilist_scp_long,g_listscp_start_long, + & g_listscp_end_long) + call int_bounds(g_ilist_scp_short,g_listscp_start_short, + & g_listscp_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listscp_start",g_listscp_start_long, + & "g_listscp_end",g_listscp_end_long + write (iout,*)"g_listscp_start_short",g_listscp_start_short, + & "g_listscp_end_short",g_listscp_end_short + endif return end !----------------------------------------------------------------------------- + subroutine make_pp_vdw_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 xmedj,ymedj,zmedj + double precision dist_init, dist_temp,r_buff_list,dxi,dyi,dzi, + & xmedi,ymedi,zmedi + double precision dxj,dyj,dzj + integer contlistpp_vdwi_short(maxint_res*maxres), + & contlistpp_vdwj_short(maxint_res*maxres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_pp_vdw_short,g_ilist_pp_vdw_short + integer displ(0:max_fg_procs), + & i_ilist_pp_vdw_short(0:max_fg_procs),ierr +! print *,"START make_SC" + double precision boxshift + double precision d_scale,r_respa_buf +#ifdef DEBUG + write (iout,*) "make_pp_vdw_inter_list" +#endif + ilist_pp_vdw_short=0 + r_buff_list=5.0 + r_respa_buf=rlamb + do i=iatel_s_vdw,iatel_e_vdw + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + dxi=dc(1,i) + dyi=dc(2,i) + dzi=dc(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi + call to_box(xmedi,ymedi,zmedi) + do j=ielstart_vdw(i),ielend_vdw(i) +! write (iout,*) i,j,itype(i),itype(j) + if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle +! 1,j) + dxj=dc(1,j) + dyj=dc(2,j) + dzj=dc(3,j) +! xj=c(1,j)+0.5D0*dxj-xmedi +! yj=c(2,j)+0.5D0*dyj-ymedi +! zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + call to_box(xj,yj,zj) + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) + dist_init=dsqrt(xj*xj+yj*yj+zj*zj) + + if (dist_init.le.(r_cut_int+r_buff_list)) then + d_scale=dist_init/rpp(itel(i),itel(j)) + if (d_scale.le.r_cut_respa+r_respa_buf) then +! Here the list is created + ilist_pp_vdw_short=ilist_pp_vdw_short+1 +! this can be substituted by cantor and anti-cantor + contlistpp_vdwi_short(ilist_pp_vdw_short)=i + contlistpp_vdwj_short(ilist_pp_vdw_short)=j + endif + endif + enddo + enddo +! enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE longrange",ilist_pp_vdw_long + do i=1,ilist_pp_vdw_long + write (iout,*) i,contlistpp_vdwi_long(i),contlistpp_vdwj_long(i) + enddo + write (iout,*) "before MPIREDUCE shortrange",ilist_pp_vdw_short + do i=1,ilist_pp_vdw_short + write (iout,*) i,contlistpp_vdwi_short(i), + & contlistpp_vdwj_short(i) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_pp_vdw_short,g_ilist_pp_vdw_short,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + if (fg_rank.eq.0.and.g_ilist_pp_vdw_short.gt.maxres*maxint_res) + & then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp VDW interactions", + & g_ilist_pp_vdw_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 pp VDW interactions", + & g_ilist_pp_vdw_short," only",maxres*maxint_res," allowed." + write (8,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_pp_vdw_short,1,MPI_INTEGER, + & i_ilist_pp_vdw_short,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_pp_vdw_short(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistpp_vdwi_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwi_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwj_short,ilist_pp_vdw_short, + & MPI_INTEGER,newcontlistpp_vdwj_short,i_ilist_pp_vdw_short,displ, + & MPI_INTEGER,king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_pp_vdw_short,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistpp_vdwi_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistpp_vdwj_short,g_ilist_pp_vdw_short, + & MPI_INT,king,FG_COMM,IERR) +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + else +#endif + g_ilist_pp_vdw_short=ilist_pp_vdw_short + + do i=1,ilist_pp_vdw_short + newcontlistpp_vdwi_short(i)=contlistpp_vdwi_short(i) + newcontlistpp_vdwj_short(i)=contlistpp_vdwj_short(i) + enddo +#ifdef MPI + endif +#endif + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "Number of short-range p-p VDW interactions", + & g_ilist_pp_vdw_short," per residue on average", + & g_ilist_pp_vdw_short/nres + endif +#ifdef DEBUG + write (iout,*) "Short-range pp_vdw" + write (iout,*) "make_pp_vdw_inter_list: after GATHERV", + & g_ilist_pp_vdw_short + do i=1,g_ilist_pp_vdw_short + write (iout,*) i,newcontlistpp_vdwi_short(i), + & newcontlistpp_vdwj_short(i) + enddo +#endif + call int_bounds(g_ilist_pp_vdw_short,g_listpp_vdw_start_short, + & g_listpp_vdw_end_short) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*)"g_listpp_vdw_start_short", + & g_listpp_vdw_start_short, + & "g_listpp_vdw_end_short",g_listpp_vdw_end_short + endif + return + end +!----------------------------------------------------------------------------- subroutine make_pp_inter_list implicit none include "DIMENSIONS" @@ -338,6 +990,7 @@ c write(iout,*) "before bcast",g_ilist_sc include 'mpif.h' include "COMMON.SETUP" #endif + include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.SPLITELE" @@ -349,7 +1002,8 @@ c write(iout,*) "before bcast",g_ilist_sc & xmedi,ymedi,zmedi double precision dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, & dx_normj,dy_normj,dz_normj - integer contlistppi(200*maxres),contlistppj(200*maxres) + integer contlistppi(maxint_res*maxres), + & contlistppj(maxint_res*maxres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, & ilist_pp,g_ilist_pp @@ -422,7 +1076,7 @@ c write(iout,*) "before bcast",g_ilist_sc enddo enddo - if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then + if (dsqrt(dist_init).le.(r_cut_int+r_buff_list)) then ! Here the list is created ilist_pp=ilist_pp+1 ! this can be substituted by cantor and anti-cantor @@ -443,9 +1097,23 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Reduce(ilist_pp,g_ilist_pp,1, & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +c write (iout,*) "After reduce ierr",ierr + if (fg_rank.eq.0.and.g_ilist_pp.gt.maxres*maxint_res) then + if ((me.eq.king.or.out1file).and.energy_dec) then + write (iout,*) "Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (iout,*) "Specify a smaller r_cut_int and resubmit" + call flush(iout) + endif + write (*,*) "Processor:",me,": Too many pp interactions", + & g_ilist_pp," only",maxres*maxint_res," allowed." + write (*,*) "Specify a smaller r_cut_int and resubmit" + call MPI_Abort(MPI_COMM_WORLD,ierr) + endif ! write(iout,*) "before bcast",g_ilist_sc call MPI_Gather(ilist_pp,1,MPI_INTEGER, & i_ilist_pp,1,MPI_INTEGER,king,FG_COMM,IERR) +c write (iout,*) "After gather ierr",ierr displ(0)=0 do i=1,nfgtasks-1,1 displ(i)=i_ilist_pp(i-1)+displ(i-1) @@ -454,36 +1122,49 @@ c write(iout,*) "before bcast",g_ilist_sc call MPI_Gatherv(contlistppi,ilist_pp,MPI_INTEGER, & newcontlistppi,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Gatherv(contlistppj,ilist_pp,MPI_INTEGER, & newcontlistppj,i_ilist_pp,displ,MPI_INTEGER, & king,FG_COMM,IERR) +c write (iout,*) "After gatherb ierr",ierr call MPI_Bcast(g_ilist_pp,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppi,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr call MPI_Bcast(newcontlistppj,g_ilist_pp,MPI_INT,king,FG_COMM, & IERR) +c write (iout,*) "After bcast ierr",ierr ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - else + else #endif g_ilist_pp=ilist_pp do i=1,ilist_pp - newcontlistppi(i)=contlistppi(i) - newcontlistppj(i)=contlistppj(i) + newcontlistppi(i)=contlistppi(i) + newcontlistppj(i)=contlistppj(i) enddo #ifdef MPI - endif + endif #endif - call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + & write (iout,'(a30,i10,a,i4)') "Number of p-p interactions", + & g_ilist_pp," per residue on average",g_ilist_pp/nres #ifdef DEBUG - write (iout,*) "after MPIREDUCE",g_ilist_pp + write (iout,*) "make_pp_inter_list: after GATHERV",g_ilist_pp do i=1,g_ilist_pp write (iout,*) i,newcontlistppi(i),newcontlistppj(i) enddo #endif + call int_bounds(g_ilist_pp,g_listpp_start,g_listpp_end) + if (fg_rank.eq.0 .and. (me.eq.king.or.out1file) .and. energy_dec) + &then + write (iout,*) "g_listpp_start",g_listpp_start, + & "g_listpp_end",g_listpp_end + endif return end