Adams corrections
[unres.git] / source / unres / src-HCD-5D / energy_p_new_barrier.F
index 2a588bd..ba7cbd8 100644 (file)
@@ -30,6 +30,7 @@ c      include 'COMMON.MD'
       include 'COMMON.SPLITELE'
       include 'COMMON.TORCNSTR'
       include 'COMMON.SAXS'
+      include 'COMMON.MD'
       double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc,
      & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr,
      & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6,
@@ -111,12 +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) 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
@@ -127,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
 #endif
       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,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
       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 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))
@@ -1479,10 +1493,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
@@ -1587,8 +1601,8 @@ cd   &           i,j,(gacont(kk,num_conti,i),kk=1,3)
               endif
             endif
 #endif
-          enddo      ! j
-        enddo        ! iint
+c          enddo      ! j
+c        enddo        ! iint
 C Change 12/1/95
 #ifdef FOURBODY
         num_cont(i)=num_conti
       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,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
       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 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))
@@ -1647,8 +1664,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
@@ -1695,8 +1712,8 @@ cgrad              do l=1,3
 cgrad                gvdwc(l,k)=gvdwc(l,k)+gg(l)
 cgrad              enddo
 cgrad            enddo
-          enddo      ! j
-        enddo        ! iint
+c          enddo      ! j
+c        enddo        ! iint
       enddo          ! i
       do i=1,nct
         do j=1,3
@@ -1727,7 +1744,7 @@ C
       integer icall
       common /srutu/ icall
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind
+      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
@@ -1742,7 +1759,10 @@ c     else
         lprn=.false.
 c     endif
       ind=0
-      do i=iatsc_s,iatsc_e
+c      do i=iatsc_s,iatsc_e 
+      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))
@@ -1757,8 +1777,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
@@ -1835,8 +1855,8 @@ C Calculate radial part of the gradient
 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
-          enddo      ! j
-        enddo        ! iint
+!          enddo      ! j
+!        enddo        ! iint
       enddo          ! i
 c     stop
       return
@@ -1864,7 +1884,7 @@ C
       logical lprn
       integer xshift,yshift,zshift,subchap
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind
+      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,
@@ -1882,7 +1902,10 @@ C we have the original box)
 C      do xshift=-1,1
 C      do yshift=-1,1
 C      do zshift=-1,1
-      do i=iatsc_s,iatsc_e
+c      do i=iatsc_s,iatsc_e
+      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))
@@ -1963,8 +1986,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)
             IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
 
 c              write(iout,*) "PRZED ZWYKLE", evdwij
@@ -2184,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
@@ -2211,8 +2234,8 @@ C Calculate angular part of the gradient.
 c            call sc_grad_scale(sss)
             call sc_grad
             ENDIF    ! dyn_ss            
-          enddo      ! j
-        enddo        ! iint
+c          enddo      ! j
+c        enddo        ! iint
       enddo          ! i
 C      enddo          ! zshift
 C      enddo          ! yshift
@@ -2244,7 +2267,7 @@ C
       common /srutu/ icall
       logical lprn
       double precision evdw
-      integer itypi,itypj,itypi1,iint,ind
+      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,
@@ -2257,7 +2280,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 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))
@@ -2307,8 +2333,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
@@ -2460,8 +2486,8 @@ C Calculate the radial part of the gradient
 C Calculate angular part of the gradient.
 c            call sc_grad_scale(sss)
             call sc_grad
-          enddo      ! j
-        enddo        ! iint
+c          enddo      ! j
+c        enddo        ! iint
       enddo          ! i
       end
 C-----------------------------------------------------------------------------
@@ -2612,7 +2638,10 @@ c      include 'COMMON.CONTACTS'
       dimension gg(3)
 cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
       evdw=0.0D0
-      do i=iatsc_s,iatsc_e
+c      do i=iatsc_s,iatsc_e
+      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))
@@ -2622,10 +2651,10 @@ cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
 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
@@ -2661,8 +2690,8 @@ cgrad              do l=1,3
 cgrad                gvdwc(l,k)=gvdwc(l,k)+gg(l)
 cgrad              enddo
 cgrad            enddo
-          enddo ! j
-        enddo ! iint
+c          enddo ! j
+c        enddo ! iint
       enddo ! i
       return
       end
@@ -3843,7 +3872,10 @@ c
 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
 c
 CTU KURWA
-      do i=iatel_s,iatel_e
+c      do i=iatel_s,iatel_e
+      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
@@ -3904,7 +3936,7 @@ c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
         num_conti=num_cont_hb(i)
 #endif
 C I TU KURWA
-        do j=ielstart(i),ielend(i)
+c        do j=ielstart(i),ielend(i)
 C          do j=16,17
 C          write (iout,*) i,j
 C         if (j.le.1) cycle
@@ -3917,7 +3949,7 @@ c     & .or.itype(j+2).eq.ntyp1
 c     & .or.itype(j-1).eq.ntyp1
      &) cycle
           call eelecij(i,j,ees,evdw1,eel_loc)
-        enddo ! j
+c        enddo ! j
 #ifdef FOURBODY
         num_cont_hb(i)=num_conti
 #endif
@@ -5546,7 +5578,10 @@ cd    write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
 C      do xshift=-1,1
 C      do yshift=-1,1
 C      do zshift=-1,1
-      do i=iatscp_s,iatscp_e
+c      do i=iatscp_s,iatscp_e
+      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))
@@ -5586,9 +5621,9 @@ c        endif
 C          xi=xi+xshift*boxxsize
 C          yi=yi+yshift*boxysize
 C          zi=zi+zshift*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)
           if (itype(j).eq.ntyp1) cycle
           itypj=iabs(itype(j))
 C Uncomment following three lines for SC-p interactions
@@ -5711,9 +5746,9 @@ cgrad          enddo
             gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
             gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
           enddo
-        enddo
+c        enddo
 
-        enddo ! iint
+c        enddo ! iint
       enddo ! i
 C      enddo !zshift
 C      enddo !yshift
@@ -5741,7 +5776,7 @@ C
       include 'COMMON.SPLITELE'
       integer xshift,yshift,zshift
       double precision ggg(3)
-      integer i,iint,j,k,iteli,itypj,subchap
+      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
@@ -5757,7 +5792,10 @@ C      do xshift=-1,1
 C      do yshift=-1,1
 C      do zshift=-1,1
       if (energy_dec) write (iout,*) "escp:",r_cut_int,rlamb
-      do i=iatscp_s,iatscp_e
+c      do i=iatscp_s,iatscp_e
+      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))
@@ -5800,9 +5838,9 @@ c        if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
 c     &       (zi.lt.((zshift-0.5d0)*boxzsize))) then
 c        go to 136
 c        endif
-        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
@@ -5937,9 +5975,9 @@ cgrad          enddo
             gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
           enddo
 c        endif !endif for sscale cutoff
-        enddo ! j
+c        enddo ! j
 
-        enddo ! iint
+c        enddo ! iint
       enddo ! i
 c      enddo !zshift
 c      enddo !yshift