Adams corrections

diff --git a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos
index f3ff018..4f7f61f 100644 (file)
--- a/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos
+++ b/source/cluster/wham/src-HCD/Makefile-MPICH-ifort-okeanos
@@ -77,6 +77,17 @@ NEWCORR: ${object} xdrf/libxdrf.a
        ${FC} ${FFLAGS} cinfo.f
        $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
 
+NEWCORR5D: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DFIVEDIAG
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR5D: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD5.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR5D: ${object} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
+
 NEWCORR_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
        -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA
 #-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
@@ -88,6 +99,17 @@ NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a
        ${FC} ${FFLAGS} cinfo.f
        $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
 
+NEWCORR5D_DFA: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \
+       -DCORRCD -DCLUST -DSPLITELE -DLANG0 -DNEWCORR -DDFA
+#-DCLUST -DSPLITELE -DLANG0 -DNEWCORR
+NEWCORR5D_DFA: BIN = ~/bin/unres_clustMD_ifort_MPICH-okeanos_SC-HCD5-DFA.exe
+#NEWCORR: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_NEWCORR-fouriertor-test.exe
+NEWCORR5D_DFA: ${object} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo | true
+       ${FC} ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${object} dfa.o cinfo.o ${LIBS} -o ${BIN}
+
 xdrf/libxdrf.a:
        cd xdrf && make
 

diff --git a/source/cluster/wham/src-HCD/energy_p_new.F b/source/cluster/wham/src-HCD/energy_p_new.F
index 5cc851c..27e944b 100644 (file)
--- a/source/cluster/wham/src-HCD/energy_p_new.F
+++ b/source/cluster/wham/src-HCD/energy_p_new.F
@@ -1775,13 +1775,17 @@ C to calculate the el-loc multibody terms of various order.
 C
 c      write(iout,*) 'SET_MATRICES nphi=',nphi,nres
       do i=3,nres+1
-        if (i.gt. nnt+2 .and. i.lt.nct+2) then
+        ii=ireschain(i-2)
+        if (ii.eq.0) cycle
+        innt=chain_border(1,ii)
+        inct=chain_border(2,ii)
+        if (i.gt. innt+2 .and. i.lt.inct+2) then
           iti = itype2loc(itype(i-2))
         else
           iti=nloctyp
         endif
 c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
-        if (i.gt. nnt+1 .and. i.lt.nct+1) then
+        if (i.gt. innt+1 .and. i.lt.inct+1) then
           iti1 = itype2loc(itype(i-1))
         else
           iti1=nloctyp
@@ -1856,6 +1860,19 @@ c        b2tilde(2,i-2)=-b2(2,i-2)
         write (iout,*) 'theta=', theta(i-1)
 #endif
 #else
+        if (i.gt. innt+2 .and. i.lt.inct+2) then
+c        if (i.gt. nnt+2 .and. i.lt.nct+2) then
+          iti = itype2loc(itype(i-2))
+        else
+          iti=nloctyp
+        endif
+c        write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
+c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
+        if (i.gt. nnt+1 .and. i.lt.nct+1) then
+          iti1 = itype2loc(itype(i-1))
+        else
+          iti1=nloctyp
+        endif
 c        if (i.gt. nnt+2 .and. i.lt.nct+2) then
 c          iti = itype2loc(itype(i-2))
 c        else
@@ -4520,6 +4537,10 @@ c
       estr1=0.0d0
 c      write (iout,*) "distchainmax",distchainmax
       do i=nnt+1,nct
+#ifdef FIVEDIAG
+        if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
+        diff = vbld(i)-vbldp0
+#else
         if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
 C          estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
 C          do j=1,3
@@ -4537,6 +4558,9 @@ C         write(iout,*) i,diff
           diff = vbld(i)-vbldp0
 c          write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
          endif
+#endif
+        if (energy_dec) write (iout,'(a7,i5,4f7.3)')
+     &     "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
           estr=estr+diff*diff
           do j=1,3
             gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
@@ -4555,8 +4579,9 @@ c
           nbi=nbondterm(iti)
           if (nbi.eq.1) then
             diff=vbld(i+nres)-vbldsc0(1,iti)
