read2sigma in wham and cluster_wham
[unres.git] / source / wham / src / energy_p_new.F
index 5cfdcce..13267da 100644 (file)
@@ -2,6 +2,7 @@
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
 
 #ifndef ISNAN
       external proc_proc
@@ -133,7 +134,7 @@ c      write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
      & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
      & +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+ehomology_constr
+     & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
      & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
      & +wdfa_beta*edfabet
 #else
@@ -144,7 +145,7 @@ c      write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
      & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
      & +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+ehomology_constr
+     & +wbond*estr+wsccor*fact(1)*esccor!+ehomology_constr
      & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
      & +wdfa_beta*edfabet
 #endif
@@ -1820,6 +1821,7 @@ C
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
       include 'COMMON.CONTROL'
       include 'COMMON.IOUNITS'
       include 'COMMON.GEO'
@@ -3149,7 +3151,7 @@ c MODELLER restraint function
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
-
+      include 'DIMENSIONS.FREE'
       integer nnn, i, j, k, ki, irec, l
       integer katy, odleglosci, test7
       real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template)
@@ -3180,7 +3182,7 @@ c
       include 'COMMON.SETUP'
       include 'COMMON.NAMES'
 
-      do i=1,19
+      do i=1,max_template
         distancek(i)=9999999.9
       enddo
 
@@ -3199,6 +3201,7 @@ c     write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d
          dij=dist(i,j)
 c        write (iout,*) "dij(",i,j,") =",dij
          do k=1,constr_homology
+           if(.not.l_homo(k,ii)) cycle
            distance(k)=odl(k,ii)-dij
 c          write (iout,*) "distance(",k,") =",distance(k)
 c
@@ -3218,7 +3221,17 @@ c
            endif
          enddo
          
-         min_odl=minval(distancek)
+c         min_odl=minval(distancek)
+         do kk=1,constr_homology
+          if(l_homo(kk,ii)) then 
+            min_odl=distancek(kk)
+            exit
+          endif
+         enddo
+         do kk=1,constr_homology
+          if(l_homo(kk,ii) .and. distancek(kk).lt.min_odl) 
+     &              min_odl=distancek(kk)
+         enddo
 c        write (iout,* )"min_odl",min_odl
 #ifdef DEBUG
          write (iout,*) "ij dij",i,j,dij
@@ -3231,6 +3244,7 @@ c        write (iout,* )"min_odl",min_odl
 c Nie wiem po co to liczycie jeszcze raz!
 c            odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/ 
 c     &              (2*(sigma_odl(i,j,k))**2))
+           if(.not.l_homo(k,ii)) cycle
            if (waga_dist.ge.0.0d0) then
 c
 c          For Gaussian-type Urestr
@@ -3281,6 +3295,7 @@ c            godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
 c     &           *waga_dist)+min_odl
 c          sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist
 c
+         if(.not.l_homo(k,ii)) cycle
          if (waga_dist.ge.0.0d0) then
 c          For Gaussian-type Urestr
 c
@@ -3744,6 +3759,7 @@ c
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
       include 'COMMON.LOCAL'
       include 'COMMON.GEO'
       include 'COMMON.INTERACT'
@@ -4070,6 +4086,7 @@ C
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
       include 'COMMON.LOCAL'
       include 'COMMON.GEO'
       include 'COMMON.INTERACT'
@@ -4099,7 +4116,7 @@ c      write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
           coskt(k)=dcos(k*theti2)
           sinkt(k)=dsin(k*theti2)
         enddo
-        if (i.gt.3  .and. itype(i-3).ne.ntyp1) then
+        if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then
 #ifdef OSF
           phii=phi(i)
           if (phii.ne.phii) phii=150.0
@@ -4551,6 +4568,7 @@ C
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
       include 'COMMON.GEO'
       include 'COMMON.LOCAL'
       include 'COMMON.VAR'
@@ -5202,6 +5220,7 @@ c        amino-acid residues.
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
       include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
       include 'COMMON.VAR'
       include 'COMMON.GEO'
       include 'COMMON.LOCAL'
@@ -5222,6 +5241,7 @@ c      write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor
       esccor=0.0D0
       do i=itau_start,itau_end
         esccor_ii=0.0D0
+        if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
         isccori=isccortyp(itype(i-2))
         isccori1=isccortyp(itype(i-1))
         phii=phi(i)
@@ -5255,11 +5275,9 @@ c   3 = SC...Ca...Ca...SCi
           cosphi=dcos(j*tauangle(intertyp,i))
           sinphi=dsin(j*tauangle(intertyp,i))
           esccor=esccor+v1ij*cosphi+v2ij*sinphi
-#define DEBUG
 #ifdef DEBUG
           esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
 #endif
-#undef DEBUG
           gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
         enddo
         gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
@@ -5596,6 +5614,10 @@ c     &         ' jj=',jj,' kk=',kk
 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. 
 C The system gains extra energy.
               ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
+#ifdef DEBUG
+              write (iout,*) "ecorr",i,j,i+1,j1,
+     &               ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
+#endif
               n_corr=n_corr+1
             else if (j1.eq.j) then
 C Contacts I-J and I-(J+1) occur simultaneously. 
@@ -5883,11 +5905,11 @@ cd    ees0pkl=0.0D0
 cd    ees0pij=1.0D0
 cd    ees0mkl=0.0D0
 cd    ees0mij=1.0D0
-c     write (iout,*)'Contacts have occurred for peptide groups',i,j,
-c    &   ' and',k,l
-c     write (iout,*)'Contacts have occurred for peptide groups',
-c    &  i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
-c    & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
+cd      write (iout,*)'Contacts have occurred for peptide groups',i,j,
+cd     &   ' and',k,l
+cd      write (iout,*)'Contacts have occurred for peptide groups',
+cd     &  i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
+cd     & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
 C Calculate the multi-body contribution to energy.
       ecorr=ecorr+ekont*ees
       if (calc_grad) then