introduce lipid good grad wrong symplex
[unres.git] / source / unres / src_MD-M / energy_p_new_barrier.F
index 7207b35..9271240 100644 (file)
@@ -99,6 +99,7 @@ c      endif
 C 
 C Compute the side-chain and electrostatic interaction energy
 C
+C      print *,ipot
       goto (101,102,103,104,105,106) ipot
 C Lennard-Jones potential.
   101 call elj(evdw)
@@ -112,6 +113,7 @@ C Berne-Pechukas potential (dilated LJ, angular dependence).
       goto 107
 C Gay-Berne potential (shifted LJ, angular dependence).
   104 call egb(evdw)
+C      print *,"bylem w egb"
       goto 107
 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
   105 call egbv(evdw)
@@ -455,8 +457,9 @@ cMS$ATTRIBUTES C ::  proc_proc
 #ifdef MPI
       include 'mpif.h'
 #endif
-      double precision gradbufc(3,0:maxres),gradbufx(3,0:maxres),
-     & glocbuf(4*maxres),gradbufc_sum(3,0:maxres),gloc_scbuf(3,0:maxres)
+      double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
+     & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
+     & ,gloc_scbuf(3,-1:maxres)
       include 'COMMON.SETUP'
       include 'COMMON.IOUNITS'
       include 'COMMON.FFIELD'
@@ -509,7 +512,7 @@ c      enddo
       call flush(iout)
 #endif
 #ifdef SPLITELE
-      do i=1,nct
+      do i=0,nct
         do j=1,3
           gradbufc(j,i)=wsc*gvdwc(j,i)+
      &                wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
@@ -525,7 +528,7 @@ c      enddo
         enddo
       enddo 
 #else
-      do i=1,nct
+      do i=0,nct
         do j=1,3
           gradbufc(j,i)=wsc*gvdwc(j,i)+
      &                wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
@@ -551,7 +554,7 @@ c      enddo
       enddo
       call flush(iout)
 #endif
-      do i=1,nres
+      do i=0,nres
         do j=1,3
           gradbufc_sum(j,i)=gradbufc(j,i)
         enddo
@@ -594,7 +597,7 @@ c      enddo
       do j=1,3
         gradbufc(j,nres-1)=gradbufc_sum(j,nres)
       enddo
-      do i=nres-2,nnt,-1
+      do i=nres-2,-1,-1
         do j=1,3
           gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
         enddo
@@ -615,7 +618,7 @@ c      enddo
       enddo
       call flush(iout)
 #endif
-      do i=1,nres
+      do i=-1,nres
         do j=1,3
           gradbufc_sum(j,i)=gradbufc(j,i)
           gradbufc(j,i)=0.0d0
@@ -624,7 +627,7 @@ c      enddo
       do j=1,3
         gradbufc(j,nres-1)=gradbufc_sum(j,nres)
       enddo
-      do i=nres-2,nnt,-1
+      do i=nres-2,-1,-1
         do j=1,3
           gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
         enddo
@@ -652,7 +655,7 @@ c      enddo
       do k=1,3
         gradbufc(k,nres)=0.0d0
       enddo
-      do i=1,nct
+      do i=-1,nct
         do j=1,3
 #ifdef SPLITELE
           gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
@@ -1110,13 +1113,13 @@ c           write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
             eps0ij=eps(itypi,itypj)
             fac=rrij**expon2
 C have you changed here?
-            e1=fac*fac*aa(itypi,itypj)
-            e2=fac*bb(itypi,itypj)
+            e1=fac*fac*aa
+            e2=fac*bb
             evdwij=e1+e2
 cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
 cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
 cd          write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd   &        restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+cd   &        restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
 cd   &        bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
 cd   &        (c(k,i),k=1,3),(c(k,j),k=1,3)
             evdw=evdw+evdwij
@@ -1261,8 +1264,8 @@ C
             r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
             fac=r_shift_inv**expon
 C have you changed here?
-            e1=fac*fac*aa(itypi,itypj)
-            e2=fac*bb(itypi,itypj)
+            e1=fac*fac*aa
+            e2=fac*bb
             evdwij=e_augm+e1+e2
 cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
 cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
@@ -1390,16 +1393,16 @@ C Calculate whole angle-dependent part of epsilon and contributions
 C to its derivatives
 C have you changed here?
             fac=(rrij*sigsq)**expon2
-            e1=fac*fac*aa(itypi,itypj)
-            e2=fac*bb(itypi,itypj)
+            e1=fac*fac*aa
+            e2=fac*bb
             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
             eps2der=evdwij*eps3rt
             eps3der=evdwij*eps2rt
             evdwij=evdwij*eps2rt*eps3rt
             evdw=evdw+evdwij
             if (lprn) then
