introduction of infinite cylinder potential - currently without PBC
[unres.git] / source / unres / src_MD-M / energy_p_new_barrier.F
index 4a47935..e86bb6e 100644 (file)
@@ -55,6 +55,8 @@ C FG slaves as WEIGHTS array.
           weights_(17)=wbond
           weights_(18)=scal14
           weights_(21)=wsccor
+          weights_(22)=wtube
+
 C FG Master broadcasts the WEIGHTS_ array
           call MPI_Bcast(weights_(1),n_ene,
      &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
@@ -81,6 +83,7 @@ C FG slaves receive the WEIGHTS array
           wbond=weights(17)
           scal14=weights(18)
           wsccor=weights(21)
+          wtube=weights(22)
         endif
         time_Bcast=time_Bcast+MPI_Wtime()-time00
         time_Bcastw=time_Bcastw+MPI_Wtime()-time00
@@ -304,6 +307,13 @@ C      print *,"za lipidami"
       else if (selfguide.gt.0) then
         call AFMvel(Eafmforce)
       endif
+      if (TUBElog.gt.0) then
+C      print *,"just before call"
+        call calctube(Etube)
+       else
+       Etube=0.0d0
+       endif
+
 #ifdef TIMING
       time_enecalc=time_enecalc+MPI_Wtime()-time00
 #endif
@@ -348,6 +358,7 @@ C
       energia(22)=eliptran
       energia(23)=Eafmforce
       energia(24)=ethetacnstr
+      energia(25)=Etube
 c    Here are the energies showed per procesor if the are more processors 
 c    per molecule then we sum it up in sum_energy subroutine 
 c      print *," Processor",myrank," calls SUM_ENERGY"
@@ -442,6 +453,7 @@ cMS$ATTRIBUTES C ::  proc_proc
       eliptran=energia(22)
       Eafmforce=energia(23)
       ethetacnstr=energia(24)
+      Etube=energia(25)
 #ifdef SPLITELE
       etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
      & +wang*ebe+wtor*etors+wscloc*escloc
@@ -449,7 +461,7 @@ cMS$ATTRIBUTES C ::  proc_proc
      & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
      & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
-     & +ethetacnstr
+     & +ethetacnstr+wtube*Etube
 #else
       etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
      & +wang*ebe+wtor*etors+wscloc*escloc
@@ -458,7 +470,7 @@ cMS$ATTRIBUTES C ::  proc_proc
      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
      & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
      & +Eafmforce
-     & +ethetacnstr
+     & +ethetacnstr+wtube*Etube
 #endif
       energia(0)=etot
 c detecting NaNQ
@@ -568,6 +580,8 @@ c      enddo
      &                 +wturn3*gshieldc_t3(j,i)
      &                 +wturn4*gshieldc_t4(j,i)
      &                 +wel_loc*gshieldc_ll(j,i)
+     &                +wtube*gg_tube(j,i)
+
 
 
         enddo
@@ -591,6 +605,8 @@ c      enddo
      &                 +wcorr*gshieldc_ec(j,i)
      &                 +wturn4*gshieldc_t4(j,i)
      &                 +wel_loc*gshieldc_ll(j,i)
+     &                +wtube*gg_tube(j,i)
+
 
 
         enddo
@@ -747,11 +763,7 @@ C          print *,gradafm(1,13),"AFM"
      &                 +wturn4*gshieldc_loc_t4(j,i)
      &                 +wel_loc*gshieldc_ll(j,i)
      &                 +wel_loc*gshieldc_loc_ll(j,i)
-
-
-
-
-
+     &                +wtube*gg_tube(j,i)
 
 #else
           gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
@@ -784,9 +796,7 @@ C          print *,gradafm(1,13),"AFM"
      &                 +wturn4*gshieldc_loc_t4(j,i)
      &                 +wel_loc*gshieldc_ll(j,i)
      &                 +wel_loc*gshieldc_loc_ll(j,i)
-
-
-
+     &                +wtube*gg_tube(j,i)
 
 
 #endif
@@ -801,6 +811,7 @@ C          print *,gradafm(1,13),"AFM"
      &                 +wturn3*gshieldx_t3(j,i)
      &                 +wturn4*gshieldx_t4(j,i)
      &                 +wel_loc*gshieldx_ll(j,i)
+     &                 +wtube*gg_tube_sc(j,i)
 
 
 
@@ -1101,6 +1112,7 @@ C------------------------------------------------------------------------
       eliptran=energia(22)
       Eafmforce=energia(23) 
       ethetacnstr=energia(24)
+      etube=energia(25)
 #ifdef SPLITELE
       write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
      &  estr,wbond,ebe,wang,
@@ -1109,6 +1121,7 @@ C------------------------------------------------------------------------
      &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
      &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,
      &  ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
+     &  etube,wtube,
      &  etot
    10 format (/'Virtual-chain energies:'//
      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
@@ -1136,6 +1149,7 @@ C------------------------------------------------------------------------
      & 'UCONST= ',1pE16.6,' (Constraint energy)'/ 
      & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
      & 'EAFM=  ',1pE16.6,' (atomic-force microscopy)'/
+     & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
      & 'ETOT=  ',1pE16.6,' (total)')
 
 #else
@@ -1146,6 +1160,7 @@ C------------------------------------------------------------------------
      &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
      &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
      &  ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
+     &  etube,wtube,
      &  etot
    10 format (/'Virtual-chain energies:'//
      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
@@ -1172,6 +1187,7 @@ C------------------------------------------------------------------------
      & 'UCONST=',1pE16.6,' (Constraint energy)'/ 
      & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
      & 'EAFM=  ',1pE16.6,' (atomic-force microscopy)'/
+     & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/
      & 'ETOT=  ',1pE16.6,' (total)')
 #endif
       return
@@ -4682,6 +4698,7 @@ C        fac_shield(j)=0.6
      &  *fac_shield(i)*fac_shield(j)
         eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
      &  *fac_shield(i)*fac_shield(j)
+C#ifdef NEWCORR
 C Derivatives in theta
         gloc(nphi+i,icg)=gloc(nphi+i,icg)
      &  +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
@@ -4689,7 +4706,7 @@ C Derivatives in theta
         gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
      &  +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
      &   *fac_shield(i)*fac_shield(j)
-
+C#endif
 
 C        if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
 C Derivatives in shield mode
@@ -11670,4 +11687,126 @@ C      write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
       enddo
       return
       end
+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.NAMES'
+      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=1,2*nres
+        enetube(i)=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=1,nres
+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
+      vectube(1)=(c(1,i)+c(1,i+1))/2.0d0-tubecenter(1)
+      vectube(2)=(c(2,i)+c(2,i+1))/2.0d0-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)
+        do i=1,nres
+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
+      vectube(1)=c(1,i+nres)-tubecenter(1)
+      vectube(2)=c(2,i+nres)-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=1,2*nres
+          Etube=Etube+enetube(i)
+        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