-C            write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
-C     &      AKSC(1,iti),AKSC(1,iti)*diff*diff
+            if (energy_dec) write (iout,*) 
+     &      i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
+     &      AKSC(1,iti),AKSC(1,iti)*diff*diff
             estr=estr+0.5d0*AKSC(1,iti)*diff*diff
             do j=1,3
               gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)

diff --git a/source/unres/src-HCD-5D/COMMON.CONTACTS b/source/unres/src-HCD-5D/COMMON.CONTACTS
index d5c2d2e..ae6a0fb 100644 (file)
--- a/source/unres/src-HCD-5D/COMMON.CONTACTS
+++ b/source/unres/src-HCD-5D/COMMON.CONTACTS
@@ -1,4 +1,3 @@
-      integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont
-      double precision facont,gacont
+      integer ncont,ncont_ref,icont,icont_ref
       common /contacts/ ncont,ncont_ref,icont(2,maxcont),
      &                  icont_ref(2,maxcont)

diff --git a/source/unres/src-HCD-5D/COMMON.CONTMAT b/source/unres/src-HCD-5D/COMMON.CONTMAT
index e681360..d65e291 100644 (file)
--- a/source/unres/src-HCD-5D/COMMON.CONTMAT
+++ b/source/unres/src-HCD-5D/COMMON.CONTMAT
@@ -1,4 +1,6 @@
 C Change 12/1/95 - common block CONTACTS1 included.
+      double precision facont,gacont
+      integer num_cont,jcont
       common /contacts1/ facont(maxconts,maxres),
      &                  gacont(3,maxconts,maxres),
      &                  num_cont(maxres),jcont(maxconts,maxres)

diff --git a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos
index 1efd046..b7c9d19 100644 (file)
--- a/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos
+++ b/source/unres/src-HCD-5D/Makefile_MPICH_ifort-okeanos
@@ -95,7 +95,7 @@ NEWCORR: ${object} xdrf/libxdrf.a
 
 NEWCORR5D: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \
        -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DFIVEDIAG -DLBFGS #-DMYGAUSS #-DTIMING
-NEWCORR5D: BIN = ~/bin/unres_ifort_MPICH-okeanos_SC-HCD5-l.exe
+NEWCORR5D: BIN = ~/bin/unres_ifort_MPICH-okeanos_SC-HCD5.exe
 NEWCORR5D: ${object_lbfgs} ${object} fdisy.o fdiag.o machpd.o kinetic_CASC.o xdrf/libxdrf.a
        gcc -o compinfo compinfo.c
        ./compinfo | true

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 0f37efe..c6c6832 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,16 +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,icont
+      integer i,j,k,itypi,itypj,itypi1,num_conti,iint,ikont
       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
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -183,16 +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,icont
+      integer i,j,k,itypi,itypj,itypi1,num_conti,iint,ikont
       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
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -280,7 +280,7 @@ C
       include "COMMON.SPLITELE"
       double precision gg(3)
       double precision evdw,evdwij
-      integer i,j,k,itypi,itypj,itypi1,iint,icont
+      integer i,j,k,itypi,itypj,itypi1,iint,ikont
       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
@@ -288,9 +288,9 @@ C
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -379,7 +379,7 @@ C
       include "COMMON.SPLITELE"
       double precision gg(3)
       double precision evdw,evdwij
-      integer i,j,k,itypi,itypj,itypi1,iint,icont
+      integer i,j,k,itypi,itypj,itypi1,iint,ikont
       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
@@ -387,9 +387,9 @@ C
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -474,7 +474,7 @@ C
       integer icall
       common /srutu/ icall
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
       double precision sss1,sssgrad1
       double precision sscale,sscagrad
@@ -490,9 +490,9 @@ c     else
 c     endif
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -601,7 +601,7 @@ C
       integer icall
       common /srutu/ icall
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
       double precision sscale,sscagrad
 c     double precision rrsave(maxdim)
@@ -616,9 +616,9 @@ c     else
 c     endif
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -724,7 +724,7 @@ C
       logical lprn
       integer xshift,yshift,zshift
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       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,
@@ -739,9 +739,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.false.
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -948,7 +948,7 @@ C
       logical lprn
       integer xshift,yshift,zshift
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       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,
@@ -963,9 +963,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.false.
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1167,7 +1167,7 @@ C
       integer icall
       common /srutu/ icall
       logical lprn
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       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,
@@ -1182,9 +1182,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.true.
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1309,7 +1309,7 @@ C
       integer icall
       common /srutu/ icall
       logical lprn
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij,
      & xi,yi,zi,fac_augm,e_augm
       double precision evdw