-            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+            sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+            epsi=bb**2/aa
 cd            write (iout,'(2(a3,i3,2x),15(0pf7.3))')
 cd     &        restyp(itypi),i,restyp(itypj),j,
 cd     &        epsi,sigm,chi1,chi2,chip1,chip2,
@@ -1449,7 +1452,7 @@ C
       integer xshift,yshift,zshift
       evdw=0.0D0
 ccccc      energy_dec=.false.
-c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+C      print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
       lprn=.false.
 c     if (icall.eq.0) lprn=.false.
@@ -1497,6 +1500,35 @@ c        endif
           if (yi.lt.0) yi=yi+boxysize
           zi=mod(zi,boxzsize)
           if (zi.lt.0) zi=zi+boxzsize
+C define scaling factor for lipids
+
+C        if (positi.le.0) positi=positi+boxzsize
+C        print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+       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
+
 C          xi=xi+xshift*boxxsize
 C          yi=yi+yshift*boxysize
 C          zi=zi+zshift*boxzsize
@@ -1581,6 +1613,36 @@ c        endif
           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 (zi.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
+      if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
+     &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+C      if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
+      print *,sslipi,sslipj,bordlipbot,zi,zj
       dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
       xj_safe=xj
       yj_safe=yj
@@ -1651,18 +1713,22 @@ c---------------------------------------------------------------
             fac=rij_shift**expon
 C here to start with
 C            if (c(i,3).gt.
-            e1=fac*fac*aa(itypi,itypj)
-            e2=fac*bb(itypi,itypj)
+            faclip=fac
+            e1=fac*fac*aa
+            e2=fac*bb
             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
             eps2der=evdwij*eps3rt
             eps3der=evdwij*eps2rt
+C       write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
+C     &((sslipi+sslipj)/2.0d0+
+C     &(2.0d0-sslipi-sslipj)/2.0d0)
 c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
 c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
             evdwij=evdwij*eps2rt*eps3rt
             evdw=evdw+evdwij*sss
             if (lprn) then
-            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+            sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+            epsi=bb**2/aa
             write (iout,'(2(a3,i3,2x),17(0pf7.3))')
      &        restyp(itypi),i,restyp(itypj),j,
      &        epsi,sigm,chi1,chi2,chip1,chip2,
@@ -1684,6 +1750,14 @@ c     &      evdwij,fac,sigma(itypi,itypj),expon
             fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
 c            fac=0.0d0
 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
+C            gg_lipi(3)=0.0d0
+C            gg_lipj(3)=0.0d0
             gg(1)=xj*fac
             gg(2)=yj*fac
             gg(3)=zj*fac
@@ -1733,6 +1807,41 @@ c     if (icall.eq.0) lprn=.true.
         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
+C define scaling factor for lipids
+
+C        if (positi.le.0) positi=positi+boxzsize
+C        print *,i
+C first for peptide groups
+c for each residue check if it is in lipid or lipid water border area
+       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-
+     &        ((positi-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-positi)/lipbufthick)
+         sslipi=sscalelip(fracinbuf)
+         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+        else
+         sslipi=1.0d0
+         ssgradlipi=0.0
+        endif
+       else
+         sslipi=0.0d0
+         ssgradlipi=0.0
+       endif
+
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1769,9 +1878,74 @@ 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
+C            xj=c(1,nres+j)-xi
+C            yj=c(2,nres+j)-yi
+C            zj=c(3,nres+j)-zi
+          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-
+     &        ((positi-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-positi)/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)) write(63,'2e10.5') 
+C     &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
+      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)
@@ -1792,8 +1966,8 @@ 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
-            e1=fac*fac*aa(itypi,itypj)
-            e2=fac*bb(itypi,itypj)
+            e1=fac*fac*aa
+            e2=fac*bb
             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
             eps2der=evdwij*eps3rt
             eps3der=evdwij*eps2rt
@@ -1802,8 +1976,8 @@ c---------------------------------------------------------------
             evdwij=evdwij*eps2rt*eps3rt
             evdw=evdw+evdwij+e_augm
             if (lprn) then
-            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+            sigm=dabs(aa/bb)**(1.0D0/6.0D0)
+            epsi=bb**2/aa
             write (iout,'(2(a3,i3,2x),17(0pf7.3))')
      &        restyp(itypi),i,restyp(itypj),j,
      &        epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
@@ -1817,6 +1991,7 @@ C Calculate gradient components.
             fac=-expon*(e1+evdwij)*rij_shift
             sigder=fac*sigder
             fac=rij*fac-2*expon*rrij*e_augm
