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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"