DFA & lipid
[unres.git] / source / unres / src-HCD-5D / energy_p_new-sep_barrier.F
index c6c6832..c4e54bc 100644 (file)
@@ -84,9 +84,15 @@ c      include 'COMMON.CONTACTS'
       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
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision boxshift
+      double precision gg_lipi(3),gg_lipj(3)
 c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c      do i=iatsc_s,iatsc_e
       do ikont=g_listscsc_start,g_listscsc_end
         i=newcontlisti(ikont)
@@ -97,6 +103,8 @@ c      do i=iatsc_s,iatsc_e
         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)
 C
 C Calculate SC interaction energy.
 C
@@ -106,9 +114,18 @@ cd   &                  'iend=',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
-            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
+            xj=boxshift(xj-xi,boxxsize)
+            yj=boxshift(yj-yi,boxysize)
+            zj=boxshift(zj-zi,boxzsize)
             rij=xj*xj+yj*yj+zj*zj
             sqrij=dsqrt(rrij)
             eps0ij=eps(itypi,itypj)
@@ -121,6 +138,7 @@ c          do j=istart(i,iint),iend(i,iint)
             if (sss.lt.1.0d0) then
               rrij=1.0D0/rij
               fac=rrij**expon2
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=e1+e2
@@ -134,11 +152,16 @@ C
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=(sss1*(1.0d0-sss)/2.0d0*(faclip*faclip*
+     &           (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &          +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon
+              gg_lipj(3)=ssgradlipj*gg_lipi(3)
+              gg_lipi(3)=gg_lipi(3)*ssgradlipi
               do k=1,3
-                gvdwx(k,i)=gvdwx(k,i)-gg(k)
-                gvdwx(k,j)=gvdwx(k,j)+gg(k)
-                gvdwc(k,i)=gvdwc(k,i)-gg(k)
-                gvdwc(k,j)=gvdwc(k,j)+gg(k)
+                gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
+                gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
+                gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k)
+                gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k)
               enddo
             endif
 c          enddo      ! j
@@ -186,9 +209,15 @@ c      include 'COMMON.CONTACTS'
       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
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision boxshift
+      double precision gg_lipi(3),gg_lipj(3)
 c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c      do i=iatsc_s,iatsc_e
       do ikont=g_listscsc_start,g_listscsc_end
         i=newcontlisti(ikont)
@@ -199,6 +228,8 @@ c      do i=iatsc_s,iatsc_e
         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)
 C Change 12/1/95
         num_conti=0
 C
@@ -210,9 +241,18 @@ cd   &                  'iend=',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
-            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
+            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
             sqrij=dsqrt(rij)
@@ -223,6 +263,7 @@ C Change 12/1/95 to calculate four-body interactions
               rrij=1.0D0/rij
               eps0ij=eps(itypi,itypj)
               fac=rrij**expon2
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=e1+e2
@@ -234,11 +275,16 @@ C
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=(sss/2.0d0*(faclip*faclip*
+     &           (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &          +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon
+              gg_lipj(3)=ssgradlipj*gg_lipi(3)
+              gg_lipi(3)=gg_lipi(3)*ssgradlipi
               do k=1,3
-                gvdwx(k,i)=gvdwx(k,i)-gg(k)
-                gvdwx(k,j)=gvdwx(k,j)+gg(k)
-                gvdwc(k,i)=gvdwc(k,i)-gg(k)
-                gvdwc(k,j)=gvdwc(k,j)+gg(k)
+                gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
+                gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
+                gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k)
+                gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k)
               enddo
             endif
 c          enddo      ! j
@@ -284,9 +330,15 @@ C
       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
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision boxshift
+      double precision gg_lipi(3),gg_lipj(3)
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c      do i=iatsc_s,iatsc_e
       do ikont=g_listscsc_start,g_listscsc_end
         i=newcontlisti(ikont)
@@ -297,6 +349,8 @@ c      do i=iatsc_s,iatsc_e
         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)
 C
 C Calculate SC interaction energy.
 C