@@ -1324,9 +1324,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.true.
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1511,7 +1511,7 @@ C
       include 'COMMON.TIME1'
       include 'COMMON.SHIELD'
       include "COMMON.SPLITELE"
-      integer icont
+      integer ikont
       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),
@@ -1661,9 +1661,9 @@ c
 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
 c
 c      do i=iatel_s,iatel_e
-      do icont=g_listpp_start,g_listpp_end
-        i=newcontlistppi(icont)
-        j=newcontlistppj(icont)
+      do ikont=g_listpp_start,g_listpp_end
+        i=newcontlistppi(ikont)
+        j=newcontlistppj(ikont)
         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
@@ -2734,16 +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
+      integer ikont
       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)
 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)
+      do ikont=g_listpp_vdw_start,g_listpp_vdw_end
+        i=newcontlistpp_vdwi(ikont)
+        j=newcontlistpp_vdwj(ikont)
         if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle
         dxi=dc(1,i)
         dyi=dc(2,i)
@@ -2889,7 +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
+      integer ikont
       if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb
       evdw2=0.0D0
       evdw2_14=0.0d0
@@ -2899,9 +2899,9 @@ c      if (lprint_short)
 c     &  write (iout,*) 'ESCP_LONG iatscp_s=',iatscp_s,
 c     & ' iatscp_e=',iatscp_e
 c      do i=iatscp_s,iatscp_e
-      do icont=g_listscp_start,g_listscp_end
-        i=newcontlistscpi(icont)
-        j=newcontlistscpj(icont)
+      do ikont=g_listscp_start,g_listscp_end
+        i=newcontlistscpi(ikont)
+        j=newcontlistscpj(ikont)
         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))

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 44023d0..ba7cbd8 100644 (file)
--- a/source/unres/src-HCD-5D/energy_p_new_barrier.F
+++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F
@@ -1471,7 +1471,7 @@ C
 #endif
       double precision gg(3)
       double precision evdw,evdwij
-      integer i,j,k,itypi,itypj,itypi1,num_conti,iint,icont
+      integer i,j,k,itypi,itypj,itypi1,num_conti,iint,ikont
       double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij,
      & sigij,r0ij,rcut,sqrij,sss1,sssgrad1
       double precision fcont,fprimcont
@@ -1479,9 +1479,9 @@ C
 c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1644,7 +1644,7 @@ C
       include 'COMMON.SPLITELE'
       double precision gg(3)
       double precision evdw,evdwij
-      integer i,j,k,itypi,itypj,itypi1,iint,icont
+      integer i,j,k,itypi,itypj,itypi1,iint,ikont
       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
@@ -1652,9 +1652,9 @@ C
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1744,7 +1744,7 @@ C
       integer icall
       common /srutu/ icall
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi,
      & sss1,sssgrad1
       double precision sscale,sscagrad
@@ -1760,9 +1760,9 @@ c     else
 c     endif
       ind=0
 c      do i=iatsc_s,iatsc_e 
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -1884,7 +1884,7 @@ C
       logical lprn
       integer xshift,yshift,zshift,subchap
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       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,
@@ -1903,9 +1903,9 @@ C      do xshift=-1,1
 C      do yshift=-1,1
 C      do zshift=-1,1
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -2207,7 +2207,7 @@ c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
             endif
 
             if (energy_dec) write (iout,'(a,2i5,3f10.5)') 
-     &                    'r sss evdw',i,j,rij,sss,evdwij
+     &                    'r sss evdw',i,j,1.0d0/rij,sss,evdwij
 
 C Calculate gradient components.
             e1=e1*eps1*eps2rt**2*eps3rt**2
@@ -2267,7 +2267,7 @@ C
       common /srutu/ icall
       logical lprn
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind,icont
+      integer itypi,itypj,itypi1,iint,ind,ikont
       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,
@@ -2281,9 +2281,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.true.
       ind=0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -2639,9 +2639,9 @@ c      include 'COMMON.CONTACTS'
 cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
       evdw=0.0D0
 c      do i=iatsc_s,iatsc_e
