corrected cluster for lipid
[unres.git] / source / cluster / wham / src-M / energy_p_new.F
index a71e55b..206d327 100644 (file)
@@ -101,6 +101,18 @@ C
         call Eliptransfer(eliptran)
       endif
 
+      if (TUBElog.eq.1) then
+      print *,"just before call"
+        call calctube(Etube)
+       print *,"just after call",etube
+       elseif (TUBElog.eq.2) then
+        call calctube2(Etube)
+       elseif (TUBElog.eq.3) then
+        call calcnano(Etube)
+       else
+       Etube=0.0d0
+       endif
+       write(iout,*), "Etube",etube
 C 
 C 12/1/95 Multi-body terms
 C
@@ -133,7 +145,7 @@ c         print *,ecorr,ecorr5,ecorr6,eturn6
      & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
      & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
      & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
-     & +wliptran*eliptran
+     & +wliptran*eliptran+wtube*Etube
       else
       etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
      & +wvdwpp*evdw1
@@ -143,7 +155,7 @@ c         print *,ecorr,ecorr5,ecorr6,eturn6
      & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
      & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
      & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
-     & +wliptran*eliptran
+     & +wliptran*eliptran+wtube*Etube
       endif
 #else
       if (shield_mode.gt.0) then
@@ -155,7 +167,7 @@ c         print *,ecorr,ecorr5,ecorr6,eturn6
      & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
      & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
      & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
-     & +wliptran*eliptran
+     & +wliptran*eliptran+wtube*Etube
       else
       etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
      & +welec*fact(1)*(ees+evdw1)
@@ -165,7 +177,7 @@ c         print *,ecorr,ecorr5,ecorr6,eturn6
      & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
      & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
      & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
-     & +wliptran*eliptran
+     & +wliptran*eliptran+wtube*Etube
       endif
 #endif
 
@@ -203,6 +215,7 @@ c         print *,ecorr,ecorr5,ecorr6,eturn6
       energia(21)=evdw_t
       energia(24)=ethetacnstr
       energia(22)=eliptran
+      energia(25)=Etube
 c detecting NaNQ
 #ifdef ISNAN
 #ifdef AIX
@@ -243,11 +256,15 @@ C
      &                wturn6*fact(5)*gcorr6_turn(j,i)+
      &                wsccor*fact(2)*gsccorc(j,i)
      &               +wliptran*gliptranc(j,i)
+     &                +wtube*gg_tube(j,i)
+
           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
      &                  wbond*gradbx(j,i)+
      &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
      &                  wsccor*fact(2)*gsccorx(j,i)
      &                 +wliptran*gliptranx(j,i)
+     &                +wtube*gg_tube_SC(j,i)
+
         else
           gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
      &                +fact(1)*wscp*gvdwc_scp(j,i)+
@@ -273,6 +290,7 @@ C
      &                 +wturn4*gshieldc_loc_t4(j,i)
      &                 +wel_loc*gshieldc_ll(j,i)
      &                 +wel_loc*gshieldc_loc_ll(j,i)
+     &                +wtube*gg_tube(j,i)
 
           gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
      &                 +fact(1)*wscp*gradx_scp(j,i)+
@@ -285,6 +303,7 @@ C
      &                 +wturn3*gshieldx_t3(j,i)
      &                 +wturn4*gshieldx_t4(j,i)
      &                 +wel_loc*gshieldx_ll(j,i)
+     &                +wtube*gg_tube_SC(j,i)
 
 
         endif
@@ -305,11 +324,14 @@ C
      &                wturn6*fact(5)*gcorr6_turn(j,i)+
      &                wsccor*fact(2)*gsccorc(j,i)
      &               +wliptran*gliptranc(j,i)
+     &                +wtube*gg_tube(j,i)
+
           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
      &                  wbond*gradbx(j,i)+
      &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
      &                  wsccor*fact(1)*gsccorx(j,i)
      &                 +wliptran*gliptranx(j,i)
+     &                +wtube*gg_tube_SC(j,i)
               else
           gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
      &                   fact(1)*wscp*gvdwc_scp(j,i)+
