wham idssb(j)+nres
[unres.git] / source / wham / src-HCD-5D / energy_p_new.F
index bd69774..6e1c491 100644 (file)
@@ -56,7 +56,7 @@ C
        call set_shield_fac2
       endif
       call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C            write(iout,*) 'po eelec'
+c            write(iout,*) 'po eelec eello_turn4',eello_turn4
 
 C Calculate excluded-volume interaction energy between peptide groups
 C and side chains.
@@ -159,6 +159,7 @@ c         write (iout,*) "Calling multibody_hbond"
          call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
       endif
 #endif
+c      write (iout,*) "nsaxs",nsaxs
 c      write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr
       if (nsaxs.gt.0 .and. saxs_mode.eq.0) then
         call e_saxs(Esaxs_constr)
@@ -192,8 +193,12 @@ c      write(iout,*)'edfan is finished!', wdfa_nei,edfanei
       edfabet=0.0d0
       if (wdfa_beta.gt.0) call edfab(edfabet)
 c      write(iout,*)'edfab is finished!', wdfa_beta,edfabet
+#else
+      edfadis=0.0d0
+      edfator=0.0d0
+      edfanei=0.0d0
+      edfabet=0.0d0
 #endif
-
 c      write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
 #ifdef SPLITELE
       if (shield_mode.gt.0) then
@@ -515,6 +520,9 @@ C     Bartek
       edfator = energia(29)
       edfanei = energia(30)
       edfabet = energia(31)
+      Eafmforc=0.0d0
+      etube=0.0d0
+      Uconst=0.0d0
 #ifdef SPLITELE
       write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp,
      &  estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
@@ -680,6 +688,7 @@ cROZNICA
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C Change 12/1/95
         num_conti=0
 C
@@ -694,6 +703,10 @@ cd   &                  'iend=',iend(i,iint)
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
 C Change 12/1/95 to calculate four-body interactions
             rij=xj*xj+yj*yj+zj*zj
             rrij=1.0D0/rij
@@ -865,6 +878,7 @@ c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
 C
 C Calculate SC interaction energy.
 C
@@ -875,6 +889,10 @@ C
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
             fac_augm=rrij**expon
             e_augm=augm(itypi,itypj)*fac_augm
@@ -982,6 +1000,7 @@ c     endif
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1014,9 +1033,13 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1128,35 +1151,8 @@ c      if (icall.gt.0) lprn=.true.
         yi=c(2,nres+i)
         zi=c(3,nres+i)
 C returning the ith atom to box
