1 subroutine Econstr_back_qlike
2 c MD with umbrella_sampling using Wolyne's distance measure as a constraint
3 implicit real*8 (a-h,o-z)
5 include 'COMMON.CONTROL'
7 include 'COMMON.QRESTR'
11 include 'COMMON.LOCAL'
12 include 'COMMON.INTERACT'
13 include 'COMMON.IOUNITS'
14 include 'COMMON.NAMES'
15 include 'COMMON.TIME1'
16 double precision sigmaang/0.1d0/,sigmadih /0.1d0/,sigmasc /0.1d0/
17 c double precision sigmaang/0.2d0/,sigmadih /0.4d0/,sigmasc /0.5d0/
18 double precision auxvec(maxres),auxtab(3,maxres),
19 & auxtab1(3,maxres),auxtabx(3,maxres)
29 c write (iout,*) "Econstr_back_qlike",nfrag_back," iset",iset
31 if (wfrag_back(1,i,iset).gt.0.0d0) then
32 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
33 c write (iout,*) "i",i," ifrag_back",ifrag_back(1,i,iset),
34 c & ifrag_back(2,i,iset)," ii",ii
36 c Deviations from theta angles
39 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
40 dtheta_i=theta(j)-thetaref(j)
41 expthet=dexp(-0.5d0*dtheta_i*dtheta_i/sigmaang)
42 c expthet=0.5d0*dtheta_i*dtheta_i
43 utheta_i=utheta_i+expthet
44 auxvec(j-2)=expthet*dtheta_i/sigmaang
45 c auxvec(j-2)=dtheta_i
46 c write (iout,*) "j",j," theta",theta(j)," thetaref",thetaref(j)
47 c write (iout,*) "expthet",expthet
49 qloc(1,i)=1.0d0-utheta_i/(ii-1)
50 c qloc(1,i,iset)=utheta_i/(ii-1)
51 c utheta(i)=(qloc(1,i,iset)-qin_back(1,i,iset))**2
52 utheta(i)=(qloc(1,i)-qin_back(1,i,iset))**2
53 c utheta(i)=qloc(1,i,iset)
54 c write (iout,*) "utheta",utheta(i)
55 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
56 c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*auxvec(j-2)
58 dutheta(j-2)=dutheta(j-2)+2*wfrag_back(1,i,iset)*auxvec(j-2)
59 & *(qloc(1,i)-qin_back(1,i,iset))/(ii-1)
60 c write (iout,*) i,j," dutheta",dutheta(j-2)
64 c Deviations from gamma angles
66 if (wfrag_back(2,i,iset).gt.0.0d0) then
68 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
69 dgamma_i=pinorm(phi(j)-phiref(j))
70 c write (iout,*) j,phi(j),phi(j)-phiref(j)
71 expgam=dexp(-0.5d0*dgamma_i*dgamma_i/sigmadih)
72 ugamma_i=ugamma_i+expgam
73 auxvec(j-3)=expgam*dgamma_i/sigmadih
75 qloc(2,i)=1.0d0-ugamma_i/(ii-2)
76 ugamma(i)=(qloc(2,i)-qin_back(2,i,iset))**2
77 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
78 dugamma(j-3)=dugamma(j-3)+2*wfrag_back(2,i,iset)*auxvec(j-3)*
79 & (qloc(2,i)-qin_back(2,i,iset))/(ii-2)
80 c write (iout,*) i,j," dugamma",dugamma(j-3)
84 c Deviations from local SC geometry
86 if (wfrag_back(3,i,iset).gt.0.0d0) then
88 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
89 c write (iout,*) "uscdif j=",j
90 if (itype(j).ne.10) then
94 expsc=dexp(-0.5d0*(dxx*dxx+dyy*dyy+dzz*dzz)/sigmasc)
99 & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)
101 & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)
103 & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz)
105 c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
106 c & xxref(j),yyref(j),zzref(j)
109 qloc(3,i)=1.0d0-usc_i/(ii-1)
110 uscdiff(i)=(qloc(3,i)-qin_back(3,i,iset))**2
111 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
112 if (itype(j).ne.10) then
114 duscdiff(k,j-1)=duscdiff(k,j-1)+2*wfrag_back(3,i,iset)
115 & *auxtab1(k,j-1)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
116 duscdiff(k,j)=duscdiff(k,j)+2*wfrag_back(3,i,iset)
117 & *auxtab(k,j)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
118 duscdiffx(k,j)=duscdiffx(k,j)+2*wfrag_back(3,i,iset)
119 & *auxtabx(k,j)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
121 c write (iout,*) i,j," duscdiff",(duscdiff(k,j),k=1,3)
124 c write (iout,*) i," uscdiff",uscdiff(i)
127 c Put together deviations from local geometry
129 c Uconst_back=Uconst_back+
130 c & wfrag_back(3,i,iset)*uscdiff(i)
131 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
132 & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
133 c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
134 c & " uscdiff",uscdiff(i)," uconst_back",uconst_back