@@ -304,9 +358,18 @@ 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
-            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
+            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
@@ -321,6 +384,7 @@ c          do j=istart(i,iint),iend(i,iint)
      &          sscagrad(rij/sigma(itypi,itypj),r_cut_respa)
               r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
               fac=r_shift_inv**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=e_augm+e1+e2
@@ -342,11 +406,16 @@ C
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=(sss1*(1.0d0-sss)/2.0d0*(faclip*faclip*
+     &           (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &          +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon
+              gg_lipj(3)=ssgradlipj*gg_lipi(3)
+              gg_lipi(3)=gg_lipi(3)*ssgradlipi
               do k=1,3
-                gvdwx(k,i)=gvdwx(k,i)-gg(k)
-                gvdwx(k,j)=gvdwx(k,j)+gg(k)
-                gvdwc(k,i)=gvdwc(k,i)-gg(k)
-                gvdwc(k,j)=gvdwc(k,j)+gg(k)
+                gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
+                gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
+                gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k)
+                gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k)
               enddo
             endif
 c          enddo      ! j
@@ -383,9 +452,15 @@ C
       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
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision boxshift
+      double precision gg_lipi(3),gg_lipj(3)
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c      do i=iatsc_s,iatsc_e
       do ikont=g_listscsc_start,g_listscsc_end
         i=newcontlisti(ikont)
@@ -396,6 +471,8 @@ c      do i=iatsc_s,iatsc_e
         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)
 C
 C Calculate SC interaction energy.
 C
@@ -403,9 +480,18 @@ 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
-            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
+            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
@@ -415,6 +501,7 @@ c          do j=istart(i,iint),iend(i,iint)
             if (sss.gt.0.0d0) then
               r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
               fac=r_shift_inv**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=e_augm+e1+e2
@@ -435,11 +522,16 @@ C
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=(sss/2.0d0*(faclip*faclip*
+     &           (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &          +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon
+              gg_lipj(3)=ssgradlipj*gg_lipi(3)
+              gg_lipi(3)=gg_lipi(3)*ssgradlipi
               do k=1,3
-                gvdwx(k,i)=gvdwx(k,i)-gg(k)
-                gvdwx(k,j)=gvdwx(k,j)+gg(k)
-                gvdwc(k,i)=gvdwc(k,i)-gg(k)
-                gvdwc(k,j)=gvdwc(k,j)+gg(k)
+                gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
+                gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
+                gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k)
+                gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k)
               enddo
             endif
 c          enddo      ! j
@@ -477,12 +569,16 @@ C
       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
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision boxshift
 c     double precision rrsave(maxdim)
       logical lprn
       evdw=0.0D0
 c     print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c     if (icall.eq.0) then
 c       lprn=.true.
 c     else
@@ -499,6 +595,8 @@ c      do i=iatsc_s,iatsc_e
         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)
@@ -523,9 +621,18 @@ c            dscj_inv=dsc_inv(itypj)
             alf1=alp(itypi)
             alf2=alp(itypj)
             alf12=0.5D0*(alf1+alf2)
-            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
+            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)
@@ -543,6 +650,7 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives.
 C Calculate whole angle-dependent part of epsilon and contributions
 C to its derivatives
               fac=(rrij*sigsq)**expon2
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -570,6 +678,12 @@ C Calculate radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=eps1*(eps2rt*eps2rt)
+     &          *(eps3rt*eps3rt)*sss1*(1.0d0-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
 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)
@@ -603,12 +717,16 @@ C
       double precision evdw
       integer itypi,itypj,itypi1,iint,ind,ikont
       double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi
