1 subroutine etotal(energia,fact)
2 implicit real*8 (a-h,o-z)
4 include 'DIMENSIONS.ZSCOPT'
10 cMS$ATTRIBUTES C :: proc_proc
13 include 'COMMON.IOUNITS'
14 double precision energia(0:max_ene),energia1(0:max_ene+1)
20 include 'COMMON.FFIELD'
21 include 'COMMON.DERIV'
22 include 'COMMON.INTERACT'
23 include 'COMMON.SBRIDGE'
24 include 'COMMON.CHAIN'
25 include 'COMMON.SHIELD'
26 include 'COMMON.CONTROL'
27 double precision fact(6)
28 cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot
29 cd print *,'nnt=',nnt,' nct=',nct
31 C Compute the side-chain and electrostatic interaction energy
33 goto (101,102,103,104,105) ipot
34 C Lennard-Jones potential.
35 101 call elj(evdw,evdw_t)
36 cd print '(a)','Exit ELJ'
38 C Lennard-Jones-Kihara potential (shifted).
39 102 call eljk(evdw,evdw_t)
41 C Berne-Pechukas potential (dilated LJ, angular dependence).
42 103 call ebp(evdw,evdw_t)
44 C Gay-Berne potential (shifted LJ, angular dependence).
45 104 call egb(evdw,evdw_t)
47 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
48 105 call egbv(evdw,evdw_t)
49 C write(iout,*) 'po elektostatyce'
51 C Calculate electrostatic (H-bonding) energy of the main chain.
54 if (shield_mode.eq.1) then
56 else if (shield_mode.eq.2) then
59 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
60 C write(iout,*) 'po eelec'
62 C Calculate excluded-volume interaction energy between peptide groups
65 call escp(evdw2,evdw2_14)
67 c Calculate the bond-stretching energy
71 C write (iout,*) "estr",estr
73 C Calculate the disulfide-bridge and other energy and the contributions
74 C from other distance constraints.
75 cd print *,'Calling EHPB'
77 cd print *,'EHPB exitted succesfully.'
79 C Calculate the virtual-bond-angle energy.
81 C print *,'Bend energy finished.'
82 call ebend(ebe,ethetacnstr)
83 cd print *,'Bend energy finished.'
85 C Calculate the SC local energy.
88 C print *,'SCLOC energy finished.'
90 C Calculate the virtual-bond torsional energy.
92 cd print *,'nterm=',nterm
93 call etor(etors,edihcnstr,fact(1))
95 C 6/23/01 Calculate double-torsional energy
97 call etor_d(etors_d,fact(2))
99 C 21/5/07 Calculate local sicdechain correlation energy
101 call eback_sc_corr(esccor)
103 if (wliptran.gt.0) then
104 call Eliptransfer(eliptran)
107 if (TUBElog.eq.1) then
108 print *,"just before call"
110 print *,"just after call",etube
111 elseif (TUBElog.eq.2) then
112 call calctube2(Etube)
113 elseif (TUBElog.eq.3) then
120 C 12/1/95 Multi-body terms
124 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
125 & .or. wturn6.gt.0.0d0) then
126 c print *,"calling multibody_eello"
127 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
128 c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1
129 c print *,ecorr,ecorr5,ecorr6,eturn6
136 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then
137 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
139 c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t
141 if (shield_mode.gt.0) then
142 etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
144 & +fact(1)*wvdwpp*evdw1
145 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
146 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
147 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
148 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
149 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
150 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
151 & +wliptran*eliptran+wtube*Etube
153 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees
155 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
156 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
157 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
158 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
159 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
160 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
161 & +wliptran*eliptran+wtube*Etube
164 if (shield_mode.gt.0) then
165 etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2
166 & +welec*fact(1)*(ees+evdw1)
167 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
168 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
169 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
170 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
171 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
172 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
173 & +wliptran*eliptran+wtube*Etube
175 etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2
176 & +welec*fact(1)*(ees+evdw1)
177 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc
178 & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5
179 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4
180 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6
181 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d
182 & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr
183 & +wliptran*eliptran+wtube*Etube
189 energia(2)=evdw2-evdw2_14
206 energia(8)=eello_turn3
207 energia(9)=eello_turn4
216 energia(20)=edihcnstr
218 energia(24)=ethetacnstr
224 if (isnan(etot).ne.0) energia(0)=1.0d+99
226 if (isnan(etot)) energia(0)=1.0d+99
231 idumm=proc_proc(etot,i)
233 call proc_proc(etot,i)
235 if(i.eq.1)energia(0)=1.0d+99
242 call enerprint(energia,fact)
247 C Sum up the components of the Cartesian gradient.
252 if (shield_mode.eq.0) then
253 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
254 & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
256 & wstrain*ghpbc(j,i)+
257 & wcorr*fact(3)*gradcorr(j,i)+
258 & wel_loc*fact(2)*gel_loc(j,i)+
259 & wturn3*fact(2)*gcorr3_turn(j,i)+
260 & wturn4*fact(3)*gcorr4_turn(j,i)+
261 & wcorr5*fact(4)*gradcorr5(j,i)+
262 & wcorr6*fact(5)*gradcorr6(j,i)+
263 & wturn6*fact(5)*gcorr6_turn(j,i)+
264 & wsccor*fact(2)*gsccorc(j,i)
265 & +wliptran*gliptranc(j,i)
266 & +welec*gshieldc(j,i)
267 & +welec*gshieldc_loc(j,i)
268 & +wcorr*gshieldc_ec(j,i)
269 & +wcorr*gshieldc_loc_ec(j,i)
270 & +wturn3*gshieldc_t3(j,i)
271 & +wturn3*gshieldc_loc_t3(j,i)
272 & +wturn4*gshieldc_t4(j,i)
273 & +wturn4*gshieldc_loc_t4(j,i)
274 & +wel_loc*gshieldc_ll(j,i)
275 & +wel_loc*gshieldc_loc_ll(j,i)
276 & +wtube*gg_tube(j,i)
279 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
281 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
282 & wsccor*fact(2)*gsccorx(j,i)
283 & +wliptran*gliptranx(j,i)
284 & +welec*gshieldx(j,i)
285 & +wcorr*gshieldx_ec(j,i)
286 & +wturn3*gshieldx_t3(j,i)
287 & +wturn4*gshieldx_t4(j,i)
288 & +wel_loc*gshieldx_ll(j,i)
289 & +wtube*gg_tube_SC(j,i)
292 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)
293 & +fact(1)*wscp*gvdwc_scp(j,i)+
294 & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+
296 & wstrain*ghpbc(j,i)+
297 & wcorr*fact(3)*gradcorr(j,i)+
298 & wel_loc*fact(2)*gel_loc(j,i)+
299 & wturn3*fact(2)*gcorr3_turn(j,i)+
300 & wturn4*fact(3)*gcorr4_turn(j,i)+
301 & wcorr5*fact(4)*gradcorr5(j,i)+
302 & wcorr6*fact(5)*gradcorr6(j,i)+
303 & wturn6*fact(5)*gcorr6_turn(j,i)+
304 & wsccor*fact(2)*gsccorc(j,i)
305 & +wliptran*gliptranc(j,i)
306 & +welec*gshieldc(j,i)
307 & +welec*gshieldc_loc(j,i)
308 & +wcorr*gshieldc_ec(j,i)
309 & +wcorr*gshieldc_loc_ec(j,i)
310 & +wturn3*gshieldc_t3(j,i)
311 & +wturn3*gshieldc_loc_t3(j,i)
312 & +wturn4*gshieldc_t4(j,i)
313 & +wturn4*gshieldc_loc_t4(j,i)
314 & +wel_loc*gshieldc_ll(j,i)
315 & +wel_loc*gshieldc_loc_ll(j,i)
316 & +wtube*gg_tube(j,i)
319 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)
320 & +fact(1)*wscp*gradx_scp(j,i)+
322 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
323 & wsccor*fact(2)*gsccorx(j,i)
324 & +wliptran*gliptranx(j,i)
325 & +welec*gshieldx(j,i)
326 & +wcorr*gshieldx_ec(j,i)
327 & +wturn3*gshieldx_t3(j,i)
328 & +wturn4*gshieldx_t4(j,i)
329 & +wel_loc*gshieldx_ll(j,i)
330 & +wtube*gg_tube_SC(j,i)
338 if (shield_mode.eq.0) then
339 gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
340 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
342 & wcorr*fact(3)*gradcorr(j,i)+
343 & wel_loc*fact(2)*gel_loc(j,i)+
344 & wturn3*fact(2)*gcorr3_turn(j,i)+
345 & wturn4*fact(3)*gcorr4_turn(j,i)+
346 & wcorr5*fact(4)*gradcorr5(j,i)+
347 & wcorr6*fact(5)*gradcorr6(j,i)+
348 & wturn6*fact(5)*gcorr6_turn(j,i)+
349 & wsccor*fact(2)*gsccorc(j,i)
350 & +wliptran*gliptranc(j,i)
351 & +welec*gshieldc(j,i)
352 & +welec*gshieldc_loc(j,i)
353 & +wcorr*gshieldc_ec(j,i)
354 & +wcorr*gshieldc_loc_ec(j,i)
355 & +wturn3*gshieldc_t3(j,i)
356 & +wturn3*gshieldc_loc_t3(j,i)
357 & +wturn4*gshieldc_t4(j,i)
358 & +wturn4*gshieldc_loc_t4(j,i)
359 & +wel_loc*gshieldc_ll(j,i)
360 & +wel_loc*gshieldc_loc_ll(j,i)
361 & +wtube*gg_tube(j,i)
363 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
365 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
366 & wsccor*fact(1)*gsccorx(j,i)
367 & +wliptran*gliptranx(j,i)
368 & +welec*gshieldx(j,i)
369 & +wcorr*gshieldx_ec(j,i)
370 & +wturn3*gshieldx_t3(j,i)
371 & +wturn4*gshieldx_t4(j,i)
372 & +wel_loc*gshieldx_ll(j,i)
373 & +wtube*gg_tube_sc(j,i)
377 gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+
378 & fact(1)*wscp*gvdwc_scp(j,i)+
379 & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+
381 & wcorr*fact(3)*gradcorr(j,i)+
382 & wel_loc*fact(2)*gel_loc(j,i)+
383 & wturn3*fact(2)*gcorr3_turn(j,i)+
384 & wturn4*fact(3)*gcorr4_turn(j,i)+
385 & wcorr5*fact(4)*gradcorr5(j,i)+
386 & wcorr6*fact(5)*gradcorr6(j,i)+
387 & wturn6*fact(5)*gcorr6_turn(j,i)+
388 & wsccor*fact(2)*gsccorc(j,i)
389 & +wliptran*gliptranc(j,i)
390 & +welec*gshieldc(j,i)
391 & +welec*gshieldc_loc(j,i)
392 & +wcorr*gshieldc_ec(j,i)
393 & +wcorr*gshieldc_loc_ec(j,i)
394 & +wturn3*gshieldc_t3(j,i)
395 & +wturn3*gshieldc_loc_t3(j,i)
396 & +wturn4*gshieldc_t4(j,i)
397 & +wturn4*gshieldc_loc_t4(j,i)
398 & +wel_loc*gshieldc_ll(j,i)
399 & +wel_loc*gshieldc_loc_ll(j,i)
400 & +wtube*gg_tube(j,i)
402 gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+
403 & fact(1)*wscp*gradx_scp(j,i)+
405 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
406 & wsccor*fact(1)*gsccorx(j,i)
407 & +wliptran*gliptranx(j,i)
408 & +welec*gshieldx(j,i)
409 & +wcorr*gshieldx_ec(j,i)
410 & +wturn3*gshieldx_t3(j,i)
411 & +wturn4*gshieldx_t4(j,i)
412 & +wel_loc*gshieldx_ll(j,i)
413 & +wtube*gg_tube_sc(j,i)
423 gloc(i,icg)=gloc(i,icg)+wcorr*fact(3)*gcorr_loc(i)
424 & +wcorr5*fact(4)*g_corr5_loc(i)
425 & +wcorr6*fact(5)*g_corr6_loc(i)
426 & +wturn4*fact(3)*gel_loc_turn4(i)
427 & +wturn3*fact(2)*gel_loc_turn3(i)
428 & +wturn6*fact(5)*gel_loc_turn6(i)
429 & +wel_loc*fact(2)*gel_loc_loc(i)
430 c & +wsccor*fact(1)*gsccor_loc(i)
431 c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA
434 if (dyn_ss) call dyn_set_nss
437 C------------------------------------------------------------------------
438 subroutine enerprint(energia,fact)
439 implicit real*8 (a-h,o-z)
441 include 'DIMENSIONS.ZSCOPT'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.SBRIDGE'
445 double precision energia(0:max_ene),fact(6)
447 evdw=energia(1)+fact(6)*energia(21)
449 evdw2=energia(2)+energia(17)
461 eello_turn3=energia(8)
462 eello_turn4=energia(9)
463 eello_turn6=energia(10)
470 edihcnstr=energia(20)
472 ethetacnstr=energia(24)
476 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,
478 & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1),
479 & etors_d,wtor_d*fact(2),ehpb,wstrain,
480 & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),
481 & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2),
482 & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5),
483 & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss,
484 & eliptran,wliptran,etube,wtube ,etot
485 10 format (/'Virtual-chain energies:'//
486 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
487 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
488 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p elec)'/
489 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
490 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
491 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
492 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
493 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
494 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
495 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
496 & ' (SS bridges & dist. cnstr.)'/
497 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
498 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
499 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
500 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
501 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
502 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
503 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
504 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
505 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
506 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
507 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
508 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
509 & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
510 & 'ETOT= ',1pE16.6,' (total)')
512 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond,
513 & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2,
514 & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),
515 & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2),
516 & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3),
517 & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor,
518 & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etube,wtube,etot
519 10 format (/'Virtual-chain energies:'//
520 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
521 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
522 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
523 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
524 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
525 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
526 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
527 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
528 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
529 & ' (SS bridges & dist. cnstr.)'/
530 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
531 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
532 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
533 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
534 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
535 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
536 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
537 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
538 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
539 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
540 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
541 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
542 & 'ETOT= ',1pE16.6,' (total)')
546 C-----------------------------------------------------------------------
547 subroutine elj(evdw,evdw_t)
549 C This subroutine calculates the interaction energy of nonbonded side chains
550 C assuming the LJ potential of interaction.
552 implicit real*8 (a-h,o-z)
554 include 'DIMENSIONS.ZSCOPT'
555 include "DIMENSIONS.COMPAR"
556 parameter (accur=1.0d-10)
559 include 'COMMON.LOCAL'
560 include 'COMMON.CHAIN'
561 include 'COMMON.DERIV'
562 include 'COMMON.INTERACT'
563 include 'COMMON.TORSION'
564 include 'COMMON.ENEPS'
565 include 'COMMON.SBRIDGE'
566 include 'COMMON.NAMES'
567 include 'COMMON.IOUNITS'
568 include 'COMMON.CONTACTS'
572 cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
576 eneps_temp(j,i)=0.0d0
585 if (itypi.eq.ntyp1) cycle
586 itypi1=iabs(itype(i+1))
593 C Calculate SC interaction energy.
596 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
597 cd & 'iend=',iend(i,iint)
598 do j=istart(i,iint),iend(i,iint)
600 if (itypj.eq.ntyp1) cycle
604 C Change 12/1/95 to calculate four-body interactions
605 rij=xj*xj+yj*yj+zj*zj
607 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
608 eps0ij=eps(itypi,itypj)
613 ij=icant(itypi,itypj)
615 eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij)
616 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij
619 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
620 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
621 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
622 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
623 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
624 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
625 if (bb.gt.0.0d0) then
632 C Calculate the components of the gradient in DC and X
634 fac=-rrij*(e1+evdwij)
639 gvdwx(k,i)=gvdwx(k,i)-gg(k)
640 gvdwx(k,j)=gvdwx(k,j)+gg(k)
644 gvdwc(l,k)=gvdwc(l,k)+gg(l)
649 C 12/1/95, revised on 5/20/97
651 C Calculate the contact function. The ith column of the array JCONT will
652 C contain the numbers of atoms that make contacts with the atom I (of numbers
653 C greater than I). The arrays FACONT and GACONT will contain the values of
654 C the contact function and its derivative.
656 C Uncomment next line, if the correlation interactions include EVDW explicitly.
657 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
658 C Uncomment next line, if the correlation interactions are contact function only
659 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
661 sigij=sigma(itypi,itypj)
662 r0ij=rs0(itypi,itypj)
664 C Check whether the SC's are not too far to make a contact.
667 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
668 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
670 if (fcont.gt.0.0D0) then
671 C If the SC-SC distance if close to sigma, apply spline.
672 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
673 cAdam & fcont1,fprimcont1)
674 cAdam fcont1=1.0d0-fcont1
675 cAdam if (fcont1.gt.0.0d0) then
676 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
677 cAdam fcont=fcont*fcont1
679 C Uncomment following 4 lines to have the geometric average of the epsilon0's
680 cga eps0ij=1.0d0/dsqrt(eps0ij)
682 cga gg(k)=gg(k)*eps0ij
684 cga eps0ij=-evdwij*eps0ij
685 C Uncomment for AL's type of SC correlation interactions.
687 num_conti=num_conti+1
689 facont(num_conti,i)=fcont*eps0ij
690 fprimcont=eps0ij*fprimcont/rij
692 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
693 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
694 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
695 C Uncomment following 3 lines for Skolnick's type of SC correlation.
696 gacont(1,num_conti,i)=-fprimcont*xj
697 gacont(2,num_conti,i)=-fprimcont*yj
698 gacont(3,num_conti,i)=-fprimcont*zj
699 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
700 cd write (iout,'(2i3,3f10.5)')
701 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
707 num_cont(i)=num_conti
712 gvdwc(j,i)=expon*gvdwc(j,i)
713 gvdwx(j,i)=expon*gvdwx(j,i)
717 C******************************************************************************
721 C To save time, the factor of EXPON has been extracted from ALL components
722 C of GVDWC and GRADX. Remember to multiply them by this factor before further
725 C******************************************************************************
728 C-----------------------------------------------------------------------------
729 subroutine eljk(evdw,evdw_t)
731 C This subroutine calculates the interaction energy of nonbonded side chains
732 C assuming the LJK potential of interaction.
734 implicit real*8 (a-h,o-z)
736 include 'DIMENSIONS.ZSCOPT'
737 include "DIMENSIONS.COMPAR"
740 include 'COMMON.LOCAL'
741 include 'COMMON.CHAIN'
742 include 'COMMON.DERIV'
743 include 'COMMON.INTERACT'
744 include 'COMMON.ENEPS'
745 include 'COMMON.IOUNITS'
746 include 'COMMON.NAMES'
751 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
754 eneps_temp(j,i)=0.0d0
761 if (itypi.eq.ntyp1) cycle
762 itypi1=iabs(itype(i+1))
767 C Calculate SC interaction energy.
770 do j=istart(i,iint),iend(i,iint)
772 if (itypj.eq.ntyp1) cycle
776 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
778 e_augm=augm(itypi,itypj)*fac_augm
781 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
782 fac=r_shift_inv**expon
786 ij=icant(itypi,itypj)
787 eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm)
788 & /dabs(eps(itypi,itypj))
789 eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj)
790 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
791 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
792 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
793 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
794 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
795 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
796 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
797 if (bb.gt.0.0d0) then
804 C Calculate the components of the gradient in DC and X
806 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
811 gvdwx(k,i)=gvdwx(k,i)-gg(k)
812 gvdwx(k,j)=gvdwx(k,j)+gg(k)
816 gvdwc(l,k)=gvdwc(l,k)+gg(l)
826 gvdwc(j,i)=expon*gvdwc(j,i)
827 gvdwx(j,i)=expon*gvdwx(j,i)
833 C-----------------------------------------------------------------------------
834 subroutine ebp(evdw,evdw_t)
836 C This subroutine calculates the interaction energy of nonbonded side chains
837 C assuming the Berne-Pechukas potential of interaction.
839 implicit real*8 (a-h,o-z)
841 include 'DIMENSIONS.ZSCOPT'
842 include "DIMENSIONS.COMPAR"
845 include 'COMMON.LOCAL'
846 include 'COMMON.CHAIN'
847 include 'COMMON.DERIV'
848 include 'COMMON.NAMES'
849 include 'COMMON.INTERACT'
850 include 'COMMON.ENEPS'
851 include 'COMMON.IOUNITS'
852 include 'COMMON.CALC'
854 c double precision rrsave(maxdim)
860 eneps_temp(j,i)=0.0d0
865 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
866 c if (icall.eq.0) then
874 if (itypi.eq.ntyp1) cycle
875 itypi1=iabs(itype(i+1))
879 dxi=dc_norm(1,nres+i)
880 dyi=dc_norm(2,nres+i)
881 dzi=dc_norm(3,nres+i)
882 dsci_inv=vbld_inv(i+nres)
884 C Calculate SC interaction energy.
887 do j=istart(i,iint),iend(i,iint)
890 if (itypj.eq.ntyp1) cycle
891 dscj_inv=vbld_inv(j+nres)
892 chi1=chi(itypi,itypj)
893 chi2=chi(itypj,itypi)
900 alf12=0.5D0*(alf1+alf2)
901 C For diagnostics only!!!
914 dxj=dc_norm(1,nres+j)
915 dyj=dc_norm(2,nres+j)
916 dzj=dc_norm(3,nres+j)
917 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
918 cd if (icall.eq.0) then
924 C Calculate the angle-dependent terms of energy & contributions to derivatives.
926 C Calculate whole angle-dependent part of epsilon and contributions
928 fac=(rrij*sigsq)**expon2
931 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
932 eps2der=evdwij*eps3rt
933 eps3der=evdwij*eps2rt
934 evdwij=evdwij*eps2rt*eps3rt
935 ij=icant(itypi,itypj)
936 aux=eps1*eps2rt**2*eps3rt**2
937 eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux
938 & /dabs(eps(itypi,itypj))
939 eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj)
940 if (bb.gt.0.0d0) then
947 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
949 write (iout,'(2(a3,i3,2x),15(0pf7.3))')
950 & restyp(itypi),i,restyp(itypj),j,
951 & epsi,sigm,chi1,chi2,chip1,chip2,
952 & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
953 & om1,om2,om12,1.0D0/dsqrt(rrij),
956 C Calculate gradient components.
957 e1=e1*eps1*eps2rt**2*eps3rt**2
958 fac=-expon*(e1+evdwij)
961 C Calculate radial part of the gradient
965 C Calculate the angular part of the gradient and sum add the contributions
966 C to the appropriate components of the Cartesian gradient.
975 C-----------------------------------------------------------------------------
976 subroutine egb(evdw,evdw_t)
978 C This subroutine calculates the interaction energy of nonbonded side chains
979 C assuming the Gay-Berne potential of interaction.
981 implicit real*8 (a-h,o-z)
983 include 'DIMENSIONS.ZSCOPT'
984 include "DIMENSIONS.COMPAR"
987 include 'COMMON.LOCAL'
988 include 'COMMON.CHAIN'
989 include 'COMMON.DERIV'
990 include 'COMMON.NAMES'
991 include 'COMMON.INTERACT'
992 include 'COMMON.ENEPS'
993 include 'COMMON.IOUNITS'
994 include 'COMMON.CALC'
995 include 'COMMON.SBRIDGE'
998 integer icant,xshift,yshift,zshift
1002 eneps_temp(j,i)=0.0d0
1005 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1009 c if (icall.gt.0) lprn=.true.
1011 do i=iatsc_s,iatsc_e
1012 itypi=iabs(itype(i))
1013 if (itypi.eq.ntyp1) cycle
1014 itypi1=iabs(itype(i+1))
1018 C returning the ith atom to box
1020 if (xi.lt.0) xi=xi+boxxsize
1022 if (yi.lt.0) yi=yi+boxysize
1024 if (zi.lt.0) zi=zi+boxzsize
1025 if ((zi.gt.bordlipbot)
1026 &.and.(zi.lt.bordliptop)) then
1027 C the energy transfer exist
1028 if (zi.lt.buflipbot) then
1029 C what fraction I am in
1031 & ((zi-bordlipbot)/lipbufthick)
1032 C lipbufthick is thickenes of lipid buffore
1033 sslipi=sscalelip(fracinbuf)
1034 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1035 elseif (zi.gt.bufliptop) then
1036 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1037 sslipi=sscalelip(fracinbuf)
1038 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1048 dxi=dc_norm(1,nres+i)
1049 dyi=dc_norm(2,nres+i)
1050 dzi=dc_norm(3,nres+i)
1051 dsci_inv=vbld_inv(i+nres)
1053 C Calculate SC interaction energy.
1055 do iint=1,nint_gr(i)
1056 do j=istart(i,iint),iend(i,iint)
1057 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1058 call dyn_ssbond_ene(i,j,evdwij)
1060 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1061 C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t
1062 C triple bond artifac removal
1063 do k=j+1,iend(i,iint)
1064 C search over all next residues
1065 if (dyn_ss_mask(k)) then
1066 C check if they are cysteins
1067 C write(iout,*) 'k=',k
1068 call triple_ssbond_ene(i,j,k,evdwij)
1069 C call the energy function that removes the artifical triple disulfide
1070 C bond the soubroutine is located in ssMD.F
1072 C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)')
1073 C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t
1074 endif!dyn_ss_mask(k)
1078 itypj=iabs(itype(j))
1079 if (itypj.eq.ntyp1) cycle
1080 dscj_inv=vbld_inv(j+nres)
1081 sig0ij=sigma(itypi,itypj)
1082 chi1=chi(itypi,itypj)
1083 chi2=chi(itypj,itypi)
1090 alf12=0.5D0*(alf1+alf2)
1091 C For diagnostics only!!!
1104 C returning jth atom to box
1106 if (xj.lt.0) xj=xj+boxxsize
1108 if (yj.lt.0) yj=yj+boxysize
1110 if (zj.lt.0) zj=zj+boxzsize
1111 if ((zj.gt.bordlipbot)
1112 &.and.(zj.lt.bordliptop)) then
1113 C the energy transfer exist
1114 if (zj.lt.buflipbot) then
1115 C what fraction I am in
1117 & ((zj-bordlipbot)/lipbufthick)
1118 C lipbufthick is thickenes of lipid buffore
1119 sslipj=sscalelip(fracinbuf)
1120 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1121 elseif (zj.gt.bufliptop) then
1122 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1123 sslipj=sscalelip(fracinbuf)
1124 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1133 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1134 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1135 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1136 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1137 C if (aa.ne.aa_aq(itypi,itypj)) then
1139 C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa,
1140 C & bb_aq(itypi,itypj)-bb,
1144 C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj)
1145 C checking the distance
1146 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1151 C finding the closest
1155 xj=xj_safe+xshift*boxxsize
1156 yj=yj_safe+yshift*boxysize
1157 zj=zj_safe+zshift*boxzsize
1158 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1159 if(dist_temp.lt.dist_init) then
1169 if (subchap.eq.1) then
1179 dxj=dc_norm(1,nres+j)
1180 dyj=dc_norm(2,nres+j)
1181 dzj=dc_norm(3,nres+j)
1182 c write (iout,*) i,j,xj,yj,zj
1183 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1185 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1186 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1187 if (sss.le.0.0) cycle
1188 C Calculate angle-dependent terms of energy and contributions to their
1193 sig=sig0ij*dsqrt(sigsq)
1194 rij_shift=1.0D0/rij-sig+sig0ij
1195 C I hate to put IF's in the loops, but here don't have another choice!!!!
1196 if (rij_shift.le.0.0D0) then
1201 c---------------------------------------------------------------
1202 rij_shift=1.0D0/rij_shift
1203 fac=rij_shift**expon
1206 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1207 eps2der=evdwij*eps3rt
1208 eps3der=evdwij*eps2rt
1209 evdwij=evdwij*eps2rt*eps3rt
1211 evdw=evdw+evdwij*sss
1213 evdw_t=evdw_t+evdwij*sss
1215 ij=icant(itypi,itypj)
1216 aux=eps1*eps2rt**2*eps3rt**2
1217 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1
1218 & /dabs(eps(itypi,itypj))
1219 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1220 c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj,
1221 c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)),
1222 c & aux*e2/eps(itypi,itypj)
1224 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1228 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1229 & restyp(itypi),i,restyp(itypj),j,
1230 & epsi,sigm,chi1,chi2,chip1,chip2,
1231 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1232 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1234 write (iout,*) "partial sum", evdw, evdw_t
1239 C Calculate gradient components.
1240 e1=e1*eps1*eps2rt**2*eps3rt**2
1241 fac=-expon*(e1+evdwij)*rij_shift
1244 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1245 C Calculate the radial part of the gradient
1249 C Calculate angular part of the gradient.
1252 C write(iout,*) "partial sum", evdw, evdw_t
1259 C-----------------------------------------------------------------------------
1260 subroutine egbv(evdw,evdw_t)
1262 C This subroutine calculates the interaction energy of nonbonded side chains
1263 C assuming the Gay-Berne-Vorobjev potential of interaction.
1265 implicit real*8 (a-h,o-z)
1266 include 'DIMENSIONS'
1267 include 'DIMENSIONS.ZSCOPT'
1268 include "DIMENSIONS.COMPAR"
1269 include 'COMMON.GEO'
1270 include 'COMMON.VAR'
1271 include 'COMMON.LOCAL'
1272 include 'COMMON.CHAIN'
1273 include 'COMMON.DERIV'
1274 include 'COMMON.NAMES'
1275 include 'COMMON.INTERACT'
1276 include 'COMMON.ENEPS'
1277 include 'COMMON.IOUNITS'
1278 include 'COMMON.CALC'
1279 common /srutu/ icall
1285 eneps_temp(j,i)=0.0d0
1290 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1293 c if (icall.gt.0) lprn=.true.
1295 do i=iatsc_s,iatsc_e
1296 itypi=iabs(itype(i))
1297 if (itypi.eq.ntyp1) cycle
1298 itypi1=iabs(itype(i+1))
1302 dxi=dc_norm(1,nres+i)
1303 dyi=dc_norm(2,nres+i)
1304 dzi=dc_norm(3,nres+i)
1305 dsci_inv=vbld_inv(i+nres)
1307 C Calculate SC interaction energy.
1309 do iint=1,nint_gr(i)
1310 do j=istart(i,iint),iend(i,iint)
1312 itypj=iabs(itype(j))
1313 if (itypj.eq.ntyp1) cycle
1314 dscj_inv=vbld_inv(j+nres)
1315 sig0ij=sigma(itypi,itypj)
1316 r0ij=r0(itypi,itypj)
1317 chi1=chi(itypi,itypj)
1318 chi2=chi(itypj,itypi)
1325 alf12=0.5D0*(alf1+alf2)
1326 C For diagnostics only!!!
1339 dxj=dc_norm(1,nres+j)
1340 dyj=dc_norm(2,nres+j)
1341 dzj=dc_norm(3,nres+j)
1342 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1344 C Calculate angle-dependent terms of energy and contributions to their
1348 sig=sig0ij*dsqrt(sigsq)
1349 rij_shift=1.0D0/rij-sig+r0ij
1350 C I hate to put IF's in the loops, but here don't have another choice!!!!
1351 if (rij_shift.le.0.0D0) then
1356 c---------------------------------------------------------------
1357 rij_shift=1.0D0/rij_shift
1358 fac=rij_shift**expon
1361 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1362 eps2der=evdwij*eps3rt
1363 eps3der=evdwij*eps2rt
1364 fac_augm=rrij**expon
1365 e_augm=augm(itypi,itypj)*fac_augm
1366 evdwij=evdwij*eps2rt*eps3rt
1367 if (bb.gt.0.0d0) then
1368 evdw=evdw+evdwij+e_augm
1370 evdw_t=evdw_t+evdwij+e_augm
1372 ij=icant(itypi,itypj)
1373 aux=eps1*eps2rt**2*eps3rt**2
1374 eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm)
1375 & /dabs(eps(itypi,itypj))
1376 eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj)
1377 c eneps_temp(ij)=eneps_temp(ij)
1378 c & +(evdwij+e_augm)/eps(itypi,itypj)
1380 c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1381 c epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1382 c write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1383 c & restyp(itypi),i,restyp(itypj),j,
1384 c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1385 c & chi1,chi2,chip1,chip2,
1386 c & eps1,eps2rt**2,eps3rt**2,
1387 c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1391 C Calculate gradient components.
1392 e1=e1*eps1*eps2rt**2*eps3rt**2
1393 fac=-expon*(e1+evdwij)*rij_shift
1395 fac=rij*fac-2*expon*rrij*e_augm
1396 C Calculate the radial part of the gradient
1400 C Calculate angular part of the gradient.
1408 C-----------------------------------------------------------------------------
1409 subroutine sc_angular
1410 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1411 C om12. Called by ebp, egb, and egbv.
1413 include 'COMMON.CALC'
1417 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1418 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1419 om12=dxi*dxj+dyi*dyj+dzi*dzj
1421 C Calculate eps1(om12) and its derivative in om12
1422 faceps1=1.0D0-om12*chiom12
1423 faceps1_inv=1.0D0/faceps1
1424 eps1=dsqrt(faceps1_inv)
1425 C Following variable is eps1*deps1/dom12
1426 eps1_om12=faceps1_inv*chiom12
1427 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1432 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1433 sigsq=1.0D0-facsig*faceps1_inv
1434 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1435 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1436 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1437 C Calculate eps2 and its derivatives in om1, om2, and om12.
1440 chipom12=chip12*om12
1441 facp=1.0D0-om12*chipom12
1443 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1444 C Following variable is the square root of eps2
1445 eps2rt=1.0D0-facp1*facp_inv
1446 C Following three variables are the derivatives of the square root of eps
1447 C in om1, om2, and om12.
1448 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1449 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1450 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1451 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1452 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1453 C Calculate whole angle-dependent part of epsilon and contributions
1454 C to its derivatives
1457 C----------------------------------------------------------------------------
1459 implicit real*8 (a-h,o-z)
1460 include 'DIMENSIONS'
1461 include 'DIMENSIONS.ZSCOPT'
1462 include 'COMMON.CHAIN'
1463 include 'COMMON.DERIV'
1464 include 'COMMON.CALC'
1465 double precision dcosom1(3),dcosom2(3)
1466 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1467 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1468 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1469 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1471 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1472 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1475 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1478 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1479 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1480 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1481 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1482 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1483 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1486 C Calculate the components of the gradient in DC and X
1490 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1495 c------------------------------------------------------------------------------
1496 subroutine vec_and_deriv
1497 implicit real*8 (a-h,o-z)
1498 include 'DIMENSIONS'
1499 include 'DIMENSIONS.ZSCOPT'
1500 include 'COMMON.IOUNITS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.VECTORS'
1506 include 'COMMON.DERIV'
1507 include 'COMMON.INTERACT'
1508 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1509 C Compute the local reference systems. For reference system (i), the
1510 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1511 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1513 c if (i.eq.nres-1 .or. itel(i+1).eq.0) then
1514 if (i.eq.nres-1) then
1515 C Case of the last full residue
1516 C Compute the Z-axis
1517 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1518 costh=dcos(pi-theta(nres))
1519 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1524 C Compute the derivatives of uz
1526 uzder(2,1,1)=-dc_norm(3,i-1)
1527 uzder(3,1,1)= dc_norm(2,i-1)
1528 uzder(1,2,1)= dc_norm(3,i-1)
1530 uzder(3,2,1)=-dc_norm(1,i-1)
1531 uzder(1,3,1)=-dc_norm(2,i-1)
1532 uzder(2,3,1)= dc_norm(1,i-1)
1535 uzder(2,1,2)= dc_norm(3,i)
1536 uzder(3,1,2)=-dc_norm(2,i)
1537 uzder(1,2,2)=-dc_norm(3,i)
1539 uzder(3,2,2)= dc_norm(1,i)
1540 uzder(1,3,2)= dc_norm(2,i)
1541 uzder(2,3,2)=-dc_norm(1,i)
1544 C Compute the Y-axis
1547 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1550 C Compute the derivatives of uy
1553 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1554 & -dc_norm(k,i)*dc_norm(j,i-1)
1555 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1557 uyder(j,j,1)=uyder(j,j,1)-costh
1558 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1563 uygrad(l,k,j,i)=uyder(l,k,j)
1564 uzgrad(l,k,j,i)=uzder(l,k,j)
1568 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1569 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1570 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1571 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1575 C Compute the Z-axis
1576 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1577 costh=dcos(pi-theta(i+2))
1578 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1583 C Compute the derivatives of uz
1585 uzder(2,1,1)=-dc_norm(3,i+1)
1586 uzder(3,1,1)= dc_norm(2,i+1)
1587 uzder(1,2,1)= dc_norm(3,i+1)
1589 uzder(3,2,1)=-dc_norm(1,i+1)
1590 uzder(1,3,1)=-dc_norm(2,i+1)
1591 uzder(2,3,1)= dc_norm(1,i+1)
1594 uzder(2,1,2)= dc_norm(3,i)
1595 uzder(3,1,2)=-dc_norm(2,i)
1596 uzder(1,2,2)=-dc_norm(3,i)
1598 uzder(3,2,2)= dc_norm(1,i)
1599 uzder(1,3,2)= dc_norm(2,i)
1600 uzder(2,3,2)=-dc_norm(1,i)
1603 C Compute the Y-axis
1606 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1609 C Compute the derivatives of uy
1612 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1613 & -dc_norm(k,i)*dc_norm(j,i+1)
1614 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1616 uyder(j,j,1)=uyder(j,j,1)-costh
1617 uyder(j,j,2)=1.0d0+uyder(j,j,2)
1622 uygrad(l,k,j,i)=uyder(l,k,j)
1623 uzgrad(l,k,j,i)=uzder(l,k,j)
1627 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1628 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1629 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1630 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1636 vbld_inv_temp(1)=vbld_inv(i+1)
1637 if (i.lt.nres-1) then
1638 vbld_inv_temp(2)=vbld_inv(i+2)
1640 vbld_inv_temp(2)=vbld_inv(i)
1645 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
1646 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
1654 C-----------------------------------------------------------------------------
1655 subroutine vec_and_deriv_test
1656 implicit real*8 (a-h,o-z)
1657 include 'DIMENSIONS'
1658 include 'DIMENSIONS.ZSCOPT'
1659 include 'COMMON.IOUNITS'
1660 include 'COMMON.GEO'
1661 include 'COMMON.VAR'
1662 include 'COMMON.LOCAL'
1663 include 'COMMON.CHAIN'
1664 include 'COMMON.VECTORS'
1665 dimension uyder(3,3,2),uzder(3,3,2)
1666 C Compute the local reference systems. For reference system (i), the
1667 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1668 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1670 if (i.eq.nres-1) then
1671 C Case of the last full residue
1672 C Compute the Z-axis
1673 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1674 costh=dcos(pi-theta(nres))
1675 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1676 c write (iout,*) 'fac',fac,
1677 c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1678 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1682 C Compute the derivatives of uz
1684 uzder(2,1,1)=-dc_norm(3,i-1)
1685 uzder(3,1,1)= dc_norm(2,i-1)
1686 uzder(1,2,1)= dc_norm(3,i-1)
1688 uzder(3,2,1)=-dc_norm(1,i-1)
1689 uzder(1,3,1)=-dc_norm(2,i-1)
1690 uzder(2,3,1)= dc_norm(1,i-1)
1693 uzder(2,1,2)= dc_norm(3,i)
1694 uzder(3,1,2)=-dc_norm(2,i)
1695 uzder(1,2,2)=-dc_norm(3,i)
1697 uzder(3,2,2)= dc_norm(1,i)
1698 uzder(1,3,2)= dc_norm(2,i)
1699 uzder(2,3,2)=-dc_norm(1,i)
1701 C Compute the Y-axis
1703 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1706 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1707 & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2-
1708 & scalar(dc_norm(1,i),dc_norm(1,i-1))**2))
1710 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1713 & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i))
1714 & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i)
1717 c write (iout,*) 'facy',facy,
1718 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1719 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1721 uy(k,i)=facy*uy(k,i)
1723 C Compute the derivatives of uy
1726 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1727 & -dc_norm(k,i)*dc_norm(j,i-1)
1728 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1730 c uyder(j,j,1)=uyder(j,j,1)-costh
1731 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1732 uyder(j,j,1)=uyder(j,j,1)
1733 & -scalar(dc_norm(1,i),dc_norm(1,i-1))
1734 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1740 uygrad(l,k,j,i)=uyder(l,k,j)
1741 uzgrad(l,k,j,i)=uzder(l,k,j)
1745 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1746 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1747 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1748 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1751 C Compute the Z-axis
1752 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
1753 costh=dcos(pi-theta(i+2))
1754 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1755 fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i)))
1759 C Compute the derivatives of uz
1761 uzder(2,1,1)=-dc_norm(3,i+1)
1762 uzder(3,1,1)= dc_norm(2,i+1)
1763 uzder(1,2,1)= dc_norm(3,i+1)
1765 uzder(3,2,1)=-dc_norm(1,i+1)
1766 uzder(1,3,1)=-dc_norm(2,i+1)
1767 uzder(2,3,1)= dc_norm(1,i+1)
1770 uzder(2,1,2)= dc_norm(3,i)
1771 uzder(3,1,2)=-dc_norm(2,i)
1772 uzder(1,2,2)=-dc_norm(3,i)
1774 uzder(3,2,2)= dc_norm(1,i)
1775 uzder(1,3,2)= dc_norm(2,i)
1776 uzder(2,3,2)=-dc_norm(1,i)
1778 C Compute the Y-axis
1780 facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))*
1781 & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2-
1782 & scalar(dc_norm(1,i),dc_norm(1,i+1))**2))
1784 c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
1787 & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i))
1788 & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i)
1791 c write (iout,*) 'facy',facy,
1792 c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1793 facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i)))
1795 uy(k,i)=facy*uy(k,i)
1797 C Compute the derivatives of uy
1800 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
1801 & -dc_norm(k,i)*dc_norm(j,i+1)
1802 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1804 c uyder(j,j,1)=uyder(j,j,1)-costh
1805 c uyder(j,j,2)=1.0d0+uyder(j,j,2)
1806 uyder(j,j,1)=uyder(j,j,1)
1807 & -scalar(dc_norm(1,i),dc_norm(1,i+1))
1808 uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i))
1814 uygrad(l,k,j,i)=uyder(l,k,j)
1815 uzgrad(l,k,j,i)=uzder(l,k,j)
1819 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
1820 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
1821 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
1822 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
1829 uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i)
1830 uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i)
1837 C-----------------------------------------------------------------------------
1838 subroutine check_vecgrad
1839 implicit real*8 (a-h,o-z)
1840 include 'DIMENSIONS'
1841 include 'DIMENSIONS.ZSCOPT'
1842 include 'COMMON.IOUNITS'
1843 include 'COMMON.GEO'
1844 include 'COMMON.VAR'
1845 include 'COMMON.LOCAL'
1846 include 'COMMON.CHAIN'
1847 include 'COMMON.VECTORS'
1848 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
1849 dimension uyt(3,maxres),uzt(3,maxres)
1850 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
1851 double precision delta /1.0d-7/
1854 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
1855 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
1856 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
1857 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
1858 cd & (dc_norm(if90,i),if90=1,3)
1859 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
1860 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
1861 cd write(iout,'(a)')
1867 uygradt(l,k,j,i)=uygrad(l,k,j,i)
1868 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
1881 cd write (iout,*) 'i=',i
1883 erij(k)=dc_norm(k,i)
1887 dc_norm(k,i)=erij(k)
1889 dc_norm(j,i)=dc_norm(j,i)+delta
1890 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
1892 c dc_norm(k,i)=dc_norm(k,i)/fac
1894 c write (iout,*) (dc_norm(k,i),k=1,3)
1895 c write (iout,*) (erij(k),k=1,3)
1898 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
1899 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
1900 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
1901 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
1903 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1904 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
1905 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
1908 dc_norm(k,i)=erij(k)
1911 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1912 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
1913 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
1914 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
1915 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
1916 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
1917 cd write (iout,'(a)')
1922 C--------------------------------------------------------------------------
1923 subroutine set_matrices
1924 implicit real*8 (a-h,o-z)
1925 include 'DIMENSIONS'
1926 include 'DIMENSIONS.ZSCOPT'
1927 include 'COMMON.IOUNITS'
1928 include 'COMMON.GEO'
1929 include 'COMMON.VAR'
1930 include 'COMMON.LOCAL'
1931 include 'COMMON.CHAIN'
1932 include 'COMMON.DERIV'
1933 include 'COMMON.INTERACT'
1934 include 'COMMON.CONTACTS'
1935 include 'COMMON.TORSION'
1936 include 'COMMON.VECTORS'
1937 include 'COMMON.FFIELD'
1938 double precision auxvec(2),auxmat(2,2)
1940 C Compute the virtual-bond-torsional-angle dependent quantities needed
1941 C to calculate the el-loc multibody terms of various order.
1944 if (i .lt. nres+1) then
1981 if (i .gt. 3 .and. i .lt. nres+1) then
1982 obrot_der(1,i-2)=-sin1
1983 obrot_der(2,i-2)= cos1
1984 Ugder(1,1,i-2)= sin1
1985 Ugder(1,2,i-2)=-cos1
1986 Ugder(2,1,i-2)=-cos1
1987 Ugder(2,2,i-2)=-sin1
1990 obrot2_der(1,i-2)=-dwasin2
1991 obrot2_der(2,i-2)= dwacos2
1992 Ug2der(1,1,i-2)= dwasin2
1993 Ug2der(1,2,i-2)=-dwacos2
1994 Ug2der(2,1,i-2)=-dwacos2
1995 Ug2der(2,2,i-2)=-dwasin2
1997 obrot_der(1,i-2)=0.0d0
1998 obrot_der(2,i-2)=0.0d0
1999 Ugder(1,1,i-2)=0.0d0
2000 Ugder(1,2,i-2)=0.0d0
2001 Ugder(2,1,i-2)=0.0d0
2002 Ugder(2,2,i-2)=0.0d0
2003 obrot2_der(1,i-2)=0.0d0
2004 obrot2_der(2,i-2)=0.0d0
2005 Ug2der(1,1,i-2)=0.0d0
2006 Ug2der(1,2,i-2)=0.0d0
2007 Ug2der(2,1,i-2)=0.0d0
2008 Ug2der(2,2,i-2)=0.0d0
2010 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2011 if (itype(i-2).le.ntyp) then
2012 iti = itortyp(itype(i-2))
2019 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2020 if (itype(i-1).le.ntyp) then
2021 iti1 = itortyp(itype(i-1))
2028 cd write (iout,*) '*******i',i,' iti1',iti
2029 cd write (iout,*) 'b1',b1(:,iti)
2030 cd write (iout,*) 'b2',b2(:,iti)
2031 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2032 c print *,"itilde1 i iti iti1",i,iti,iti1
2033 if (i .gt. iatel_s+2) then
2034 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2035 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2036 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2037 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2038 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2039 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2040 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2050 DtUg2(l,k,i-2)=0.0d0
2054 c print *,"itilde2 i iti iti1",i,iti,iti1
2055 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2056 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2057 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2058 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2059 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2060 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2061 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2062 c print *,"itilde3 i iti iti1",i,iti,iti1
2064 muder(k,i-2)=Ub2der(k,i-2)
2066 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2067 if (itype(i-1).le.ntyp) then
2068 iti1 = itortyp(itype(i-1))
2076 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2078 C write (iout,*) 'mumu',i,b1(1,iti),Ub2(1,i-2)
2080 C Vectors and matrices dependent on a single virtual-bond dihedral.
2081 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2082 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2083 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2084 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2085 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2086 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2087 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2088 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2089 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2090 cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2),
2091 cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2)
2093 C Matrices dependent on two consecutive virtual-bond dihedrals.
2094 C The order of matrices is from left to right.
2096 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2097 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2098 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2099 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2100 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2101 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2102 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2103 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2106 cd iti = itortyp(itype(i))
2109 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2110 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2115 C--------------------------------------------------------------------------
2116 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2118 C This subroutine calculates the average interaction energy and its gradient
2119 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2120 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2121 C The potential depends both on the distance of peptide-group centers and on
2122 C the orientation of the CA-CA virtual bonds.
2124 implicit real*8 (a-h,o-z)
2125 include 'DIMENSIONS'
2126 include 'DIMENSIONS.ZSCOPT'
2127 include 'COMMON.CONTROL'
2128 include 'COMMON.IOUNITS'
2129 include 'COMMON.GEO'
2130 include 'COMMON.VAR'
2131 include 'COMMON.LOCAL'
2132 include 'COMMON.CHAIN'
2133 include 'COMMON.DERIV'
2134 include 'COMMON.INTERACT'
2135 include 'COMMON.CONTACTS'
2136 include 'COMMON.TORSION'
2137 include 'COMMON.VECTORS'
2138 include 'COMMON.FFIELD'
2139 include 'COMMON.SHIELD'
2140 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2141 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2142 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2143 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2144 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1
2145 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2146 double precision scal_el /0.5d0/
2148 C 13-go grudnia roku pamietnego...
2149 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2150 & 0.0d0,1.0d0,0.0d0,
2151 & 0.0d0,0.0d0,1.0d0/
2152 cd write(iout,*) 'In EELEC'
2154 cd write(iout,*) 'Type',i
2155 cd write(iout,*) 'B1',B1(:,i)
2156 cd write(iout,*) 'B2',B2(:,i)
2157 cd write(iout,*) 'CC',CC(:,:,i)
2158 cd write(iout,*) 'DD',DD(:,:,i)
2159 cd write(iout,*) 'EE',EE(:,:,i)
2161 cd call check_vecgrad
2163 if (icheckgrad.eq.1) then
2165 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2167 dc_norm(k,i)=dc(k,i)*fac
2169 c write (iout,*) 'i',i,' fac',fac
2172 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2173 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2174 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2175 cd if (wel_loc.gt.0.0d0) then
2176 if (icheckgrad.eq.1) then
2177 call vec_and_deriv_test
2184 cd write (iout,*) 'i=',i
2186 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2189 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2190 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2203 C print '(a)','Enter EELEC'
2204 C write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2206 gel_loc_loc(i)=0.0d0
2209 do i=iatel_s,iatel_e
2211 if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1
2212 C & .or. itype(i+2).eq.ntyp1) cycle
2214 C if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2215 C & .or. itype(i+2).eq.ntyp1
2216 C & .or. itype(i-1).eq.ntyp1
2219 if (itel(i).eq.0) goto 1215
2223 dx_normi=dc_norm(1,i)
2224 dy_normi=dc_norm(2,i)
2225 dz_normi=dc_norm(3,i)
2226 xmedi=c(1,i)+0.5d0*dxi
2227 ymedi=c(2,i)+0.5d0*dyi
2228 zmedi=c(3,i)+0.5d0*dzi
2229 xmedi=mod(xmedi,boxxsize)
2230 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2231 ymedi=mod(ymedi,boxysize)
2232 if (ymedi.lt.0) ymedi=ymedi+boxysize
2233 zmedi=mod(zmedi,boxzsize)
2234 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2235 zmedi2=mod(zmedi,boxzsize)
2236 if (zmedi2.lt.0) zmedi2=zmedi2+boxzsize
2237 if ((zmedi2.gt.bordlipbot)
2238 &.and.(zmedi2.lt.bordliptop)) then
2239 C the energy transfer exist
2240 if (zmedi2.lt.buflipbot) then
2241 C what fraction I am in
2243 & ((zmedi2-bordlipbot)/lipbufthick)
2244 C lipbufthick is thickenes of lipid buffore
2245 sslipi=sscalelip(fracinbuf)
2246 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2247 elseif (zmedi2.gt.bufliptop) then
2248 fracinbuf=1.0d0-((bordliptop-zmedi2)/lipbufthick)
2249 sslipi=sscalelip(fracinbuf)
2250 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2261 C write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2262 do j=ielstart(i),ielend(i)
2264 C if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2265 C & .or.itype(j+2).eq.ntyp1
2268 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1
2269 C & .or.itype(j+2).eq.ntyp1
2270 C & .or.itype(j-1).eq.ntyp1
2275 if (itel(j).eq.0) goto 1216
2279 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2280 aaa=app(iteli,itelj)
2281 bbb=bpp(iteli,itelj)
2282 C Diagnostics only!!!
2288 ael6i=ael6(iteli,itelj)
2289 ael3i=ael3(iteli,itelj)
2293 dx_normj=dc_norm(1,j)
2294 dy_normj=dc_norm(2,j)
2295 dz_normj=dc_norm(3,j)
2300 if (xj.lt.0) xj=xj+boxxsize
2302 if (yj.lt.0) yj=yj+boxysize
2304 if (zj.lt.0) zj=zj+boxzsize
2305 if ((zj.gt.bordlipbot)
2306 &.and.(zj.lt.bordliptop)) then
2307 C the energy transfer exist
2308 if (zj.lt.buflipbot) then
2309 C what fraction I am in
2311 & ((zj-bordlipbot)/lipbufthick)
2312 C lipbufthick is thickenes of lipid buffore
2313 sslipj=sscalelip(fracinbuf)
2314 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
2315 elseif (zj.gt.bufliptop) then
2316 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
2317 sslipj=sscalelip(fracinbuf)
2318 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
2327 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2335 xj=xj_safe+xshift*boxxsize
2336 yj=yj_safe+yshift*boxysize
2337 zj=zj_safe+zshift*boxzsize
2338 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2339 if(dist_temp.lt.dist_init) then
2349 if (isubchap.eq.1) then
2358 rij=xj*xj+yj*yj+zj*zj
2359 sss=sscale(sqrt(rij))
2360 sssgrad=sscagrad(sqrt(rij))
2366 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2367 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2368 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2369 fac=cosa-3.0D0*cosb*cosg
2371 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2372 if (j.eq.i+2) ev1=scal_el*ev1
2377 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2380 c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij
2381 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2382 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2383 if (shield_mode.gt.0) then
2386 write(iout,*) "ees_compon",i,j,el1,el2,
2387 & fac_shield(i),fac_shield(j)
2392 el1=el1*fac_shield(i)**2*fac_shield(j)**2
2393 el2=el2*fac_shield(i)**2*fac_shield(j)**2
2401 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2404 evdw1=evdw1+evdwij*sss
2405 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2407 c write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
2408 c &'evdw1',i,j,evdwij
2409 c &,iteli,itelj,aaa,evdw1
2411 C write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2412 c write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2413 c & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2414 c & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2415 c & xmedi,ymedi,zmedi,xj,yj,zj
2417 C Calculate contributions to the Cartesian gradient.
2420 facvdw=-6*rrmij*(ev1+evdwij)*sss
2421 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2423 facel=-3*rrmij*(el1+eesij)
2424 &*((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2432 * Radial derivatives. First process both termini of the fragment (i,j)
2437 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2438 & (shield_mode.gt.0)) then
2440 do ilist=1,ishield_list(i)
2441 iresshield=shield_list(ilist,i)
2443 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)
2445 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2447 & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0
2448 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2449 C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield)
2450 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2451 C if (iresshield.gt.i) then
2452 C do ishi=i+1,iresshield-1
2453 C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield
2454 C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2458 C do ishi=iresshield,i
2459 C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield
2460 C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)
2466 do ilist=1,ishield_list(j)
2467 iresshield=shield_list(ilist,j)
2469 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j)
2471 gshieldx(k,iresshield)=gshieldx(k,iresshield)+
2473 & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0
2474 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
2479 gshieldc(k,i)=gshieldc(k,i)+
2480 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2481 gshieldc(k,j)=gshieldc(k,j)+
2482 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2483 gshieldc(k,i-1)=gshieldc(k,i-1)+
2484 & grad_shield(k,i)*eesij/fac_shield(i)*2.0
2485 gshieldc(k,j-1)=gshieldc(k,j-1)+
2486 & grad_shield(k,j)*eesij/fac_shield(j)*2.0
2493 gelc(k,i)=gelc(k,i)+ghalf
2494 gelc(k,j)=gelc(k,j)+ghalf
2497 * Loop over residues i+1 thru j-1.
2501 gelc(l,k)=gelc(l,k)+ggg(l)
2507 if (sss.gt.0.0) then
2508 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
2509 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2510 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
2511 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2513 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
2514 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2523 gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2524 gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2526 gvdwpp(3,j)=gvdwpp(3,j)+
2527 & sss*ssgradlipj*evdwij/2.0d0*lipscale**2
2528 gvdwpp(3,i)=gvdwpp(3,i)+
2529 & sss*ssgradlipi*evdwij/2.0d0*lipscale**2
2532 * Loop over residues i+1 thru j-1.
2536 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2540 facvdw=(ev1+evdwij)*sss
2541 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2545 fac=-3*rrmij*(facvdw+facvdw+facel)
2551 * Radial derivatives. First process both termini of the fragment (i,j)
2558 gelc(k,i)=gelc(k,i)+ghalf
2559 gelc(k,j)=gelc(k,j)+ghalf
2562 * Loop over residues i+1 thru j-1.
2566 gelc(l,k)=gelc(l,k)+ggg(l)
2573 ecosa=2.0D0*fac3*fac1+fac4
2576 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
2577 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
2579 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
2580 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
2582 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
2583 cd & (dcosg(k),k=1,3)
2585 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
2586 & *fac_shield(i)**2*fac_shield(j)**2
2587 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2592 gelc(k,i)=gelc(k,i)+ghalf
2593 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
2594 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
2595 & *fac_shield(i)**2*fac_shield(j)**2
2596 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2599 gelc(k,j)=gelc(k,j)+ghalf
2600 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
2601 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
2602 & *fac_shield(i)**2*fac_shield(j)**2
2603 & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
2608 gelc(l,k)=gelc(l,k)+ggg(l)
2613 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2614 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
2615 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
2617 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
2618 C energy of a peptide unit is assumed in the form of a second-order
2619 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
2620 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
2621 C are computed for EVERY pair of non-contiguous peptide groups.
2623 if (j.lt.nres-1) then
2634 muij(kkk)=mu(k,i)*mu(l,j)
2637 cd write (iout,*) 'EELEC: i',i,' j',j
2638 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
2639 cd write(iout,*) 'muij',muij
2640 ury=scalar(uy(1,i),erij)
2641 urz=scalar(uz(1,i),erij)
2642 vry=scalar(uy(1,j),erij)
2643 vrz=scalar(uz(1,j),erij)
2644 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
2645 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
2646 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
2647 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
2648 C For diagnostics only
2653 fac=dsqrt(-ael6i)*r3ij
2654 cd write (2,*) 'fac=',fac
2655 C For diagnostics only
2661 cd write (iout,'(4i5,4f10.5)')
2662 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
2663 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
2664 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3),
2665 cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3)
2666 cd write (iout,'(4f10.5)')
2667 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
2668 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
2669 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
2670 cd write (iout,'(2i3,9f10.5/)') i,j,
2671 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
2673 C Derivatives of the elements of A in virtual-bond vectors
2674 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
2681 uryg(k,1)=scalar(erder(1,k),uy(1,i))
2682 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
2683 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
2684 urzg(k,1)=scalar(erder(1,k),uz(1,i))
2685 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
2686 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
2687 vryg(k,1)=scalar(erder(1,k),uy(1,j))
2688 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
2689 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
2690 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
2691 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
2692 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
2702 C Compute radial contributions to the gradient
2724 C Add the contributions coming from er
2727 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
2728 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
2729 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
2730 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
2733 C Derivatives in DC(i)
2734 ghalf1=0.5d0*agg(k,1)
2735 ghalf2=0.5d0*agg(k,2)
2736 ghalf3=0.5d0*agg(k,3)
2737 ghalf4=0.5d0*agg(k,4)
2738 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
2739 & -3.0d0*uryg(k,2)*vry)+ghalf1
2740 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
2741 & -3.0d0*uryg(k,2)*vrz)+ghalf2
2742 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
2743 & -3.0d0*urzg(k,2)*vry)+ghalf3
2744 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
2745 & -3.0d0*urzg(k,2)*vrz)+ghalf4
2746 C Derivatives in DC(i+1)
2747 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
2748 & -3.0d0*uryg(k,3)*vry)+agg(k,1)
2749 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
2750 & -3.0d0*uryg(k,3)*vrz)+agg(k,2)
2751 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
2752 & -3.0d0*urzg(k,3)*vry)+agg(k,3)
2753 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
2754 & -3.0d0*urzg(k,3)*vrz)+agg(k,4)
2755 C Derivatives in DC(j)
2756 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
2757 & -3.0d0*vryg(k,2)*ury)+ghalf1
2758 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
2759 & -3.0d0*vrzg(k,2)*ury)+ghalf2
2760 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
2761 & -3.0d0*vryg(k,2)*urz)+ghalf3
2762 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
2763 & -3.0d0*vrzg(k,2)*urz)+ghalf4
2764 C Derivatives in DC(j+1) or DC(nres-1)
2765 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
2766 & -3.0d0*vryg(k,3)*ury)
2767 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
2768 & -3.0d0*vrzg(k,3)*ury)
2769 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
2770 & -3.0d0*vryg(k,3)*urz)
2771 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
2772 & -3.0d0*vrzg(k,3)*urz)
2777 C Derivatives in DC(i+1)
2778 cd aggi1(k,1)=agg(k,1)
2779 cd aggi1(k,2)=agg(k,2)
2780 cd aggi1(k,3)=agg(k,3)
2781 cd aggi1(k,4)=agg(k,4)
2782 C Derivatives in DC(j)
2787 C Derivatives in DC(j+1)
2792 if (j.eq.nres-1 .and. i.lt.j-2) then
2794 aggj1(k,l)=aggj1(k,l)+agg(k,l)
2795 cd aggj1(k,l)=agg(k,l)
2801 C Check the loc-el terms by numerical integration
2811 aggi(k,l)=-aggi(k,l)
2812 aggi1(k,l)=-aggi1(k,l)
2813 aggj(k,l)=-aggj(k,l)
2814 aggj1(k,l)=-aggj1(k,l)
2817 if (j.lt.nres-1) then
2823 aggi(k,l)=-aggi(k,l)
2824 aggi1(k,l)=-aggi1(k,l)
2825 aggj(k,l)=-aggj(k,l)
2826 aggj1(k,l)=-aggj1(k,l)
2837 aggi(k,l)=-aggi(k,l)
2838 aggi1(k,l)=-aggi1(k,l)
2839 aggj(k,l)=-aggj(k,l)
2840 aggj1(k,l)=-aggj1(k,l)
2846 IF (wel_loc.gt.0.0d0) THEN
2847 C Contribution to the local-electrostatic energy coming from the i-j pair
2848 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
2850 if (shield_mode.eq.0) then
2857 eel_loc_ij=eel_loc_ij
2858 & *fac_shield(i)*fac_shield(j)
2859 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2860 C write (iout,'(a3,i4,a3,i4,a8,4f8.3)')
2861 C & 'i',i,' j',j,' eel_loc_ij',eel_loc_ij,sslipi,
2863 C write (iout,'(a6,2i5,0pf7.3,2f7.3)')
2864 C & 'eelloc',i,j,eel_loc_ij,a22*muij(1),a23*muij(2)
2865 C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4)
2866 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
2867 C eel_loc=eel_loc+eel_loc_ij
2868 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
2869 & (shield_mode.gt.0)) then
2872 do ilist=1,ishield_list(i)
2873 iresshield=shield_list(ilist,i)
2875 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij
2878 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2880 & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i)
2881 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2885 do ilist=1,ishield_list(j)
2886 iresshield=shield_list(ilist,j)
2888 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij
2891 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+
2893 & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j)
2894 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)
2900 gshieldc_ll(k,i)=gshieldc_ll(k,i)+
2901 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2902 gshieldc_ll(k,j)=gshieldc_ll(k,j)+
2903 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2904 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+
2905 & grad_shield(k,i)*eel_loc_ij/fac_shield(i)
2906 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+
2907 & grad_shield(k,j)*eel_loc_ij/fac_shield(j)
2910 eel_loc=eel_loc+eel_loc_ij
2912 C Partial derivatives in virtual-bond dihedral angles gamma
2915 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
2916 & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
2917 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j))
2918 & *fac_shield(i)*fac_shield(j)
2919 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2921 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
2922 & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
2923 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j))
2924 & *fac_shield(i)*fac_shield(j)
2925 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2927 cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij)
2928 cd write(iout,*) 'agg ',agg
2929 cd write(iout,*) 'aggi ',aggi
2930 cd write(iout,*) 'aggi1',aggi1
2931 cd write(iout,*) 'aggj ',aggj
2932 cd write(iout,*) 'aggj1',aggj1
2934 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
2936 ggg(l)=(agg(l,1)*muij(1)+
2937 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))
2938 & *fac_shield(i)*fac_shield(j)
2939 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2944 gel_loc(l,k)=gel_loc(l,k)+ggg(l)
2947 C Remaining derivatives of eello
2949 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
2950 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
2951 & *fac_shield(i)*fac_shield(j)
2952 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2954 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
2955 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
2956 & *fac_shield(i)*fac_shield(j)
2957 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2959 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
2960 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
2961 & *fac_shield(i)*fac_shield(j)
2962 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2964 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
2965 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
2966 & *fac_shield(i)*fac_shield(j)
2967 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
2972 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2973 C Contributions from turns
2978 call eturn34(i,j,eello_turn3,eello_turn4)
2980 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
2981 if (j.gt.i+1 .and. num_conti.le.maxconts) then
2983 C Calculate the contact function. The ith column of the array JCONT will
2984 C contain the numbers of atoms that make contacts with the atom I (of numbers
2985 C greater than I). The arrays FACONT and GACONT will contain the values of
2986 C the contact function and its derivative.
2987 c r0ij=1.02D0*rpp(iteli,itelj)
2988 c r0ij=1.11D0*rpp(iteli,itelj)
2989 r0ij=2.20D0*rpp(iteli,itelj)
2990 c r0ij=1.55D0*rpp(iteli,itelj)
2991 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
2992 if (fcont.gt.0.0D0) then
2993 num_conti=num_conti+1
2994 if (num_conti.gt.maxconts) then
2995 write (iout,*) 'WARNING - max. # of contacts exceeded;',
2996 & ' will skip next contacts for this conf.'
2998 jcont_hb(num_conti,i)=j
2999 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3000 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3001 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3003 d_cont(num_conti,i)=rij
3004 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3005 C --- Electrostatic-interaction matrix ---
3006 a_chuj(1,1,num_conti,i)=a22
3007 a_chuj(1,2,num_conti,i)=a23
3008 a_chuj(2,1,num_conti,i)=a32
3009 a_chuj(2,2,num_conti,i)=a33
3010 C --- Gradient of rij
3012 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3015 c a_chuj(1,1,num_conti,i)=-0.61d0
3016 c a_chuj(1,2,num_conti,i)= 0.4d0
3017 c a_chuj(2,1,num_conti,i)= 0.65d0
3018 c a_chuj(2,2,num_conti,i)= 0.50d0
3019 c else if (i.eq.2) then
3020 c a_chuj(1,1,num_conti,i)= 0.0d0
3021 c a_chuj(1,2,num_conti,i)= 0.0d0
3022 c a_chuj(2,1,num_conti,i)= 0.0d0
3023 c a_chuj(2,2,num_conti,i)= 0.0d0
3025 C --- and its gradients
3026 cd write (iout,*) 'i',i,' j',j
3028 cd write (iout,*) 'iii 1 kkk',kkk
3029 cd write (iout,*) agg(kkk,:)
3032 cd write (iout,*) 'iii 2 kkk',kkk
3033 cd write (iout,*) aggi(kkk,:)
3036 cd write (iout,*) 'iii 3 kkk',kkk
3037 cd write (iout,*) aggi1(kkk,:)
3040 cd write (iout,*) 'iii 4 kkk',kkk
3041 cd write (iout,*) aggj(kkk,:)
3044 cd write (iout,*) 'iii 5 kkk',kkk
3045 cd write (iout,*) aggj1(kkk,:)
3052 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3053 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3054 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3055 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3056 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3058 c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0
3064 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3065 C Calculate contact energies
3067 wij=cosa-3.0D0*cosb*cosg
3070 c fac3=dsqrt(-ael6i)/r0ij**3
3071 fac3=dsqrt(-ael6i)*r3ij
3072 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3073 ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3075 if (shield_mode.eq.0) then
3079 ees0plist(num_conti,i)=j
3080 C fac_shield(i)=0.4d0
3081 C fac_shield(j)=0.6d0
3083 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3084 & *fac_shield(i)*fac_shield(j)
3086 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3087 & *fac_shield(i)*fac_shield(j)
3089 C Diagnostics. Comment out or remove after debugging!
3090 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3091 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3092 c ees0m(num_conti,i)=0.0D0
3094 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3095 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3096 facont_hb(num_conti,i)=fcont
3098 C Angular derivatives of the contact function
3099 ees0pij1=fac3/ees0pij
3100 ees0mij1=fac3/ees0mij
3101 fac3p=-3.0D0*fac3*rrmij
3102 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3103 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3105 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3106 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3107 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3108 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3109 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3110 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3111 ecosap=ecosa1+ecosa2
3112 ecosbp=ecosb1+ecosb2
3113 ecosgp=ecosg1+ecosg2
3114 ecosam=ecosa1-ecosa2
3115 ecosbm=ecosb1-ecosb2
3116 ecosgm=ecosg1-ecosg2
3125 fprimcont=fprimcont/rij
3126 cd facont_hb(num_conti,i)=1.0D0
3127 C Following line is for diagnostics.
3130 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3131 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3134 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3135 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3137 gggp(1)=gggp(1)+ees0pijp*xj
3138 gggp(2)=gggp(2)+ees0pijp*yj
3139 gggp(3)=gggp(3)+ees0pijp*zj
3140 gggm(1)=gggm(1)+ees0mijp*xj
3141 gggm(2)=gggm(2)+ees0mijp*yj
3142 gggm(3)=gggm(3)+ees0mijp*zj
3143 C Derivatives due to the contact function
3144 gacont_hbr(1,num_conti,i)=fprimcont*xj
3145 gacont_hbr(2,num_conti,i)=fprimcont*yj
3146 gacont_hbr(3,num_conti,i)=fprimcont*zj
3148 ghalfp=0.5D0*gggp(k)
3149 ghalfm=0.5D0*gggm(k)
3150 gacontp_hb1(k,num_conti,i)=ghalfp
3151 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3152 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3153 & *fac_shield(i)*fac_shield(j)
3155 gacontp_hb2(k,num_conti,i)=ghalfp
3156 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3157 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3158 & *fac_shield(i)*fac_shield(j)
3160 gacontp_hb3(k,num_conti,i)=gggp(k)
3161 & *fac_shield(i)*fac_shield(j)
3163 gacontm_hb1(k,num_conti,i)=ghalfm
3164 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3165 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3166 & *fac_shield(i)*fac_shield(j)
3168 gacontm_hb2(k,num_conti,i)=ghalfm
3169 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3170 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3171 & *fac_shield(i)*fac_shield(j)
3173 gacontm_hb3(k,num_conti,i)=gggm(k)
3174 & *fac_shield(i)*fac_shield(j)
3178 C Diagnostics. Comment out or remove after debugging!
3180 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3181 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3182 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3183 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3184 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3185 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3188 endif ! num_conti.le.maxconts
3193 num_cont_hb(i)=num_conti
3197 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3198 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3200 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3201 ccc eel_loc=eel_loc+eello_turn3
3204 C-----------------------------------------------------------------------------
3205 subroutine eturn34(i,j,eello_turn3,eello_turn4)
3206 C Third- and fourth-order contributions from turns
3207 implicit real*8 (a-h,o-z)
3208 include 'DIMENSIONS'
3209 include 'DIMENSIONS.ZSCOPT'
3210 include 'COMMON.IOUNITS'
3211 include 'COMMON.GEO'
3212 include 'COMMON.VAR'
3213 include 'COMMON.LOCAL'
3214 include 'COMMON.CHAIN'
3215 include 'COMMON.DERIV'
3216 include 'COMMON.INTERACT'
3217 include 'COMMON.CONTACTS'
3218 include 'COMMON.TORSION'
3219 include 'COMMON.VECTORS'
3220 include 'COMMON.FFIELD'
3221 include 'COMMON.SHIELD'
3222 include 'COMMON.CONTROL'
3224 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3225 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3226 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3227 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3228 & aggj(3,4),aggj1(3,4),a_temp(2,2)
3229 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
3230 zj=(c(3,j)+c(3,j+1))/2.0d0
3231 C xj=mod(xj,boxxsize)
3232 C if (xj.lt.0) xj=xj+boxxsize
3233 C yj=mod(yj,boxysize)
3234 C if (yj.lt.0) yj=yj+boxysize
3236 if (zj.lt.0) zj=zj+boxzsize
3237 C if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3238 if ((zj.gt.bordlipbot)
3239 &.and.(zj.lt.bordliptop)) then
3240 C the energy transfer exist
3241 if (zj.lt.buflipbot) then
3242 C what fraction I am in
3244 & ((zj-bordlipbot)/lipbufthick)
3245 C lipbufthick is thickenes of lipid buffore
3246 sslipj=sscalelip(fracinbuf)
3247 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3248 elseif (zj.gt.bufliptop) then
3249 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3250 sslipj=sscalelip(fracinbuf)
3251 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3262 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3263 C changes suggested by Ana to avoid out of bounds
3264 C & .or.((i+5).gt.nres)
3265 C & .or.((i-1).le.0)
3266 C end of changes suggested by Ana
3267 & .or. itype(i+2).eq.ntyp1
3268 & .or. itype(i+3).eq.ntyp1
3269 C & .or. itype(i+5).eq.ntyp1
3270 C & .or. itype(i).eq.ntyp1
3271 C & .or. itype(i-1).eq.ntyp1
3274 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3276 C Third-order contributions
3283 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3284 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3285 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3286 call transpose2(auxmat(1,1),auxmat1(1,1))
3287 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3288 if (shield_mode.eq.0) then
3296 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3297 & *fac_shield(i)*fac_shield(j)
3298 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3300 eello_t3=0.5d0*(pizda(1,1)+pizda(2,2))
3301 & *fac_shield(i)*fac_shield(j)
3302 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3303 write (iout,'(a3,i4,a3,i4,a8,4f8.3)')
3304 & 'i',i,' j',j,' eturn3',eello_t3,sslipi,
3306 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3307 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3308 cd & ' eello_turn3_num',4*eello_turn3_num
3310 C Derivatives in shield mode
3311 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3312 & (shield_mode.gt.0)) then
3315 do ilist=1,ishield_list(i)
3316 iresshield=shield_list(ilist,i)
3318 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
3320 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3322 & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
3323 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3327 do ilist=1,ishield_list(j)
3328 iresshield=shield_list(ilist,j)
3330 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
3332 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+
3334 & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
3335 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1)
3342 gshieldc_t3(k,i)=gshieldc_t3(k,i)+
3343 & grad_shield(k,i)*eello_t3/fac_shield(i)
3344 gshieldc_t3(k,j)=gshieldc_t3(k,j)+
3345 & grad_shield(k,j)*eello_t3/fac_shield(j)
3346 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+
3347 & grad_shield(k,i)*eello_t3/fac_shield(i)
3348 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+
3349 & grad_shield(k,j)*eello_t3/fac_shield(j)
3353 C Derivatives in gamma(i)
3354 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3355 call transpose2(auxmat2(1,1),pizda(1,1))
3356 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3357 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3358 & *fac_shield(i)*fac_shield(j)
3359 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3361 C Derivatives in gamma(i+1)
3362 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3363 call transpose2(auxmat2(1,1),pizda(1,1))
3364 call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1))
3365 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3366 & +0.5d0*(pizda(1,1)+pizda(2,2))
3367 & *fac_shield(i)*fac_shield(j)
3368 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3370 C Cartesian derivatives
3372 a_temp(1,1)=aggi(l,1)
3373 a_temp(1,2)=aggi(l,2)
3374 a_temp(2,1)=aggi(l,3)
3375 a_temp(2,2)=aggi(l,4)
3376 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3377 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3378 & +0.5d0*(pizda(1,1)+pizda(2,2))
3379 & *fac_shield(i)*fac_shield(j)
3380 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3382 a_temp(1,1)=aggi1(l,1)
3383 a_temp(1,2)=aggi1(l,2)
3384 a_temp(2,1)=aggi1(l,3)
3385 a_temp(2,2)=aggi1(l,4)
3386 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3387 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3388 & +0.5d0*(pizda(1,1)+pizda(2,2))
3389 & *fac_shield(i)*fac_shield(j)
3390 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3392 a_temp(1,1)=aggj(l,1)
3393 a_temp(1,2)=aggj(l,2)
3394 a_temp(2,1)=aggj(l,3)
3395 a_temp(2,2)=aggj(l,4)
3396 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3397 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3398 & +0.5d0*(pizda(1,1)+pizda(2,2))
3399 & *fac_shield(i)*fac_shield(j)
3400 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3402 a_temp(1,1)=aggj1(l,1)
3403 a_temp(1,2)=aggj1(l,2)
3404 a_temp(2,1)=aggj1(l,3)
3405 a_temp(2,2)=aggj1(l,4)
3406 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3407 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3408 & +0.5d0*(pizda(1,1)+pizda(2,2))
3409 & *fac_shield(i)*fac_shield(j)
3410 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3415 else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then
3416 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3417 C changes suggested by Ana to avoid out of bounds
3418 C & .or.((i+5).gt.nres)
3419 C & .or.((i-1).le.0)
3420 C end of changes suggested by Ana
3421 & .or. itype(i+3).eq.ntyp1
3422 & .or. itype(i+4).eq.ntyp1
3423 C & .or. itype(i+5).eq.ntyp1
3424 & .or. itype(i).eq.ntyp1
3425 C & .or. itype(i-1).eq.ntyp1
3427 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3429 C Fourth-order contributions
3437 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3438 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3439 iti1=itortyp(itype(i+1))
3440 iti2=itortyp(itype(i+2))
3441 iti3=itortyp(itype(i+3))
3442 call transpose2(EUg(1,1,i+1),e1t(1,1))
3443 call transpose2(Eug(1,1,i+2),e2t(1,1))
3444 call transpose2(Eug(1,1,i+3),e3t(1,1))
3445 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3446 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3447 s1=scalar2(b1(1,iti2),auxvec(1))
3448 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3449 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3450 s2=scalar2(b1(1,iti1),auxvec(1))
3451 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3452 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3453 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3454 if (shield_mode.eq.0) then
3462 eello_turn4=eello_turn4-(s1+s2+s3)
3463 & *fac_shield(i)*fac_shield(j)
3464 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3466 eello_t4=-(s1+s2+s3)
3467 & *fac_shield(i)*fac_shield(j)
3469 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3470 cd & ' eello_turn4_num',8*eello_turn4_num
3471 C Derivatives in gamma(i)
3473 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
3474 & (shield_mode.gt.0)) then
3477 do ilist=1,ishield_list(i)
3478 iresshield=shield_list(ilist,i)
3480 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
3482 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3484 & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
3485 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3489 do ilist=1,ishield_list(j)
3490 iresshield=shield_list(ilist,j)
3492 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
3494 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+
3496 & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
3497 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1)
3504 gshieldc_t4(k,i)=gshieldc_t4(k,i)+
3505 & grad_shield(k,i)*eello_t4/fac_shield(i)
3506 gshieldc_t4(k,j)=gshieldc_t4(k,j)+
3507 & grad_shield(k,j)*eello_t4/fac_shield(j)
3508 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+
3509 & grad_shield(k,i)*eello_t4/fac_shield(i)
3510 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+
3511 & grad_shield(k,j)*eello_t4/fac_shield(j)
3514 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3515 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3516 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3517 s1=scalar2(b1(1,iti2),auxvec(1))
3518 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3519 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3520 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3521 & *fac_shield(i)*fac_shield(j)
3522 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3524 C Derivatives in gamma(i+1)
3525 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3526 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3527 s2=scalar2(b1(1,iti1),auxvec(1))
3528 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3529 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3530 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3531 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3532 & *fac_shield(i)*fac_shield(j)
3533 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3535 C Derivatives in gamma(i+2)
3536 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3537 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3538 s1=scalar2(b1(1,iti2),auxvec(1))
3539 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3540 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3541 s2=scalar2(b1(1,iti1),auxvec(1))
3542 call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1))
3543 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3544 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3545 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3546 & *fac_shield(i)*fac_shield(j)
3547 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3549 C Cartesian derivatives
3551 C Derivatives of this turn contributions in DC(i+2)
3552 if (j.lt.nres-1) then
3554 a_temp(1,1)=agg(l,1)
3555 a_temp(1,2)=agg(l,2)
3556 a_temp(2,1)=agg(l,3)
3557 a_temp(2,2)=agg(l,4)
3558 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3559 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3560 s1=scalar2(b1(1,iti2),auxvec(1))
3561 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3562 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3563 s2=scalar2(b1(1,iti1),auxvec(1))
3564 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3565 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3566 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3568 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3569 & *fac_shield(i)*fac_shield(j)
3570 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3574 C Remaining derivatives of this turn contribution
3576 a_temp(1,1)=aggi(l,1)
3577 a_temp(1,2)=aggi(l,2)
3578 a_temp(2,1)=aggi(l,3)
3579 a_temp(2,2)=aggi(l,4)
3580 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3581 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3582 s1=scalar2(b1(1,iti2),auxvec(1))
3583 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3584 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3585 s2=scalar2(b1(1,iti1),auxvec(1))
3586 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3587 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3588 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3589 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3590 & *fac_shield(i)*fac_shield(j)
3591 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3593 a_temp(1,1)=aggi1(l,1)
3594 a_temp(1,2)=aggi1(l,2)
3595 a_temp(2,1)=aggi1(l,3)
3596 a_temp(2,2)=aggi1(l,4)
3597 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3598 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3599 s1=scalar2(b1(1,iti2),auxvec(1))
3600 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3601 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3602 s2=scalar2(b1(1,iti1),auxvec(1))
3603 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3604 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3605 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3606 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3607 & *fac_shield(i)*fac_shield(j)
3608 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3610 a_temp(1,1)=aggj(l,1)
3611 a_temp(1,2)=aggj(l,2)
3612 a_temp(2,1)=aggj(l,3)
3613 a_temp(2,2)=aggj(l,4)
3614 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3615 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3616 s1=scalar2(b1(1,iti2),auxvec(1))
3617 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3618 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3619 s2=scalar2(b1(1,iti1),auxvec(1))
3620 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3621 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3622 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3623 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3624 & *fac_shield(i)*fac_shield(j)
3625 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3627 a_temp(1,1)=aggj1(l,1)
3628 a_temp(1,2)=aggj1(l,2)
3629 a_temp(2,1)=aggj1(l,3)
3630 a_temp(2,2)=aggj1(l,4)
3631 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3632 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3633 s1=scalar2(b1(1,iti2),auxvec(1))
3634 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3635 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3636 s2=scalar2(b1(1,iti1),auxvec(1))
3637 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3638 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3640 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3641 & *fac_shield(i)*fac_shield(j)
3642 &*((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3645 gshieldc_t4(3,i)=gshieldc_t4(3,i)+
3646 & ssgradlipi*eello_t4/4.0d0*lipscale
3647 gshieldc_t4(3,j)=gshieldc_t4(3,j)+
3648 & ssgradlipj*eello_t4/4.0d0*lipscale
3649 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+
3650 & ssgradlipi*eello_t4/4.0d0*lipscale
3651 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+
3652 & ssgradlipj*eello_t4/4.0d0*lipscale
3658 C-----------------------------------------------------------------------------
3659 subroutine vecpr(u,v,w)
3660 implicit real*8(a-h,o-z)
3661 dimension u(3),v(3),w(3)
3662 w(1)=u(2)*v(3)-u(3)*v(2)
3663 w(2)=-u(1)*v(3)+u(3)*v(1)
3664 w(3)=u(1)*v(2)-u(2)*v(1)
3667 C-----------------------------------------------------------------------------
3668 subroutine unormderiv(u,ugrad,unorm,ungrad)
3669 C This subroutine computes the derivatives of a normalized vector u, given
3670 C the derivatives computed without normalization conditions, ugrad. Returns
3673 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3674 double precision vec(3)
3675 double precision scalar
3677 c write (2,*) 'ugrad',ugrad
3680 vec(i)=scalar(ugrad(1,i),u(1))
3682 c write (2,*) 'vec',vec
3685 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3688 c write (2,*) 'ungrad',ungrad
3691 C-----------------------------------------------------------------------------
3692 subroutine escp(evdw2,evdw2_14)
3694 C This subroutine calculates the excluded-volume interaction energy between
3695 C peptide-group centers and side chains and its gradient in virtual-bond and
3696 C side-chain vectors.
3698 implicit real*8 (a-h,o-z)
3699 include 'DIMENSIONS'
3700 include 'DIMENSIONS.ZSCOPT'
3701 include 'COMMON.GEO'
3702 include 'COMMON.VAR'
3703 include 'COMMON.LOCAL'
3704 include 'COMMON.CHAIN'
3705 include 'COMMON.DERIV'
3706 include 'COMMON.INTERACT'
3707 include 'COMMON.FFIELD'
3708 include 'COMMON.IOUNITS'
3712 cd print '(a)','Enter ESCP'
3713 c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e,
3714 c & ' scal14',scal14
3715 do i=iatscp_s,iatscp_e
3716 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3718 c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i),
3719 c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
3720 if (iteli.eq.0) goto 1225
3721 xi=0.5D0*(c(1,i)+c(1,i+1))
3722 yi=0.5D0*(c(2,i)+c(2,i+1))
3723 zi=0.5D0*(c(3,i)+c(3,i+1))
3724 C Returning the ith atom to box
3726 if (xi.lt.0) xi=xi+boxxsize
3728 if (yi.lt.0) yi=yi+boxysize
3730 if (zi.lt.0) zi=zi+boxzsize
3731 do iint=1,nscp_gr(i)
3733 do j=iscpstart(i,iint),iscpend(i,iint)
3734 itypj=iabs(itype(j))
3735 if (itypj.eq.ntyp1) cycle
3736 C Uncomment following three lines for SC-p interactions
3740 C Uncomment following three lines for Ca-p interactions
3744 C returning the jth atom to box
3746 if (xj.lt.0) xj=xj+boxxsize
3748 if (yj.lt.0) yj=yj+boxysize
3750 if (zj.lt.0) zj=zj+boxzsize
3751 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3756 C Finding the closest jth atom
3760 xj=xj_safe+xshift*boxxsize
3761 yj=yj_safe+yshift*boxysize
3762 zj=zj_safe+zshift*boxzsize
3763 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
3764 if(dist_temp.lt.dist_init) then
3774 if (subchap.eq.1) then
3783 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3784 C sss is scaling function for smoothing the cutoff gradient otherwise
3785 C the gradient would not be continuouse
3786 sss=sscale(1.0d0/(dsqrt(rrij)))
3787 if (sss.le.0.0d0) cycle
3788 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
3790 e1=fac*fac*aad(itypj,iteli)
3791 e2=fac*bad(itypj,iteli)
3792 if (iabs(j-i) .le. 2) then
3795 evdw2_14=evdw2_14+(e1+e2)*sss
3798 c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
3799 c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
3800 c & bad(itypj,iteli)
3801 evdw2=evdw2+evdwij*sss
3804 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3806 fac=-(evdwij+e1)*rrij*sss
3807 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
3812 cd write (iout,*) 'j<i'
3813 C Uncomment following three lines for SC-p interactions
3815 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3818 cd write (iout,*) 'j>i'
3821 C Uncomment following line for SC-p interactions
3822 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3826 gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3830 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3831 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3834 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3844 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3845 gradx_scp(j,i)=expon*gradx_scp(j,i)
3848 C******************************************************************************
3852 C To save time the factor EXPON has been extracted from ALL components
3853 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3856 C******************************************************************************
3859 C--------------------------------------------------------------------------
3860 subroutine edis(ehpb)
3862 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3864 implicit real*8 (a-h,o-z)
3865 include 'DIMENSIONS'
3866 include 'DIMENSIONS.ZSCOPT'
3867 include 'COMMON.SBRIDGE'
3868 include 'COMMON.CHAIN'
3869 include 'COMMON.DERIV'
3870 include 'COMMON.VAR'
3871 include 'COMMON.INTERACT'
3872 include 'COMMON.CONTROL'
3873 include 'COMMON.IOUNITS'
3876 cd print *,'edis: nhpb=',nhpb,' fbr=',fbr
3877 cd print *,'link_start=',link_start,' link_end=',link_end
3878 C write(iout,*) link_end, "link_end"
3879 if (link_end.eq.0) return
3880 do i=link_start,link_end
3881 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3882 C CA-CA distance used in regularization of structure.
3885 C iii and jjj point to the residues for which the distance is assigned.
3886 if (ii.gt.nres) then
3893 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3894 C distance and angle dependent SS bond potential.
3895 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3896 C & iabs(itype(jjj)).eq.1) then
3897 C write(iout,*) constr_dist,"const"
3898 if (.not.dyn_ss .and. i.le.nss) then
3899 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
3900 & iabs(itype(jjj)).eq.1) then
3901 call ssbond_ene(iii,jjj,eij)
3904 else if (ii.gt.nres .and. jj.gt.nres) then
3905 c Restraints from contact prediction
3907 if (constr_dist.eq.11) then
3908 C ehpb=ehpb+fordepth(i)**4.0d0
3909 C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3910 ehpb=ehpb+fordepth(i)**4.0d0
3911 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3912 fac=fordepth(i)**4.0d0
3913 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3914 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3915 C & ehpb,fordepth(i),dd
3916 C write(iout,*) ehpb,"atu?"
3918 C fac=fordepth(i)**4.0d0
3919 C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3921 if (dhpb1(i).gt.0.0d0) then
3922 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3923 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3924 c write (iout,*) "beta nmr",
3925 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3929 C Get the force constant corresponding to this distance.
3931 C Calculate the contribution to energy.
3932 ehpb=ehpb+waga*rdis*rdis
3933 c write (iout,*) "beta reg",dd,waga*rdis*rdis
3935 C Evaluate gradient.
3938 endif !end dhpb1(i).gt.0
3939 endif !end const_dist=11
3941 ggg(j)=fac*(c(j,jj)-c(j,ii))
3944 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3945 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3948 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
3949 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
3952 C write(iout,*) "before"
3954 C write(iout,*) "after",dd
3955 if (constr_dist.eq.11) then
3956 ehpb=ehpb+fordepth(i)**4.0d0
3957 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
3958 fac=fordepth(i)**4.0d0
3959 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
3960 C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i))
3961 C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd
3962 C print *,ehpb,"tu?"
3963 C write(iout,*) ehpb,"btu?",
3964 C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i)
3965 C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
3966 C & ehpb,fordepth(i),dd
3968 if (dhpb1(i).gt.0.0d0) then
3969 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3970 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
3971 c write (iout,*) "alph nmr",
3972 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
3975 C Get the force constant corresponding to this distance.
3977 C Calculate the contribution to energy.
3978 ehpb=ehpb+waga*rdis*rdis
3979 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
3981 C Evaluate gradient.
3988 ggg(j)=fac*(c(j,jj)-c(j,ii))
3990 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3991 C If this is a SC-SC distance, we need to calculate the contributions to the
3992 C Cartesian gradient in the SC vectors (ghpbx).
3995 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3996 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4001 ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4006 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4009 C--------------------------------------------------------------------------
4010 subroutine ssbond_ene(i,j,eij)
4012 C Calculate the distance and angle dependent SS-bond potential energy
4013 C using a free-energy function derived based on RHF/6-31G** ab initio
4014 C calculations of diethyl disulfide.
4016 C A. Liwo and U. Kozlowska, 11/24/03
4018 implicit real*8 (a-h,o-z)
4019 include 'DIMENSIONS'
4020 include 'DIMENSIONS.ZSCOPT'
4021 include 'COMMON.SBRIDGE'
4022 include 'COMMON.CHAIN'
4023 include 'COMMON.DERIV'
4024 include 'COMMON.LOCAL'
4025 include 'COMMON.INTERACT'
4026 include 'COMMON.VAR'
4027 include 'COMMON.IOUNITS'
4028 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4029 itypi=iabs(itype(i))
4033 dxi=dc_norm(1,nres+i)
4034 dyi=dc_norm(2,nres+i)
4035 dzi=dc_norm(3,nres+i)
4036 dsci_inv=dsc_inv(itypi)
4037 itypj=iabs(itype(j))
4038 dscj_inv=dsc_inv(itypj)
4042 dxj=dc_norm(1,nres+j)
4043 dyj=dc_norm(2,nres+j)
4044 dzj=dc_norm(3,nres+j)
4045 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4050 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4051 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4052 om12=dxi*dxj+dyi*dyj+dzi*dzj
4054 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4055 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4061 deltat12=om2-om1+2.0d0
4063 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4064 & +akct*deltad*deltat12
4065 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4066 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4067 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4068 c & " deltat12",deltat12," eij",eij
4069 ed=2*akcm*deltad+akct*deltat12
4071 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4072 eom1=-2*akth*deltat1-pom1-om2*pom2
4073 eom2= 2*akth*deltat2+pom1-om1*pom2
4076 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4079 ghpbx(k,i)=ghpbx(k,i)-gg(k)
4080 & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
4081 ghpbx(k,j)=ghpbx(k,j)+gg(k)
4082 & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
4085 C Calculate the components of the gradient in DC and X
4089 ghpbc(l,k)=ghpbc(l,k)+gg(l)
4094 C--------------------------------------------------------------------------
4095 subroutine ebond(estr)
4097 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4099 implicit real*8 (a-h,o-z)
4100 include 'DIMENSIONS'
4101 include 'DIMENSIONS.ZSCOPT'
4102 include 'COMMON.LOCAL'
4103 include 'COMMON.GEO'
4104 include 'COMMON.INTERACT'
4105 include 'COMMON.DERIV'
4106 include 'COMMON.VAR'
4107 include 'COMMON.CHAIN'
4108 include 'COMMON.IOUNITS'
4109 include 'COMMON.NAMES'
4110 include 'COMMON.FFIELD'
4111 include 'COMMON.CONTROL'
4112 logical energy_dec /.false./
4113 double precision u(3),ud(3)
4116 c write (iout,*) "distchainmax",distchainmax
4118 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4119 C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4121 C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4122 C & *dc(j,i-1)/vbld(i)
4124 C if (energy_dec) write(iout,*)
4125 C & "estr1",i,vbld(i),distchainmax,
4126 C & gnmr1(vbld(i),-1.0d0,distchainmax)
4128 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4129 diff = vbld(i)-vbldpDUM
4130 C write(iout,*) i,diff
4132 diff = vbld(i)-vbldp0
4133 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4137 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4140 C write (iout,'(a7,i5,4f7.3)')
4141 C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4143 estr=0.5d0*AKP*estr+estr1
4145 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4149 if (iti.ne.10 .and. iti.ne.ntyp1) then
4152 diff=vbld(i+nres)-vbldsc0(1,iti)
4153 C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4154 C & AKSC(1,iti),AKSC(1,iti)*diff*diff
4155 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4157 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4161 diff=vbld(i+nres)-vbldsc0(j,iti)
4162 ud(j)=aksc(j,iti)*diff
4163 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4177 uprod2=uprod2*u(k)*u(k)
4181 usumsqder=usumsqder+ud(j)*uprod2
4183 c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti),
4184 c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi)
4185 estr=estr+uprod/usum
4187 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4195 C--------------------------------------------------------------------------
4196 subroutine ebend(etheta,ethetacnstr)
4198 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4199 C angles gamma and its derivatives in consecutive thetas and gammas.
4201 implicit real*8 (a-h,o-z)
4202 include 'DIMENSIONS'
4203 include 'DIMENSIONS.ZSCOPT'
4204 include 'COMMON.LOCAL'
4205 include 'COMMON.GEO'
4206 include 'COMMON.INTERACT'
4207 include 'COMMON.DERIV'
4208 include 'COMMON.VAR'
4209 include 'COMMON.CHAIN'
4210 include 'COMMON.IOUNITS'
4211 include 'COMMON.NAMES'
4212 include 'COMMON.FFIELD'
4213 include 'COMMON.TORCNSTR'
4214 common /calcthet/ term1,term2,termm,diffak,ratak,
4215 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4216 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4217 double precision y(2),z(2)
4219 c time11=dexp(-2*time)
4222 c write (iout,*) "nres",nres
4223 c write (*,'(a,i2)') 'EBEND ICG=',icg
4224 c write (iout,*) ithet_start,ithet_end
4225 do i=ithet_start,ithet_end
4226 C if (itype(i-1).eq.ntyp1) cycle
4228 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4229 & .or.itype(i).eq.ntyp1) cycle
4230 C Zero the energy function and its derivative at 0 or pi.
4231 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4233 ichir1=isign(1,itype(i-2))
4234 ichir2=isign(1,itype(i))
4235 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4236 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4237 if (itype(i-1).eq.10) then
4238 itype1=isign(10,itype(i-2))
4239 ichir11=isign(1,itype(i-2))
4240 ichir12=isign(1,itype(i-2))
4241 itype2=isign(10,itype(i))
4242 ichir21=isign(1,itype(i))
4243 ichir22=isign(1,itype(i))
4250 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4254 c call proc_proc(phii,icrc)
4255 if (icrc.eq.1) phii=150.0
4266 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4270 c call proc_proc(phii1,icrc)
4271 if (icrc.eq.1) phii1=150.0
4283 C Calculate the "mean" value of theta from the part of the distribution
4284 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4285 C In following comments this theta will be referred to as t_c.
4286 thet_pred_mean=0.0d0
4288 athetk=athet(k,it,ichir1,ichir2)
4289 bthetk=bthet(k,it,ichir1,ichir2)
4291 athetk=athet(k,itype1,ichir11,ichir12)
4292 bthetk=bthet(k,itype2,ichir21,ichir22)
4294 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4296 c write (iout,*) "thet_pred_mean",thet_pred_mean
4297 dthett=thet_pred_mean*ssd
4298 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4299 c write (iout,*) "thet_pred_mean",thet_pred_mean
4300 C Derivatives of the "mean" values in gamma1 and gamma2.
4301 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4302 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4303 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4304 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4306 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4307 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4308 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4309 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4311 if (theta(i).gt.pi-delta) then
4312 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4314 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4315 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4316 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4318 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4320 else if (theta(i).lt.delta) then
4321 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4322 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4323 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4325 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4326 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4329 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4332 etheta=etheta+ethetai
4333 c write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
4334 c & 'ebend',i,ethetai,theta(i),itype(i)
4335 c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i),
4336 c & rad2deg*phii,rad2deg*phii1,ethetai
4337 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4338 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4339 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4343 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4344 do i=1,ntheta_constr
4345 itheta=itheta_constr(i)
4346 thetiii=theta(itheta)
4347 difi=pinorm(thetiii-theta_constr0(i))
4348 if (difi.gt.theta_drange(i)) then
4349 difi=difi-theta_drange(i)
4350 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4351 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4352 & +for_thet_constr(i)*difi**3
4353 else if (difi.lt.-drange(i)) then
4355 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4356 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4357 & +for_thet_constr(i)*difi**3
4361 C if (energy_dec) then
4362 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4363 C & i,itheta,rad2deg*thetiii,
4364 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4365 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4366 C & gloc(itheta+nphi-2,icg)
4369 C Ufff.... We've done all this!!!
4372 C---------------------------------------------------------------------------
4373 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4375 implicit real*8 (a-h,o-z)
4376 include 'DIMENSIONS'
4377 include 'COMMON.LOCAL'
4378 include 'COMMON.IOUNITS'
4379 common /calcthet/ term1,term2,termm,diffak,ratak,
4380 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4381 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4382 C Calculate the contributions to both Gaussian lobes.
4383 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4384 C The "polynomial part" of the "standard deviation" of this part of
4388 sig=sig*thet_pred_mean+polthet(j,it)
4390 C Derivative of the "interior part" of the "standard deviation of the"
4391 C gamma-dependent Gaussian lobe in t_c.
4392 sigtc=3*polthet(3,it)
4394 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4397 C Set the parameters of both Gaussian lobes of the distribution.
4398 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4399 fac=sig*sig+sigc0(it)
4402 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4403 sigsqtc=-4.0D0*sigcsq*sigtc
4404 c print *,i,sig,sigtc,sigsqtc
4405 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4406 sigtc=-sigtc/(fac*fac)
4407 C Following variable is sigma(t_c)**(-2)
4408 sigcsq=sigcsq*sigcsq
4410 sig0inv=1.0D0/sig0i**2
4411 delthec=thetai-thet_pred_mean
4412 delthe0=thetai-theta0i
4413 term1=-0.5D0*sigcsq*delthec*delthec
4414 term2=-0.5D0*sig0inv*delthe0*delthe0
4415 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4416 C NaNs in taking the logarithm. We extract the largest exponent which is added
4417 C to the energy (this being the log of the distribution) at the end of energy
4418 C term evaluation for this virtual-bond angle.
4419 if (term1.gt.term2) then
4421 term2=dexp(term2-termm)
4425 term1=dexp(term1-termm)
4428 C The ratio between the gamma-independent and gamma-dependent lobes of
4429 C the distribution is a Gaussian function of thet_pred_mean too.
4430 diffak=gthet(2,it)-thet_pred_mean
4431 ratak=diffak/gthet(3,it)**2
4432 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4433 C Let's differentiate it in thet_pred_mean NOW.
4435 C Now put together the distribution terms to make complete distribution.
4436 termexp=term1+ak*term2
4437 termpre=sigc+ak*sig0i
4438 C Contribution of the bending energy from this theta is just the -log of
4439 C the sum of the contributions from the two lobes and the pre-exponential
4440 C factor. Simple enough, isn't it?
4441 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4442 C NOW the derivatives!!!
4443 C 6/6/97 Take into account the deformation.
4444 E_theta=(delthec*sigcsq*term1
4445 & +ak*delthe0*sig0inv*term2)/termexp
4446 E_tc=((sigtc+aktc*sig0i)/termpre
4447 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4448 & aktc*term2)/termexp)
4451 c-----------------------------------------------------------------------------
4452 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4453 implicit real*8 (a-h,o-z)
4454 include 'DIMENSIONS'
4455 include 'COMMON.LOCAL'
4456 include 'COMMON.IOUNITS'
4457 common /calcthet/ term1,term2,termm,diffak,ratak,
4458 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4459 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4460 delthec=thetai-thet_pred_mean
4461 delthe0=thetai-theta0i
4462 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4463 t3 = thetai-thet_pred_mean
4467 t14 = t12+t6*sigsqtc
4469 t21 = thetai-theta0i
4475 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4476 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4477 & *(-t12*t9-ak*sig0inv*t27)
4481 C--------------------------------------------------------------------------
4482 subroutine ebend(etheta,ethetacnstr)
4484 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4485 C angles gamma and its derivatives in consecutive thetas and gammas.
4486 C ab initio-derived potentials from
4487 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4489 implicit real*8 (a-h,o-z)
4490 include 'DIMENSIONS'
4491 include 'DIMENSIONS.ZSCOPT'
4492 include 'COMMON.LOCAL'
4493 include 'COMMON.GEO'
4494 include 'COMMON.INTERACT'
4495 include 'COMMON.DERIV'
4496 include 'COMMON.VAR'
4497 include 'COMMON.CHAIN'
4498 include 'COMMON.IOUNITS'
4499 include 'COMMON.NAMES'
4500 include 'COMMON.FFIELD'
4501 include 'COMMON.CONTROL'
4502 include 'COMMON.TORCNSTR'
4503 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4504 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4505 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4506 & sinph1ph2(maxdouble,maxdouble)
4507 logical lprn /.false./, lprn1 /.false./
4509 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1)
4510 do i=ithet_start,ithet_end
4512 C if (itype(i-1).eq.ntyp1) cycle
4514 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4515 & .or.itype(i).eq.ntyp1) cycle
4516 if (iabs(itype(i+1)).eq.20) iblock=2
4517 if (iabs(itype(i+1)).ne.20) iblock=1
4521 theti2=0.5d0*theta(i)
4522 ityp2=ithetyp((itype(i-1)))
4524 coskt(k)=dcos(k*theti2)
4525 sinkt(k)=dsin(k*theti2)
4535 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4538 if (phii.ne.phii) phii=150.0
4542 ityp1=ithetyp((itype(i-2)))
4544 cosph1(k)=dcos(k*phii)
4545 sinph1(k)=dsin(k*phii)
4551 ityp1=ithetyp((itype(i-2)))
4557 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4560 if (phii1.ne.phii1) phii1=150.0
4565 ityp3=ithetyp((itype(i)))
4567 cosph2(k)=dcos(k*phii1)
4568 sinph2(k)=dsin(k*phii1)
4573 ityp3=ithetyp((itype(i)))
4579 c write (iout,*) "i",i," ityp1",itype(i-2),ityp1,
4580 c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3
4582 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4585 ccl=cosph1(l)*cosph2(k-l)
4586 ssl=sinph1(l)*sinph2(k-l)
4587 scl=sinph1(l)*cosph2(k-l)
4588 csl=cosph1(l)*sinph2(k-l)
4589 cosph1ph2(l,k)=ccl-ssl
4590 cosph1ph2(k,l)=ccl+ssl
4591 sinph1ph2(l,k)=scl+csl
4592 sinph1ph2(k,l)=scl-csl
4596 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4597 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4598 write (iout,*) "coskt and sinkt"
4600 write (iout,*) k,coskt(k),sinkt(k)
4604 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4605 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4608 & write (iout,*) "k",k,"
4609 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4610 & " ethetai",ethetai
4613 write (iout,*) "cosph and sinph"
4615 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4617 write (iout,*) "cosph1ph2 and sinph2ph2"
4620 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4621 & sinph1ph2(l,k),sinph1ph2(k,l)
4624 write(iout,*) "ethetai",ethetai
4628 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4629 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4630 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4631 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4632 ethetai=ethetai+sinkt(m)*aux
4633 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4634 dephii=dephii+k*sinkt(m)*(
4635 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4636 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4637 dephii1=dephii1+k*sinkt(m)*(
4638 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4639 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4641 & write (iout,*) "m",m," k",k," bbthet",
4642 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4643 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4644 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4645 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4649 & write(iout,*) "ethetai",ethetai
4653 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4654 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4655 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4656 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4657 ethetai=ethetai+sinkt(m)*aux
4658 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4659 dephii=dephii+l*sinkt(m)*(
4660 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4661 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4662 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4663 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4664 dephii1=dephii1+(k-l)*sinkt(m)*(
4665 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4666 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4667 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4668 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4670 write (iout,*) "m",m," k",k," l",l," ffthet",
4671 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4672 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4673 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4674 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4675 & " ethetai",ethetai
4676 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4677 & cosph1ph2(k,l)*sinkt(m),
4678 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4684 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4685 & i,theta(i)*rad2deg,phii*rad2deg,
4686 & phii1*rad2deg,ethetai
4687 etheta=etheta+ethetai
4688 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4689 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4690 c gloc(nphi+i-2,icg)=wang*dethetai
4691 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
4695 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
4696 do i=1,ntheta_constr
4697 itheta=itheta_constr(i)
4698 thetiii=theta(itheta)
4699 difi=pinorm(thetiii-theta_constr0(i))
4700 if (difi.gt.theta_drange(i)) then
4701 difi=difi-theta_drange(i)
4702 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4703 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4704 & +for_thet_constr(i)*difi**3
4705 else if (difi.lt.-drange(i)) then
4707 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
4708 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
4709 & +for_thet_constr(i)*difi**3
4713 C if (energy_dec) then
4714 C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
4715 C & i,itheta,rad2deg*thetiii,
4716 C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
4717 C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
4718 C & gloc(itheta+nphi-2,icg)
4725 c-----------------------------------------------------------------------------
4726 subroutine esc(escloc)
4727 C Calculate the local energy of a side chain and its derivatives in the
4728 C corresponding virtual-bond valence angles THETA and the spherical angles
4730 implicit real*8 (a-h,o-z)
4731 include 'DIMENSIONS'
4732 include 'DIMENSIONS.ZSCOPT'
4733 include 'COMMON.GEO'
4734 include 'COMMON.LOCAL'
4735 include 'COMMON.VAR'
4736 include 'COMMON.INTERACT'
4737 include 'COMMON.DERIV'
4738 include 'COMMON.CHAIN'
4739 include 'COMMON.IOUNITS'
4740 include 'COMMON.NAMES'
4741 include 'COMMON.FFIELD'
4742 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4743 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4744 common /sccalc/ time11,time12,time112,theti,it,nlobit
4747 C write (iout,*) 'ESC'
4748 do i=loc_start,loc_end
4750 if (it.eq.ntyp1) cycle
4751 if (it.eq.10) goto 1
4752 nlobit=nlob(iabs(it))
4753 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4754 C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4755 theti=theta(i+1)-pipol
4759 c write (iout,*) "i",i," x",x(1),x(2),x(3)
4761 if (x(2).gt.pi-delta) then
4765 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4767 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4768 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4770 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4771 & ddersc0(1),dersc(1))
4772 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4773 & ddersc0(3),dersc(3))
4775 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4777 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4778 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4779 & dersc0(2),esclocbi,dersc02)
4780 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4782 call splinthet(x(2),0.5d0*delta,ss,ssd)
4787 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4789 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4790 write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4792 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4794 c write (iout,*) escloci
4795 else if (x(2).lt.delta) then
4799 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4801 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4802 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4804 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4805 & ddersc0(1),dersc(1))
4806 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4807 & ddersc0(3),dersc(3))
4809 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4811 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4812 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4813 & dersc0(2),esclocbi,dersc02)
4814 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4819 call splinthet(x(2),0.5d0*delta,ss,ssd)
4821 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4823 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4824 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4826 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4827 C write (iout,*) 'i=',i, escloci
4829 call enesc(x,escloci,dersc,ddummy,.false.)
4832 escloc=escloc+escloci
4833 C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4834 write (iout,'(a6,i5,0pf7.3)')
4835 & 'escloc',i,escloci
4837 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4839 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4840 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4845 C---------------------------------------------------------------------------
4846 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4847 implicit real*8 (a-h,o-z)
4848 include 'DIMENSIONS'
4849 include 'COMMON.GEO'
4850 include 'COMMON.LOCAL'
4851 include 'COMMON.IOUNITS'
4852 common /sccalc/ time11,time12,time112,theti,it,nlobit
4853 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4854 double precision contr(maxlob,-1:1)
4856 c write (iout,*) 'it=',it,' nlobit=',nlobit
4860 if (mixed) ddersc(j)=0.0d0
4864 C Because of periodicity of the dependence of the SC energy in omega we have
4865 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4866 C To avoid underflows, first compute & store the exponents.
4874 z(k)=x(k)-censc(k,j,it)
4879 Axk=Axk+gaussc(l,k,j,it)*z(l)
4885 expfac=expfac+Ax(k,j,iii)*z(k)
4893 C As in the case of ebend, we want to avoid underflows in exponentiation and
4894 C subsequent NaNs and INFs in energy calculation.
4895 C Find the largest exponent
4899 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4903 cd print *,'it=',it,' emin=',emin
4905 C Compute the contribution to SC energy and derivatives
4909 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4910 cd print *,'j=',j,' expfac=',expfac
4911 escloc_i=escloc_i+expfac
4913 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4917 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4918 & +gaussc(k,2,j,it))*expfac
4925 dersc(1)=dersc(1)/cos(theti)**2
4926 ddersc(1)=ddersc(1)/cos(theti)**2
4929 escloci=-(dlog(escloc_i)-emin)
4931 dersc(j)=dersc(j)/escloc_i
4935 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4940 C------------------------------------------------------------------------------
4941 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4942 implicit real*8 (a-h,o-z)
4943 include 'DIMENSIONS'
4944 include 'COMMON.GEO'
4945 include 'COMMON.LOCAL'
4946 include 'COMMON.IOUNITS'
4947 common /sccalc/ time11,time12,time112,theti,it,nlobit
4948 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4949 double precision contr(maxlob)
4960 z(k)=x(k)-censc(k,j,it)
4966 Axk=Axk+gaussc(l,k,j,it)*z(l)
4972 expfac=expfac+Ax(k,j)*z(k)
4977 C As in the case of ebend, we want to avoid underflows in exponentiation and
4978 C subsequent NaNs and INFs in energy calculation.
4979 C Find the largest exponent
4982 if (emin.gt.contr(j)) emin=contr(j)
4986 C Compute the contribution to SC energy and derivatives
4990 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4991 escloc_i=escloc_i+expfac
4993 dersc(k)=dersc(k)+Ax(k,j)*expfac
4995 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4996 & +gaussc(1,2,j,it))*expfac
5000 dersc(1)=dersc(1)/cos(theti)**2
5001 dersc12=dersc12/cos(theti)**2
5002 escloci=-(dlog(escloc_i)-emin)
5004 dersc(j)=dersc(j)/escloc_i
5006 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5010 c----------------------------------------------------------------------------------
5011 subroutine esc(escloc)
5012 C Calculate the local energy of a side chain and its derivatives in the
5013 C corresponding virtual-bond valence angles THETA and the spherical angles
5014 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5015 C added by Urszula Kozlowska. 07/11/2007
5017 implicit real*8 (a-h,o-z)
5018 include 'DIMENSIONS'
5019 include 'DIMENSIONS.ZSCOPT'
5020 include 'COMMON.GEO'
5021 include 'COMMON.LOCAL'
5022 include 'COMMON.VAR'
5023 include 'COMMON.SCROT'
5024 include 'COMMON.INTERACT'
5025 include 'COMMON.DERIV'
5026 include 'COMMON.CHAIN'
5027 include 'COMMON.IOUNITS'
5028 include 'COMMON.NAMES'
5029 include 'COMMON.FFIELD'
5030 include 'COMMON.CONTROL'
5031 include 'COMMON.VECTORS'
5032 double precision x_prime(3),y_prime(3),z_prime(3)
5033 & , sumene,dsc_i,dp2_i,x(65),
5034 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5035 & de_dxx,de_dyy,de_dzz,de_dt
5036 double precision s1_t,s1_6_t,s2_t,s2_6_t
5038 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5039 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5040 & dt_dCi(3),dt_dCi1(3)
5041 common /sccalc/ time11,time12,time112,theti,it,nlobit
5044 do i=loc_start,loc_end
5045 if (itype(i).eq.ntyp1) cycle
5046 costtab(i+1) =dcos(theta(i+1))
5047 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5048 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5049 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5050 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5051 cosfac=dsqrt(cosfac2)
5052 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5053 sinfac=dsqrt(sinfac2)
5055 if (it.eq.10) goto 1
5057 C Compute the axes of tghe local cartesian coordinates system; store in
5058 c x_prime, y_prime and z_prime
5065 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5066 C & dc_norm(3,i+nres)
5068 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5069 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5072 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5075 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5076 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5077 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5078 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5079 c & " xy",scalar(x_prime(1),y_prime(1)),
5080 c & " xz",scalar(x_prime(1),z_prime(1)),
5081 c & " yy",scalar(y_prime(1),y_prime(1)),
5082 c & " yz",scalar(y_prime(1),z_prime(1)),
5083 c & " zz",scalar(z_prime(1),z_prime(1))
5085 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5086 C to local coordinate system. Store in xx, yy, zz.
5092 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5093 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5094 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5101 C Compute the energy of the ith side cbain
5103 c write (2,*) "xx",xx," yy",yy," zz",zz
5106 x(j) = sc_parmin(j,it)
5109 Cc diagnostics - remove later
5111 yy1 = dsin(alph(2))*dcos(omeg(2))
5112 zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5113 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5114 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5116 C," --- ", xx_w,yy_w,zz_w
5119 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5120 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5122 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5123 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5125 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5126 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5127 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5128 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5129 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5131 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5132 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5133 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5134 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5135 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5137 dsc_i = 0.743d0+x(61)
5139 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5140 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5141 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5142 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5143 s1=(1+x(63))/(0.1d0 + dscp1)
5144 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5145 s2=(1+x(65))/(0.1d0 + dscp2)
5146 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5147 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5148 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5149 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5151 c & dscp1,dscp2,sumene
5152 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5153 escloc = escloc + sumene
5154 c write (2,*) "escloc",escloc
5155 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i),
5157 if (.not. calc_grad) goto 1
5160 C This section to check the numerical derivatives of the energy of ith side
5161 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5162 C #define DEBUG in the code to turn it on.
5164 write (2,*) "sumene =",sumene
5168 write (2,*) xx,yy,zz
5169 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5170 de_dxx_num=(sumenep-sumene)/aincr
5172 write (2,*) "xx+ sumene from enesc=",sumenep
5175 write (2,*) xx,yy,zz
5176 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5177 de_dyy_num=(sumenep-sumene)/aincr
5179 write (2,*) "yy+ sumene from enesc=",sumenep
5182 write (2,*) xx,yy,zz
5183 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5184 de_dzz_num=(sumenep-sumene)/aincr
5186 write (2,*) "zz+ sumene from enesc=",sumenep
5187 costsave=cost2tab(i+1)
5188 sintsave=sint2tab(i+1)
5189 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5190 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5191 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5192 de_dt_num=(sumenep-sumene)/aincr
5193 write (2,*) " t+ sumene from enesc=",sumenep
5194 cost2tab(i+1)=costsave
5195 sint2tab(i+1)=sintsave
5196 C End of diagnostics section.
5199 C Compute the gradient of esc
5201 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5202 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5203 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5204 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5205 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5206 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5207 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5208 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5209 pom1=(sumene3*sint2tab(i+1)+sumene1)
5210 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5211 pom2=(sumene4*cost2tab(i+1)+sumene2)
5212 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5213 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5214 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5215 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5217 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5218 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5219 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5221 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5222 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5223 & +(pom1+pom2)*pom_dx
5225 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5228 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5229 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5230 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5232 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5233 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5234 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5235 & +x(59)*zz**2 +x(60)*xx*zz
5236 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5237 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5238 & +(pom1-pom2)*pom_dy
5240 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5243 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5244 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5245 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5246 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5247 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5248 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5249 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5250 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5252 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5255 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5256 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5257 & +pom1*pom_dt1+pom2*pom_dt2
5259 write(2,*), "de_dt = ", de_dt,de_dt_num
5263 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5264 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5265 cosfac2xx=cosfac2*xx
5266 sinfac2yy=sinfac2*yy
5268 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5270 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5272 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5273 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5274 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5275 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5276 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5277 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5278 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5279 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5280 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5281 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5285 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5286 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5287 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5288 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5291 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5292 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5293 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5295 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5296 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5300 dXX_Ctab(k,i)=dXX_Ci(k)
5301 dXX_C1tab(k,i)=dXX_Ci1(k)
5302 dYY_Ctab(k,i)=dYY_Ci(k)
5303 dYY_C1tab(k,i)=dYY_Ci1(k)
5304 dZZ_Ctab(k,i)=dZZ_Ci(k)
5305 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5306 dXX_XYZtab(k,i)=dXX_XYZ(k)
5307 dYY_XYZtab(k,i)=dYY_XYZ(k)
5308 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5312 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5313 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5314 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5315 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5316 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5318 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5319 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5320 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5321 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5322 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5323 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5324 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5325 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5327 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5328 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5330 C to check gradient call subroutine check_grad
5337 c------------------------------------------------------------------------------
5338 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5340 C This procedure calculates two-body contact function g(rij) and its derivative:
5343 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5346 C where x=(rij-r0ij)/delta
5348 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5351 double precision rij,r0ij,eps0ij,fcont,fprimcont
5352 double precision x,x2,x4,delta
5356 if (x.lt.-1.0D0) then
5359 else if (x.le.1.0D0) then
5362 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5363 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5370 c------------------------------------------------------------------------------
5371 subroutine splinthet(theti,delta,ss,ssder)
5372 implicit real*8 (a-h,o-z)
5373 include 'DIMENSIONS'
5374 include 'DIMENSIONS.ZSCOPT'
5375 include 'COMMON.VAR'
5376 include 'COMMON.GEO'
5379 if (theti.gt.pipol) then
5380 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5382 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5387 c------------------------------------------------------------------------------
5388 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5390 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5391 double precision ksi,ksi2,ksi3,a1,a2,a3
5392 a1=fprim0*delta/(f1-f0)
5398 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5399 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5402 c------------------------------------------------------------------------------
5403 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5405 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5406 double precision ksi,ksi2,ksi3,a1,a2,a3
5411 a2=3*(f1x-f0x)-2*fprim0x*delta
5412 a3=fprim0x*delta-2*(f1x-f0x)
5413 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5416 C-----------------------------------------------------------------------------
5418 C-----------------------------------------------------------------------------
5419 subroutine etor(etors,edihcnstr,fact)
5420 implicit real*8 (a-h,o-z)
5421 include 'DIMENSIONS'
5422 include 'DIMENSIONS.ZSCOPT'
5423 include 'COMMON.VAR'
5424 include 'COMMON.GEO'
5425 include 'COMMON.LOCAL'
5426 include 'COMMON.TORSION'
5427 include 'COMMON.INTERACT'
5428 include 'COMMON.DERIV'
5429 include 'COMMON.CHAIN'
5430 include 'COMMON.NAMES'
5431 include 'COMMON.IOUNITS'
5432 include 'COMMON.FFIELD'
5433 include 'COMMON.TORCNSTR'
5435 C Set lprn=.true. for debugging
5439 do i=iphi_start,iphi_end
5440 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5441 & .or. itype(i).eq.ntyp1) cycle
5442 itori=itortyp(itype(i-2))
5443 itori1=itortyp(itype(i-1))
5446 C Proline-Proline pair is a special case...
5447 if (itori.eq.3 .and. itori1.eq.3) then
5448 if (phii.gt.-dwapi3) then
5450 fac=1.0D0/(1.0D0-cosphi)
5451 etorsi=v1(1,3,3)*fac
5452 etorsi=etorsi+etorsi
5453 etors=etors+etorsi-v1(1,3,3)
5454 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5457 v1ij=v1(j+1,itori,itori1)
5458 v2ij=v2(j+1,itori,itori1)
5461 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5462 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5466 v1ij=v1(j,itori,itori1)
5467 v2ij=v2(j,itori,itori1)
5470 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5471 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5475 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5476 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5477 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5478 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5479 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5481 ! 6/20/98 - dihedral angle constraints
5484 itori=idih_constr(i)
5487 if (difi.gt.drange(i)) then
5489 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5490 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5491 else if (difi.lt.-drange(i)) then
5493 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5494 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5496 C write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5497 C & i,itori,rad2deg*phii,
5498 C & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5500 ! write (iout,*) 'edihcnstr',edihcnstr
5503 c------------------------------------------------------------------------------
5505 subroutine etor(etors,edihcnstr,fact)
5506 implicit real*8 (a-h,o-z)
5507 include 'DIMENSIONS'
5508 include 'DIMENSIONS.ZSCOPT'
5509 include 'COMMON.VAR'
5510 include 'COMMON.GEO'
5511 include 'COMMON.LOCAL'
5512 include 'COMMON.TORSION'
5513 include 'COMMON.INTERACT'
5514 include 'COMMON.DERIV'
5515 include 'COMMON.CHAIN'
5516 include 'COMMON.NAMES'
5517 include 'COMMON.IOUNITS'
5518 include 'COMMON.FFIELD'
5519 include 'COMMON.TORCNSTR'
5521 C Set lprn=.true. for debugging
5525 do i=iphi_start,iphi_end
5527 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5528 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
5529 C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5530 C & .or. itype(i).eq.ntyp1) cycle
5531 if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215
5532 if (iabs(itype(i)).eq.20) then
5537 itori=itortyp(itype(i-2))
5538 itori1=itortyp(itype(i-1))
5541 C Regular cosine and sine terms
5542 do j=1,nterm(itori,itori1,iblock)
5543 v1ij=v1(j,itori,itori1,iblock)
5544 v2ij=v2(j,itori,itori1,iblock)
5547 etors=etors+v1ij*cosphi+v2ij*sinphi
5548 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5552 C E = SUM ----------------------------------- - v1
5553 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5555 cosphi=dcos(0.5d0*phii)
5556 sinphi=dsin(0.5d0*phii)
5557 do j=1,nlor(itori,itori1,iblock)
5558 vl1ij=vlor1(j,itori,itori1)
5559 vl2ij=vlor2(j,itori,itori1)
5560 vl3ij=vlor3(j,itori,itori1)
5561 pom=vl2ij*cosphi+vl3ij*sinphi
5562 pom1=1.0d0/(pom*pom+1.0d0)
5563 etors=etors+vl1ij*pom1
5564 c if (energy_dec) etors_ii=etors_ii+
5567 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5569 C Subtract the constant term
5570 etors=etors-v0(itori,itori1,iblock)
5572 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5573 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5574 & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6)
5575 gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci
5576 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5579 ! 6/20/98 - dihedral angle constraints
5582 itori=idih_constr(i)
5584 difi=pinorm(phii-phi0(i))
5586 if (difi.gt.drange(i)) then
5588 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5589 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5590 edihi=0.25d0*ftors(i)*difi**4
5591 else if (difi.lt.-drange(i)) then
5593 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
5594 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
5595 edihi=0.25d0*ftors(i)*difi**4
5599 write (iout,'(a6,2i5,2f8.3,2e14.5)') "edih",
5600 & i,itori,rad2deg*phii,
5601 & rad2deg*difi,0.25d0*ftors(i)*difi**4
5602 c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi,
5604 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5605 ! & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
5607 ! write (iout,*) 'edihcnstr',edihcnstr
5610 c----------------------------------------------------------------------------
5611 subroutine etor_d(etors_d,fact2)
5612 C 6/23/01 Compute double torsional energy
5613 implicit real*8 (a-h,o-z)
5614 include 'DIMENSIONS'
5615 include 'DIMENSIONS.ZSCOPT'
5616 include 'COMMON.VAR'
5617 include 'COMMON.GEO'
5618 include 'COMMON.LOCAL'
5619 include 'COMMON.TORSION'
5620 include 'COMMON.INTERACT'
5621 include 'COMMON.DERIV'
5622 include 'COMMON.CHAIN'
5623 include 'COMMON.NAMES'
5624 include 'COMMON.IOUNITS'
5625 include 'COMMON.FFIELD'
5626 include 'COMMON.TORCNSTR'
5628 C Set lprn=.true. for debugging
5632 do i=iphi_start,iphi_end-1
5634 C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5635 C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5636 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
5637 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
5638 & (itype(i+1).eq.ntyp1)) cycle
5639 if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0)
5641 itori=itortyp(itype(i-2))
5642 itori1=itortyp(itype(i-1))
5643 itori2=itortyp(itype(i))
5649 if (iabs(itype(i+1)).eq.20) iblock=2
5650 C Regular cosine and sine terms
5651 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5652 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5653 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5654 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5655 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5656 cosphi1=dcos(j*phii)
5657 sinphi1=dsin(j*phii)
5658 cosphi2=dcos(j*phii1)
5659 sinphi2=dsin(j*phii1)
5660 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5661 & v2cij*cosphi2+v2sij*sinphi2
5662 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5663 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5665 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5667 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5668 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5669 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5670 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5671 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5672 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5673 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5674 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5675 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5676 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5677 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5678 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5679 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5680 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5683 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1
5684 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*fact2*gloci2
5690 c------------------------------------------------------------------------------
5691 subroutine eback_sc_corr(esccor)
5692 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5693 c conformational states; temporarily implemented as differences
5694 c between UNRES torsional potentials (dependent on three types of
5695 c residues) and the torsional potentials dependent on all 20 types
5696 c of residues computed from AM1 energy surfaces of terminally-blocked
5697 c amino-acid residues.
5698 implicit real*8 (a-h,o-z)
5699 include 'DIMENSIONS'
5700 include 'DIMENSIONS.ZSCOPT'
5701 include 'COMMON.VAR'
5702 include 'COMMON.GEO'
5703 include 'COMMON.LOCAL'
5704 include 'COMMON.TORSION'
5705 include 'COMMON.SCCOR'
5706 include 'COMMON.INTERACT'
5707 include 'COMMON.DERIV'
5708 include 'COMMON.CHAIN'
5709 include 'COMMON.NAMES'
5710 include 'COMMON.IOUNITS'
5711 include 'COMMON.FFIELD'
5712 include 'COMMON.CONTROL'
5714 C Set lprn=.true. for debugging
5717 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5719 do i=itau_start,itau_end
5720 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5722 isccori=isccortyp(itype(i-2))
5723 isccori1=isccortyp(itype(i-1))
5725 do intertyp=1,3 !intertyp
5726 cc Added 09 May 2012 (Adasko)
5727 cc Intertyp means interaction type of backbone mainchain correlation:
5728 c 1 = SC...Ca...Ca...Ca
5729 c 2 = Ca...Ca...Ca...SC
5730 c 3 = SC...Ca...Ca...SCi
5732 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5733 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5734 & (itype(i-1).eq.ntyp1)))
5735 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5736 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5737 & .or.(itype(i).eq.ntyp1)))
5738 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5739 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5740 & (itype(i-3).eq.ntyp1)))) cycle
5741 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5742 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5744 do j=1,nterm_sccor(isccori,isccori1)
5745 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5746 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5747 cosphi=dcos(j*tauangle(intertyp,i))
5748 sinphi=dsin(j*tauangle(intertyp,i))
5749 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5750 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5752 C write (iout,*)"EBACK_SC_COR",esccor,i
5753 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp,
5754 c & nterm_sccor(isccori,isccori1),isccori,isccori1
5755 c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5757 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5758 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5759 & (v1sccor(j,1,itori,itori1),j=1,6)
5760 & ,(v2sccor(j,1,itori,itori1),j=1,6)
5761 c gsccor_loc(i-3)=gloci
5766 c------------------------------------------------------------------------------
5767 subroutine multibody(ecorr)
5768 C This subroutine calculates multi-body contributions to energy following
5769 C the idea of Skolnick et al. If side chains I and J make a contact and
5770 C at the same time side chains I+1 and J+1 make a contact, an extra
5771 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5772 implicit real*8 (a-h,o-z)
5773 include 'DIMENSIONS'
5774 include 'COMMON.IOUNITS'
5775 include 'COMMON.DERIV'
5776 include 'COMMON.INTERACT'
5777 include 'COMMON.CONTACTS'
5778 double precision gx(3),gx1(3)
5781 C Set lprn=.true. for debugging
5785 write (iout,'(a)') 'Contact function values:'
5787 write (iout,'(i2,20(1x,i2,f10.5))')
5788 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5803 num_conti=num_cont(i)
5804 num_conti1=num_cont(i1)
5809 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5810 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5811 cd & ' ishift=',ishift
5812 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5813 C The system gains extra energy.
5814 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5815 endif ! j1==j+-ishift
5824 c------------------------------------------------------------------------------
5825 double precision function esccorr(i,j,k,l,jj,kk)
5826 implicit real*8 (a-h,o-z)
5827 include 'DIMENSIONS'
5828 include 'COMMON.IOUNITS'
5829 include 'COMMON.DERIV'
5830 include 'COMMON.INTERACT'
5831 include 'COMMON.CONTACTS'
5832 double precision gx(3),gx1(3)
5837 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5838 C Calculate the multi-body contribution to energy.
5839 C Calculate multi-body contributions to the gradient.
5840 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5841 cd & k,l,(gacont(m,kk,k),m=1,3)
5843 gx(m) =ekl*gacont(m,jj,i)
5844 gx1(m)=eij*gacont(m,kk,k)
5845 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5846 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5847 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5848 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5852 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5857 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5863 c------------------------------------------------------------------------------
5865 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5866 implicit real*8 (a-h,o-z)
5867 include 'DIMENSIONS'
5868 integer dimen1,dimen2,atom,indx
5869 double precision buffer(dimen1,dimen2)
5870 double precision zapas
5871 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5872 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),ees0m(ntyp,maxres),
5873 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5874 num_kont=num_cont_hb(atom)
5878 buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5881 buffer(i,indx+22)=facont_hb(i,atom)
5882 buffer(i,indx+23)=ees0p(i,atom)
5883 buffer(i,indx+24)=ees0m(i,atom)
5884 buffer(i,indx+25)=dfloat(jcont_hb(i,atom))
5886 buffer(1,indx+26)=dfloat(num_kont)
5889 c------------------------------------------------------------------------------
5890 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5891 implicit real*8 (a-h,o-z)
5892 include 'DIMENSIONS'
5893 integer dimen1,dimen2,atom,indx
5894 double precision buffer(dimen1,dimen2)
5895 double precision zapas
5896 common /contacts_hb/ zapas(3,ntyp,maxres,7),
5897 & facont_hb(ntyp,maxres),ees0p(ntyp,maxres),
5898 & ees0m(ntyp,maxres),
5899 & num_cont_hb(maxres),jcont_hb(ntyp,maxres)
5900 num_kont=buffer(1,indx+26)
5901 num_kont_old=num_cont_hb(atom)
5902 num_cont_hb(atom)=num_kont+num_kont_old
5907 zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5910 facont_hb(ii,atom)=buffer(i,indx+22)
5911 ees0p(ii,atom)=buffer(i,indx+23)
5912 ees0m(ii,atom)=buffer(i,indx+24)
5913 jcont_hb(ii,atom)=buffer(i,indx+25)
5917 c------------------------------------------------------------------------------
5919 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5920 C This subroutine calculates multi-body contributions to hydrogen-bonding
5921 implicit real*8 (a-h,o-z)
5922 include 'DIMENSIONS'
5923 include 'DIMENSIONS.ZSCOPT'
5924 include 'COMMON.IOUNITS'
5926 include 'COMMON.INFO'
5928 include 'COMMON.FFIELD'
5929 include 'COMMON.DERIV'
5930 include 'COMMON.INTERACT'
5931 include 'COMMON.CONTACTS'
5933 parameter (max_cont=maxconts)
5934 parameter (max_dim=2*(8*3+2))
5935 parameter (msglen1=max_cont*max_dim*4)
5936 parameter (msglen2=2*msglen1)
5937 integer source,CorrelType,CorrelID,Error
5938 double precision buffer(max_cont,max_dim)
5940 double precision gx(3),gx1(3)
5943 C Set lprn=.true. for debugging
5948 if (fgProcs.le.1) goto 30
5950 write (iout,'(a)') 'Contact function values:'
5952 write (iout,'(2i3,50(1x,i2,f5.2))')
5953 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5954 & j=1,num_cont_hb(i))
5957 C Caution! Following code assumes that electrostatic interactions concerning
5958 C a given atom are split among at most two processors!
5968 cd write (iout,*) 'MyRank',MyRank,' mm',mm
5971 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5972 if (MyRank.gt.0) then
5973 C Send correlation contributions to the preceding processor
5975 nn=num_cont_hb(iatel_s)
5976 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5977 cd write (iout,*) 'The BUFFER array:'
5979 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
5981 if (ielstart(iatel_s).gt.iatel_s+ispp) then
5983 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
5984 C Clear the contacts of the atom passed to the neighboring processor
5985 nn=num_cont_hb(iatel_s+1)
5987 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
5989 num_cont_hb(iatel_s)=0
5991 cd write (iout,*) 'Processor ',MyID,MyRank,
5992 cd & ' is sending correlation contribution to processor',MyID-1,
5993 cd & ' msglen=',msglen
5994 cd write (*,*) 'Processor ',MyID,MyRank,
5995 cd & ' is sending correlation contribution to processor',MyID-1,
5996 cd & ' msglen=',msglen,' CorrelType=',CorrelType
5997 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
5998 cd write (iout,*) 'Processor ',MyID,
5999 cd & ' has sent correlation contribution to processor',MyID-1,
6000 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6001 cd write (*,*) 'Processor ',MyID,
6002 cd & ' has sent correlation contribution to processor',MyID-1,
6003 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6005 endif ! (MyRank.gt.0)
6009 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6010 if (MyRank.lt.fgProcs-1) then
6011 C Receive correlation contributions from the next processor
6013 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6014 cd write (iout,*) 'Processor',MyID,
6015 cd & ' is receiving correlation contribution from processor',MyID+1,
6016 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6017 cd write (*,*) 'Processor',MyID,
6018 cd & ' is receiving correlation contribution from processor',MyID+1,
6019 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6021 do while (nbytes.le.0)
6022 call mp_probe(MyID+1,CorrelType,nbytes)
6024 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6025 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6026 cd write (iout,*) 'Processor',MyID,
6027 cd & ' has received correlation contribution from processor',MyID+1,
6028 cd & ' msglen=',msglen,' nbytes=',nbytes
6029 cd write (iout,*) 'The received BUFFER array:'
6031 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6033 if (msglen.eq.msglen1) then
6034 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6035 else if (msglen.eq.msglen2) then
6036 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6037 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6040 & 'ERROR!!!! message length changed while processing correlations.'
6042 & 'ERROR!!!! message length changed while processing correlations.'
6043 call mp_stopall(Error)
6044 endif ! msglen.eq.msglen1
6045 endif ! MyRank.lt.fgProcs-1
6052 write (iout,'(a)') 'Contact function values:'
6054 write (iout,'(2i3,50(1x,i2,f5.2))')
6055 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6056 & j=1,num_cont_hb(i))
6060 C Remove the loop below after debugging !!!
6067 C Calculate the local-electrostatic correlation terms
6068 do i=iatel_s,iatel_e+1
6070 num_conti=num_cont_hb(i)
6071 num_conti1=num_cont_hb(i+1)
6076 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6077 c & ' jj=',jj,' kk=',kk
6078 if (j1.eq.j+1 .or. j1.eq.j-1) then
6079 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6080 C The system gains extra energy.
6081 ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6083 else if (j1.eq.j) then
6084 C Contacts I-J and I-(J+1) occur simultaneously.
6085 C The system loses extra energy.
6086 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6091 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6092 c & ' jj=',jj,' kk=',kk
6094 C Contacts I-J and (I+1)-J occur simultaneously.
6095 C The system loses extra energy.
6096 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6103 c------------------------------------------------------------------------------
6104 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6106 C This subroutine calculates multi-body contributions to hydrogen-bonding
6107 implicit real*8 (a-h,o-z)
6108 include 'DIMENSIONS'
6109 include 'DIMENSIONS.ZSCOPT'
6110 include 'COMMON.IOUNITS'
6112 include 'COMMON.INFO'
6114 include 'COMMON.FFIELD'
6115 include 'COMMON.DERIV'
6116 include 'COMMON.INTERACT'
6117 include 'COMMON.CONTACTS'
6119 parameter (max_cont=maxconts)
6120 parameter (max_dim=2*(8*3+2))
6121 parameter (msglen1=max_cont*max_dim*4)
6122 parameter (msglen2=2*msglen1)
6123 integer source,CorrelType,CorrelID,Error
6124 double precision buffer(max_cont,max_dim)
6126 double precision gx(3),gx1(3)
6129 C Set lprn=.true. for debugging
6136 if (fgProcs.le.1) goto 30
6138 write (iout,'(a)') 'Contact function values:'
6140 write (iout,'(2i3,50(1x,i2,f5.2))')
6141 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6142 & j=1,num_cont_hb(i))
6145 C Caution! Following code assumes that electrostatic interactions concerning
6146 C a given atom are split among at most two processors!
6156 cd write (iout,*) 'MyRank',MyRank,' mm',mm
6159 cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
6160 if (MyRank.gt.0) then
6161 C Send correlation contributions to the preceding processor
6163 nn=num_cont_hb(iatel_s)
6164 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
6165 cd write (iout,*) 'The BUFFER array:'
6167 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26)
6169 if (ielstart(iatel_s).gt.iatel_s+ispp) then
6171 call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer)
6172 C Clear the contacts of the atom passed to the neighboring processor
6173 nn=num_cont_hb(iatel_s+1)
6175 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26)
6177 num_cont_hb(iatel_s)=0
6179 cd write (iout,*) 'Processor ',MyID,MyRank,
6180 cd & ' is sending correlation contribution to processor',MyID-1,
6181 cd & ' msglen=',msglen
6182 cd write (*,*) 'Processor ',MyID,MyRank,
6183 cd & ' is sending correlation contribution to processor',MyID-1,
6184 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6185 call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID)
6186 cd write (iout,*) 'Processor ',MyID,
6187 cd & ' has sent correlation contribution to processor',MyID-1,
6188 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6189 cd write (*,*) 'Processor ',MyID,
6190 cd & ' has sent correlation contribution to processor',MyID-1,
6191 cd & ' msglen=',msglen,' CorrelID=',CorrelID
6193 endif ! (MyRank.gt.0)
6197 cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
6198 if (MyRank.lt.fgProcs-1) then
6199 C Receive correlation contributions from the next processor
6201 if (ielend(iatel_e).lt.nct-1) msglen=msglen2
6202 cd write (iout,*) 'Processor',MyID,
6203 cd & ' is receiving correlation contribution from processor',MyID+1,
6204 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6205 cd write (*,*) 'Processor',MyID,
6206 cd & ' is receiving correlation contribution from processor',MyID+1,
6207 cd & ' msglen=',msglen,' CorrelType=',CorrelType
6209 do while (nbytes.le.0)
6210 call mp_probe(MyID+1,CorrelType,nbytes)
6212 cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
6213 call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes)
6214 cd write (iout,*) 'Processor',MyID,
6215 cd & ' has received correlation contribution from processor',MyID+1,
6216 cd & ' msglen=',msglen,' nbytes=',nbytes
6217 cd write (iout,*) 'The received BUFFER array:'
6219 cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
6221 if (msglen.eq.msglen1) then
6222 call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
6223 else if (msglen.eq.msglen2) then
6224 call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
6225 call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer)
6228 & 'ERROR!!!! message length changed while processing correlations.'
6230 & 'ERROR!!!! message length changed while processing correlations.'
6231 call mp_stopall(Error)
6232 endif ! msglen.eq.msglen1
6233 endif ! MyRank.lt.fgProcs-1
6240 write (iout,'(a)') 'Contact function values:'
6242 write (iout,'(2i3,50(1x,i2,f5.2))')
6243 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6244 & j=1,num_cont_hb(i))
6250 C Remove the loop below after debugging !!!
6257 C Calculate the dipole-dipole interaction energies
6258 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6259 do i=iatel_s,iatel_e+1
6260 num_conti=num_cont_hb(i)
6267 C Calculate the local-electrostatic correlation terms
6268 do i=iatel_s,iatel_e+1
6270 num_conti=num_cont_hb(i)
6271 num_conti1=num_cont_hb(i+1)
6276 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6277 c & ' jj=',jj,' kk=',kk
6278 if (j1.eq.j+1 .or. j1.eq.j-1) then
6279 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6280 C The system gains extra energy.
6282 sqd1=dsqrt(d_cont(jj,i))
6283 sqd2=dsqrt(d_cont(kk,i1))
6284 sred_geom = sqd1*sqd2
6285 IF (sred_geom.lt.cutoff_corr) THEN
6286 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6288 c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6289 c & ' jj=',jj,' kk=',kk
6290 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6291 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6293 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6294 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6297 cd write (iout,*) 'sred_geom=',sred_geom,
6298 cd & ' ekont=',ekont,' fprim=',fprimcont
6299 call calc_eello(i,j,i+1,j1,jj,kk)
6300 if (wcorr4.gt.0.0d0)
6301 & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
6302 if (wcorr5.gt.0.0d0)
6303 & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
6304 c print *,"wcorr5",ecorr5
6305 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6306 cd write(2,*)'ijkl',i,j,i+1,j1
6307 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
6308 & .or. wturn6.eq.0.0d0))then
6309 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6310 ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
6311 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6312 cd & 'ecorr6=',ecorr6
6313 cd write (iout,'(4e15.5)') sred_geom,
6314 cd & dabs(eello4(i,j,i+1,j1,jj,kk)),
6315 cd & dabs(eello5(i,j,i+1,j1,jj,kk)),
6316 cd & dabs(eello6(i,j,i+1,j1,jj,kk))
6317 else if (wturn6.gt.0.0d0
6318 & .and. (j.eq.i+4 .and. j1.eq.i+3)) then
6319 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
6320 eturn6=eturn6+eello_turn6(i,jj,kk)
6321 cd write (2,*) 'multibody_eello:eturn6',eturn6
6322 else if ((wturn6.eq.0.0d0).and.(wcorr6.eq.0.0d0)) then
6329 else if (j1.eq.j) then
6330 C Contacts I-J and I-(J+1) occur simultaneously.
6331 C The system loses extra energy.
6332 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6337 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6338 c & ' jj=',jj,' kk=',kk
6340 C Contacts I-J and (I+1)-J occur simultaneously.
6341 C The system loses extra energy.
6342 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6347 write (iout,*) "eturn6",eturn6,ecorr6
6350 c------------------------------------------------------------------------------
6351 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6352 implicit real*8 (a-h,o-z)
6353 include 'DIMENSIONS'
6354 include 'COMMON.IOUNITS'
6355 include 'COMMON.DERIV'
6356 include 'COMMON.INTERACT'
6357 include 'COMMON.CONTACTS'
6358 include 'COMMON.CONTROL'
6359 include 'COMMON.SHIELD'
6360 double precision gx(3),gx1(3)
6370 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6371 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6372 C Following 4 lines for diagnostics.
6377 c write (iout,*)'Contacts have occurred for peptide groups',i,j,
6379 c write (iout,*)'Contacts have occurred for peptide groups',
6380 c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
6381 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
6382 C Calculate the multi-body contribution to energy.
6383 C ecorr=ecorr+ekont*ees
6385 C Calculate multi-body contributions to the gradient.
6387 ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
6388 gradcorr(ll,i)=gradcorr(ll,i)+ghalf
6389 & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
6390 & coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
6391 gradcorr(ll,j)=gradcorr(ll,j)+ghalf
6392 & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
6393 & coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
6394 ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
6395 gradcorr(ll,k)=gradcorr(ll,k)+ghalf
6396 & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
6397 & coeffm*ees0mij*gacontm_hb1(ll,kk,k))
6398 gradcorr(ll,l)=gradcorr(ll,l)+ghalf
6399 & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
6400 & coeffm*ees0mij*gacontm_hb2(ll,kk,k))
6404 gradcorr(ll,m)=gradcorr(ll,m)+
6405 & ees*ekl*gacont_hbr(ll,jj,i)-
6406 & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6407 & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6412 gradcorr(ll,m)=gradcorr(ll,m)+
6413 & ees*eij*gacont_hbr(ll,kk,k)-
6414 & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6415 & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6418 if (shield_mode.gt.0) then
6421 C print *,i,j,fac_shield(i),fac_shield(j),
6422 C &fac_shield(k),fac_shield(l)
6423 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and.
6424 & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
6425 do ilist=1,ishield_list(i)
6426 iresshield=shield_list(ilist,i)
6428 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
6430 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6432 & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
6433 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6437 do ilist=1,ishield_list(j)
6438 iresshield=shield_list(ilist,j)
6440 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
6442 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6444 & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
6445 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6449 do ilist=1,ishield_list(k)
6450 iresshield=shield_list(ilist,k)
6452 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
6454 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6456 & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
6457 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6461 do ilist=1,ishield_list(l)
6462 iresshield=shield_list(ilist,l)
6464 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
6466 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+
6468 & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
6469 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1)
6473 C print *,gshieldx(m,iresshield)
6475 gshieldc_ec(m,i)=gshieldc_ec(m,i)+
6476 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6477 gshieldc_ec(m,j)=gshieldc_ec(m,j)+
6478 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6479 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+
6480 & grad_shield(m,i)*ehbcorr/fac_shield(i)
6481 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+
6482 & grad_shield(m,j)*ehbcorr/fac_shield(j)
6484 gshieldc_ec(m,k)=gshieldc_ec(m,k)+
6485 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6486 gshieldc_ec(m,l)=gshieldc_ec(m,l)+
6487 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6488 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+
6489 & grad_shield(m,k)*ehbcorr/fac_shield(k)
6490 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+
6491 & grad_shield(m,l)*ehbcorr/fac_shield(l)
6500 C---------------------------------------------------------------------------
6501 subroutine dipole(i,j,jj)
6502 implicit real*8 (a-h,o-z)
6503 include 'DIMENSIONS'
6504 include 'DIMENSIONS.ZSCOPT'
6505 include 'COMMON.IOUNITS'
6506 include 'COMMON.CHAIN'
6507 include 'COMMON.FFIELD'
6508 include 'COMMON.DERIV'
6509 include 'COMMON.INTERACT'
6510 include 'COMMON.CONTACTS'
6511 include 'COMMON.TORSION'
6512 include 'COMMON.VAR'
6513 include 'COMMON.GEO'
6514 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6516 iti1 = itortyp(itype(i+1))
6517 if (j.lt.nres-1) then
6518 if (itype(j).le.ntyp) then
6519 itj1 = itortyp(itype(j+1))
6527 dipi(iii,1)=Ub2(iii,i)
6528 dipderi(iii)=Ub2der(iii,i)
6529 dipi(iii,2)=b1(iii,iti1)
6530 dipj(iii,1)=Ub2(iii,j)
6531 dipderj(iii)=Ub2der(iii,j)
6532 dipj(iii,2)=b1(iii,itj1)
6536 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6539 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6542 if (.not.calc_grad) return
6547 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6551 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6556 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6557 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6559 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6561 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6563 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6567 C---------------------------------------------------------------------------
6568 subroutine calc_eello(i,j,k,l,jj,kk)
6570 C This subroutine computes matrices and vectors needed to calculate
6571 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6573 implicit real*8 (a-h,o-z)
6574 include 'DIMENSIONS'
6575 include 'DIMENSIONS.ZSCOPT'
6576 include 'COMMON.IOUNITS'
6577 include 'COMMON.CHAIN'
6578 include 'COMMON.DERIV'
6579 include 'COMMON.INTERACT'
6580 include 'COMMON.CONTACTS'
6581 include 'COMMON.TORSION'
6582 include 'COMMON.VAR'
6583 include 'COMMON.GEO'
6584 include 'COMMON.FFIELD'
6585 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6586 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6589 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6590 cd & ' jj=',jj,' kk=',kk
6591 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6594 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6595 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6598 call transpose2(aa1(1,1),aa1t(1,1))
6599 call transpose2(aa2(1,1),aa2t(1,1))
6602 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6603 & aa1tder(1,1,lll,kkk))
6604 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6605 & aa2tder(1,1,lll,kkk))
6609 C parallel orientation of the two CA-CA-CA frames.
6610 if (i.gt.1 .and. itype(i).le.ntyp) then
6611 iti=itortyp(itype(i))
6615 itk1=itortyp(itype(k+1))
6616 itj=itortyp(itype(j))
6617 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
6618 itl1=itortyp(itype(l+1))
6622 C A1 kernel(j+1) A2T
6624 cd write (iout,'(3f10.5,5x,3f10.5)')
6625 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6627 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6628 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6629 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6630 C Following matrices are needed only for 6-th order cumulants
6631 IF (wcorr6.gt.0.0d0) THEN
6632 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6633 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6634 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6635 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6636 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6637 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6638 & ADtEAderx(1,1,1,1,1,1))
6640 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6641 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6642 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6643 & ADtEA1derx(1,1,1,1,1,1))
6645 C End 6-th order cumulants
6648 cd write (2,*) 'In calc_eello6'
6650 cd write (2,*) 'iii=',iii
6652 cd write (2,*) 'kkk=',kkk
6654 cd write (2,'(3(2f10.5),5x)')
6655 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6660 call transpose2(EUgder(1,1,k),auxmat(1,1))
6661 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6662 call transpose2(EUg(1,1,k),auxmat(1,1))
6663 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6664 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6668 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6669 & EAEAderx(1,1,lll,kkk,iii,1))
6673 C A1T kernel(i+1) A2
6674 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6675 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6676 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6677 C Following matrices are needed only for 6-th order cumulants
6678 IF (wcorr6.gt.0.0d0) THEN
6679 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6680 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6681 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6682 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6683 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6684 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6685 & ADtEAderx(1,1,1,1,1,2))
6686 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6687 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6688 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6689 & ADtEA1derx(1,1,1,1,1,2))
6691 C End 6-th order cumulants
6692 call transpose2(EUgder(1,1,l),auxmat(1,1))
6693 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6694 call transpose2(EUg(1,1,l),auxmat(1,1))
6695 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6696 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6700 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6701 & EAEAderx(1,1,lll,kkk,iii,2))
6706 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6707 C They are needed only when the fifth- or the sixth-order cumulants are
6709 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6710 call transpose2(AEA(1,1,1),auxmat(1,1))
6711 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6712 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6713 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6714 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6715 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6716 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6717 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6718 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6719 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6720 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6721 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6722 call transpose2(AEA(1,1,2),auxmat(1,1))
6723 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6724 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6725 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6726 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6727 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6728 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6729 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6730 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6731 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6732 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6733 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6734 C Calculate the Cartesian derivatives of the vectors.
6738 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6739 call matvec2(auxmat(1,1),b1(1,iti),
6740 & AEAb1derx(1,lll,kkk,iii,1,1))
6741 call matvec2(auxmat(1,1),Ub2(1,i),
6742 & AEAb2derx(1,lll,kkk,iii,1,1))
6743 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6744 & AEAb1derx(1,lll,kkk,iii,2,1))
6745 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6746 & AEAb2derx(1,lll,kkk,iii,2,1))
6747 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6748 call matvec2(auxmat(1,1),b1(1,itj),
6749 & AEAb1derx(1,lll,kkk,iii,1,2))
6750 call matvec2(auxmat(1,1),Ub2(1,j),
6751 & AEAb2derx(1,lll,kkk,iii,1,2))
6752 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6753 & AEAb1derx(1,lll,kkk,iii,2,2))
6754 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6755 & AEAb2derx(1,lll,kkk,iii,2,2))
6762 C Antiparallel orientation of the two CA-CA-CA frames.
6763 if (i.gt.1 .and. itype(i).le.ntyp) then
6764 iti=itortyp(itype(i))
6768 itk1=itortyp(itype(k+1))
6769 itl=itortyp(itype(l))
6770 itj=itortyp(itype(j))
6771 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
6772 itj1=itortyp(itype(j+1))
6776 C A2 kernel(j-1)T A1T
6777 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6778 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6779 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6780 C Following matrices are needed only for 6-th order cumulants
6781 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6782 & j.eq.i+4 .and. l.eq.i+3)) THEN
6783 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6784 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6785 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6786 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6787 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6788 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6789 & ADtEAderx(1,1,1,1,1,1))
6790 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6791 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6792 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6793 & ADtEA1derx(1,1,1,1,1,1))
6795 C End 6-th order cumulants
6796 call transpose2(EUgder(1,1,k),auxmat(1,1))
6797 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6798 call transpose2(EUg(1,1,k),auxmat(1,1))
6799 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6800 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6804 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6805 & EAEAderx(1,1,lll,kkk,iii,1))
6809 C A2T kernel(i+1)T A1
6810 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6811 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6812 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6813 C Following matrices are needed only for 6-th order cumulants
6814 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6815 & j.eq.i+4 .and. l.eq.i+3)) THEN
6816 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6817 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6818 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6819 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6820 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6821 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6822 & ADtEAderx(1,1,1,1,1,2))
6823 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6824 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6825 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6826 & ADtEA1derx(1,1,1,1,1,2))
6828 C End 6-th order cumulants
6829 call transpose2(EUgder(1,1,j),auxmat(1,1))
6830 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6831 call transpose2(EUg(1,1,j),auxmat(1,1))
6832 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6833 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6837 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6838 & EAEAderx(1,1,lll,kkk,iii,2))
6843 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6844 C They are needed only when the fifth- or the sixth-order cumulants are
6846 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6847 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6848 call transpose2(AEA(1,1,1),auxmat(1,1))
6849 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6850 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6851 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6852 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6853 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6854 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6855 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6856 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6857 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6858 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6859 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6860 call transpose2(AEA(1,1,2),auxmat(1,1))
6861 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6862 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6863 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6864 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6865 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6866 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6867 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6868 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6869 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6870 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6871 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6872 C Calculate the Cartesian derivatives of the vectors.
6876 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6877 call matvec2(auxmat(1,1),b1(1,iti),
6878 & AEAb1derx(1,lll,kkk,iii,1,1))
6879 call matvec2(auxmat(1,1),Ub2(1,i),
6880 & AEAb2derx(1,lll,kkk,iii,1,1))
6881 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6882 & AEAb1derx(1,lll,kkk,iii,2,1))
6883 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6884 & AEAb2derx(1,lll,kkk,iii,2,1))
6885 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6886 call matvec2(auxmat(1,1),b1(1,itl),
6887 & AEAb1derx(1,lll,kkk,iii,1,2))
6888 call matvec2(auxmat(1,1),Ub2(1,l),
6889 & AEAb2derx(1,lll,kkk,iii,1,2))
6890 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6891 & AEAb1derx(1,lll,kkk,iii,2,2))
6892 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6893 & AEAb2derx(1,lll,kkk,iii,2,2))
6902 C---------------------------------------------------------------------------
6903 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6904 & KK,KKderg,AKA,AKAderg,AKAderx)
6908 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6909 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6910 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6915 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6917 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6920 cd if (lprn) write (2,*) 'In kernel'
6922 cd if (lprn) write (2,*) 'kkk=',kkk
6924 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6925 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6927 cd write (2,*) 'lll=',lll
6928 cd write (2,*) 'iii=1'
6930 cd write (2,'(3(2f10.5),5x)')
6931 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6934 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6935 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6937 cd write (2,*) 'lll=',lll
6938 cd write (2,*) 'iii=2'
6940 cd write (2,'(3(2f10.5),5x)')
6941 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6948 C---------------------------------------------------------------------------
6949 double precision function eello4(i,j,k,l,jj,kk)
6950 implicit real*8 (a-h,o-z)
6951 include 'DIMENSIONS'
6952 include 'DIMENSIONS.ZSCOPT'
6953 include 'COMMON.IOUNITS'
6954 include 'COMMON.CHAIN'
6955 include 'COMMON.DERIV'
6956 include 'COMMON.INTERACT'
6957 include 'COMMON.CONTACTS'
6958 include 'COMMON.TORSION'
6959 include 'COMMON.VAR'
6960 include 'COMMON.GEO'
6961 double precision pizda(2,2),ggg1(3),ggg2(3)
6962 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6966 cd print *,'eello4:',i,j,k,l,jj,kk
6967 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
6968 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
6969 cold eij=facont_hb(jj,i)
6970 cold ekl=facont_hb(kk,k)
6972 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6974 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6975 gcorr_loc(k-1)=gcorr_loc(k-1)
6976 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6978 gcorr_loc(l-1)=gcorr_loc(l-1)
6979 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6981 gcorr_loc(j-1)=gcorr_loc(j-1)
6982 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6987 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6988 & -EAEAderx(2,2,lll,kkk,iii,1)
6989 cd derx(lll,kkk,iii)=0.0d0
6993 cd gcorr_loc(l-1)=0.0d0
6994 cd gcorr_loc(j-1)=0.0d0
6995 cd gcorr_loc(k-1)=0.0d0
6997 cd write (iout,*)'Contacts have occurred for peptide groups',
6998 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
6999 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7000 if (j.lt.nres-1) then
7007 if (l.lt.nres-1) then
7015 cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
7016 ggg1(ll)=eel4*g_contij(ll,1)
7017 ggg2(ll)=eel4*g_contij(ll,2)
7018 ghalf=0.5d0*ggg1(ll)
7020 gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
7021 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7022 gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
7023 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7024 cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
7025 ghalf=0.5d0*ggg2(ll)
7027 gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
7028 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7029 gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
7030 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7035 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
7036 gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7041 cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
7042 gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7048 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7053 gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7057 cd write (2,*) iii,gcorr_loc(iii)
7061 cd write (2,*) 'ekont',ekont
7062 cd write (iout,*) 'eello4',ekont*eel4
7065 C---------------------------------------------------------------------------
7066 double precision function eello5(i,j,k,l,jj,kk)
7067 implicit real*8 (a-h,o-z)
7068 include 'DIMENSIONS'
7069 include 'DIMENSIONS.ZSCOPT'
7070 include 'COMMON.IOUNITS'
7071 include 'COMMON.CHAIN'
7072 include 'COMMON.DERIV'
7073 include 'COMMON.INTERACT'
7074 include 'COMMON.CONTACTS'
7075 include 'COMMON.TORSION'
7076 include 'COMMON.VAR'
7077 include 'COMMON.GEO'
7078 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7079 double precision ggg1(3),ggg2(3)
7080 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7085 C /l\ / \ \ / \ / \ / C
7086 C / \ / \ \ / \ / \ / C
7087 C j| o |l1 | o | o| o | | o |o C
7088 C \ |/k\| |/ \| / |/ \| |/ \| C
7089 C \i/ \ / \ / / \ / \ C
7091 C (I) (II) (III) (IV) C
7093 C eello5_1 eello5_2 eello5_3 eello5_4 C
7095 C Antiparallel chains C
7098 C /j\ / \ \ / \ / \ / C
7099 C / \ / \ \ / \ / \ / C
7100 C j1| o |l | o | o| o | | o |o C
7101 C \ |/k\| |/ \| / |/ \| |/ \| C
7102 C \i/ \ / \ / / \ / \ C
7104 C (I) (II) (III) (IV) C
7106 C eello5_1 eello5_2 eello5_3 eello5_4 C
7108 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7111 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7116 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7118 itk=itortyp(itype(k))
7119 itl=itortyp(itype(l))
7120 itj=itortyp(itype(j))
7125 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7126 cd & eel5_3_num,eel5_4_num)
7130 derx(lll,kkk,iii)=0.0d0
7134 cd eij=facont_hb(jj,i)
7135 cd ekl=facont_hb(kk,k)
7137 cd write (iout,*)'Contacts have occurred for peptide groups',
7138 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7140 C Contribution from the graph I.
7141 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7142 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7143 call transpose2(EUg(1,1,k),auxmat(1,1))
7144 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7145 vv(1)=pizda(1,1)-pizda(2,2)
7146 vv(2)=pizda(1,2)+pizda(2,1)
7147 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7148 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7150 C Explicit gradient in virtual-dihedral angles.
7151 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7152 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7153 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7154 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7155 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7156 vv(1)=pizda(1,1)-pizda(2,2)
7157 vv(2)=pizda(1,2)+pizda(2,1)
7158 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7159 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7160 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7161 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7162 vv(1)=pizda(1,1)-pizda(2,2)
7163 vv(2)=pizda(1,2)+pizda(2,1)
7165 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7166 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7167 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7169 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7170 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7171 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7173 C Cartesian gradient
7177 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7179 vv(1)=pizda(1,1)-pizda(2,2)
7180 vv(2)=pizda(1,2)+pizda(2,1)
7181 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7182 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7183 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7190 C Contribution from graph II
7191 call transpose2(EE(1,1,itk),auxmat(1,1))
7192 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7193 vv(1)=pizda(1,1)+pizda(2,2)
7194 vv(2)=pizda(2,1)-pizda(1,2)
7195 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7196 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7198 C Explicit gradient in virtual-dihedral angles.
7199 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7200 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7201 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7202 vv(1)=pizda(1,1)+pizda(2,2)
7203 vv(2)=pizda(2,1)-pizda(1,2)
7205 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7206 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7207 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7209 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7210 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7211 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7213 C Cartesian gradient
7217 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7219 vv(1)=pizda(1,1)+pizda(2,2)
7220 vv(2)=pizda(2,1)-pizda(1,2)
7221 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7222 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7223 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7232 C Parallel orientation
7233 C Contribution from graph III
7234 call transpose2(EUg(1,1,l),auxmat(1,1))
7235 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7236 vv(1)=pizda(1,1)-pizda(2,2)
7237 vv(2)=pizda(1,2)+pizda(2,1)
7238 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7239 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7241 C Explicit gradient in virtual-dihedral angles.
7242 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7243 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7244 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7245 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7246 vv(1)=pizda(1,1)-pizda(2,2)
7247 vv(2)=pizda(1,2)+pizda(2,1)
7248 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7249 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7250 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7251 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7252 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7253 vv(1)=pizda(1,1)-pizda(2,2)
7254 vv(2)=pizda(1,2)+pizda(2,1)
7255 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7256 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7257 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7258 C Cartesian gradient
7262 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7264 vv(1)=pizda(1,1)-pizda(2,2)
7265 vv(2)=pizda(1,2)+pizda(2,1)
7266 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7267 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7268 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7274 C Contribution from graph IV
7276 call transpose2(EE(1,1,itl),auxmat(1,1))
7277 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7278 vv(1)=pizda(1,1)+pizda(2,2)
7279 vv(2)=pizda(2,1)-pizda(1,2)
7280 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7281 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7283 C Explicit gradient in virtual-dihedral angles.
7284 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7285 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7286 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7287 vv(1)=pizda(1,1)+pizda(2,2)
7288 vv(2)=pizda(2,1)-pizda(1,2)
7289 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7290 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7291 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7292 C Cartesian gradient
7296 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7298 vv(1)=pizda(1,1)+pizda(2,2)
7299 vv(2)=pizda(2,1)-pizda(1,2)
7300 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7301 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7302 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7308 C Antiparallel orientation
7309 C Contribution from graph III
7311 call transpose2(EUg(1,1,j),auxmat(1,1))
7312 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7313 vv(1)=pizda(1,1)-pizda(2,2)
7314 vv(2)=pizda(1,2)+pizda(2,1)
7315 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7316 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7318 C Explicit gradient in virtual-dihedral angles.
7319 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7320 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7321 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7322 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7323 vv(1)=pizda(1,1)-pizda(2,2)
7324 vv(2)=pizda(1,2)+pizda(2,1)
7325 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7326 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7327 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7328 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7329 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7330 vv(1)=pizda(1,1)-pizda(2,2)
7331 vv(2)=pizda(1,2)+pizda(2,1)
7332 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7333 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7334 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7335 C Cartesian gradient
7339 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7341 vv(1)=pizda(1,1)-pizda(2,2)
7342 vv(2)=pizda(1,2)+pizda(2,1)
7343 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7344 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7345 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7351 C Contribution from graph IV
7353 call transpose2(EE(1,1,itj),auxmat(1,1))
7354 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7355 vv(1)=pizda(1,1)+pizda(2,2)
7356 vv(2)=pizda(2,1)-pizda(1,2)
7357 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7358 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7360 C Explicit gradient in virtual-dihedral angles.
7361 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7362 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7363 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7364 vv(1)=pizda(1,1)+pizda(2,2)
7365 vv(2)=pizda(2,1)-pizda(1,2)
7366 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7367 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7368 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7369 C Cartesian gradient
7373 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7375 vv(1)=pizda(1,1)+pizda(2,2)
7376 vv(2)=pizda(2,1)-pizda(1,2)
7377 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7378 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7379 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7386 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7387 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7388 cd write (2,*) 'ijkl',i,j,k,l
7389 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7390 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7392 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7393 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7394 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7395 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7397 if (j.lt.nres-1) then
7404 if (l.lt.nres-1) then
7414 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7416 ggg1(ll)=eel5*g_contij(ll,1)
7417 ggg2(ll)=eel5*g_contij(ll,2)
7418 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7419 ghalf=0.5d0*ggg1(ll)
7421 gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
7422 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7423 gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
7424 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7425 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7426 ghalf=0.5d0*ggg2(ll)
7428 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7429 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7430 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7431 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7436 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7437 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7442 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7443 gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7449 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7454 gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7458 cd write (2,*) iii,g_corr5_loc(iii)
7462 cd write (2,*) 'ekont',ekont
7463 cd write (iout,*) 'eello5',ekont*eel5
7466 c--------------------------------------------------------------------------
7467 double precision function eello6(i,j,k,l,jj,kk)
7468 implicit real*8 (a-h,o-z)
7469 include 'DIMENSIONS'
7470 include 'DIMENSIONS.ZSCOPT'
7471 include 'COMMON.IOUNITS'
7472 include 'COMMON.CHAIN'
7473 include 'COMMON.DERIV'
7474 include 'COMMON.INTERACT'
7475 include 'COMMON.CONTACTS'
7476 include 'COMMON.TORSION'
7477 include 'COMMON.VAR'
7478 include 'COMMON.GEO'
7479 include 'COMMON.FFIELD'
7480 double precision ggg1(3),ggg2(3)
7481 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7486 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7494 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7495 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7499 derx(lll,kkk,iii)=0.0d0
7503 cd eij=facont_hb(jj,i)
7504 cd ekl=facont_hb(kk,k)
7510 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7511 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7512 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7513 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7514 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7515 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7517 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7518 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7519 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7520 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7521 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7522 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7526 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7528 C If turn contributions are considered, they will be handled separately.
7529 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7530 cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
7531 cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
7532 cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
7533 cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
7534 cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
7535 cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
7538 if (j.lt.nres-1) then
7545 if (l.lt.nres-1) then
7553 ggg1(ll)=eel6*g_contij(ll,1)
7554 ggg2(ll)=eel6*g_contij(ll,2)
7555 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7556 ghalf=0.5d0*ggg1(ll)
7558 gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
7559 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7560 gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
7561 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7562 ghalf=0.5d0*ggg2(ll)
7563 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7565 gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
7566 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7567 gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
7568 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7573 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7574 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7579 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7580 gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7586 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7591 gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7595 cd write (2,*) iii,g_corr6_loc(iii)
7599 cd write (2,*) 'ekont',ekont
7600 cd write (iout,*) 'eello6',ekont*eel6
7603 c--------------------------------------------------------------------------
7604 double precision function eello6_graph1(i,j,k,l,imat,swap)
7605 implicit real*8 (a-h,o-z)
7606 include 'DIMENSIONS'
7607 include 'DIMENSIONS.ZSCOPT'
7608 include 'COMMON.IOUNITS'
7609 include 'COMMON.CHAIN'
7610 include 'COMMON.DERIV'
7611 include 'COMMON.INTERACT'
7612 include 'COMMON.CONTACTS'
7613 include 'COMMON.TORSION'
7614 include 'COMMON.VAR'
7615 include 'COMMON.GEO'
7616 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7620 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7622 C Parallel Antiparallel C
7628 C \ j|/k\| / \ |/k\|l / C
7633 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7634 itk=itortyp(itype(k))
7635 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7636 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7637 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7638 call transpose2(EUgC(1,1,k),auxmat(1,1))
7639 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7640 vv1(1)=pizda1(1,1)-pizda1(2,2)
7641 vv1(2)=pizda1(1,2)+pizda1(2,1)
7642 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7643 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7644 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7645 s5=scalar2(vv(1),Dtobr2(1,i))
7646 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7647 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7648 if (.not. calc_grad) return
7649 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7650 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7651 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7652 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7653 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7654 & +scalar2(vv(1),Dtobr2der(1,i)))
7655 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7656 vv1(1)=pizda1(1,1)-pizda1(2,2)
7657 vv1(2)=pizda1(1,2)+pizda1(2,1)
7658 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7659 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7661 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7662 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7663 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7664 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7665 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7667 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7668 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7669 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7670 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7671 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7673 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7674 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7675 vv1(1)=pizda1(1,1)-pizda1(2,2)
7676 vv1(2)=pizda1(1,2)+pizda1(2,1)
7677 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7678 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7679 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7680 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7689 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7690 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7691 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7692 call transpose2(EUgC(1,1,k),auxmat(1,1))
7693 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7695 vv1(1)=pizda1(1,1)-pizda1(2,2)
7696 vv1(2)=pizda1(1,2)+pizda1(2,1)
7697 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7698 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7699 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7700 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7701 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7702 s5=scalar2(vv(1),Dtobr2(1,i))
7703 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7709 c----------------------------------------------------------------------------
7710 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7711 implicit real*8 (a-h,o-z)
7712 include 'DIMENSIONS'
7713 include 'DIMENSIONS.ZSCOPT'
7714 include 'COMMON.IOUNITS'
7715 include 'COMMON.CHAIN'
7716 include 'COMMON.DERIV'
7717 include 'COMMON.INTERACT'
7718 include 'COMMON.CONTACTS'
7719 include 'COMMON.TORSION'
7720 include 'COMMON.VAR'
7721 include 'COMMON.GEO'
7723 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7724 & auxvec1(2),auxvec2(2),auxmat1(2,2)
7727 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7729 C Parallel Antiparallel C
7735 C \ j|/k\| \ |/k\|l C
7740 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7741 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7742 C AL 7/4/01 s1 would occur in the sixth-order moment,
7743 C but not in a cluster cumulant
7745 s1=dip(1,jj,i)*dip(1,kk,k)
7747 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7748 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7749 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7750 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7751 call transpose2(EUg(1,1,k),auxmat(1,1))
7752 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7753 vv(1)=pizda(1,1)-pizda(2,2)
7754 vv(2)=pizda(1,2)+pizda(2,1)
7755 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7756 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7758 eello6_graph2=-(s1+s2+s3+s4)
7760 eello6_graph2=-(s2+s3+s4)
7763 if (.not. calc_grad) return
7764 C Derivatives in gamma(i-1)
7767 s1=dipderg(1,jj,i)*dip(1,kk,k)
7769 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7770 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7771 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7772 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7774 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7776 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7778 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7780 C Derivatives in gamma(k-1)
7782 s1=dip(1,jj,i)*dipderg(1,kk,k)
7784 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7785 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7786 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7787 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7788 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7789 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7790 vv(1)=pizda(1,1)-pizda(2,2)
7791 vv(2)=pizda(1,2)+pizda(2,1)
7792 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7794 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7796 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7798 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7799 C Derivatives in gamma(j-1) or gamma(l-1)
7802 s1=dipderg(3,jj,i)*dip(1,kk,k)
7804 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7805 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7806 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7807 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7808 vv(1)=pizda(1,1)-pizda(2,2)
7809 vv(2)=pizda(1,2)+pizda(2,1)
7810 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7813 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7815 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7818 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7819 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7821 C Derivatives in gamma(l-1) or gamma(j-1)
7824 s1=dip(1,jj,i)*dipderg(3,kk,k)
7826 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7827 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7828 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7829 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7830 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7831 vv(1)=pizda(1,1)-pizda(2,2)
7832 vv(2)=pizda(1,2)+pizda(2,1)
7833 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7836 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7838 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7841 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7842 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7844 C Cartesian derivatives.
7846 write (2,*) 'In eello6_graph2'
7848 write (2,*) 'iii=',iii
7850 write (2,*) 'kkk=',kkk
7852 write (2,'(3(2f10.5),5x)')
7853 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7863 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7865 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7868 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7870 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7871 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7873 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7874 call transpose2(EUg(1,1,k),auxmat(1,1))
7875 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7877 vv(1)=pizda(1,1)-pizda(2,2)
7878 vv(2)=pizda(1,2)+pizda(2,1)
7879 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7880 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7882 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7884 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7887 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7889 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7896 c----------------------------------------------------------------------------
7897 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7898 implicit real*8 (a-h,o-z)
7899 include 'DIMENSIONS'
7900 include 'DIMENSIONS.ZSCOPT'
7901 include 'COMMON.IOUNITS'
7902 include 'COMMON.CHAIN'
7903 include 'COMMON.DERIV'
7904 include 'COMMON.INTERACT'
7905 include 'COMMON.CONTACTS'
7906 include 'COMMON.TORSION'
7907 include 'COMMON.VAR'
7908 include 'COMMON.GEO'
7909 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7911 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7913 C Parallel Antiparallel C
7919 C j|/k\| / |/k\|l / C
7924 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7926 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7927 C energy moment and not to the cluster cumulant.
7928 iti=itortyp(itype(i))
7929 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
7930 itj1=itortyp(itype(j+1))
7934 itk=itortyp(itype(k))
7935 itk1=itortyp(itype(k+1))
7936 if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then
7937 itl1=itortyp(itype(l+1))
7942 s1=dip(4,jj,i)*dip(4,kk,k)
7944 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7945 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7946 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7947 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7948 call transpose2(EE(1,1,itk),auxmat(1,1))
7949 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7950 vv(1)=pizda(1,1)+pizda(2,2)
7951 vv(2)=pizda(2,1)-pizda(1,2)
7952 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7953 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7955 eello6_graph3=-(s1+s2+s3+s4)
7957 eello6_graph3=-(s2+s3+s4)
7960 if (.not. calc_grad) return
7961 C Derivatives in gamma(k-1)
7962 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7963 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7964 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7965 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7966 C Derivatives in gamma(l-1)
7967 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7968 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7969 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7970 vv(1)=pizda(1,1)+pizda(2,2)
7971 vv(2)=pizda(2,1)-pizda(1,2)
7972 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7973 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7974 C Cartesian derivatives.
7980 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7982 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7985 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7987 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7988 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7990 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7991 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7993 vv(1)=pizda(1,1)+pizda(2,2)
7994 vv(2)=pizda(2,1)-pizda(1,2)
7995 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7997 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7999 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8002 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8004 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8006 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8012 c----------------------------------------------------------------------------
8013 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8014 implicit real*8 (a-h,o-z)
8015 include 'DIMENSIONS'
8016 include 'DIMENSIONS.ZSCOPT'
8017 include 'COMMON.IOUNITS'
8018 include 'COMMON.CHAIN'
8019 include 'COMMON.DERIV'
8020 include 'COMMON.INTERACT'
8021 include 'COMMON.CONTACTS'
8022 include 'COMMON.TORSION'
8023 include 'COMMON.VAR'
8024 include 'COMMON.GEO'
8025 include 'COMMON.FFIELD'
8026 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8027 & auxvec1(2),auxmat1(2,2)
8029 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8031 C Parallel Antiparallel C
8037 C \ j|/k\| \ |/k\|l C
8042 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8044 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8045 C energy moment and not to the cluster cumulant.
8046 cd write (2,*) 'eello_graph4: wturn6',wturn6
8047 iti=itortyp(itype(i))
8048 itj=itortyp(itype(j))
8049 if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then
8050 itj1=itortyp(itype(j+1))
8054 itk=itortyp(itype(k))
8055 if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then
8056 itk1=itortyp(itype(k+1))
8060 itl=itortyp(itype(l))
8061 if (l.lt.nres-1) then
8062 itl1=itortyp(itype(l+1))
8066 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8067 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8068 cd & ' itl',itl,' itl1',itl1
8071 s1=dip(3,jj,i)*dip(3,kk,k)
8073 s1=dip(2,jj,j)*dip(2,kk,l)
8076 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8077 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8079 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8080 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8082 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8083 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8085 call transpose2(EUg(1,1,k),auxmat(1,1))
8086 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8087 vv(1)=pizda(1,1)-pizda(2,2)
8088 vv(2)=pizda(2,1)+pizda(1,2)
8089 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8090 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8092 eello6_graph4=-(s1+s2+s3+s4)
8094 eello6_graph4=-(s2+s3+s4)
8096 if (.not. calc_grad) return
8097 C Derivatives in gamma(i-1)
8101 s1=dipderg(2,jj,i)*dip(3,kk,k)
8103 s1=dipderg(4,jj,j)*dip(2,kk,l)
8106 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8108 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8109 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8111 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8112 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8114 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8115 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8116 cd write (2,*) 'turn6 derivatives'
8118 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8120 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8124 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8126 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8130 C Derivatives in gamma(k-1)
8133 s1=dip(3,jj,i)*dipderg(2,kk,k)
8135 s1=dip(2,jj,j)*dipderg(4,kk,l)
8138 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8139 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8141 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8142 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8144 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8145 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8147 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8148 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8149 vv(1)=pizda(1,1)-pizda(2,2)
8150 vv(2)=pizda(2,1)+pizda(1,2)
8151 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8152 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8154 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8156 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8160 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8162 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8165 C Derivatives in gamma(j-1) or gamma(l-1)
8166 if (l.eq.j+1 .and. l.gt.1) then
8167 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8168 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8169 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8170 vv(1)=pizda(1,1)-pizda(2,2)
8171 vv(2)=pizda(2,1)+pizda(1,2)
8172 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8173 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8174 else if (j.gt.1) then
8175 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8176 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8177 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8178 vv(1)=pizda(1,1)-pizda(2,2)
8179 vv(2)=pizda(2,1)+pizda(1,2)
8180 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8181 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8182 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8184 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8187 C Cartesian derivatives.
8194 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8196 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8200 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8202 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8206 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8208 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8210 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8211 & b1(1,itj1),auxvec(1))
8212 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8214 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8215 & b1(1,itl1),auxvec(1))
8216 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8218 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8220 vv(1)=pizda(1,1)-pizda(2,2)
8221 vv(2)=pizda(2,1)+pizda(1,2)
8222 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8224 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8226 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8229 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8232 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8235 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8237 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8239 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8243 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8245 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8248 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8250 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8258 c----------------------------------------------------------------------------
8259 double precision function eello_turn6(i,jj,kk)
8260 implicit real*8 (a-h,o-z)
8261 include 'DIMENSIONS'
8262 include 'DIMENSIONS.ZSCOPT'
8263 include 'COMMON.IOUNITS'
8264 include 'COMMON.CHAIN'
8265 include 'COMMON.DERIV'
8266 include 'COMMON.INTERACT'
8267 include 'COMMON.CONTACTS'
8268 include 'COMMON.TORSION'
8269 include 'COMMON.VAR'
8270 include 'COMMON.GEO'
8271 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8272 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8274 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8275 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8276 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8277 C the respective energy moment and not to the cluster cumulant.
8282 iti=itortyp(itype(i))
8283 itk=itortyp(itype(k))
8284 itk1=itortyp(itype(k+1))
8285 itl=itortyp(itype(l))
8286 itj=itortyp(itype(j))
8287 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8288 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8289 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8294 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8296 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8300 derx_turn(lll,kkk,iii)=0.0d0
8307 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8309 cd write (2,*) 'eello6_5',eello6_5
8311 call transpose2(AEA(1,1,1),auxmat(1,1))
8312 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8313 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8314 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8318 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8319 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8320 s2 = scalar2(b1(1,itk),vtemp1(1))
8322 call transpose2(AEA(1,1,2),atemp(1,1))
8323 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8324 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8325 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8329 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8330 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8331 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8333 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8334 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8335 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8336 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8337 ss13 = scalar2(b1(1,itk),vtemp4(1))
8338 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8342 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8348 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8350 C Derivatives in gamma(i+2)
8352 call transpose2(AEA(1,1,1),auxmatd(1,1))
8353 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8354 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8355 call transpose2(AEAderg(1,1,2),atempd(1,1))
8356 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8357 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8361 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8362 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8363 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8369 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8370 C Derivatives in gamma(i+3)
8372 call transpose2(AEA(1,1,1),auxmatd(1,1))
8373 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8374 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8375 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8379 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8380 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8381 s2d = scalar2(b1(1,itk),vtemp1d(1))
8383 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8384 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8386 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8388 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8389 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8390 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8400 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8401 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8403 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8404 & -0.5d0*ekont*(s2d+s12d)
8406 C Derivatives in gamma(i+4)
8407 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8408 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8409 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8411 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8412 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8413 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8423 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8425 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8427 C Derivatives in gamma(i+5)
8429 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8430 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8431 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8435 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8436 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8437 s2d = scalar2(b1(1,itk),vtemp1d(1))
8439 call transpose2(AEA(1,1,2),atempd(1,1))
8440 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8441 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8445 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8446 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8448 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8449 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8450 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8460 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8461 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8463 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8464 & -0.5d0*ekont*(s2d+s12d)
8466 C Cartesian derivatives
8471 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8472 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8473 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8477 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8478 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8480 s2d = scalar2(b1(1,itk),vtemp1d(1))
8482 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8483 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8484 s8d = -(atempd(1,1)+atempd(2,2))*
8485 & scalar2(cc(1,1,itl),vtemp2(1))
8489 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8491 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8492 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8499 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8502 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8506 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8507 & - 0.5d0*(s8d+s12d)
8509 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8518 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8520 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8521 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8522 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8523 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8524 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8526 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8527 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8528 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8532 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8533 cd & 16*eel_turn6_num
8535 if (j.lt.nres-1) then
8542 if (l.lt.nres-1) then
8550 ggg1(ll)=eel_turn6*g_contij(ll,1)
8551 ggg2(ll)=eel_turn6*g_contij(ll,2)
8552 ghalf=0.5d0*ggg1(ll)
8554 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
8555 & +ekont*derx_turn(ll,2,1)
8556 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8557 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
8558 & +ekont*derx_turn(ll,4,1)
8559 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8560 ghalf=0.5d0*ggg2(ll)
8562 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
8563 & +ekont*derx_turn(ll,2,2)
8564 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8565 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
8566 & +ekont*derx_turn(ll,4,2)
8567 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8572 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8577 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8583 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8588 gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8592 cd write (2,*) iii,g_corr6_loc(iii)
8595 eello_turn6=ekont*eel_turn6
8596 cd write (2,*) 'ekont',ekont
8597 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8600 crc-------------------------------------------------
8601 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8602 subroutine Eliptransfer(eliptran)
8603 implicit real*8 (a-h,o-z)
8604 include 'DIMENSIONS'
8605 include 'COMMON.GEO'
8606 include 'COMMON.VAR'
8607 include 'COMMON.LOCAL'
8608 include 'COMMON.CHAIN'
8609 include 'COMMON.DERIV'
8610 include 'COMMON.INTERACT'
8611 include 'COMMON.IOUNITS'
8612 include 'COMMON.CALC'
8613 include 'COMMON.CONTROL'
8614 include 'COMMON.SPLITELE'
8615 include 'COMMON.SBRIDGE'
8616 C this is done by Adasko
8620 C--bordliptop-- buffore starts
8621 C--bufliptop--- here true lipid starts
8623 C--buflipbot--- lipid ends buffore starts
8624 C--bordlipbot--buffore ends
8628 if (itype(i).eq.ntyp1) cycle
8630 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
8631 if (positi.le.0) positi=positi+boxzsize
8633 C first for peptide groups
8634 c for each residue check if it is in lipid or lipid water border area
8635 if ((positi.gt.bordlipbot)
8636 &.and.(positi.lt.bordliptop)) then
8637 C the energy transfer exist
8638 if (positi.lt.buflipbot) then
8639 C what fraction I am in
8641 & ((positi-bordlipbot)/lipbufthick)
8642 C lipbufthick is thickenes of lipid buffore
8643 sslip=sscalelip(fracinbuf)
8644 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8645 eliptran=eliptran+sslip*pepliptran
8646 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8647 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8648 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8649 elseif (positi.gt.bufliptop) then
8650 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
8651 sslip=sscalelip(fracinbuf)
8652 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8653 eliptran=eliptran+sslip*pepliptran
8654 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
8655 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
8656 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
8657 C print *, "doing sscalefor top part"
8658 C print *,i,sslip,fracinbuf,ssgradlip
8660 eliptran=eliptran+pepliptran
8661 C print *,"I am in true lipid"
8664 C eliptran=elpitran+0.0 ! I am in water
8667 C print *, "nic nie bylo w lipidzie?"
8668 C now multiply all by the peptide group transfer factor
8669 C eliptran=eliptran*pepliptran
8670 C now the same for side chains
8673 if (itype(i).eq.ntyp1) cycle
8674 positi=(mod(c(3,i+nres),boxzsize))
8675 if (positi.le.0) positi=positi+boxzsize
8676 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
8677 c for each residue check if it is in lipid or lipid water border area
8678 C respos=mod(c(3,i+nres),boxzsize)
8679 C print *,positi,bordlipbot,buflipbot
8680 if ((positi.gt.bordlipbot)
8681 & .and.(positi.lt.bordliptop)) then
8682 C the energy transfer exist
8683 if (positi.lt.buflipbot) then
8685 & ((positi-bordlipbot)/lipbufthick)
8686 C lipbufthick is thickenes of lipid buffore
8687 sslip=sscalelip(fracinbuf)
8688 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
8689 eliptran=eliptran+sslip*liptranene(itype(i))
8690 gliptranx(3,i)=gliptranx(3,i)
8691 &+ssgradlip*liptranene(itype(i))
8692 gliptranc(3,i-1)= gliptranc(3,i-1)
8693 &+ssgradlip*liptranene(itype(i))
8694 C print *,"doing sccale for lower part"
8695 elseif (positi.gt.bufliptop) then
8697 &((bordliptop-positi)/lipbufthick)
8698 sslip=sscalelip(fracinbuf)
8699 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
8700 eliptran=eliptran+sslip*liptranene(itype(i))
8701 gliptranx(3,i)=gliptranx(3,i)
8702 &+ssgradlip*liptranene(itype(i))
8703 gliptranc(3,i-1)= gliptranc(3,i-1)
8704 &+ssgradlip*liptranene(itype(i))
8705 C print *, "doing sscalefor top part",sslip,fracinbuf
8707 eliptran=eliptran+liptranene(itype(i))
8708 C print *,"I am in true lipid"
8710 endif ! if in lipid or buffor
8712 C eliptran=elpitran+0.0 ! I am in water
8718 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8720 SUBROUTINE MATVEC2(A1,V1,V2)
8721 implicit real*8 (a-h,o-z)
8722 include 'DIMENSIONS'
8723 DIMENSION A1(2,2),V1(2),V2(2)
8727 c 3 VI=VI+A1(I,K)*V1(K)
8731 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8732 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8737 C---------------------------------------
8738 SUBROUTINE MATMAT2(A1,A2,A3)
8739 implicit real*8 (a-h,o-z)
8740 include 'DIMENSIONS'
8741 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8742 c DIMENSION AI3(2,2)
8746 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8752 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8753 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8754 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8755 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8763 c-------------------------------------------------------------------------
8764 double precision function scalar2(u,v)
8766 double precision u(2),v(2)
8769 scalar2=u(1)*v(1)+u(2)*v(2)
8773 C-----------------------------------------------------------------------------
8775 subroutine transpose2(a,at)
8777 double precision a(2,2),at(2,2)
8784 c--------------------------------------------------------------------------
8785 subroutine transpose(n,a,at)
8788 double precision a(n,n),at(n,n)
8796 C---------------------------------------------------------------------------
8797 subroutine prodmat3(a1,a2,kk,transp,prod)
8800 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8802 crc double precision auxmat(2,2),prod_(2,2)
8805 crc call transpose2(kk(1,1),auxmat(1,1))
8806 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8807 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8809 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8810 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8811 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8812 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8813 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8814 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8815 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8816 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8819 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8820 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8822 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8823 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8824 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8825 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8826 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8827 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8828 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8829 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8832 c call transpose2(a2(1,1),a2t(1,1))
8835 crc print *,((prod_(i,j),i=1,2),j=1,2)
8836 crc print *,((prod(i,j),i=1,2),j=1,2)
8840 C-----------------------------------------------------------------------------
8841 double precision function scalar(u,v)
8843 double precision u(3),v(3)
8853 C-----------------------------------------------------------------------
8854 double precision function sscale(r)
8855 double precision r,gamm
8856 include "COMMON.SPLITELE"
8857 if(r.lt.r_cut-rlamb) then
8859 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8860 gamm=(r-(r_cut-rlamb))/rlamb
8861 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
8867 C-----------------------------------------------------------------------
8868 C-----------------------------------------------------------------------
8869 double precision function sscagrad(r)
8870 double precision r,gamm
8871 include "COMMON.SPLITELE"
8872 if(r.lt.r_cut-rlamb) then
8874 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8875 gamm=(r-(r_cut-rlamb))/rlamb
8876 sscagrad=gamm*(6*gamm-6.0d0)/rlamb
8882 C-----------------------------------------------------------------------
8883 C-----------------------------------------------------------------------
8884 double precision function sscalelip(r)
8885 double precision r,gamm
8886 include "COMMON.SPLITELE"
8887 C if(r.lt.r_cut-rlamb) then
8889 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8890 C gamm=(r-(r_cut-rlamb))/rlamb
8891 sscalelip=1.0d0+r*r*(2*r-3.0d0)
8897 C-----------------------------------------------------------------------
8898 double precision function sscagradlip(r)
8899 double precision r,gamm
8900 include "COMMON.SPLITELE"
8901 C if(r.lt.r_cut-rlamb) then
8903 C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
8904 C gamm=(r-(r_cut-rlamb))/rlamb
8905 sscagradlip=r*(6*r-6.0d0)
8912 C-----------------------------------------------------------------------
8913 subroutine set_shield_fac
8914 implicit real*8 (a-h,o-z)
8915 include 'DIMENSIONS'
8916 include 'COMMON.CHAIN'
8917 include 'COMMON.DERIV'
8918 include 'COMMON.IOUNITS'
8919 include 'COMMON.SHIELD'
8920 include 'COMMON.INTERACT'
8921 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
8922 double precision div77_81/0.974996043d0/,
8923 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
8925 C the vector between center of side_chain and peptide group
8926 double precision pep_side(3),long,side_calf(3),
8927 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
8928 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
8929 C the line belowe needs to be changed for FGPROC>1
8931 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
8933 Cif there two consequtive dummy atoms there is no peptide group between them
8934 C the line below has to be changed for FGPROC>1
8937 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
8941 C first lets set vector conecting the ithe side-chain with kth side-chain
8942 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
8944 C and vector conecting the side-chain with its proper calfa
8945 side_calf(j)=c(j,k+nres)-c(j,k)
8946 C side_calf(j)=2.0d0
8947 pept_group(j)=c(j,i)-c(j,i+1)
8948 C lets have their lenght
8949 dist_pep_side=pep_side(j)**2+dist_pep_side
8950 dist_side_calf=dist_side_calf+side_calf(j)**2
8951 dist_pept_group=dist_pept_group+pept_group(j)**2
8953 dist_pep_side=dsqrt(dist_pep_side)
8954 dist_pept_group=dsqrt(dist_pept_group)
8955 dist_side_calf=dsqrt(dist_side_calf)
8957 pep_side_norm(j)=pep_side(j)/dist_pep_side
8958 side_calf_norm(j)=dist_side_calf
8960 C now sscale fraction
8961 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
8962 C print *,buff_shield,"buff"
8964 if (sh_frac_dist.le.0.0) cycle
8965 C If we reach here it means that this side chain reaches the shielding sphere
8966 C Lets add him to the list for gradient
8967 ishield_list(i)=ishield_list(i)+1
8968 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
8969 C this list is essential otherwise problem would be O3
8970 shield_list(ishield_list(i),i)=k
8971 C Lets have the sscale value
8972 if (sh_frac_dist.gt.1.0) then
8973 scale_fac_dist=1.0d0
8975 sh_frac_dist_grad(j)=0.0d0
8978 scale_fac_dist=-sh_frac_dist*sh_frac_dist
8979 & *(2.0*sh_frac_dist-3.0d0)
8980 fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2)
8981 & /dist_pep_side/buff_shield*0.5
8982 C remember for the final gradient multiply sh_frac_dist_grad(j)
8983 C for side_chain by factor -2 !
8985 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
8986 C print *,"jestem",scale_fac_dist,fac_help_scale,
8987 C & sh_frac_dist_grad(j)
8990 C if ((i.eq.3).and.(k.eq.2)) then
8991 C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist
8995 C this is what is now we have the distance scaling now volume...
8996 short=short_r_sidechain(itype(k))
8997 long=long_r_sidechain(itype(k))
8998 costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2)
9001 costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4
9004 costhet_grad(j)=costhet_fac*pep_side(j)
9006 C remember for the final gradient multiply costhet_grad(j)
9007 C for side_chain by factor -2 !
9008 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9009 C pep_side0pept_group is vector multiplication
9010 pep_side0pept_group=0.0
9012 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9014 cosalfa=(pep_side0pept_group/
9015 & (dist_pep_side*dist_side_calf))
9016 fac_alfa_sin=1.0-cosalfa**2
9017 fac_alfa_sin=dsqrt(fac_alfa_sin)
9018 rkprim=fac_alfa_sin*(long-short)+short
9020 cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2)
9021 cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4
9024 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9025 &+cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9026 &*(long-short)/fac_alfa_sin*cosalfa/
9027 &((dist_pep_side*dist_side_calf))*
9028 &((side_calf(j))-cosalfa*
9029 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9031 cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim)
9032 &*(long-short)/fac_alfa_sin*cosalfa
9033 &/((dist_pep_side*dist_side_calf))*
9035 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9038 VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi)
9041 C now the gradient...
9042 C grad_shield is gradient of Calfa for peptide groups
9043 C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist,
9045 C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group,
9046 C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k)
9048 grad_shield(j,i)=grad_shield(j,i)
9049 C gradient po skalowaniu
9050 & +(sh_frac_dist_grad(j)
9051 C gradient po costhet
9052 &-scale_fac_dist*costhet_grad(j)/(1.0-costhet)
9053 &-scale_fac_dist*(cosphi_grad_long(j))
9054 &/(1.0-cosphi) )*div77_81
9056 C grad_shield_side is Cbeta sidechain gradient
9057 grad_shield_side(j,ishield_list(i),i)=
9058 & (sh_frac_dist_grad(j)*-2.0d0
9059 & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet)
9060 & +scale_fac_dist*(cosphi_grad_long(j))
9061 & *2.0d0/(1.0-cosphi))
9062 & *div77_81*VofOverlap
9064 grad_shield_loc(j,ishield_list(i),i)=
9065 & scale_fac_dist*cosphi_grad_loc(j)
9066 & *2.0d0/(1.0-cosphi)
9067 & *div77_81*VofOverlap
9069 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9071 fac_shield(i)=VolumeTotal*div77_81+div4_81
9072 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9076 C--------------------------------------------------------------------------
9077 C first for shielding is setting of function of side-chains
9078 subroutine set_shield_fac2
9079 implicit real*8 (a-h,o-z)
9080 include 'DIMENSIONS'
9081 include 'COMMON.CHAIN'
9082 include 'COMMON.DERIV'
9083 include 'COMMON.IOUNITS'
9084 include 'COMMON.SHIELD'
9085 include 'COMMON.INTERACT'
9086 C this is the squar root 77 devided by 81 the epislion in lipid (in protein)
9087 double precision div77_81/0.974996043d0/,
9088 &div4_81/0.2222222222d0/,sh_frac_dist_grad(3)
9090 C the vector between center of side_chain and peptide group
9091 double precision pep_side(3),long,side_calf(3),
9092 &pept_group(3),costhet_grad(3),cosphi_grad_long(3),
9093 &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3)
9094 C the line belowe needs to be changed for FGPROC>1
9096 if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle
9098 Cif there two consequtive dummy atoms there is no peptide group between them
9099 C the line below has to be changed for FGPROC>1
9102 if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle
9106 C first lets set vector conecting the ithe side-chain with kth side-chain
9107 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
9109 C and vector conecting the side-chain with its proper calfa
9110 side_calf(j)=c(j,k+nres)-c(j,k)
9111 C side_calf(j)=2.0d0
9112 pept_group(j)=c(j,i)-c(j,i+1)
9113 C lets have their lenght
9114 dist_pep_side=pep_side(j)**2+dist_pep_side
9115 dist_side_calf=dist_side_calf+side_calf(j)**2
9116 dist_pept_group=dist_pept_group+pept_group(j)**2
9118 dist_pep_side=dsqrt(dist_pep_side)
9119 dist_pept_group=dsqrt(dist_pept_group)
9120 dist_side_calf=dsqrt(dist_side_calf)
9122 pep_side_norm(j)=pep_side(j)/dist_pep_side
9123 side_calf_norm(j)=dist_side_calf
9125 C now sscale fraction
9126 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
9127 C print *,buff_shield,"buff"
9129 if (sh_frac_dist.le.0.0) cycle
9130 C If we reach here it means that this side chain reaches the shielding sphere
9131 C Lets add him to the list for gradient
9132 ishield_list(i)=ishield_list(i)+1
9133 C ishield_list is a list of non 0 side-chain that contribute to factor gradient
9134 C this list is essential otherwise problem would be O3
9135 shield_list(ishield_list(i),i)=k
9136 C Lets have the sscale value
9137 if (sh_frac_dist.gt.1.0) then
9138 scale_fac_dist=1.0d0
9140 sh_frac_dist_grad(j)=0.0d0
9143 scale_fac_dist=-sh_frac_dist*sh_frac_dist
9144 & *(2.0d0*sh_frac_dist-3.0d0)
9145 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2)
9146 & /dist_pep_side/buff_shield*0.5d0
9147 C remember for the final gradient multiply sh_frac_dist_grad(j)
9148 C for side_chain by factor -2 !
9150 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
9151 C sh_frac_dist_grad(j)=0.0d0
9152 C scale_fac_dist=1.0d0
9153 C print *,"jestem",scale_fac_dist,fac_help_scale,
9154 C & sh_frac_dist_grad(j)
9157 C this is what is now we have the distance scaling now volume...
9158 short=short_r_sidechain(itype(k))
9159 long=long_r_sidechain(itype(k))
9160 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
9161 sinthet=short/dist_pep_side*costhet
9165 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
9166 C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
9167 C & -short/dist_pep_side**2/costhet)
9170 costhet_grad(j)=costhet_fac*pep_side(j)
9172 C remember for the final gradient multiply costhet_grad(j)
9173 C for side_chain by factor -2 !
9174 C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
9175 C pep_side0pept_group is vector multiplication
9176 pep_side0pept_group=0.0d0
9178 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
9180 cosalfa=(pep_side0pept_group/
9181 & (dist_pep_side*dist_side_calf))
9182 fac_alfa_sin=1.0d0-cosalfa**2
9183 fac_alfa_sin=dsqrt(fac_alfa_sin)
9184 rkprim=fac_alfa_sin*(long-short)+short
9188 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
9190 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
9191 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/
9195 cosphi_grad_long(j)=cosphi_fac*pep_side(j)
9196 &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9197 &*(long-short)/fac_alfa_sin*cosalfa/
9198 &((dist_pep_side*dist_side_calf))*
9199 &((side_calf(j))-cosalfa*
9200 &((pep_side(j)/dist_pep_side)*dist_side_calf))
9201 C cosphi_grad_long(j)=0.0d0
9202 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim)
9203 &*(long-short)/fac_alfa_sin*cosalfa
9204 &/((dist_pep_side*dist_side_calf))*
9206 &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
9207 C cosphi_grad_loc(j)=0.0d0
9209 C print *,sinphi,sinthet
9210 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet))
9213 C now the gradient...
9215 grad_shield(j,i)=grad_shield(j,i)
9216 C gradient po skalowaniu
9217 & +(sh_frac_dist_grad(j)*VofOverlap
9218 C gradient po costhet
9219 & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0*
9220 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9221 & sinphi/sinthet*costhet*costhet_grad(j)
9222 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9224 C grad_shield_side is Cbeta sidechain gradient
9225 grad_shield_side(j,ishield_list(i),i)=
9226 & (sh_frac_dist_grad(j)*-2.0d0
9228 & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9229 &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(
9230 & sinphi/sinthet*costhet*costhet_grad(j)
9231 & +sinthet/sinphi*cosphi*cosphi_grad_long(j)))
9234 grad_shield_loc(j,ishield_list(i),i)=
9235 & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*
9236 &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(
9237 & sinthet/sinphi*cosphi*cosphi_grad_loc(j)
9241 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
9243 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
9244 C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i)
9245 C write(2,*) "TU",rpp(1,1),short,long,buff_shield
9250 C-----------------------------------------------------------------------
9251 C-----------------------------------------------------------
9252 C This subroutine is to mimic the histone like structure but as well can be
9253 C utilizet to nanostructures (infinit) small modification has to be used to
9254 C make it finite (z gradient at the ends has to be changes as well as the x,y
9255 C gradient has to be modified at the ends
9256 C The energy function is Kihara potential
9257 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9258 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9259 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9260 C simple Kihara potential
9261 subroutine calctube(Etube)
9262 implicit real*8 (a-h,o-z)
9263 include 'DIMENSIONS'
9264 include 'COMMON.GEO'
9265 include 'COMMON.VAR'
9266 include 'COMMON.LOCAL'
9267 include 'COMMON.CHAIN'
9268 include 'COMMON.DERIV'
9269 include 'COMMON.INTERACT'
9270 include 'COMMON.IOUNITS'
9271 include 'COMMON.CALC'
9272 include 'COMMON.CONTROL'
9273 include 'COMMON.SPLITELE'
9274 include 'COMMON.SBRIDGE'
9275 double precision tub_r,vectube(3),enetube(maxres*2)
9277 do i=itube_start,itube_end
9279 enetube(i+nres)=0.0d0
9281 C first we calculate the distance from tube center
9282 C first sugare-phosphate group for NARES this would be peptide group
9284 do i=itube_start,itube_end
9285 C lets ommit dummy atoms for now
9286 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9287 C now calculate distance from center of tube and direction vectors
9291 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9292 vectube(1)=vectube(1)+boxxsize*j
9293 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9294 vectube(2)=vectube(2)+boxysize*j
9296 xminact=abs(vectube(1)-tubecenter(1))
9297 yminact=abs(vectube(2)-tubecenter(2))
9298 if (xmin.gt.xminact) then
9302 if (ymin.gt.yminact) then
9309 vectube(1)=vectube(1)-tubecenter(1)
9310 vectube(2)=vectube(2)-tubecenter(2)
9312 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9313 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9315 C as the tube is infinity we do not calculate the Z-vector use of Z
9318 C now calculte the distance
9319 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9320 C now normalize vector
9321 vectube(1)=vectube(1)/tub_r
9322 vectube(2)=vectube(2)/tub_r
9323 C calculte rdiffrence between r and r0
9327 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9328 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9329 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9330 C print *,rdiff,rdiff6,pep_aa_tube
9331 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9332 C now we calculate gradient
9333 fac=(-12.0d0*pep_aa_tube/rdiff6-
9334 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9335 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9338 C now direction of gg_tube vector
9340 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9341 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9344 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9345 C print *,gg_tube(1,0),"TU"
9348 do i=itube_start,itube_end
9349 C Lets not jump over memory as we use many times iti
9351 C lets ommit dummy atoms for now
9353 C in UNRES uncomment the line below as GLY has no side-chain...
9359 vectube(1)=mod((c(1,i+nres)),boxxsize)
9360 vectube(1)=vectube(1)+boxxsize*j
9361 vectube(2)=mod((c(2,i+nres)),boxysize)
9362 vectube(2)=vectube(2)+boxysize*j
9364 xminact=abs(vectube(1)-tubecenter(1))
9365 yminact=abs(vectube(2)-tubecenter(2))
9366 if (xmin.gt.xminact) then
9370 if (ymin.gt.yminact) then
9377 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9379 vectube(1)=vectube(1)-tubecenter(1)
9380 vectube(2)=vectube(2)-tubecenter(2)
9382 C as the tube is infinity we do not calculate the Z-vector use of Z
9385 C now calculte the distance
9386 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9387 C now normalize vector
9388 vectube(1)=vectube(1)/tub_r
9389 vectube(2)=vectube(2)/tub_r
9391 C calculte rdiffrence between r and r0
9395 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9396 sc_aa_tube=sc_aa_tube_par(iti)
9397 sc_bb_tube=sc_bb_tube_par(iti)
9398 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9399 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9400 C now we calculate gradient
9401 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9402 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9403 C now direction of gg_tube vector
9405 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9406 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9409 do i=itube_start,itube_end
9410 Etube=Etube+enetube(i)+enetube(i+nres)
9412 C print *,"ETUBE", etube
9415 C TO DO 1) add to total energy
9416 C 2) add to gradient summation
9417 C 3) add reading parameters (AND of course oppening of PARAM file)
9418 C 4) add reading the center of tube
9420 C 6) add to zerograd
9422 C-----------------------------------------------------------------------
9423 C-----------------------------------------------------------
9424 C This subroutine is to mimic the histone like structure but as well can be
9425 C utilizet to nanostructures (infinit) small modification has to be used to
9426 C make it finite (z gradient at the ends has to be changes as well as the x,y
9427 C gradient has to be modified at the ends
9428 C The energy function is Kihara potential
9429 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9430 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9431 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9432 C simple Kihara potential
9433 subroutine calctube2(Etube)
9434 implicit real*8 (a-h,o-z)
9435 include 'DIMENSIONS'
9436 include 'COMMON.GEO'
9437 include 'COMMON.VAR'
9438 include 'COMMON.LOCAL'
9439 include 'COMMON.CHAIN'
9440 include 'COMMON.DERIV'
9441 include 'COMMON.INTERACT'
9442 include 'COMMON.IOUNITS'
9443 include 'COMMON.CALC'
9444 include 'COMMON.CONTROL'
9445 include 'COMMON.SPLITELE'
9446 include 'COMMON.SBRIDGE'
9447 double precision tub_r,vectube(3),enetube(maxres*2)
9449 do i=itube_start,itube_end
9451 enetube(i+nres)=0.0d0
9453 C first we calculate the distance from tube center
9454 C first sugare-phosphate group for NARES this would be peptide group
9456 do i=itube_start,itube_end
9457 C lets ommit dummy atoms for now
9459 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9460 C now calculate distance from center of tube and direction vectors
9461 C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9462 C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9463 C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9464 C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9468 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9469 vectube(1)=vectube(1)+boxxsize*j
9470 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9471 vectube(2)=vectube(2)+boxysize*j
9473 xminact=abs(vectube(1)-tubecenter(1))
9474 yminact=abs(vectube(2)-tubecenter(2))
9475 if (xmin.gt.xminact) then
9479 if (ymin.gt.yminact) then
9486 vectube(1)=vectube(1)-tubecenter(1)
9487 vectube(2)=vectube(2)-tubecenter(2)
9489 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9490 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9492 C as the tube is infinity we do not calculate the Z-vector use of Z
9495 C now calculte the distance
9496 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9497 C now normalize vector
9498 vectube(1)=vectube(1)/tub_r
9499 vectube(2)=vectube(2)/tub_r
9500 C calculte rdiffrence between r and r0
9504 C THIS FRAGMENT MAKES TUBE FINITE
9505 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9506 if (positi.le.0) positi=positi+boxzsize
9507 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9508 c for each residue check if it is in lipid or lipid water border area
9509 C respos=mod(c(3,i+nres),boxzsize)
9510 print *,positi,bordtubebot,buftubebot,bordtubetop
9511 if ((positi.gt.bordtubebot)
9512 & .and.(positi.lt.bordtubetop)) then
9513 C the energy transfer exist
9514 if (positi.lt.buftubebot) then
9516 & ((positi-bordtubebot)/tubebufthick)
9517 C lipbufthick is thickenes of lipid buffore
9518 sstube=sscalelip(fracinbuf)
9519 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9520 print *,ssgradtube, sstube,tubetranene(itype(i))
9521 enetube(i)=enetube(i)+sstube*tubetranenepep
9522 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9523 C &+ssgradtube*tubetranene(itype(i))
9524 C gg_tube(3,i-1)= gg_tube(3,i-1)
9525 C &+ssgradtube*tubetranene(itype(i))
9526 C print *,"doing sccale for lower part"
9527 elseif (positi.gt.buftubetop) then
9529 &((bordtubetop-positi)/tubebufthick)
9530 sstube=sscalelip(fracinbuf)
9531 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9532 enetube(i)=enetube(i)+sstube*tubetranenepep
9533 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9534 C &+ssgradtube*tubetranene(itype(i))
9535 C gg_tube(3,i-1)= gg_tube(3,i-1)
9536 C &+ssgradtube*tubetranene(itype(i))
9537 C print *, "doing sscalefor top part",sslip,fracinbuf
9541 enetube(i)=enetube(i)+sstube*tubetranenepep
9542 C print *,"I am in true lipid"
9548 endif ! if in lipid or buffor
9550 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9551 enetube(i)=enetube(i)+sstube*
9552 &(pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
9553 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9554 C print *,rdiff,rdiff6,pep_aa_tube
9555 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9556 C now we calculate gradient
9557 fac=(-12.0d0*pep_aa_tube/rdiff6-
9558 & 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
9559 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9562 C now direction of gg_tube vector
9564 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9565 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9567 gg_tube(3,i)=gg_tube(3,i)
9568 &+ssgradtube*enetube(i)/sstube/2.0d0
9569 gg_tube(3,i-1)= gg_tube(3,i-1)
9570 &+ssgradtube*enetube(i)/sstube/2.0d0
9573 C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
9574 C print *,gg_tube(1,0),"TU"
9575 do i=itube_start,itube_end
9576 C Lets not jump over memory as we use many times iti
9578 C lets ommit dummy atoms for now
9580 C in UNRES uncomment the line below as GLY has no side-chain...
9583 vectube(1)=c(1,i+nres)
9584 vectube(1)=mod(vectube(1),boxxsize)
9585 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
9586 vectube(2)=c(2,i+nres)
9587 vectube(2)=mod(vectube(2),boxysize)
9588 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
9590 vectube(1)=vectube(1)-tubecenter(1)
9591 vectube(2)=vectube(2)-tubecenter(2)
9592 C THIS FRAGMENT MAKES TUBE FINITE
9593 positi=(mod(c(3,i+nres),boxzsize))
9594 if (positi.le.0) positi=positi+boxzsize
9595 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
9596 c for each residue check if it is in lipid or lipid water border area
9597 C respos=mod(c(3,i+nres),boxzsize)
9598 print *,positi,bordtubebot,buftubebot,bordtubetop
9599 if ((positi.gt.bordtubebot)
9600 & .and.(positi.lt.bordtubetop)) then
9601 C the energy transfer exist
9602 if (positi.lt.buftubebot) then
9604 & ((positi-bordtubebot)/tubebufthick)
9605 C lipbufthick is thickenes of lipid buffore
9606 sstube=sscalelip(fracinbuf)
9607 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
9608 print *,ssgradtube, sstube,tubetranene(itype(i))
9609 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9610 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9611 C &+ssgradtube*tubetranene(itype(i))
9612 C gg_tube(3,i-1)= gg_tube(3,i-1)
9613 C &+ssgradtube*tubetranene(itype(i))
9614 C print *,"doing sccale for lower part"
9615 elseif (positi.gt.buftubetop) then
9617 &((bordtubetop-positi)/tubebufthick)
9618 sstube=sscalelip(fracinbuf)
9619 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
9620 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9621 C gg_tube_SC(3,i)=gg_tube_SC(3,i)
9622 C &+ssgradtube*tubetranene(itype(i))
9623 C gg_tube(3,i-1)= gg_tube(3,i-1)
9624 C &+ssgradtube*tubetranene(itype(i))
9625 C print *, "doing sscalefor top part",sslip,fracinbuf
9629 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i))
9630 C print *,"I am in true lipid"
9636 endif ! if in lipid or buffor
9637 CEND OF FINITE FRAGMENT
9638 C as the tube is infinity we do not calculate the Z-vector use of Z
9641 C now calculte the distance
9642 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9643 C now normalize vector
9644 vectube(1)=vectube(1)/tub_r
9645 vectube(2)=vectube(2)/tub_r
9646 C calculte rdiffrence between r and r0
9650 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9651 sc_aa_tube=sc_aa_tube_par(iti)
9652 sc_bb_tube=sc_bb_tube_par(iti)
9653 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)
9654 & *sstube+enetube(i+nres)
9655 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9656 C now we calculate gradient
9657 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9658 & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
9659 C now direction of gg_tube vector
9661 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9662 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9664 gg_tube_SC(3,i)=gg_tube_SC(3,i)
9665 &+ssgradtube*enetube(i+nres)/sstube
9666 gg_tube(3,i-1)= gg_tube(3,i-1)
9667 &+ssgradtube*enetube(i+nres)/sstube
9670 do i=itube_start,itube_end
9671 Etube=Etube+enetube(i)+enetube(i+nres)
9673 C print *,"ETUBE", etube
9676 C TO DO 1) add to total energy
9677 C 2) add to gradient summation
9678 C 3) add reading parameters (AND of course oppening of PARAM file)
9679 C 4) add reading the center of tube
9681 C 6) add to zerograd
9684 C#-------------------------------------------------------------------------------
9685 C This subroutine is to mimic the histone like structure but as well can be
9686 C utilizet to nanostructures (infinit) small modification has to be used to
9687 C make it finite (z gradient at the ends has to be changes as well as the x,y
9688 C gradient has to be modified at the ends
9689 C The energy function is Kihara potential
9690 C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
9691 C 4eps is depth of well sigma is r_minimum r is distance from center of tube
9692 C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
9693 C simple Kihara potential
9694 subroutine calcnano(Etube)
9695 implicit real*8 (a-h,o-z)
9696 include 'DIMENSIONS'
9697 include 'COMMON.GEO'
9698 include 'COMMON.VAR'
9699 include 'COMMON.LOCAL'
9700 include 'COMMON.CHAIN'
9701 include 'COMMON.DERIV'
9702 include 'COMMON.INTERACT'
9703 include 'COMMON.IOUNITS'
9704 include 'COMMON.CALC'
9705 include 'COMMON.CONTROL'
9706 include 'COMMON.SPLITELE'
9707 include 'COMMON.SBRIDGE'
9708 double precision tub_r,vectube(3),enetube(maxres*2),
9709 & enecavtube(maxres*2)
9711 do i=itube_start,itube_end
9713 enetube(i+nres)=0.0d0
9715 C first we calculate the distance from tube center
9716 C first sugare-phosphate group for NARES this would be peptide group
9718 do i=itube_start,itube_end
9719 C lets ommit dummy atoms for now
9720 if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle
9721 C now calculate distance from center of tube and direction vectors
9727 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
9728 vectube(1)=vectube(1)+boxxsize*j
9729 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
9730 vectube(2)=vectube(2)+boxysize*j
9731 vectube(3)=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
9732 vectube(3)=vectube(3)+boxzsize*j
9735 xminact=abs(vectube(1)-tubecenter(1))
9736 yminact=abs(vectube(2)-tubecenter(2))
9737 zminact=abs(vectube(3)-tubecenter(3))
9739 if (xmin.gt.xminact) then
9743 if (ymin.gt.yminact) then
9747 if (zmin.gt.zminact) then
9756 vectube(1)=vectube(1)-tubecenter(1)
9757 vectube(2)=vectube(2)-tubecenter(2)
9758 vectube(3)=vectube(3)-tubecenter(3)
9760 C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
9761 C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
9762 C as the tube is infinity we do not calculate the Z-vector use of Z
9765 C now calculte the distance
9766 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9767 C now normalize vector
9768 vectube(1)=vectube(1)/tub_r
9769 vectube(2)=vectube(2)/tub_r
9770 vectube(3)=vectube(3)/tub_r
9771 C calculte rdiffrence between r and r0
9775 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9776 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
9777 C write(iout,*) "TU13",i,rdiff6,enetube(i)
9778 C print *,rdiff,rdiff6,pep_aa_tube
9779 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9780 C now we calculate gradient
9781 fac=(-12.0d0*pep_aa_tube/rdiff6-
9782 & 6.0d0*pep_bb_tube)/rdiff6/rdiff
9783 C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
9785 if (acavtubpep.eq.0.0d0) then
9790 denominator=(1.0+dcavtubpep*rdiff6*rdiff6)
9792 & (bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)+ccavtubpep)
9795 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/sqrt(rdiff))
9796 & *denominator-(bcavtubpep*rdiff+acavtubpep*sqrt(rdiff)
9797 & +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0)
9798 & /denominator**2.0d0
9803 C print *,"TUT",i,iti,rdiff,rdiff6,acavtubpep,denominator,
9804 C & enecavtube(i),faccav
9806 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9807 CX print *,"finene=",enetube(i+nres)+enecavtube(i)
9809 C now direction of gg_tube vector
9811 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
9812 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
9816 do i=itube_start,itube_end
9818 C Lets not jump over memory as we use many times iti
9820 C lets ommit dummy atoms for now
9822 C in UNRES uncomment the line below as GLY has no side-chain...
9829 vectube(1)=mod((c(1,i+nres)),boxxsize)
9830 vectube(1)=vectube(1)+boxxsize*j
9831 vectube(2)=mod((c(2,i+nres)),boxysize)
9832 vectube(2)=vectube(2)+boxysize*j
9833 vectube(3)=mod((c(3,i+nres)),boxzsize)
9834 vectube(3)=vectube(3)+boxzsize*j
9837 xminact=abs(vectube(1)-tubecenter(1))
9838 yminact=abs(vectube(2)-tubecenter(2))
9839 zminact=abs(vectube(3)-tubecenter(3))
9841 if (xmin.gt.xminact) then
9845 if (ymin.gt.yminact) then
9849 if (zmin.gt.zminact) then
9858 C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
9860 vectube(1)=vectube(1)-tubecenter(1)
9861 vectube(2)=vectube(2)-tubecenter(2)
9862 vectube(3)=vectube(3)-tubecenter(3)
9863 C now calculte the distance
9864 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
9865 C now normalize vector
9866 vectube(1)=vectube(1)/tub_r
9867 vectube(2)=vectube(2)/tub_r
9868 vectube(3)=vectube(3)/tub_r
9870 C calculte rdiffrence between r and r0
9874 C for vectorization reasons we will sumup at the end to avoid depenence of previous
9875 sc_aa_tube=sc_aa_tube_par(iti)
9876 sc_bb_tube=sc_bb_tube_par(iti)
9877 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
9878 C enetube(i+nres)=0.0d0
9879 C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
9880 C now we calculate gradient
9881 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-
9882 & 6.0d0*sc_bb_tube/rdiff6/rdiff
9884 C now direction of gg_tube vector
9885 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9886 if (acavtub(iti).eq.0.0d0) then
9888 enecavtube(i+nres)=0.0
9891 denominator=(1.0+dcavtub(iti)*rdiff6*rdiff6)
9893 & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9896 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/sqrt(rdiff))
9897 & *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)
9898 & +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0)
9899 & /denominator**2.0d0
9904 C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
9905 C & enecavtube(i),faccav
9907 C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
9908 C print *,"finene=",enetube(i+nres)+enecavtube(i)
9910 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
9911 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
9914 C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
9915 C do i=itube_start,itube_end
9918 C if (acavtub(iti).eq.0.0) cycle
9922 do i=itube_start,itube_end
9923 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i)
9924 & +enecavtube(i+nres)
9926 C print *,"ETUBE", etube
9929 C TO DO 1) add to total energy
9930 C 2) add to gradient summation
9931 C 3) add reading parameters (AND of course oppening of PARAM file)
9932 C 4) add reading the center of tube
9934 C 6) add to zerograd