& evdwij
endif
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
+ if (energy_dec) then
+ write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij
+ call flush(iout)
+ endif
C Calculate gradient components.
e1=e1*eps1*eps2rt**2*eps3rt**2
fac=-expon*(e1+evdwij)*rij_shift
gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
& +0.5d0*(pizda(1,1)+pizda(2,2))
C Cartesian derivatives
+!DIR$ UNROLL(0)
do l=1,3
c ghalf1=0.5d0*agg(l,1)
c ghalf2=0.5d0*agg(l,2)
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
+ include 'COMMON.CONTROL'
dimension ggg(3)
ehpb=0.0D0
+ do i=1,3
+ ggg(i)=0.0d0
+ enddo
+C write (iout,*) ,"link_end",link_end,constr_dist
cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
-cd write(iout,*)'link_start=',link_start,' link_end=',link_end
+c write(iout,*)'link_start=',link_start,' link_end=',link_end,
+c & " constr_dist",constr_dist
if (link_end.eq.0) return
do i=link_start,link_end
C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
+C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+C & iabs(itype(jjj)).eq.1) then
cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
if (.not.dyn_ss .and. i.le.nss) then
C 15/02/13 CC dynamic SSbond - additional check
- if (ii.gt.nres
- & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
- call ssbond_ene(iii,jjj,eij)
- ehpb=ehpb+2*eij
+ if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+ & iabs(itype(jjj)).eq.1) then
+ call ssbond_ene(iii,jjj,eij)
+ ehpb=ehpb+eij
endif
cd write (iout,*) "eij",eij
- else if (ii.gt.nres .and. jj.gt.nres) then
-c Restraints from contact prediction
- dd=dist(ii,jj)
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "beta nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- else
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-c write (iout,*) "beta reg",dd,waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
- endif
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
- else
+cd & ' waga=',waga,' fac=',fac
+! else if (ii.gt.nres .and. jj.gt.nres) then
+ else
C Calculate the distance between the two points and its difference from the
C target distance.
dd=dist(ii,jj)
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ if (irestr_type(i).eq.11) then
+ ehpb=ehpb+fordepth(i)!**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)!**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)')
+ & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
+ & ehpb,irestr_type(i)
+ else if (irestr_type(i).eq.10) then
+c AL 6//19/2018 cross-link restraints
+ xdis = 0.5d0*(dd/forcon(i))**2
+ expdis = dexp(-xdis)
+c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i)
+ aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i)
+c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux,
+c & " wboltzd",wboltzd
+ ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux)
+c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i))
+ fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i))
+ & *expdis/(aux*forcon(i)**2)
+ if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)')
+ & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),
+ & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i)
+ else if (irestr_type(i).eq.2) then
+c Quartic restraints
+ ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
+ & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
+ & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i)
fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "alph nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
else
+c Quadratic restraints
rdis=dd-dhpb(i)
C Get the force constant corresponding to this distance.
waga=forcon(i)
C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-c write (iout,*) "alpha reg",dd,waga*rdis*rdis
+ ehpb=ehpb+0.5d0*waga*rdis*rdis
+ if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)')
+ & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),
+ & 0.5d0*waga*rdis*rdis,irestr_type(i)
C
C Evaluate gradient.
C
fac=waga*rdis/dd
endif
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
+c Calculate Cartesian gradient
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
C If this is a SC-SC distance, we need to calculate the contributions to the
C Cartesian gradient in the SC vectors (ghpbx).
if (iii.lt.ii) then
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
endif
cgrad do j=iii,jjj-1
cgrad do k=1,3
enddo
endif
enddo
- ehpb=0.5D0*ehpb
return
end
C--------------------------------------------------------------------------
diff=vbld(i+nres)-vbldsc0(1,iti)
c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
c & AKSC(1,iti),AKSC(1,iti)*diff*diff
- if (energy_dec) write (iout,*)
- & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
- & AKSC(1,iti),AKSC(1,iti)*diff*diff
+ if (energy_dec) then
+ write (iout,*)
+ & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
+ & AKSC(1,iti),AKSC(1,iti)*diff*diff
+ call flush(iout)
+ endif
estr=estr+0.5d0*AKSC(1,iti)*diff*diff
do j=1,3
gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
sinkt(k)=dsin(k*theti2)
enddo
C if (i.gt.3) then
- 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
c & dscp1,dscp2,sumene
c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
-c write (2,*) "i",i," escloc",sumene,escloc
+ if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
+ & 'escloc',i,sumene
#ifdef DEBUG
C
C This section to check the numerical derivatives of the energy of ith side
c
- do i=1,19
+ do i=1,max_template
distancek(i)=9999999.9
enddo
j = jres_homo(ii)
dij=dist(i,j)
c write (iout,*) "dij(",i,j,") =",dij
+ nexl=0
do k=1,constr_homology
c write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii)
- if(.not.l_homo(k,ii)) cycle
+ if(.not.l_homo(k,ii)) then
+ nexl=nexl+1
+ cycle
+ endif
distance(k)=odl(k,ii)-dij
c write (iout,*) "distance(",k,") =",distance(k)
c
& (distance(k)**2+sigma_odlir(k,ii)**2))
endif
enddo
+c write (iout,*) "distance: ii",ii," nexl",nexl
- 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
write (iout,*) "distancek",(distancek(k),k=1,constr_homology)
write (iout,* )"min_odl",min_odl
#endif
+#ifdef OLDRESTR
odleg2=0.0d0
+#else
+ if (waga_dist.ge.0.0d0) then
+ odleg2=nexl
+ else
+ odleg2=0.0d0
+ endif
+#endif
do k=1,constr_homology
c Nie wiem po co to liczycie jeszcze raz!
c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/
enddo
#endif
do i=idihconstr_start_homo,idihconstr_end_homo
- kat2=0.0d0
c betai=beta(i,i+1,i+2,i+3)
- betai = phi(i+3)
+ betai = phi(i)
c write (iout,*) "betai =",betai
+ kat2=0.0d0
do k=1,constr_homology
dih_diff(k)=pinorm(dih(k,i)-betai)
c write (iout,*) "dih_diff(",k,") =",dih_diff(k)
c & -(6.28318-dih_diff(i,k))
c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
c & 6.28318+dih_diff(i,k)
-
+#ifdef OLD_DIHED
kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#else
+ kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument
+#endif
c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i)
gdih(k)=dexp(kat3)
kat2=kat2+gdih(k)
-c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
-c write(*,*)""
+c write(iout,*) "i",i," k",k," sigma",sigma_dih(k,i),
+c & " kat2=", kat2, "gdih=",gdih(k)
enddo
c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps
c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps
sum_gdih=kat2
sum_sgdih=0.0d0
do k=1,constr_homology
+#ifdef OLD_DIHED
sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd
+#else
+ sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd
+#endif
c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle
sum_sgdih=sum_sgdih+sgdih
enddo
c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
ccc & gloc(nphi+i-3,icg)
- gloc(i,icg)=gloc(i,icg)+grad_dih3
+ gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3
c if (i.eq.25) then
c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg)
c endif
utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument
c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta?
gtheta(k)=dexp(utheta_i) ! + min_utheta_i?
- gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk)
+ gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk)
+c write (iout,*) "i",i," k",k," sigma_theta",sigma_theta(k,i),
+c & " gtheta",gtheta(k)
c Gradient for single Gaussian restraint in subr Econstr_back
c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
c
c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d?
c uscdiffk(k)=usc_diff(i)
guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff
- guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk)
+c write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i),
+c & " guscdiff2",guscdiff2(k)
+ guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk)
c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
c & xxref(j),yyref(j),zzref(j)
enddo
c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_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))
do intertyp=1,3 !intertyp
+ esccor_ii=0.0D0
cc Added 09 May 2012 (Adasko)
cc Intertyp means interaction type of backbone mainchain correlation:
c 1 = SC...Ca...Ca...Ca
v2ij=v2sccor(j,intertyp,isccori,isccori1)
cosphi=dcos(j*tauangle(intertyp,i))
sinphi=dsin(j*tauangle(intertyp,i))
+ if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
esccor=esccor+v1ij*cosphi+v2ij*sinphi
gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
enddo
+ if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)')
+ & 'esccor',i,intertyp,esccor_ii
gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
c &gloc_sc(intertyp,i-3,icg)
projects / unres.git / blobdiff