-      double precision sscale,sscagrad
+      double precision sscale,sscagrad,sscagradlip,sscalelip
+      double precision fracinbuf,sslipi,sslipj,ssgradlipj,ssgradlipi,
+     & faclip
+      double precision boxshift
 c     double precision rrsave(maxdim)
       logical lprn
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c     print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
 c     if (icall.eq.0) then
 c       lprn=.true.
 c     else
@@ -625,6 +743,8 @@ c      do i=iatsc_s,iatsc_e
         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)
@@ -649,9 +769,18 @@ c            dscj_inv=dsc_inv(itypj)
             alf1=alp(itypi)
             alf2=alp(itypj)
             alf12=0.5D0*(alf1+alf2)
-            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
+            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)
@@ -666,6 +795,7 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives.
 C Calculate whole angle-dependent part of epsilon and contributions
 C to its derivatives
               fac=(rrij*sigsq)**expon2
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -692,6 +822,17 @@ C Calculate radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=(sss/2.0d0*(faclip*faclip*
+     &           (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
+     &          +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))))/expon
+              gg_lipj(3)=ssgradlipj*gg_lipi(3)
+              gg_lipi(3)=gg_lipi(3)*ssgradlipi
+              do k=1,3
+                gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
+                gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
+                gvdwc(k,i)=gvdwc(k,i)-gg(k)+gg_lipi(k)
+                gvdwc(k,j)=gvdwc(k,j)+gg(k)+gg_lipj(k)
+              enddo
 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)
@@ -731,10 +872,12 @@ C
      & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
       double precision dist,sscale,sscagrad,sscagradlip,sscalelip
       double precision subchap,sss1,sssgrad1
+      double precision boxshift
       evdw=0.0D0
 ccccc      energy_dec=.false.
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
       lprn=.false.
 c     if (icall.eq.0) lprn=.false.
       ind=0
@@ -748,12 +891,8 @@ c      do i=iatsc_s,iatsc_e
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
-          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)
+        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)
@@ -787,79 +926,27 @@ c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
             xj=c(1,nres+j)
             yj=c(2,nres+j)
             zj=c(3,nres+j)
-            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-((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-                sslipj=sscalelip(fracinbuf)
-                ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-              else if (zi.gt.bufliptop) then
-                fracinbuf=1.0d0-((bordliptop-zi)/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
-           dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-           xj_safe=xj
-           yj_safe=yj
-           zj_safe=zj
-           subchap=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-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
-           dxj=dc_norm(1,nres+j)
-           dyj=dc_norm(2,nres+j)
-           dzj=dc_norm(3,nres+j)
-           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-           rij=dsqrt(rrij)
-           sss1=sscale(1.0d0/rij,r_cut_int)
-           if (sss1.eq.0.0d0) cycle
-           sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
-           if (sss.lt.1.0d0) then
+            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
+            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)
+            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+            rij=dsqrt(rrij)
+            sss1=sscale(1.0d0/rij,r_cut_int)
+            if (sss1.eq.0.0d0) cycle
+            sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)),r_cut_respa)
+            if (sss.lt.1.0d0) then
 C Calculate angle-dependent terms of energy and contributions to their
 C derivatives.
-             sssgrad=
+              sssgrad=
      &         sscagrad((1.0d0/rij)/sigmaii(itypi,itypj),r_cut_respa)
               sssgrad1=sscagrad(1.0d0/rij,r_cut_int)
               call sc_angular
@@ -880,6 +967,7 @@ cd     &          rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
 c---------------------------------------------------------------
               rij_shift=1.0D0/rij_shift 
               fac=rij_shift**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -900,8 +988,8 @@ c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
      &          evdwij
               endif
 
-              if (energy_dec) write (iout,'(a6,2i5,4f10.5)') 
-     &                        'evdw',i,j,rij,sss,sss1,evdwij
+              if (energy_dec) write (iout,'(a,2i5,5f10.5,e15.5)')
+     &          'r sss evdw',i,j,1.0d0/rij,sss1,sss,sslipi,sslipj,evdwij
 
 C Calculate gradient components.
               e1=e1*eps1*eps2rt**2*eps3rt**2