-          xi=mod(xi,boxxsize)
-          if (xi.lt.0) xi=xi+boxxsize
-          yi=mod(yi,boxysize)
-          if (yi.lt.0) yi=yi+boxysize
-          zi=mod(zi,boxzsize)
-          if (zi.lt.0) zi=zi+boxzsize
-       if ((zi.gt.bordlipbot)
-     &.and.(zi.lt.bordliptop)) then
-C the energy transfer exist
-        if (zi.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zi.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
-         sslipi=sscalelip(fracinbuf)
-         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipi=1.0d0
-         ssgradlipi=0.0
-        endif
-       else
-         sslipi=0.0d0
-         ssgradlipi=0.0
-       endif
-
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1214,80 +1210,18 @@ c           alf12=0.0D0
             yj=c(2,nres+j)
             zj=c(3,nres+j)
 C returning jth atom to box
-          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
-       if ((zj.gt.bordlipbot)
-     &.and.(zj.lt.bordliptop)) then
-C the energy transfer exist
-        if (zj.lt.buflipbot) then
-C what fraction I am in
-         fracinbuf=1.0d0-
-     &        ((zj-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-        elseif (zj.gt.bufliptop) then
-         fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
-         sslipj=sscalelip(fracinbuf)
-         ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-        else
-         sslipj=1.0d0
-         ssgradlipj=0.0
-        endif
-       else
-         sslipj=0.0d0
-         ssgradlipj=0.0
-       endif
-      aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-      bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
-     &  +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
-C       if (aa.ne.aa_aq(itypi,itypj)) then
-       
-C      write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
-C     & bb_aq(itypi,itypj)-bb,
-C     & sslipi,sslipj
-C         endif
-
-C        write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
-C checking the distance
-      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-C finding the closest
-      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-xi)**2+(yj-yi)**2+(zj-zi)**2
-          if(dist_temp.lt.dist_init) then
-            dist_init=dist_temp
-            xj_temp=xj
-            yj_temp=yj
-            zj_temp=zj
-            subchap=1
-          endif
-       enddo
-       enddo
-       enddo
-       if (subchap.eq.1) then
-          xj=xj_temp-xi
-          yj=yj_temp-yi
-          zj=zj_temp-zi
-       else
-          xj=xj_safe-xi
-          yj=yj_safe-yi
-          zj=zj_safe-zi
-       endif
-
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+c      write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj)
+c      if (aa.ne.aa_aq(itypi,itypj)) write(iout,'(2e15.5)')
+c     &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1347,8 +1281,8 @@ c#define DEBUG
 #endif
 c#undef DEBUG
 c            endif
-            if (energy_dec) write (iout,'(a,2i5,3f10.5)')
-     &                    'r sss evdw',i,j,1.0d0/rij,sss,evdwij
+            if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)')
+     &       'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij
             if (calc_grad) then
 C Calculate gradient components.
             e1=e1*eps1*eps2rt**2*eps3rt**2
@@ -1357,6 +1291,12 @@ C Calculate gradient components.
             fac=rij*fac
             fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
 C Calculate the radial part of the gradient
