source: bgs.f@ cb47b9c

Last change on this file since cb47b9c was cb47b9c, checked in by baerbaer <baerbaer@…>, 14 years ago

Explicitly declare variables.

All variables should be declared so that we can remove the implicit statements
from the beginning of the INCL.H file.

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@25 26dc1dd8-5c4e-0410-9ffe-d298b4865968

  • Property mode set to 100644
File size: 10.0 KB
Line 
1! ****************************************************************
2! Trial version implementing the semi-local conformational update
3! BGS (Biased Gaussian Steps). This file presently contains the
4! functions initlund, bgsposs and bgs.
5!
6! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
7! Jan H. Meinke, Sandipan Mohanty
8! ****************************************************************
9
10
11! Checks if it is possible to perform a BGS update starting at the
12! variable indexed ipos. Calls: none.
13 logical function bgsposs(ips)
14 include 'INCL.H'
15 include 'incl_lund.h'
16 logical ians
17
18 jv=idvr(ips)
19 iaa=nursvr(jv)
20 ians=.true.
21! print *,'evaluating bgs possibility for ',ips,nmvr(jv)
22 if (nmvr(jv).ne.'phi') then
23! print *,'bgs not possible because variable name is ',nmvr(jv)
24 ians=.false.
25 else if (iaa.gt.(irsml2(mlvr(jv))-3)) then
26! print *,'bgs impossible, residue too close to end'
27! print *,'iaa = ',iaa,' end = ',irsml2(mlvr(jv))
28 ians=.false.
29 else
30 nnonfx=0
31 do i=iaa,iaa+3
32 if (iphi(i).gt.0) then
33 if (.not.fxvr(iphi(i))) then
34 nnonfx=nnonfx+1
35 endif
36 endif
37 if (.not.fxvr(ipsi(i))) then
38 nnonfx=nnonfx+1
39 endif
40 enddo
41 if (nnonfx.lt.6) then
42! print *,iaa,'bgs impossible because ndof = ',nnonfx
43 ians=.false.
44 endif
45 endif
46 if (ians) then
47! print *,'bgs is possible for angle ',ips,jv,nmvr(jv)
48 endif
49 bgsposs=ians
50 return
51 end
52
53! Biased Gaussian Steps. Implements a semi-local conformational update
54! which modifies the protein backbone locally in a certain range of
55! amino acids. The 'down-stream' parts of the molecule outside the
56! region of update get small rigid body translations and rotations.
57!
58! Use the update sparingly. It is rather local, and is not of great
59! value if we need big changes in the conformation. It is recommended
60! that this update be used to refine a structure around a low energy
61! candidate structure. Even at low energies, if you always
62! perform BGS, the chances of coming out of that minimum are small.
63! So, there is a probability bgsprob, which decides whether BGS or the
64! normal single angle update is used.
65!
66! Calls: energy, dummy (function provided as argument), addang, (rand)
67!
68
69 integer function bgs(eol1,dummy)
70 include 'INCL.H'
71 include 'incl_lund.h'
72 external dummy
73 dimension xiv(8,3),bv(8,3),rv(3,3),dv(3,8,3)
74 dimension ab(8), A(8,8),p(8),ppsi(8)
75 double precision ovr(mxvr)
76! Initialize
77! print *,'using BGS on angle ',nmvr(idvr(ivar))
78 if (bgsnvar.eq.0) then
79 bgs=0
80 goto 171
81 endif
82 ivar=1+grnd()*bgsnvar
83 do i=1,8
84 iph(i)=-50000
85 dph(i)=0
86 enddo
87 nph=0
88 jv=idvr(ivar)
89 ia=nursvr(jv)
90! Get BGS matrices based on coordinates of atoms in 4 amino acids
91 do i=1,4
92 icurraa=ia+i-1
93 if (iphi(icurraa).gt.0.and..not.fxvr(iphi(icurraa))) then
94 nph=nph+1
95 xiv(nph,1)=xat(iCa(icurraa))
96 xiv(nph,2)=yat(iCa(icurraa))
97 xiv(nph,3)=zat(iCa(icurraa))
98 bv(nph,1)=xiv(nph,1)-xat(iN(icurraa))
99 bv(nph,2)=xiv(nph,2)-yat(iN(icurraa))
100 bv(nph,3)=xiv(nph,3)-zat(iN(icurraa))
101 ab(nph)=bv(nph,1)*bv(nph,1)+bv(nph,2)*bv(nph,2)
102 & +bv(nph,3)*bv(nph,3)
103 iph(nph)=iphi(icurraa)
104 endif
105 if (.not.fxvr(ipsi(icurraa))) then
106 nph=nph+1
107 xiv(nph,1)=xat(iC(icurraa))
108 xiv(nph,2)=yat(iC(icurraa))
109 xiv(nph,3)=zat(iC(icurraa))
110 bv(nph,1)=xiv(nph,1)-xat(iCa(icurraa))
111 bv(nph,2)=xiv(nph,2)-yat(iCa(icurraa))
112 bv(nph,3)=xiv(nph,3)-zat(iCa(icurraa))
113 ab(nph)=bv(nph,1)*bv(nph,1)+bv(nph,2)*bv(nph,2)
114 & +bv(nph,3)*bv(nph,3)
115 iph(nph)=ipsi(icurraa)
116 endif
117 enddo
118 rv(1,1)=xat(iCa(ia+3))
119 rv(1,2)=yat(iCa(ia+3))
120 rv(1,3)=zat(iCa(ia+3))
121 rv(2,1)=xat(iC(ia+3))
122 rv(2,2)=yat(iC(ia+3))
123 rv(2,3)=zat(iC(ia+3))
124 rv(3,1)=xat(iC(ia+3)+1)
125 rv(3,2)=yat(iC(ia+3)+1)
126 rv(3,3)=zat(iC(ia+3)+1)
127
128 do i=1,3
129 do j=1,nph
130 dv(i,j,1)=(1.0/ab(j))*(bv(j,2)*(rv(i,3)-xiv(j,3))-
131 & bv(j,3)*(rv(i,2)-xiv(j,2)))
132 dv(i,j,2)=(-1.0/ab(j))*(bv(j,1)*(rv(i,3)-xiv(j,3))-
133 & bv(j,3)*(rv(i,1)-xiv(j,1)))
134 dv(i,j,3)=(1.0/ab(j))*(bv(j,1)*(rv(i,2)-xiv(j,2))-
135 & bv(j,2)*(rv(i,1)-xiv(j,1)))
136 enddo
137 enddo
138 do i=1,nph
139 do j=i,nph
140 A(i,j)=0
141 do k=1,3
142 do l=1,3
143 A(i,j)=A(i,j)+dv(k,i,l)*(dv(k,j,l))
144 enddo
145 enddo
146 A(i,j)=bbgs*A(i,j)
147 if (i.eq.j) then
148 A(i,j)=A(i,j)+1
149 endif
150 A(i,j)=0.5*abgs*A(i,j)
151 enddo
152 enddo
153 do i=1,nph
154 do j=i,nph
155 sum=A(i,j)
156 do k=i-1,1,-1
157 sum=sum-A(i,k)*A(j,k)
158 enddo
159 if (i.eq.j) then
160 p(i)=sqrt(sum)
161 else
162 A(j,i)=sum/p(i)
163 endif
164 enddo
165 enddo
166! Generate 8 Gaussian distributed small random angles
167 do i=1,8,2
168 r1=grnd()
169! In the rare event that this random number is 0, just take the next
170 if (r1.le.0) r1=grnd()
171 r1=sqrt(-log(r1))
172 r2=grnd()
173 ppsi(i)=r1*cos(pi2*r2)
174 ppsi(i+1)=r1*sin(pi2*r2)
175 enddo
176 do i=1,nph
177 dph(i)=0
178 enddo
179! Solve lower triangular matrix to get dphi proposals
180 do i=nph,1,-1
181 sum=ppsi(i)
182 do k=i+1,nph
183 sum=sum-A(k,i)*dph(k)
184 enddo
185 dph(i)=sum/p(i)
186 enddo
187! Calculate intrinsic (non-Boltzmann) weight for forward process
188! print *,'calculating intrinsic weight for forward process'
189 sum=0
190 do i=1,nph
191 sum=sum+ppsi(i)*ppsi(i)
192 enddo
193 wfw=exp(-sum)
194 do i=1,nph
195 wfw=wfw*p(i)
196 enddo
197
198! Reconstruct chain and calculate new energy
199! print *,'going to assign changes to the chain'
200 ovr = vlvr
201 do i=1,nph
202 vlvr(iph(i))=addang(vlvr(iph(i)),dph(i))
203 enddo
204 enw = energy()
205! Calculate weight for reverse process for detail balance
206! print *,'proceeding to calculate weight for the reverse process'
207 nph=0
208 do i=1,4
209 icurraa=ia+i-1
210 if (iphi(icurraa).gt.0.and..not.fxvr(iphi(icurraa))) then
211 nph=nph+1
212 xiv(nph,1)=xat(iCa(icurraa))
213 xiv(nph,2)=yat(iCa(icurraa))
214 xiv(nph,3)=zat(iCa(icurraa))
215 bv(nph,1)=xiv(nph,1)-xat(iN(icurraa))
216 bv(nph,2)=xiv(nph,2)-yat(iN(icurraa))
217 bv(nph,3)=xiv(nph,3)-zat(iN(icurraa))
218 ab(nph)=bv(nph,1)*bv(nph,1)+bv(nph,2)*bv(nph,2)
219 & +bv(nph,3)*bv(nph,3)
220 iph(nph)=iphi(icurraa)
221 endif
222 if (.not.fxvr(ipsi(icurraa))) then
223 nph=nph+1
224 xiv(nph,1)=xat(iC(icurraa))
225 xiv(nph,2)=yat(iC(icurraa))
226 xiv(nph,3)=zat(iC(icurraa))
227 bv(nph,1)=xiv(nph,1)-xat(iCa(icurraa))
228 bv(nph,2)=xiv(nph,2)-yat(iCa(icurraa))
229 bv(nph,3)=xiv(nph,3)-zat(iCa(icurraa))
230 ab(nph)=bv(nph,1)*bv(nph,1)+bv(nph,2)*bv(nph,2)
231 & +bv(nph,3)*bv(nph,3)
232 iph(nph)=ipsi(icurraa)
233 endif
234 enddo
235 rv(1,1)=xat(iCa(ia+3))
236 rv(1,2)=yat(iCa(ia+3))
237 rv(1,3)=zat(iCa(ia+3))
238 rv(2,1)=xat(iC(ia+3))
239 rv(2,2)=yat(iC(ia+3))
240 rv(2,3)=zat(iC(ia+3))
241 rv(3,1)=xat(iC(ia+3)+1)
242 rv(3,2)=yat(iC(ia+3)+1)
243 rv(3,3)=zat(iC(ia+3)+1)
244
245 do i=1,3
246 do j=1,nph
247 dv(i,j,1)=(1.0/ab(j))*(bv(j,2)*(rv(i,3)-xiv(j,3))-
248 & bv(j,3)*(rv(i,2)-xiv(j,2)))
249 dv(i,j,2)=(-1.0/ab(j))*(bv(j,1)*(rv(i,3)-xiv(j,3))-
250 & bv(j,3)*(rv(i,1)-xiv(j,1)))
251 dv(i,j,3)=(1.0/ab(j))*(bv(j,1)*(rv(i,2)-xiv(j,2))-
252 & bv(j,2)*(rv(i,1)-xiv(j,1)))
253 enddo
254 enddo
255 do i=1,nph
256 do j=i,nph
257 A(i,j)=0
258 do k=1,3
259 do l=1,3
260 A(i,j)=A(i,j)+dv(k,i,l)*(dv(k,j,l))
261 enddo
262 enddo
263 A(i,j)=bbgs*A(i,j)
264 if (i.eq.j) then
265 A(i,j)=A(i,j)+1
266 endif
267 A(i,j)=0.5*abgs*A(i,j)
268 enddo
269 enddo
270 do i=1,nph
271 do j=i,nph
272 sum=A(i,j)
273 do k=i-1,1,-1
274 sum=sum-A(i,k)*A(j,k)
275 enddo
276 if (i.eq.j) then
277 p(i)=sqrt(sum)
278 else
279 A(j,i)=sum/p(i)
280 endif
281 enddo
282 enddo
283 do i=1,nph
284 ppsi(i)=p(i)*dph(i)
285 do j=i+1,nph
286 ppsi(i)=ppsi(i)+A(j,i)*dph(j)
287 enddo
288 enddo
289 sum=0
290 do i=1,nph
291 sum=sum+ppsi(i)*ppsi(i)
292 enddo
293 wbw=exp(-sum)
294 do i=1,nph
295 wbw=wbw*p(i)
296 enddo
297! Acceptance condition (includes additional weight)
298 rd=grnd()
299! print *,'generated selection random number ',rd
300! print *,'wfw/wbw = ',wfw/wbw
301 rd=-log(rd*wfw/wbw)
302! print *,'modified rd = ',rd
303! print *,'before calculating energy change'
304 delta = dummy(enw)-dummy(eol1)
305! print *,'delta = ',delta
306! call outpdb(0,'after.pdb')
307! print *,'after outpdb for after.pdb'
308! do i=1,nph
309! print *,'BGS>',i,iph(i),vlvr(iph(i)),dph(i)
310! enddo
311 if (rd.ge.delta) then
312! accept
313 eol1=enw
314 bgs=1
315! print *,'BGS move accepted'
316 else
317! reject
318 vlvr = ovr
319! enw=energy()
320! if (abs(enw-eol1).gt.0.000001) then
321! write(*,*) 'rejected bgs move: energy change :',eol1,enw
322! endif
323! write(*,*) 'rejected bgs move: ',eol1,enw,wfw,wbw,rd
324 bgs=0
325 endif
326 171 continue
327 return
328 end
329
Note: See TracBrowser for help on using the repository browser.