@@ -914,8 +1002,13 @@ C Calculate the radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
-              gg_lipi(3)=ssgradlipi*evdwij
-              gg_lipj(3)=ssgradlipj*evdwij
+              gg_lipi(3)=eps1*(eps2rt*eps2rt)
+     &          *(eps3rt*eps3rt)*sss1*(1.0d0-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
+
 C Calculate angular part of the gradient.
               call sc_grad_scale((1.0d0-sss)*sss1)
             endif
@@ -946,19 +1039,18 @@ C
       include 'COMMON.CONTROL'
       include "COMMON.SPLITELE"
       logical lprn
-      integer xshift,yshift,zshift
       double precision evdw
       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,
-     & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
+     & sslipj,ssgradlipj,ssgradlipi,sig,rij_shift,faclip
       double precision dist,sscale,sscagrad,sscagradlip,sscalelip
-      double precision subchap
+      double precision boxshift
       evdw=0.0D0
 ccccc      energy_dec=.false.
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
+      gg_lipi=0.0D0
+      gg_lipj=0.0d0
       lprn=.false.
 c     if (icall.eq.0) lprn=.false.
       ind=0
@@ -972,12 +1064,8 @@ c      do i=iatsc_s,iatsc_e
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
-          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)
+        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)
@@ -1011,67 +1099,20 @@ c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
             xj=c(1,nres+j)
             yj=c(2,nres+j)
             zj=c(3,nres+j)
-            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-((zi-bordlipbot)/lipbufthick)
-C lipbufthick is thickenes of lipid buffore
-                sslipj=sscalelip(fracinbuf)
-                ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
-              elseif (zi.gt.bufliptop) then
-                fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
-                sslipj=sscalelip(fracinbuf)
-                ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
-              else
-                sslipj=1.0d0
-                ssgradlipj=0.0
-              endif
-            else
-              sslipj=0.0d0
-              ssgradlipj=0.0
-            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
+     &        +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
-            dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-            xj_safe=xj
-            yj_safe=yj
-            zj_safe=zj
-            subchap=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-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
+     &        +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
+c            write (iout,*) "aa bb",aa_lip(itypi,itypj),
+c     &       bb_lip(itypi,itypj),aa_aq(itypi,itypj),
+c     &       bb_aq(itypi,itypj),aa,bb
+c            write (iout,*) (sslipi+sslipj)/2.0d0,
+c     &        (2.0d0-sslipi-sslipj)/2.0d0
+            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)
@@ -1101,6 +1142,7 @@ cd     &          rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
 c---------------------------------------------------------------
               rij_shift=1.0D0/rij_shift 
               fac=rij_shift**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -1121,8 +1163,8 @@ c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
      &          evdwij
               endif
 
-              if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') 
-     &                        'evdw',i,j,evdwij
+              if (energy_dec) write (iout,'(a,2i5,4f10.5,e15.5)')
+     &          'r sss evdw',i,j,1.0d0/rij,sss,sslipi,sslipj,evdwij
 
 C Calculate gradient components.
               e1=e1*eps1*eps2rt**2*eps3rt**2
@@ -1134,8 +1176,13 @@ C Calculate the radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
-              gg_lipi(3)=ssgradlipi*evdwij
-              gg_lipj(3)=ssgradlipj*evdwij
+              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
+c              write (iout,*) "gglip",i,j,gg_lipi,gg_lipj
 C Calculate angular part of the gradient.
               call sc_grad_scale(sss)
             endif
@@ -1176,8 +1223,9 @@ C
       double precision dist,sscale,sscagrad,sscagradlip,sscalelip
       double precision sss1,sssgrad1
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
       lprn=.false.
 c     if (icall.eq.0) lprn=.true.
       ind=0
@@ -1191,6 +1239,8 @@ c      do i=iatsc_s,iatsc_e
         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)