+            gg_lipi(3)=eps1*(eps2rt*eps2rt)
+     &        *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
+     &         (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &        +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
+            gg_lipj(3)=ssgradlipj*gg_lipi(3)
+            gg_lipi(3)=gg_lipi(3)*ssgradlipi
             gg(1)=xj*fac
             gg(2)=yj*fac
             gg(3)=zj*fac
@@ -1413,6 +1353,8 @@ c      if (icall.gt.0) lprn=.true.
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1447,9 +1389,21 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+            call to_box(xj,yj,zj)
+            call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+            aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+            bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+C      if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
+C     &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+C      write(iout,*) "tu,", i,j,aa,bb,aa_lip(itypi,itypj),sslipi,sslipj
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
@@ -1512,6 +1466,12 @@ C Calculate gradient components.
             fac=rij*fac-2*expon*rrij*e_augm
             fac=fac+(evdwij+e_augm)*sssgrad/sss*rij
 C Calculate the radial part of the gradient
+            gg_lipi(3)=eps1*(eps2rt*eps2rt)
+     &       *(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
+     &        (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &       +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
+            gg_lipj(3)=ssgradlipj*gg_lipi(3)
+            gg_lipi(3)=gg_lipi(3)*ssgradlipi
             gg(1)=xj*fac
             gg(2)=yj*fac
             gg(3)=zj*fac
@@ -2165,6 +2125,8 @@ C
       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
      &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
      &    num_conti,j1,j2
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj
+      common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj
 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
 #ifdef MOMENT
       double precision scal_el /1.0d0/
@@ -2271,12 +2233,8 @@ c        end if
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
         num_conti=0
         call eelecij(i,i+2,ees,evdw1,eel_loc)
         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
@@ -2306,37 +2264,8 @@ c     &    .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-C Return atom into box, boxxsize is size of box in x dimension
-c  194   continue
-c        if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((-0.5d0)*boxxsize))) then
-c        go to 194
-c        endif
-c  195   continue
-c        if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((-0.5d0)*boxysize))) then
-c        go to 195
-c        endif
-c  196   continue
-c        if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-C Condition for being inside the proper box
-c        if ((zmedi.gt.((0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((-0.5d0)*boxzsize))) then
-c        go to 196
-c        endif
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2344,6 +2273,7 @@ c        write(iout,*) "JESTEM W PETLI"
         call eelecij(i,i+3,ees,evdw1,eel_loc)
         if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) 
      &   call eturn4(i,eello_turn4)
+c        write (iout,*) "i",i," eello_turn4",eello_turn4
 #ifdef FOURBODY
         num_cont_hb(i)=num_conti
 #endif
@@ -2376,43 +2306,8 @@ c     &  .or. itype(i-1).eq.ntyp1
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
-          xmedi=mod(xmedi,boxxsize)
-          if (xmedi.lt.0) xmedi=xmedi+boxxsize
-          ymedi=mod(ymedi,boxysize)
-          if (ymedi.lt.0) ymedi=ymedi+boxysize
-          zmedi=mod(zmedi,boxzsize)
-          if (zmedi.lt.0) zmedi=zmedi+boxzsize
-C          xmedi=xmedi+xshift*boxxsize
-C          ymedi=ymedi+yshift*boxysize
-C          zmedi=zmedi+zshift*boxzsize
-
-C Return tom into box, boxxsize is size of box in x dimension
-c  164   continue
-c        if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
-c        if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
-C Condition for being inside the proper box
-c        if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
-c     &       (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
-c        go to 164
-c        endif
-c  165   continue
-c        if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
-c        if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
-C Condition for being inside the proper box
-c        if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
-c     &       (ymedi.lt.((yshift-0.5d0)*boxysize))) then
-c        go to 165
-c        endif
-c  166   continue
-c        if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
-c        if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
-cC Condition for being inside the proper box
-c        if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
-c     &       (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
-c        go to 166
-c        endif
-
-c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -2484,6 +2379,9 @@ C-------------------------------------------------------------------------------
       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
      &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
      &    num_conti,j1,j2
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij,
+     & faclipij2
+      common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
 #ifdef MOMENT
       double precision scal_el /1.0d0/
@@ -2518,73 +2416,13 @@ C          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
-          if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
-      dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      isubchap=0
-      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
-            isubchap=1
-          endif
-       enddo
-       enddo
-       enddo
-       if (isubchap.eq.1) then
-          xj=xj_temp-xmedi
-          yj=yj_temp-ymedi
-          zj=zj_temp-zmedi
-       else
-          xj=xj_safe-xmedi
-          yj=yj_safe-ymedi
-          zj=zj_safe-zmedi
-       endif
-C        if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
-c  174   continue
-c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
-c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
-C Condition for being inside the proper box
-c        if ((xj.gt.((0.5d0)*boxxsize)).or.
-c     &       (xj.lt.((-0.5d0)*boxxsize))) then
-c        go to 174
-c        endif
-c  175   continue
-c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
-c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
-C Condition for being inside the proper box
-c        if ((yj.gt.((0.5d0)*boxysize)).or.
-c     &       (yj.lt.((-0.5d0)*boxysize))) then
-c        go to 175
-c        endif
-c  176   continue
-c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
-c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
-C Condition for being inside the proper box
-c        if ((zj.gt.((0.5d0)*boxzsize)).or.
-c     &       (zj.lt.((-0.5d0)*boxzsize))) then
-c        go to 176
-c        endif
-C        endif !endPBC condintion
-C        xj=xj-xmedi
-C        yj=yj-ymedi
-C        zj=zj-zmedi
+          call to_box(xj,yj,zj)
+          call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+          faclipij=(sslipi+sslipj)/2.0d0*lipscale+1.0d0
+          faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
+          xj=boxshift(xj-xmedi,boxxsize)
+          yj=boxshift(yj-ymedi,boxysize)
+          zj=boxshift(zj-zmedi,boxzsize)
           rij=xj*xj+yj*yj+zj*zj
 
           sss=sscale(sqrt(rij))
@@ -2621,25 +2459,25 @@ C          fac_shield(j)=0.6
           el1=el1*fac_shield(i)**2*fac_shield(j)**2
           el2=el2*fac_shield(i)**2*fac_shield(j)**2
           eesij=(el1+el2)
-          ees=ees+eesij
+          ees=ees+eesij*sss*faclipij2
           else
           fac_shield(i)=1.0
           fac_shield(j)=1.0
           eesij=(el1+el2)
-          ees=ees+eesij
+          ees=ees+eesij*sss*faclipij2
           endif
-          evdw1=evdw1+evdwij*sss
+          evdw1=evdw1+evdwij*sss*faclipij2
 cd          write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
 cd     &      iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
 cd     &      1.0D0/dsqrt(rrmij),evdwij,eesij,
 cd     &      xmedi,ymedi,zmedi,xj,yj,zj
 
           if (energy_dec) then 
-              write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') 
-     &'evdw1',i,j,evdwij
-     &,iteli,itelj,aaa,evdw1,sss
-              write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij,
-     &fac_shield(i),fac_shield(j)
+            write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') 
+     &'       evdw1',i,j,evdwij,iteli,itelj,aaa,evdw1,sss
+            write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
+     &        fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,
+     &        faclipij2
           endif
 
 C
@@ -2657,9 +2495,10 @@ C
 * Radial derivatives. First process both termini of the fragment (i,j)
 *
           if (calc_grad) then
-          ggg(1)=facel*xj
-          ggg(2)=facel*yj
-          ggg(3)=facel*zj
+          aux=(facel*sss+rmij*sssgrad*eesij)*faclipij2
+          ggg(1)=aux*xj
+          ggg(2)=aux*yj
+          ggg(3)=aux*zj
           if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
      &  (shield_mode.gt.0)) then
 C          print *,i,j     
@@ -2745,6 +2584,11 @@ C            gelc_long(k,i-1)=gelc_long(k,i-1)
 C     &                    +grad_shield(k,i)*eesij/fac_shield(i)
 C            gelc_long(k,j-1)=gelc_long(k,j-1)
 C     &                    +grad_shield(k,j)*eesij/fac_shield(j)
+          gelc_long(3,j)=gelc_long(3,j)+
+     &      ssgradlipj*eesij/2.0d0*lipscale**2*sss
+
+          gelc_long(3,i)=gelc_long(3,i)+
+     &      ssgradlipi*eesij/2.0d0*lipscale**2*sss
           enddo
 C           print *,"bafter", gelc_long(1,i), gelc_long(1,j)
 
@@ -2757,7 +2601,7 @@ cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
 cgrad            enddo
 cgrad          enddo
           if (sss.gt.0.0) then
-          facvdw=facvdw+sssgrad*rmij*evdwij
+          facvdw=(facvdw+sssgrad*rmij*evdwij)*faclipij2
           ggg(1)=facvdw*xj
           ggg(2)=facvdw*yj
           ggg(3)=facvdw*zj
@@ -2776,6 +2620,11 @@ c 9/28/08 AL Gradient compotents will be summed only at the end
             gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
             gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
           enddo
+!C Lipidic part for scaling weight
+          gvdwpp(3,j)=gvdwpp(3,j)+
+     &      sss*ssgradlipj*evdwij/2.0d0*lipscale**2
+          gvdwpp(3,i)=gvdwpp(3,i)+
+     &      sss*ssgradlipi*evdwij/2.0d0*lipscale**2
 *
 * Loop over residues i+1 thru j-1.
 *
@@ -2787,7 +2636,7 @@ cgrad          enddo
           endif ! calc_grad
 #else
 C MARYSIA
-          facvdw=(ev1+evdwij)
+          facvdw=(ev1+evdwij)*faclipij2
           facel=(el1+eesij)
           fac1=fac
           fac=-3*rrmij*(facvdw+facvdw+facel)*sss
@@ -2831,6 +2680,10 @@ c 9/28/08 AL Gradient compotents will be summed only at the end
             gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
             gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
           enddo
+          gvdwpp(3,j)=gvdwpp(3,j)+
+     &      sss*ssgradlipj*evdwij/2.0d0*lipscale**2
+          gvdwpp(3,i)=gvdwpp(3,i)+
+     &      sss*ssgradlipi*evdwij/2.0d0*lipscale**2
           endif ! calc_grad
 #endif
 *
@@ -2850,7 +2703,7 @@ cd        print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
 cd   &          (dcosg(k),k=1,3)
           do k=1,3
             ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*
-     &      fac_shield(i)**2*fac_shield(j)**2
+     &      fac_shield(i)**2*fac_shield(j)**2*sss*faclipij2
           enddo
 c          do k=1,3
 c            ghalf=0.5D0*ggg(k)
@@ -2871,11 +2724,11 @@ C                     print *,"before22", gelc_long(1,i), gelc_long(1,j)
             gelc(k,i)=gelc(k,i)
      &           +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
      &           + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1))