@@ -324,12 +346,15 @@ C
      &                wturn6*fact(5)*gcorr6_turn(j,i)+
      &                wsccor*fact(2)*gsccorc(j,i)
      &               +wliptran*gliptranc(j,i)
+     &                +wtube*gg_tube(j,i)
+
           gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
      &                  fact(1)*wscp*gradx_scp(j,i)+
      &                  wbond*gradbx(j,i)+
      &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
      &                  wsccor*fact(1)*gsccorx(j,i)
      &                 +wliptran*gliptranx(j,i)
+     &                +wtube*gg_tube_SC(j,i)
          endif
         enddo     
 #endif
@@ -387,6 +412,7 @@ C------------------------------------------------------------------------
       edihcnstr=energia(20)
       estr=energia(18)
       ethetacnstr=energia(24)
+      etube=energia(25)
 #ifdef SPLITELE
       write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
      &  wvdwpp,
@@ -395,7 +421,8 @@ C------------------------------------------------------------------------
      &  ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
      &  eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
      &  eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
-     &  esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etot
+     &  esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,etube,wtube,
+     & etot
    10 format (/'Virtual-chain energies:'//
      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
      & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
@@ -419,6 +446,7 @@ C------------------------------------------------------------------------
      & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
      & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
      & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ 
+     & 'ETUBE=',1pE16.6,' WEIGHT=',1pD16.6,' (energy with nano)'/
      & 'ETOT=  ',1pE16.6,' (total)')
 #else
       write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
@@ -427,7 +455,7 @@ C------------------------------------------------------------------------
      &  ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
      &  eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
      &  eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
-     &  edihcnstr,ethetacnstr,ebr*nss,etot
+     &  edihcnstr,ethetacnstr,ebr*nss,etube,wtube,etot
    10 format (/'Virtual-chain energies:'//
      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
      & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
@@ -450,6 +478,7 @@ C------------------------------------------------------------------------
      & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
      & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
      & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ 
+     & 'ETUBE=',1pE16.6,' WEIGHT=',1pD16.6,' (energy with nano)'/
      & 'ETOT=  ',1pE16.6,' (total)')
 #endif
       return
@@ -2208,6 +2237,31 @@ C         endif
           if (ymedi.lt.0) ymedi=ymedi+boxysize
           zmedi=mod(zmedi,boxzsize)
           if (zmedi.lt.0) zmedi=zmedi+boxzsize
+          zmedi2=mod(zmedi,boxzsize)
+          if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
+       if ((zmedi2.gt.bordlipbot)
+     &.and.(zmedi2.lt.bordliptop)) then
+C the energy transfer exist
+        if (zmedi2.lt.buflipbot) then
+C what fraction I am in
+         fracinbuf=1.0d0-
+     &        ((zmedi2-bordlipbot)/lipbufthick)
+C lipbufthick is thickenes of lipid buffore
+         sslipi=sscalelip(fracinbuf)
+         ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
+        elseif (zmedi2.gt.bufliptop) then
+         fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
+         sslipi=sscalelip(fracinbuf)
+         ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
+        else
+         sslipi=1.0d0
+         ssgradlipi=0.0d0
+        endif
+       else
+         sslipi=0.0d0
+         ssgradlipi=0.0d0
+       endif
+
         num_conti=0
 c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
         do j=ielstart(i),ielend(i)
@@ -2251,6 +2305,29 @@ C End diagnostics
           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
+
       dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
       xj_safe=xj
       yj_safe=yj
@@ -2320,15 +2397,18 @@ C#undef DEBUG
           el1=el1*fac_shield(i)**2*fac_shield(j)**2
           el2=el2*fac_shield(i)**2*fac_shield(j)**2
           eesij=(el1+el2)
+C     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
           ees=ees+eesij
           else
           fac_shield(i)=1.0
           fac_shield(j)=1.0
           eesij=(el1+el2)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
           ees=ees+eesij
           endif
 C          ees=ees+eesij
           evdw1=evdw1+evdwij*sss
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 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,
@@ -2759,6 +2839,8 @@ C           fac_shield(j)=0.6
           endif
           eel_loc_ij=eel_loc_ij
      &    *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