+            fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
 C Calculate the radial part of the gradient
             gg(1)=xj*fac
             gg(2)=yj*fac
@@ -1927,10 +2102,10 @@ c      write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
       enddo 
 c      write (iout,*) "gg",(gg(k),k=1,3)
       do k=1,3
-        gvdwx(k,i)=gvdwx(k,i)-gg(k)
+        gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
      &            +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
      &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
-        gvdwx(k,j)=gvdwx(k,j)+gg(k)
+        gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
      &            +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
      &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
 c        write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
@@ -1947,8 +2122,8 @@ cgrad          gvdwc(l,k)=gvdwc(l,k)+gg(l)
 cgrad        enddo
 cgrad      enddo
       do l=1,3
-        gvdwc(l,i)=gvdwc(l,i)-gg(l)
-        gvdwc(l,j)=gvdwc(l,j)+gg(l)
+        gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
+        gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
       enddo
       return
       end
@@ -9708,6 +9883,7 @@ CCC----------------------------------------------
       include 'COMMON.CONTROL'
       include 'COMMON.SPLITELE'
       include 'COMMON.SBRIDGE'
+C this is done by Adasko
 C      print *,"wchodze"
 C structure of box:
 C      water
@@ -9718,9 +9894,10 @@ C--buflipbot--- lipid ends buffore starts
 C--bordlipbot--buffore ends
       eliptran=0.0
       do i=ilip_start,ilip_end
+C       do i=1,1
         if (itype(i).eq.ntyp1) cycle
 
-        positi=(mod((c(3,i)+c(3,i+1)),boxzsize))
+        positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
         if (positi.le.0) positi=positi+boxzsize
 C        print *,i
 C first for peptide groups
@@ -9736,8 +9913,8 @@ C lipbufthick is thickenes of lipid buffore
          sslip=sscalelip(fracinbuf)
          ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
          eliptran=eliptran+sslip*pepliptran
-         gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0
-         gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0
+         gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
+         gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
 C         gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
 
 C         print *,"doing sccale for lower part"
@@ -9749,10 +9926,10 @@ C         print *,"doing sccale for lower part"
          gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
          gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
 C         gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
-          print *, "doing sscalefor top part"
+C          print *, "doing sscalefor top part"
         else
          eliptran=eliptran+pepliptran
-         print *,"I am in true lipid"
+C         print *,"I am in true lipid"
         endif
 C       else
 C       eliptran=elpitran+0.0 ! I am in water
@@ -9762,6 +9939,7 @@ C       print *, "nic nie bylo w lipidzie?"
 C now multiply all by the peptide group transfer factor
 C       eliptran=eliptran*pepliptran
 C now the same for side chains
+C       do i=1,1
        do i=ilip_start,ilip_end
         if (itype(i).eq.ntyp1) cycle
         positi=(mod(c(3,i+nres),boxzsize))
@@ -9769,6 +9947,7 @@ C now the same for side chains
 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)
+C       print *,positi,bordlipbot,buflipbot
        if ((positi.gt.bordlipbot)
      & .and.(positi.lt.bordliptop)) then
 C the energy transfer exist
@@ -9781,9 +9960,9 @@ C lipbufthick is thickenes of lipid buffore
          eliptran=eliptran+sslip*liptranene(itype(i))
          gliptranx(3,i)=gliptranx(3,i)
      &+ssgradlip*liptranene(itype(i))/2.0d0
-         gliptranc(3,i-1)=
-     &+ssgradlip*liptranene(itype(i))
-         print *,"doing sccale for lower part"
+         gliptranc(3,i-1)= gliptranc(3,i-1)
+     &+ssgradlip*liptranene(itype(i))/2.0d0
+C         print *,"doing sccale for lower part"
         elseif (positi.gt.bufliptop) then
          fracinbuf=1.0d0-
      &((bordliptop-positi)/lipbufthick)
@@ -9792,12 +9971,12 @@ C lipbufthick is thickenes of lipid buffore
          eliptran=eliptran+sslip*liptranene(itype(i))
          gliptranx(3,i)=gliptranx(3,i)
      &+ssgradlip*liptranene(itype(i))/2.0d0
-         gliptranc(3,i-1)=
-     &+ssgradlip*liptranene(itype(i))
-          print *, "doing sscalefor top part",sslip,fracinbuf
+         gliptranc(3,i-1)= gliptranc(3,i-1)
+     &+ssgradlip*liptranene(itype(i))/2.0d0
+C          print *, "doing sscalefor top part",sslip,fracinbuf
         else
          eliptran=eliptran+liptranene(itype(i))
-         print *,"I am in true lipid"
+C         print *,"I am in true lipid"
         endif
         endif ! if in lipid or buffor
 C       else