-      do icont=g_listscsc_start,g_listscsc_end
-        i=newcontlisti(icont)
-        j=newcontlistj(icont)
+      do ikont=g_listscsc_start,g_listscsc_end
+        i=newcontlisti(ikont)
+        j=newcontlistj(ikont)
         itypi=iabs(itype(i))
         if (itypi.eq.ntyp1) cycle
         itypi1=iabs(itype(i+1))
@@ -3873,9 +3873,9 @@ 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
-        i=newcontlistppi(icont)
-        j=newcontlistppj(icont)
+      do ikont=g_listpp_start,g_listpp_end
+        i=newcontlistppi(ikont)
+        j=newcontlistppj(ikont)
 C        do i=75,75
 c        if (i.le.1) cycle
         if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
@@ -5579,9 +5579,9 @@ C      do xshift=-1,1
 C      do yshift=-1,1
 C      do zshift=-1,1
 c      do i=iatscp_s,iatscp_e
-      do icont=g_listscp_start,g_listscp_end
-        i=newcontlistscpi(icont)
-        j=newcontlistscpj(icont)
+      do ikont=g_listscp_start,g_listscp_end
+        i=newcontlistscpi(ikont)
+        j=newcontlistscpj(ikont)
         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))
@@ -5776,7 +5776,7 @@ C
       include 'COMMON.SPLITELE'
       integer xshift,yshift,zshift
       double precision ggg(3)
-      integer i,iint,j,k,iteli,itypj,subchap,icont
+      integer i,iint,j,k,iteli,itypj,subchap,ikont
       double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1,
      & fac,e1,e2,rij
       double precision evdw2,evdw2_14,evdwij
@@ -5793,9 +5793,9 @@ C      do yshift=-1,1
 C      do zshift=-1,1
       if (energy_dec) write (iout,*) "escp:",r_cut_int,rlamb
 c      do i=iatscp_s,iatscp_e
-      do icont=g_listscp_start,g_listscp_end
-        i=newcontlistscpi(icont)
-        j=newcontlistscpj(icont)
+      do ikont=g_listscp_start,g_listscp_end
+        i=newcontlistscpi(ikont)
+        j=newcontlistscpj(ikont)
         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))

diff --git a/source/unres/src-HCD-5D/initialize_p.F b/source/unres/src-HCD-5D/initialize_p.F
index 6806e62..855c7a4 100644 (file)
--- a/source/unres/src-HCD-5D/initialize_p.F
+++ b/source/unres/src-HCD-5D/initialize_p.F
@@ -446,6 +446,9 @@ c---------------------------------------------------------------------------
       include 'COMMON.TORCNSTR'
       include 'COMMON.IOUNITS'
       include 'COMMON.DERIV'
+#ifdef FOURBODY
+      include 'COMMON.CONTMAT'
+#endif
       include 'COMMON.CORRMAT'
       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
      & iturn4_end_all,iatel_s_all,

diff --git a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos
index 01955ff..e667382 100644 (file)
--- a/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos
+++ b/source/wham/src-HCD/Makefile_MPICH_ifort-okeanos
@@ -121,7 +121,7 @@ E0LL2Y_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
        $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
        ${LIBS} -o ${BIN}/wham_ifort_MPICH-okeanos_E0LL2Y-HCD-DFA.exe
 
-NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DFOURBODY -DPGI -DISNAN -DAMD64 -DWHAM
+NEWCORR: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM
 NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a
        gcc -o compinfo compinfo.c
        ./compinfo
@@ -129,6 +129,14 @@ NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a
        $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
        ${LIBS} -o ${BIN}/wham_ifort_MPICH-okeanos_SC-HCD.exe
 
+NEWCORR5D: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG
+NEWCORR5D: ${objects} ${objects_compar} xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-okeanos_SC-HCD5.exe
+
 NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA
 NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
        gcc -o compinfo compinfo.c
@@ -137,6 +145,14 @@ NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
        $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
        ${LIBS} -o ${BIN}/wham_ifort_MPICH-okeanos_SC-HCD-DFA-D.exe
 