-     &           *fac_shield(i)**2*fac_shield(j)**2   
+     &           *fac_shield(i)**2*fac_shield(j)**2*faclipij2
             gelc(k,j)=gelc(k,j)
      &           +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
      &           + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1))
-     &           *fac_shield(i)**2*fac_shield(j)**2
+     &           *fac_shield(i)**2*fac_shield(j)**2*faclipij2
             gelc_long(k,j)=gelc_long(k,j)+ggg(k)
             gelc_long(k,i)=gelc_long(k,i)-ggg(k)
           enddo
@@ -3107,7 +2960,7 @@ C           fac_shield(i)=0.4
 C           fac_shield(j)=0.6
           endif
           eel_loc_ij=eel_loc_ij
-     &    *fac_shield(i)*fac_shield(j)*sss
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
           if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
      &            'eelloc',i,j,eel_loc_ij
 c           if (eel_loc_ij.ne.0)
@@ -3171,7 +3024,7 @@ C Calculate patrial derivative for theta angle
      &     +a23*gmuij1(2)
      &     +a32*gmuij1(3)
      &     +a33*gmuij1(4))
-     &    *fac_shield(i)*fac_shield(j)*sss
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 c         write(iout,*) "derivative over thatai"
 c         write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
 c     &   a33*gmuij1(4) 
