source: opeflx.f@ bd2278d

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

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

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

  • Property mode set to 100644
File size: 12.7 KB
Line 
1! **************************************************************
2!
3! This file contains the subroutines: opeflx,gdtflx
4!
5! Copyright 2003-2005 Frank Eisenmenger, U.H.E. Hansmann,
6! Shura Hayryan, Chin-Ku
7! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8! Jan H. Meinke, Sandipan Mohanty
9!
10! **************************************************************
11
12 subroutine opeflx(nml)
13
14! ......................................................................
15! PURPOSE: Calculate internal energy for FLEX dataset and its partial
16! derivatives vs. variables using recursive algorithm from:
17! Noguti T, Go N, J Phys Soc (Japan) v52 3685-3690 1984; Abe H,
18! Braun W, Noguti T, Go N, Comp Chem v8 239-247 1984; Mazur A K,
19! Abagyan R A, J Biomol Struct Dyn v6 815-832, which I modified
20! for atomic forces instead of simple derivatives (see Lavery R,
21! Sklenar H, Zakrzewska K, Pullman B, J Biomol Struct Dyn v3
22! 989-1014 1986)
23!
24! CALLS: gdtflx
25! ......................................................................
26
27 include 'INCL.H'
28
29 dimension xfat(mxat),yfat(mxat),zfat(mxat),
30 & xtat(mxat),ytat(mxat),ztat(mxat),
31 & xfvr(mxvr),yfvr(mxvr),zfvr(mxvr),
32 & xfrvr(mxvr),yfrvr(mxvr),zfrvr(mxvr)
33
34
35 eyel=0.d0
36 eyvw=0.d0
37 eyhb=0.d0
38 eyvr=0.d0
39 eysm=0.d0
40
41 ntlvr=nvrml(nml)
42 if (ntlvr.eq.0) then
43 write (*,'(a,i4)')
44 & ' opeflx> No variables defined in molecule #',nml
45 return
46 endif
47
48 ifivr=ivrml1(nml)
49 ilavr=ifivr+ntlvr-1
50
51 do i=ifivr,ilavr
52 gdeyvr(i)=0.d0
53 xfvr(i)=0.0
54 yfvr(i)=0.0
55 zfvr(i)=0.0
56 xfrvr(i)=0.0
57 yfrvr(i)=0.0
58 zfrvr(i)=0.0
59 enddo
60
61 do i=iatrs1(irsml1(nml)),iatrs2(irsml2(nml))
62 xfat(i)=0.d0
63 yfat(i)=0.d0
64 zfat(i)=0.d0
65
66 xtat(i)=0.d0
67 ytat(i)=0.d0
68 ztat(i)=0.d0
69 enddo
70
71 i1s=imsml1(nml)+nmsml(nml)
72 i1a=iadml1(nml)+nadml(nml)
73
74 do io=ilavr,ifivr,-1 ! ______ loop over variables in desc. order
75
76 iv=iorvr(io) ! index of var.
77 ia=iatvr(iv) ! prim.mv.at
78
79 ib=iowat(ia) ! base
80 xb=xat(ib)
81 yb=yat(ib)
82 zb=zat(ib)
83
84 it=ityvr(iv) ! type
85 ic=iclvr(iv) ! class
86
87 fvr=0.d0
88
89 if (it.eq.3) then ! torsion
90 ex=xtoat(ib)
91 ey=ytoat(ib)
92 ez=ztoat(ib)
93
94 vr=toat(ia)
95
96 e0=e0to(ic)
97 if (e0.ne.0.d0) then
98 vrn=vr*rnto(ic)
99 eyvr=eyvr+e0*(1.d0+sgto(ic)*cos(vrn))
100 fvr=esnto(ic)*sin(vrn)
101 endif
102
103 elseif (it.eq.2) then ! b.angle
104 ex=xbaat(ia)
105 ey=ybaat(ia)
106 ez=zbaat(ia)
107
108 vr=baat(ia)
109
110 elseif (it.eq.1) then ! b.length
111 ex=xtoat(ia)
112 ey=ytoat(ia)
113 ez=ztoat(ia)
114
115 vr=blat(ia)
116
117 endif
118
119! ============================================ Energies & Atomic forces
120
121 xfiv=0.d0
122 yfiv=0.d0
123 zfiv=0.d0
124 xfriv=0.d0
125 yfriv=0.d0
126 zfriv=0.d0
127
128 i2s=i1s-1 ! last m.s per 'iv'
129 i1s=imsvr1(iv) ! 1st m.s
130
131 do ims=i1s,i2s ! __ loop over m.s
132
133 i1=latms1(ims)
134 i2=latms2(ims)
135
136 do i=i1,i2 ! __ loop over atoms i ===================
137
138 ity=ityat(i)
139 cqi=conv*cgat(i)
140
141 xi=xat(i)
142 yi=yat(i)
143 zi=zat(i)
144
145 xfi=xfat(i)
146 yfi=yfat(i)
147 zfi=zfat(i)
148
149 xti=xtat(i)
150 yti=ytat(i)
151 zti=ztat(i)
152
153 do ivw=ivwat1(i),ivwat2(i) ! loop over vdW-domains of 'i'
154 do j=lvwat1(ivw),lvwat2(ivw) ! atoms j
155
156 jty=ityat(j)
157
158 xj=xat(j)
159 yj=yat(j)
160 zj=zat(j)
161
162 xij=xj-xi
163 yij=yj-yi
164 zij=zj-zi
165
166 rij2=xij*xij+yij*yij+zij*zij
167 rij6=rij2**3
168 rij12=rij6*rij6
169 rij=sqrt(rij2)
170
171 cqiqj=cqi*cgat(j)
172
173 if (epsd) then
174
175 sr=slp_f*rij
176 sr2=sr*sr
177 xsr=(plt-1.d0)*exp(-sr)/2.d0
178 ep=plt-(sr2+2.d0*sr+2.d0)*xsr
179
180 eel=cqiqj/(rij*ep)
181 eyel=eyel+eel
182 deel=eel+cqiqj*(slp_f*sr2*xsr)/(ep*ep)
183
184 else
185
186 eel=cqiqj/rij
187 eyel=eyel+eel
188 deel=eel
189
190 endif
191
192
193 eyrp=aij(ity,jty)/rij12
194 eyds=cij(ity,jty)/rij6
195
196 c=(-12.d0*eyrp+6.d0*eyds- deel)/rij
197
198 xij=xij/rij
199 yij=yij/rij
200 zij=zij/rij
201
202 xfji=c*xij
203 yfji=c*yij
204 zfji=c*zij
205
206 ijhb=ihbty(ity,jty)
207 if (ijhb.ne.0.and.rij.le.cohb) then ! HB Possible
208 if (ijhb.gt.0) then ! i=H,j=acceptor
209 iowh=iowat(i)
210 px=xi-xat(iowh)
211 py=yi-yat(iowh)
212 pz=zi-zat(iowh)
213 else ! i=acceptor,j=H
214 jowh=iowat(j)
215 px=xat(jowh)-xj
216 py=yat(jowh)-yj
217 pz=zat(jowh)-zj
218 endif
219
220 p=sqrt(px*px+py*py+pz*pz)
221 px=px/p
222 py=py/p
223 pz=pz/p
224
225 cth=xij*px+yij*py+zij*pz
226
227 if (cth.gt.0.d0) then
228
229 deyrp=(ahb(ity,jty)-aij(ity,jty))/rij12
230 deyds=(chb(ity,jty)-cij(ity,jty))/rij6
231
232 dhb=deyrp-deyds
233 eyhb=eyhb+eyrp-eyds+cth*dhb
234
235 if (ijhb.gt.0) then ! i=H
236 xti=xti +dhb * (zij*py-yij*pz)
237 yti=yti +dhb * (xij*pz-zij*px)
238 zti=zti +dhb * (yij*px-xij*py)
239 else ! j=H
240 xtat(j)=xtat(j) +dhb * (zij*py-yij*pz)
241 ytat(j)=ytat(j) +dhb * (xij*pz-zij*px)
242 ztat(j)=ztat(j) +dhb * (yij*px-xij*py)
243 endif
244
245 dhb=dhb/rij
246 hhb=cth*(7.d0*deyds-13.d0*deyrp)/rij
247
248 xfji=xfji+ dhb*px+ hhb*xij
249 yfji=yfji+ dhb*py+ hhb*yij
250 zfji=zfji+ dhb*pz+ hhb*zij
251! __________________________________________________ No Hydrogen Bond
252 else
253 eyvw=eyvw+eyrp-eyds
254 endif
255 else
256 eyvw=eyvw+eyrp-eyds
257 endif
258
259 xfi=xfi+xfji
260 yfi=yfi+yfji
261 zfi=zfi+zfji
262
263 xfat(j)=xfat(j)-xfji
264 yfat(j)=yfat(j)-yfji
265 zfat(j)=zfat(j)-zfji
266
267 enddo ! ... atoms j
268 enddo ! ... vdW-domains of i
269
270 do i14=i14at1(i),i14at2(i) ! loop over 1-4 partn. of 'i'
271 j=l14at(i14)
272
273 jty=ityat(j)
274
275 xj=xat(j)
276 yj=yat(j)
277 zj=zat(j)
278
279 xij=xj-xi
280 yij=yj-yi
281 zij=zj-zi
282
283 rij2=xij*xij+yij*yij+zij*zij
284 rij6=rij2**3
285 rij12=rij6*rij6
286 rij=sqrt(rij2)
287
288 cqiqj=cqi*cgat(j)
289
290 if (epsd) then
291
292 sr=slp_f*rij
293 sr2=sr*sr
294 xsr=(plt-1.d0)*exp(-sr)/2.d0
295 ep=plt-(sr2+2.d0*sr+2.d0)*xsr
296
297 eel=cqiqj/(rij*ep)
298 eyel=eyel+eel
299 deel=eel+cqiqj*(slp_f*sr2*xsr)/(ep*ep)
300
301 else
302
303 eel=cqiqj/rij
304 eyel=eyel+eel
305 deel=eel
306
307 endif
308
309 eyrp=a14(ity,jty)/rij12
310 eyds=cij(ity,jty)/rij6
311
312 c=(-12.d0*eyrp+6.d0*eyds- deel )/rij
313
314 xij=xij/rij
315 yij=yij/rij
316 zij=zij/rij
317
318 xfji=c*xij
319 yfji=c*yij
320 zfji=c*zij
321
322 ijhb=ihbty(ity,jty)
323 if (ijhb.ne.0.and.rij.le.cohb) then ! HB Possible
324 if (ijhb.gt.0) then ! i=H,j=acceptor
325 iowh=iowat(i)
326 px=xi-xat(iowh)
327 py=yi-yat(iowh)
328 pz=zi-zat(iowh)
329 else ! i=acceptor,j=H
330 jowh=iowat(j)
331 px=xat(jowh)-xj
332 py=yat(jowh)-yj
333 pz=zat(jowh)-zj
334 endif
335
336 p=sqrt(px*px+py*py+pz*pz)
337 px=px/p
338 py=py/p
339 pz=pz/p
340
341 cth=xij*px+yij*py+zij*pz
342
343 if (cth.gt.0.d0) then
344
345 deyrp=(ahb(ity,jty)-a14(ity,jty))/rij12
346 deyds=(chb(ity,jty)-cij(ity,jty))/rij6
347
348 dhb=deyrp-deyds
349 eyhb=eyhb+eyrp-eyds+cth*dhb
350
351 if (ijhb.gt.0) then ! i=H
352 xti=xti -dhb * (yij*pz-zij*py)
353 yti=yti -dhb * (zij*px-xij*pz)
354 zti=zti -dhb * (xij*py-yij*px)
355 else ! j=H
356 xtat(j)=xtat(j) +dhb * (yij*pz-zij*py)
357 ytat(j)=ytat(j) +dhb * (zij*px-xij*pz)
358 ztat(j)=ztat(j) +dhb * (xij*py-yij*px)
359 endif
360
361 dhb=dhb/rij
362 hhb=cth*(7.d0*deyds-13.d0*deyrp)/rij
363
364 xfji=xfji+ dhb*px+ hhb*xij
365 yfji=yfji+ dhb*py+ hhb*yij
366 zfji=zfji+ dhb*pz+ hhb*zij
367! __________________________________________________ No Hydrogen Bond
368 else
369 eyvw=eyvw+eyrp-eyds
370 endif
371 else
372 eyvw=eyvw+eyrp-eyds
373 endif
374
375 xfi=xfi+xfji
376 yfi=yfi+yfji
377 zfi=zfi+zfji
378
379 xfat(j)=xfat(j)-xfji
380 yfat(j)=yfat(j)-yfji
381 zfat(j)=zfat(j)-zfji
382
383 enddo ! ... 1-4-partners of i
384
385 xfat(i)=xfi
386 yfat(i)=yfi
387 zfat(i)=zfi
388 xtat(i)=xti
389 ytat(i)=yti
390 ztat(i)=zti
391
392 xfiv=xfiv + xfi
393 yfiv=yfiv + yfi
394 zfiv=zfiv + zfi
395
396 xfriv=xfriv + yfi*zi-zfi*yi + xti
397 yfriv=yfriv + zfi*xi-xfi*zi + yti
398 zfriv=zfriv + xfi*yi-yfi*xi + zti
399
400 enddo ! ... atoms i
401 enddo ! ... m.s.
402
403 i2a=i1a-1 ! last 'added' var.
404 i1a=iadvr1(iv) ! 1st 'added' var.
405
406 do iad=i1a,i2a
407 lad=ladvr(iad)
408 xfiv=xfiv+xfvr(lad)
409 yfiv=yfiv+yfvr(lad)
410 zfiv=zfiv+zfvr(lad)
411 xfriv=xfriv+xfrvr(lad)
412 yfriv=yfriv+yfrvr(lad)
413 zfriv=zfriv+zfrvr(lad)
414 enddo
415
416 xfvr(iv)=xfiv
417 yfvr(iv)=yfiv
418 zfvr(iv)=zfiv
419 xfrvr(iv)=xfriv
420 yfrvr(iv)=yfriv
421 zfrvr(iv)=zfriv
422
423 if (it.eq.3.or.it.eq.2) then ! torsion,b.angle
424
425 gdeyvr(iv)= (ey*zb-ez*yb)*xfiv+(ez*xb-ex*zb)*yfiv+
426 & (ex*yb-ey*xb)*zfiv
427 & +ex*xfriv+ey*yfriv+ez*zfriv -fvr
428
429 elseif (it.eq.1) then ! b.length
430
431 gdeyvr(iv)= -(ex*xfiv+ey*yfiv+ez*zfiv) -fvr
432
433 endif
434
435 if (tesgrd) call gdtflx(nml,iv) ! grad.-test
436
437 enddo ! ... variables
438
439 eysm= eyel+eyvw+eyhb+eyvr
440
441 return
442 end
443! *****************************
444 subroutine gdtflx(nml,iv)
445
446! .....................................................................
447! PURPOSE: calculate partial derivative of internal energy for molecule
448! 'nml' vs. variable 'iv' NUMERICALLY and compare with
449! its value obtained analytically
450!
451! CALLS: setvar, enyflx
452! .....................................................................
453
454 include 'INCL.H'
455
456 parameter (del=1.d-7)
457
458 dimension vlvrx(mxvr)
459
460! ____________________________ get & save values of variables
461 do i=1,ivrml1(ntlml)+nvrml(ntlml)-1
462 it=ityvr(i) ! type
463 if (it.eq.3) then ! torsion
464 vlvrx(i)=toat(iatvr(i))
465 elseif (it.eq.2) then ! b.angle
466 vlvrx(i)=baat(iatvr(i))
467 elseif (it.eq.1) then ! b.length
468 vlvrx(i)=blat(iatvr(i))
469 endif
470 enddo
471
472 ovr=vlvrx(iv)
473 eyol=enyflx(nml)
474
475 vlvrx(iv)=ovr+del ! change variable 'iv' by 'del'
476 call setvar(nml,vlvrx)
477 eynw=enyflx(nml) ! new energy
478
479 gdn=(eynw-eyol)/del ! numerical derivative
480 gda=gdeyvr(iv) ! analytical der.
481
482 write (*,'(1x,2a,2(e12.6,a))') nmvr(iv),': ',gda,' (',
483 & abs(gda-gdn),')'
484
485! _________________________ restore
486 vlvrx(iv)=ovr
487 call setvar(nml,vlvrx)
488
489 return
490 end
491
Note: See TracBrowser for help on using the repository browser.