+NEWCORR5D_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DFIVEDIAG -DDFA
+NEWCORR5D_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a
+       gcc -o compinfo compinfo.c
+       ./compinfo
+       ${FC} -c ${FFLAGS} cinfo.f
+       $(FC) ${OPT} ${objects} ${objects_compar} dfa.o cinfo.o \
+       ${LIBS} -o ${BIN}/wham_ifort_MPICH-okeanos_SC-HCD5-DFA.exe
+
 xdrf/libxdrf.a:
        cd xdrf && make
 

diff --git a/source/wham/src-HCD/energy_p_new.F b/source/wham/src-HCD/energy_p_new.F
index f4dabad..835045b 100644 (file)
--- a/source/wham/src-HCD/energy_p_new.F
+++ b/source/wham/src-HCD/energy_p_new.F
@@ -1342,8 +1342,8 @@ c#define DEBUG
 #endif
 c#undef DEBUG
 c            endif
-            if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
-     &                        'evdw',i,j,evdwij
+            if (energy_dec) write (iout,'(a,2i5,3f10.5)')
+     &                    'r sss evdw',i,j,1.0d0/rij,sss,evdwij
             if (calc_grad) then
 C Calculate gradient components.
             e1=e1*eps1*eps2rt**2*eps3rt**2
@@ -1794,13 +1794,19 @@ C to calculate the el-loc multibody terms of various order.
 C
 c      write(iout,*) 'SET_MATRICES nphi=',nphi,nres
       do i=3,nres+1
-        if (i.gt. nnt+2 .and. i.lt.nct+2) then
+        ii=ireschain(i-2)
+        if (ii.eq.0) cycle
+        innt=chain_border(1,ii)
+        inct=chain_border(2,ii)
+c        if (i.gt. nnt+2 .and. i.lt.nct+2) then
+        if (i.gt. innt+2 .and. i.lt.inct+2) then
           iti = itype2loc(itype(i-2))
         else
           iti=nloctyp
         endif
 c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
-        if (i.gt. nnt+1 .and. i.lt.nct+1) then
+c        if (i.gt. nnt+1 .and. i.lt.nct+1) then
+        if (i.gt. innt+1 .and. i.lt.inct+1) then
           iti1 = itype2loc(itype(i-1))
         else
           iti1=nloctyp
@@ -5165,6 +5171,10 @@ c
       estr1=0.0d0
 c      write (iout,*) "distchainmax",distchainmax
       do i=nnt+1,nct
+#ifdef FIVEDIAG
+        if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) cycle
+        diff = vbld(i)-vbldp0
+#else
         if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
 C          estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
 C          do j=1,3
@@ -5182,13 +5192,14 @@ C         write(iout,*) i,diff
           diff = vbld(i)-vbldp0
 c          write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
          endif
+#endif
           estr=estr+diff*diff
           do j=1,3
             gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
           enddo
 C        endif
-C        write (iout,'(a7,i5,4f7.3)')
-C     &     "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
+          if (energy_dec) write (iout,'(a7,i5,4f7.3)')
+     &     "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
       enddo
       estr=0.5d0*AKP*estr+estr1
 c
@@ -5200,8 +5211,9 @@ c
           nbi=nbondterm(iti)
           if (nbi.eq.1) then
             diff=vbld(i+nres)-vbldsc0(1,iti)
-C            write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
-C     &      AKSC(1,iti),AKSC(1,iti)*diff*diff
+            if (energy_dec) write (iout,*) "estr sc",iti,vbld(i+nres),
+     &      vbldsc0(1,iti),diff,
+     &      AKSC(1,iti),AKSC(1,iti)*diff*diff
             estr=estr+0.5d0*AKSC(1,iti)*diff*diff
             do j=1,3
               gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)

diff --git a/source/wham/src-HCD/readrtns.F b/source/wham/src-HCD/readrtns.F
index 84a366f..e7effcd 100644 (file)
--- a/source/wham/src-HCD/readrtns.F
+++ b/source/wham/src-HCD/readrtns.F
@@ -93,7 +93,7 @@
        call reada(controlcard,'BOXY',boxysize,100.0d0)
        call reada(controlcard,'BOXZ',boxzsize,100.0d0)
 c Cutoff range for interactions
-      call reada(controlcard,"R_CUT",r_cut,15.0d0)
+      call reada(controlcard,"R_CUT",r_cut,25.0d0)
       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)