@@ -3187,7 +3040,7 @@ c     &   a33*gmuij2(4)
      &     +a33*gmuij2(4)
          gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
      &      geel_loc_ij*wel_loc
-     &    *fac_shield(i)*fac_shield(j)*sss
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
 c  Derivative over j residue
          geel_loc_ji=a22*gmuji1(1)
@@ -3200,7 +3053,7 @@ c     &   a33*gmuji1(4)
 
         gloc(nphi+j,icg)=gloc(nphi+j,icg)+
      &      geel_loc_ji*wel_loc
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
          geel_loc_ji=
      &     +a22*gmuji2(1)
@@ -3212,7 +3065,7 @@ c         write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
 c     &   a33*gmuji2(4)
          gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
      &      geel_loc_ji*wel_loc
-     &    *fac_shield(i)*fac_shield(j)*sss
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 #endif
 cd          write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
 
@@ -3221,12 +3074,12 @@ C Partial derivatives in virtual-bond dihedral angles gamma
      &    gel_loc_loc(i-1)=gel_loc_loc(i-1)+ 
      &            (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
      &           +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
           gel_loc_loc(j-1)=gel_loc_loc(j-1)+ 
      &           (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
      &           +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
           aux=eel_loc_ij/sss*sssgrad*rmij
           ggg(1)=aux*xj
@@ -3235,13 +3088,18 @@ C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
           do l=1,3
             ggg(l)=ggg(l)+(agg(l,1)*muij(1)+
      &          agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
-     &    *fac_shield(i)*fac_shield(j)*sss
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
             gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
             gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
 cgrad            ghalf=0.5d0*ggg(l)
 cgrad            gel_loc(l,i)=gel_loc(l,i)+ghalf
 cgrad            gel_loc(l,j)=gel_loc(l,j)+ghalf
           enddo
+          gel_loc_long(3,j)=gel_loc_long(3,j)+
+     &      ssgradlipj*eel_loc_ij/2.0d0*lipscale/faclipij
+
+          gel_loc_long(3,i)=gel_loc_long(3,i)+
+     &      ssgradlipi*eel_loc_ij/2.0d0*lipscale/faclipij
 cgrad          do k=i+1,j2
 cgrad            do l=1,3
 cgrad              gel_loc(l,k)=gel_loc(l,k)+ggg(l)
@@ -3251,19 +3109,19 @@ C Remaining derivatives of eello
           do l=1,3
             gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
      &        aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
             gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
      &     aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
             gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
      &       aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
             gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
      &     aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
-     &    *fac_shield(i)*fac_shield(j)
+     &    *fac_shield(i)*fac_shield(j)*sss*faclipij
 
           enddo
           endif ! calc_grad
@@ -3531,6 +3389,8 @@ C Third- and fourth-order contributions from turns
       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
      &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
      &    num_conti,j1,j2
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
+      common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
       j=i+2
 c      write (iout,*) "eturn3",i,j,j1,j2
       a_temp(1,1)=a22
@@ -3568,7 +3428,7 @@ C        fac_shield(i)=0.4
 C        fac_shield(j)=0.6
         endif
         eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
         eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
      &  *fac_shield(i)*fac_shield(j)
         if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2,
@@ -3578,10 +3438,10 @@ C#ifdef NEWCORR
 C Derivatives in theta
         gloc(nphi+i,icg)=gloc(nphi+i,icg)
      &  +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
         gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
      &  +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
 C#endif
 
 C Derivatives in shield mode
@@ -3636,14 +3496,14 @@ C Derivatives in gamma(i)
         call transpose2(auxmat2(1,1),auxmat3(1,1))
         call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
         gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
 C Derivatives in gamma(i+1)
         call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
         call transpose2(auxmat2(1,1),auxmat3(1,1))
         call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
         gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
      &    +0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
 C Cartesian derivatives
         do l=1,3
 c            ghalf1=0.5d0*agg(l,1)
@@ -3657,7 +3517,7 @@ c            ghalf4=0.5d0*agg(l,4)
           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
           gcorr3_turn(l,i)=gcorr3_turn(l,i)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
 
           a_temp(1,1)=aggi1(l,1)!+agg(l,1)
           a_temp(1,2)=aggi1(l,2)!+agg(l,2)
@@ -3666,7 +3526,7 @@ c            ghalf4=0.5d0*agg(l,4)
           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
           gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
           a_temp(1,1)=aggj(l,1)!+ghalf1
           a_temp(1,2)=aggj(l,2)!+ghalf2
           a_temp(2,1)=aggj(l,3)!+ghalf3
@@ -3674,7 +3534,7 @@ c            ghalf4=0.5d0*agg(l,4)
           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
           gcorr3_turn(l,j)=gcorr3_turn(l,j)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
           a_temp(1,1)=aggj1(l,1)
           a_temp(1,2)=aggj1(l,2)
           a_temp(2,1)=aggj1(l,3)
@@ -3682,7 +3542,7 @@ c            ghalf4=0.5d0*agg(l,4)
           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
           gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
-     &   *fac_shield(i)*fac_shield(j)
+     &   *fac_shield(i)*fac_shield(j)*faclipij
         enddo
 
         endif ! calc_grad
@@ -3722,6 +3582,8 @@ C Third- and fourth-order contributions from turns
       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
      &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
      &    num_conti,j1,j2
+      double precision sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
+      common /lipcalc/ sslipi,sslipj,ssgradlipi,ssgradlipj,faclipij
       j=i+3
 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 C
@@ -3817,7 +3679,7 @@ C        fac_shield(i)=0.6
 C        fac_shield(j)=0.4
         endif
         eello_turn4=eello_turn4-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
         eello_t4=-(s1+s2+s3)
      &  *fac_shield(i)*fac_shield(j)
 c             write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
@@ -3894,7 +3756,7 @@ C Derivatives in gamma(i)
         call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
         s3=0.5d0*(pizda(1,1)+pizda(2,2))
         gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
 C Derivatives in gamma(i+1)
         call transpose2(EUgder(1,1,i+2),e2tder(1,1))
         call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) 
@@ -3903,7 +3765,7 @@ C Derivatives in gamma(i+1)
         call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
         s3=0.5d0*(pizda(1,1)+pizda(2,2))
         gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
 C Derivatives in gamma(i+2)
         call transpose2(EUgder(1,1,i+3),e3tder(1,1))
         call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
@@ -3915,7 +3777,7 @@ C Derivatives in gamma(i+2)
         call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
         s3=0.5d0*(pizda(1,1)+pizda(2,2))
         gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
         if (calc_grad) then
 C Cartesian derivatives
 C Derivatives of this turn contributions in DC(i+2)
@@ -3936,7 +3798,7 @@ C Derivatives of this turn contributions in DC(i+2)
             s3=0.5d0*(pizda(1,1)+pizda(2,2))
             ggg(l)=-(s1+s2+s3)
             gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
           enddo
         endif
 C Remaining derivatives of this turn contribution
@@ -3955,7 +3817,7 @@ C Remaining derivatives of this turn contribution
           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
           s3=0.5d0*(pizda(1,1)+pizda(2,2))
           gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
           a_temp(1,1)=aggi1(l,1)
           a_temp(1,2)=aggi1(l,2)
           a_temp(2,1)=aggi1(l,3)
@@ -3970,7 +3832,7 @@ C Remaining derivatives of this turn contribution
           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
           s3=0.5d0*(pizda(1,1)+pizda(2,2))
           gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
           a_temp(1,1)=aggj(l,1)
           a_temp(1,2)=aggj(l,2)
           a_temp(2,1)=aggj(l,3)
@@ -3985,7 +3847,7 @@ C Remaining derivatives of this turn contribution
           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
           s3=0.5d0*(pizda(1,1)+pizda(2,2))
           gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
           a_temp(1,1)=aggj1(l,1)
           a_temp(1,2)=aggj1(l,2)
           a_temp(2,1)=aggj1(l,3)
@@ -4001,7 +3863,7 @@ C Remaining derivatives of this turn contribution
           s3=0.5d0*(pizda(1,1)+pizda(2,2))
 c          write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
           gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
-     &  *fac_shield(i)*fac_shield(j)
+     &  *fac_shield(i)*fac_shield(j)*faclipij
         enddo
 
         endif ! calc_grad
@@ -4075,13 +3937,7 @@ c     &   " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
         xi=0.5D0*(c(1,i)+c(1,i+1))
         yi=0.5D0*(c(2,i)+c(2,i+1))
         zi=0.5D0*(c(3,i)+c(3,i+1))
-C Returning the ith atom to box
-          xi=mod(xi,boxxsize)
-          if (xi.lt.0) xi=xi+boxxsize
-          yi=mod(yi,boxysize)
-          if (yi.lt.0) yi=yi+boxysize
-          zi=mod(zi,boxzsize)
-          if (zi.lt.0) zi=zi+boxzsize
+        call to_box(xi,yi,zi)
         do iint=1,nscp_gr(i)
 
         do j=iscpstart(i,iint),iscpend(i,iint)
@@ -4096,44 +3952,10 @@ C Uncomment following three lines for Ca-p interactions
           yj=c(2,j)
           zj=c(3,j)
 C returning the jth atom to box
-          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-xi)**2+(yj-yi)**2+(zj-zi)**2
-      xj_safe=xj
-      yj_safe=yj
-      zj_safe=zj
-      subchap=0
-C Finding the closest jth atom
-      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-xi)**2+(yj-yi)**2+(zj-zi)**2
-          if(dist_temp.lt.dist_init) then
-            dist_init=dist_temp
-            xj_temp=xj
-            yj_temp=yj
-            zj_temp=zj
-            subchap=1
-          endif
-       enddo
-       enddo
-       enddo
-       if (subchap.eq.1) then
-          xj=xj_temp-xi
-          yj=yj_temp-yi
-          zj=zj_temp-zi
-       else
-          xj=xj_safe-xi
-          yj=yj_safe-yi
-          zj=zj_safe-zi
-       endif
+          call to_box(xj,yj,zj)
+          xj=boxshift(xj-xi,boxxsize)
+          yj=boxshift(yj-yi,boxysize)
+          zj=boxshift(zj-zi,boxzsize)
           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
 C sss is scaling function for smoothing the cutoff gradient otherwise
 C the gradient would not be continuouse
          enddo
          
 c         min_odl=minval(distancek)
