1 double precision function qwolynes(ilevel,jfrag,kkk)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.COMPAR'
6 include 'COMMON.IOUNITS'
7 include 'COMMON.COMPAR'
9 include 'COMMON.INTERACT'
10 include 'COMMON.CONTROL'
11 integer ilevel,jfrag,kkk
12 integer i,j,jl,k,l,il,kl,nl,np,ip,kp
16 double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM
17 logical lprn /.false./
18 double precision sigm,x
20 c write (iout,*) "QWolyes: " jfrag",jfrag,
22 c write (iout,*) "qwolynes: permutation",kkk
25 if (lprn) write (iout,*) "Q computed for whole molecule"
28 if (itype(il).eq.ntyp1) cycle
30 if (itype(jl).eq.ntyp1) cycle
38 d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
39 & (cref(2,jl)-cref(2,il))**2+
40 & (cref(3,jl)-cref(3,il))**2)
41 dij=dist(iperm(il,kkk),iperm(jl,kkk))
42 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
43 if (itype(il).ne.10 .or. itype(jl).ne.10) then
46 & (cref(1,jl+nres)-cref(1,il+nres))**2+
47 & (cref(2,jl+nres)-cref(2,il+nres))**2+
48 & (cref(3,jl+nres)-cref(3,il+nres))**2)
49 dijCM=dist(iperm(il,kkk)+nres,iperm(jl,kkk)+nres)
50 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
54 write (iout,*) "il",il," jl",jl,
55 & " itype",itype(il),itype(jl)
56 write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,
57 & " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
62 if (lprn) write (iout,*) "nl",nl," qq",qq
63 else if (ilevel.eq.1) then
64 if (lprn) write (iout,*) "Level",ilevel," fragment",jfrag
66 c write (iout,*) "nlist_frag",nlist_frag(jfrag)
67 do i=2,nlist_frag(jfrag)
71 if (itype(il).eq.ntyp1.or.itype(jl).eq.ntyp1) cycle
72 if (iabs(il-jl).gt.nsep) then
80 d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
81 & (cref(2,jl)-cref(2,il))**2+
82 & (cref(3,jl)-cref(3,il))**2)
83 dij=dist(iperm(il,kkk),iperm(jl,kkk))
84 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
85 if (itype(il).ne.10 .or. itype(jl).ne.10) then
88 & (cref(1,jl+nres)-cref(1,il+nres))**2+
89 & (cref(2,jl+nres)-cref(2,il+nres))**2+
90 & (cref(3,jl+nres)-cref(3,il+nres))**2)
91 dijCM=dist(iperm(il,kkk)+nres,
92 & iperm(iperm(jl,kkk),kkk)+nres)
93 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
97 write (iout,*) "i",i," j",j," il",il," jl",jl,
98 & " itype",itype(il),itype(jl)
99 write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,
100 & " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
106 if (lprn) write (iout,*) "nl",nl," qq",qq
107 else if (ilevel.eq.2) then
108 np=npiece(jfrag,ilevel)
111 ip=ipiece(i,jfrag,ilevel)
112 do j=1,nlist_frag(ip)
114 if (itype(il).eq.ntyp1) cycle
116 kp=ipiece(k,jfrag,ilevel)
117 do l=1,nlist_frag(kp)
119 if (itype(kl).eq.ntyp1) cycle
120 if (iabs(kl-il).gt.nsep) then
128 d0ij=dsqrt((cref(1,kl)-cref(1,il))**2+
129 & (cref(2,kl)-cref(2,il))**2+
130 & (cref(3,kl)-cref(3,il))**2)
131 dij=dist(iperm(il,kkk),iperm(kl,kkk))
132 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
133 if (itype(il).ne.10 .or. itype(kl).ne.10) then
136 & (cref(1,kl+nres)-cref(1,il+nres))**2+
137 & (cref(2,kl+nres)-cref(2,il+nres))**2+
138 & (cref(3,kl+nres)-cref(3,il+nres))**2)
139 dijCM=dist(iperm(il,kkk)+nres,iperm(kl,kkk)+nres)
140 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/
141 & (sigm(d0ijCM)))**2)
145 write (iout,*) "i",i," j",j," k",k," l",l," il",il,
146 & " kl",kl," itype",itype(il),itype(kl)
147 write (iout,*) " d0ij",d0ij," dij",dij," d0ijCM",
148 & d0ijCM," dijCM",dijCM," qqij",qqij," qqijCM",qqijCM
156 if (lprn) write (iout,*) "nl",nl," qq",qq
158 write (iout,*)"Error: Q can be computed only for level 1 and 2."
163 c-------------------------------------------------------------------------------
164 subroutine fragment_list
167 include 'DIMENSIONS.ZSCOPT'
168 include 'DIMENSIONS.COMPAR'
169 include 'COMMON.IOUNITS'
170 include 'COMMON.COMPAR'
171 logical lprn /.true./
172 integer i,ilevel,j,k,jfrag
175 do i=1,npiece(jfrag,1)
176 if (lprn) write (iout,*) "jfrag=",jfrag,
177 & "i=",i," fragment",ifrag(1,i,jfrag),
179 do j=ifrag(1,i,jfrag),ifrag(2,i,jfrag)
180 do k=1,nlist_frag(jfrag)
181 if (list_frag(k,jfrag).eq.j) goto 10
183 nlist_frag(jfrag)=nlist_frag(jfrag)+1
184 list_frag(nlist_frag(jfrag),jfrag)=j
189 write (iout,*) "Fragment list"
191 write (iout,*)"Fragment",j," list",(list_frag(k,j),