From: Cezary Czaplewski Date: Fri, 27 Mar 2020 17:37:49 +0000 (+0100) Subject: Adam's 5D respa update X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=commitdiff_plain;h=17ebcc043908bc104476886723628754d0f44c5f;p=unres.git Adam's 5D respa update --- diff --git a/source/unres/src-HCD-5D/COMMON.INTERACT b/source/unres/src-HCD-5D/COMMON.INTERACT index 3440239..6db43d0 100644 --- a/source/unres/src-HCD-5D/COMMON.INTERACT +++ b/source/unres/src-HCD-5D/COMMON.INTERACT @@ -24,12 +24,15 @@ C 3/26/20 Interaction lists integer newcontlisti(200*maxres),newcontlistj(200*maxres), & newcontlistppi(200*maxres),newcontlistppj(200*maxres), + & newcontlistpp_vdwi(200*maxres),newcontlistpp_vdwj(200*maxres), & newcontlistscpi(200*maxres),newcontlistscpj(200*maxres), & g_listscsc_start,g_listscsc_end,g_listpp_start,g_listpp_end, - & g_listscp_start,g_listscp_end + & g_listpp_vdw_start,g_listpp_vdw_end,g_listscp_start,g_listscp_end common /interact_list/newcontlisti,newcontlistj,g_listscsc_start, & g_listscsc_end,newcontlistppi,newcontlistppj,g_listpp_start, - & g_listpp_end,newcontlistscpi,newcontlistscpj,g_listscp_start, + & g_listpp_end,newcontlistpp_vdwi,newcontlistpp_vdwj, + & g_listpp_vdw_start,g_listpp_vdw_end, + & newcontlistscpi,newcontlistscpj,g_listscp_start, & g_listscp_end C 12/1/95 Array EPS included in the COMMON block. double precision eps,epslip,sigma,sigmaii,rs0,chi,chip,alp, diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos index 32a0dec..1efd046 100644 --- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos +++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos @@ -38,7 +38,7 @@ object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ pinorm.o randgens.o rescode.o intcor.o timing.o misc.o \ cart2intgrad.o checkder_p.o contact_cp econstr_local.o econstr_qlike.o \ - econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list \ + econstrq-PMF.o PMFprocess.o energy_p_new_barrier.o make_xx_list.o \ energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o \ diff --git a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F index 93fe9ab..0f37efe 100644 --- a/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new-sep_barrier.F @@ -81,13 +81,16 @@ C c include 'COMMON.CONTACTS' double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,num_conti,iint + integer i,j,k,itypi,itypj,itypi1,num_conti,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sss1,sssgrad1,sqrij double precision sscale,sscagrad c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -97,10 +100,10 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) +c do iint=1,nint_gr(i) cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -138,8 +141,8 @@ C gvdwc(k,j)=gvdwc(k,j)+gg(k) enddo endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i do i=1,nct do j=1,3 @@ -180,13 +183,16 @@ C c include 'COMMON.CONTACTS' double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,num_conti,iint + integer i,j,k,itypi,itypj,itypi1,num_conti,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sqrij,sss1,sssgrad1 double precision sscale,sscagrad c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -198,10 +204,10 @@ C Change 12/1/95 C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) +c do iint=1,nint_gr(i) cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -235,8 +241,8 @@ C gvdwc(k,j)=gvdwc(k,j)+gg(k) enddo endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i do i=1,nct do j=1,3 @@ -274,14 +280,17 @@ C include "COMMON.SPLITELE" double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,iint + integer i,j,k,itypi,itypj,itypi1,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck double precision sscale,sscagrad c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -291,8 +300,8 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -340,8 +349,8 @@ C gvdwc(k,j)=gvdwc(k,j)+gg(k) enddo endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i do i=1,nct do j=1,3 @@ -370,14 +379,17 @@ C include "COMMON.SPLITELE" double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,iint + integer i,j,k,itypi,itypj,itypi1,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck double precision sscale,sscagrad c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -387,8 +399,8 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -430,8 +442,8 @@ C gvdwc(k,j)=gvdwc(k,j)+gg(k) enddo endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i do i=1,nct do j=1,3 @@ -462,7 +474,7 @@ C integer icall common /srutu/ icall double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision sss1,sssgrad1 double precision sscale,sscagrad @@ -477,7 +489,10 @@ c else lprn=.false. c endif ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -492,8 +507,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -559,8 +574,8 @@ C Calculate the angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad_scale((1.0d0-sss)*sss1) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i c stop return @@ -586,7 +601,7 @@ C integer icall common /srutu/ icall double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision sscale,sscagrad c double precision rrsave(maxdim) @@ -600,7 +615,10 @@ c else lprn=.false. c endif ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -615,8 +633,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -678,8 +696,8 @@ C Calculate the angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad_scale(sss) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i c stop return @@ -706,7 +724,7 @@ C logical lprn integer xshift,yshift,zshift double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij, & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe, @@ -720,7 +738,10 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -743,8 +764,8 @@ c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -898,8 +919,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad_scale((1.0d0-sss)*sss1) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i c write (iout,*) "Number of loop steps in EGB:",ind cccc energy_dec=.false. @@ -927,7 +948,7 @@ C logical lprn integer xshift,yshift,zshift double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij, & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe, @@ -941,7 +962,10 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -964,8 +988,8 @@ c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -1115,8 +1139,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad_scale(sss) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i c write (iout,*) "Number of loop steps in EGB:",ind cccc energy_dec=.false. @@ -1143,7 +1167,7 @@ C integer icall common /srutu/ icall logical lprn - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij, & xi,yi,zi,fac_augm,e_augm double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij, @@ -1157,7 +1181,10 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1172,8 +1199,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -1257,8 +1284,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad_scale((1.0d0-sss)*sss1) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i end C----------------------------------------------------------------------------- @@ -1282,7 +1309,7 @@ C integer icall common /srutu/ icall logical lprn - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij, & xi,yi,zi,fac_augm,e_augm double precision evdw @@ -1296,7 +1323,10 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1311,8 +1341,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -1390,8 +1420,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad_scale(sss) endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i end C---------------------------------------------------------------------------- @@ -1481,6 +1511,7 @@ C include 'COMMON.TIME1' include 'COMMON.SHIELD' include "COMMON.SPLITELE" + integer icont dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), @@ -1629,7 +1660,10 @@ C & .or. itype(i-1).eq.ntyp1 c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c - do i=iatel_s,iatel_e +c do i=iatel_s,iatel_e + do icont=g_listpp_start,g_listpp_end + i=newcontlistppi(icont) + j=newcontlistppj(icont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 C & .or. itype(i+2).eq.ntyp1 C & .or. itype(i-1).eq.ntyp1 @@ -1653,13 +1687,13 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend #ifdef FOURBODY num_conti=num_cont_hb(i) #endif - do j=ielstart(i),ielend(i) +c do j=ielstart(i),ielend(i) if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1 C & .or.itype(j+2).eq.ntyp1 C & .or.itype(j-1).eq.ntyp1 &) cycle call eelecij_scale(i,j,ees,evdw1,eel_loc) - enddo ! j +c enddo ! j #ifdef FOURBODY num_cont_hb(i)=num_conti #endif @@ -2700,12 +2734,16 @@ c write (iout,*) "evdwpp_short" double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp, & dist_temp, dist_init,sss_grad double precision sscale,sscagrad + integer icont evdw1=0.0D0 C print *,"WCHODZE" c write (iout,*) "iatel_s_vdw",iatel_s_vdw, c & " iatel_e_vdw",iatel_e_vdw c call flush(iout) - do i=iatel_s_vdw,iatel_e_vdw +c do i=iatel_s_vdw,iatel_e_vdw + do icont=g_listpp_vdw_start,g_listpp_vdw_end + i=newcontlistpp_vdwi(icont) + j=newcontlistpp_vdwj(icont) if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) @@ -2726,7 +2764,7 @@ c call flush(iout) c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), c & ' ielend',ielend_vdw(i) c call flush(iout) - do j=ielstart_vdw(i),ielend_vdw(i) +c do j=ielstart_vdw(i),ielend_vdw(i) if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle ind=ind+1 iteli=itel(i) @@ -2817,7 +2855,7 @@ C ggg(3)=facvdw*zj gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo endif - enddo ! j +c enddo ! j enddo ! i return end @@ -2851,6 +2889,7 @@ C double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp, & dist_temp, dist_init double precision sscale,sscagrad + integer icont if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb evdw2=0.0D0 evdw2_14=0.0d0 @@ -2859,7 +2898,10 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e c if (lprint_short) c & write (iout,*) 'ESCP_LONG iatscp_s=',iatscp_s, c & ' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e +c do i=iatscp_s,iatscp_e + do icont=g_listscp_start,g_listscp_end + i=newcontlistscpi(icont) + j=newcontlistscpj(icont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -2872,9 +2914,9 @@ c & ' iatscp_e=',iatscp_e zi=mod(zi,boxzsize) if (zi.lt.0) zi=zi+boxzsize - do iint=1,nscp_gr(i) +c do iint=1,nscp_gr(i) - do j=iscpstart(i,iint),iscpend(i,iint) +c do j=iscpstart(i,iint),iscpend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions @@ -2969,9 +3011,9 @@ c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo endif - enddo +c enddo - enddo ! iint +c enddo ! iint enddo ! i do i=1,nct do j=1,3 diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index ef19809..44023d0 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -112,18 +112,15 @@ C FG slaves receive the WEIGHTS array time_Bcastw=time_Bcastw+MPI_Wtime()-time00 c call chainbuild_cart endif -#ifndef DFA - edfadis=0.0d0 - edfator=0.0d0 - edfanei=0.0d0 - edfabet=0.0d0 -#endif if (nfgtasks.gt.1) then call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) endif - if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list - if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list - if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list + if (mod(itime_mat,imatupdate).eq.0) then + call make_SCp_inter_list + call make_SCSC_inter_list + call make_pp_inter_list + call make_pp_vdw_inter_list + endif c print *,'Processor',myrank,' calling etotal ipot=',ipot c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct #else @@ -134,6 +131,13 @@ c endif #ifdef TIMING time00=MPI_Wtime() #endif + +#ifndef DFA + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 +#endif C C Compute the side-chain and electrostatic interaction energy C @@ -3869,7 +3873,7 @@ c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c CTU KURWA c do i=iatel_s,iatel_e - do icont=g_listpp_start,g_listpp_end + do icont=g_listpp_start,g_listpp_end i=newcontlistppi(icont) j=newcontlistppj(icont) C do i=75,75 diff --git a/source/unres/src-HCD-5D/energy_split-sep.F b/source/unres/src-HCD-5D/energy_split-sep.F index 1b033a5..f16bc1b 100644 --- a/source/unres/src-HCD-5D/energy_split-sep.F +++ b/source/unres/src-HCD-5D/energy_split-sep.F @@ -127,7 +127,17 @@ c write (iout,*) 'Processor',myrank, c & ' calling etotal_short ipot=',ipot c call flush(iout) c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct + if (nfgtasks.gt.1) then + call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) + endif + if (mod(itime_mat,imatupdate).eq.0) then + call make_SCp_inter_list + call make_SCSC_inter_list + call make_pp_inter_list + call make_pp_vdw_inter_list + endif #endif + cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy diff --git a/source/unres/src-HCD-5D/make_xx_list.F b/source/unres/src-HCD-5D/make_xx_list.F index fb6c055..a83740f 100644 --- a/source/unres/src-HCD-5D/make_xx_list.F +++ b/source/unres/src-HCD-5D/make_xx_list.F @@ -331,6 +331,166 @@ c write(iout,*) "before bcast",g_ilist_sc return end !----------------------------------------------------------------------------- + subroutine make_pp_vdw_inter_list + implicit none + include "DIMENSIONS" +#ifdef MPI + include 'mpif.h' + include "COMMON.SETUP" +#endif + 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 dx_normi,dy_normi,dz_normi,dxj,dyj,dzj, + & dx_normj,dy_normj,dz_normj + integer contlistpp_vdwi(200*maxres),contlistpp_vdwj(200*maxres) +! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint, + & ilist_pp_vdw,g_ilist_pp_vdw + integer displ(0:max_fg_procs),i_ilist_pp_vdw(0:max_fg_procs),ierr +! print *,"START make_SC" +#ifdef DEBUG + write (iout,*) "make_pp_vdw_inter_list" +#endif + ilist_pp_vdw=0 + r_buff_list=5.0 + 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) + dx_normi=dc_norm(1,i) + dy_normi=dc_norm(2,i) + dz_normi=dc_norm(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + 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) + dx_normj=dc_norm(1,j) + dy_normj=dc_norm(2,j) + dz_normj=dc_norm(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 + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + endif + enddo + enddo + enddo + + if (sqrt(dist_init).le.(r_cut_int+r_buff_list)) then +! Here the list is created + ilist_pp_vdw=ilist_pp_vdw+1 +! this can be substituted by cantor and anti-cantor + contlistpp_vdwi(ilist_pp_vdw)=i + contlistpp_vdwj(ilist_pp_vdw)=j + endif + enddo + enddo +! enddo +#ifdef MPI +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_pp_vdw + do i=1,ilist_pp_vdw + write (iout,*) i,contlistpp_vdwi(i),contlistpp_vdwj(i) + enddo +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_pp_vdw,g_ilist_pp_vdw,1, + & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_pp_vdw,1,MPI_INTEGER, + & i_ilist_pp_vdw,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_pp_vdw(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistpp_vdwi,ilist_pp_vdw,MPI_INTEGER, + & newcontlistpp_vdwi,i_ilist_pp_vdw,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Gatherv(contlistpp_vdwj,ilist_pp_vdw,MPI_INTEGER, + & newcontlistpp_vdwj,i_ilist_pp_vdw,displ,MPI_INTEGER, + & king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_pp_vdw,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,g_ilist_pp_vdw,MPI_INT,king, + & FG_COMM,IERR) + call MPI_Bcast(newcontlistpp_vdwj,g_ilist_pp_vdw,MPI_INT,king, + & FG_COMM,IERR) + +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + + else +#endif + g_ilist_pp_vdw=ilist_pp_vdw + + do i=1,ilist_pp_vdw + newcontlistpp_vdwi(i)=contlistpp_vdwi(i) + newcontlistpp_vdwj(i)=contlistpp_vdwj(i) + enddo +#ifdef MPI + endif +#endif + call int_bounds(g_ilist_pp_vdw,g_listpp_vdw_start, + & g_listpp_vdw_end) +#ifdef DEBUG + write (iout,*) "g_listpp_vdw_start",g_listpp_vdw_start, + & "g_listpp_vdw_end",g_listpp_vdw_end + write (iout,*) "after MPIREDUCE",g_ilist_pp_vdw + do i=1,g_ilist_pp_vdw + write (iout,*) i,newcontlistpp_vdwi(i),newcontlistpp_vdwj(i) + enddo +#endif + return + end +!----------------------------------------------------------------------------- subroutine make_pp_inter_list implicit none include "DIMENSIONS"