-         do kk=1,constr_homology
-          if(l_homo(kk,ii)) then 
-            min_odl=distancek(kk)
-            exit
-          endif
-         enddo
-         do kk=1,constr_homology
-          if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl) 
+         if (nexl.gt.0) then
+           min_odl=0.0d0
+         else
+           do kk=1,constr_homology
+            if(l_homo(kk,ii)) then
+              min_odl=distancek(kk)
+              exit
+            endif
+           enddo
+           do kk=1,constr_homology
+            if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl)
      &              min_odl=distancek(kk)
-         enddo
+           enddo
+         endif
 c        write (iout,* )"min_odl",min_odl
 #ifdef DEBUG
          write (iout,*) "ij dij",i,j,dij
@@ -9717,6 +9543,8 @@ C--bufliptop--- here true lipid starts
 C      lipid
 C--buflipbot--- lipid ends buffore starts
 C--bordlipbot--buffore ends
+c      call cartprint
+c      write (iout,*) "Eliptransfer peplipran",pepliptran
       eliptran=0.0
       do i=1,nres
 C       do i=1,1
@@ -9768,6 +9596,8 @@ CV       do i=1,1
         if (itype(i).eq.ntyp1) cycle
         positi=(mod(c(3,i+nres),boxzsize))
         if (positi.le.0) positi=positi+boxzsize
+c        write(iout,*) "i",i," positi",positi,bordlipbot,buflipbot,
+c     &   bordliptop
 C       print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
 c for each residue check if it is in lipid or lipid water border area
 C       respos=mod(c(3,i+nres),boxzsize)
@@ -9778,8 +9608,11 @@ C the energy transfer exist
         if (positi.lt.buflipbot) then
          fracinbuf=1.0d0-
      &     ((positi-bordlipbot)/lipbufthick)
+c         write (iout,*) "i",i,itype(i)," fracinbuf",fracinbuf
+c         write (iout,*) "i",i," liptranene",liptranene(itype(i))
 C lipbufthick is thickenes of lipid buffore
          sslip=sscalelip(fracinbuf)
+c         write (iout,*) "sslip",sslip
          ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
          eliptran=eliptran+sslip*liptranene(itype(i))
          gliptranx(3,i)=gliptranx(3,i)
@@ -9805,6 +9638,7 @@ C         print *,"I am in true lipid"
         endif ! if in lipid or buffor
 C       else
 C       eliptran=elpitran+0.0 ! I am in water
+c        write (iout,*) "eliptran",eliptran
        enddo
        return
        end