@@ -1217,9 +1267,18 @@ c            dscj_inv=dsc_inv(itypj)
             alf1=alp(itypi)
             alf2=alp(itypj)
             alf12=0.5D0*(alf1+alf2)
-            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
+            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)
@@ -1249,6 +1308,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!!
 c---------------------------------------------------------------
               rij_shift=1.0D0/rij_shift 
               fac=rij_shift**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -1281,6 +1341,12 @@ C Calculate the radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              gg_lipi(3)=eps1*(eps2rt*eps2rt)
+     &          *(eps3rt*eps3rt)*sss1*(1.0d0-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
 C Calculate angular part of the gradient.
               call sc_grad_scale((1.0d0-sss)*sss1)
             endif
@@ -1317,9 +1383,11 @@ C
      & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe,
      & xj_temp,yj_temp,zj_temp,dist_temp,sig,rij_shift,faclip
       double precision dist,sscale,sscagrad,sscagradlip,sscalelip
+      double precision boxshift
       evdw=0.0D0
+      gg_lipi=0.0d0
+      gg_lipj=0.0d0
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-      evdw=0.0D0
       lprn=.false.
 c     if (icall.eq.0) lprn=.true.
       ind=0
@@ -1336,6 +1404,8 @@ c      do i=iatsc_s,iatsc_e
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
+        call to_box(xi,yi,zi)
+        call lipid_layer(xi,yi,zi,sslipi,ssgradlipi)
 c        dsci_inv=dsc_inv(itypi)
         dsci_inv=vbld_inv(i+nres)
 C
@@ -1359,9 +1429,18 @@ c            dscj_inv=dsc_inv(itypj)
             alf1=alp(itypi)
             alf2=alp(itypj)
             alf12=0.5D0*(alf1+alf2)
-            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
+            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)
@@ -1387,6 +1466,7 @@ C I hate to put IF's in the loops, but here don't have another choice!!!!
 c---------------------------------------------------------------
               rij_shift=1.0D0/rij_shift 
               fac=rij_shift**expon
+              faclip=fac
               e1=fac*fac*aa
               e2=fac*bb
               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
@@ -1417,6 +1497,12 @@ C Calculate the radial part of the gradient
               gg(1)=xj*fac
               gg(2)=yj*fac
               gg(3)=zj*fac
+              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
 C Calculate angular part of the gradient.
               call sc_grad_scale(sss)
             endif
@@ -1471,6 +1557,7 @@ c     &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
 C 
 C Calculate the components of the gradient in DC and X
 C
+c      write (iout,*) "scgrad gglip",i,j,gg_lipi,gg_lipj
       do l=1,3
         gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
         gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
@@ -1519,6 +1606,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/
@@ -1612,12 +1701,8 @@ C     &  .or. itype(i+4).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
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
         num_conti=0
         call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
@@ -1641,12 +1726,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
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
 #endif
@@ -1677,12 +1758,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
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
 c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend
 #ifdef FOURBODY
         num_conti=num_cont_hb(i)
@@ -1764,7 +1841,10 @@ C-------------------------------------------------------------------------------
       double precision sss1,sssgrad1
       double precision sscale,sscagrad
       double precision scalar
-
+      double precision boxshift
+      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/
@@ -1796,44 +1876,13 @@ C      print *,"WCHODZE2"
       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
-      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
-
+      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
       rrmij=1.0D0/rij
       rij=dsqrt(rij)
@@ -1868,17 +1917,18 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
       eesij=el1+el2
 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
       ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