+
           eel_loc=eel_loc+eel_loc_ij
 C Partial derivatives in virtual-bond dihedral angles gamma
           if (calc_grad) then
@@ -2823,9 +2905,10 @@ cd          write(iout,*) 'aggj1',aggj1
 
 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
           do l=1,3
-            ggg(l)=agg(l,1)*muij(1)+
-     &          agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
+            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)
+     &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
           enddo
           do k=i+2,j2
@@ -2838,18 +2921,22 @@ C Remaining derivatives of eello
             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)
+     &*((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)
+     &*((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)
+     &*((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)
+     &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
 
           enddo
           endif
@@ -3149,8 +3236,11 @@ 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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
         eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
      &  *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
 cd        write (2,*) 'i,',i,' j',j,'eello_turn3',
 cd     &    0.5d0*(pizda(1,1)+pizda(2,2)),
@@ -3224,6 +3314,7 @@ C Cartesian derivatives
           gcorr3_turn(l,i)=gcorr3_turn(l,i)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
      &   *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggi1(l,1)
           a_temp(1,2)=aggi1(l,2)
@@ -3233,6 +3324,7 @@ C Cartesian derivatives
           gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
      &   *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggj(l,1)
           a_temp(1,2)=aggj(l,2)
@@ -3242,6 +3334,7 @@ C Cartesian derivatives
           gcorr3_turn(l,j)=gcorr3_turn(l,j)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
      &   *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggj1(l,1)
           a_temp(1,2)=aggj1(l,2)
@@ -3251,6 +3344,7 @@ C Cartesian derivatives
           gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
      &      +0.5d0*(pizda(1,1)+pizda(2,2))
      &   *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
         enddo
         endif
@@ -3304,8 +3398,11 @@ C        fac_shield(j)=0.6
         endif
         eello_turn4=eello_turn4-(s1+s2+s3)
      &  *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
+
         eello_t4=-(s1+s2+s3)
      &  *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
 cd        write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
 cd     &    ' eello_turn4_num',8*eello_turn4_num
@@ -3361,6 +3458,7 @@ C     &     *2.0
         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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
 C Derivatives in gamma(i+1)
         call transpose2(EUgder(1,1,i+2),e2tder(1,1))
@@ -3371,6 +3469,7 @@ C Derivatives in gamma(i+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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
 C Derivatives in gamma(i+2)
         call transpose2(EUgder(1,1,i+3),e3tder(1,1))
@@ -3384,7 +3483,8 @@ C Derivatives in gamma(i+2)
         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)
-
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 C Cartesian derivatives
 C Derivatives of this turn contributions in DC(i+2)
         if (j.lt.nres-1) then
@@ -3405,6 +3505,7 @@ C Derivatives of this turn contributions in DC(i+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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           enddo
         endif
@@ -3425,6 +3526,7 @@ C Remaining derivatives of this turn contribution
           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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggi1(l,1)
           a_temp(1,2)=aggi1(l,2)
@@ -3441,6 +3543,7 @@ C Remaining derivatives of this turn contribution
           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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggj(l,1)
           a_temp(1,2)=aggj(l,2)
@@ -3457,6 +3560,7 @@ C Remaining derivatives of this turn contribution
           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)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
           a_temp(1,1)=aggj1(l,1)
           a_temp(1,2)=aggj1(l,2)
@@ -3473,6 +3577,7 @@ C Remaining derivatives of this turn contribution
           s3=0.5d0*(pizda(1,1)+pizda(2,2))
           gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
      &  *fac_shield(i)*fac_shield(j)
+     &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
 
         enddo
         endif
@@ -9054,3 +9159,689 @@ C       eliptran=elpitran+0.0 ! I am in water
        return
        end
 C-------------------------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------
+C This subroutine is to mimic the histone like structure but as well can be
+C utilizet to nanostructures (infinit) small modification has to be used to 
+C make it finite (z gradient at the ends has to be changes as well as the x,y
+C gradient has to be modified at the ends 
+C The energy function is Kihara potential 
+C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
+C 4eps is depth of well sigma is r_minimum r is distance from center of tube 
+C and r0 is the excluded size of nanotube (can be set to 0 if we want just a 
+C simple Kihara potential
+      subroutine calctube(Etube)
+       implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SPLITELE'
+      include 'COMMON.SBRIDGE'
+      double precision tub_r,vectube(3),enetube(maxres*2)
+      Etube=0.0d0
+      do i=itube_start,itube_end
+        enetube(i)=0.0d0
+        enetube(i+nres)=0.0d0
+      enddo
+C first we calculate the distance from tube center
+C first sugare-phosphate group for NARES this would be peptide group 
+C for UNRES
+       do i=itube_start,itube_end
+C lets ommit dummy atoms for now
+       if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
+C now calculate distance from center of tube and direction vectors
+      xmin=boxxsize
+      ymin=boxysize
+        do j=-1,1
+         vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+         vectube(1)=vectube(1)+boxxsize*j
+         vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+         vectube(2)=vectube(2)+boxysize*j
+       
+         xminact=abs(vectube(1)-tubecenter(1))
+         yminact=abs(vectube(2)-tubecenter(2))
+           if (xmin.gt.xminact) then
+            xmin=xminact
+            xtemp=vectube(1)
+           endif
+           if (ymin.gt.yminact) then
+             ymin=yminact
+             ytemp=vectube(2)
+            endif
+         enddo
+      vectube(1)=xtemp
+      vectube(2)=ytemp
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+
+C      print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+C      print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+
+C as the tube is infinity we do not calculate the Z-vector use of Z
+C as chosen axis
+      vectube(3)=0.0d0
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
+C       write(iout,*) "TU13",i,rdiff6,enetube(i)
+C       print *,rdiff,rdiff6,pep_aa_tube
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=(-12.0d0*pep_aa_tube/rdiff6-
+     &       6.0d0*pep_bb_tube)/rdiff6/rdiff
+C       write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
+C     &rdiff,fac
+
+C now direction of gg_tube vector
+        do j=1,3
+        gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+        gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+        enddo
+        enddo
+C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
+C        print *,gg_tube(1,0),"TU"
+
+
+       do i=itube_start,itube_end
+C Lets not jump over memory as we use many times iti
+         iti=itype(i)
+C lets ommit dummy atoms for now
+         if ((iti.eq.ntyp1)
+C in UNRES uncomment the line below as GLY has no side-chain...
+C      .or.(iti.eq.10)
+     &   ) cycle
+      xmin=boxxsize
+      ymin=boxysize
+        do j=-1,1
+         vectube(1)=mod((c(1,i+nres)),boxxsize)
+         vectube(1)=vectube(1)+boxxsize*j
+         vectube(2)=mod((c(2,i+nres)),boxysize)
+         vectube(2)=vectube(2)+boxysize*j
+
+         xminact=abs(vectube(1)-tubecenter(1))
+         yminact=abs(vectube(2)-tubecenter(2))
+           if (xmin.gt.xminact) then
+            xmin=xminact
+            xtemp=vectube(1)
+           endif
+           if (ymin.gt.yminact) then
+             ymin=yminact
+             ytemp=vectube(2)
+            endif
+         enddo
+      vectube(1)=xtemp
+      vectube(2)=ytemp
+C          write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
+C     &     tubecenter(2)
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+
+C as the tube is infinity we do not calculate the Z-vector use of Z
+C as chosen axis
+      vectube(3)=0.0d0
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       sc_aa_tube=sc_aa_tube_par(iti)
+       sc_bb_tube=sc_bb_tube_par(iti)
+       enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
+     &       6.0d0*sc_bb_tube/rdiff6/rdiff
+C now direction of gg_tube vector
+         do j=1,3
+          gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+          gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+         enddo
+        enddo
+        do i=itube_start,itube_end
+          Etube=Etube+enetube(i)+enetube(i+nres)
+        enddo
+C        print *,"ETUBE", etube
+        return
+        end
+C TO DO 1) add to total energy
+C       2) add to gradient summation
+C       3) add reading parameters (AND of course oppening of PARAM file)
+C       4) add reading the center of tube
+C       5) add COMMONs
+C       6) add to zerograd
+
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------
+C This subroutine is to mimic the histone like structure but as well can be
+C utilizet to nanostructures (infinit) small modification has to be used to 
+C make it finite (z gradient at the ends has to be changes as well as the x,y
+C gradient has to be modified at the ends 
+C The energy function is Kihara potential 
+C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
+C 4eps is depth of well sigma is r_minimum r is distance from center of tube 
+C and r0 is the excluded size of nanotube (can be set to 0 if we want just a 
+C simple Kihara potential
+      subroutine calctube2(Etube)
+       implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SPLITELE'
+      include 'COMMON.SBRIDGE'
+      double precision tub_r,vectube(3),enetube(maxres*2)
+      Etube=0.0d0
+      do i=itube_start,itube_end
+        enetube(i)=0.0d0
+        enetube(i+nres)=0.0d0
+      enddo
+C first we calculate the distance from tube center
+C first sugare-phosphate group for NARES this would be peptide group 
+C for UNRES
+       do i=itube_start,itube_end
+C lets ommit dummy atoms for now
+       
+       if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
+C now calculate distance from center of tube and direction vectors
+C      vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+C          if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+C      vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+C          if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
+      xmin=boxxsize
+      ymin=boxysize
+        do j=-1,1
+         vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+         vectube(1)=vectube(1)+boxxsize*j
+         vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+         vectube(2)=vectube(2)+boxysize*j
+
+         xminact=abs(vectube(1)-tubecenter(1))
+         yminact=abs(vectube(2)-tubecenter(2))
+           if (xmin.gt.xminact) then
+            xmin=xminact
+            xtemp=vectube(1)
+           endif
+           if (ymin.gt.yminact) then
+             ymin=yminact
+             ytemp=vectube(2)
+            endif
+         enddo
+      vectube(1)=xtemp
+      vectube(2)=ytemp
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+
+C      print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+C      print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+
+C as the tube is infinity we do not calculate the Z-vector use of Z
+C as chosen axis
+      vectube(3)=0.0d0
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C THIS FRAGMENT MAKES TUBE FINITE
+        positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+        if (positi.le.0) positi=positi+boxzsize
+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)
+       print *,positi,bordtubebot,buftubebot,bordtubetop
+       if ((positi.gt.bordtubebot)
+     & .and.(positi.lt.bordtubetop)) then
+C the energy transfer exist
+        if (positi.lt.buftubebot) then
+         fracinbuf=1.0d0-
+     &     ((positi-bordtubebot)/tubebufthick)
+C lipbufthick is thickenes of lipid buffore
+         sstube=sscalelip(fracinbuf)
+         ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+         print *,ssgradtube, sstube,tubetranene(itype(i))
+         enetube(i)=enetube(i)+sstube*tubetranenepep
+C         gg_tube_SC(3,i)=gg_tube_SC(3,i)
+C     &+ssgradtube*tubetranene(itype(i))
+C         gg_tube(3,i-1)= gg_tube(3,i-1)
+C     &+ssgradtube*tubetranene(itype(i))
+C         print *,"doing sccale for lower part"
+        elseif (positi.gt.buftubetop) then
+         fracinbuf=1.0d0-
+     &((bordtubetop-positi)/tubebufthick)
+         sstube=sscalelip(fracinbuf)
+         ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+         enetube(i)=enetube(i)+sstube*tubetranenepep
+C         gg_tube_SC(3,i)=gg_tube_SC(3,i)
+C     &+ssgradtube*tubetranene(itype(i))
+C         gg_tube(3,i-1)= gg_tube(3,i-1)
+C     &+ssgradtube*tubetranene(itype(i))
+C          print *, "doing sscalefor top part",sslip,fracinbuf
+        else
+         sstube=1.0d0
+         ssgradtube=0.0d0
+         enetube(i)=enetube(i)+sstube*tubetranenepep
+C         print *,"I am in true lipid"
+        endif
+        else
+C          sstube=0.0d0
+C          ssgradtube=0.0d0
+        cycle
+        endif ! if in lipid or buffor
+
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       enetube(i)=enetube(i)+sstube*
+     &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
+C       write(iout,*) "TU13",i,rdiff6,enetube(i)
+C       print *,rdiff,rdiff6,pep_aa_tube
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=(-12.0d0*pep_aa_tube/rdiff6-
+     &       6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
+C       write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
+C     &rdiff,fac
+
+C now direction of gg_tube vector
+        do j=1,3
+        gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+        gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+        enddo
+         gg_tube(3,i)=gg_tube(3,i)
+     &+ssgradtube*enetube(i)/sstube/2.0d0
+         gg_tube(3,i-1)= gg_tube(3,i-1)
+     &+ssgradtube*enetube(i)/sstube/2.0d0
+
+        enddo
+C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
+C        print *,gg_tube(1,0),"TU"
+        do i=itube_start,itube_end
+C Lets not jump over memory as we use many times iti
+         iti=itype(i)
+C lets ommit dummy atoms for now
+         if ((iti.eq.ntyp1)
+C in UNRES uncomment the line below as GLY has no side-chain...
+     &      .or.(iti.eq.10)
+     &   ) cycle
+          vectube(1)=c(1,i+nres)
+          vectube(1)=mod(vectube(1),boxxsize)
+          if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
+          vectube(2)=c(2,i+nres)
+          vectube(2)=mod(vectube(2),boxysize)
+          if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
+
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+C THIS FRAGMENT MAKES TUBE FINITE
+        positi=(mod(c(3,i+nres),boxzsize))
+        if (positi.le.0) positi=positi+boxzsize
+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)
+       print *,positi,bordtubebot,buftubebot,bordtubetop
+       if ((positi.gt.bordtubebot)
+     & .and.(positi.lt.bordtubetop)) then
+C the energy transfer exist
+        if (positi.lt.buftubebot) then
+         fracinbuf=1.0d0-
+     &     ((positi-bordtubebot)/tubebufthick)
+C lipbufthick is thickenes of lipid buffore
+         sstube=sscalelip(fracinbuf)
+         ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
+         print *,ssgradtube, sstube,tubetranene(itype(i))
+         enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
+C         gg_tube_SC(3,i)=gg_tube_SC(3,i)
+C     &+ssgradtube*tubetranene(itype(i))
+C         gg_tube(3,i-1)= gg_tube(3,i-1)
+C     &+ssgradtube*tubetranene(itype(i))
+C         print *,"doing sccale for lower part"
+        elseif (positi.gt.buftubetop) then
+         fracinbuf=1.0d0-
+     &((bordtubetop-positi)/tubebufthick)
+         sstube=sscalelip(fracinbuf)
+         ssgradtube=sscagradlip(fracinbuf)/tubebufthick
+         enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
+C         gg_tube_SC(3,i)=gg_tube_SC(3,i)
+C     &+ssgradtube*tubetranene(itype(i))
+C         gg_tube(3,i-1)= gg_tube(3,i-1)
+C     &+ssgradtube*tubetranene(itype(i))
+C          print *, "doing sscalefor top part",sslip,fracinbuf
+        else
+         sstube=1.0d0
+         ssgradtube=0.0d0
+         enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
+C         print *,"I am in true lipid"
+        endif
+        else
+C          sstube=0.0d0
+C          ssgradtube=0.0d0
+        cycle
+        endif ! if in lipid or buffor
+CEND OF FINITE FRAGMENT
+C as the tube is infinity we do not calculate the Z-vector use of Z
+C as chosen axis
+      vectube(3)=0.0d0
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       sc_aa_tube=sc_aa_tube_par(iti)
+       sc_bb_tube=sc_bb_tube_par(iti)
+       enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
+     &                 *sstube+enetube(i+nres)
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
+     &       6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
+C now direction of gg_tube vector
+         do j=1,3
+          gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+          gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+         enddo
+         gg_tube_SC(3,i)=gg_tube_SC(3,i)
+     &+ssgradtube*enetube(i+nres)/sstube
+         gg_tube(3,i-1)= gg_tube(3,i-1)
+     &+ssgradtube*enetube(i+nres)/sstube
+
+        enddo
+        do i=itube_start,itube_end
+          Etube=Etube+enetube(i)+enetube(i+nres)
+        enddo
+C        print *,"ETUBE", etube
+        return
+        end
+C TO DO 1) add to total energy
+C       2) add to gradient summation
+C       3) add reading parameters (AND of course oppening of PARAM file)
+C       4) add reading the center of tube
+C       5) add COMMONs
+C       6) add to zerograd
+
+
+C#-------------------------------------------------------------------------------
+C This subroutine is to mimic the histone like structure but as well can be
+C utilizet to nanostructures (infinit) small modification has to be used to 
+C make it finite (z gradient at the ends has to be changes as well as the x,y
+C gradient has to be modified at the ends 
+C The energy function is Kihara potential 
+C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
+C 4eps is depth of well sigma is r_minimum r is distance from center of tube 
+C and r0 is the excluded size of nanotube (can be set to 0 if we want just a 
+C simple Kihara potential
+      subroutine calcnano(Etube)
+       implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SPLITELE'
+      include 'COMMON.SBRIDGE'
+      double precision tub_r,vectube(3),enetube(maxres*2),
+     & enecavtube(maxres*2)
+      Etube=0.0d0
+      do i=itube_start,itube_end
+        enetube(i)=0.0d0
+        enetube(i+nres)=0.0d0
+      enddo
+C first we calculate the distance from tube center
+C first sugare-phosphate group for NARES this would be peptide group 
+C for UNRES
+       do i=itube_start,itube_end
+C lets ommit dummy atoms for now
+       if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
+C now calculate distance from center of tube and direction vectors
+      xmin=boxxsize
+      ymin=boxysize
+      zmin=boxzsize
+
+        do j=-1,1
+         vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
+         vectube(1)=vectube(1)+boxxsize*j
+         vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
+         vectube(2)=vectube(2)+boxysize*j
+         vectube(3)=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
+         vectube(3)=vectube(3)+boxzsize*j
+
+
+         xminact=abs(vectube(1)-tubecenter(1))
+         yminact=abs(vectube(2)-tubecenter(2))
+         zminact=abs(vectube(3)-tubecenter(3))
+
+           if (xmin.gt.xminact) then
+            xmin=xminact
+            xtemp=vectube(1)
+           endif
+           if (ymin.gt.yminact) then
+             ymin=yminact
+             ytemp=vectube(2)
+            endif
+           if (zmin.gt.zminact) then
+             zmin=zminact
+             ztemp=vectube(3)
+            endif
+         enddo
+      vectube(1)=xtemp
+      vectube(2)=ytemp
+      vectube(3)=ztemp
+
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+      vectube(3)=vectube(3)-tubecenter(3)
+
+C      print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
+C      print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
+C as the tube is infinity we do not calculate the Z-vector use of Z
+C as chosen axis
+C      vectube(3)=0.0d0
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+      vectube(3)=vectube(3)/tub_r
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
+C       write(iout,*) "TU13",i,rdiff6,enetube(i)
+C       print *,rdiff,rdiff6,pep_aa_tube
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=(-12.0d0*pep_aa_tube/rdiff6-
+     &       6.0d0*pep_bb_tube)/rdiff6/rdiff
+C       write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
+C     &rdiff,fac
+         if (acavtubpep.eq.0.0d0) then
+C go to 667
+         enecavtube(i)=0.0
+         faccav=0.0
+         else
+         denominator=(1.0+dcavtubpep*rdiff6*rdiff6)
+         enecavtube(i)=
+     &   (bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)+ccavtubpep)
+     &   /denominator
+         enecavtube(i)=0.0
+         faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/sqrt(rdiff))
+     &   *denominator-(bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)
+     &   +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
+     &   /denominator**2.0d0
+C         faccav=0.0
+C         fac=fac+faccav
+C 667     continue
+         endif
+C         print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
+C     &   enecavtube(i),faccav
+C         print *,"licz=",
+C     & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
+CX         print *,"finene=",enetube(i+nres)+enecavtube(i)
+         
+C now direction of gg_tube vector
+        do j=1,3
+        gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
+        gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
+        enddo
+        enddo
+
+       do i=itube_start,itube_end
+        enecavtube(i)=0.0 
+C Lets not jump over memory as we use many times iti
+         iti=itype(i)
+C lets ommit dummy atoms for now
+         if ((iti.eq.ntyp1)
+C in UNRES uncomment the line below as GLY has no side-chain...
+C      .or.(iti.eq.10)
+     &   ) cycle
+      xmin=boxxsize
+      ymin=boxysize
+      zmin=boxzsize
+        do j=-1,1
+         vectube(1)=mod((c(1,i+nres)),boxxsize)
+         vectube(1)=vectube(1)+boxxsize*j
+         vectube(2)=mod((c(2,i+nres)),boxysize)
+         vectube(2)=vectube(2)+boxysize*j
+         vectube(3)=mod((c(3,i+nres)),boxzsize)
+         vectube(3)=vectube(3)+boxzsize*j
+
+
+         xminact=abs(vectube(1)-tubecenter(1))
+         yminact=abs(vectube(2)-tubecenter(2))
+         zminact=abs(vectube(3)-tubecenter(3))
+
+           if (xmin.gt.xminact) then
+            xmin=xminact
+            xtemp=vectube(1)
+           endif
+           if (ymin.gt.yminact) then
+             ymin=yminact
+             ytemp=vectube(2)
+            endif
+           if (zmin.gt.zminact) then
+             zmin=zminact
+             ztemp=vectube(3)
+            endif
+         enddo
+      vectube(1)=xtemp
+      vectube(2)=ytemp
+      vectube(3)=ztemp
+
+C          write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
+C     &     tubecenter(2)
+      vectube(1)=vectube(1)-tubecenter(1)
+      vectube(2)=vectube(2)-tubecenter(2)
+      vectube(3)=vectube(3)-tubecenter(3)
+C now calculte the distance
+       tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
+C now normalize vector
+      vectube(1)=vectube(1)/tub_r
+      vectube(2)=vectube(2)/tub_r
+      vectube(3)=vectube(3)/tub_r
+
+C calculte rdiffrence between r and r0
+      rdiff=tub_r-tubeR0
+C and its 6 power
+      rdiff6=rdiff**6.0d0
+C for vectorization reasons we will sumup at the end to avoid depenence of previous
+       sc_aa_tube=sc_aa_tube_par(iti)
+       sc_bb_tube=sc_bb_tube_par(iti)
+       enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
+C       enetube(i+nres)=0.0d0
+C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
+C now we calculate gradient
+       fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
+     &       6.0d0*sc_bb_tube/rdiff6/rdiff
+C       fac=0.0
+C now direction of gg_tube vector
+C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
+         if (acavtub(iti).eq.0.0d0) then
+C go to 667
+         enecavtube(i+nres)=0.0
+         faccav=0.0
+         else
+         denominator=(1.0+dcavtub(iti)*rdiff6*rdiff6)
+         enecavtube(i+nres)=
+     &   (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
+     &   /denominator
+C         enecavtube(i)=0.0
+         faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/sqrt(rdiff))
+     &   *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)
+     &   +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
+     &   /denominator**2.0d0
+C         faccav=0.0
+         fac=fac+faccav
+C 667     continue
+         endif
+C         print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
+C     &   enecavtube(i),faccav
+C         print *,"licz=",
+C     & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
+C         print *,"finene=",enetube(i+nres)+enecavtube(i)
+         do j=1,3
+          gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
+          gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
+         enddo
+        enddo
+C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
+C        do i=itube_start,itube_end
+C        enecav(i)=0.0        
+C        iti=itype(i)
+C        if (acavtub(iti).eq.0.0) cycle
+        
+
+
+        do i=itube_start,itube_end
+          Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
+     & +enecavtube(i+nres)
+        enddo
+C        print *,"ETUBE", etube
+        return
+        end
+C TO DO 1) add to total energy
+C       2) add to gradient summation
+C       3) add reading parameters (AND of course oppening of PARAM file)
+C       4) add reading the center of tube
+C       5) add COMMONs
+C       6) add to zerograd
+