1 double precision function qwolynes(ilevel,jfrag)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.COMPAR'
6 include 'DIMENSIONS.FREE'
7 include 'COMMON.IOUNITS'
8 include 'COMMON.COMPAR'
10 include 'COMMON.INTERACT'
11 include 'COMMON.CONTROL'
12 integer ilevel,jfrag,kkk
13 integer i,j,jl,k,l,il,kl,nl,np,ip,kp
15 double precision dist,tempus(maxperm),maxiQ
16 double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM
17 logical lprn /.false./
18 double precision sigm,x
25 c write (iout,*) "QWolyes: " jfrag",jfrag,
30 if (lprn) write (iout,*) "Q computed for whole molecule"
41 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+
42 & (cref(2,jl,kkk)-cref(2,il,kkk))**2+
43 & (cref(3,jl,kkk)-cref(3,il,kkk))**2)
45 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
46 if (itype(il).ne.10 .or. itype(jl).ne.10) then
49 & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+
50 & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+
51 & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
52 dijCM=dist(il+nres,jl+nres)
53 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
57 write (iout,*) "il",il," jl",jl,
58 & " itype",itype(il),itype(jl)
59 write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,
60 & " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
65 if (lprn) write (iout,*) "nl",nl," qq",qq
66 else if (ilevel.eq.1) then
67 if (lprn) write (iout,*) "Level",ilevel," fragment",jfrag
69 c write (iout,*) "nlist_frag",nlist_frag(jfrag)
70 do i=2,nlist_frag(jfrag)
74 if (iabs(il-jl).gt.nsep) then
82 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+
83 & (cref(2,jl,kkk)-cref(2,il,kkk))**2+
84 & (cref(3,jl,kkk)-cref(3,il,kkk))**2)
86 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
87 if (itype(il).ne.10 .or. itype(jl).ne.10) then
90 & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+
91 & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+
92 & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
93 dijCM=dist(il+nres,jl+nres)
94 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
98 write (iout,*) "i",i," j",j," il",il," jl",jl,
99 & " itype",itype(il),itype(jl)
100 write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,
101 & " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
107 if (lprn) write (iout,*) "nl",nl," qq",qq
108 else if (ilevel.eq.2) then
109 np=npiece(jfrag,ilevel)
112 ip=ipiece(i,jfrag,ilevel)
113 do j=1,nlist_frag(ip)
116 kp=ipiece(k,jfrag,ilevel)
117 do l=1,nlist_frag(kp)
119 if (iabs(kl-il).gt.nsep) then
127 d0ij=dsqrt((cref(1,kl,kkk)-cref(1,il,kkk))**2+
128 & (cref(2,kl,kkk)-cref(2,il,kkk))**2+
129 & (cref(3,kl,kkk)-cref(3,il,kkk))**2)
131 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
132 if (itype(il).ne.10 .or. itype(kl).ne.10) then
135 & (cref(1,kl+nres,kkk)-cref(1,il+nres,kkk))**2+
136 & (cref(2,kl+nres,kkk)-cref(2,il+nres,kkk))**2+
137 & (cref(3,kl+nres,kkk)-cref(3,il+nres,kkk))**2)
138 dijCM=dist(il+nres,kl+nres)
139 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/
140 & (sigm(d0ijCM)))**2)
144 write (iout,*) "i",i," j",j," k",k," l",l," il",il,
145 & " kl",kl," itype",itype(il),itype(kl)
146 write (iout,*) " d0ij",d0ij," dij",dij," d0ijCM",
147 & d0ijCM," dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
155 if (lprn) write (iout,*) "nl",nl," qq",qq
157 write (iout,*)"Error: Q can be computed only for level 1 and 2."
162 if (maxiQ.le.tempus(kkk)) maxiQ=tempus(kkk)
167 c-------------------------------------------------------------------------------
168 subroutine fragment_list
171 include 'DIMENSIONS.ZSCOPT'
172 include 'DIMENSIONS.COMPAR'
173 include 'COMMON.IOUNITS'
174 include 'COMMON.COMPAR'
175 logical lprn /.true./
176 integer i,ilevel,j,k,jfrag
179 do i=1,npiece(jfrag,1)
180 if (lprn) write (iout,*) "jfrag=",jfrag,
181 & "i=",i," fragment",ifrag(1,i,jfrag),
183 do j=ifrag(1,i,jfrag),ifrag(2,i,jfrag)
184 do k=1,nlist_frag(jfrag)
185 if (list_frag(k,jfrag).eq.j) goto 10
187 nlist_frag(jfrag)=nlist_frag(jfrag)+1
188 list_frag(nlist_frag(jfrag),jfrag)=j
193 write (iout,*) "Fragment list"
195 write (iout,*)"Fragment",j," list",(list_frag(k,j),