-      ees=ees+eesij*sss1
-      evdw1=evdw1+evdwij*(1.0d0-sss)*sss1
+      ees=ees+eesij*sss1*faclipij2
+      evdw1=evdw1+evdwij*(1.0d0-sss)*sss1*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,2f7.3)')
-     &              'evdw1',i,j,evdwij,sss,sss1
-          write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
+        write (iout,'(a6,2i5,0pf7.3,2i5,e11.3,5f10.5)')
+     &  'evdw1',i,j,evdwij,iteli,itelj,aaa,sss,sss1,sssgrad,sssgrad1,rij
+        write (iout,'(a6,2i5,0pf7.3,6f8.5)') 'ees',i,j,eesij,
+     &  fac_shield(i),fac_shield(j),sslipi,sslipj,faclipij,faclipij2
       endif
 
 C
@@ -1896,7 +1946,8 @@ c     &  *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 *
 * Radial derivatives. First process both termini of the fragment (i,j)
 *
-      aux=facel+sssgrad1*(1.0d0-sss)*eesij*rmij
+c old      aux=(facel+sssgrad1*(1.0d0-sss)*eesij*rmij)*faclipij2
+      aux=(facel+sssgrad1*eesij*rmij)*faclipij2
 c     & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
       ggg(1)=aux*xj
       ggg(2)=aux*yj
@@ -1969,6 +2020,10 @@ c 9/28/08 AL Gradient compotents will be summed only at the end
         gelc_long(k,j)=gelc_long(k,j)+ggg(k)
         gelc_long(k,i)=gelc_long(k,i)-ggg(k)
       enddo
+      gelc_long(3,j)=gelc_long(3,j)+
+     &  ssgradlipj*eesij/2.0d0*lipscale**2*sss1
+      gelc_long(3,i)=gelc_long(3,i)+
+     &  ssgradlipi*eesij/2.0d0*lipscale**2*sss1
 c      gelc_long(3,i)=gelc_long(3,i)+
 c        ssgradlipi*eesij/2.0d0*lipscale**2*sss1
 *
@@ -1979,9 +2034,9 @@ cgrad            do l=1,3
 cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
 cgrad            enddo
 cgrad          enddo
-      facvdw=facvdw+
-     & (-sss1*sssgrad/rpp(iteli,itelj)+(1.0d0-sss)*sssgrad1)*rmij*evdwij
-c     &   *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)   
+      facvdw=(facvdw+
+     &(-sss1*sssgrad/rpp(iteli,itelj)+(1.0d0-sss)*sssgrad1)*rmij*evdwij)
+     &   *faclipij2
       ggg(1)=facvdw*xj
       ggg(2)=facvdw*yj
       ggg(3)=facvdw*zj
@@ -1995,6 +2050,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)+
+     &    sss1*(1.0d0-sss)*ssgradlipj*evdwij/2.0d0*lipscale**2
+        gvdwpp(3,i)=gvdwpp(3,i)+
+     &    sss1*(1.0d0-sss)*ssgradlipi*evdwij/2.0d0*lipscale**2
 *
 * Loop over residues i+1 thru j-1.
 *
@@ -2019,8 +2079,8 @@ c      facel=el1+eesij
 *
 * Radial derivatives. First process both termini of the fragment (i,j)
 * 
-      aux=fac+(sssgrad1*(1.0d0-sss)-sssgrad*sss1/rpp(iteli,itelj))
-     &  *eesij*rmij
+      aux=(fac+(sssgrad1*(1.0d0-sss)-sssgrad*sss1/rpp(iteli,itelj))
+     &  *eesij*rmij)*faclipij2
 c     & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
       ggg(1)=aux*xj
       ggg(2)=aux*yj
@@ -2059,6 +2119,10 @@ C          ggg(3)=facvdw*zj
         gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
         gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
       enddo
+      gvdwpp(3,j)=gvdwpp(3,j)+
+     &  sss1*ssgradlipj*evdwij/2.0d0*lipscale**2
+      gvdwpp(3,i)=gvdwpp(3,i)+
+     &  sss1*ssgradlipi*evdwij/2.0d0*lipscale**2
 #endif
 *
 * Angular part
