ifdef poporawa
[unres4.git] / source / unres / energy.f90
index 565c695..4065e96 100644 (file)
@@ -45,6 +45,7 @@
       real(kind=8),dimension(:,:,:),allocatable :: gacont      !(3,maxconts,maxres)
       integer,dimension(:),allocatable :: ishield_list
       integer,dimension(:,:),allocatable ::  shield_list
+      real(kind=8),dimension(:),allocatable :: enetube,enecavtube
 !                
 ! 12/26/95 - H-bonding contacts
 !      common /contacts_hb/ 
               usumsqder=usumsqder+ud(j)*uprod2   
             enddo
             estr=estr+uprod/usum
+             if (energy_dec) write (iout,*) &
+            "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
+            AKSC(1,iti),AKSC(1,iti)*diff*diff
             do j=1,3
              gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
             enddo
@@ -18327,7 +18331,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !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)
-      real(kind=8) :: vectube(3),enetube(nres*2)
+      real(kind=8),dimension(3) :: vectube
       real(kind=8) :: Etube,xtemp,xminact,yminact,& 
        ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
        sc_aa_tube,sc_bb_tube
@@ -18488,7 +18492,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !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)
-      real(kind=8) :: vectube(3),enetube(nres*2)
+            real(kind=8),dimension(3) :: vectube
       real(kind=8) :: Etube,xtemp,xminact,yminact,&
        ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
        sstube,ssgradtube,sc_aa_tube,sc_bb_tube
@@ -18725,8 +18729,8 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
         end subroutine calctube2
 !=====================================================================================================================================
       subroutine calcnano(Etube)
-      real(kind=8) :: vectube(3),enetube(nres*2), &
-      enecavtube(nres*2)
+      real(kind=8),dimension(3) :: vectube
+      
       real(kind=8) :: Etube,xtemp,xminact,yminact,&
        ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
        sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
@@ -18826,7 +18830,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !C         fac=fac+faccav
 !C 667     continue
          endif
-
+          if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
         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
@@ -18929,6 +18933,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
           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
+          if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
         enddo
 
 
@@ -19552,6 +19557,9 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
       allocate(shield_list(50,nres))
       allocate(dyn_ss_mask(nres))
       allocate(fac_shield(nres))
+      allocate(enetube(nres*2))
+      allocate(enecavtube(nres*2))
+
 !(maxres)
       dyn_ss_mask(:)=.false.
 !----------------------