@@ -2076,7 +2140,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))*sss1
-     &  *fac_shield(i)**2*fac_shield(j)**2
+     &  *fac_shield(i)**2*fac_shield(j)**2*faclipij2
 c     &  *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
       enddo
@@ -2098,13 +2162,13 @@ cgrad          enddo
         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))*sss1
-     &       *fac_shield(i)**2*fac_shield(j)**2
+     &       *fac_shield(i)**2*fac_shield(j)**2*faclipij2
 c     &       *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
         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))*sss1
-     &       *fac_shield(i)**2*fac_shield(j)**2
+     &       *fac_shield(i)**2*fac_shield(j)**2*faclipij2
 c     &       *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
         gelc_long(k,j)=gelc_long(k,j)+ggg(k)
         gelc_long(k,i)=gelc_long(k,i)-ggg(k)
@@ -2318,7 +2382,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)*sss1
+     &  *fac_shield(i)*fac_shield(j)*sss1*faclipij
         eel_loc=eel_loc+eel_loc_ij
 
         if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
@@ -2370,7 +2434,7 @@ C     &     *2.0
      &     +a23*gmuij1(2)
      &     +a32*gmuij1(3)
      &     +a33*gmuij1(4))
-     &    *fac_shield(i)*fac_shield(j)*sss1
+     &    *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c         write(iout,*) "derivative over thatai"
 c         write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
 c     &   a33*gmuij1(4)
@@ -2386,7 +2450,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)*sss1
+     &    *fac_shield(i)*fac_shield(j)*sss1*faclipij
 
 c  Derivative over j residue
         geel_loc_ji=a22*gmuji1(1)
@@ -2399,7 +2463,7 @@ c     &   a33*gmuji1(4)
 
         gloc(nphi+j,icg)=gloc(nphi+j,icg)+
      &      geel_loc_ji*wel_loc
-     &    *fac_shield(i)*fac_shield(j)*sss1
+     &    *fac_shield(i)*fac_shield(j)*sss1*faclipij
 
         geel_loc_ji=
      &     +a22*gmuji2(1)
@@ -2411,14 +2475,14 @@ 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)*sss1
+     &    *fac_shield(i)*fac_shield(j)*sss1*faclipij
 #endif
 cC Paral derivatives in virtual-bond dihedral angles gamma
         if (i.gt.1)
      &    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)*sss1
+     &         *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &         *fac_shield(i)*fac_shield(j)
 c     &         *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
@@ -2426,7 +2490,7 @@ c     &         *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
         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)*sss1
+     &         *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &         *fac_shield(i)*fac_shield(j)
 c     &         *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
@@ -2438,7 +2502,7 @@ 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)*sss1
+     &       *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &         *fac_shield(i)*fac_shield(j)
 c     &         *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
@@ -2448,6 +2512,10 @@ 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)
@@ -2465,22 +2533,22 @@ c          ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
         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)*sss1
+     &       *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &       *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
           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)*sss1
+     &      *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &       *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
           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)*sss1
+     &       *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &       *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
           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)*sss1
+     &      *fac_shield(i)*fac_shield(j)*sss1*faclipij
 c     &       *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
         enddo
@@ -2734,7 +2802,10 @@ 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
+      double precision sslipi,ssgradlipi,sslipj,ssgradlipj
+      double precision boxshift
       integer ikont
+      double precision faclipij2
       evdw1=0.0D0
 C      print *,"WCHODZE"
 c      write (iout,*) "iatel_s_vdw",iatel_s_vdw,
@@ -2754,12 +2825,8 @@ c      do i=iatel_s_vdw,iatel_e_vdw
         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.0d0) xmedi=xmedi+boxxsize
-        ymedi=mod(ymedi,boxysize)
-        if (ymedi.lt.0.0d0) ymedi=ymedi+boxysize
-        zmedi=mod(zmedi,boxzsize)
-        if (zmedi.lt.0.0d0) zmedi=zmedi+boxzsize
+        call to_box(xmedi,ymedi,zmedi)
+        call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi)
         num_conti=0
 c        write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
 c     &   ' ielend',ielend_vdw(i)
@@ -2781,43 +2848,12 @@ c        do j=ielstart_vdw(i),ielend_vdw(i)
           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
-          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
+          call to_box(xj,yj,zj)
+          call lipid_layer(xj,yj,zj,sslipj,ssgradlipj)
+          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
           rrmij=1.0D0/rij
           rij=dsqrt(rij)
@@ -2837,16 +2873,17 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
             if (energy_dec) then 
               write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
             endif
-            evdw1=evdw1+evdwij*sss
+            evdw1=evdw1+evdwij*sss*faclipij2
             if (energy_dec) write (iout,'(a10,2i5,0pf7.3)') 
      &        'evdw1_sum',i,j,evdw1
 C
 C Calculate contributions to the Cartesian gradient.
 C
-            facvdw=-6*rrmij*(ev1+evdwij)*sss
-            ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj)
-            ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj)
-            ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj)
+            facvdw=(-6*rrmij*(ev1+evdwij)*sss+sssgrad*rmij*evdwij/
+     &         rpp(iteli,itelj))*faclipij2
+            ggg(1)=facvdw*xj
+            ggg(2)=facvdw*yj
+            ggg(3)=facvdw*zj
 C            ggg(1)=facvdw*xj
 C            ggg(2)=facvdw*yj
 C            ggg(3)=facvdw*zj
@@ -2854,6 +2891,11 @@ C            ggg(3)=facvdw*zj
               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
           endif
 c        enddo ! j
       enddo   ! i
       logical lprint_short
       common /shortcheck/ lprint_short
       double precision ggg(3)
-      integer xshift,yshift,zshift
       integer i,iint,j,k,iteli,itypj,subchap
       double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1,
      & fac,e1,e2,rij
       double precision evdw2,evdw2_14,evdwij
-      double precision xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,
-     & dist_temp, dist_init
       double precision sscale,sscagrad
+      double precision boxshift
       integer ikont
       if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb
       evdw2=0.0D0
@@ -2907,12 +2947,7 @@ c      do i=iatscp_s,iatscp_e
         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))
-        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)
 
 c        do iint=1,nscp_gr(i)
 
@@ -2928,44 +2963,10 @@ C Uncomment following three lines for Ca-p interactions
           yj=c(2,j)
           zj=c(3,j)
 c corrected by AL
-          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
-c end correction
-          dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-          xj_safe=xj
-          yj_safe=yj
-          zj_safe=zj
-          subchap=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-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)
 
@@ -3063,6 +3064,7 @@ C
      & dist_temp, dist_init
       double precision ggg(3)
       double precision sscale,sscagrad
+      double precision boxshift
       evdw2=0.0D0
       evdw2_14=0.0d0
 cd    print '(a)','Enter ESCP'
@@ -3076,12 +3078,7 @@ c     & ' iatscp_e=',iatscp_e
         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))
-        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)
 
 c        if (lprint_short) 
 c     &    write (iout,*) "i",i," itype",itype(i),itype(i+1),
@@ -3102,49 +3099,13 @@ C Uncomment following three lines for Ca-p interactions
           yj=c(2,j)
           zj=c(3,j)
 c corrected by AL
-          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
-c end correction
-          dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
-c          if (lprint_short) then
-c            write (iout,*) i,j,xi,yi,zi,xj,yj,zj
-c            write (iout,*) "dist_init",dsqrt(dist_init)
-c          endif
-          xj_safe=xj
-          yj_safe=yj
-          zj_safe=zj
-          subchap=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-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
-c          if (lprint_short) write (iout,*) "dist_temp",dsqrt(dist_temp)
-          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
+          xj=c(1,j)
+          yj=c(2,j)
+          zj=c(3,j)
+          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=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
 c          sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))